pax_global_header00006660000000000000000000000064115756234760014532gustar00rootroot0000000000000052 comment=98b88affd875473a07cb29583932bbba6a49eeb0 clojure1.2_1.2.1+dfsg.orig/000077500000000000000000000000001157562347600153575ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/.gitignore000066400000000000000000000001341157562347600173450ustar00rootroot00000000000000test-classes/* classes/* *jar pom.xml clojure.iws clojure.ipr nbproject/private/ *.zip dist clojure1.2_1.2.1+dfsg.orig/build.xml000066400000000000000000000247251157562347600172120ustar00rootroot00000000000000 Build with "ant jar" and then start the REPL with: "java -cp clojure.jar clojure.main". You will need to install the Maven Ant Tasks to ${ant.home}/lib in order to execute the nightly-build or stable-build targets. clojure1.2_1.2.1+dfsg.orig/changes.txt000066400000000000000000000177351157562347600175450ustar00rootroot00000000000000Changed to Clojure from 1.2 to 1.2.1 * keyword map uses weak refs, reduces strain on permgen * fixes genclass namespace munging CLJ-432 * fix stack overflow in Keyword.intern CLJ-444 * detect and report cyclic load CLJ-8 Changes to Clojure in Version 1.2 = CONTENTS = 0 Changes from beta up to 1.2 0.0 Clojure 1.2 is Clojure 1.2 RC3 0.1 Changes from RC2 to RC3 0.2 Changes from RC1 to RC2 0.3 Changes from beta1 to RC1 1 Deprecated and Removed Features 1.1 metadata reader macro is now ^ 2 New/Improved Features in clojure.core 2.1 Protocols, Records, and Types 2.2 Sequence Library 2.3 Destructuring 2.4 Case 2.5 Duplicate Key Prevention 2.6 Primitive Vectors 2.7 Agent Error Handling 2.8 Improved Ratio Support 2.9 Macro Implicit Args 2.10 Multimethod Enhancements 2.11 Function Metadata (Alpha) 2.12 Java Annotations 2.13 Namespace Collision Warnings 3 New Namespaces 3.1 clojure.java.io 3.1 clojure.java.javadoc 3.3 clojure.java.shell 3.4 clojure.pprint 3.5 clojure.repl 3.6 clojure.string 4 Functions with Improved Performance 5 Bug Fixes = 0 Changes from beta1 -> RC1 -> RC2 = 0.0 Clojure 1.2 is the same code as Clojure RC3 * only change is build metadata and changes.txt = 0.1 Changes from RC2 to RC3 * #382 underive fixed * #423 future now clears closed-over variables, allowing gc * #404 clojure.java.io: reader and writer work correctly for sockets * #422 fixed corner case in finally blocks where code could execute twice = 0.2 Changes from RC1 to RC2 Record/map equality is now symmetric in all cases. There are two variants: * In most cases, you should use =. Calls to = include type information, so instances of different record types can never be = to each other, or to plain maps. * Calls to .equals are different. They respect the Java semantics for maps, which is a requirement for correct interop. Type information is *not* included, so any kind of map can be .equals to any other. Possible impacts for your programs: * If you create a custom implementation of Clojure's IPersistentMap, you probably want it to be able to be = to other maps. If so, all you need to do is implement the marker interface clojure.lang.MapEquivalence. Note that APersistentMap does this for you. = 0.3 Changes from beta1 to RC1 = * switch to soft refs for class and keyword cache * update reify, defprotocol, extend-protocol docstrings (#340) * fix fieldless defrecord corner case (#402) * sh reads stdout and stderr in parallel * sh stdin, stdout default to UTF-8 (#413) * gen-class checks validity of method names (#407) = 1 Deprecated and Removed Features = == 1.1 metadata reader macro is now ^ == ^ is the metadata reader macro. The former syntax #^ is deprecated and will be removed in a future version of Clojure. = 2 New Features in clojure.core = == 2.1 Protocols, Records, Reify, and Types == defprotocol provides polymorphism without type intrusion. defrecord, reify, and deftype provide datatypes. They support, in a relatively clean manner, access to the highest-performance primitive representation and polymorphism mechanisms of the host. See http://clojure.org/protocols and http://clojure.org/datatypes for a more complete description. == 2.2 Sequence Library == The sequence library has several new functions in Clojure 1.2. The notes in parentheses indicate differences from the similarly-named functions in clojure-contrib. * flatten - New * frequencies - New * group-by - New (note: unsorted) * keep - New * keep-indexed - New (preferred over contrib's indexed for perf) * map-indexed - New (preferred over contrib's indexed for perf) * partition-all - New * partition-by - New * rand-nth - New (name indicates dependency on nth's perf) * range - Improved (added zero arity) * reductions - New * repeatedly - Improved! (added "do n times" semantics) * shuffle - New == 2.3 Destructuring Enhanced == If you associatively destructure a seq, it will be poured into a map first: (defn foo [& {:keys [a b c]}] [a b c]) (foo :c 3 :b 2) => [nil 2 3] == 2.4 Case == Case provides constant time dispatch on its clauses, which can be any compile-time literal (defn release-status [version] (case version (0.9 1.0 1.1) "History" 1.2 "Right now" :sentient "RSN" "The default")) The string "The default" represents the default clause and can be any expression, not only a compile-time literal. == 2.5 Duplicate Key Prevention == Associative literals and their constructor functions hash-map and hash-set now prevent duplicate keys: #{1 1} => java.lang.IllegalArgumentException: Duplicate key: 1 == 2.6 Primitive Vectors == vector-of creates a vector of unboxed Java primitives, which follows the contract of Clojure vectors. It takes one keyword argument corresponding to its primitive type that can be any of :int, :long, :float, :double, :byte, :short, :boolean, or :char. == 2.7 Agent Error Handling == Agent error handling has been reworked in Clojure 1.2. * agent-error - New * restart-agent - New * set-error-handler - New * error-handler - New * set-error-mode! - New * error-mode - New * await - improved docstring, explains failed agent semantics * agent-errors - DEPRECATED * clear-agent-errors - DEPRECATED == 2.8 Improved Ratio Support == * numerator - New * denominator - New * bigint - Enhanced, now ratio aware == 2.9 Macro Implicit Args == Macros now have access to implicit arguments: * &form - the macro form * &env - the local bindings == 2.10 Multimethod Enhancements == Multimethods have been enhanced to improve interactive development: * remove-all-methods - New * defmulti - Enhanced to have defonce semantics == 2.11 Function Metadata == Clojure functions can now have metadata. Please treat this capability as alpha and subject to possible change or removal in a future version of Clojure. == 2.12 Java Annotations == Java Annotations can be added simply by making a Java annotation class a key in a Clojure metadata map: ;; Name is deprecated (defrecord ^{Deprecated true} Name [first last]) Please use Java annotations for interop purposes only. == 2.13 Namespace Collision Warnings == If a namespace defines a Var whose name collides with a name in the clojure.core namespace, you will see a warning but the definition will be allowed to proceed. This facilitates promoting useful functions into clojure.core without causing a breaking change. Please track down and fix these warnings, as matching names do not always imply matching semantics! = 3 New Namespaces = Complete documentation for all namespaces is in the source and API docs: http://clojure.github.com/clojure/ == 3.1 clojure.java.io == Java I/O libraries distilled from the duck-streams and io namespaces in clojure-contrib. == 3.2 clojure.java.javadoc == Launch a Javadoc browser from the REPL, promoted from the javadoc and repl-util namespace in clojure-contrib. == 3.3 clojure.java.shell == Utilities for launching a subprocess, promoted from shell-out namespace in clojure-contrib. == 3.4 clojure.pprint == Pretty-printer for Clojure, promoted from pprint in clojure-contrib. == 3.5 clojure.repl == Utilities for a more pleasant REPL experience, promoted from the repl-utils and ns-utils namespaces in clojure-contrib. == 3.6 clojure.string == String utilities promoted from the str-utils, str-utils2, str-utils3, and string namespaces in clojure-contrib. = 4 Performance Enhancements = Many functions have improved performance in Clojure 1.2: aget array-map aset bit-shift-left bit-shift-right boolean byte count double false? float future-call get into keyword line-seq long nil? nth promise re-seq reduce resultset-seq set short true? vector = 5 Bug Fixes = Please see the complete list at https://www.assembla.com/spaces/ticket_reports/show/13167?space_id=clojure. clojure1.2_1.2.1+dfsg.orig/doc/000077500000000000000000000000001157562347600161245ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/doc/clojure/000077500000000000000000000000001157562347600175675ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/doc/clojure/pprint/000077500000000000000000000000001157562347600211035ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/doc/clojure/pprint/CommonLispFormat.markdown000066400000000000000000000204661157562347600261100ustar00rootroot00000000000000# A Common Lisp-compatible Format Function cl-format is an implementation of the incredibly baroque Common Lisp format function as specified in [Common Lisp, the Language, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000). Format gives you an easy and powerful way to format text and data for output. It supports rich formatting of strings and numbers, loops, conditionals, embedded formats, etc. It is really a domain-specific language for formatting. This implementation for clojure has the following goals: * Support the full feature set of the Common Lisp format function (including the X3J13 extensions) with the only exception being concepts that make no sense or are differently interpreted in Clojure. * Make porting code from Common Lisp easier. * Provide a more native feeling solution for Clojure programmers than the Java format method and its relatives. * Be fast. This includes the ability to precompile formats that are going to be used reptitively. * Include useful error handling and comprehensive documentation. ## Why would I use cl-format? For some people the answer to this question is that they are used to Common Lisp and, therefore, they already know the syntax of format strings and all the directives. A more interesting answer is that cl-format provides a way of rendering strings that is much more suited to Lisp and its data structures. Because iteration and conditionals are built into the directive structure of cl-format, it is possible to render sequences and other complex data structures directly without having to loop over the data structure. For example, to print the elements of a sequence separated by commas, you simply say: (cl-format true "~{~a~^, ~}" aseq) (This example is taken from [Practical Common Lisp](http://www.gigamonkeys.com/book/) by Peter Seibel.) The corresponding output using Clojure's Java-based _format_ function would involve a nasty loop/recur with some code to figure out about the commas. Yuck! ## Current Status of cl-format cl-format is 100% compatible with the Common Lisp standard as specified in CLtLv2. This includes all of the functionality of Common Lisp's format function including iteration, conditionals, text justification and rich options for displaying real and integer values. It also includes the directives to support pretty printing structured output. If you find a bug in a directive, drop me a line with a chunk of code that exhibits the bug and the version of cl-format you found it in and I'll try to get it fixed. I also intend to have good built-in documentation for the directives, but I haven't built that yet. The following directives are not yet supported: ~:T and ~@:T (but all other forms of ~T work) and extensions with ~/. The pretty printer interface is similar, but not identical to the interface in Common Lisp. Next up: * Support for ~/ * True compiled formats * Restructure unit tests into modular chunks. * Import tests from CLISP and SBCL. * Unit tests for exception conditions. * Interactive documentation ## How to use cl-format ### Loading cl-format in your program Once cl-format is in your path, adding it to your code is easy: (ns your-namespace-here (:use [clojure.pprint :only (cl-format)])) If you want to refer to the cl-format function as "format" (rather than using the clojure function of that name), you can use this idiom: (ns your-namespace-here (:refer-clojure :exclude [format]) (:use clojure.pprint)) (def format cl-format) You might want to do this in code that you've ported from Common Lisp, for instance, or maybe just because old habits die hard. From the REPL, you can grab it using (use): (use 'clojure.pprint) ### Calling cl-format cl-format is a standard clojure function that takes a variable number of arguments. You call it like this: (cl-format stream format args...) _stream_ can be any Java Writer (that is java.io.Writer) or the values _true_, _false_, or _nil_. The argument _true_ is identical to using `*`out`*` while _false_ or _nil_ indicate that cl-format should return its result as a string rather than writing it to a stream. _format_ is either a format string or a compiled format (see below). The format string controls the output that's written in a way that's similar to (but much more powerful than) the standard Clojure API format function (which is based on Java's java.lang.String.Format). Format strings consist of characters that are to be written to the output stream plus directives (which are marked by ~) as in "The answer is ~,2f". Format strings are documented in detail in [*Common Lisp the Language*, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000). _args_ is a set of arguments whose use is defined by the format. ## Using column aware streams across format invocations Writers in Java have no real idea of current column or device page width, so the format directives that want to work relative to the current position on the page have nothing to work with. To deal with this, cl-format contains an extension to writer called pretty-writer. A pretty-writer watches the output and keeps track of what column the current output is going to. When you call format and your format includes a directive that cares about what column it's in (~T, ~&, ~<...~>), cl-format will automatically wrap the Writer you passed in with a pretty-writer. This means that by default all cl-format statements act like they begin on a fresh line and have a page width of 72. For many applications, these assumptions are fine and you need to do nothing more. But sometimes you want to use multiple cl-format calls that output partial lines. You may also want to mix cl-format calls with the native clojure calls like print. If you want stay column-aware while doing this you need to create a pretty-writer of your own (and possibly bind it to `*`out`*`). As an example of this, this function takes a nested list and prints it as a table (returning the result as a string): (defn list-to-table [aseq column-width] (let [string-writer (java.io.StringWriter.) stream (get-pretty-writer string-writer)] (binding [*out* stream] (doseq [row aseq] (doseq [col row] (cl-format true "~4D~7,vT" col column-width)) (prn))) (.flush stream) (.toString string-writer))) (In reality, you'd probably do this as a single call to cl-format.) The get-pretty-writer function takes the Writer to wrap and (optionally) the page width (in columns) for use with ~<...~>. ## Examples The following function uses cl-format to dump a columnized table of the Java system properties: (defn show-props [stream] (let [p (mapcat #(vector (key %) (val %)) (sort-by key (System/getProperties)))] (cl-format stream "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}" "Property" "Value" ["" "" "" ""] p))) There are some more examples in the pretty print examples gallery at http://github.com/tomfaulhaber/pprint-examples: * hexdump - a program that uses cl-format to create a standard formatted hexdump of the requested stream. * multiply - a function to show a formatted multipication table in a very "first-order" way. * props - the show-props example shown above. * show_doc - some utilities for showing documentation from various name spaces. ## Differences from the Common Lisp format function The floating point directives that show exponents (~E, ~G) show E for the exponent character in all cases (unless overridden with an _exponentchar_). Clojure does not distinguish between floats and doubles in its printed representation and neither does cl-format. The ~A and ~S directives accept the colon prefix, but ignore it since () and nil are not equivalent in Clojure. Clojure has 3 different reader syntaxes for characters. The ~@c directive to cl-format has an argument extension to let you choose: * ~@c (with no argument) prints "\c" (backslash followed by the printed representation of the character or \newline, \space, \tab, \backspace, \return) * ~'o@c prints "\oDDD" where DDD are the octal digits representing the character. * ~'u@c prints "\uXXXX" prints the hex Unicode representation of the character. clojure1.2_1.2.1+dfsg.orig/doc/clojure/pprint/PrettyPrinting.markdown000066400000000000000000000241121157562347600256510ustar00rootroot00000000000000# A Pretty Printer for Clojure ## Overview This namespace adds a new feature to Clojure: a generalized pretty printer. The pretty printer is easy to use: user=> (println (for [x (range 10)] (range x))) (() (0) (0 1) (0 1 2) (0 1 2 3) (0 1 2 3 4) (0 1 2 3 4 5) (0 1 2 3 4 5 6) (0 1 2 3 4 5 6 7) (0 1 2 3 4 5 6 7 8)) nil user=> (use 'clojure.pprint) nil user=> (pprint (for [x (range 10)] (range x))) (() (0) (0 1) (0 1 2) (0 1 2 3) (0 1 2 3 4) (0 1 2 3 4 5) (0 1 2 3 4 5 6) (0 1 2 3 4 5 6 7) (0 1 2 3 4 5 6 7 8)) nil user=> The pretty printer supports two modes: _code_ which has special formatting for special forms and core macros and _simple_ (the default) which formats the various Clojure data structures as appropriate for raw data. In fact, the pretty printer is highly customizable, but basic use is pretty simple. All the functions and variables described here are in the clojure.pprint namespace. Using them is as simple as adding a `(:use clojure.pprint)` to your namespace declarations. Or, better practice would be `(:use [clojure.pprint :only ()])`. pprint is being developed by Tom Faulhaber (to mail me you can use my first name at my domain which is infolace.com). As with the rest of Clojure, the pretty printer is licensed under the [http://opensource.org/licenses/eclipse-1.0.php Eclipse Public License 1.0]. Future development is guided by those using it, so send feedback about what's working and not working for you and what you'd like to see in the pretty printer. ## Pretty Printing Basics Pretty printing is primarily implemented with the function pprint. pprint takes a single argument and formats it according to the settings of several special variables. Generally, the defaults are fine for pretty printing and you can simply use: (pprint obj) to print your object. If you wish to write to another stream besides `*`out`*`, you can use: (write obj :pretty true :stream foo) where foo is the stream to which you wish to write. (The write function has a lot more options which are not yet documented. Stay tuned.) When at the REPL, the pp macro pretty prints the last output value. This is useful when you get something too complex to read comfortably. Just type: user=> (pp) and you'll get a pretty printed version of the last thing output (the magic variable `*`1). ## Dispatch tables and code formatting The behavior of the pretty printer can be finely controlled through the use of _dispatch tables_ that contain descriptions for how different structures should be formatted. Using custom dispatch tables, the pretty printer can create formatted output for data structures that is customized for the application. This allows pretty printing to be baked into any structured output. For information and examples, see below in [#Custom_Dispatch_Functions Custom Dispatch Functions]. The pretty printer comes with two pre-defined dispatch tables to cover the most common situations: `*`simple-dispatch`*` - supports basic representation of data in various Clojure structures: seqs, maps, vectors, etc. in a fairly statndard way. When structures need to be broken across lines, following lines are indented to line up with the first element. `*`simple-dispatch`*` is the default and is good for showing the output of most operations. `*`code-dispatch`*` - has special representation for various structures found in code: defn, condp, binding vectors, anonymous functions, etc. This dispatch indents following lines of a list one more space as appropriate for a function/argument type of list. An example formatted with code dispatch: user=> (def code '(defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator)))) #'user/code user=> (with-pprint-dispatch *code-dispatch* (pprint code)) (defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))) nil user=> There are three ways to set the current dispatch: set it to a specific table permanantly with set-pprint-dispatch, bind it with with-pprint-dispatch (as shown in the example above), or use the :dispatch keyword argument to write. ## Control variables The operation of pretty printing is also controlled by a set of variables that control general parameters of how the pretty printer makes decisions. The current list is as follows: *`*`print-pretty`*`*: Default: *true* Bind to true if you want write to use pretty printing. (pprint and pp automatically bind this to true.) *`*`print-right-margin`*`*: Default: *72* Pretty printing will try to avoid anything going beyond this column. *`*`print-miser-width`*`*: Default: *40* The column at which to enter miser style. Depending on the dispatch table, miser style add newlines in more places to try to keep lines short allowing for further levels of nesting. For example, in the code dispatch table, the pretty printer will insert a newline between the "if" and its condition when in miser style. *`*`print-suppress-namespaces`*`*: Default: *false* Don't print namespaces with symbols. This is particularly useful when pretty printing the results of macro expansions *`*`print-level`*`*: Default: *nil* As with the regular Clojure print function, this variable controls the depth of structure that is printed. The argument itself is level 0, the first level of a collection is level 1, etc. When the structure gets deeper than the specified `*`print-level`*`, a hash sign (#) is printed. For example: user=> (binding [*print-level* 2] (pprint '(a b (c d) ((e) ((f d) g))))) (a b (c d) (# #)) nil user=> *`*`print-length`*`*: Default: *nil* As with the regular Clojure print function, this variable controls the number of items that are printed at each layer of structure. When a layer has too many items, elipses (...) are displayed. For example: user=> (defn foo [x] (for [i (range x) ] (range 1 (- x (dec i))))) #'user/foo user=> (binding [*print-length* 6] (pprint (foo 10))) ((1 2 3 4 5 6 ...) (1 2 3 4 5 6 ...) (1 2 3 4 5 6 ...) (1 2 3 4 5 6 ...) (1 2 3 4 5 6) (1 2 3 4 5) ...) nil user=> ## Custom Dispatch Functions Using custom dispatch, you can easily create your own formatted output for structured data. Examples included with the pretty printer show how to use custom dispatch to translate simple Clojure structures into nicely formatted JSON and XML. ### Basic Concepts of Pretty Printing In order to create custom dispatch functions, you need to understand the fundamentals of pretty printing. The clojure pretty printer is based on the XP pretty printer algorithm (used in many Lisps including Common Lisp) which supports sophisticated decision-making about line breaking and indentation with reasonable performance even for very large structures. The XP algorithm is documented in the paper, [http://dspace.mit.edu/handle/1721.1/6504 XP. A Common Lisp Pretty Printing System]. The Clojure implementation of XP is similar in spirit to the Common Lisp implementation, but the details of the interface are somewhat different. The result is that writing custom dispatch in Clojure is more "Clojure-y." There are three key concepts to understand when creating custom pretty printing functions: _logical blocks_, _conditional newlines_, and _indentation_. A _logical block_ marks a set of output that should be thought about as a single unit by the pretty printer. Logical blocks can contain other logical blocks (that is, they nest). As a simple example, when printing list structure, every sublist will typically be a logical block. _Conditional newlines_ tell the pretty printer where it can insert line breaks and how to make the decisions about when to do it. There are four types of conditional newline: * Linear newlines tell the pretty printer to insert a newline in a place whenever the enclosing logical block won't fit on a single line. Linear newlines are an all-or-nothing proposition; if the logical block doesn't fit on a single line, *all* the linear newlines are emitted as actual newlines. * Fill newlines tell the pretty printer that it should fit as many chunks of the logical block as possible on this line and then emit a newline. * Mandatory newlines tell the pretty printer to emit a newline regardless of where it is in the output line. * Miser newlines tell the pretty printer to emit a newline if the output column is in the miser region (as defined by the pretty printer variable `*`pprint-miser-width`*`). This allows you to define special behavior as the output gets heavily nested near the right margin. _Indentation_ commands allow you to specify how wrapped lines should be indented. Indentation can be relative to either the start column of the current logical block or the current column position of the output. (This section is still incomplete...) ## Current limitations and future plans This is an early version release of the pretty printer and there is plenty that is yet to come. Here are some examples: * Support all the types and forms in Clojure (most of the way there now). * Support for limiting pretty printing based on line counts. * Support for circular and shared substructure detection. * Finishing the integration with the format function (support for ~/ and tabular pretty printing). * Performance! (Not much thought has been made to making this go fast, but there are a bunch of pretty obvious speedups to be had.) * Handle Java objects intelligently Please let me know about anything that's not working right, anything that should work differently, or the feature you think should be at the top of my list. clojure1.2_1.2.1+dfsg.orig/epl-v10.html000066400000000000000000000311651157562347600174370ustar00rootroot00000000000000 Eclipse Public License - Version 1.0

Eclipse Public License - v 1.0

THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.

1. DEFINITIONS

"Contribution" means:

a) in the case of the initial Contributor, the initial code and documentation distributed under this Agreement, and

b) in the case of each subsequent Contributor:

i) changes to the Program, and

ii) additions to the Program;

where such changes and/or additions to the Program originate from and are distributed by that particular Contributor. A Contribution 'originates' from a Contributor if it was added to the Program by such Contributor itself or anyone acting on such Contributor's behalf. Contributions do not include additions to the Program which: (i) are separate modules of software distributed in conjunction with the Program under their own license agreement, and (ii) are not derivative works of the Program.

"Contributor" means any person or entity that distributes the Program.

"Licensed Patents" mean patent claims licensable by a Contributor which are necessarily infringed by the use or sale of its Contribution alone or when combined with the Program.

"Program" means the Contributions distributed in accordance with this Agreement.

"Recipient" means anyone who receives the Program under this Agreement, including all Contributors.

2. GRANT OF RIGHTS

a) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, distribute and sublicense the Contribution of such Contributor, if any, and such derivative works, in source code and object code form.

b) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free patent license under Licensed Patents to make, use, sell, offer to sell, import and otherwise transfer the Contribution of such Contributor, if any, in source code and object code form. This patent license shall apply to the combination of the Contribution and the Program if, at the time the Contribution is added by the Contributor, such addition of the Contribution causes such combination to be covered by the Licensed Patents. The patent license shall not apply to any other combinations which include the Contribution. No hardware per se is licensed hereunder.

c) Recipient understands that although each Contributor grants the licenses to its Contributions set forth herein, no assurances are provided by any Contributor that the Program does not infringe the patent or other intellectual property rights of any other entity. Each Contributor disclaims any liability to Recipient for claims brought by any other entity based on infringement of intellectual property rights or otherwise. As a condition to exercising the rights and licenses granted hereunder, each Recipient hereby assumes sole responsibility to secure any other intellectual property rights needed, if any. For example, if a third party patent license is required to allow Recipient to distribute the Program, it is Recipient's responsibility to acquire that license before distributing the Program.

d) Each Contributor represents that to its knowledge it has sufficient copyright rights in its Contribution, if any, to grant the copyright license set forth in this Agreement.

3. REQUIREMENTS

A Contributor may choose to distribute the Program in object code form under its own license agreement, provided that:

a) it complies with the terms and conditions of this Agreement; and

b) its license agreement:

i) effectively disclaims on behalf of all Contributors all warranties and conditions, express and implied, including warranties or conditions of title and non-infringement, and implied warranties or conditions of merchantability and fitness for a particular purpose;

ii) effectively excludes on behalf of all Contributors all liability for damages, including direct, indirect, special, incidental and consequential damages, such as lost profits;

iii) states that any provisions which differ from this Agreement are offered by that Contributor alone and not by any other party; and

iv) states that source code for the Program is available from such Contributor, and informs licensees how to obtain it in a reasonable manner on or through a medium customarily used for software exchange.

When the Program is made available in source code form:

a) it must be made available under this Agreement; and

b) a copy of this Agreement must be included with each copy of the Program.

Contributors may not remove or alter any copyright notices contained within the Program.

Each Contributor must identify itself as the originator of its Contribution, if any, in a manner that reasonably allows subsequent Recipients to identify the originator of the Contribution.

4. COMMERCIAL DISTRIBUTION

Commercial distributors of software may accept certain responsibilities with respect to end users, business partners and the like. While this license is intended to facilitate the commercial use of the Program, the Contributor who includes the Program in a commercial product offering should do so in a manner which does not create potential liability for other Contributors. Therefore, if a Contributor includes the Program in a commercial product offering, such Contributor ("Commercial Contributor") hereby agrees to defend and indemnify every other Contributor ("Indemnified Contributor") against any losses, damages and costs (collectively "Losses") arising from claims, lawsuits and other legal actions brought by a third party against the Indemnified Contributor to the extent caused by the acts or omissions of such Commercial Contributor in connection with its distribution of the Program in a commercial product offering. The obligations in this section do not apply to any claims or Losses relating to any actual or alleged intellectual property infringement. In order to qualify, an Indemnified Contributor must: a) promptly notify the Commercial Contributor in writing of such claim, and b) allow the Commercial Contributor to control, and cooperate with the Commercial Contributor in, the defense and any related settlement negotiations. The Indemnified Contributor may participate in any such claim at its own expense.

For example, a Contributor might include the Program in a commercial product offering, Product X. That Contributor is then a Commercial Contributor. If that Commercial Contributor then makes performance claims, or offers warranties related to Product X, those performance claims and warranties are such Commercial Contributor's responsibility alone. Under this section, the Commercial Contributor would have to defend claims against the other Contributors related to those performance claims and warranties, and if a court requires any other Contributor to pay any damages as a result, the Commercial Contributor must pay those damages.

5. NO WARRANTY

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the appropriateness of using and distributing the Program and assumes all risks associated with its exercise of rights under this Agreement , including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and unavailability or interruption of operations.

6. DISCLAIMER OF LIABILITY

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

7. GENERAL

If any provision of this Agreement is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this Agreement, and without further action by the parties hereto, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable.

If Recipient institutes patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Program itself (excluding combinations of the Program with other software or hardware) infringes such Recipient's patent(s), then such Recipient's rights granted under Section 2(b) shall terminate as of the date such litigation is filed.

All Recipient's rights under this Agreement shall terminate if it fails to comply with any of the material terms or conditions of this Agreement and does not cure such failure in a reasonable period of time after becoming aware of such noncompliance. If all Recipient's rights under this Agreement terminate, Recipient agrees to cease use and distribution of the Program as soon as reasonably practicable. However, Recipient's obligations under this Agreement and any licenses granted by Recipient relating to the Program shall continue and survive.

Everyone is permitted to copy and distribute copies of this Agreement, but in order to avoid inconsistency the Agreement is copyrighted and may only be modified in the following manner. The Agreement Steward reserves the right to publish new versions (including revisions) of this Agreement from time to time. No one other than the Agreement Steward has the right to modify this Agreement. The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation may assign the responsibility to serve as the Agreement Steward to a suitable separate entity. Each new version of the Agreement will be given a distinguishing version number. The Program (including Contributions) may always be distributed subject to the version of the Agreement under which it was received. In addition, after a new version of the Agreement is published, Contributor may elect to distribute the Program (including its Contributions) under the new version. Except as expressly stated in Sections 2(a) and 2(b) above, Recipient receives no rights or licenses to the intellectual property of any Contributor under this Agreement, whether expressly, by implication, estoppel or otherwise. All rights in the Program not expressly granted under this Agreement are reserved.

This Agreement is governed by the laws of the State of New York and the intellectual property laws of the United States of America. No party to this Agreement will bring a legal action under this Agreement more than one year after the cause of action arose. Each party waives its rights to a jury trial in any resulting litigation.

clojure1.2_1.2.1+dfsg.orig/pom-template.xml000066400000000000000000000014741157562347600205130ustar00rootroot00000000000000 4.0.0 org.clojure clojure clojure @clojure-version@ http://clojure.org/ Clojure core environment and runtime library. Eclipse Public License 1.0 http://opensource.org/licenses/eclipse-1.0.php repo clojure1.2_1.2.1+dfsg.orig/readme.txt000066400000000000000000000044011157562347600173540ustar00rootroot00000000000000 * Clojure * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. Docs: http://clojure.org Feedback: http://groups.google.com/group/clojure To Run: java -cp clojure.jar clojure.main To Build: ant -------------------------------------------------------------------------- This program uses the ASM bytecode engineering library which is distributed with the following notice: Copyright (c) 2000-2005 INRIA, France Telecom All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.clojure1.2_1.2.1+dfsg.orig/release.sh000066400000000000000000000020351157562347600173330ustar00rootroot00000000000000#!/bin/bash if [ -z $3 ]; then echo 'Usage: (checkout onto correct branch) (edit changes.txt) (optional: set CLOJURE_DEPLOY_URL for nonstandard location) release.sh (qualifier)' exit 0 fi MAJOR_VERSION=$1 MINOR_VERSION=$2 INCREMENTAL_VERSION=$3 QUALIFIER=$4 echo "clojure.version.major=$MAJOR_VERSION clojure.version.minor=$MINOR_VERSION clojure.version.incremental=$INCREMENTAL_VERSION clojure.version.qualifier=$QUALIFIER clojure.version.interim=false" >src/clj/clojure/version.properties if [ -z $QUALIFIER ]; then VERSION="$MAJOR_VERSION.$MINOR_VERSION.$INCREMENTAL_VERSION" else VERSION="$MAJOR_VERSION.$MINOR_VERSION.$INCREMENTAL_VERSION-$QUALIFIER" fi git commit -a -m "[Automated release] Clojure $VERSION" git tag -a -m "$VERSION" $VERSION if [ -z $CLOJURE_DEPLOY_URL ]; then CLOJURE_DEPLOY_URL=scp://build.clojure.org/srv/www/releases fi ant release -Ddeployment.url=$CLOJURE_DEPLOY_URL echo "Build is complete. git push if you are satisfied with the result." clojure1.2_1.2.1+dfsg.orig/src/000077500000000000000000000000001157562347600161465ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/000077500000000000000000000000001157562347600167165ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/000077500000000000000000000000001157562347600203615ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/core.clj000066400000000000000000005630731157562347600220210ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "The core Clojure language." :author "Rich Hickey"} clojure.core) (def unquote) (def unquote-splicing) (def ^{:arglists '([& items]) :doc "Creates a new list containing the items." :added "1.0"} list (. clojure.lang.PersistentList creator)) (def ^{:arglists '([x seq]) :doc "Returns a new seq where x is the first element and seq is the rest." :added "1.0"} cons (fn* cons [x seq] (. clojure.lang.RT (cons x seq)))) ;during bootstrap we don't have destructuring let, loop or fn, will redefine later (def ^{:macro true :added "1.0"} let (fn* let [&form &env & decl] (cons 'let* decl))) (def ^{:macro true :added "1.0"} loop (fn* loop [&form &env & decl] (cons 'loop* decl))) (def ^{:macro true :added "1.0"} fn (fn* fn [&form &env & decl] (.withMeta ^clojure.lang.IObj (cons 'fn* decl) (.meta ^clojure.lang.IMeta &form)))) (def ^{:arglists '([coll]) :doc "Returns the first item in the collection. Calls seq on its argument. If coll is nil, returns nil." :added "1.0"} first (fn first [coll] (. clojure.lang.RT (first coll)))) (def ^{:arglists '([coll]) :tag clojure.lang.ISeq :doc "Returns a seq of the items after the first. Calls seq on its argument. If there are no more items, returns nil." :added "1.0"} next (fn next [x] (. clojure.lang.RT (next x)))) (def ^{:arglists '([coll]) :tag clojure.lang.ISeq :doc "Returns a possibly empty seq of the items after the first. Calls seq on its argument." :added "1.0"} rest (fn rest [x] (. clojure.lang.RT (more x)))) (def ^{:arglists '([coll x] [coll x & xs]) :doc "conj[oin]. Returns a new collection with the xs 'added'. (conj nil item) returns (item). The 'addition' may happen at different 'places' depending on the concrete type." :added "1.0"} conj (fn conj ([coll x] (. clojure.lang.RT (conj coll x))) ([coll x & xs] (if xs (recur (conj coll x) (first xs) (next xs)) (conj coll x))))) (def ^{:doc "Same as (first (next x))" :arglists '([x]) :added "1.0"} second (fn second [x] (first (next x)))) (def ^{:doc "Same as (first (first x))" :arglists '([x]) :added "1.0"} ffirst (fn ffirst [x] (first (first x)))) (def ^{:doc "Same as (next (first x))" :arglists '([x]) :added "1.0"} nfirst (fn nfirst [x] (next (first x)))) (def ^{:doc "Same as (first (next x))" :arglists '([x]) :added "1.0"} fnext (fn fnext [x] (first (next x)))) (def ^{:doc "Same as (next (next x))" :arglists '([x]) :added "1.0"} nnext (fn nnext [x] (next (next x)))) (def ^{:arglists '([coll]) :doc "Returns a seq on the collection. If the collection is empty, returns nil. (seq nil) returns nil. seq also works on Strings, native Java arrays (of reference types) and any objects that implement Iterable." :tag clojure.lang.ISeq :added "1.0"} seq (fn seq [coll] (. clojure.lang.RT (seq coll)))) (def ^{:arglists '([^Class c x]) :doc "Evaluates x and tests if it is an instance of the class c. Returns true or false" :added "1.0"} instance? (fn instance? [^Class c x] (. c (isInstance x)))) (def ^{:arglists '([x]) :doc "Return true if x implements ISeq" :added "1.0"} seq? (fn seq? [x] (instance? clojure.lang.ISeq x))) (def ^{:arglists '([x]) :doc "Return true if x is a Character" :added "1.0"} char? (fn char? [x] (instance? Character x))) (def ^{:arglists '([x]) :doc "Return true if x is a String" :added "1.0"} string? (fn string? [x] (instance? String x))) (def ^{:arglists '([x]) :doc "Return true if x implements IPersistentMap" :added "1.0"} map? (fn map? [x] (instance? clojure.lang.IPersistentMap x))) (def ^{:arglists '([x]) :doc "Return true if x implements IPersistentVector" :added "1.0"} vector? (fn vector? [x] (instance? clojure.lang.IPersistentVector x))) (def ^{:arglists '([map key val] [map key val & kvs]) :doc "assoc[iate]. When applied to a map, returns a new map of the same (hashed/sorted) type, that contains the mapping of key(s) to val(s). When applied to a vector, returns a new vector that contains val at index. Note - index must be <= (count vector)." :added "1.0"} assoc (fn assoc ([map key val] (. clojure.lang.RT (assoc map key val))) ([map key val & kvs] (let [ret (assoc map key val)] (if kvs (recur ret (first kvs) (second kvs) (nnext kvs)) ret))))) ;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:arglists '([obj]) :doc "Returns the metadata of obj, returns nil if there is no metadata." :added "1.0"} meta (fn meta [x] (if (instance? clojure.lang.IMeta x) (. ^clojure.lang.IMeta x (meta))))) (def ^{:arglists '([^clojure.lang.IObj obj m]) :doc "Returns an object of the same type and value as obj, with map m as its metadata." :added "1.0"} with-meta (fn with-meta [^clojure.lang.IObj x m] (. x (withMeta m)))) (def ^{:private true :dynamic true} assert-valid-fdecl (fn [fdecl])) (def ^{:private true} sigs (fn [fdecl] (assert-valid-fdecl fdecl) (let [asig (fn [fdecl] (let [arglist (first fdecl) ;elide implicit macro args arglist (if (clojure.lang.Util/equals '&form (first arglist)) (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist)) arglist) body (next fdecl)] (if (map? (first body)) (if (next body) (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body))) arglist) arglist)))] (if (seq? (first fdecl)) (loop [ret [] fdecls fdecl] (if fdecls (recur (conj ret (asig (first fdecls))) (next fdecls)) (seq ret))) (list (asig fdecl)))))) (def ^{:arglists '([coll]) :doc "Return the last item in coll, in linear time" :added "1.0"} last (fn last [s] (if (next s) (recur (next s)) (first s)))) (def ^{:arglists '([coll]) :doc "Return a seq of all but the last item in coll, in linear time" :added "1.0"} butlast (fn butlast [s] (loop [ret [] s s] (if (next s) (recur (conj ret (first s)) (next s)) (seq ret))))) (def ^{:doc "Same as (def name (fn [params* ] exprs*)) or (def name (fn ([params* ] exprs*)+)) with any doc-string or attrs added to the var metadata" :arglists '([name doc-string? attr-map? [params*] body] [name doc-string? attr-map? ([params*] body)+ attr-map?]) :added "1.0"} defn (fn defn [&form &env name & fdecl] (let [m (if (string? (first fdecl)) {:doc (first fdecl)} {}) fdecl (if (string? (first fdecl)) (next fdecl) fdecl) m (if (map? (first fdecl)) (conj m (first fdecl)) m) fdecl (if (map? (first fdecl)) (next fdecl) fdecl) fdecl (if (vector? (first fdecl)) (list fdecl) fdecl) m (if (map? (last fdecl)) (conj m (last fdecl)) m) fdecl (if (map? (last fdecl)) (butlast fdecl) fdecl) m (conj {:arglists (list 'quote (sigs fdecl))} m) m (let [inline (:inline m) ifn (first inline) iname (second inline)] ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...) (if (if (clojure.lang.Util/equiv 'fn ifn) (if (instance? clojure.lang.Symbol iname) false true)) ;; inserts the same fn name to the inline fn if it does not have one (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName name) "__inliner")) (next inline)))) m)) m (conj (if (meta name) (meta name) {}) m)] (list 'def (with-meta name m) (list '.withMeta (cons `fn (cons name fdecl)) (list '.meta (list 'var name))))))) (. (var defn) (setMacro)) (defn cast "Throws a ClassCastException if x is not a c, else returns x." {:added "1.0"} [^Class c x] (. c (cast x))) (defn to-array "Returns an array of Objects containing the contents of coll, which can be any Collection. Maps to java.util.Collection.toArray()." {:tag "[Ljava.lang.Object;" :added "1.0"} [coll] (. clojure.lang.RT (toArray coll))) (defn vector "Creates a new vector containing the args." {:added "1.0"} ([] []) ([a] [a]) ([a b] [a b]) ([a b c] [a b c]) ([a b c d] [a b c d]) ([a b c d & args] (. clojure.lang.LazilyPersistentVector (create (cons a (cons b (cons c (cons d args)))))))) (defn vec "Creates a new vector containing the contents of coll." {:added "1.0"} ([coll] (if (instance? java.util.Collection coll) (clojure.lang.LazilyPersistentVector/create coll) (. clojure.lang.LazilyPersistentVector (createOwning (to-array coll)))))) (defn hash-map "keyval => key val Returns a new hash map with supplied mappings." {:added "1.0"} ([] {}) ([& keyvals] (. clojure.lang.PersistentHashMap (createWithCheck keyvals)))) (defn hash-set "Returns a new hash set with supplied keys." {:added "1.0"} ([] #{}) ([& keys] (clojure.lang.PersistentHashSet/createWithCheck keys))) (defn sorted-map "keyval => key val Returns a new sorted map with supplied mappings." {:added "1.0"} ([& keyvals] (clojure.lang.PersistentTreeMap/create keyvals))) (defn sorted-map-by "keyval => key val Returns a new sorted map with supplied mappings, using the supplied comparator." {:added "1.0"} ([comparator & keyvals] (clojure.lang.PersistentTreeMap/create comparator keyvals))) (defn sorted-set "Returns a new sorted set with supplied keys." {:added "1.0"} ([& keys] (clojure.lang.PersistentTreeSet/create keys))) (defn sorted-set-by "Returns a new sorted set with supplied keys, using the supplied comparator." {:added "1.1"} ([comparator & keys] (clojure.lang.PersistentTreeSet/create comparator keys))) ;;;;;;;;;;;;;;;;;;;; (defn nil? "Returns true if x is nil, false otherwise." {:tag Boolean :added "1.0"} [x] (clojure.lang.Util/identical x nil)) (def ^{:doc "Like defn, but the resulting function name is declared as a macro and will be used as a macro by the compiler when it is called." :arglists '([name doc-string? attr-map? [params*] body] [name doc-string? attr-map? ([params*] body)+ attr-map?]) :added "1.0"} defmacro (fn [&form &env name & args] (let [prefix (loop [p (list name) args args] (let [f (first args)] (if (string? f) (recur (cons f p) (next args)) (if (map? f) (recur (cons f p) (next args)) p)))) fdecl (loop [fd args] (if (string? (first fd)) (recur (next fd)) (if (map? (first fd)) (recur (next fd)) fd))) fdecl (if (vector? (first fdecl)) (list fdecl) fdecl) add-implicit-args (fn [fd] (let [args (first fd)] (cons (vec (cons '&form (cons '&env args))) (next fd)))) add-args (fn [acc ds] (if (nil? ds) acc (let [d (first ds)] (if (map? d) (conj acc d) (recur (conj acc (add-implicit-args d)) (next ds)))))) fdecl (seq (add-args [] fdecl)) decl (loop [p prefix d fdecl] (if p (recur (next p) (cons (first p) d)) d))] (list 'do (cons `defn decl) (list '. (list 'var name) '(setMacro)) (list 'var name))))) (. (var defmacro) (setMacro)) (defmacro when "Evaluates test. If logical true, evaluates body in an implicit do." {:added "1.0"} [test & body] (list 'if test (cons 'do body))) (defmacro when-not "Evaluates test. If logical false, evaluates body in an implicit do." {:added "1.0"} [test & body] (list 'if test nil (cons 'do body))) (defn false? "Returns true if x is the value false, false otherwise." {:tag Boolean, :added "1.0"} [x] (clojure.lang.Util/identical x false)) (defn true? "Returns true if x is the value true, false otherwise." {:tag Boolean, :added "1.0"} [x] (clojure.lang.Util/identical x true)) (defn not "Returns true if x is logical false, false otherwise." {:tag Boolean :added "1.0"} [x] (if x false true)) (defn str "With no args, returns the empty string. With one arg x, returns x.toString(). (str nil) returns the empty string. With more than one arg, returns the concatenation of the str values of the args." {:tag String :added "1.0"} ([] "") ([^Object x] (if (nil? x) "" (. x (toString)))) ([x & ys] ((fn [^StringBuilder sb more] (if more (recur (. sb (append (str (first more)))) (next more)) (str sb))) (new StringBuilder ^String (str x)) ys))) (defn symbol? "Return true if x is a Symbol" {:added "1.0"} [x] (instance? clojure.lang.Symbol x)) (defn keyword? "Return true if x is a Keyword" {:added "1.0"} [x] (instance? clojure.lang.Keyword x)) (defn symbol "Returns a Symbol with the given namespace and name." {:tag clojure.lang.Symbol :added "1.0"} ([name] (if (symbol? name) name (clojure.lang.Symbol/intern name))) ([ns name] (clojure.lang.Symbol/intern ns name))) (defn gensym "Returns a new symbol with a unique name. If a prefix string is supplied, the name is prefix# where # is some unique number. If prefix is not supplied, the prefix is 'G__'." {:added "1.0"} ([] (gensym "G__")) ([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID)))))))) (defmacro cond "Takes a set of test/expr pairs. It evaluates each test one at a time. If a test returns logical true, cond evaluates and returns the value of the corresponding expr and doesn't evaluate any of the other tests or exprs. (cond) returns nil." {:added "1.0"} [& clauses] (when clauses (list 'if (first clauses) (if (next clauses) (second clauses) (throw (IllegalArgumentException. "cond requires an even number of forms"))) (cons 'clojure.core/cond (next (next clauses)))))) (defn keyword "Returns a Keyword with the given namespace and name. Do not use : in the keyword strings, it will be added automatically." {:tag clojure.lang.Keyword :added "1.0"} ([name] (cond (keyword? name) name (symbol? name) (clojure.lang.Keyword/intern ^clojure.lang.Symbol name) (string? name) (clojure.lang.Keyword/intern ^String name))) ([ns name] (clojure.lang.Keyword/intern ns name))) (defn spread {:private true} [arglist] (cond (nil? arglist) nil (nil? (next arglist)) (seq (first arglist)) :else (cons (first arglist) (spread (next arglist))))) (defn list* "Creates a new list containing the items prepended to the rest, the last of which will be treated as a sequence." {:added "1.0"} ([args] (seq args)) ([a args] (cons a args)) ([a b args] (cons a (cons b args))) ([a b c args] (cons a (cons b (cons c args)))) ([a b c d & more] (cons a (cons b (cons c (cons d (spread more))))))) (defn apply "Applies fn f to the argument list formed by prepending args to argseq." {:arglists '([f args* argseq]) :added "1.0"} ([^clojure.lang.IFn f args] (. f (applyTo (seq args)))) ([^clojure.lang.IFn f x args] (. f (applyTo (list* x args)))) ([^clojure.lang.IFn f x y args] (. f (applyTo (list* x y args)))) ([^clojure.lang.IFn f x y z args] (. f (applyTo (list* x y z args)))) ([^clojure.lang.IFn f a b c d & args] (. f (applyTo (cons a (cons b (cons c (cons d (spread args))))))))) (defn vary-meta "Returns an object of the same type and value as obj, with (apply f (meta obj) args) as its metadata." {:added "1.0"} [obj f & args] (with-meta obj (apply f (meta obj) args))) (defmacro lazy-seq "Takes a body of expressions that returns an ISeq or nil, and yields a Seqable object that will invoke the body only the first time seq is called, and will cache the result and return it on all subsequent seq calls." {:added "1.0"} [& body] (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body))) (defn ^clojure.lang.ChunkBuffer chunk-buffer [capacity] (clojure.lang.ChunkBuffer. capacity)) (defn chunk-append [^clojure.lang.ChunkBuffer b x] (.add b x)) (defn chunk [^clojure.lang.ChunkBuffer b] (.chunk b)) (defn ^clojure.lang.IChunk chunk-first [^clojure.lang.IChunkedSeq s] (.chunkedFirst s)) (defn ^clojure.lang.ISeq chunk-rest [^clojure.lang.IChunkedSeq s] (.chunkedMore s)) (defn ^clojure.lang.ISeq chunk-next [^clojure.lang.IChunkedSeq s] (.chunkedNext s)) (defn chunk-cons [chunk rest] (if (clojure.lang.Numbers/isZero (clojure.lang.RT/count chunk)) rest (clojure.lang.ChunkedCons. chunk rest))) (defn chunked-seq? [s] (instance? clojure.lang.IChunkedSeq s)) (defn concat "Returns a lazy seq representing the concatenation of the elements in the supplied colls." {:added "1.0"} ([] (lazy-seq nil)) ([x] (lazy-seq x)) ([x y] (lazy-seq (let [s (seq x)] (if s (if (chunked-seq? s) (chunk-cons (chunk-first s) (concat (chunk-rest s) y)) (cons (first s) (concat (rest s) y))) y)))) ([x y & zs] (let [cat (fn cat [xys zs] (lazy-seq (let [xys (seq xys)] (if xys (if (chunked-seq? xys) (chunk-cons (chunk-first xys) (cat (chunk-rest xys) zs)) (cons (first xys) (cat (rest xys) zs))) (when zs (cat (first zs) (next zs)))))))] (cat (concat x y) zs)))) ;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;; (defmacro delay "Takes a body of expressions and yields a Delay object that will invoke the body only the first time it is forced (with force or deref/@), and will cache the result and return it on all subsequent force calls." {:added "1.0"} [& body] (list 'new 'clojure.lang.Delay (list* `^{:once true} fn* [] body))) (defn delay? "returns true if x is a Delay created with delay" {:added "1.0"} [x] (instance? clojure.lang.Delay x)) (defn force "If x is a Delay, returns the (possibly cached) value of its expression, else returns x" {:added "1.0"} [x] (. clojure.lang.Delay (force x))) (defmacro if-not "Evaluates test. If logical false, evaluates and returns then expr, otherwise else expr, if supplied, else nil." {:added "1.0"} ([test then] `(if-not ~test ~then nil)) ([test then else] `(if (not ~test) ~then ~else))) (defn identical? "Tests if 2 arguments are the same object" {:inline (fn [x y] `(. clojure.lang.Util identical ~x ~y)) :inline-arities #{2} :added "1.0"} ([x y] (clojure.lang.Util/identical x y))) (defn = "Equality. Returns true if x equals y, false if not. Same as Java x.equals(y) except it also works for nil, and compares numbers and collections in a type-independent manner. Clojure's immutable data structures define equals() (and thus =) as a value, not an identity, comparison." {:inline (fn [x y] `(. clojure.lang.Util equiv ~x ~y)) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (clojure.lang.Util/equiv x y)) ([x y & more] (if (= x y) (if (next more) (recur y (first more) (next more)) (= y (first more))) false))) (defn not= "Same as (not (= obj1 obj2))" {:tag Boolean :added "1.0"} ([x] false) ([x y] (not (= x y))) ([x y & more] (not (apply = x y more)))) (defn compare "Comparator. Returns a negative number, zero, or a positive number when x is logically 'less than', 'equal to', or 'greater than' y. Same as Java x.compareTo(y) except it also works for nil, and compares numbers and collections in a type-independent manner. x must implement Comparable" { :inline (fn [x y] `(. clojure.lang.Util compare ~x ~y)) :added "1.0"} [x y] (. clojure.lang.Util (compare x y))) (defmacro and "Evaluates exprs one at a time, from left to right. If a form returns logical false (nil or false), and returns that value and doesn't evaluate any of the other expressions, otherwise it returns the value of the last expr. (and) returns true." {:added "1.0"} ([] true) ([x] x) ([x & next] `(let [and# ~x] (if and# (and ~@next) and#)))) (defmacro or "Evaluates exprs one at a time, from left to right. If a form returns a logical true value, or returns that value and doesn't evaluate any of the other expressions, otherwise it returns the value of the last expression. (or) returns nil." {:added "1.0"} ([] nil) ([x] x) ([x & next] `(let [or# ~x] (if or# or# (or ~@next))))) ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; (defn zero? "Returns true if num is zero, else false" { :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (isZero x))) (defn count "Returns the number of items in the collection. (count nil) returns 0. Also works on strings, arrays, and Java Collections and Maps" { :inline (fn [x] `(. clojure.lang.RT (count ~x))) :added "1.0"} [coll] (clojure.lang.RT/count coll)) (defn int "Coerce to int" { :inline (fn [x] `(. clojure.lang.RT (intCast ~x))) :added "1.0"} [x] (. clojure.lang.RT (intCast x))) (defn nth "Returns the value at the index. get returns nil if index out of bounds, nth throws an exception unless not-found is supplied. nth also works for strings, Java arrays, regex Matchers and Lists, and, in O(n) time, for sequences." {:inline (fn [c i & nf] `(. clojure.lang.RT (nth ~c ~i ~@nf))) :inline-arities #{2 3} :added "1.0"} ([coll index] (. clojure.lang.RT (nth coll index))) ([coll index not-found] (. clojure.lang.RT (nth coll index not-found)))) (defn < "Returns non-nil if nums are in monotonically increasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (lt ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (lt x y))) ([x y & more] (if (< x y) (if (next more) (recur y (first more) (next more)) (< y (first more))) false))) (defn inc "Returns a number one greater than num." {:inline (fn [x] `(. clojure.lang.Numbers (inc ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (inc x))) ;; reduce is defined again later after InternalReduce loads (def ^{:arglists '([f coll] [f val coll]) :doc "f should be a function of 2 arguments. If val is not supplied, returns the result of applying f to the first 2 items in coll, then applying f to that result and the 3rd item, etc. If coll contains no items, f must accept no arguments as well, and reduce returns the result of calling f with no arguments. If coll has only 1 item, it is returned and f is not called. If val is supplied, returns the result of applying f to val and the first item in coll, then applying f to that result and the 2nd item, etc. If coll contains no items, returns val and f is not called." :added "1.0"} reduce (fn r ([f coll] (let [s (seq coll)] (if s (r f (first s) (next s)) (f)))) ([f val coll] (let [s (seq coll)] (if s (if (chunked-seq? s) (recur f (.reduce (chunk-first s) f val) (chunk-next s)) (recur f (f val (first s)) (next s))) val))))) (defn reverse "Returns a seq of the items in coll in reverse order. Not lazy." {:added "1.0"} [coll] (reduce conj () coll)) ;;math stuff (defn + "Returns the sum of nums. (+) returns 0." {:inline (fn [x y] `(. clojure.lang.Numbers (add ~x ~y))) :inline-arities #{2} :added "1.0"} ([] 0) ([x] (cast Number x)) ([x y] (. clojure.lang.Numbers (add x y))) ([x y & more] (reduce + (+ x y) more))) (defn * "Returns the product of nums. (*) returns 1." {:inline (fn [x y] `(. clojure.lang.Numbers (multiply ~x ~y))) :inline-arities #{2} :added "1.0"} ([] 1) ([x] (cast Number x)) ([x y] (. clojure.lang.Numbers (multiply x y))) ([x y & more] (reduce * (* x y) more))) (defn / "If no denominators are supplied, returns 1/numerator, else returns numerator divided by all of the denominators." {:inline (fn [x y] `(. clojure.lang.Numbers (divide ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] (/ 1 x)) ([x y] (. clojure.lang.Numbers (divide x y))) ([x y & more] (reduce / (/ x y) more))) (defn - "If no ys are supplied, returns the negation of x, else subtracts the ys from x and returns the result." {:inline (fn [& args] `(. clojure.lang.Numbers (minus ~@args))) :inline-arities #{1 2} :added "1.0"} ([x] (. clojure.lang.Numbers (minus x))) ([x y] (. clojure.lang.Numbers (minus x y))) ([x y & more] (reduce - (- x y) more))) (defn <= "Returns non-nil if nums are in monotonically non-decreasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (lte ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (lte x y))) ([x y & more] (if (<= x y) (if (next more) (recur y (first more) (next more)) (<= y (first more))) false))) (defn > "Returns non-nil if nums are in monotonically decreasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (gt ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (gt x y))) ([x y & more] (if (> x y) (if (next more) (recur y (first more) (next more)) (> y (first more))) false))) (defn >= "Returns non-nil if nums are in monotonically non-increasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (gte ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (gte x y))) ([x y & more] (if (>= x y) (if (next more) (recur y (first more) (next more)) (>= y (first more))) false))) (defn == "Returns non-nil if nums all have the same value, otherwise false" {:inline (fn [x y] `(. clojure.lang.Numbers (equiv ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (equiv x y))) ([x y & more] (if (== x y) (if (next more) (recur y (first more) (next more)) (== y (first more))) false))) (defn max "Returns the greatest of the nums." {:added "1.0"} ([x] x) ([x y] (if (> x y) x y)) ([x y & more] (reduce max (max x y) more))) (defn min "Returns the least of the nums." {:added "1.0"} ([x] x) ([x y] (if (< x y) x y)) ([x y & more] (reduce min (min x y) more))) (defn dec "Returns a number one less than num." {:inline (fn [x] `(. clojure.lang.Numbers (dec ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (dec x))) (defn unchecked-inc "Returns a number one greater than x, an int or long. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_inc x))) (defn unchecked-dec "Returns a number one less than x, an int or long. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_dec x))) (defn unchecked-negate "Returns the negation of x, an int or long. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_negate ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_negate x))) (defn unchecked-add "Returns the sum of x and y, both int or long. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_add x y))) (defn unchecked-subtract "Returns the difference of x and y, both int or long. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_subtract ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_subtract x y))) (defn unchecked-multiply "Returns the product of x and y, both int or long. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_multiply x y))) (defn unchecked-divide "Returns the division of x by y, both int or long. Note - uses a primitive operator subject to truncation." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_divide ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_divide x y))) (defn unchecked-remainder "Returns the remainder of division of x by y, both int or long. Note - uses a primitive operator subject to truncation." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_remainder ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_remainder x y))) (defn pos? "Returns true if num is greater than zero, else false" { :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (isPos x))) (defn neg? "Returns true if num is less than zero, else false" { :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (isNeg x))) (defn quot "quot[ient] of dividing numerator by denominator." {:added "1.0"} [num div] (. clojure.lang.Numbers (quotient num div))) (defn rem "remainder of dividing numerator by denominator." {:added "1.0"} [num div] (. clojure.lang.Numbers (remainder num div))) (defn rationalize "returns the rational value of num" {:added "1.0"} [num] (. clojure.lang.Numbers (rationalize num))) ;;Bit ops (defn bit-not "Bitwise complement" {:inline (fn [x] `(. clojure.lang.Numbers (not ~x))) :added "1.0"} [x] (. clojure.lang.Numbers not x)) (defn bit-and "Bitwise and" {:inline (fn [x y] `(. clojure.lang.Numbers (and ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers and x y)) (defn bit-or "Bitwise or" {:inline (fn [x y] `(. clojure.lang.Numbers (or ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers or x y)) (defn bit-xor "Bitwise exclusive or" {:inline (fn [x y] `(. clojure.lang.Numbers (xor ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers xor x y)) (defn bit-and-not "Bitwise and with complement" {:added "1.0"} [x y] (. clojure.lang.Numbers andNot x y)) (defn bit-clear "Clear bit at index n" {:added "1.0"} [x n] (. clojure.lang.Numbers clearBit x n)) (defn bit-set "Set bit at index n" {:added "1.0"} [x n] (. clojure.lang.Numbers setBit x n)) (defn bit-flip "Flip bit at index n" {:added "1.0"} [x n] (. clojure.lang.Numbers flipBit x n)) (defn bit-test "Test bit at index n" {:added "1.0"} [x n] (. clojure.lang.Numbers testBit x n)) (defn bit-shift-left "Bitwise shift left" {:inline (fn [x n] `(. clojure.lang.Numbers (shiftLeft ~x ~n))) :added "1.0"} [x n] (. clojure.lang.Numbers shiftLeft x n)) (defn bit-shift-right "Bitwise shift right" {:inline (fn [x n] `(. clojure.lang.Numbers (shiftRight ~x ~n))) :added "1.0"} [x n] (. clojure.lang.Numbers shiftRight x n)) (defn even? "Returns true if n is even, throws an exception if n is not an integer" {:added "1.0"} [n] (zero? (bit-and n 1))) (defn odd? "Returns true if n is odd, throws an exception if n is not an integer" {:added "1.0"} [n] (not (even? n))) ;; (defn complement "Takes a fn f and returns a fn that takes the same arguments as f, has the same effects, if any, and returns the opposite truth value." {:added "1.0"} [f] (fn ([] (not (f))) ([x] (not (f x))) ([x y] (not (f x y))) ([x y & zs] (not (apply f x y zs))))) (defn constantly "Returns a function that takes any number of arguments and returns x." {:added "1.0"} [x] (fn [& args] x)) (defn identity "Returns its argument." {:added "1.0"} [x] x) ;;Collection stuff ;;list stuff (defn peek "For a list or queue, same as first, for a vector, same as, but much more efficient than, last. If the collection is empty, returns nil." {:added "1.0"} [coll] (. clojure.lang.RT (peek coll))) (defn pop "For a list or queue, returns a new list/queue without the first item, for a vector, returns a new vector without the last item. If the collection is empty, throws an exception. Note - not the same as next/butlast." {:added "1.0"} [coll] (. clojure.lang.RT (pop coll))) ;;map stuff (defn contains? "Returns true if key is present in the given collection, otherwise returns false. Note that for numerically indexed collections like vectors and Java arrays, this tests if the numeric key is within the range of indexes. 'contains?' operates constant or logarithmic time; it will not perform a linear search for a value. See also 'some'." {:added "1.0"} [coll key] (. clojure.lang.RT (contains coll key))) (defn get "Returns the value mapped to key, not-found or nil if key not present." {:inline (fn [m k & nf] `(. clojure.lang.RT (get ~m ~k ~@nf))) :inline-arities #{2 3} :added "1.0"} ([map key] (. clojure.lang.RT (get map key))) ([map key not-found] (. clojure.lang.RT (get map key not-found)))) (defn dissoc "dissoc[iate]. Returns a new map of the same (hashed/sorted) type, that does not contain a mapping for key(s)." {:added "1.0"} ([map] map) ([map key] (. clojure.lang.RT (dissoc map key))) ([map key & ks] (let [ret (dissoc map key)] (if ks (recur ret (first ks) (next ks)) ret)))) (defn disj "disj[oin]. Returns a new set of the same (hashed/sorted) type, that does not contain key(s)." {:added "1.0"} ([set] set) ([^clojure.lang.IPersistentSet set key] (when set (. set (disjoin key)))) ([set key & ks] (when set (let [ret (disj set key)] (if ks (recur ret (first ks) (next ks)) ret))))) (defn find "Returns the map entry for key, or nil if key not present." {:added "1.0"} [map key] (. clojure.lang.RT (find map key))) (defn select-keys "Returns a map containing only those entries in map whose key is in keys" {:added "1.0"} [map keyseq] (loop [ret {} keys (seq keyseq)] (if keys (let [entry (. clojure.lang.RT (find map (first keys)))] (recur (if entry (conj ret entry) ret) (next keys))) ret))) (defn keys "Returns a sequence of the map's keys." {:added "1.0"} [map] (. clojure.lang.RT (keys map))) (defn vals "Returns a sequence of the map's values." {:added "1.0"} [map] (. clojure.lang.RT (vals map))) (defn key "Returns the key of the map entry." {:added "1.0"} [^java.util.Map$Entry e] (. e (getKey))) (defn val "Returns the value in the map entry." {:added "1.0"} [^java.util.Map$Entry e] (. e (getValue))) (defn rseq "Returns, in constant time, a seq of the items in rev (which can be a vector or sorted-map), in reverse order. If rev is empty returns nil" {:added "1.0"} [^clojure.lang.Reversible rev] (. rev (rseq))) (defn name "Returns the name String of a string, symbol or keyword." {:tag String :added "1.0"} [^clojure.lang.Named x] (if (string? x) x (. x (getName)))) (defn namespace "Returns the namespace String of a symbol or keyword, or nil if not present." {:tag String :added "1.0"} [^clojure.lang.Named x] (. x (getNamespace))) (defmacro locking "Executes exprs in an implicit do, while holding the monitor of x. Will release the monitor of x in all circumstances." {:added "1.0"} [x & body] `(let [lockee# ~x] (try (monitor-enter lockee#) ~@body (finally (monitor-exit lockee#))))) (defmacro .. "form => fieldName-symbol or (instanceMethodName-symbol args*) Expands into a member access (.) of the first member on the first argument, followed by the next member on the result, etc. For instance: (.. System (getProperties) (get \"os.name\")) expands to: (. (. System (getProperties)) (get \"os.name\")) but is easier to write, read, and understand." {:added "1.0"} ([x form] `(. ~x ~form)) ([x form & more] `(.. (. ~x ~form) ~@more))) (defmacro -> "Threads the expr through the forms. Inserts x as the second item in the first form, making a list of it if it is not a list already. If there are more forms, inserts the first form as the second item in second form, etc." {:added "1.0"} ([x] x) ([x form] (if (seq? form) (with-meta `(~(first form) ~x ~@(next form)) (meta form)) (list form x))) ([x form & more] `(-> (-> ~x ~form) ~@more))) (defmacro ->> "Threads the expr through the forms. Inserts x as the last item in the first form, making a list of it if it is not a list already. If there are more forms, inserts the first form as the last item in second form, etc." {:added "1.1"} ([x form] (if (seq? form) (with-meta `(~(first form) ~@(next form) ~x) (meta form)) (list form x))) ([x form & more] `(->> (->> ~x ~form) ~@more))) ;;multimethods (def global-hierarchy) (defmacro defmulti "Creates a new multimethod with the associated dispatch function. The docstring and attribute-map are optional. Options are key-value pairs and may be one of: :default the default dispatch value, defaults to :default :hierarchy the isa? hierarchy to use for dispatching defaults to the global hierarchy" {:arglists '([name docstring? attr-map? dispatch-fn & options]) :added "1.0"} [mm-name & options] (let [docstring (if (string? (first options)) (first options) nil) options (if (string? (first options)) (next options) options) m (if (map? (first options)) (first options) {}) options (if (map? (first options)) (next options) options) dispatch-fn (first options) options (next options) m (assoc m :tag 'clojure.lang.MultiFn) m (if docstring (assoc m :doc docstring) m) m (if (meta mm-name) (conj (meta mm-name) m) m)] (when (= (count options) 1) (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))) (let [options (apply hash-map options) default (get options :default :default) hierarchy (get options :hierarchy #'global-hierarchy)] `(let [v# (def ~mm-name)] (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#))) (def ~(with-meta mm-name m) (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy))))))) (defmacro defmethod "Creates and installs a new method of multimethod associated with dispatch-value. " {:added "1.0"} [multifn dispatch-val & fn-tail] `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail))) (defn remove-all-methods "Removes all of the methods of multimethod." {:added "1.2"} [^clojure.lang.MultiFn multifn] (.reset multifn)) (defn remove-method "Removes the method of multimethod associated with dispatch-value." {:added "1.0"} [^clojure.lang.MultiFn multifn dispatch-val] (. multifn removeMethod dispatch-val)) (defn prefer-method "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y when there is a conflict" {:added "1.0"} [^clojure.lang.MultiFn multifn dispatch-val-x dispatch-val-y] (. multifn preferMethod dispatch-val-x dispatch-val-y)) (defn methods "Given a multimethod, returns a map of dispatch values -> dispatch fns" {:added "1.0"} [^clojure.lang.MultiFn multifn] (.getMethodTable multifn)) (defn get-method "Given a multimethod and a dispatch value, returns the dispatch fn that would apply to that value, or nil if none apply and no default" {:added "1.0"} [^clojure.lang.MultiFn multifn dispatch-val] (.getMethod multifn dispatch-val)) (defn prefers "Given a multimethod, returns a map of preferred value -> set of other values" {:added "1.0"} [^clojure.lang.MultiFn multifn] (.getPreferTable multifn)) ;;;;;;;;; var stuff (defmacro ^{:private true} assert-args [fnname & pairs] `(do (when-not ~(first pairs) (throw (IllegalArgumentException. ~(str fnname " requires " (second pairs))))) ~(let [more (nnext pairs)] (when more (list* `assert-args fnname more))))) (defmacro if-let "bindings => binding-form test If test is true, evaluates then with binding-form bound to the value of test, if not, yields else" {:added "1.0"} ([bindings then] `(if-let ~bindings ~then nil)) ([bindings then else & oldform] (assert-args if-let (and (vector? bindings) (nil? oldform)) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [form (bindings 0) tst (bindings 1)] `(let [temp# ~tst] (if temp# (let [~form temp#] ~then) ~else))))) (defmacro when-let "bindings => binding-form test When test is true, evaluates body with binding-form bound to the value of test" {:added "1.0"} [bindings & body] (assert-args when-let (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [form (bindings 0) tst (bindings 1)] `(let [temp# ~tst] (when temp# (let [~form temp#] ~@body))))) (defn push-thread-bindings "WARNING: This is a low-level function. Prefer high-level macros like binding where ever possible. Takes a map of Var/value pairs. Binds each Var to the associated value for the current thread. Each call *MUST* be accompanied by a matching call to pop-thread-bindings wrapped in a try-finally! (push-thread-bindings bindings) (try ... (finally (pop-thread-bindings)))" {:added "1.1"} [bindings] (clojure.lang.Var/pushThreadBindings bindings)) (defn pop-thread-bindings "Pop one set of bindings pushed with push-binding before. It is an error to pop bindings without pushing before." {:added "1.1"} [] (clojure.lang.Var/popThreadBindings)) (defn get-thread-bindings "Get a map with the Var/value pairs which is currently in effect for the current thread." {:added "1.1"} [] (clojure.lang.Var/getThreadBindings)) (defmacro binding "binding => var-symbol init-expr Creates new bindings for the (already-existing) vars, with the supplied initial values, executes the exprs in an implicit do, then re-establishes the bindings that existed before. The new bindings are made in parallel (unlike let); all init-exprs are evaluated before the vars are bound to their new values." {:added "1.0"} [bindings & body] (assert-args binding (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (let [var-ize (fn [var-vals] (loop [ret [] vvs (seq var-vals)] (if vvs (recur (conj (conj ret `(var ~(first vvs))) (second vvs)) (next (next vvs))) (seq ret))))] `(let [] (push-thread-bindings (hash-map ~@(var-ize bindings))) (try ~@body (finally (pop-thread-bindings)))))) (defn with-bindings* "Takes a map of Var/value pairs. Installs for the given Vars the associated values as thread-local bindings. Then calls f with the supplied arguments. Pops the installed bindings after f returned. Returns whatever f returns." {:added "1.1"} [binding-map f & args] (push-thread-bindings binding-map) (try (apply f args) (finally (pop-thread-bindings)))) (defmacro with-bindings "Takes a map of Var/value pairs. Installs for the given Vars the associated values as thread-local bindings. The executes body. Pops the installed bindings after body was evaluated. Returns the value of body." {:added "1.1"} [binding-map & body] `(with-bindings* ~binding-map (fn [] ~@body))) (defn bound-fn* "Returns a function, which will install the same bindings in effect as in the thread at the time bound-fn* was called and then call f with any given arguments. This may be used to define a helper function which runs on a different thread, but needs the same bindings in place." {:added "1.1"} [f] (let [bindings (get-thread-bindings)] (fn [& args] (apply with-bindings* bindings f args)))) (defmacro bound-fn "Returns a function defined by the given fntail, which will install the same bindings in effect as in the thread at the time bound-fn was called. This may be used to define a helper function which runs on a different thread, but needs the same bindings in place." {:added "1.1"} [& fntail] `(bound-fn* (fn ~@fntail))) (defn find-var "Returns the global var named by the namespace-qualified symbol, or nil if no var with that name." {:added "1.0"} [sym] (. clojure.lang.Var (find sym))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Refs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn ^{:private true} setup-reference [^clojure.lang.ARef r options] (let [opts (apply hash-map options)] (when (:meta opts) (.resetMeta r (:meta opts))) (when (:validator opts) (.setValidator r (:validator opts))) r)) (defn agent "Creates and returns an agent with an initial value of state and zero or more options (in any order): :meta metadata-map :validator validate-fn :error-handler handler-fn :error-mode mode-keyword If metadata-map is supplied, it will be come the metadata on the agent. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception. handler-fn is called if an action throws an exception or if validate-fn rejects a new state -- see set-error-handler! for details. The mode-keyword may be either :continue (the default if an error-handler is given) or :fail (the default if no error-handler is given) -- see set-error-mode! for details." {:added "1.0"} ([state & options] (let [a (new clojure.lang.Agent state) opts (apply hash-map options)] (setup-reference a options) (when (:error-handler opts) (.setErrorHandler a (:error-handler opts))) (.setErrorMode a (or (:error-mode opts) (if (:error-handler opts) :continue :fail))) a))) (defn send "Dispatch an action to an agent. Returns the agent immediately. Subsequently, in a thread from a thread pool, the state of the agent will be set to the value of: (apply action-fn state-of-agent args)" {:added "1.0"} [^clojure.lang.Agent a f & args] (. a (dispatch f args false))) (defn send-off "Dispatch a potentially blocking action to an agent. Returns the agent immediately. Subsequently, in a separate thread, the state of the agent will be set to the value of: (apply action-fn state-of-agent args)" {:added "1.0"} [^clojure.lang.Agent a f & args] (. a (dispatch f args true))) (defn release-pending-sends "Normally, actions sent directly or indirectly during another action are held until the action completes (changes the agent's state). This function can be used to dispatch any pending sent actions immediately. This has no impact on actions sent during a transaction, which are still held until commit. If no action is occurring, does nothing. Returns the number of actions dispatched." {:added "1.0"} [] (clojure.lang.Agent/releasePendingSends)) (defn add-watch "Alpha - subject to change. Adds a watch function to an agent/atom/var/ref reference. The watch fn must be a fn of 4 args: a key, the reference, its old-state, its new-state. Whenever the reference's state might have been changed, any registered watches will have their functions called. The watch fn will be called synchronously, on the agent's thread if an agent, before any pending sends if agent or ref. Note that an atom's or ref's state may have changed again prior to the fn call, so use old/new-state rather than derefing the reference. Note also that watch fns may be called from multiple threads simultaneously. Var watchers are triggered only by root binding changes, not thread-local set!s. Keys must be unique per reference, and can be used to remove the watch with remove-watch, but are otherwise considered opaque by the watch mechanism." {:added "1.0"} [^clojure.lang.IRef reference key fn] (.addWatch reference key fn)) (defn remove-watch "Alpha - subject to change. Removes a watch (set by add-watch) from a reference" {:added "1.0"} [^clojure.lang.IRef reference key] (.removeWatch reference key)) (defn agent-error "Returns the exception thrown during an asynchronous action of the agent if the agent is failed. Returns nil if the agent is not failed." {:added "1.2"} [^clojure.lang.Agent a] (.getError a)) (defn restart-agent "When an agent is failed, changes the agent state to new-state and then un-fails the agent so that sends are allowed again. If a :clear-actions true option is given, any actions queued on the agent that were being held while it was failed will be discarded, otherwise those held actions will proceed. The new-state must pass the validator if any, or restart will throw an exception and the agent will remain failed with its old state and error. Watchers, if any, will NOT be notified of the new state. Throws an exception if the agent is not failed." {:added "1.2"} [^clojure.lang.Agent a, new-state & options] (let [opts (apply hash-map options)] (.restart a new-state (if (:clear-actions opts) true false)))) (defn set-error-handler! "Sets the error-handler of agent a to handler-fn. If an action being run by the agent throws an exception or doesn't pass the validator fn, handler-fn will be called with two arguments: the agent and the exception." {:added "1.2"} [^clojure.lang.Agent a, handler-fn] (.setErrorHandler a handler-fn)) (defn error-handler "Returns the error-handler of agent a, or nil if there is none. See set-error-handler!" {:added "1.2"} [^clojure.lang.Agent a] (.getErrorHandler a)) (defn set-error-mode! "Sets the error-mode of agent a to mode-keyword, which must be either :fail or :continue. If an action being run by the agent throws an exception or doesn't pass the validator fn, an error-handler may be called (see set-error-handler!), after which, if the mode is :continue, the agent will continue as if neither the action that caused the error nor the error itself ever happened. If the mode is :fail, the agent will become failed and will stop accepting new 'send' and 'send-off' actions, and any previously queued actions will be held until a 'restart-agent'. Deref will still work, returning the state of the agent before the error." {:added "1.2"} [^clojure.lang.Agent a, mode-keyword] (.setErrorMode a mode-keyword)) (defn error-mode "Returns the error-mode of agent a. See set-error-mode!" {:added "1.2"} [^clojure.lang.Agent a] (.getErrorMode a)) (defn agent-errors "DEPRECATED: Use 'agent-error' instead. Returns a sequence of the exceptions thrown during asynchronous actions of the agent." {:added "1.0" :deprecated "1.2"} [a] (when-let [e (agent-error a)] (list e))) (defn clear-agent-errors "DEPRECATED: Use 'restart-agent' instead. Clears any exceptions thrown during asynchronous actions of the agent, allowing subsequent actions to occur." {:added "1.0" :deprecated "1.2"} [^clojure.lang.Agent a] (restart-agent a (.deref a))) (defn shutdown-agents "Initiates a shutdown of the thread pools that back the agent system. Running actions will complete, but no new actions will be accepted" {:added "1.0"} [] (. clojure.lang.Agent shutdown)) (defn ref "Creates and returns a Ref with an initial value of x and zero or more options (in any order): :meta metadata-map :validator validate-fn :min-history (default 0) :max-history (default 10) If metadata-map is supplied, it will be come the metadata on the ref. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception. validate-fn will be called on transaction commit, when all refs have their final values. Normally refs accumulate history dynamically as needed to deal with read demands. If you know in advance you will need history you can set :min-history to ensure it will be available when first needed (instead of after a read fault). History is limited, and the limit can be set with :max-history." {:added "1.0"} ([x] (new clojure.lang.Ref x)) ([x & options] (let [r ^clojure.lang.Ref (setup-reference (ref x) options) opts (apply hash-map options)] (when (:max-history opts) (.setMaxHistory r (:max-history opts))) (when (:min-history opts) (.setMinHistory r (:min-history opts))) r))) (defn deref "Also reader macro: @ref/@agent/@var/@atom/@delay/@future. Within a transaction, returns the in-transaction-value of ref, else returns the most-recently-committed value of ref. When applied to a var, agent or atom, returns its current state. When applied to a delay, forces it if not already forced. When applied to a future, will block if computation not complete" {:added "1.0"} [^clojure.lang.IDeref ref] (.deref ref)) (defn atom "Creates and returns an Atom with an initial value of x and zero or more options (in any order): :meta metadata-map :validator validate-fn If metadata-map is supplied, it will be come the metadata on the atom. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception." {:added "1.0"} ([x] (new clojure.lang.Atom x)) ([x & options] (setup-reference (atom x) options))) (defn swap! "Atomically swaps the value of atom to be: (apply f current-value-of-atom args). Note that f may be called multiple times, and thus should be free of side effects. Returns the value that was swapped in." {:added "1.0"} ([^clojure.lang.Atom atom f] (.swap atom f)) ([^clojure.lang.Atom atom f x] (.swap atom f x)) ([^clojure.lang.Atom atom f x y] (.swap atom f x y)) ([^clojure.lang.Atom atom f x y & args] (.swap atom f x y args))) (defn compare-and-set! "Atomically sets the value of atom to newval if and only if the current value of the atom is identical to oldval. Returns true if set happened, else false" {:added "1.0"} [^clojure.lang.Atom atom oldval newval] (.compareAndSet atom oldval newval)) (defn reset! "Sets the value of atom to newval without regard for the current value. Returns newval." {:added "1.0"} [^clojure.lang.Atom atom newval] (.reset atom newval)) (defn set-validator! "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validator-fn should return false or throw an exception. If the current state (root value if var) is not acceptable to the new validator, an exception will be thrown and the validator will not be changed." {:added "1.0"} [^clojure.lang.IRef iref validator-fn] (. iref (setValidator validator-fn))) (defn get-validator "Gets the validator-fn for a var/ref/agent/atom." {:added "1.0"} [^clojure.lang.IRef iref] (. iref (getValidator))) (defn alter-meta! "Atomically sets the metadata for a namespace/var/ref/agent/atom to be: (apply f its-current-meta args) f must be free of side-effects" {:added "1.0"} [^clojure.lang.IReference iref f & args] (.alterMeta iref f args)) (defn reset-meta! "Atomically resets the metadata for a namespace/var/ref/agent/atom" {:added "1.0"} [^clojure.lang.IReference iref metadata-map] (.resetMeta iref metadata-map)) (defn commute "Must be called in a transaction. Sets the in-transaction-value of ref to: (apply fun in-transaction-value-of-ref args) and returns the in-transaction-value of ref. At the commit point of the transaction, sets the value of ref to be: (apply fun most-recently-committed-value-of-ref args) Thus fun should be commutative, or, failing that, you must accept last-one-in-wins behavior. commute allows for more concurrency than ref-set." {:added "1.0"} [^clojure.lang.Ref ref fun & args] (. ref (commute fun args))) (defn alter "Must be called in a transaction. Sets the in-transaction-value of ref to: (apply fun in-transaction-value-of-ref args) and returns the in-transaction-value of ref." {:added "1.0"} [^clojure.lang.Ref ref fun & args] (. ref (alter fun args))) (defn ref-set "Must be called in a transaction. Sets the value of ref. Returns val." {:added "1.0"} [^clojure.lang.Ref ref val] (. ref (set val))) (defn ref-history-count "Returns the history count of a ref" {:added "1.1"} [^clojure.lang.Ref ref] (.getHistoryCount ref)) (defn ref-min-history "Gets the min-history of a ref, or sets it and returns the ref" {:added "1.1"} ([^clojure.lang.Ref ref] (.getMinHistory ref)) ([^clojure.lang.Ref ref n] (.setMinHistory ref n))) (defn ref-max-history "Gets the max-history of a ref, or sets it and returns the ref" {:added "1.1"} ([^clojure.lang.Ref ref] (.getMaxHistory ref)) ([^clojure.lang.Ref ref n] (.setMaxHistory ref n))) (defn ensure "Must be called in a transaction. Protects the ref from modification by other transactions. Returns the in-transaction-value of ref. Allows for more concurrency than (ref-set ref @ref)" {:added "1.0"} [^clojure.lang.Ref ref] (. ref (touch)) (. ref (deref))) (defmacro sync "transaction-flags => TBD, pass nil for now Runs the exprs (in an implicit do) in a transaction that encompasses exprs and any nested calls. Starts a transaction if none is already running on this thread. Any uncaught exception will abort the transaction and flow out of sync. The exprs may be run more than once, but any effects on Refs will be atomic." {:added "1.0"} [flags-ignored-for-now & body] `(. clojure.lang.LockingTransaction (runInTransaction (fn [] ~@body)))) (defmacro io! "If an io! block occurs in a transaction, throws an IllegalStateException, else runs body in an implicit do. If the first expression in body is a literal string, will use that as the exception message." {:added "1.0"} [& body] (let [message (when (string? (first body)) (first body)) body (if message (next body) body)] `(if (clojure.lang.LockingTransaction/isRunning) (throw (new IllegalStateException ~(or message "I/O in transaction"))) (do ~@body)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn stuff ;;;;;;;;;;;;;;;; (defn comp "Takes a set of functions and returns a fn that is the composition of those fns. The returned fn takes a variable number of args, applies the rightmost of fns to the args, the next fn (right-to-left) to the result, etc." {:added "1.0"} ([f] f) ([f g] (fn ([] (f (g))) ([x] (f (g x))) ([x y] (f (g x y))) ([x y z] (f (g x y z))) ([x y z & args] (f (apply g x y z args))))) ([f g h] (fn ([] (f (g (h)))) ([x] (f (g (h x)))) ([x y] (f (g (h x y)))) ([x y z] (f (g (h x y z)))) ([x y z & args] (f (g (apply h x y z args)))))) ([f1 f2 f3 & fs] (let [fs (reverse (list* f1 f2 f3 fs))] (fn [& args] (loop [ret (apply (first fs) args) fs (next fs)] (if fs (recur ((first fs) ret) (next fs)) ret)))))) (defn juxt "Alpha - name subject to change. Takes a set of functions and returns a fn that is the juxtaposition of those fns. The returned fn takes a variable number of args, and returns a vector containing the result of applying each fn to the args (left-to-right). ((juxt a b c) x) => [(a x) (b x) (c x)]" {:added "1.1"} ([f] (fn ([] [(f)]) ([x] [(f x)]) ([x y] [(f x y)]) ([x y z] [(f x y z)]) ([x y z & args] [(apply f x y z args)]))) ([f g] (fn ([] [(f) (g)]) ([x] [(f x) (g x)]) ([x y] [(f x y) (g x y)]) ([x y z] [(f x y z) (g x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args)]))) ([f g h] (fn ([] [(f) (g) (h)]) ([x] [(f x) (g x) (h x)]) ([x y] [(f x y) (g x y) (h x y)]) ([x y z] [(f x y z) (g x y z) (h x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)]))) ([f g h & fs] (let [fs (list* f g h fs)] (fn ([] (reduce #(conj %1 (%2)) [] fs)) ([x] (reduce #(conj %1 (%2 x)) [] fs)) ([x y] (reduce #(conj %1 (%2 x y)) [] fs)) ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs)) ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs)))))) (defn partial "Takes a function f and fewer than the normal arguments to f, and returns a fn that takes a variable number of additional args. When called, the returned function calls f with args + additional args." {:added "1.0"} ([f arg1] (fn [& args] (apply f arg1 args))) ([f arg1 arg2] (fn [& args] (apply f arg1 arg2 args))) ([f arg1 arg2 arg3] (fn [& args] (apply f arg1 arg2 arg3 args))) ([f arg1 arg2 arg3 & more] (fn [& args] (apply f arg1 arg2 arg3 (concat more args))))) ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; (defn sequence "Coerces coll to a (possibly empty) sequence, if it is not already one. Will not force a lazy seq. (sequence nil) yields ()" {:added "1.0"} [coll] (if (seq? coll) coll (or (seq coll) ()))) (defn every? "Returns true if (pred x) is logical true for every x in coll, else false." {:tag Boolean :added "1.0"} [pred coll] (cond (nil? (seq coll)) true (pred (first coll)) (recur pred (next coll)) :else false)) (def ^{:tag Boolean :doc "Returns false if (pred x) is logical true for every x in coll, else true." :arglists '([pred coll]) :added "1.0"} not-every? (comp not every?)) (defn some "Returns the first logical true value of (pred x) for any x in coll, else nil. One common idiom is to use a set as pred, for example this will return :fred if :fred is in the sequence, otherwise nil: (some #{:fred} coll)" {:added "1.0"} [pred coll] (when (seq coll) (or (pred (first coll)) (recur pred (next coll))))) (def ^{:tag Boolean :doc "Returns false if (pred x) is logical true for any x in coll, else true." :arglists '([pred coll]) :added "1.0"} not-any? (comp not some)) ;will be redefed later with arg checks (defmacro dotimes "bindings => name n Repeatedly executes body (presumably for side-effects) with name bound to integers from 0 through n-1." {:added "1.0"} [bindings & body] (let [i (first bindings) n (second bindings)] `(let [n# (int ~n)] (loop [~i (int 0)] (when (< ~i n#) ~@body (recur (inc ~i))))))) (defn map "Returns a lazy sequence consisting of the result of applying f to the set of first items of each coll, followed by applying f to the set of second items in each coll, until any one of the colls is exhausted. Any remaining items in other colls are ignored. Function f should accept number-of-colls arguments." {:added "1.0"} ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (int (count c)) b (chunk-buffer size)] (dotimes [i size] (chunk-append b (f (.nth c i)))) (chunk-cons (chunk b) (map f (chunk-rest s)))) (cons (f (first s)) (map f (rest s))))))) ([f c1 c2] (lazy-seq (let [s1 (seq c1) s2 (seq c2)] (when (and s1 s2) (cons (f (first s1) (first s2)) (map f (rest s1) (rest s2))))))) ([f c1 c2 c3] (lazy-seq (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] (when (and s1 s2 s3) (cons (f (first s1) (first s2) (first s3)) (map f (rest s1) (rest s2) (rest s3))))))) ([f c1 c2 c3 & colls] (let [step (fn step [cs] (lazy-seq (let [ss (map seq cs)] (when (every? identity ss) (cons (map first ss) (step (map rest ss)))))))] (map #(apply f %) (step (conj colls c3 c2 c1)))))) (defn mapcat "Returns the result of applying concat to the result of applying map to f and colls. Thus function f should return a collection." {:added "1.0"} [f & colls] (apply concat (apply map f colls))) (defn filter "Returns a lazy sequence of the items in coll for which (pred item) returns true. pred must be free of side-effects." {:added "1.0"} ([pred coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (when (pred (.nth c i)) (chunk-append b (.nth c i)))) (chunk-cons (chunk b) (filter pred (chunk-rest s)))) (let [f (first s) r (rest s)] (if (pred f) (cons f (filter pred r)) (filter pred r)))))))) (defn remove "Returns a lazy sequence of the items in coll for which (pred item) returns false. pred must be free of side-effects." {:added "1.0"} [pred coll] (filter (complement pred) coll)) (defn take "Returns a lazy sequence of the first n items in coll, or all items if there are fewer than n." {:added "1.0"} [n coll] (lazy-seq (when (pos? n) (when-let [s (seq coll)] (cons (first s) (take (dec n) (rest s))))))) (defn take-while "Returns a lazy sequence of successive items from coll while (pred item) returns true. pred must be free of side-effects." {:added "1.0"} [pred coll] (lazy-seq (when-let [s (seq coll)] (when (pred (first s)) (cons (first s) (take-while pred (rest s))))))) (defn drop "Returns a lazy sequence of all but the first n items in coll." {:added "1.0"} [n coll] (let [step (fn [n coll] (let [s (seq coll)] (if (and (pos? n) s) (recur (dec n) (rest s)) s)))] (lazy-seq (step n coll)))) (defn drop-last "Return a lazy sequence of all but the last n (default 1) items in coll" {:added "1.0"} ([s] (drop-last 1 s)) ([n s] (map (fn [x _] x) s (drop n s)))) (defn take-last "Returns a seq of the last n items in coll. Depending on the type of coll may be no better than linear time. For vectors, see also subvec." {:added "1.1"} [n coll] (loop [s (seq coll), lead (seq (drop n coll))] (if lead (recur (next s) (next lead)) s))) (defn drop-while "Returns a lazy sequence of the items in coll starting from the first item for which (pred item) returns nil." {:added "1.0"} [pred coll] (let [step (fn [pred coll] (let [s (seq coll)] (if (and s (pred (first s))) (recur pred (rest s)) s)))] (lazy-seq (step pred coll)))) (defn cycle "Returns a lazy (infinite!) sequence of repetitions of the items in coll." {:added "1.0"} [coll] (lazy-seq (when-let [s (seq coll)] (concat s (cycle s))))) (defn split-at "Returns a vector of [(take n coll) (drop n coll)]" {:added "1.0"} [n coll] [(take n coll) (drop n coll)]) (defn split-with "Returns a vector of [(take-while pred coll) (drop-while pred coll)]" {:added "1.0"} [pred coll] [(take-while pred coll) (drop-while pred coll)]) (defn repeat "Returns a lazy (infinite!, or length n if supplied) sequence of xs." {:added "1.0"} ([x] (lazy-seq (cons x (repeat x)))) ([n x] (take n (repeat x)))) (defn replicate "Returns a lazy seq of n xs." {:added "1.0"} [n x] (take n (repeat x))) (defn iterate "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects" {:added "1.0"} [f x] (cons x (lazy-seq (iterate f (f x))))) (defn range "Returns a lazy seq of nums from start (inclusive) to end (exclusive), by step, where start defaults to 0, step to 1, and end to infinity." {:added "1.0"} ([] (range 0 Double/POSITIVE_INFINITY 1)) ([end] (range 0 end 1)) ([start end] (range start end 1)) ([start end step] (lazy-seq (let [b (chunk-buffer 32) comp (if (pos? step) < >)] (loop [i start] (if (and (< (count b) 32) (comp i end)) (do (chunk-append b i) (recur (+ i step))) (chunk-cons (chunk b) (when (comp i end) (range i end step))))))))) (defn merge "Returns a map that consists of the rest of the maps conj-ed onto the first. If a key occurs in more than one map, the mapping from the latter (left-to-right) will be the mapping in the result." {:added "1.0"} [& maps] (when (some identity maps) (reduce #(conj (or %1 {}) %2) maps))) (defn merge-with "Returns a map that consists of the rest of the maps conj-ed onto the first. If a key occurs in more than one map, the mapping(s) from the latter (left-to-right) will be combined with the mapping in the result by calling (f val-in-result val-in-latter)." {:added "1.0"} [f & maps] (when (some identity maps) (let [merge-entry (fn [m e] (let [k (key e) v (val e)] (if (contains? m k) (assoc m k (f (get m k) v)) (assoc m k v)))) merge2 (fn [m1 m2] (reduce merge-entry (or m1 {}) (seq m2)))] (reduce merge2 maps)))) (defn zipmap "Returns a map with the keys mapped to the corresponding vals." {:added "1.0"} [keys vals] (loop [map {} ks (seq keys) vs (seq vals)] (if (and ks vs) (recur (assoc map (first ks) (first vs)) (next ks) (next vs)) map))) (defmacro declare "defs the supplied var names with no bindings, useful for making forward declarations." {:added "1.0"} [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names))) (defn line-seq "Returns the lines of text from rdr as a lazy sequence of strings. rdr must implement java.io.BufferedReader." {:added "1.0"} [^java.io.BufferedReader rdr] (when-let [line (.readLine rdr)] (cons line (lazy-seq (line-seq rdr))))) (defn comparator "Returns an implementation of java.util.Comparator based upon pred." {:added "1.0"} [pred] (fn [x y] (cond (pred x y) -1 (pred y x) 1 :else 0))) (defn sort "Returns a sorted sequence of the items in coll. If no comparator is supplied, uses compare. comparator must implement java.util.Comparator." {:added "1.0"} ([coll] (sort compare coll)) ([^java.util.Comparator comp coll] (if (seq coll) (let [a (to-array coll)] (. java.util.Arrays (sort a comp)) (seq a)) ()))) (defn sort-by "Returns a sorted sequence of the items in coll, where the sort order is determined by comparing (keyfn item). If no comparator is supplied, uses compare. comparator must implement java.util.Comparator." {:added "1.0"} ([keyfn coll] (sort-by keyfn compare coll)) ([keyfn ^java.util.Comparator comp coll] (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll))) (defn partition "Returns a lazy sequence of lists of n items each, at offsets step apart. If step is not supplied, defaults to n, i.e. the partitions do not overlap. If a pad collection is supplied, use its elements as necessary to complete last partition upto n items. In case there are not enough padding elements, return a partition with less than n items." {:added "1.0"} ([n coll] (partition n n coll)) ([n step coll] (lazy-seq (when-let [s (seq coll)] (let [p (take n s)] (when (= n (count p)) (cons p (partition n step (drop step s)))))))) ([n step pad coll] (lazy-seq (when-let [s (seq coll)] (let [p (take n s)] (if (= n (count p)) (cons p (partition n step pad (drop step s))) (list (take n (concat p pad))))))))) ;; evaluation (defn eval "Evaluates the form data structure (not text!) and returns the result." {:added "1.0"} [form] (. clojure.lang.Compiler (eval form))) (defmacro doseq "Repeatedly executes body (presumably for side-effects) with bindings and filtering as provided by \"for\". Does not retain the head of the sequence. Returns nil." {:added "1.0"} [seq-exprs & body] (assert-args doseq (vector? seq-exprs) "a vector for its binding" (even? (count seq-exprs)) "an even number of forms in binding vector") (let [step (fn step [recform exprs] (if-not exprs [true `(do ~@body)] (let [k (first exprs) v (second exprs)] (if (keyword? k) (let [steppair (step recform (nnext exprs)) needrec (steppair 0) subform (steppair 1)] (cond (= k :let) [needrec `(let ~v ~subform)] (= k :while) [false `(when ~v ~subform ~@(when needrec [recform]))] (= k :when) [false `(if ~v (do ~subform ~@(when needrec [recform])) ~recform)])) (let [seq- (gensym "seq_") chunk- (with-meta (gensym "chunk_") {:tag 'clojure.lang.IChunk}) count- (gensym "count_") i- (gensym "i_") recform `(recur (next ~seq-) nil (int 0) (int 0)) steppair (step recform (nnext exprs)) needrec (steppair 0) subform (steppair 1) recform-chunk `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-)) steppair-chunk (step recform-chunk (nnext exprs)) subform-chunk (steppair-chunk 1)] [true `(loop [~seq- (seq ~v), ~chunk- nil, ~count- (int 0), ~i- (int 0)] (if (< ~i- ~count-) (let [~k (.nth ~chunk- ~i-)] ~subform-chunk ~@(when needrec [recform-chunk])) (when-let [~seq- (seq ~seq-)] (if (chunked-seq? ~seq-) (let [c# (chunk-first ~seq-)] (recur (chunk-rest ~seq-) c# (int (count c#)) (int 0))) (let [~k (first ~seq-)] ~subform ~@(when needrec [recform]))))))])))))] (nth (step nil (seq seq-exprs)) 1))) (defn dorun "When lazy sequences are produced via functions that have side effects, any effects other than those needed to produce the first element in the seq do not occur until the seq is consumed. dorun can be used to force any effects. Walks through the successive nexts of the seq, does not retain the head and returns nil." {:added "1.0"} ([coll] (when (seq coll) (recur (next coll)))) ([n coll] (when (and (seq coll) (pos? n)) (recur (dec n) (next coll))))) (defn doall "When lazy sequences are produced via functions that have side effects, any effects other than those needed to produce the first element in the seq do not occur until the seq is consumed. doall can be used to force any effects. Walks through the successive nexts of the seq, retains the head and returns it, thus causing the entire seq to reside in memory at one time." {:added "1.0"} ([coll] (dorun coll) coll) ([n coll] (dorun n coll) coll)) (defn await "Blocks the current thread (indefinitely!) until all actions dispatched thus far, from this thread or agent, to the agent(s) have occurred. Will block on failed agents. Will never return if a failed agent is restarted with :clear-actions true." {:added "1.0"} [& agents] (io! "await in transaction" (when *agent* (throw (new Exception "Can't await in agent action"))) (let [latch (new java.util.concurrent.CountDownLatch (count agents)) count-down (fn [agent] (. latch (countDown)) agent)] (doseq [agent agents] (send agent count-down)) (. latch (await))))) (defn await1 [^clojure.lang.Agent a] (when (pos? (.getQueueCount a)) (await a)) a) (defn await-for "Blocks the current thread until all actions dispatched thus far (from this thread or agent) to the agents have occurred, or the timeout (in milliseconds) has elapsed. Returns nil if returning due to timeout, non-nil otherwise." {:added "1.0"} [timeout-ms & agents] (io! "await-for in transaction" (when *agent* (throw (new Exception "Can't await in agent action"))) (let [latch (new java.util.concurrent.CountDownLatch (count agents)) count-down (fn [agent] (. latch (countDown)) agent)] (doseq [agent agents] (send agent count-down)) (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS)))))) (defmacro dotimes "bindings => name n Repeatedly executes body (presumably for side-effects) with name bound to integers from 0 through n-1." {:added "1.0"} [bindings & body] (assert-args dotimes (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [i (first bindings) n (second bindings)] `(let [n# (int ~n)] (loop [~i (int 0)] (when (< ~i n#) ~@body (recur (unchecked-inc ~i))))))) #_(defn into "Returns a new coll consisting of to-coll with all of the items of from-coll conjoined." {:added "1.0"} [to from] (let [ret to items (seq from)] (if items (recur (conj ret (first items)) (next items)) ret))) ;;;;;;;;;;;;;;;;;;;;; editable collections ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn transient "Alpha - subject to change. Returns a new, transient version of the collection, in constant time." {:added "1.1"} [^clojure.lang.IEditableCollection coll] (.asTransient coll)) (defn persistent! "Alpha - subject to change. Returns a new, persistent version of the transient collection, in constant time. The transient collection cannot be used after this call, any such use will throw an exception." {:added "1.1"} [^clojure.lang.ITransientCollection coll] (.persistent coll)) (defn conj! "Alpha - subject to change. Adds x to the transient collection, and return coll. The 'addition' may happen at different 'places' depending on the concrete type." {:added "1.1"} [^clojure.lang.ITransientCollection coll x] (.conj coll x)) (defn assoc! "Alpha - subject to change. When applied to a transient map, adds mapping of key(s) to val(s). When applied to a transient vector, sets the val at index. Note - index must be <= (count vector). Returns coll." {:added "1.1"} ([^clojure.lang.ITransientAssociative coll key val] (.assoc coll key val)) ([^clojure.lang.ITransientAssociative coll key val & kvs] (let [ret (.assoc coll key val)] (if kvs (recur ret (first kvs) (second kvs) (nnext kvs)) ret)))) (defn dissoc! "Alpha - subject to change. Returns a transient map that doesn't contain a mapping for key(s)." {:added "1.1"} ([^clojure.lang.ITransientMap map key] (.without map key)) ([^clojure.lang.ITransientMap map key & ks] (let [ret (.without map key)] (if ks (recur ret (first ks) (next ks)) ret)))) (defn pop! "Alpha - subject to change. Removes the last item from a transient vector. If the collection is empty, throws an exception. Returns coll" {:added "1.1"} [^clojure.lang.ITransientVector coll] (.pop coll)) (defn disj! "Alpha - subject to change. disj[oin]. Returns a transient set of the same (hashed/sorted) type, that does not contain key(s)." {:added "1.1"} ([set] set) ([^clojure.lang.ITransientSet set key] (. set (disjoin key))) ([set key & ks] (let [ret (disj set key)] (if ks (recur ret (first ks) (next ks)) ret)))) ;redef into with batch support (defn into "Returns a new coll consisting of to-coll with all of the items of from-coll conjoined." {:added "1.0"} [to from] (if (instance? clojure.lang.IEditableCollection to) (persistent! (reduce conj! (transient to) from)) (reduce conj to from))) (defmacro import "import-list => (package-symbol class-name-symbols*) For each name in class-name-symbols, adds a mapping from name to the class named by package.name to the current namespace. Use :import in the ns macro in preference to calling this directly." {:added "1.0"} [& import-symbols-or-lists] (let [specs (map #(if (and (seq? %) (= 'quote (first %))) (second %) %) import-symbols-or-lists)] `(do ~@(map #(list 'clojure.core/import* %) (reduce (fn [v spec] (if (symbol? spec) (conj v (name spec)) (let [p (first spec) cs (rest spec)] (into v (map #(str p "." %) cs))))) [] specs))))) (defn into-array "Returns an array with components set to the values in aseq. The array's component type is type if provided, or the type of the first value in aseq if present, or Object. All values in aseq must be compatible with the component type. Class objects for the primitive types can be obtained using, e.g., Integer/TYPE." {:added "1.0"} ([aseq] (clojure.lang.RT/seqToTypedArray (seq aseq))) ([type aseq] (clojure.lang.RT/seqToTypedArray type (seq aseq)))) (defn ^{:private true} array [& items] (into-array items)) (defn ^Class class "Returns the Class of x" {:added "1.0"} [^Object x] (if (nil? x) x (. x (getClass)))) (defn type "Returns the :type metadata of x, or its Class if none" {:added "1.0"} [x] (or (:type (meta x)) (class x))) (defn num "Coerce to Number" {:tag Number :inline (fn [x] `(. clojure.lang.Numbers (num ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (num x))) (defn long "Coerce to long" {:tag Long :inline (fn [x] `(. clojure.lang.RT (longCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/longCast x)) (defn float "Coerce to float" {:tag Float :inline (fn [x] `(. clojure.lang.RT (floatCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/floatCast x)) (defn double "Coerce to double" {:tag Double :inline (fn [x] `(. clojure.lang.RT (doubleCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/doubleCast x)) (defn short "Coerce to short" {:tag Short :inline (fn [x] `(. clojure.lang.RT (shortCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/shortCast x)) (defn byte "Coerce to byte" {:tag Byte :inline (fn [x] `(. clojure.lang.RT (byteCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/byteCast x)) (defn char "Coerce to char" {:tag Character :inline (fn [x] `(. clojure.lang.RT (charCast ~x))) :added "1.1"} [x] (. clojure.lang.RT (charCast x))) (defn boolean "Coerce to boolean" { :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) :added "1.0"} [x] (clojure.lang.RT/booleanCast x)) (defn number? "Returns true if x is a Number" {:added "1.0"} [x] (instance? Number x)) (defn integer? "Returns true if n is an integer" {:added "1.0"} [n] (or (instance? Integer n) (instance? Long n) (instance? BigInteger n) (instance? Short n) (instance? Byte n))) (defn mod "Modulus of num and div. Truncates toward negative infinity." {:added "1.0"} [num div] (let [m (rem num div)] (if (or (zero? m) (pos? (* num div))) m (+ m div)))) (defn ratio? "Returns true if n is a Ratio" {:added "1.0"} [n] (instance? clojure.lang.Ratio n)) (defn numerator "Returns the numerator part of a Ratio." {:tag BigInteger :added "1.2"} [r] (.numerator ^clojure.lang.Ratio r)) (defn denominator "Returns the denominator part of a Ratio." {:tag BigInteger :added "1.2"} [r] (.denominator ^clojure.lang.Ratio r)) (defn decimal? "Returns true if n is a BigDecimal" {:added "1.0"} [n] (instance? BigDecimal n)) (defn float? "Returns true if n is a floating point number" {:added "1.0"} [n] (or (instance? Double n) (instance? Float n))) (defn rational? [n] "Returns true if n is a rational number" {:added "1.0"} (or (integer? n) (ratio? n) (decimal? n))) (defn bigint "Coerce to BigInteger" {:tag BigInteger :added "1.0"} [x] (cond (instance? BigInteger x) x (decimal? x) (.toBigInteger ^BigDecimal x) (ratio? x) (.bigIntegerValue ^clojure.lang.Ratio x) (number? x) (BigInteger/valueOf (long x)) :else (BigInteger. x))) (defn bigdec "Coerce to BigDecimal" {:tag BigDecimal :added "1.0"} [x] (cond (decimal? x) x (float? x) (. BigDecimal valueOf (double x)) (ratio? x) (/ (BigDecimal. (.numerator x)) (.denominator x)) (instance? BigInteger x) (BigDecimal. ^BigInteger x) (number? x) (BigDecimal/valueOf (long x)) :else (BigDecimal. x))) (def ^{:private true} print-initialized false) (defmulti print-method (fn [x writer] (type x))) (defmulti print-dup (fn [x writer] (class x))) (defn pr-on {:private true} [x w] (if *print-dup* (print-dup x w) (print-method x w)) nil) (defn pr "Prints the object(s) to the output stream that is the current value of *out*. Prints the object(s), separated by spaces if there is more than one. By default, pr and prn print in a way that objects can be read by the reader" {:dynamic true :added "1.0"} ([] nil) ([x] (pr-on x *out*)) ([x & more] (pr x) (. *out* (append \space)) (if-let [nmore (next more)] (recur (first more) nmore) (apply pr more)))) (defn newline "Writes a newline to the output stream that is the current value of *out*" {:added "1.0"} [] (. *out* (append \newline)) nil) (defn flush "Flushes the output stream that is the current value of *out*" {:added "1.0"} [] (. *out* (flush)) nil) (defn prn "Same as pr followed by (newline). Observes *flush-on-newline*" {:added "1.0"} [& more] (apply pr more) (newline) (when *flush-on-newline* (flush))) (defn print "Prints the object(s) to the output stream that is the current value of *out*. print and println produce output for human consumption." {:added "1.0"} [& more] (binding [*print-readably* nil] (apply pr more))) (defn println "Same as print followed by (newline)" {:added "1.0"} [& more] (binding [*print-readably* nil] (apply prn more))) (defn read "Reads the next object from stream, which must be an instance of java.io.PushbackReader or some derivee. stream defaults to the current value of *in* ." {:added "1.0"} ([] (read *in*)) ([stream] (read stream true nil)) ([stream eof-error? eof-value] (read stream eof-error? eof-value false)) ([stream eof-error? eof-value recursive?] (. clojure.lang.LispReader (read stream (boolean eof-error?) eof-value recursive?)))) (defn read-line "Reads the next line from stream that is the current value of *in* ." {:added "1.0"} [] (if (instance? clojure.lang.LineNumberingPushbackReader *in*) (.readLine ^clojure.lang.LineNumberingPushbackReader *in*) (.readLine ^java.io.BufferedReader *in*))) (defn read-string "Reads one object from the string s" {:added "1.0"} [s] (clojure.lang.RT/readString s)) (defn subvec "Returns a persistent vector of the items in vector from start (inclusive) to end (exclusive). If end is not supplied, defaults to (count vector). This operation is O(1) and very fast, as the resulting vector shares structure with the original and no trimming is done." {:added "1.0"} ([v start] (subvec v start (count v))) ([v start end] (. clojure.lang.RT (subvec v start end)))) (defmacro with-open "bindings => [name init ...] Evaluates body in a try expression with names bound to the values of the inits, and a finally clause that calls (.close name) on each name in reverse order." {:added "1.0"} [bindings & body] (assert-args with-open (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (cond (= (count bindings) 0) `(do ~@body) (symbol? (bindings 0)) `(let ~(subvec bindings 0 2) (try (with-open ~(subvec bindings 2) ~@body) (finally (. ~(bindings 0) close)))) :else (throw (IllegalArgumentException. "with-open only allows Symbols in bindings")))) (defmacro doto "Evaluates x then calls all of the methods and functions with the value of x supplied at the front of the given arguments. The forms are evaluated in order. Returns x. (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))" {:added "1.0"} [x & forms] (let [gx (gensym)] `(let [~gx ~x] ~@(map (fn [f] (if (seq? f) `(~(first f) ~gx ~@(next f)) `(~f ~gx))) forms) ~gx))) (defmacro memfn "Expands into code that creates a fn that expects to be passed an object and any args and calls the named instance method on the object passing the args. Use when you want to treat a Java method as a first-class fn." {:added "1.0"} [name & args] `(fn [target# ~@args] (. target# (~name ~@args)))) (defmacro time "Evaluates expr and prints the time it took. Returns the value of expr." {:added "1.0"} [expr] `(let [start# (. System (nanoTime)) ret# ~expr] (prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs")) ret#)) (import '(java.lang.reflect Array)) (defn alength "Returns the length of the Java array. Works on arrays of all types." {:inline (fn [a] `(. clojure.lang.RT (alength ~a))) :added "1.0"} [array] (. clojure.lang.RT (alength array))) (defn aclone "Returns a clone of the Java array. Works on arrays of known types." {:inline (fn [a] `(. clojure.lang.RT (aclone ~a))) :added "1.0"} [array] (. clojure.lang.RT (aclone array))) (defn aget "Returns the value at the index/indices. Works on Java arrays of all types." {:inline (fn [a i] `(. clojure.lang.RT (aget ~a (int ~i)))) :inline-arities #{2} :added "1.0"} ([array idx] (clojure.lang.Reflector/prepRet (. Array (get array idx)))) ([array idx & idxs] (apply aget (aget array idx) idxs))) (defn aset "Sets the value at the index/indices. Works on Java arrays of reference types. Returns val." {:inline (fn [a i v] `(. clojure.lang.RT (aset ~a (int ~i) ~v))) :inline-arities #{3} :added "1.0"} ([array idx val] (. Array (set array idx val)) val) ([array idx idx2 & idxv] (apply aset (aget array idx) idx2 idxv))) (defmacro ^{:private true} def-aset [name method coerce] `(defn ~name {:arglists '([~'array ~'idx ~'val] [~'array ~'idx ~'idx2 & ~'idxv])} ([array# idx# val#] (. Array (~method array# idx# (~coerce val#))) val#) ([array# idx# idx2# & idxv#] (apply ~name (aget array# idx#) idx2# idxv#)))) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val." :added "1.0"} aset-int setInt int) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val." :added "1.0"} aset-long setLong long) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val." :added "1.0"} aset-boolean setBoolean boolean) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val." :added "1.0"} aset-float setFloat float) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val." :added "1.0"} aset-double setDouble double) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val." :added "1.0"} aset-short setShort short) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val." :added "1.0"} aset-byte setByte byte) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val." :added "1.0"} aset-char setChar char) (defn make-array "Creates and returns an array of instances of the specified class of the specified dimension(s). Note that a class object is required. Class objects can be obtained by using their imported or fully-qualified name. Class objects for the primitive types can be obtained using, e.g., Integer/TYPE." {:added "1.0"} ([^Class type len] (. Array (newInstance type (int len)))) ([^Class type dim & more-dims] (let [dims (cons dim more-dims) ^"[I" dimarray (make-array (. Integer TYPE) (count dims))] (dotimes [i (alength dimarray)] (aset-int dimarray i (nth dims i))) (. Array (newInstance type dimarray))))) (defn to-array-2d "Returns a (potentially-ragged) 2-dimensional array of Objects containing the contents of coll, which can be any Collection of any Collection." {:tag "[[Ljava.lang.Object;" :added "1.0"} [^java.util.Collection coll] (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))] (loop [i 0 xs (seq coll)] (when xs (aset ret i (to-array (first xs))) (recur (inc i) (next xs)))) ret)) (defn macroexpand-1 "If form represents a macro form, returns its expansion, else returns form." {:added "1.0"} [form] (. clojure.lang.Compiler (macroexpand1 form))) (defn macroexpand "Repeatedly calls macroexpand-1 on form until it no longer represents a macro form, then returns it. Note neither macroexpand-1 nor macroexpand expand macros in subforms." {:added "1.0"} [form] (let [ex (macroexpand-1 form)] (if (identical? ex form) form (macroexpand ex)))) (defn create-struct "Returns a structure basis object." {:added "1.0"} [& keys] (. clojure.lang.PersistentStructMap (createSlotMap keys))) (defmacro defstruct "Same as (def name (create-struct keys...))" {:added "1.0"} [name & keys] `(def ~name (create-struct ~@keys))) (defn struct-map "Returns a new structmap instance with the keys of the structure-basis. keyvals may contain all, some or none of the basis keys - where values are not supplied they will default to nil. keyvals can also contain keys not in the basis." {:added "1.0"} [s & inits] (. clojure.lang.PersistentStructMap (create s inits))) (defn struct "Returns a new structmap instance with the keys of the structure-basis. vals must be supplied for basis keys in order - where values are not supplied they will default to nil." {:added "1.0"} [s & vals] (. clojure.lang.PersistentStructMap (construct s vals))) (defn accessor "Returns a fn that, given an instance of a structmap with the basis, returns the value at the key. The key must be in the basis. The returned function should be (slightly) more efficient than using get, but such use of accessors should be limited to known performance-critical areas." {:added "1.0"} [s key] (. clojure.lang.PersistentStructMap (getAccessor s key))) (defn load-reader "Sequentially read and evaluate the set of forms contained in the stream/file" {:added "1.0"} [rdr] (. clojure.lang.Compiler (load rdr))) (defn load-string "Sequentially read and evaluate the set of forms contained in the string" {:added "1.0"} [s] (let [rdr (-> (java.io.StringReader. s) (clojure.lang.LineNumberingPushbackReader.))] (load-reader rdr))) (defn set "Returns a set of the distinct elements of coll." {:added "1.0"} [coll] (clojure.lang.PersistentHashSet/create ^clojure.lang.ISeq (seq coll))) (defn ^{:private true} filter-key [keyfn pred amap] (loop [ret {} es (seq amap)] (if es (if (pred (keyfn (first es))) (recur (assoc ret (key (first es)) (val (first es))) (next es)) (recur ret (next es))) ret))) (defn find-ns "Returns the namespace named by the symbol or nil if it doesn't exist." {:added "1.0"} [sym] (clojure.lang.Namespace/find sym)) (defn create-ns "Create a new namespace named by the symbol if one doesn't already exist, returns it or the already-existing namespace of the same name." {:added "1.0"} [sym] (clojure.lang.Namespace/findOrCreate sym)) (defn remove-ns "Removes the namespace named by the symbol. Use with caution. Cannot be used to remove the clojure namespace." {:added "1.0"} [sym] (clojure.lang.Namespace/remove sym)) (defn all-ns "Returns a sequence of all namespaces." {:added "1.0"} [] (clojure.lang.Namespace/all)) (defn ^clojure.lang.Namespace the-ns "If passed a namespace, returns it. Else, when passed a symbol, returns the namespace named by it, throwing an exception if not found." {:added "1.0"} [x] (if (instance? clojure.lang.Namespace x) x (or (find-ns x) (throw (Exception. (str "No namespace: " x " found")))))) (defn ns-name "Returns the name of the namespace, a symbol." {:added "1.0"} [ns] (.getName (the-ns ns))) (defn ns-map "Returns a map of all the mappings for the namespace." {:added "1.0"} [ns] (.getMappings (the-ns ns))) (defn ns-unmap "Removes the mappings for the symbol from the namespace." {:added "1.0"} [ns sym] (.unmap (the-ns ns) sym)) ;(defn export [syms] ; (doseq [sym syms] ; (.. *ns* (intern sym) (setExported true)))) (defn ns-publics "Returns a map of the public intern mappings for the namespace." {:added "1.0"} [ns] (let [ns (the-ns ns)] (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) (= ns (.ns v)) (.isPublic v))) (ns-map ns)))) (defn ns-imports "Returns a map of the import mappings for the namespace." {:added "1.0"} [ns] (filter-key val (partial instance? Class) (ns-map ns))) (defn ns-interns "Returns a map of the intern mappings for the namespace." {:added "1.0"} [ns] (let [ns (the-ns ns)] (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) (= ns (.ns v)))) (ns-map ns)))) (defn refer "refers to all public vars of ns, subject to filters. filters can include at most one each of: :exclude list-of-symbols :only list-of-symbols :rename map-of-fromsymbol-tosymbol For each public interned var in the namespace named by the symbol, adds a mapping from the name of the var to the var to the current namespace. Throws an exception if name is already mapped to something else in the current namespace. Filters can be used to select a subset, via inclusion or exclusion, or to provide a mapping to a symbol different from the var's name, in order to prevent clashes. Use :use in the ns macro in preference to calling this directly." {:added "1.0"} [ns-sym & filters] (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym)))) fs (apply hash-map filters) nspublics (ns-publics ns) rename (or (:rename fs) {}) exclude (set (:exclude fs)) to-do (or (:only fs) (keys nspublics))] (doseq [sym to-do] (when-not (exclude sym) (let [v (nspublics sym)] (when-not v (throw (new java.lang.IllegalAccessError (if (get (ns-interns ns) sym) (str sym " is not public") (str sym " does not exist"))))) (. *ns* (refer (or (rename sym) sym) v))))))) (defn ns-refers "Returns a map of the refer mappings for the namespace." {:added "1.0"} [ns] (let [ns (the-ns ns)] (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) (not= ns (.ns v)))) (ns-map ns)))) (defn alias "Add an alias in the current namespace to another namespace. Arguments are two symbols: the alias to be used, and the symbolic name of the target namespace. Use :as in the ns macro in preference to calling this directly." {:added "1.0"} [alias namespace-sym] (.addAlias *ns* alias (find-ns namespace-sym))) (defn ns-aliases "Returns a map of the aliases for the namespace." {:added "1.0"} [ns] (.getAliases (the-ns ns))) (defn ns-unalias "Removes the alias for the symbol from the namespace." {:added "1.0"} [ns sym] (.removeAlias (the-ns ns) sym)) (defn take-nth "Returns a lazy seq of every nth item in coll." {:added "1.0"} [n coll] (lazy-seq (when-let [s (seq coll)] (cons (first s) (take-nth n (drop n s)))))) (defn interleave "Returns a lazy seq of the first item in each coll, then the second etc." {:added "1.0"} ([c1 c2] (lazy-seq (let [s1 (seq c1) s2 (seq c2)] (when (and s1 s2) (cons (first s1) (cons (first s2) (interleave (rest s1) (rest s2)))))))) ([c1 c2 & colls] (lazy-seq (let [ss (map seq (conj colls c2 c1))] (when (every? identity ss) (concat (map first ss) (apply interleave (map rest ss)))))))) (defn var-get "Gets the value in the var object" {:added "1.0"} [^clojure.lang.Var x] (. x (get))) (defn var-set "Sets the value in the var object to val. The var must be thread-locally bound." {:added "1.0"} [^clojure.lang.Var x val] (. x (set val))) (defmacro with-local-vars "varbinding=> symbol init-expr Executes the exprs in a context in which the symbols are bound to vars with per-thread bindings to the init-exprs. The symbols refer to the var objects themselves, and must be accessed with var-get and var-set" {:added "1.0"} [name-vals-vec & body] (assert-args with-local-vars (vector? name-vals-vec) "a vector for its binding" (even? (count name-vals-vec)) "an even number of forms in binding vector") `(let [~@(interleave (take-nth 2 name-vals-vec) (repeat '(. clojure.lang.Var (create))))] (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec))) (try ~@body (finally (. clojure.lang.Var (popThreadBindings)))))) (defn ns-resolve "Returns the var or Class to which a symbol will be resolved in the namespace, else nil. Note that if the symbol is fully qualified, the var/Class to which it resolves need not be present in the namespace." {:added "1.0"} [ns sym] (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym)) (defn resolve "same as (ns-resolve *ns* symbol)" {:added "1.0"} [sym] (ns-resolve *ns* sym)) (defn array-map "Constructs an array-map." {:added "1.0"} ([] (. clojure.lang.PersistentArrayMap EMPTY)) ([& keyvals] (clojure.lang.PersistentArrayMap/createWithCheck (to-array keyvals)))) (defn nthnext "Returns the nth next of coll, (seq coll) when n is 0." {:added "1.0"} [coll n] (loop [n n xs (seq coll)] (if (and xs (pos? n)) (recur (dec n) (next xs)) xs))) ;redefine let and loop with destructuring (defn destructure [bindings] (let [bents (partition 2 bindings) pb (fn pb [bvec b v] (let [pvec (fn [bvec b val] (let [gvec (gensym "vec__")] (loop [ret (-> bvec (conj gvec) (conj val)) n 0 bs b seen-rest? false] (if (seq bs) (let [firstb (first bs)] (cond (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n)) n (nnext bs) true) (= firstb :as) (pb ret (second bs) gvec) :else (if seen-rest? (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) (recur (pb ret firstb (list `nth gvec n nil)) (inc n) (next bs) seen-rest?)))) ret)))) pmap (fn [bvec b v] (let [gmap (or (:as b) (gensym "map__")) defaults (:or b)] (loop [ret (-> bvec (conj gmap) (conj v) (conj gmap) (conj `(if (seq? ~gmap) (apply hash-map ~gmap) ~gmap))) bes (reduce (fn [bes entry] (reduce #(assoc %1 %2 ((val entry) %2)) (dissoc bes (key entry)) ((key entry) bes))) (dissoc b :as :or) {:keys #(keyword (str %)), :strs str, :syms #(list `quote %)})] (if (seq bes) (let [bb (key (first bes)) bk (val (first bes)) has-default (contains? defaults bb)] (recur (pb ret bb (if has-default (list `get gmap bk (defaults bb)) (list `get gmap bk))) (next bes))) ret))))] (cond (symbol? b) (-> bvec (conj b) (conj v)) (vector? b) (pvec bvec b v) (map? b) (pmap bvec b v) :else (throw (new Exception (str "Unsupported binding form: " b)))))) process-entry (fn [bvec b] (pb bvec (first b) (second b)))] (if (every? symbol? (map first bents)) bindings (reduce process-entry [] bents)))) (defmacro let "Evaluates the exprs in a lexical context in which the symbols in the binding-forms are bound to their respective init-exprs or parts therein." {:added "1.0"} [bindings & body] (assert-args let (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") `(let* ~(destructure bindings) ~@body)) (defn ^{:private true} maybe-destructured [params body] (if (every? symbol? params) (cons params body) (loop [params params new-params [] lets []] (if params (if (symbol? (first params)) (recur (next params) (conj new-params (first params)) lets) (let [gparam (gensym "p__")] (recur (next params) (conj new-params gparam) (-> lets (conj (first params)) (conj gparam))))) `(~new-params (let ~lets ~@body)))))) ;redefine fn with destructuring and pre/post conditions (defmacro fn "(fn name? [params* ] exprs*) (fn name? ([params* ] exprs*)+) params => positional-params* , or positional-params* & next-param positional-param => binding-form next-param => binding-form name => symbol Defines a function" {:added "1.0"} [& sigs] (let [name (if (symbol? (first sigs)) (first sigs) nil) sigs (if name (next sigs) sigs) sigs (if (vector? (first sigs)) (list sigs) sigs) psig (fn* [sig] (let [[params & body] sig conds (when (and (next body) (map? (first body))) (first body)) body (if conds (next body) body) conds (or conds (meta params)) pre (:pre conds) post (:post conds) body (if post `((let [~'% ~(if (< 1 (count body)) `(do ~@body) (first body))] ~@(map (fn* [c] `(assert ~c)) post) ~'%)) body) body (if pre (concat (map (fn* [c] `(assert ~c)) pre) body) body)] (maybe-destructured params body))) new-sigs (map psig sigs)] (with-meta (if name (list* 'fn* name new-sigs) (cons 'fn* new-sigs)) (meta &form)))) (defmacro loop "Evaluates the exprs in a lexical context in which the symbols in the binding-forms are bound to their respective init-exprs or parts therein. Acts as a recur target." {:added "1.0"} [bindings & body] (assert-args loop (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (let [db (destructure bindings)] (if (= db bindings) `(loop* ~bindings ~@body) (let [vs (take-nth 2 (drop 1 bindings)) bs (take-nth 2 bindings) gs (map (fn [b] (if (symbol? b) b (gensym))) bs) bfs (reduce (fn [ret [b v g]] (if (symbol? b) (conj ret g v) (conj ret g v b g))) [] (map vector bs vs gs))] `(let ~bfs (loop* ~(vec (interleave gs gs)) (let ~(vec (interleave bs gs)) ~@body))))))) (defmacro when-first "bindings => x xs Same as (when (seq xs) (let [x (first xs)] body))" {:added "1.0"} [bindings & body] (assert-args when-first (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [[x xs] bindings] `(when (seq ~xs) (let [~x (first ~xs)] ~@body)))) (defmacro lazy-cat "Expands to code which yields a lazy sequence of the concatenation of the supplied colls. Each coll expr is not evaluated until it is needed. (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))" {:added "1.0"} [& colls] `(concat ~@(map #(list `lazy-seq %) colls))) (defmacro for "List comprehension. Takes a vector of one or more binding-form/collection-expr pairs, each followed by zero or more modifiers, and yields a lazy sequence of evaluations of expr. Collections are iterated in a nested fashion, rightmost fastest, and nested coll-exprs can refer to bindings created in prior binding-forms. Supported modifiers are: :let [binding-form expr ...], :while test, :when test. (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))" {:added "1.0"} [seq-exprs body-expr] (assert-args for (vector? seq-exprs) "a vector for its binding" (even? (count seq-exprs)) "an even number of forms in binding vector") (let [to-groups (fn [seq-exprs] (reduce (fn [groups [k v]] (if (keyword? k) (conj (pop groups) (conj (peek groups) [k v])) (conj groups [k v]))) [] (partition 2 seq-exprs))) err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg)))) emit-bind (fn emit-bind [[[bind expr & mod-pairs] & [[_ next-expr] :as next-groups]]] (let [giter (gensym "iter__") gxs (gensym "s__") do-mod (fn do-mod [[[k v :as pair] & etc]] (cond (= k :let) `(let ~v ~(do-mod etc)) (= k :while) `(when ~v ~(do-mod etc)) (= k :when) `(if ~v ~(do-mod etc) (recur (rest ~gxs))) (keyword? k) (err "Invalid 'for' keyword " k) next-groups `(let [iterys# ~(emit-bind next-groups) fs# (seq (iterys# ~next-expr))] (if fs# (concat fs# (~giter (rest ~gxs))) (recur (rest ~gxs)))) :else `(cons ~body-expr (~giter (rest ~gxs)))))] (if next-groups #_"not the inner-most loop" `(fn ~giter [~gxs] (lazy-seq (loop [~gxs ~gxs] (when-first [~bind ~gxs] ~(do-mod mod-pairs))))) #_"inner-most loop" (let [gi (gensym "i__") gb (gensym "b__") do-cmod (fn do-cmod [[[k v :as pair] & etc]] (cond (= k :let) `(let ~v ~(do-cmod etc)) (= k :while) `(when ~v ~(do-cmod etc)) (= k :when) `(if ~v ~(do-cmod etc) (recur (unchecked-inc ~gi))) (keyword? k) (err "Invalid 'for' keyword " k) :else `(do (chunk-append ~gb ~body-expr) (recur (unchecked-inc ~gi)))))] `(fn ~giter [~gxs] (lazy-seq (loop [~gxs ~gxs] (when-let [~gxs (seq ~gxs)] (if (chunked-seq? ~gxs) (let [c# (chunk-first ~gxs) size# (int (count c#)) ~gb (chunk-buffer size#)] (if (loop [~gi (int 0)] (if (< ~gi size#) (let [~bind (.nth c# ~gi)] ~(do-cmod mod-pairs)) true)) (chunk-cons (chunk ~gb) (~giter (chunk-rest ~gxs))) (chunk-cons (chunk ~gb) nil))) (let [~bind (first ~gxs)] ~(do-mod mod-pairs)))))))))))] `(let [iter# ~(emit-bind (to-groups seq-exprs))] (iter# ~(second seq-exprs))))) (defmacro comment "Ignores body, yields nil" {:added "1.0"} [& body]) (defmacro with-out-str "Evaluates exprs in a context in which *out* is bound to a fresh StringWriter. Returns the string created by any nested printing calls." {:added "1.0"} [& body] `(let [s# (new java.io.StringWriter)] (binding [*out* s#] ~@body (str s#)))) (defmacro with-in-str "Evaluates body in a context in which *in* is bound to a fresh StringReader initialized with the string s." {:added "1.0"} [s & body] `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)] (binding [*in* s#] ~@body))) (defn pr-str "pr to a string, returning it" {:tag String :added "1.0"} [& xs] (with-out-str (apply pr xs))) (defn prn-str "prn to a string, returning it" {:tag String :added "1.0"} [& xs] (with-out-str (apply prn xs))) (defn print-str "print to a string, returning it" {:tag String :added "1.0"} [& xs] (with-out-str (apply print xs))) (defn println-str "println to a string, returning it" {:tag String :added "1.0"} [& xs] (with-out-str (apply println xs))) (defmacro assert "Evaluates expr and throws an exception if it does not evaluate to logical true." {:added "1.0"} [x] (when *assert* `(when-not ~x (throw (new AssertionError (str "Assert failed: " (pr-str '~x))))))) (defn test "test [v] finds fn at key :test in var metadata and calls it, presuming failure will throw exception" {:added "1.0"} [v] (let [f (:test (meta v))] (if f (do (f) :ok) :no-test))) (defn re-pattern "Returns an instance of java.util.regex.Pattern, for use, e.g. in re-matcher." {:tag java.util.regex.Pattern :added "1.0"} [s] (if (instance? java.util.regex.Pattern s) s (. java.util.regex.Pattern (compile s)))) (defn re-matcher "Returns an instance of java.util.regex.Matcher, for use, e.g. in re-find." {:tag java.util.regex.Matcher :added "1.0"} [^java.util.regex.Pattern re s] (. re (matcher s))) (defn re-groups "Returns the groups from the most recent match/find. If there are no nested groups, returns a string of the entire match. If there are nested groups, returns a vector of the groups, the first element being the entire match." {:added "1.0"} [^java.util.regex.Matcher m] (let [gc (. m (groupCount))] (if (zero? gc) (. m (group)) (loop [ret [] c 0] (if (<= c gc) (recur (conj ret (. m (group c))) (inc c)) ret))))) (defn re-seq "Returns a lazy sequence of successive matches of pattern in string, using java.util.regex.Matcher.find(), each such match processed with re-groups." {:added "1.0"} [^java.util.regex.Pattern re s] (let [m (re-matcher re s)] ((fn step [] (when (. m (find)) (cons (re-groups m) (lazy-seq (step)))))))) (defn re-matches "Returns the match, if any, of string to pattern, using java.util.regex.Matcher.matches(). Uses re-groups to return the groups." {:added "1.0"} [^java.util.regex.Pattern re s] (let [m (re-matcher re s)] (when (. m (matches)) (re-groups m)))) (defn re-find "Returns the next regex match, if any, of string to pattern, using java.util.regex.Matcher.find(). Uses re-groups to return the groups." {:added "1.0"} ([^java.util.regex.Matcher m] (when (. m (find)) (re-groups m))) ([^java.util.regex.Pattern re s] (let [m (re-matcher re s)] (re-find m)))) (defn rand "Returns a random floating point number between 0 (inclusive) and n (default 1) (exclusive)." {:added "1.0"} ([] (. Math (random))) ([n] (* n (rand)))) (defn rand-int "Returns a random integer between 0 (inclusive) and n (exclusive)." {:added "1.0"} [n] (int (rand n))) (defmacro defn- "same as defn, yielding non-public def" {:added "1.0"} [name & decls] (list* `defn (with-meta name (assoc (meta name) :private true)) decls)) (defn print-doc [v] (println "-------------------------") (println (str (ns-name (:ns (meta v))) "/" (:name (meta v)))) (prn (:arglists (meta v))) (when (:macro (meta v)) (println "Macro")) (println " " (:doc (meta v)))) (defn find-doc "Prints documentation for any var whose documentation or name contains a match for re-string-or-pattern" {:added "1.0"} [re-string-or-pattern] (let [re (re-pattern re-string-or-pattern)] (doseq [ns (all-ns) v (sort-by (comp :name meta) (vals (ns-interns ns))) :when (and (:doc (meta v)) (or (re-find (re-matcher re (:doc (meta v)))) (re-find (re-matcher re (str (:name (meta v)))))))] (print-doc v)))) (defn special-form-anchor "Returns the anchor tag on http://clojure.org/special_forms for the special form x, or nil" {:added "1.0"} [x] (#{'. 'def 'do 'fn 'if 'let 'loop 'monitor-enter 'monitor-exit 'new 'quote 'recur 'set! 'throw 'try 'var} x)) (defn syntax-symbol-anchor "Returns the anchor tag on http://clojure.org/special_forms for the special form that uses syntax symbol x, or nil" {:added "1.0"} [x] ({'& 'fn 'catch 'try 'finally 'try} x)) (defn print-special-doc [name type anchor] (println "-------------------------") (println name) (println type) (println (str " Please see http://clojure.org/special_forms#" anchor))) (defn print-namespace-doc "Print the documentation string of a Namespace." {:added "1.0"} [nspace] (println "-------------------------") (println (str (ns-name nspace))) (println " " (:doc (meta nspace)))) (defmacro doc "Prints documentation for a var or special form given its name" {:added "1.0"} [name] (cond (special-form-anchor `~name) `(print-special-doc '~name "Special Form" (special-form-anchor '~name)) (syntax-symbol-anchor `~name) `(print-special-doc '~name "Syntax Symbol" (syntax-symbol-anchor '~name)) :else (let [nspace (find-ns name)] (if nspace `(print-namespace-doc ~nspace) `(print-doc (var ~name)))))) (defn tree-seq "Returns a lazy sequence of the nodes in a tree, via a depth-first walk. branch? must be a fn of one arg that returns true if passed a node that can have children (but may not). children must be a fn of one arg that returns a sequence of the children. Will only be called on nodes for which branch? returns true. Root is the root node of the tree." {:added "1.0"} [branch? children root] (let [walk (fn walk [node] (lazy-seq (cons node (when (branch? node) (mapcat walk (children node))))))] (walk root))) (defn file-seq "A tree seq on java.io.Files" {:added "1.0"} [dir] (tree-seq (fn [^java.io.File f] (. f (isDirectory))) (fn [^java.io.File d] (seq (. d (listFiles)))) dir)) (defn xml-seq "A tree seq on the xml elements as per xml/parse" {:added "1.0"} [root] (tree-seq (complement string?) (comp seq :content) root)) (defn special-symbol? "Returns true if s names a special form" {:added "1.0"} [s] (contains? (. clojure.lang.Compiler specials) s)) (defn var? "Returns true if v is of type clojure.lang.Var" {:added "1.0"} [v] (instance? clojure.lang.Var v)) (defn ^String subs "Returns the substring of s beginning at start inclusive, and ending at end (defaults to length of string), exclusive." {:added "1.0"} ([^String s start] (. s (substring start))) ([^String s start end] (. s (substring start end)))) (defn max-key "Returns the x for which (k x), a number, is greatest." {:added "1.0"} ([k x] x) ([k x y] (if (> (k x) (k y)) x y)) ([k x y & more] (reduce #(max-key k %1 %2) (max-key k x y) more))) (defn min-key "Returns the x for which (k x), a number, is least." {:added "1.0"} ([k x] x) ([k x y] (if (< (k x) (k y)) x y)) ([k x y & more] (reduce #(min-key k %1 %2) (min-key k x y) more))) (defn distinct "Returns a lazy sequence of the elements of coll with duplicates removed" {:added "1.0"} [coll] (let [step (fn step [xs seen] (lazy-seq ((fn [[f :as xs] seen] (when-let [s (seq xs)] (if (contains? seen f) (recur (rest s) seen) (cons f (step (rest s) (conj seen f)))))) xs seen)))] (step coll #{}))) (defn replace "Given a map of replacement pairs and a vector/collection, returns a vector/seq with any elements = a key in smap replaced with the corresponding val in smap" {:added "1.0"} [smap coll] (if (vector? coll) (reduce (fn [v i] (if-let [e (find smap (nth v i))] (assoc v i (val e)) v)) coll (range (count coll))) (map #(if-let [e (find smap %)] (val e) %) coll))) (defmacro dosync "Runs the exprs (in an implicit do) in a transaction that encompasses exprs and any nested calls. Starts a transaction if none is already running on this thread. Any uncaught exception will abort the transaction and flow out of dosync. The exprs may be run more than once, but any effects on Refs will be atomic." {:added "1.0"} [& exprs] `(sync nil ~@exprs)) (defmacro with-precision "Sets the precision and rounding mode to be used for BigDecimal operations. Usage: (with-precision 10 (/ 1M 3)) or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3)) The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN, HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP." {:added "1.0"} [precision & exprs] (let [[body rm] (if (= (first exprs) :rounding) [(next (next exprs)) `((. java.math.RoundingMode ~(second exprs)))] [exprs nil])] `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)] ~@body))) (defn mk-bound-fn {:private true} [^clojure.lang.Sorted sc test key] (fn [e] (test (.. sc comparator (compare (. sc entryKey e) key)) 0))) (defn subseq "sc must be a sorted collection, test(s) one of <, <=, > or >=. Returns a seq of those entries with keys ek for which (test (.. sc comparator (compare ek key)) 0) is true" {:added "1.0"} ([^clojure.lang.Sorted sc test key] (let [include (mk-bound-fn sc test key)] (if (#{> >=} test) (when-let [[e :as s] (. sc seqFrom key true)] (if (include e) s (next s))) (take-while include (. sc seq true))))) ([^clojure.lang.Sorted sc start-test start-key end-test end-key] (when-let [[e :as s] (. sc seqFrom start-key true)] (take-while (mk-bound-fn sc end-test end-key) (if ((mk-bound-fn sc start-test start-key) e) s (next s)))))) (defn rsubseq "sc must be a sorted collection, test(s) one of <, <=, > or >=. Returns a reverse seq of those entries with keys ek for which (test (.. sc comparator (compare ek key)) 0) is true" {:added "1.0"} ([^clojure.lang.Sorted sc test key] (let [include (mk-bound-fn sc test key)] (if (#{< <=} test) (when-let [[e :as s] (. sc seqFrom key false)] (if (include e) s (next s))) (take-while include (. sc seq false))))) ([^clojure.lang.Sorted sc start-test start-key end-test end-key] (when-let [[e :as s] (. sc seqFrom end-key false)] (take-while (mk-bound-fn sc start-test start-key) (if ((mk-bound-fn sc end-test end-key) e) s (next s)))))) (defn repeatedly "Takes a function of no args, presumably with side effects, and returns an infinite (or length n if supplied) lazy sequence of calls to it" {:added "1.0"} ([f] (lazy-seq (cons (f) (repeatedly f)))) ([n f] (take n (repeatedly f)))) (defn add-classpath "DEPRECATED Adds the url (String or URL object) to the classpath per URLClassLoader.addURL" {:added "1.0" :deprecated "1.1"} [url] (println "WARNING: add-classpath is deprecated") (clojure.lang.RT/addURL url)) (defn hash "Returns the hash code of its argument" {:added "1.0"} [x] (. clojure.lang.Util (hash x))) (defn interpose "Returns a lazy seq of the elements of coll separated by sep" {:added "1.0"} [sep coll] (drop 1 (interleave (repeat sep) coll))) (defmacro definline "Experimental - like defmacro, except defines a named function whose body is the expansion, calls to which may be expanded inline as if it were a macro. Cannot be used with variadic (&) args." {:added "1.0"} [name & decl] (let [[pre-args [args expr]] (split-with (comp not vector?) decl)] `(do (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args)) (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr)) (var ~name)))) (defn empty "Returns an empty collection of the same category as coll, or nil" {:added "1.0"} [coll] (when (instance? clojure.lang.IPersistentCollection coll) (.empty ^clojure.lang.IPersistentCollection coll))) (defmacro amap "Maps an expression across an array a, using an index named idx, and return value named ret, initialized to a clone of a, then setting each element of ret to the evaluation of expr, returning the new array ret." {:added "1.0"} [a idx ret expr] `(let [a# ~a ~ret (aclone a#)] (loop [~idx (int 0)] (if (< ~idx (alength a#)) (do (aset ~ret ~idx ~expr) (recur (unchecked-inc ~idx))) ~ret)))) (defmacro areduce "Reduces an expression across an array a, using an index named idx, and return value named ret, initialized to init, setting ret to the evaluation of expr at each step, returning ret." {:added "1.0"} [a idx ret init expr] `(let [a# ~a] (loop [~idx (int 0) ~ret ~init] (if (< ~idx (alength a#)) (recur (unchecked-inc ~idx) ~expr) ~ret)))) (defn float-array "Creates an array of floats" {:inline (fn [& args] `(. clojure.lang.Numbers float_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq))) (defn boolean-array "Creates an array of booleans" {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq))) (defn byte-array "Creates an array of bytes" {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq))) (defn char-array "Creates an array of chars" {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq))) (defn short-array "Creates an array of shorts" {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq))) (defn double-array "Creates an array of doubles" {:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers double_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers double_array size init-val-or-seq))) (defn object-array "Creates an array of objects" {:inline (fn [arg] `(. clojure.lang.RT object_array ~arg)) :inline-arities #{1} :added "1.2"} ([size-or-seq] (. clojure.lang.RT object_array size-or-seq))) (defn int-array "Creates an array of ints" {:inline (fn [& args] `(. clojure.lang.Numbers int_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers int_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq))) (defn long-array "Creates an array of longs" {:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq))) (definline booleans "Casts to boolean[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers booleans ~xs)) (definline bytes "Casts to bytes[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers bytes ~xs)) (definline chars "Casts to chars[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers chars ~xs)) (definline shorts "Casts to shorts[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers shorts ~xs)) (definline floats "Casts to float[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers floats ~xs)) (definline ints "Casts to int[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers ints ~xs)) (definline doubles "Casts to double[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers doubles ~xs)) (definline longs "Casts to long[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers longs ~xs)) (import '(java.util.concurrent BlockingQueue LinkedBlockingQueue)) (defn seque "Creates a queued seq on another (presumably lazy) seq s. The queued seq will produce a concrete seq in the background, and can get up to n items ahead of the consumer. n-or-q can be an integer n buffer size, or an instance of java.util.concurrent BlockingQueue. Note that reading from a seque can block if the reader gets ahead of the producer." {:added "1.0"} ([s] (seque 100 s)) ([n-or-q s] (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q) n-or-q (LinkedBlockingQueue. (int n-or-q))) NIL (Object.) ;nil sentinel since LBQ doesn't support nils agt (agent (seq s)) fill (fn [s] (try (loop [[x & xs :as s] s] (if s (if (.offer q (if (nil? x) NIL x)) (recur xs) s) (.put q q))) ; q itself is eos sentinel (catch Exception e (.put q q) (throw e)))) drain (fn drain [] (lazy-seq (let [x (.take q)] (if (identical? x q) ;q itself is eos sentinel (do @agt nil) ;touch agent just to propagate errors (do (send-off agt fill) (cons (if (identical? x NIL) nil x) (drain)))))))] (send-off agt fill) (drain)))) (defn class? "Returns true if x is an instance of Class" {:added "1.0"} [x] (instance? Class x)) (defn- is-annotation? [c] (and (class? c) (.isAssignableFrom java.lang.annotation.Annotation c))) (defn- is-runtime-annotation? [^Class c] (boolean (and (is-annotation? c) (when-let [^java.lang.annotation.Retention r (.getAnnotation c java.lang.annotation.Retention)] (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME))))) (defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c)) (declare process-annotation) (defn- add-annotation [^clojure.asm.AnnotationVisitor av name v] (cond (vector? v) (let [avec (.visitArray av name)] (doseq [vval v] (add-annotation avec "value" vval)) (.visitEnd avec)) (symbol? v) (let [ev (eval v)] (cond (instance? java.lang.Enum ev) (.visitEnum av name (descriptor (class ev)) (str ev)) (class? ev) (.visit av name (clojure.asm.Type/getType ev)) :else (throw (IllegalArgumentException. (str "Unsupported annotation value: " v " of class " (class ev)))))) (seq? v) (let [[nested nv] v c (resolve nested) nav (.visitAnnotation av name (descriptor c))] (process-annotation nav nv) (.visitEnd nav)) :else (.visit av name v))) (defn- process-annotation [av v] (if (map? v) (doseq [[k v] v] (add-annotation av (name k) v)) (add-annotation av "value" v))) (defn- add-annotations ([visitor m] (add-annotations visitor m nil)) ([visitor m i] (doseq [[k v] m] (when (symbol? k) (when-let [c (resolve k)] (when (is-annotation? c) ;this is known duck/reflective as no common base of ASM Visitors (let [av (if i (.visitParameterAnnotation visitor i (descriptor c) (is-runtime-annotation? c)) (.visitAnnotation visitor (descriptor c) (is-runtime-annotation? c)))] (process-annotation av v) (.visitEnd av)))))))) (defn alter-var-root "Atomically alters the root binding of var v by applying f to its current value plus any args" {:added "1.0"} [^clojure.lang.Var v f & args] (.alterRoot v f args)) (defn bound? "Returns true if all of the vars provided as arguments have any bound value, root or thread-local. Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2"} [& vars] (every? #(.isBound ^clojure.lang.Var %) vars)) (defn thread-bound? "Returns true if all of the vars provided as arguments have thread-local bindings. Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2"} [& vars] (every? #(.getThreadBinding ^clojure.lang.Var %) vars)) (defn make-hierarchy "Creates a hierarchy object for use with derive, isa? etc." {:added "1.0"} [] {:parents {} :descendants {} :ancestors {}}) (def ^{:private true} global-hierarchy (make-hierarchy)) (defn not-empty "If coll is empty, returns nil, else coll" {:added "1.0"} [coll] (when (seq coll) coll)) (defn bases "Returns the immediate superclass and direct interfaces of c, if any" {:added "1.0"} [^Class c] (when c (let [i (.getInterfaces c) s (.getSuperclass c)] (not-empty (if s (cons s i) i))))) (defn supers "Returns the immediate and indirect superclasses and interfaces of c, if any" {:added "1.0"} [^Class class] (loop [ret (set (bases class)) cs ret] (if (seq cs) (let [c (first cs) bs (bases c)] (recur (into ret bs) (into (disj cs c) bs))) (not-empty ret)))) (defn isa? "Returns true if (= child parent), or child is directly or indirectly derived from parent, either via a Java type inheritance relationship or a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" {:added "1.0"} ([child parent] (isa? global-hierarchy child parent)) ([h child parent] (or (= child parent) (and (class? parent) (class? child) (. ^Class parent isAssignableFrom child)) (contains? ((:ancestors h) child) parent) (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child))) (and (vector? parent) (vector? child) (= (count parent) (count child)) (loop [ret true i 0] (if (or (not ret) (= i (count parent))) ret (recur (isa? h (child i) (parent i)) (inc i)))))))) (defn parents "Returns the immediate parents of tag, either via a Java type inheritance relationship or a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" {:added "1.0"} ([tag] (parents global-hierarchy tag)) ([h tag] (not-empty (let [tp (get (:parents h) tag)] (if (class? tag) (into (set (bases tag)) tp) tp))))) (defn ancestors "Returns the immediate and indirect parents of tag, either via a Java type inheritance relationship or a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" {:added "1.0"} ([tag] (ancestors global-hierarchy tag)) ([h tag] (not-empty (let [ta (get (:ancestors h) tag)] (if (class? tag) (let [superclasses (set (supers tag))] (reduce into superclasses (cons ta (map #(get (:ancestors h) %) superclasses)))) ta))))) (defn descendants "Returns the immediate and indirect children of tag, through a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy. Note: does not work on Java type inheritance relationships." {:added "1.0"} ([tag] (descendants global-hierarchy tag)) ([h tag] (if (class? tag) (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes")) (not-empty (get (:descendants h) tag))))) (defn derive "Establishes a parent/child relationship between parent and tag. Parent must be a namespace-qualified symbol or keyword and child can be either a namespace-qualified symbol or keyword or a class. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (assert (namespace parent)) (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag)))) (alter-var-root #'global-hierarchy derive tag parent) nil) ([h tag parent] (assert (not= tag parent)) (assert (or (class? tag) (instance? clojure.lang.Named tag))) (assert (instance? clojure.lang.Named parent)) (let [tp (:parents h) td (:descendants h) ta (:ancestors h) tf (fn [m source sources target targets] (reduce (fn [ret k] (assoc ret k (reduce conj (get targets k #{}) (cons target (targets target))))) m (cons source (sources source))))] (or (when-not (contains? (tp tag) parent) (when (contains? (ta tag) parent) (throw (Exception. (print-str tag "already has" parent "as ancestor")))) (when (contains? (ta parent) tag) (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor")))) {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent)) :ancestors (tf (:ancestors h) tag td parent ta) :descendants (tf (:descendants h) parent ta tag td)}) h)))) (declare flatten) (defn underive "Removes a parent/child relationship between parent and tag. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil) ([h tag parent] (let [parentMap (:parents h) childsParents (if (parentMap tag) (disj (parentMap tag) parent) #{}) newParents (if (not-empty childsParents) (assoc parentMap tag childsParents) (dissoc parentMap tag)) deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %))) (seq newParents)))] (if (contains? (parentMap tag) parent) (reduce #(apply derive %1 %2) (make-hierarchy) (partition 2 deriv-seq)) h)))) (defn distinct? "Returns true if no two of the arguments are =" {:tag Boolean :added "1.0"} ([x] true) ([x y] (not (= x y))) ([x y & more] (if (not= x y) (loop [s #{x y} [x & etc :as xs] more] (if xs (if (contains? s x) false (recur (conj s x) etc)) true)) false))) (defn resultset-seq "Creates and returns a lazy sequence of structmaps corresponding to the rows in the java.sql.ResultSet rs" {:added "1.0"} [^java.sql.ResultSet rs] (let [rsmeta (. rs (getMetaData)) idxs (range 1 (inc (. rsmeta (getColumnCount)))) keys (map (comp keyword #(.toLowerCase ^String %)) (map (fn [i] (. rsmeta (getColumnLabel i))) idxs)) check-keys (or (apply distinct? keys) (throw (Exception. "ResultSet must have unique column labels"))) row-struct (apply create-struct keys) row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs)) rows (fn thisfn [] (when (. rs (next)) (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))] (rows))) (defn iterator-seq "Returns a seq on a java.util.Iterator. Note that most collections providing iterators implement Iterable and thus support seq directly." {:added "1.0"} [iter] (clojure.lang.IteratorSeq/create iter)) (defn enumeration-seq "Returns a seq on a java.util.Enumeration" {:added "1.0"} [e] (clojure.lang.EnumerationSeq/create e)) (defn format "Formats a string using java.lang.String.format, see java.util.Formatter for format string syntax" {:tag String :added "1.0"} [fmt & args] (String/format fmt (to-array args))) (defn printf "Prints formatted output, as per format" {:added "1.0"} [fmt & args] (print (apply format fmt args))) (declare gen-class) (defmacro with-loading-context [& body] `((fn loading# [] (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER (.getClassLoader (.getClass ^Object loading#))})) (try ~@body (finally (. clojure.lang.Var (popThreadBindings))))))) (defmacro ns "Sets *ns* to the namespace named by name (unevaluated), creating it if needed. references can be zero or more of: (:refer-clojure ...) (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class) with the syntax of refer-clojure/require/use/import/load/gen-class respectively, except the arguments are unevaluated and need not be quoted. (:gen-class ...), when supplied, defaults to :name corresponding to the ns name, :main true, :impl-ns same as ns, and :init-impl-ns true. All options of gen-class are supported. The :gen-class directive is ignored when not compiling. If :gen-class is not supplied, when compiled only an nsname__init.class will be generated. If :refer-clojure is not used, a default (refer 'clojure) is used. Use of ns is preferred to individual calls to in-ns/require/use/import: (ns foo.bar (:refer-clojure :exclude [ancestors printf]) (:require (clojure.contrib sql sql.tests)) (:use (my.lib this that)) (:import (java.util Date Timer Random) (java.sql Connection Statement)))" {:arglists '([name docstring? attr-map? references*]) :added "1.0"} [name & references] (let [process-reference (fn [[kname & args]] `(~(symbol "clojure.core" (clojure.core/name kname)) ~@(map #(list 'quote %) args))) docstring (when (string? (first references)) (first references)) references (if docstring (next references) references) name (if docstring (vary-meta name assoc :doc docstring) name) metadata (when (map? (first references)) (first references)) references (if metadata (next references) references) name (if metadata (vary-meta name merge metadata) name) gen-class-clause (first (filter #(= :gen-class (first %)) references)) gen-class-call (when gen-class-clause (list* `gen-class :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause))) references (remove #(= :gen-class (first %)) references) ;ns-effect (clojure.core/in-ns name) ] `(do (clojure.core/in-ns '~name) (with-loading-context ~@(when gen-class-call (list gen-class-call)) ~@(when (and (not= name 'clojure.core) (not-any? #(= :refer-clojure (first %)) references)) `((clojure.core/refer '~'clojure.core))) ~@(map process-reference references))))) (defmacro refer-clojure "Same as (refer 'clojure.core )" {:added "1.0"} [& filters] `(clojure.core/refer '~'clojure.core ~@filters)) (defmacro defonce "defs name to have the root value of the expr iff the named var has no root value, else expr is unevaluated" {:added "1.0"} [name expr] `(let [v# (def ~name)] (when-not (.hasRoot v#) (def ~name ~expr)))) ;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;; (defonce ^{:private true :doc "A ref to a sorted set of symbols representing loaded libs"} *loaded-libs* (ref (sorted-set))) (defonce ^{:private true :doc "A stack of paths currently being loaded by this thread"} *pending-paths* ()) (defonce ^{:private true :doc "True while a verbose load is pending"} *loading-verbosely* false) (defn- throw-if "Throws an exception with a message if pred is true" [pred fmt & args] (when pred (let [^String message (apply format fmt args) exception (Exception. message) raw-trace (.getStackTrace exception) boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke") trace (into-array (drop 2 (drop-while boring? raw-trace)))] (.setStackTrace exception trace) (throw exception)))) (defn- libspec? "Returns true if x is a libspec" [x] (or (symbol? x) (and (vector? x) (or (nil? (second x)) (keyword? (second x)))))) (defn- prependss "Prepends a symbol or a seq to coll" [x coll] (if (symbol? x) (cons x coll) (concat x coll))) (defn- root-resource "Returns the root directory path for a lib" {:tag String} [lib] (str \/ (.. (name lib) (replace \- \_) (replace \. \/)))) (defn- root-directory "Returns the root resource path for a lib" [lib] (let [d (root-resource lib)] (subs d 0 (.lastIndexOf d "/")))) (declare load) (defn- load-one "Loads a lib given its name. If need-ns, ensures that the associated namespace exists after loading. If require, records the load so any duplicate loads can be skipped." [lib need-ns require] (load (root-resource lib)) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found after loading '%s'" lib (root-resource lib)) (when require (dosync (commute *loaded-libs* conj lib)))) (defn- load-all "Loads a lib given its name and forces a load of any libs it directly or indirectly loads. If need-ns, ensures that the associated namespace exists after loading. If require, records the load so any duplicate loads can be skipped." [lib need-ns require] (dosync (commute *loaded-libs* #(reduce conj %1 %2) (binding [*loaded-libs* (ref (sorted-set))] (load-one lib need-ns require) @*loaded-libs*)))) (defn- load-lib "Loads a lib with options" [prefix lib & options] (throw-if (and prefix (pos? (.indexOf (name lib) (int \.)))) "lib names inside prefix lists must not contain periods") (let [lib (if prefix (symbol (str prefix \. lib)) lib) opts (apply hash-map options) {:keys [as reload reload-all require use verbose]} opts loaded (contains? @*loaded-libs* lib) load (cond reload-all load-all (or reload (not require) (not loaded)) load-one) need-ns (or as use) filter-opts (select-keys opts '(:exclude :only :rename))] (binding [*loading-verbosely* (or *loading-verbosely* verbose)] (if load (load lib need-ns require) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found" lib)) (when (and need-ns *loading-verbosely*) (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*))) (when as (when *loading-verbosely* (printf "(clojure.core/alias '%s '%s)\n" as lib)) (alias as lib)) (when use (when *loading-verbosely* (printf "(clojure.core/refer '%s" lib) (doseq [opt filter-opts] (printf " %s '%s" (key opt) (print-str (val opt)))) (printf ")\n")) (apply refer lib (mapcat seq filter-opts)))))) (defn- load-libs "Loads libs, interpreting libspecs, prefix lists, and flags for forwarding to load-lib" [& args] (let [flags (filter keyword? args) opts (interleave flags (repeat true)) args (filter (complement keyword?) args)] ; check for unsupported options (let [supported #{:as :reload :reload-all :require :use :verbose} unsupported (seq (remove supported flags))] (throw-if unsupported (apply str "Unsupported option(s) supplied: " (interpose \, unsupported)))) ; check a load target was specified (throw-if (not (seq args)) "Nothing specified to load") (doseq [arg args] (if (libspec? arg) (apply load-lib nil (prependss arg opts)) (let [[prefix & args] arg] (throw-if (nil? prefix) "prefix cannot be nil") (doseq [arg args] (apply load-lib prefix (prependss arg opts)))))))) (defn- check-cyclic-dependency "Detects and rejects non-trivial cyclic load dependencies. The exception message shows the dependency chain with the cycle highlighted. Ignores the trivial case of a file attempting to load itself because that can occur when a gen-class'd class loads its implementation." [path] (when (some #{path} (rest *pending-paths*)) (let [pending (map #(if (= % path) (str "[ " % " ]") %) (cons path *pending-paths*)) chain (apply str (interpose "->" pending))] (throw (Exception. (str "Cyclic load dependency: " chain)))))) ;; Public (defn require "Loads libs, skipping any that are already loaded. Each argument is either a libspec that identifies a lib, a prefix list that identifies multiple libs whose names share a common prefix, or a flag that modifies how all the identified libs are loaded. Use :require in the ns macro in preference to calling this directly. Libs A 'lib' is a named set of resources in classpath whose contents define a library of Clojure code. Lib names are symbols and each lib is associated with a Clojure namespace and a Java package that share its name. A lib's name also locates its root directory within classpath using Java's package name to classpath-relative path mapping. All resources in a lib should be contained in the directory structure under its root directory. All definitions a lib makes should be in its associated namespace. 'require loads a lib by loading its root resource. The root resource path is derived from the lib name in the following manner: Consider a lib named by the symbol 'x.y.z; it has the root directory /x/y/, and its root resource is /x/y/z.clj. The root resource should contain code to create the lib's namespace (usually by using the ns macro) and load any additional lib resources. Libspecs A libspec is a lib name or a vector containing a lib name followed by options expressed as sequential keywords and arguments. Recognized options: :as :as takes a symbol as its argument and makes that symbol an alias to the lib's namespace in the current namespace. Prefix Lists It's common for Clojure code to depend on several libs whose names have the same prefix. When specifying libs, prefix lists can be used to reduce repetition. A prefix list contains the shared prefix followed by libspecs with the shared prefix removed from the lib names. After removing the prefix, the names that remain must not contain any periods. Flags A flag is a keyword. Recognized flags: :reload, :reload-all, :verbose :reload forces loading of all the identified libs even if they are already loaded :reload-all implies :reload and also forces loading of all libs that the identified libs directly or indirectly load via require or use :verbose triggers printing information about each load, alias, and refer Example: The following would load the libraries clojure.zip and clojure.set abbreviated as 's'. (require '(clojure zip [set :as s]))" {:added "1.0"} [& args] (apply load-libs :require args)) (defn use "Like 'require, but also refers to each lib's namespace using clojure.core/refer. Use :use in the ns macro in preference to calling this directly. 'use accepts additional options in libspecs: :exclude, :only, :rename. The arguments and semantics for :exclude, :only, and :rename are the same as those documented for clojure.core/refer." {:added "1.0"} [& args] (apply load-libs :require :use args)) (defn loaded-libs "Returns a sorted set of symbols naming the currently loaded libs" {:added "1.0"} [] @*loaded-libs*) (defn load "Loads Clojure code from resources in classpath. A path is interpreted as classpath-relative if it begins with a slash or relative to the root directory for the current namespace otherwise." {:added "1.0"} [& paths] (doseq [^String path paths] (let [^String path (if (.startsWith path "/") path (str (root-directory (ns-name *ns*)) \/ path))] (when *loading-verbosely* (printf "(clojure.core/load \"%s\")\n" path) (flush)) (check-cyclic-dependency path) (when-not (= path (first *pending-paths*)) (binding [*pending-paths* (conj *pending-paths* path)] (clojure.lang.RT/load (.substring path 1))))))) (defn compile "Compiles the namespace named by the symbol lib into a set of classfiles. The source for the lib must be in a proper classpath-relative directory. The output files will go into the directory specified by *compile-path*, and that directory too must be in the classpath." {:added "1.0"} [lib] (binding [*compile-files* true] (load-one lib true true)) lib) ;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;; (defn get-in "Returns the value in a nested associative structure, where ks is a sequence of ke(ys. Returns nil if the key is not present, or the not-found value if supplied." {:added "1.2"} ([m ks] (reduce get m ks)) ([m ks not-found] (loop [sentinel (Object.) m m ks (seq ks)] (if ks (let [m (get m (first ks) sentinel)] (if (identical? sentinel m) not-found (recur sentinel m (next ks)))) m)))) (defn assoc-in "Associates a value in a nested associative structure, where ks is a sequence of keys and v is the new value and returns a new nested structure. If any levels do not exist, hash-maps will be created." {:added "1.0"} [m [k & ks] v] (if ks (assoc m k (assoc-in (get m k) ks v)) (assoc m k v))) (defn update-in "'Updates' a value in a nested associative structure, where ks is a sequence of keys and f is a function that will take the old value and any supplied args and return the new value, and returns a new nested structure. If any levels do not exist, hash-maps will be created." {:added "1.0"} ([m [k & ks] f & args] (if ks (assoc m k (apply update-in (get m k) ks f args)) (assoc m k (apply f (get m k) args))))) (defn empty? "Returns true if coll has no items - same as (not (seq coll)). Please use the idiom (seq x) rather than (not (empty? x))" {:added "1.0"} [coll] (not (seq coll))) (defn coll? "Returns true if x implements IPersistentCollection" {:added "1.0"} [x] (instance? clojure.lang.IPersistentCollection x)) (defn list? "Returns true if x implements IPersistentList" {:added "1.0"} [x] (instance? clojure.lang.IPersistentList x)) (defn set? "Returns true if x implements IPersistentSet" {:added "1.0"} [x] (instance? clojure.lang.IPersistentSet x)) (defn ifn? "Returns true if x implements IFn. Note that many data structures (e.g. sets and maps) implement IFn" {:added "1.0"} [x] (instance? clojure.lang.IFn x)) (defn fn? "Returns true if x implements Fn, i.e. is an object created via fn." {:added "1.0"} [x] (instance? clojure.lang.Fn x)) (defn associative? "Returns true if coll implements Associative" {:added "1.0"} [coll] (instance? clojure.lang.Associative coll)) (defn sequential? "Returns true if coll implements Sequential" {:added "1.0"} [coll] (instance? clojure.lang.Sequential coll)) (defn sorted? "Returns true if coll implements Sorted" {:added "1.0"} [coll] (instance? clojure.lang.Sorted coll)) (defn counted? "Returns true if coll implements count in constant time" {:added "1.0"} [coll] (instance? clojure.lang.Counted coll)) (defn reversible? "Returns true if coll implements Reversible" {:added "1.0"} [coll] (instance? clojure.lang.Reversible coll)) (def ^{:doc "bound in a repl thread to the most recent value printed" :added "1.0"} *1) (def ^{:doc "bound in a repl thread to the second most recent value printed" :added "1.0"} *2) (def ^{:doc "bound in a repl thread to the third most recent value printed" :added "1.0"} *3) (def ^{:doc "bound in a repl thread to the most recent exception caught by the repl" :added "1.0"} *e) (defn trampoline "trampoline can be used to convert algorithms requiring mutual recursion without stack consumption. Calls f with supplied args, if any. If f returns a fn, calls that fn with no arguments, and continues to repeat, until the return value is not a fn, then returns that non-fn value. Note that if you want to return a fn as a final value, you must wrap it in some data structure and unpack it after trampoline returns." {:added "1.0"} ([f] (let [ret (f)] (if (fn? ret) (recur ret) ret))) ([f & args] (trampoline #(apply f args)))) (defn intern "Finds or creates a var named by the symbol name in the namespace ns (which can be a symbol or a namespace), setting its root binding to val if supplied. The namespace must exist. The var will adopt any metadata from the name symbol. Returns the var." {:added "1.0"} ([ns ^clojure.lang.Symbol name] (let [v (clojure.lang.Var/intern (the-ns ns) name)] (when (meta name) (.setMeta v (meta name))) v)) ([ns name val] (let [v (clojure.lang.Var/intern (the-ns ns) name val)] (when (meta name) (.setMeta v (meta name))) v))) (defmacro while "Repeatedly executes body while test expression is true. Presumes some side-effect will cause test to become false/nil. Returns nil" {:added "1.0"} [test & body] `(loop [] (when ~test ~@body (recur)))) (defn memoize "Returns a memoized version of a referentially transparent function. The memoized version of the function keeps a cache of the mapping from arguments to results and, when calls with the same arguments are repeated often, has higher performance at the expense of higher memory use." {:added "1.0"} [f] (let [mem (atom {})] (fn [& args] (if-let [e (find @mem args)] (val e) (let [ret (apply f args)] (swap! mem assoc args ret) ret))))) (defmacro condp "Takes a binary predicate, an expression, and a set of clauses. Each clause can take the form of either: test-expr result-expr test-expr :>> result-fn Note :>> is an ordinary keyword. For each clause, (pred test-expr expr) is evaluated. If it returns logical true, the clause is a match. If a binary clause matches, the result-expr is returned, if a ternary clause matches, its result-fn, which must be a unary function, is called with the result of the predicate as its argument, the result of that call being the return value of condp. A single default expression can follow the clauses, and its value will be returned if no clause matches. If no default expression is provided and no clause matches, an IllegalArgumentException is thrown." {:added "1.0"} [pred expr & clauses] (let [gpred (gensym "pred__") gexpr (gensym "expr__") emit (fn emit [pred expr args] (let [[[a b c :as clause] more] (split-at (if (= :>> (second args)) 3 2) args) n (count clause)] (cond (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr))) (= 1 n) a (= 2 n) `(if (~pred ~a ~expr) ~b ~(emit pred expr more)) :else `(if-let [p# (~pred ~a ~expr)] (~c p#) ~(emit pred expr more))))) gres (gensym "res__")] `(let [~gpred ~pred ~gexpr ~expr] ~(emit gpred gexpr clauses)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;; (alter-meta! #'*agent* assoc :added "1.0") (alter-meta! #'in-ns assoc :added "1.0") (alter-meta! #'load-file assoc :added "1.0") (defmacro add-doc-and-meta {:private true} [name docstring meta] `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring))) (add-doc-and-meta *file* "The path of the file being evaluated, as a String. Evaluates to nil when there is no file, eg. in the REPL." {:added "1.0"}) (add-doc-and-meta *command-line-args* "A sequence of the supplied command line arguments, or nil if none were supplied" {:added "1.0"}) (add-doc-and-meta *warn-on-reflection* "When set to true, the compiler will emit warnings when reflection is needed to resolve Java method calls or field accesses. Defaults to false." {:added "1.0"}) (add-doc-and-meta *compile-path* "Specifies the directory where 'compile' will write out .class files. This directory must be in the classpath for 'compile' to work. Defaults to \"classes\"" {:added "1.0"}) (add-doc-and-meta *compile-files* "Set to true when compiling files, false otherwise." {:added "1.0"}) (add-doc-and-meta *ns* "A clojure.lang.Namespace object representing the current namespace." {:added "1.0"}) (add-doc-and-meta *in* "A java.io.Reader object representing standard input for read operations. Defaults to System/in, wrapped in a LineNumberingPushbackReader" {:added "1.0"}) (add-doc-and-meta *out* "A java.io.Writer object representing standard output for print operations. Defaults to System/out" {:added "1.0"}) (add-doc-and-meta *err* "A java.io.Writer object representing standard error for print operations. Defaults to System/err, wrapped in a PrintWriter" {:added "1.0"}) (add-doc-and-meta *flush-on-newline* "When set to true, output will be flushed whenever a newline is printed. Defaults to true." {:added "1.0"}) (add-doc-and-meta *print-meta* "If set to logical true, when printing an object, its metadata will also be printed in a form that can be read back by the reader. Defaults to false." {:added "1.0"}) (add-doc-and-meta *print-dup* "When set to logical true, objects will be printed in a way that preserves their type when read in later. Defaults to false." {:added "1.0"}) (add-doc-and-meta *print-readably* "When set to logical false, strings and characters will be printed with non-alphanumeric characters converted to the appropriate escape sequences. Defaults to true" {:added "1.0"}) (add-doc-and-meta *read-eval* "When set to logical false, the EvalReader (#=(...)) is disabled in the read/load in the thread-local binding. Example: (binding [*read-eval* false] (read-string \"#=(eval (def x 3))\")) Defaults to true" {:added "1.0"}) (defn future? "Returns true if x is a future" {:added "1.1"} [x] (instance? java.util.concurrent.Future x)) (defn future-done? "Returns true if future f is done" {:added "1.1"} [^java.util.concurrent.Future f] (.isDone f)) (defmacro letfn "Takes a vector of function specs and a body, and generates a set of bindings of functions to their names. All of the names are available in all of the definitions of the functions, as well as the body. fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)" {:added "1.0"} [fnspecs & body] `(letfn* ~(vec (interleave (map first fnspecs) (map #(cons `fn %) fnspecs))) ~@body)) ;;;;;;; case ;;;;;;;;;;;;; (defn- shift-mask [shift mask x] (-> x (bit-shift-right shift) (bit-and mask))) (defn- min-hash "takes a collection of keys and returns [shift mask]" [keys] (let [hashes (map hash keys) cnt (count keys)] (when-not (apply distinct? hashes) (throw (IllegalArgumentException. "Hashes must be distinct"))) (or (first (filter (fn [[s m]] (apply distinct? (map #(shift-mask s m %) hashes))) (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 14)) shift (range 0 31)] [shift mask]))) (throw (IllegalArgumentException. "No distinct mapping found"))))) (defmacro case "Takes an expression, and a set of clauses. Each clause can take the form of either: test-constant result-expr (test-constant1 ... test-constantN) result-expr The test-constants are not evaluated. They must be compile-time literals, and need not be quoted. If the expression is equal to a test-constant, the corresponding result-expr is returned. A single default expression can follow the clauses, and its value will be returned if no clause matches. If no default expression is provided and no clause matches, an IllegalArgumentException is thrown. Unlike cond and condp, case does a constant-time dispatch, the clauses are not considered sequentially. All manner of constant expressions are acceptable in case, including numbers, strings, symbols, keywords, and (Clojure) composites thereof. Note that since lists are used to group multiple constants that map to the same expression, a vector can be used to match a list if needed. The test-constants need not be all of the same type." {:added "1.2"} [e & clauses] (let [ge (with-meta (gensym) {:tag Object}) default (if (odd? (count clauses)) (last clauses) `(throw (IllegalArgumentException. (str "No matching clause: " ~ge)))) cases (partition 2 clauses) case-map (reduce (fn [m [test expr]] (if (seq? test) (into m (zipmap test (repeat expr))) (assoc m test expr))) {} cases) [shift mask] (if (seq case-map) (min-hash (keys case-map)) [0 0]) hmap (reduce (fn [m [test expr :as te]] (assoc m (shift-mask shift mask (hash test)) te)) (sorted-map) case-map)] `(let [~ge ~e] ~(condp = (count clauses) 0 default 1 default `(case* ~ge ~shift ~mask ~(key (first hmap)) ~(key (last hmap)) ~default ~hmap ~(every? keyword? (keys case-map))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language") (load "core_proxy") (load "core_print") (load "genclass") (load "core_deftype") (load "core/protocols") (load "gvec") ;; redefine reduce with internal-reduce #_(defn reduce "f should be a function of 2 arguments. If val is not supplied, returns the result of applying f to the first 2 items in coll, then applying f to that result and the 3rd item, etc. If coll contains no items, f must accept no arguments as well, and reduce returns the result of calling f with no arguments. If coll has only 1 item, it is returned and f is not called. If val is supplied, returns the result of applying f to val and the first item in coll, then applying f to that result and the 2nd item, etc. If coll contains no items, returns val and f is not called." {:added "1.0"} ([f coll] (if-let [s (seq coll)] (reduce f (first s) (next s)) (f))) ([f val coll] (let [s (seq coll)] (clojure.core.protocols/internal-reduce s f val)))) (require '[clojure.java.io :as jio]) (defn- normalize-slurp-opts [opts] (if (string? (first opts)) (do (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).") [:encoding (first opts)]) opts)) (defn slurp "Reads the file named by f using the encoding enc into a string and returns it." {:added "1.0"} ([f & opts] (let [opts (normalize-slurp-opts opts) sb (StringBuilder.)] (with-open [#^java.io.Reader r (apply jio/reader f opts)] (loop [c (.read r)] (if (neg? c) (str sb) (do (.append sb (char c)) (recur (.read r))))))))) (defn spit "Opposite of slurp. Opens f with writer, writes content, then closes f. Options passed to clojure.java.io/writer." {:added "1.2"} [f content & options] (with-open [#^java.io.Writer w (apply jio/writer f options)] (.write w (str content)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;; (defn future-call "Takes a function of no args and yields a future object that will invoke the function in another thread, and will cache the result and return it on all subsequent calls to deref/@. If the computation has not yet finished, calls to deref/@ will block." {:added "1.1"} [^Callable f] (let [fut (.submit clojure.lang.Agent/soloExecutor f)] (reify clojure.lang.IDeref (deref [_] (.get fut)) java.util.concurrent.Future (get [_] (.get fut)) (get [_ timeout unit] (.get fut timeout unit)) (isCancelled [_] (.isCancelled fut)) (isDone [_] (.isDone fut)) (cancel [_ interrupt?] (.cancel fut interrupt?))))) (defmacro future "Takes a body of expressions and yields a future object that will invoke the body in another thread, and will cache the result and return it on all subsequent calls to deref/@. If the computation has not yet finished, calls to deref/@ will block." {:added "1.1"} [& body] `(future-call (^{:once true} fn* [] ~@body))) (defn future-cancel "Cancels the future, if possible." {:added "1.1"} [^java.util.concurrent.Future f] (.cancel f true)) (defn future-cancelled? "Returns true if future f is cancelled" {:added "1.1"} [^java.util.concurrent.Future f] (.isCancelled f)) (defn pmap "Like map, except f is applied in parallel. Semi-lazy in that the parallel computation stays ahead of the consumption, but doesn't realize the entire result unless required. Only useful for computationally intensive functions where the time of f dominates the coordination overhead." {:added "1.0"} ([f coll] (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) rets (map #(future (f %)) coll) step (fn step [[x & xs :as vs] fs] (lazy-seq (if-let [s (seq fs)] (cons (deref x) (step xs (rest s))) (map deref vs))))] (step rets (drop n rets)))) ([f coll & colls] (let [step (fn step [cs] (lazy-seq (let [ss (map seq cs)] (when (every? identity ss) (cons (map first ss) (step (map rest ss)))))))] (pmap #(apply f %) (step (cons coll colls)))))) (defn pcalls "Executes the no-arg fns in parallel, returning a lazy sequence of their values" {:added "1.0"} [& fns] (pmap #(%) fns)) (defmacro pvalues "Returns a lazy sequence of the values of the exprs, which are evaluated in parallel" {:added "1.0"} [& exprs] `(pcalls ~@(map #(list `fn [] %) exprs))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;; (let [version-stream (.getResourceAsStream (clojure.lang.RT/baseLoader) "clojure/version.properties") properties (doto (new java.util.Properties) (.load version-stream)) prop (fn [k] (.getProperty properties (str "clojure.version." k))) clojure-version {:major (Integer/valueOf ^String (prop "major")) :minor (Integer/valueOf ^String (prop "minor")) :incremental (Integer/valueOf ^String (prop "incremental")) :qualifier (prop "qualifier")}] (def *clojure-version* (if (not (= (prop "interim") "false")) (clojure.lang.RT/assoc clojure-version :interim true) clojure-version))) (add-doc-and-meta *clojure-version* "The version info for Clojure core, as a map containing :major :minor :incremental and :qualifier keys. Feature releases may increment :minor and/or :major, bugfix releases will increment :incremental. Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\"" {:added "1.0"}) (defn clojure-version "Returns clojure version as a printable string." {:added "1.0"} [] (str (:major *clojure-version*) "." (:minor *clojure-version*) (when-let [i (:incremental *clojure-version*)] (str "." i)) (when-let [q (:qualifier *clojure-version*)] (when (pos? (count q)) (str "-" q))) (when (:interim *clojure-version*) "-SNAPSHOT"))) (defn promise "Alpha - subject to change. Returns a promise object that can be read with deref/@, and set, once only, with deliver. Calls to deref/@ prior to delivery will block. All subsequent derefs will return the same delivered value without blocking." {:added "1.1"} [] (let [d (java.util.concurrent.CountDownLatch. 1) v (atom nil)] (reify clojure.lang.IDeref (deref [_] (.await d) @v) clojure.lang.IFn (invoke [this x] (locking d (if (pos? (.getCount d)) (do (reset! v x) (.countDown d) this) (throw (IllegalStateException. "Multiple deliver calls to a promise")))))))) (defn deliver "Alpha - subject to change. Delivers the supplied value to the promise, releasing any pending derefs. A subsequent call to deliver on a promise will throw an exception." {:added "1.1"} [promise val] (promise val)) (defn flatten "Takes any nested combination of sequential things (lists, vectors, etc.) and returns their contents as a single, flat sequence. (flatten nil) returns nil." {:added "1.2"} [x] (filter (complement sequential?) (rest (tree-seq sequential? seq x)))) (defn group-by "Returns a map of the elements of coll keyed by the result of f on each element. The value at each key will be a vector of the corresponding elements, in the order they appeared in coll." {:added "1.2"} [f coll] (persistent! (reduce (fn [ret x] (let [k (f x)] (assoc! ret k (conj (get ret k []) x)))) (transient {}) coll))) (defn partition-by "Applies f to each value in coll, splitting it each time f returns a new value. Returns a lazy seq of partitions." {:added "1.2"} [f coll] (lazy-seq (when-let [s (seq coll)] (let [fst (first s) fv (f fst) run (cons fst (take-while #(= fv (f %)) (rest s)))] (cons run (partition-by f (drop (count run) s))))))) (defn frequencies "Returns a map from distinct items in coll to the number of times they appear." {:added "1.2"} [coll] (persistent! (reduce (fn [counts x] (assoc! counts x (inc (get counts x 0)))) (transient {}) coll))) (defn reductions "Returns a lazy seq of the intermediate values of the reduction (as per reduce) of coll by f, starting with init." {:added "1.2"} ([f coll] (lazy-seq (if-let [s (seq coll)] (reductions f (first s) (rest s)) (list (f))))) ([f init coll] (cons init (lazy-seq (when-let [s (seq coll)] (reductions f (f init (first s)) (rest s))))))) (defn rand-nth "Return a random element of the (sequential) collection. Will have the same performance characteristics as nth for the given collection." {:added "1.2"} [coll] (nth coll (rand-int (count coll)))) (defn partition-all "Returns a lazy sequence of lists like partition, but may include partitions with fewer than n items at the end." {:added "1.2"} ([n coll] (partition-all n n coll)) ([n step coll] (lazy-seq (when-let [s (seq coll)] (cons (take n s) (partition-all n step (drop step s))))))) (defn shuffle "Return a random permutation of coll" {:added "1.2"} [coll] (let [al (java.util.ArrayList. coll)] (java.util.Collections/shuffle al) (clojure.lang.RT/vector (.toArray al)))) (defn map-indexed "Returns a lazy sequence consisting of the result of applying f to 0 and the first item of coll, followed by applying f to 1 and the second item in coll, etc, until coll is exhausted. Thus function f should accept 2 arguments, index and item." {:added "1.2"} [f coll] (letfn [(mapi [idx coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (int (count c)) b (chunk-buffer size)] (dotimes [i size] (chunk-append b (f (+ idx i) (.nth c i)))) (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s)))) (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))] (mapi 0 coll))) (defn keep "Returns a lazy sequence of the non-nil results of (f item). Note, this means false return values will be included. f must be free of side-effects." {:added "1.2"} ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [x (f (.nth c i))] (when-not (nil? x) (chunk-append b x)))) (chunk-cons (chunk b) (keep f (chunk-rest s)))) (let [x (f (first s))] (if (nil? x) (keep f (rest s)) (cons x (keep f (rest s)))))))))) (defn keep-indexed "Returns a lazy sequence of the non-nil results of (f index item). Note, this means false return values will be included. f must be free of side-effects." {:added "1.2"} ([f coll] (letfn [(keepi [idx coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [x (f (+ idx i) (.nth c i))] (when-not (nil? x) (chunk-append b x)))) (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s)))) (let [x (f idx (first s))] (if (nil? x) (keepi (inc idx) (rest s)) (cons x (keepi (inc idx) (rest s)))))))))] (keepi 0 coll)))) (defn fnil "Takes a function f, and returns a function that calls f, replacing a nil first argument to f with the supplied value x. Higher arity versions can replace arguments in the second and third positions (y, z). Note that the function f can take any number of arguments, not just the one(s) being nil-patched." {:added "1.2"} ([f x] (fn ([a] (f (if (nil? a) x a))) ([a b] (f (if (nil? a) x a) b)) ([a b c] (f (if (nil? a) x a) b c)) ([a b c & ds] (apply f (if (nil? a) x a) b c ds)))) ([f x y] (fn ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c)) ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds)))) ([f x y z] (fn ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c))) ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds))))) (defn- ^{:dynamic true} assert-valid-fdecl "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn." [fdecl] (if-let [bad-args (seq (remove #(vector? %) (map first fdecl)))] (throw (IllegalArgumentException. (str "Parameter declaration " (first bad-args) " should be a vector"))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/core/000077500000000000000000000000001157562347600213115ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/core/protocols.clj000066400000000000000000000047041157562347600240340ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.core.protocols) (defprotocol InternalReduce "Protocol for concrete seq types that can reduce themselves faster than first/next recursion. Called by clojure.core/reduce." (internal-reduce [seq f start])) (extend-protocol InternalReduce nil (internal-reduce [s f val] val) ;; handles vectors and ranges clojure.lang.IChunkedSeq (internal-reduce [s f val] (if-let [s (seq s)] (if (chunked-seq? s) (recur (chunk-next s) f (.reduce (chunk-first s) f val)) (internal-reduce s f val)) val)) clojure.lang.StringSeq (internal-reduce [str-seq f val] (let [s (.s str-seq)] (loop [i (.i str-seq) val val] (if (< i (.length s)) (recur (inc i) (f val (.charAt s i))) val)))) clojure.lang.ArraySeq (internal-reduce [a-seq f val] (let [^objects arr (.array a-seq)] (loop [i (.index a-seq) val val] (if (< i (alength arr)) (recur (inc i) (f val (aget arr i))) val)))) java.lang.Object (internal-reduce [s f val] (loop [cls (class s) s s f f val val] (if-let [s (seq s)] ;; roll over to faster implementation if underlying seq changes type (if (identical? (class s) cls) (recur cls (next s) f (f val (first s))) (internal-reduce s f val)) val)))) (def arr-impl '(internal-reduce [a-seq f val] (let [arr (.array a-seq)] (loop [i (.index a-seq) val val] (if (< i (alength arr)) (recur (inc i) (f val (aget arr i))) val))))) (defn- emit-array-impls* [syms] (apply concat (map (fn [s] [(symbol (str "clojure.lang.ArraySeq$ArraySeq_" s)) arr-impl]) syms))) (defmacro emit-array-impls [& syms] `(extend-protocol InternalReduce ~@(emit-array-impls* syms))) (emit-array-impls int long float double byte char boolean) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/core_deftype.clj000066400000000000000000000743301157562347600235320ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; definterface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn namespace-munge "Convert a Clojure namespace name to a legal Java package name." {:added "1.2"} [ns] (.replace (str ns) \- \_)) ;for now, built on gen-interface (defmacro definterface [name & sigs] (let [tag (fn [x] (or (:tag (meta x)) Object)) psig (fn [[name [& args]]] (vector name (vec (map tag args)) (tag name) (map meta args))) cname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))] `(let [] (gen-interface :name ~cname :methods ~(vec (map psig sigs))) (import ~cname)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- parse-opts [s] (loop [opts {} [k v & rs :as s] s] (if (keyword? k) (recur (assoc opts k v) rs) [opts s]))) (defn- parse-impls [specs] (loop [ret {} s specs] (if (seq s) (recur (assoc ret (first s) (take-while seq? (next s))) (drop-while seq? (next s))) ret))) (defn- parse-opts+specs [opts+specs] (let [[opts specs] (parse-opts opts+specs) impls (parse-impls specs) interfaces (-> (map #(if (var? (resolve %)) (:on (deref (resolve %))) %) (keys impls)) set (disj 'Object 'java.lang.Object) vec) methods (map (fn [[name params & body]] (cons name (maybe-destructured params body))) (apply concat (vals impls)))] (when-let [bad-opts (seq (remove #{:no-print} (keys opts)))] (throw (IllegalArgumentException. (apply print-str "Unsupported option(s) -" bad-opts)))) [interfaces methods opts])) (defmacro reify "reify is a macro with the following structure: (reify options* specs*) Currently there are no options. Each spec consists of the protocol or interface name followed by zero or more method bodies: protocol-or-interface-or-Object (methodName [args+] body)* Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for methods of Object. Note that the first parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method head should *not* pass the target object, it will be supplied automatically and can not be substituted. The return type can be indicated by a type hint on the method name, and arg types can be indicated by a type hint on arg names. If you leave out all hints, reify will try to match on same name/arity method in the protocol(s)/interface(s) - this is preferred. If you supply any hints at all, no inference is done, so all hints (or default of Object) must be correct, for both arguments and return type. If a method is overloaded in a protocol/interface, multiple independent method definitions must be supplied. If overloaded with same arity in an interface you must specify complete hints to disambiguate - a missing hint implies Object. recur works to method heads The method bodies of reify are lexical closures, and can refer to the surrounding local scope: (str (let [f \"foo\"] (reify Object (toString [this] f)))) == \"foo\" (seq (let [f \"foo\"] (reify clojure.lang.Seqable (seq [this] (seq f))))) == (\\f \\o \\o))" {:added "1.2"} [& opts+specs] (let [[interfaces methods] (parse-opts+specs opts+specs)] (with-meta `(reify* ~interfaces ~@methods) (meta &form)))) (defn hash-combine [x y] (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y))) (defn munge [s] ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s)))) (defn- imap-cons [^IPersistentMap this o] (cond (instance? java.util.Map$Entry o) (let [^java.util.Map$Entry pair o] (.assoc this (.getKey pair) (.getValue pair))) (instance? clojure.lang.IPersistentVector o) (let [^clojure.lang.IPersistentVector vec o] (.assoc this (.nth vec 0) (.nth vec 1))) :else (loop [this this o o] (if (seq o) (let [^java.util.Map$Entry pair (first o)] (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o))) this)))) (defn- emit-defrecord "Do not use this directly - use defrecord" {:added "1.2"} [tagname name fields interfaces methods] (let [tag (keyword (str *ns*) (str tagname)) classname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name)) interfaces (vec interfaces) interface-set (set (map resolve interfaces)) methodname-set (set (map first methods)) hinted-fields fields fields (vec (map #(with-meta % nil) fields)) base-fields fields fields (conj fields '__meta '__extmap)] (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields)) (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields"))) (let [gs (gensym)] (letfn [(eqhash [[i m]] [i (conj m `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#)) `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))]) (iobj [[i m]] [(conj i 'clojure.lang.IObj) (conj m `(meta [this#] ~'__meta) `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))]) (ilookup [[i m]] [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup) (conj m `(valAt [this# k#] (.valAt this# k# nil)) `(valAt [this# k# else#] (case k# ~@(mapcat (fn [fld] [(keyword fld) fld]) base-fields) (get ~'__extmap k# else#))) `(getLookupThunk [this# k#] (let [~'gclass (class this#)] (case k# ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})] (mapcat (fn [fld] [(keyword fld) `(reify clojure.lang.ILookupThunk (get [~'thunk ~'gtarget] (if (identical? (class ~'gtarget) ~'gclass) (. ~hinted-target ~(keyword fld)) ~'thunk)))]) base-fields)) nil))))]) (imap [[i m]] [(conj i 'clojure.lang.IPersistentMap) (conj m `(count [this#] (+ ~(count base-fields) (count ~'__extmap))) `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname))))) `(cons [this# e#] ((var imap-cons) this# e#)) `(equiv [this# ~gs] (boolean (or (identical? this# ~gs) (when (identical? (class this#) (class ~gs)) (let [~gs ~(with-meta gs {:tag tagname})] (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields) (= ~'__extmap (. ~gs ~'__extmap)))))))) `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#)))) `(entryAt [this# k#] (let [v# (.valAt this# k# this#)] (when-not (identical? this# v#) (clojure.lang.MapEntry. k# v#)))) `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)] ~'__extmap))) `(assoc [this# k# ~gs] (condp identical? k# ~@(mapcat (fn [fld] [(keyword fld) (list* `new tagname (replace {fld gs} fields))]) base-fields) (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs)))) `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#) (dissoc (with-meta (into {} this#) ~'__meta) k#) (new ~tagname ~@(remove #{'__extmap} fields) (not-empty (dissoc ~'__extmap k#))))))]) (ijavamap [[i m]] [(conj i 'java.util.Map 'java.io.Serializable) (conj m `(size [this#] (.count this#)) `(isEmpty [this#] (= 0 (.count this#))) `(containsValue [this# v#] (boolean (some #{v#} (vals this#)))) `(get [this# k#] (.valAt this# k#)) `(put [this# k# v#] (throw (UnsupportedOperationException.))) `(remove [this# k#] (throw (UnsupportedOperationException.))) `(putAll [this# m#] (throw (UnsupportedOperationException.))) `(clear [this#] (throw (UnsupportedOperationException.))) `(keySet [this#] (set (keys this#))) `(values [this#] (vals this#)) `(entrySet [this#] (set this#)))]) ] (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap ijavamap)] `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap) :implements ~(vec i) ~@m)))))) (defmacro defrecord "Alpha - subject to change (defrecord name [fields*] options* specs*) Currently there are no options. Each spec consists of a protocol or interface name followed by zero or more method bodies: protocol-or-interface-or-Object (methodName [args*] body)* Dynamically generates compiled bytecode for class with the given name, in a package with the same name as the current namespace, the given fields, and, optionally, methods for protocols and/or interfaces. The class will have the (immutable) fields named by fields, which can have type hints. Protocols/interfaces and methods are optional. The only methods that can be supplied are those declared in the protocols/interfaces. Note that method bodies are not closures, the local environment includes only the named fields, and those fields can be accessed directy. Method definitions take the form: (methodname [args*] body) The argument and return types can be hinted on the arg and methodname symbols. If not supplied, they will be inferred, so type hints should be reserved for disambiguation. Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for methods of Object. Note that a parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method head should *not* pass the target object, it will be supplied automatically and can not be substituted. In the method bodies, the (unqualified) name can be used to name the class (for calls to new, instance? etc). The class will have implementations of several (clojure.lang) interfaces generated automatically: IObj (metadata support) and IPersistentMap, and all of their superinterfaces. In addition, defrecord will define type-and-value-based equality and hashCode. When AOT compiling, generates compiled bytecode for a class with the given name (a symbol), prepends the current ns as the package, and writes the .class file to the *compile-path* directory. Two constructors will be defined, one taking the designated fields followed by a metadata map (nil for none) and an extension field map (nil for none), and one taking only the fields (using nil for meta and extension fields)." {:added "1.2"} [name [& fields] & opts+specs] (let [gname name [interfaces methods opts] (parse-opts+specs opts+specs) classname (symbol (str (namespace-munge *ns*) "." gname)) tag (keyword (str *ns*) (str name)) hinted-fields fields fields (vec (map #(with-meta % nil) fields))] `(let [] ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods) (defmethod print-method ~classname [o# w#] ((var print-defrecord) o# w#)) (import ~classname) #_(defn ~name ([~@fields] (new ~classname ~@fields nil nil)) ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#)))))) (defn- print-defrecord [o ^Writer w] (print-meta o w) (.write w "#:") (.write w (.getName (class o))) (print-map o pr-on w)) (defn- emit-deftype* "Do not use this directly - use deftype" [tagname name fields interfaces methods] (let [classname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))] `(deftype* ~tagname ~classname ~fields :implements ~interfaces ~@methods))) (defmacro deftype "Alpha - subject to change (deftype name [fields*] options* specs*) Currently there are no options. Each spec consists of a protocol or interface name followed by zero or more method bodies: protocol-or-interface-or-Object (methodName [args*] body)* Dynamically generates compiled bytecode for class with the given name, in a package with the same name as the current namespace, the given fields, and, optionally, methods for protocols and/or interfaces. The class will have the (by default, immutable) fields named by fields, which can have type hints. Protocols/interfaces and methods are optional. The only methods that can be supplied are those declared in the protocols/interfaces. Note that method bodies are not closures, the local environment includes only the named fields, and those fields can be accessed directy. Fields can be qualified with the metadata :volatile-mutable true or :unsynchronized-mutable true, at which point (set! afield aval) will be supported in method bodies. Note well that mutable fields are extremely difficult to use correctly, and are present only to facilitate the building of higher level constructs, such as Clojure's reference types, in Clojure itself. They are for experts only - if the semantics and implications of :volatile-mutable or :unsynchronized-mutable are not immediately apparent to you, you should not be using them. Method definitions take the form: (methodname [args*] body) The argument and return types can be hinted on the arg and methodname symbols. If not supplied, they will be inferred, so type hints should be reserved for disambiguation. Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for methods of Object. Note that a parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method head should *not* pass the target object, it will be supplied automatically and can not be substituted. In the method bodies, the (unqualified) name can be used to name the class (for calls to new, instance? etc). When AOT compiling, generates compiled bytecode for a class with the given name (a symbol), prepends the current ns as the package, and writes the .class file to the *compile-path* directory. One constructors will be defined, taking the designated fields." {:added "1.2"} [name [& fields] & opts+specs] (let [gname name [interfaces methods opts] (parse-opts+specs opts+specs) classname (symbol (str (namespace-munge *ns*) "." gname)) tag (keyword (str *ns*) (str name)) hinted-fields fields fields (vec (map #(with-meta % nil) fields))] `(let [] ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods) (import ~classname)))) ;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;; (defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f] (let [cs (into {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache))))) cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f)) [shift mask] (min-hash (keys cs)) table (make-array Object (* 2 (inc mask))) table (reduce (fn [^objects t [c e]] (let [i (* 2 (int (shift-mask shift mask (hash c))))] (aset t i c) (aset t (inc i) e) t)) table cs)] (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table))) (defn- super-chain [^Class c] (when c (cons c (super-chain (.getSuperclass c))))) (defn- pref ([] nil) ([a] a) ([^Class a ^Class b] (if (.isAssignableFrom a b) b a))) (defn find-protocol-impl [protocol x] (if (instance? (:on-interface protocol) x) x (let [c (class x) impl #(get (:impls protocol) %)] (or (impl c) (and c (or (first (remove nil? (map impl (butlast (super-chain c))))) (when-let [t (reduce pref (filter impl (disj (supers c) Object)))] (impl t)) (impl Object))))))) (defn find-protocol-method [protocol methodk x] (get (find-protocol-impl protocol x) methodk)) (defn- protocol? [maybe-p] (boolean (:on-interface maybe-p))) (defn- implements? [protocol atype] (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype))) (defn extends? "Returns true if atype extends protocol" {:added "1.2"} [protocol atype] (boolean (or (implements? protocol atype) (get (:impls protocol) atype)))) (defn extenders "Returns a collection of the types explicitly extending protocol" {:added "1.2"} [protocol] (keys (:impls protocol))) (defn satisfies? "Returns true if x satisfies the protocol" {:added "1.2"} [protocol x] (boolean (find-protocol-impl protocol x))) (defn -cache-protocol-fn [^clojure.lang.AFunction pf x ^Class c ^clojure.lang.IFn interf] (let [cache (.__methodImplCache pf) f (if (.isInstance c x) interf (find-protocol-method (.protocol cache) (.methodk cache) x))] (when-not f (throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache) " of protocol: " (:var (.protocol cache)) " found for class: " (if (nil? x) "nil" (.getName (class x))))))) (set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f)) f)) (defn- emit-method-builder [on-interface method on-method arglists] (let [methodk (keyword method) gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction}) ginterf (gensym)] `(fn [cache#] (let [~ginterf (fn ~@(map (fn [args] (let [gargs (map #(gensym (str "gf__" % "__")) args) target (first gargs)] `([~@gargs] (. ~(with-meta target {:tag on-interface}) ~(or on-method method) ~@(rest gargs))))) arglists)) ^clojure.lang.AFunction f# (fn ~gthis ~@(map (fn [args] (let [gargs (map #(gensym (str "gf__" % "__")) args) target (first gargs)] `([~@gargs] (let [cache# (.__methodImplCache ~gthis) f# (.fnFor cache# (clojure.lang.Util/classOf ~target))] (if f# (f# ~@gargs) ((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs)))))) arglists))] (set! (.__methodImplCache f#) cache#) f#)))) (defn -reset-methods [protocol] (doseq [[^clojure.lang.Var v build] (:method-builders protocol)] (let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))] (.bindRoot v (build cache))))) (defn- assert-same-protocol [protocol-var method-syms] (doseq [m method-syms] (let [v (resolve m) p (:protocol (meta v))] (when (and v (bound? v) (not= protocol-var p)) (binding [*out* *err*] (println "Warning: protocol" protocol-var "is overwriting" (if p (str "method " (.sym v) " of protocol " (.sym p)) (str "function " (.sym v))))))))) (defn- emit-protocol [name opts+sigs] (let [iname (symbol (str (munge (namespace-munge *ns*)) "." (munge name))) [opts sigs] (loop [opts {:on (list 'quote iname) :on-interface iname} sigs opts+sigs] (condp #(%1 %2) (first sigs) string? (recur (assoc opts :doc (first sigs)) (next sigs)) keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs)) [opts sigs])) sigs (reduce (fn [m s] (let [name-meta (meta (first s)) mname (with-meta (first s) nil) [arglists doc] (loop [as [] rs (rest s)] (if (vector? (first rs)) (recur (conj as (first rs)) (next rs)) [(seq as) (first rs)]))] (when (some #{0} (map count arglists)) (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg")))) (assoc m (keyword mname) (merge name-meta {:name (vary-meta mname assoc :doc doc :arglists arglists) :arglists arglists :doc doc})))) {} sigs) meths (mapcat (fn [sig] (let [m (munge (:name sig))] (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object) (:arglists sig)))) (vals sigs))] `(do (defonce ~name {}) (gen-interface :name ~iname :methods ~meths) (alter-meta! (var ~name) assoc :doc ~(:doc opts)) (#'assert-same-protocol (var ~name) '~(map :name (vals sigs))) (alter-var-root (var ~name) merge (assoc ~opts :sigs '~sigs :var (var ~name) :method-map ~(and (:on opts) (apply hash-map (mapcat (fn [s] [(keyword (:name s)) (keyword (or (:on s) (:name s)))]) (vals sigs)))) :method-builders ~(apply hash-map (mapcat (fn [s] [`(intern *ns* (with-meta '~(:name s) (merge '~s {:protocol (var ~name)}))) (emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))]) (vals sigs))))) (-reset-methods ~name) '~name))) (defmacro defprotocol "A protocol is a named set of named methods and their signatures: (defprotocol AProtocolName ;optional doc string \"A doc string for AProtocol abstraction\" ;method signatures (bar [this a b] \"bar docs\") (baz [this a] [this a b] [this a b c] \"baz docs\")) No implementations are provided. Docs can be specified for the protocol overall and for each method. The above yields a set of polymorphic functions and a protocol object. All are namespace-qualified by the ns enclosing the definition The resulting functions dispatch on the type of their first argument, which is required and corresponds to the implicit target object ('this' in Java parlance). defprotocol is dynamic, has no special compile-time effect, and defines no new types or classes. Implementations of the protocol methods can be provided using extend. defprotocol will automatically generate a corresponding interface, with the same name as the protocol, i.e. given a protocol: my.ns/Protocol, an interface: my.ns.Protocol. The interface will have methods corresponding to the protocol functions, and the protocol will automatically work with instances of the interface. Note that you should not use this interface with deftype or reify, as they support the protocol directly: (defprotocol P (foo [this]) (bar-me [this] [this y])) (deftype Foo [a b c] P (foo [this] a) (bar-me [this] b) (bar-me [this y] (+ c y))) (bar-me (Foo. 1 2 3) 42) => 45 (foo (let [x 42] (reify P (foo [this] 17) (bar-me [this] x) (bar-me [this y] x)))) => 17" {:added "1.2"} [name & opts+sigs] (emit-protocol name opts+sigs)) (defn extend "Implementations of protocol methods can be provided using the extend construct: (extend AType AProtocol {:foo an-existing-fn :bar (fn [a b] ...) :baz (fn ([a]...) ([a b] ...)...)} BProtocol {...} ...) extend takes a type/class (or interface, see below), and one or more protocol + method map pairs. It will extend the polymorphism of the protocol's methods to call the supplied methods when an AType is provided as the first argument. Method maps are maps of the keyword-ized method names to ordinary fns. This facilitates easy reuse of existing fns and fn maps, for code reuse/mixins without derivation or composition. You can extend an interface to a protocol. This is primarily to facilitate interop with the host (e.g. Java) but opens the door to incidental multiple inheritance of implementation since a class can inherit from more than one interface, both of which extend the protocol. It is TBD how to specify which impl to use. You can extend a protocol on nil. If you are supplying the definitions explicitly (i.e. not reusing exsting functions or mixin maps), you may find it more convenient to use the extend-type or extend-protocol macros. Note that multiple independent extend clauses can exist for the same type, not all protocols need be defined in a single extend call. See also: extends?, satisfies?, extenders" {:added "1.2"} [atype & proto+mmaps] (doseq [[proto mmap] (partition 2 proto+mmaps)] (when-not (protocol? proto) (throw (IllegalArgumentException. (str proto " is not a protocol")))) (when (implements? proto atype) (throw (IllegalArgumentException. (str atype " already directly implements " (:on-interface proto) " for protocol:" (:var proto))))) (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap)))) (defn- emit-impl [[p fs]] [p (zipmap (map #(-> % first keyword) fs) (map #(cons 'fn (drop 1 %)) fs))]) (defn- emit-hinted-impl [c [p fs]] (let [hint (fn [specs] (let [specs (if (vector? (first specs)) (list specs) specs)] (map (fn [[[target & args] & body]] (cons (apply vector (vary-meta target assoc :tag c) args) body)) specs)))] [p (zipmap (map #(-> % first keyword) fs) (map #(cons 'fn (hint (drop 1 %))) fs))])) (defn- emit-extend-type [c specs] (let [impls (parse-impls specs)] `(extend ~c ~@(mapcat (partial emit-hinted-impl c) impls)))) (defmacro extend-type "A macro that expands into an extend call. Useful when you are supplying the definitions explicitly inline, extend-type automatically creates the maps required by extend. Propagates the class as a type hint on the first argument of all fns. (extend-type MyType Countable (cnt [c] ...) Foo (bar [x y] ...) (baz ([x] ...) ([x y & zs] ...))) expands into: (extend MyType Countable {:cnt (fn [c] ...)} Foo {:baz (fn ([x] ...) ([x y & zs] ...)) :bar (fn [x y] ...)})" {:added "1.2"} [t & specs] (emit-extend-type t specs)) (defn- emit-extend-protocol [p specs] (let [impls (parse-impls specs)] `(do ~@(map (fn [[t fs]] `(extend-type ~t ~p ~@fs)) impls)))) (defmacro extend-protocol "Useful when you want to provide several implementations of the same protocol all at once. Takes a single protocol and the implementation of that protocol for one or more types. Expands into calls to extend-type: (extend-protocol Protocol AType (foo [x] ...) (bar [x y] ...) BType (foo [x] ...) (bar [x y] ...) AClass (foo [x] ...) (bar [x y] ...) nil (foo [x] ...) (bar [x y] ...)) expands into: (do (clojure.core/extend-type AType Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type BType Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type AClass Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type nil Protocol (foo [x] ...) (bar [x y] ...)))" {:added "1.2"} [p & specs] (emit-extend-protocol p specs)) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/core_print.clj000066400000000000000000000250311157562347600232200ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (import '(java.io Writer)) (def ^{:doc "*print-length* controls how many items of each collection the printer will print. If it is bound to logical false, there is no limit. Otherwise, it must be bound to an integer indicating the maximum number of items of each collection to print. If a collection contains more items, the printer will print items up to the limit followed by '...' to represent the remaining items. The root binding is nil indicating no limit." :added "1.0"} *print-length* nil) (def ^{:doc "*print-level* controls how many levels deep the printer will print nested objects. If it is bound to logical false, there is no limit. Otherwise, it must be bound to an integer indicating the maximum level to print. Each argument to print is at level 0; if an argument is a collection, its items are at level 1; and so on. If an object is a collection and is at a level greater than or equal to the value bound to *print-level*, the printer prints '#' to represent it. The root binding is nil indicating no limit." :added "1.0"} *print-level* nil) (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w] (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))] (if (and *print-level* (neg? *print-level*)) (.write w "#") (do (.write w begin) (when-let [xs (seq sequence)] (if (and (not *print-dup*) *print-length*) (loop [[x & xs] xs print-length *print-length*] (if (zero? print-length) (.write w "...") (do (print-one x w) (when xs (.write w sep) (recur xs (dec print-length)))))) (loop [[x & xs] xs] (print-one x w) (when xs (.write w sep) (recur xs))))) (.write w end))))) (defn- print-meta [o, ^Writer w] (when-let [m (meta o)] (when (and (pos? (count m)) (or *print-dup* (and *print-meta* *print-readably*))) (.write w "^") (if (and (= (count m) 1) (:tag m)) (pr-on (:tag m) w) (pr-on m w)) (.write w " ")))) (defmethod print-method :default [o, ^Writer w] (print-method (vary-meta o #(dissoc % :type)) w)) (defmethod print-method nil [o, ^Writer w] (.write w "nil")) (defmethod print-dup nil [o w] (print-method o w)) (defn print-ctor [o print-args ^Writer w] (.write w "#=(") (.write w (.getName ^Class (class o))) (.write w ". ") (print-args o w) (.write w ")")) (defmethod print-method Object [o, ^Writer w] (.write w "#<") (.write w (.getSimpleName (class o))) (.write w " ") (.write w (str o)) (.write w ">")) (defmethod print-method clojure.lang.Keyword [o, ^Writer w] (.write w (str o))) (defmethod print-dup clojure.lang.Keyword [o w] (print-method o w)) (defmethod print-method Number [o, ^Writer w] (.write w (str o))) (defmethod print-dup Number [o, ^Writer w] (print-ctor o (fn [o w] (print-dup (str o) w)) w)) (defmethod print-dup clojure.lang.Fn [o, ^Writer w] (print-ctor o (fn [o w]) w)) (prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn) (prefer-method print-dup java.util.Map clojure.lang.Fn) (prefer-method print-dup java.util.Collection clojure.lang.Fn) (defmethod print-method Boolean [o, ^Writer w] (.write w (str o))) (defmethod print-dup Boolean [o w] (print-method o w)) (defn print-simple [o, ^Writer w] (print-meta o w) (.write w (str o))) (defmethod print-method clojure.lang.Symbol [o, ^Writer w] (print-simple o w)) (defmethod print-dup clojure.lang.Symbol [o w] (print-method o w)) (defmethod print-method clojure.lang.Var [o, ^Writer w] (print-simple o w)) (defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w] (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")"))) (defmethod print-method clojure.lang.ISeq [o, ^Writer w] (print-meta o w) (print-sequential "(" pr-on " " ")" o w)) (defmethod print-dup clojure.lang.ISeq [o w] (print-method o w)) (defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w)) (prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection) (prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection) (prefer-method print-method clojure.lang.ISeq java.util.Collection) (prefer-method print-dup clojure.lang.ISeq java.util.Collection) (defmethod print-dup java.util.Collection [o, ^Writer w] (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w)) (defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w] (print-meta o w) (.write w "#=(") (.write w (.getName ^Class (class o))) (.write w "/create ") (print-sequential "[" print-dup " " "]" o w) (.write w ")")) (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection) (def ^{:tag String :doc "Returns escape string for char or nil if none" :added "1.0"} char-escape-string {\newline "\\n" \tab "\\t" \return "\\r" \" "\\\"" \\ "\\\\" \formfeed "\\f" \backspace "\\b"}) (defmethod print-method String [^String s, ^Writer w] (if (or *print-dup* *print-readably*) (do (.append w \") (dotimes [n (count s)] (let [c (.charAt s n) e (char-escape-string c)] (if e (.write w e) (.append w c)))) (.append w \")) (.write w s)) nil) (defmethod print-dup String [s w] (print-method s w)) (defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w] (print-meta v w) (print-sequential "[" pr-on " " "]" v w)) (defn- print-map [m print-one w] (print-sequential "{" (fn [e ^Writer w] (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) ", " "}" (seq m) w)) (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) (print-map m pr-on w)) (defmethod print-dup java.util.Map [m, ^Writer w] (print-ctor m #(print-map (seq %1) print-dup %2) w)) (defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) (.write w "#=(") (.write w (.getName (class m))) (.write w "/create ") (print-map m print-dup w) (.write w ")")) (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map) (defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w] (print-meta s w) (print-sequential "#{" pr-on " " "}" (seq s) w)) (def ^{:tag String :doc "Returns name string for char or nil if none" :added "1.0"} char-name-string {\newline "newline" \tab "tab" \space "space" \backspace "backspace" \formfeed "formfeed" \return "return"}) (defmethod print-method java.lang.Character [^Character c, ^Writer w] (if (or *print-dup* *print-readably*) (do (.append w \\) (let [n (char-name-string c)] (if n (.write w n) (.append w c)))) (.append w c)) nil) (defmethod print-dup java.lang.Character [c w] (print-method c w)) (defmethod print-dup java.lang.Integer [o w] (print-method o w)) (defmethod print-dup java.lang.Double [o w] (print-method o w)) (defmethod print-dup clojure.lang.Ratio [o w] (print-method o w)) (defmethod print-dup java.math.BigDecimal [o w] (print-method o w)) (defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w)) (defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w)) (defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w)) (defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w)) (def primitives-classnames {Float/TYPE "Float/TYPE" Integer/TYPE "Integer/TYPE" Long/TYPE "Long/TYPE" Boolean/TYPE "Boolean/TYPE" Character/TYPE "Character/TYPE" Double/TYPE "Double/TYPE" Byte/TYPE "Byte/TYPE" Short/TYPE "Short/TYPE"}) (defmethod print-method Class [^Class c, ^Writer w] (.write w (.getName c))) (defmethod print-dup Class [^Class c, ^Writer w] (cond (.isPrimitive c) (do (.write w "#=(identity ") (.write w ^String (primitives-classnames c)) (.write w ")")) (.isArray c) (do (.write w "#=(java.lang.Class/forName \"") (.write w (.getName c)) (.write w "\")")) :else (do (.write w "#=") (.write w (.getName c))))) (defmethod print-method java.math.BigDecimal [b, ^Writer w] (.write w (str b)) (.write w "M")) (defmethod print-method java.util.regex.Pattern [p ^Writer w] (.write w "#\"") (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p)) qmode false] (when s (cond (= c \\) (let [[^Character c2 & r2] r] (.append w \\) (.append w c2) (if qmode (recur r2 (not= c2 \E)) (recur r2 (= c2 \Q)))) (= c \") (do (if qmode (.write w "\\E\\\"\\Q") (.write w "\\\"")) (recur r qmode)) :else (do (.append w c) (recur r qmode))))) (.append w \")) (defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w)) (defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w] (.write w "#=(find-ns ") (print-dup (.name n) w) (.write w ")")) (defmethod print-method clojure.lang.IDeref [o ^Writer w] (print-sequential (format "#<%s@%x%s: " (.getSimpleName (class o)) (System/identityHashCode o) (if (and (instance? clojure.lang.Agent o) (agent-error o)) " FAILED" "")) pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w)) (def ^{:private true} print-initialized true) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/core_proxy.clj000066400000000000000000000446721157562347600232610ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (import '(clojure.asm ClassWriter ClassVisitor Opcodes Type) '(java.lang.reflect Modifier Constructor) '(clojure.asm.commons Method GeneratorAdapter) '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT)) (defn method-sig [^java.lang.reflect.Method meth] [(. meth (getName)) (seq (. meth (getParameterTypes))) (. meth getReturnType)]) (defn- most-specific [rtypes] (or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes) (throw (Exception. "Incompatible return types")))) (defn- group-by-sig [coll] "takes a collection of [msig meth] and returns a seq of maps from return-types to meths." (vals (reduce (fn [m [msig meth]] (let [rtype (peek msig) argsig (pop msig)] (assoc m argsig (assoc (m argsig {}) rtype meth)))) {} coll))) (defn proxy-name {:tag String} [^Class super interfaces] (let [inames (into (sorted-set) (map #(.getName ^Class %) interfaces))] (apply str (.replace (str *ns*) \- \_) ".proxy" (interleave (repeat "$") (concat [(.getName super)] (map #(subs % (inc (.lastIndexOf ^String % "."))) inames) [(Integer/toHexString (hash inames))]))))) (defn- generate-proxy [^Class super interfaces] (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) cname (.replace (proxy-name super interfaces) \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) ctype (. Type (getObjectType cname)) iname (fn [^Class c] (.. Type (getType c) (getInternalName))) fmap "__clojureFnMap" totype (fn [^Class c] (. Type (getType c))) to-types (fn [cs] (if (pos? (count cs)) (into-array (map totype cs)) (make-array Type 0))) super-type ^Type (totype super) imap-type ^Type (totype IPersistentMap) ifn-type (totype clojure.lang.IFn) obj-type (totype Object) sym-type (totype clojure.lang.Symbol) rt-type (totype clojure.lang.RT) ex-type (totype java.lang.UnsupportedOperationException) gen-bridge (fn [^java.lang.reflect.Method meth ^java.lang.reflect.Method dest] (let [pclasses (. meth (getParameterTypes)) ptypes (to-types pclasses) rtype ^Type (totype (. meth (getReturnType))) m (new Method (. meth (getName)) rtype ptypes) dtype (totype (.getDeclaringClass dest)) dm (new Method (. dest (getName)) (totype (. dest (getReturnType))) (to-types (. dest (getParameterTypes)))) gen (new GeneratorAdapter (bit-or (. Opcodes ACC_PUBLIC) (. Opcodes ACC_BRIDGE)) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (dotimes [i (count ptypes)] (. gen (loadArg i))) (if (-> dest .getDeclaringClass .isInterface) (. gen (invokeInterface dtype dm)) (. gen (invokeVirtual dtype dm))) (. gen (returnValue)) (. gen (endMethod)))) gen-method (fn [^java.lang.reflect.Method meth else-gen] (let [pclasses (. meth (getParameterTypes)) ptypes (to-types pclasses) rtype ^Type (totype (. meth (getReturnType))) m (new Method (. meth (getName)) rtype ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) else-label (. gen (newLabel)) end-label (. gen (newLabel)) decl-type (. Type (getType (. meth (getDeclaringClass))))] (. gen (visitCode)) (if (> (count pclasses) 18) (else-gen gen m) (do (. gen (loadThis)) (. gen (getField ctype fmap imap-type)) (. gen (push (. meth (getName)))) ;lookup fn in map (. gen (invokeStatic rt-type (. Method (getMethod "Object get(Object, Object)")))) (. gen (dup)) (. gen (ifNull else-label)) ;if found (.checkCast gen ifn-type) (. gen (loadThis)) ;box args (dotimes [i (count ptypes)] (. gen (loadArg i)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) ;call fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (into-array (cons obj-type (replicate (count ptypes) obj-type)))))) ;unbox return (. gen (unbox rtype)) (when (= (. rtype (getSort)) (. Type VOID)) (. gen (pop))) (. gen (goTo end-label)) ;else call supplied alternative generator (. gen (mark else-label)) (. gen (pop)) (else-gen gen m) (. gen (mark end-label)))) (. gen (returnValue)) (. gen (endMethod))))] ;start class definition (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) cname nil (iname super) (into-array (map iname (cons IProxy interfaces))))) ;add field for fn mappings (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_VOLATILE)) fmap (. imap-type (getDescriptor)) nil nil)) ;add ctors matching/calling super's (doseq [^Constructor ctor (. super (getDeclaredConstructors))] (when-not (. Modifier (isPrivate (. ctor (getModifiers)))) (let [ptypes (to-types (. ctor (getParameterTypes))) m (new Method "" (. Type VOID_TYPE) ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) ;call super ctor (. gen (loadThis)) (. gen (dup)) (. gen (loadArgs)) (. gen (invokeConstructor super-type m)) (. gen (returnValue)) (. gen (endMethod))))) ;add IProxy methods (let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (. gen (loadArgs)) (. gen (putField ctype fmap imap-type)) (. gen (returnValue)) (. gen (endMethod))) (let [m (. Method (getMethod "void __updateClojureFnMappings(clojure.lang.IPersistentMap)")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (. gen (dup)) (. gen (getField ctype fmap imap-type)) (.checkCast gen (totype clojure.lang.IPersistentCollection)) (. gen (loadArgs)) (. gen (invokeInterface (totype clojure.lang.IPersistentCollection) (. Method (getMethod "clojure.lang.IPersistentCollection cons(Object)")))) (. gen (checkCast imap-type)) (. gen (putField ctype fmap imap-type)) (. gen (returnValue)) (. gen (endMethod))) (let [m (. Method (getMethod "clojure.lang.IPersistentMap __getClojureFnMappings()")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (. gen (getField ctype fmap imap-type)) (. gen (returnValue)) (. gen (endMethod))) ;calc set of supers' non-private instance methods (let [[mm considered] (loop [mm {} considered #{} c super] (if c (let [[mm considered] (loop [mm mm considered considered meths (concat (seq (. c (getDeclaredMethods))) (seq (. c (getMethods))))] (if (seq meths) (let [^java.lang.reflect.Method meth (first meths) mods (. meth (getModifiers)) mk (method-sig meth)] (if (or (considered mk) (not (or (Modifier/isPublic mods) (Modifier/isProtected mods))) ;(. Modifier (isPrivate mods)) (. Modifier (isStatic mods)) (. Modifier (isFinal mods)) (= "finalize" (.getName meth))) (recur mm (conj considered mk) (next meths)) (recur (assoc mm mk meth) (conj considered mk) (next meths)))) [mm considered]))] (recur mm considered (. c (getSuperclass)))) [mm considered])) ifaces-meths (into {} (for [^Class iface interfaces meth (. iface (getMethods)) :let [msig (method-sig meth)] :when (not (considered msig))] {msig meth})) mgroups (group-by-sig (concat mm ifaces-meths)) rtypes (map #(most-specific (keys %)) mgroups) mb (map #(vector (%1 %2) (vals (dissoc %1 %2))) mgroups rtypes) bridge? (reduce into #{} (map second mb)) ifaces-meths (remove bridge? (vals ifaces-meths)) mm (remove bridge? (vals mm))] ;add methods matching supers', if no mapping -> call super (doseq [[^java.lang.reflect.Method dest bridges] mb ^java.lang.reflect.Method meth bridges] (gen-bridge meth dest)) (doseq [^java.lang.reflect.Method meth mm] (gen-method meth (fn [^GeneratorAdapter gen ^Method m] (. gen (loadThis)) ;push args (. gen (loadArgs)) ;call super (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) (. super-type (getInternalName)) (. m (getName)) (. m (getDescriptor))))))) ;add methods matching interfaces', if no mapping -> throw (doseq [^java.lang.reflect.Method meth ifaces-meths] (gen-method meth (fn [^GeneratorAdapter gen ^Method m] (. gen (throwException ex-type (. m (getName)))))))) ;finish class def (. cv (visitEnd)) [cname (. cv toByteArray)])) (defn- get-super-and-interfaces [bases] (if (. ^Class (first bases) (isInterface)) [Object bases] [(first bases) (next bases)])) (defn get-proxy-class "Takes an optional single class followed by zero or more interfaces. If not supplied class defaults to Object. Creates an returns an instance of a proxy class derived from the supplied classes. The resulting value is cached and used for any subsequent requests for the same class set. Returns a Class object." {:added "1.0"} [& bases] (let [[super interfaces] (get-super-and-interfaces bases) pname (proxy-name super interfaces)] (or (RT/loadClassForName pname) (let [[cname bytecode] (generate-proxy super interfaces)] (. ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (defineClass pname bytecode [super interfaces])))))) (defn construct-proxy "Takes a proxy class and any arguments for its superclass ctor and creates and returns an instance of the proxy." {:added "1.0"} [c & ctor-args] (. Reflector (invokeConstructor c (to-array ctor-args)))) (defn init-proxy "Takes a proxy instance and a map of strings (which must correspond to methods of the proxy superclass/superinterfaces) to fns (which must take arguments matching the corresponding method, plus an additional (explicit) first arg corresponding to this, and sets the proxy's fn map." {:added "1.0"} [^IProxy proxy mappings] (. proxy (__initClojureFnMappings mappings))) (defn update-proxy "Takes a proxy instance and a map of strings (which must correspond to methods of the proxy superclass/superinterfaces) to fns (which must take arguments matching the corresponding method, plus an additional (explicit) first arg corresponding to this, and updates (via assoc) the proxy's fn map. nil can be passed instead of a fn, in which case the corresponding method will revert to the default behavior. Note that this function can be used to update the behavior of an existing instance without changing its identity." {:added "1.0"} [^IProxy proxy mappings] (. proxy (__updateClojureFnMappings mappings))) (defn proxy-mappings "Takes a proxy instance and returns the proxy's fn map." {:added "1.0"} [^IProxy proxy] (. proxy (__getClojureFnMappings))) (defmacro proxy "class-and-interfaces - a vector of class names args - a (possibly empty) vector of arguments to the superclass constructor. f => (name [params*] body) or (name ([params*] body) ([params+] body) ...) Expands to code which creates a instance of a proxy class that implements the named class/interface(s) by calling the supplied fns. A single class, if provided, must be first. If not provided it defaults to Object. The interfaces names must be valid interface types. If a method fn is not provided for a class method, the superclass methd will be called. If a method fn is not provided for an interface method, an UnsupportedOperationException will be thrown should it be called. Method fns are closures and can capture the environment in which proxy is called. Each method fn takes an additional implicit first arg, which is bound to 'this. Note that while method fns can be provided to override protected methods, they have no other access to protected members, nor to super, as these capabilities cannot be proxied." {:added "1.0"} [class-and-interfaces args & fs] (let [bases (map #(or (resolve %) (throw (Exception. (str "Can't resolve: " %)))) class-and-interfaces) [super interfaces] (get-super-and-interfaces bases) compile-effect (when *compile-files* (let [[cname bytecode] (generate-proxy super interfaces)] (clojure.lang.Compiler/writeClassFile cname bytecode))) pc-effect (apply get-proxy-class bases) pname (proxy-name super interfaces)] ;remember the class to prevent it from disappearing before use (intern *ns* (symbol pname) pc-effect) `(let [;pc# (get-proxy-class ~@class-and-interfaces) p# (new ~(symbol pname) ~@args)] ;(construct-proxy pc# ~@args)] (init-proxy p# ~(loop [fmap {} fs fs] (if fs (let [[sym & meths] (first fs) meths (if (vector? (first meths)) (list meths) meths) meths (map (fn [[params & body]] (cons (apply vector 'this params) body)) meths)] (if-not (contains? fmap (name sym)) (recur (assoc fmap (name sym) (cons `fn meths)) (next fs)) (throw (IllegalArgumentException. (str "Method '" (name sym) "' redefined"))))) fmap))) p#))) (defn proxy-call-with-super [call this meth] (let [m (proxy-mappings this)] (update-proxy this (assoc m meth nil)) (let [ret (call)] (update-proxy this m) ret))) (defmacro proxy-super "Use to call a superclass method in the body of a proxy method. Note, expansion captures 'this" {:added "1.0"} [meth & args] `(proxy-call-with-super (fn [] (. ~'this ~meth ~@args)) ~'this ~(name meth))) (defn bean "Takes a Java object and returns a read-only implementation of the map abstraction based upon its JavaBean properties." {:added "1.0"} [^Object x] (let [c (. x (getClass)) pmap (reduce (fn [m ^java.beans.PropertyDescriptor pd] (let [name (. pd (getName)) method (. pd (getReadMethod))] (if (and method (zero? (alength (. method (getParameterTypes))))) (assoc m (keyword name) (fn [] (clojure.lang.Reflector/prepRet (. method (invoke x nil))))) m))) {} (seq (.. java.beans.Introspector (getBeanInfo c) (getPropertyDescriptors)))) v (fn [k] ((pmap k))) snapshot (fn [] (reduce (fn [m e] (assoc m (key e) ((val e)))) {} (seq pmap)))] (proxy [clojure.lang.APersistentMap] [] (containsKey [k] (contains? pmap k)) (entryAt [k] (when (contains? pmap k) (new clojure.lang.MapEntry k (v k)))) (valAt ([k] (v k)) ([k default] (if (contains? pmap k) (v k) default))) (cons [m] (conj (snapshot) m)) (count [] (count pmap)) (assoc [k v] (assoc (snapshot) k v)) (without [k] (dissoc (snapshot) k)) (seq [] ((fn thisfn [plseq] (lazy-seq (when-let [pseq (seq plseq)] (cons (new clojure.lang.MapEntry (first pseq) (v (first pseq))) (thisfn (rest pseq)))))) (keys pmap)))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/genclass.clj000066400000000000000000000760231157562347600226620ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) (import '(java.lang.reflect Modifier Constructor) '(clojure.asm ClassWriter ClassVisitor Opcodes Type) '(clojure.asm.commons Method GeneratorAdapter) '(clojure.lang IPersistentMap)) ;(defn method-sig [^java.lang.reflect.Method meth] ; [(. meth (getName)) (seq (. meth (getParameterTypes)))]) (defn- non-private-methods [^Class c] (loop [mm {} considered #{} c c] (if c (let [[mm considered] (loop [mm mm considered considered meths (seq (concat (seq (. c (getDeclaredMethods))) (seq (. c (getMethods)))))] (if meths (let [^java.lang.reflect.Method meth (first meths) mods (. meth (getModifiers)) mk (method-sig meth)] (if (or (considered mk) (not (or (Modifier/isPublic mods) (Modifier/isProtected mods))) ;(. Modifier (isPrivate mods)) (. Modifier (isStatic mods)) (. Modifier (isFinal mods)) (= "finalize" (.getName meth))) (recur mm (conj considered mk) (next meths)) (recur (assoc mm mk meth) (conj considered mk) (next meths)))) [mm considered]))] (recur mm considered (. c (getSuperclass)))) mm))) (defn- ctor-sigs [^Class super] (for [^Constructor ctor (. super (getDeclaredConstructors)) :when (not (. Modifier (isPrivate (. ctor (getModifiers)))))] (apply vector (. ctor (getParameterTypes))))) (defn- escape-class-name [^Class c] (.. (.getSimpleName c) (replace "[]" "<>"))) (defn- overload-name [mname pclasses] (if (seq pclasses) (apply str mname (interleave (repeat \-) (map escape-class-name pclasses))) (str mname "-void"))) (defn- ^java.lang.reflect.Field find-field [^Class c f] (let [start-class c] (loop [c c] (if (= c Object) (throw (new Exception (str "field, " f ", not defined in class, " start-class ", or its ancestors"))) (let [dflds (.getDeclaredFields c) rfld (first (filter #(= f (.getName ^java.lang.reflect.Field %)) dflds))] (or rfld (recur (.getSuperclass c)))))))) ;(distinct (map first(keys (mapcat non-private-methods [Object IPersistentMap])))) (def ^{:private true} prim->class {'int Integer/TYPE 'long Long/TYPE 'float Float/TYPE 'double Double/TYPE 'void Void/TYPE 'short Short/TYPE 'boolean Boolean/TYPE 'byte Byte/TYPE 'char Character/TYPE}) (defn- ^Class the-class [x] (cond (class? x) x (contains? prim->class x) (prim->class x) :else (let [strx (str x)] (clojure.lang.RT/classForName (if (some #{\. \[} strx) strx (str "java.lang." strx)))))) ;; someday this can be made codepoint aware (defn- valid-java-method-name [^String s] (= s (clojure.lang.Compiler/munge s))) (defn- validate-generate-class-options [{:keys [methods]}] (let [[mname] (remove valid-java-method-name (map (comp str first) methods))] (when mname (throw (IllegalArgumentException. (str "Not a valid method name: " mname)))))) (defn- generate-class [options-map] (validate-generate-class-options options-map) (let [default-options {:prefix "-" :load-impl-ns true :impl-ns (ns-name *ns*)} {:keys [name extends implements constructors methods main factory state init exposes exposes-methods prefix load-impl-ns impl-ns post-init]} (merge default-options options-map) name-meta (meta name) name (str name) super (if extends (the-class extends) Object) interfaces (map the-class implements) supers (cons super interfaces) ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super))) cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) cname (. name (replace "." "/")) pkg-name name impl-pkg-name (str impl-ns) impl-cname (.. impl-pkg-name (replace "." "/") (replace \- \_)) ctype (. Type (getObjectType cname)) iname (fn [^Class c] (.. Type (getType c) (getInternalName))) totype (fn [^Class c] (. Type (getType c))) to-types (fn [cs] (if (pos? (count cs)) (into-array (map totype cs)) (make-array Type 0))) obj-type ^Type (totype Object) arg-types (fn [n] (if (pos? n) (into-array (replicate n obj-type)) (make-array Type 0))) super-type ^Type (totype super) init-name (str init) post-init-name (str post-init) factory-name (str factory) state-name (str state) main-name "main" var-name (fn [s] (clojure.lang.Compiler/munge (str s "__var"))) class-type (totype Class) rt-type (totype clojure.lang.RT) var-type ^Type (totype clojure.lang.Var) ifn-type (totype clojure.lang.IFn) iseq-type (totype clojure.lang.ISeq) ex-type (totype java.lang.UnsupportedOperationException) all-sigs (distinct (concat (map #(let[[m p] (key %)] {m [p]}) (mapcat non-private-methods supers)) (map (fn [[m p]] {(str m) [p]}) methods))) sigs-by-name (apply merge-with concat {} all-sigs) overloads (into {} (filter (fn [[m s]] (next s)) sigs-by-name)) var-fields (concat (when init [init-name]) (when post-init [post-init-name]) (when main [main-name]) ;(when exposes-methods (map str (vals exposes-methods))) (distinct (concat (keys sigs-by-name) (mapcat (fn [[m s]] (map #(overload-name m (map the-class %)) s)) overloads) (mapcat (comp (partial map str) vals val) exposes)))) emit-get-var (fn [^GeneratorAdapter gen v] (let [false-label (. gen newLabel) end-label (. gen newLabel)] (. gen getStatic ctype (var-name v) var-type) (. gen dup) (. gen invokeVirtual var-type (. Method (getMethod "boolean isBound()"))) (. gen ifZCmp (. GeneratorAdapter EQ) false-label) (. gen invokeVirtual var-type (. Method (getMethod "Object get()"))) (. gen goTo end-label) (. gen mark false-label) (. gen pop) (. gen visitInsn (. Opcodes ACONST_NULL)) (. gen mark end-label))) emit-unsupported (fn [^GeneratorAdapter gen ^Method m] (. gen (throwException ex-type (str (. m (getName)) " (" impl-pkg-name "/" prefix (.getName m) " not defined?)")))) emit-forwarding-method (fn [name pclasses rclass as-static else-gen] (let [mname (str name) pmetas (map meta pclasses) pclasses (map the-class pclasses) rclass (the-class rclass) ptypes (to-types pclasses) rtype ^Type (totype rclass) m (new Method mname rtype ptypes) is-overload (seq (overloads mname)) gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (if as-static (. Opcodes ACC_STATIC) 0)) m nil nil cv) found-label (. gen (newLabel)) else-label (. gen (newLabel)) end-label (. gen (newLabel))] (add-annotations gen (meta name)) (dotimes [i (count pmetas)] (add-annotations gen (nth pmetas i) i)) (. gen (visitCode)) (if (> (count pclasses) 18) (else-gen gen m) (do (when is-overload (emit-get-var gen (overload-name mname pclasses)) (. gen (dup)) (. gen (ifNonNull found-label)) (. gen (pop))) (emit-get-var gen mname) (. gen (dup)) (. gen (ifNull else-label)) (when is-overload (. gen (mark found-label))) ;if found (.checkCast gen ifn-type) (when-not as-static (. gen (loadThis))) ;box args (dotimes [i (count ptypes)] (. gen (loadArg i)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) ;call fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (to-types (replicate (+ (count ptypes) (if as-static 0 1)) Object))))) ;(into-array (cons obj-type ; (replicate (count ptypes) obj-type)))))) ;unbox return (. gen (unbox rtype)) (when (= (. rtype (getSort)) (. Type VOID)) (. gen (pop))) (. gen (goTo end-label)) ;else call supplied alternative generator (. gen (mark else-label)) (. gen (pop)) (else-gen gen m) (. gen (mark end-label)))) (. gen (returnValue)) (. gen (endMethod)))) ] ;start class definition (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) cname nil (iname super) (when-let [ifc (seq interfaces)] (into-array (map iname ifc))))) ; class annotations (add-annotations cv name-meta) ;static fields for vars (doseq [v var-fields] (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_FINAL) (. Opcodes ACC_STATIC)) (var-name v) (. var-type getDescriptor) nil nil))) ;instance field for state (when state (. cv (visitField (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL)) state-name (. obj-type getDescriptor) nil nil))) ;static init to set up var fields and load init (let [gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) (. Method getMethod "void ()") nil nil cv)] (. gen (visitCode)) (doseq [v var-fields] (. gen push impl-pkg-name) (. gen push (str prefix v)) (. gen (invokeStatic var-type (. Method (getMethod "clojure.lang.Var internPrivate(String,String)")))) (. gen putStatic ctype (var-name v) var-type)) (when load-impl-ns (. gen push "clojure.core") (. gen push "load") (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.Var var(String,String)")))) (. gen push (str "/" impl-cname)) (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (to-types [Object])))) ; (. gen push (str (.replace impl-pkg-name \- \_) "__init")) ; (. gen (invokeStatic class-type (. Method (getMethod "Class forName(String)")))) (. gen pop)) (. gen (returnValue)) (. gen (endMethod))) ;ctors (doseq [[pclasses super-pclasses] ctor-sig-map] (let [pclasses (map the-class pclasses) super-pclasses (map the-class super-pclasses) ptypes (to-types pclasses) super-ptypes (to-types super-pclasses) m (new Method "" (. Type VOID_TYPE) ptypes) super-m (new Method "" (. Type VOID_TYPE) super-ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) no-init-label (. gen newLabel) end-label (. gen newLabel) no-post-init-label (. gen newLabel) end-post-init-label (. gen newLabel) nth-method (. Method (getMethod "Object nth(Object,int)")) local (. gen newLocal obj-type)] (. gen (visitCode)) (if init (do (emit-get-var gen init-name) (. gen dup) (. gen ifNull no-init-label) (.checkCast gen ifn-type) ;box init args (dotimes [i (count pclasses)] (. gen (loadArg i)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) ;call init fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (arg-types (count ptypes))))) ;expecting [[super-ctor-args] state] returned (. gen dup) (. gen push 0) (. gen (invokeStatic rt-type nth-method)) (. gen storeLocal local) (. gen (loadThis)) (. gen dupX1) (dotimes [i (count super-pclasses)] (. gen loadLocal local) (. gen push i) (. gen (invokeStatic rt-type nth-method)) (. clojure.lang.Compiler$HostExpr (emitUnboxArg nil gen (nth super-pclasses i)))) (. gen (invokeConstructor super-type super-m)) (if state (do (. gen push 1) (. gen (invokeStatic rt-type nth-method)) (. gen (putField ctype state-name obj-type))) (. gen pop)) (. gen goTo end-label) ;no init found (. gen mark no-init-label) (. gen (throwException ex-type (str impl-pkg-name "/" prefix init-name " not defined"))) (. gen mark end-label)) (if (= pclasses super-pclasses) (do (. gen (loadThis)) (. gen (loadArgs)) (. gen (invokeConstructor super-type super-m))) (throw (new Exception ":init not specified, but ctor and super ctor args differ")))) (when post-init (emit-get-var gen post-init-name) (. gen dup) (. gen ifNull no-post-init-label) (.checkCast gen ifn-type) (. gen (loadThis)) ;box init args (dotimes [i (count pclasses)] (. gen (loadArg i)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i)))) ;call init fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (arg-types (inc (count ptypes)))))) (. gen pop) (. gen goTo end-post-init-label) ;no init found (. gen mark no-post-init-label) (. gen (throwException ex-type (str impl-pkg-name "/" prefix post-init-name " not defined"))) (. gen mark end-post-init-label)) (. gen (returnValue)) (. gen (endMethod)) ;factory (when factory (let [fm (new Method factory-name ctype ptypes) gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) fm nil nil cv)] (. gen (visitCode)) (. gen newInstance ctype) (. gen dup) (. gen (loadArgs)) (. gen (invokeConstructor ctype m)) (. gen (returnValue)) (. gen (endMethod)))))) ;add methods matching supers', if no fn -> call super (let [mm (non-private-methods super)] (doseq [^java.lang.reflect.Method meth (vals mm)] (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) false (fn [^GeneratorAdapter gen ^Method m] (. gen (loadThis)) ;push args (. gen (loadArgs)) ;call super (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) (. super-type (getInternalName)) (. m (getName)) (. m (getDescriptor))))))) ;add methods matching interfaces', if no fn -> throw (reduce (fn [mm ^java.lang.reflect.Method meth] (if (contains? mm (method-sig meth)) mm (do (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) false emit-unsupported) (assoc mm (method-sig meth) meth)))) mm (mapcat #(.getMethods ^Class %) interfaces)) ;extra methods (doseq [[mname pclasses rclass :as msig] methods] (emit-forwarding-method mname pclasses rclass (:static (meta msig)) emit-unsupported)) ;expose specified overridden superclass methods (doseq [[local-mname ^java.lang.reflect.Method m] (reduce (fn [ms [[name _ _] m]] (if (contains? exposes-methods (symbol name)) (conj ms [((symbol name) exposes-methods) m]) ms)) [] (seq mm))] (let [ptypes (to-types (.getParameterTypes m)) rtype (totype (.getReturnType m)) exposer-m (new Method (str local-mname) rtype ptypes) target-m (new Method (.getName m) rtype ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) exposer-m nil nil cv)] (. gen (loadThis)) (. gen (loadArgs)) (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) (. super-type (getInternalName)) (. target-m (getName)) (. target-m (getDescriptor)))) (. gen (returnValue)) (. gen (endMethod))))) ;main (when main (let [m (. Method getMethod "void main (String[])") gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) m nil nil cv) no-main-label (. gen newLabel) end-label (. gen newLabel)] (. gen (visitCode)) (emit-get-var gen main-name) (. gen dup) (. gen ifNull no-main-label) (.checkCast gen ifn-type) (. gen loadArgs) (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.ISeq seq(Object)")))) (. gen (invokeInterface ifn-type (new Method "applyTo" obj-type (into-array [iseq-type])))) (. gen pop) (. gen goTo end-label) ;no main found (. gen mark no-main-label) (. gen (throwException ex-type (str impl-pkg-name "/" prefix main-name " not defined"))) (. gen mark end-label) (. gen (returnValue)) (. gen (endMethod)))) ;field exposers (doseq [[f {getter :get setter :set}] exposes] (let [fld (find-field super (str f)) ftype (totype (.getType fld)) static? (Modifier/isStatic (.getModifiers fld)) acc (+ Opcodes/ACC_PUBLIC (if static? Opcodes/ACC_STATIC 0))] (when getter (let [m (new Method (str getter) ftype (to-types [])) gen (new GeneratorAdapter acc m nil nil cv)] (. gen (visitCode)) (if static? (. gen getStatic ctype (str f) ftype) (do (. gen loadThis) (. gen getField ctype (str f) ftype))) (. gen (returnValue)) (. gen (endMethod)))) (when setter (let [m (new Method (str setter) Type/VOID_TYPE (into-array [ftype])) gen (new GeneratorAdapter acc m nil nil cv)] (. gen (visitCode)) (if static? (do (. gen loadArgs) (. gen putStatic ctype (str f) ftype)) (do (. gen loadThis) (. gen loadArgs) (. gen putField ctype (str f) ftype))) (. gen (returnValue)) (. gen (endMethod)))))) ;finish class def (. cv (visitEnd)) [cname (. cv (toByteArray))])) (defmacro gen-class "When compiling, generates compiled bytecode for a class with the given package-qualified :name (which, as all names in these parameters, can be a string or symbol), and writes the .class file to the *compile-path* directory. When not compiling, does nothing. The gen-class construct contains no implementation, as the implementation will be dynamically sought by the generated class in functions in an implementing Clojure namespace. Given a generated class org.mydomain.MyClass with a method named mymethod, gen-class will generate an implementation that looks for a function named by (str prefix mymethod) (default prefix: \"-\") in a Clojure namespace specified by :impl-ns (defaults to the current namespace). All inherited methods, generated methods, and init and main functions (see :methods, :init, and :main below) will be found similarly prefixed. By default, the static initializer for the generated class will attempt to load the Clojure support code for the class as a resource from the classpath, e.g. in the example case, ``org/mydomain/MyClass__init.class``. This behavior can be controlled by :load-impl-ns Note that methods with a maximum of 18 parameters are supported. In all subsequent sections taking types, the primitive types can be referred to by their Java names (int, float etc), and classes in the java.lang package can be used without a package qualifier. All other classes must be fully qualified. Options should be a set of key/value pairs, all except for :name are optional: :name aname The package-qualified name of the class to be generated :extends aclass Specifies the superclass, the non-private methods of which will be overridden by the class. If not provided, defaults to Object. :implements [interface ...] One or more interfaces, the methods of which will be implemented by the class. :init name If supplied, names a function that will be called with the arguments to the constructor. Must return [ [superclass-constructor-args] state] If not supplied, the constructor args are passed directly to the superclass constructor and the state will be nil :constructors {[param-types] [super-param-types], ...} By default, constructors are created for the generated class which match the signature(s) of the constructors for the superclass. This parameter may be used to explicitly specify constructors, each entry providing a mapping from a constructor signature to a superclass constructor signature. When you supply this, you must supply an :init specifier. :post-init name If supplied, names a function that will be called with the object as the first argument, followed by the arguments to the constructor. It will be called every time an object of this class is created, immediately after all the inherited constructors have completed. It's return value is ignored. :methods [ [name [param-types] return-type], ...] The generated class automatically defines all of the non-private methods of its superclasses/interfaces. This parameter can be used to specify the signatures of additional methods of the generated class. Static methods can be specified with ^{:static true} in the signature's metadata. Do not repeat superclass/interface signatures here. :main boolean If supplied and true, a static public main function will be generated. It will pass each string of the String[] argument as a separate argument to a function called (str prefix main). :factory name If supplied, a (set of) public static factory function(s) will be created with the given name, and the same signature(s) as the constructor(s). :state name If supplied, a public final instance field with the given name will be created. You must supply an :init function in order to provide a value for the state. Note that, though final, the state can be a ref or agent, supporting the creation of Java objects with transactional or asynchronous mutation semantics. :exposes {protected-field-name {:get name :set name}, ...} Since the implementations of the methods of the generated class occur in Clojure functions, they have no access to the inherited protected fields of the superclass. This parameter can be used to generate public getter/setter methods exposing the protected field(s) for use in the implementation. :exposes-methods {super-method-name exposed-name, ...} It is sometimes necessary to call the superclass' implementation of an overridden method. Those methods may be exposed and referred in the new method implementation by a local name. :prefix string Default: \"-\" Methods called e.g. Foo will be looked up in vars called prefixFoo in the implementing ns. :impl-ns name Default: the name of the current ns. Implementations of methods will be looked up in this namespace. :load-impl-ns boolean Default: true. Causes the static initializer for the generated class to reference the load code for the implementing namespace. Should be true when implementing-ns is the default, false if you intend to load the code via some other method." {:added "1.0"} [& options] (when *compile-files* (let [options-map (into {} (map vec (partition 2 options))) [cname bytecode] (generate-class options-map)] (clojure.lang.Compiler/writeClassFile cname bytecode)))) ;;;;;;;;;;;;;;;;;;;; gen-interface ;;;;;;;;;;;;;;;;;;;;;; ;; based on original contribution by Chris Houser (defn- ^Type asm-type "Returns an asm Type object for c, which may be a primitive class (such as Integer/TYPE), any other class (such as Double), or a fully-qualified class name given as a string or symbol (such as 'java.lang.String)" [c] (if (or (instance? Class c) (prim->class c)) (Type/getType (the-class c)) (let [strx (str c)] (Type/getObjectType (.replace (if (some #{\.} strx) strx (str "java.lang." strx)) "." "/"))))) (defn- generate-interface [{:keys [name extends methods]}] (let [iname (.replace (str name) "." "/") cv (ClassWriter. ClassWriter/COMPUTE_MAXS)] (. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE) iname nil "java/lang/Object" (when (seq extends) (into-array (map #(.getInternalName (asm-type %)) extends)))) (add-annotations cv (meta name)) (doseq [[mname pclasses rclass pmetas] methods] (let [mv (. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) (str mname) (Type/getMethodDescriptor (asm-type rclass) (if pclasses (into-array Type (map asm-type pclasses)) (make-array Type 0))) nil nil)] (add-annotations mv (meta mname)) (dotimes [i (count pmetas)] (add-annotations mv (nth pmetas i) i)) (. mv visitEnd))) (. cv visitEnd) [iname (. cv toByteArray)])) (defmacro gen-interface "When compiling, generates compiled bytecode for an interface with the given package-qualified :name (which, as all names in these parameters, can be a string or symbol), and writes the .class file to the *compile-path* directory. When not compiling, does nothing. In all subsequent sections taking types, the primitive types can be referred to by their Java names (int, float etc), and classes in the java.lang package can be used without a package qualifier. All other classes must be fully qualified. Options should be a set of key/value pairs, all except for :name are optional: :name aname The package-qualified name of the class to be generated :extends [interface ...] One or more interfaces, which will be extended by this interface. :methods [ [name [param-types] return-type], ...] This parameter is used to specify the signatures of the methods of the generated interface. Do not repeat superinterface signatures here." {:added "1.0"} [& options] (let [options-map (apply hash-map options) [cname bytecode] (generate-interface options-map)] (if *compile-files* (clojure.lang.Compiler/writeClassFile cname bytecode) (.defineClass ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (str (:name options-map)) bytecode options)))) (comment (defn gen-and-load-class "Generates and immediately loads the bytecode for the specified class. Note that a class generated this way can be loaded only once - the JVM supports only one class with a given name per classloader. Subsequent to generation you can import it into any desired namespaces just like any other class. See gen-class for a description of the options." {:added "1.0"} [& options] (let [options-map (apply hash-map options) [cname bytecode] (generate-class options-map)] (.. (clojure.lang.RT/getRootClassLoader) (defineClass cname bytecode options)))) ) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/gvec.clj000066400000000000000000000367321157562347600220120ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; a generic vector implementation for vectors of primitives (in-ns 'clojure.core) ;(set! *warn-on-reflection* true) (deftype VecNode [edit arr]) (def EMPTY-NODE (VecNode. nil (object-array 32))) (definterface IVecImpl (^int tailoff []) (arrayFor [^int i]) (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode]) (popTail [^int level node]) (newPath [edit ^int level node]) (doAssoc [^int level node ^int i val])) (definterface ArrayManager (array [^int size]) (^int alength [arr]) (aclone [arr]) (aget [arr ^int i]) (aset [arr ^int i val])) (deftype ArrayChunk [^clojure.core.ArrayManager am arr ^int off ^int end] clojure.lang.Indexed (nth [_ i] (.aget am arr (+ off i))) (count [_] (- end off)) clojure.lang.IChunk (dropFirst [_] (if (= off end) (throw (IllegalStateException. "dropFirst of empty chunk")) (new ArrayChunk am arr (inc off) end))) (reduce [_ f init] (loop [ret init i off] (if (< i end) (recur (f ret (.aget am arr i)) (inc i)) ret))) ) (deftype VecSeq [^clojure.core.ArrayManager am ^clojure.core.IVecImpl vec anode ^int i ^int offset] :no-print true clojure.core.protocols.InternalReduce (internal-reduce [_ f val] (loop [result val aidx offset] (if (< aidx (count vec)) (let [node (.arrayFor vec aidx) result (loop [result result node-idx (bit-and (int 0x1f) aidx)] (if (< node-idx (.alength am node)) (recur (f result (.aget am node node-idx)) (inc node-idx)) result))] (recur result (bit-and (int 0xffe0) (+ aidx (int 32))))) result))) clojure.lang.ISeq (first [_] (.aget am anode offset)) (next [this] (if (< (inc offset) (.alength am anode)) (new VecSeq am vec anode i (inc offset)) (.chunkedNext this))) (more [this] (let [s (.next this)] (or s (clojure.lang.PersistentList/EMPTY)))) (cons [this o] (clojure.lang.Cons. o this)) (count [this] (loop [i 1 s (next this)] (if s (if (instance? clojure.lang.Counted s) (+ i (.count s)) (recur (inc i) (next s))) i))) (equiv [this o] (cond (identical? this o) true (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) (loop [me this you (seq o)] (if (nil? me) (nil? you) (and (clojure.lang.Util/equiv (first me) (first you)) (recur (next me) (next you))))) :else false)) (empty [_] clojure.lang.PersistentList/EMPTY) clojure.lang.Seqable (seq [this] this) clojure.lang.IChunkedSeq (chunkedFirst [_] (ArrayChunk. am anode offset (.alength am anode))) (chunkedNext [_] (let [nexti (+ i (.alength am anode))] (when (< nexti (count vec)) (new VecSeq am vec (.arrayFor vec nexti) nexti 0)))) (chunkedMore [this] (let [s (.chunkedNext this)] (or s (clojure.lang.PersistentList/EMPTY))))) (defmethod print-method ::VecSeq [v w] ((get (methods print-method) clojure.lang.ISeq) v w)) (deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta] Object (equals [this o] (cond (identical? this o) true (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o)) (and (= cnt (count o)) (loop [i (int 0)] (cond (= i cnt) true (.equals (.nth this i) (nth o i)) (recur (inc i)) :else false))) (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) (.equals (seq this) (seq o)) :else false)) ;todo - cache (hashCode [this] (loop [hash (int 1) i (int 0)] (if (= i cnt) hash (let [val (.nth this i)] (recur (unchecked-add (unchecked-multiply (int 31) hash) (clojure.lang.Util/hash val)) (inc i)))))) clojure.lang.Counted (count [_] cnt) clojure.lang.IMeta (meta [_] _meta) clojure.lang.IObj (withMeta [_ m] (new Vec am cnt shift root tail m)) clojure.lang.Indexed (nth [this i] (let [a (.arrayFor this i)] (.aget am a (bit-and i (int 0x1f))))) (nth [this i not-found] (let [z (int 0)] (if (and (>= i z) (< i (.count this))) (.nth this i) not-found))) clojure.lang.IPersistentCollection (cons [this val] (if (< (- cnt (.tailoff this)) (int 32)) (let [new-tail (.array am (inc (.alength am tail)))] (System/arraycopy tail 0 new-tail 0 (.alength am tail)) (.aset am new-tail (.alength am tail) val) (new Vec am (inc cnt) shift root new-tail (meta this))) (let [tail-node (VecNode. (.edit root) tail)] (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root? (let [new-root (VecNode. (.edit root) (object-array 32))] (doto ^objects (.arr new-root) (aset 0 root) (aset 1 (.newPath this (.edit root) shift tail-node))) (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am tl 0 val) tl) (meta this))) (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) (let [tl (.array am 1)] (.aset am tl 0 val) tl) (meta this)))))) (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0) nil)) (equiv [this o] (cond (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o)) (and (= cnt (count o)) (loop [i (int 0)] (cond (= i cnt) true (= (.nth this i) (nth o i)) (recur (inc i)) :else false))) (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) (= (seq this) (seq o)) :else false)) clojure.lang.IPersistentStack (peek [this] (when (> cnt (int 0)) (.nth this (dec cnt)))) (pop [this] (cond (zero? cnt) (throw (IllegalStateException. "Can't pop empty vector")) (= 1 cnt) (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this)) (> (- cnt (.tailoff this)) 1) (let [new-tail (.array am (dec (.alength am tail)))] (System/arraycopy tail 0 new-tail 0 (.alength am new-tail)) (new Vec am (dec cnt) shift root new-tail (meta this))) :else (let [new-tail (.arrayFor this (- cnt 2)) new-root ^clojure.core.VecNode (.popTail this shift root)] (cond (nil? new-root) (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this)) (and (> shift 5) (nil? (aget ^objects (.arr new-root) 1))) (new Vec am (dec cnt) (- shift 5) (aget ^objects (.arr new-root) 0) new-tail (meta this)) :else (new Vec am (dec cnt) shift new-root new-tail (meta this)))))) clojure.lang.IPersistentVector (assocN [this i val] (cond (and (<= (int 0) i) (< i cnt)) (if (>= i (.tailoff this)) (let [new-tail (.array am (.alength am tail))] (System/arraycopy tail 0 new-tail 0 (.alength am tail)) (.aset am new-tail (bit-and i (int 0x1f)) val) (new Vec am cnt shift root new-tail (meta this))) (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this))) (= i cnt) (.cons this val) :else (throw (IndexOutOfBoundsException.)))) clojure.lang.Reversible (rseq [this] (if (> (.count this) 0) (clojure.lang.APersistentVector$RSeq. this (dec (.count this))) nil)) clojure.lang.Associative (assoc [this k v] (if (clojure.lang.Util/isInteger k) (.assocN this k v) (throw (IllegalArgumentException. "Key must be integer")))) (containsKey [this k] (and (clojure.lang.Util/isInteger k) (<= 0 (int k)) (< (int k) cnt))) (entryAt [this k] (if (.containsKey this k) (clojure.lang.MapEntry. k (.nth this (int k))) nil)) clojure.lang.ILookup (valAt [this k not-found] (if (clojure.lang.Util/isInteger k) (let [i (int k)] (if (and (>= i 0) (< i cnt)) (.nth this i) not-found)) not-found)) (valAt [this k] (.valAt this k nil)) clojure.lang.IFn (invoke [this k] (if (clojure.lang.Util/isInteger k) (let [i (int k)] (if (and (>= i 0) (< i cnt)) (.nth this i) (throw (IndexOutOfBoundsException.)))) (throw (IllegalArgumentException. "Key must be integer")))) clojure.lang.Seqable (seq [this] (if (zero? cnt) nil (VecSeq. am this (.arrayFor this 0) 0 0))) clojure.lang.Sequential ;marker, no methods clojure.core.IVecImpl (tailoff [_] (- cnt (.alength am tail))) (arrayFor [this i] (if (and (<= (int 0) i) (< i cnt)) (if (>= i (.tailoff this)) tail (loop [node root level shift] (if (zero? level) (.arr node) (recur (aget ^objects (.arr node) (bit-and (bit-shift-right i level) (int 0x1f))) (- level (int 5)))))) (throw (IndexOutOfBoundsException.)))) (pushTail [this level parent tailnode] (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f)) parent ^clojure.core.VecNode parent ret (VecNode. (.edit parent) (aclone ^objects (.arr parent))) node-to-insert (if (= level (int 5)) tailnode (let [child (aget ^objects (.arr parent) subidx)] (if child (.pushTail this (- level (int 5)) child tailnode) (.newPath this (.edit root) (- level (int 5)) tailnode))))] (aset ^objects (.arr ret) subidx node-to-insert) ret)) (popTail [this level node] (let [node ^clojure.core.VecNode node subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))] (cond (> level 5) (let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))] (if (and (nil? new-child) (zero? subidx)) nil (let [arr (aclone ^objects (.arr node))] (aset arr subidx new-child) (VecNode. (.edit root) arr)))) (zero? subidx) nil :else (let [arr (aclone ^objects (.arr node))] (aset arr subidx nil) (VecNode. (.edit root) arr))))) (newPath [this edit ^int level node] (if (zero? level) node (let [ret (VecNode. edit (object-array 32))] (aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node)) ret))) (doAssoc [this level node i val] (let [node ^clojure.core.VecNode node] (if (zero? level) ;on this branch, array will need val type (let [arr (.aclone am (.arr node))] (.aset am arr (bit-and i (int 0x1f)) val) (VecNode. (.edit node) arr)) (let [arr (aclone ^objects (.arr node)) subidx (bit-and (bit-shift-right i level) (int 0x1f))] (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val)) (VecNode. (.edit node) arr))))) java.lang.Comparable (compareTo [this o] (if (identical? this o) 0 (let [#^clojure.lang.IPersistentVector v (cast clojure.lang.IPersistentVector o) vcnt (.count v)] (cond (< cnt vcnt) -1 (> cnt vcnt) 1 :else (loop [i (int 0)] (if (= i cnt) 0 (let [comp (clojure.lang.Util/compare (.nth this i) (.nth v i))] (if (= 0 comp) (recur (inc i)) comp)))))))) java.lang.Iterable (iterator [this] (let [i (java.util.concurrent.atomic.AtomicInteger. 0)] (reify java.util.Iterator (hasNext [_] (< (.get i) cnt)) (next [_] (.nth this (dec (.incrementAndGet i)))) (remove [_] (throw (UnsupportedOperationException.)))))) java.util.Collection (contains [this o] (boolean (some #(= % o) this))) (containsAll [this c] (every? #(.contains this %) c)) (isEmpty [_] (zero? cnt)) (toArray [this] (into-array Object this)) (toArray [this arr] (if (>= (count arr) cnt) (do (dotimes [i cnt] (aset arr i (.nth this i))) arr) (into-array Object this))) (size [_] cnt) (add [_ o] (throw (UnsupportedOperationException.))) (addAll [_ c] (throw (UnsupportedOperationException.))) (clear [_] (throw (UnsupportedOperationException.))) (^boolean remove [_ o] (throw (UnsupportedOperationException.))) (removeAll [_ c] (throw (UnsupportedOperationException.))) (retainAll [_ c] (throw (UnsupportedOperationException.))) java.util.List (get [this i] (.nth this i)) (indexOf [this o] (loop [i (int 0)] (cond (== i cnt) -1 (= o (.nth this i)) i :else (recur (inc i))))) (lastIndexOf [this o] (loop [i (dec cnt)] (cond (< i 0) -1 (= o (.nth this i)) i :else (recur (dec i))))) (listIterator [this] (.listIterator this 0)) (listIterator [this i] (let [i (java.util.concurrent.atomic.AtomicInteger. i)] (reify java.util.ListIterator (hasNext [_] (< (.get i) cnt)) (hasPrevious [_] (pos? i)) (next [_] (.nth this (dec (.incrementAndGet i)))) (nextIndex [_] (.get i)) (previous [_] (.nth this (.decrementAndGet i))) (previousIndex [_] (dec (.get i))) (add [_ e] (throw (UnsupportedOperationException.))) (remove [_] (throw (UnsupportedOperationException.))) (set [_ e] (throw (UnsupportedOperationException.)))))) (subList [this a z] (subvec this a z)) (add [_ i o] (throw (UnsupportedOperationException.))) (addAll [_ i c] (throw (UnsupportedOperationException.))) (^Object remove [_ ^int i] (throw (UnsupportedOperationException.))) (set [_ i e] (throw (UnsupportedOperationException.))) ) (defmethod print-method ::Vec [v w] ((get (methods print-method) clojure.lang.IPersistentVector) v w)) (defmacro mk-am {:private true} [t] (let [garr (gensym) tgarr (with-meta garr {:tag (symbol (str t "s"))})] `(reify clojure.core.ArrayManager (array [_ size#] (~(symbol (str t "-array")) size#)) (alength [_ ~garr] (alength ~tgarr)) (aclone [_ ~garr] (aclone ~tgarr)) (aget [_ ~garr i#] (aget ~tgarr i#)) (aset [_ ~garr i# val#] (aset ~tgarr i# (~t val#)))))) (def ^{:private true} ams {:int (mk-am int) :long (mk-am long) :float (mk-am float) :double (mk-am double) :byte (mk-am byte) :short (mk-am short) :char (mk-am char) :boolean (mk-am boolean)}) (defn vector-of "Creates a new vector of a single primitive type t, where t is one of :int :long :float :double :byte :short :char or :boolean. The resulting vector complies with the interface of vectors in general, but stores the values unboxed internally." {:added "1.2"} [t] (let [am ^clojure.core.ArrayManager (ams t)] (Vec. am 0 5 EMPTY-NODE (.array am 0) nil))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/inspector.clj000066400000000000000000000127111157562347600230630ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Graphical object inspector for Clojure data structures." :author "Rich Hickey"} clojure.inspector (:import (java.awt BorderLayout) (java.awt.event ActionEvent ActionListener) (javax.swing.tree TreeModel) (javax.swing.table TableModel AbstractTableModel) (javax.swing JPanel JTree JTable JScrollPane JFrame JToolBar JButton SwingUtilities))) (defn atom? [x] (not (coll? x))) (defn collection-tag [x] (cond (instance? java.util.Map$Entry x) :entry (instance? java.util.Map x) :map (sequential? x) :seq :else :atom)) (defmulti is-leaf collection-tag) (defmulti get-child (fn [parent index] (collection-tag parent))) (defmulti get-child-count collection-tag) (defmethod is-leaf :default [node] (atom? node)) (defmethod get-child :default [parent index] (nth parent index)) (defmethod get-child-count :default [parent] (count parent)) (defmethod is-leaf :entry [e] (is-leaf (val e))) (defmethod get-child :entry [e index] (get-child (val e) index)) (defmethod get-child-count :entry [e] (count (val e))) (defmethod is-leaf :map [m] false) (defmethod get-child :map [m index] (nth (seq m) index)) (defn tree-model [data] (proxy [TreeModel] [] (getRoot [] data) (addTreeModelListener [treeModelListener]) (getChild [parent index] (get-child parent index)) (getChildCount [parent] (get-child-count parent)) (isLeaf [node] (is-leaf node)) (valueForPathChanged [path newValue]) (getIndexOfChild [parent child] -1) (removeTreeModelListener [treeModelListener]))) (defn old-table-model [data] (let [row1 (first data) colcnt (count row1) cnt (count data) vals (if (map? row1) vals identity)] (proxy [TableModel] [] (addTableModelListener [tableModelListener]) (getColumnClass [columnIndex] Object) (getColumnCount [] colcnt) (getColumnName [columnIndex] (if (map? row1) (name (nth (keys row1) columnIndex)) (str columnIndex))) (getRowCount [] cnt) (getValueAt [rowIndex columnIndex] (nth (vals (nth data rowIndex)) columnIndex)) (isCellEditable [rowIndex columnIndex] false) (removeTableModelListener [tableModelListener])))) (defn inspect-tree "creates a graphical (Swing) inspector on the supplied hierarchical data" {:added "1.0"} [data] (doto (JFrame. "Clojure Inspector") (.add (JScrollPane. (JTree. (tree-model data)))) (.setSize 400 600) (.setVisible true))) (defn inspect-table "creates a graphical (Swing) inspector on the supplied regular data, which must be a sequential data structure of data structures of equal length" {:added "1.0"} [data] (doto (JFrame. "Clojure Inspector") (.add (JScrollPane. (JTable. (old-table-model data)))) (.setSize 400 600) (.setVisible true))) (defmulti list-provider class) (defmethod list-provider :default [x] {:nrows 1 :get-value (fn [i] x) :get-label (fn [i] (.getName (class x)))}) (defmethod list-provider java.util.List [c] (let [v (if (vector? c) c (vec c))] {:nrows (count v) :get-value (fn [i] (v i)) :get-label (fn [i] i)})) (defmethod list-provider java.util.Map [c] (let [v (vec (sort (map (fn [[k v]] (vector k v)) c)))] {:nrows (count v) :get-value (fn [i] ((v i) 1)) :get-label (fn [i] ((v i) 0))})) (defn list-model [provider] (let [{:keys [nrows get-value get-label]} provider] (proxy [AbstractTableModel] [] (getColumnCount [] 2) (getRowCount [] nrows) (getValueAt [rowIndex columnIndex] (cond (= 0 columnIndex) (get-label rowIndex) (= 1 columnIndex) (print-str (get-value rowIndex))))))) (defmulti table-model class) (defmethod table-model :default [x] (proxy [AbstractTableModel] [] (getColumnCount [] 2) (getRowCount [] 1) (getValueAt [rowIndex columnIndex] (if (zero? columnIndex) (class x) x)))) ;(defn make-inspector [x] ; (agent {:frame frame :data x :parent nil :index 0})) (defn inspect "creates a graphical (Swing) inspector on the supplied object" {:added "1.0"} [x] (doto (JFrame. "Clojure Inspector") (.add (doto (JPanel. (BorderLayout.)) (.add (doto (JToolBar.) (.add (JButton. "Back")) (.addSeparator) (.add (JButton. "List")) (.add (JButton. "Table")) (.add (JButton. "Bean")) (.add (JButton. "Line")) (.add (JButton. "Bar")) (.addSeparator) (.add (JButton. "Prev")) (.add (JButton. "Next"))) BorderLayout/NORTH) (.add (JScrollPane. (doto (JTable. (list-model (list-provider x))) (.setAutoResizeMode JTable/AUTO_RESIZE_LAST_COLUMN))) BorderLayout/CENTER))) (.setSize 400 400) (.setVisible true))) (comment (load-file "src/inspector.clj") (refer 'inspector) (inspect-tree {:a 1 :b 2 :c [1 2 3 {:d 4 :e 5 :f [6 7 8]}]}) (inspect-table [[1 2 3][4 5 6][7 8 9][10 11 12]]) ) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/java/000077500000000000000000000000001157562347600213025ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/java/browse.clj000066400000000000000000000036031157562347600232770ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Christophe Grand", :doc "Start a web browser from Clojure"} clojure.java.browse (:require [clojure.java.shell :as sh]) (:import (java.net URI))) (defn- macosx? [] (-> "os.name" System/getProperty .toLowerCase (.startsWith "mac os x"))) (def *open-url-script* (when (macosx?) "/usr/bin/open")) (defn- open-url-in-browser "Opens url (a string) in the default system web browser. May not work on all platforms. Returns url on success, nil if not supported." [url] (try (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" "isDesktopSupported" (to-array nil)) (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" "getDesktop" (to-array nil)) (.browse (URI. url))) url) (catch ClassNotFoundException e nil))) (defn- open-url-in-swing "Opens url (a string) in a Swing window." [url] ; the implementation of this function resides in another namespace to be loaded "on demand" ; this fixes a bug on mac os x where the process turns into a GUI app ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32 (require 'clojure.java.browse-ui) ((find-var 'clojure.java.browse-ui/open-url-in-swing) url)) (defn browse-url "Open url in a browser" {:added "1.2"} [url] (or (open-url-in-browser url) (when *open-url-script* (sh/sh *open-url-script* (str url)) true) (open-url-in-swing url))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/java/browse_ui.clj000066400000000000000000000025321157562347600237740ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Christophe Grand", :doc "Helper namespace for clojure.java.browse. Prevents console apps from becoming GUI unnecessarily."} clojure.java.browse-ui) (defn- open-url-in-swing [url] (let [htmlpane (javax.swing.JEditorPane. url)] (.setEditable htmlpane false) (.addHyperlinkListener htmlpane (proxy [javax.swing.event.HyperlinkListener] [] (hyperlinkUpdate [#^javax.swing.event.HyperlinkEvent e] (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED)) (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e) (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e)) (.setPage htmlpane (.getURL e))))))) (doto (javax.swing.JFrame.) (.setContentPane (javax.swing.JScrollPane. htmlpane)) (.setBounds 32 32 700 900) (.show)))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/java/io.clj000066400000000000000000000356041157562347600224130ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Stuart Sierra, Chas Emerick, Stuart Halloway", :doc "This file defines polymorphic I/O utility functions for Clojure."} clojure.java.io (:import (java.io Reader InputStream InputStreamReader PushbackReader BufferedReader File OutputStream OutputStreamWriter BufferedWriter Writer FileInputStream FileOutputStream ByteArrayOutputStream StringReader ByteArrayInputStream BufferedInputStream BufferedOutputStream CharArrayReader Closeable) (java.net URI URL MalformedURLException Socket))) (def ^{:doc "Type object for a Java primitive byte array." :private true } byte-array-type (class (make-array Byte/TYPE 0))) (def ^{:doc "Type object for a Java primitive char array." :private true} char-array-type (class (make-array Character/TYPE 0))) (defprotocol ^{:added "1.2"} Coercions "Coerce between various 'resource-namish' things." (^{:tag java.io.File, :added "1.2"} as-file [x] "Coerce argument to a file.") (^{:tag java.net.URL, :added "1.2"} as-url [x] "Coerce argument to a URL.")) (extend-protocol Coercions nil (as-file [_] nil) (as-url [_] nil) String (as-file [s] (File. s)) (as-url [s] (URL. s)) File (as-file [f] f) (as-url [f] (.toURL f)) URL (as-url [u] u) (as-file [u] (if (= "file" (.getProtocol u)) (as-file (.getPath u)) (throw (IllegalArgumentException. "Not a file: " u)))) URI (as-url [u] (.toURL u)) (as-file [u] (as-file (as-url u)))) (defprotocol ^{:added "1.2"} IOFactory "Factory functions that create ready-to-use, buffered versions of the various Java I/O stream types, on top of anything that can be unequivocally converted to the requested kind of stream. Common options include :append true to open stream in append mode :encoding string name of encoding to use, e.g. \"UTF-8\". Callers should generally prefer the higher level API provided by reader, writer, input-stream, and output-stream." (^{:added "1.2"} make-reader [x opts] "Creates a BufferedReader. See also IOFactory docs.") (^{:added "1.2"} make-writer [x opts] "Creates a BufferedWriter. See also IOFactory docs.") (^{:added "1.2"} make-input-stream [x opts] "Creates a BufferedInputStream. See also IOFactory docs.") (^{:added "1.2"} make-output-stream [x opts] "Creates a BufferedOutputStream. See also IOFactory docs.")) (defn ^Reader reader "Attempts to coerce its argument into an open java.io.Reader. Default implementations always return a java.io.BufferedReader. Default implementations are provided for Reader, BufferedReader, InputStream, File, URI, URL, Socket, byte arrays, character arrays, and String. If argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the Reader is properly closed." {:added "1.2"} [x & opts] (make-reader x (when opts (apply hash-map opts)))) (defn ^Writer writer "Attempts to coerce its argument into an open java.io.Writer. Default implementations always return a java.io.BufferedWriter. Default implementations are provided for Writer, BufferedWriter, OutputStream, File, URI, URL, Socket, and String. If the argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the Writer is properly closed." {:added "1.2"} [x & opts] (make-writer x (when opts (apply hash-map opts)))) (defn ^InputStream input-stream "Attempts to coerce its argument into an open java.io.InputStream. Default implementations always return a java.io.BufferedInputStream. Default implementations are defined for OutputStream, File, URI, URL, Socket, byte array, and String arguments. If the argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the InputStream is properly closed." {:added "1.2"} [x & opts] (make-input-stream x (when opts (apply hash-map opts)))) (defn ^OutputStream output-stream "Attempts to coerce its argument into an open java.io.OutputStream. Default implementations always return a java.io.BufferedOutputStream. Default implementations are defined for OutputStream, File, URI, URL, Socket, and String arguments. If the argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the OutputStream is properly closed." {:added "1.2"} [x & opts] (make-output-stream x (when opts (apply hash-map opts)))) (defn- ^Boolean append? [opts] (boolean (:append opts))) (defn- ^String encoding [opts] (or (:encoding opts) "UTF-8")) (defn- buffer-size [opts] (or (:buffer-size opts) 1024)) (def default-streams-impl {:make-reader (fn [x opts] (make-reader (make-input-stream x opts) opts)) :make-writer (fn [x opts] (make-writer (make-output-stream x opts) opts)) :make-input-stream (fn [x opts] (throw (IllegalArgumentException. (str "Cannot open <" (pr-str x) "> as an InputStream.")))) :make-output-stream (fn [x opts] (throw (IllegalArgumentException. (str "Cannot open <" (pr-str x) "> as an OutputStream."))))}) (defn- inputstream->reader [^InputStream is opts] (make-reader (InputStreamReader. is (encoding opts)) opts)) (defn- outputstream->writer [^OutputStream os opts] (make-writer (OutputStreamWriter. os (encoding opts)) opts)) (extend BufferedInputStream IOFactory (assoc default-streams-impl :make-input-stream (fn [x opts] x) :make-reader inputstream->reader)) (extend InputStream IOFactory (assoc default-streams-impl :make-input-stream (fn [x opts] (BufferedInputStream. x)) :make-reader inputstream->reader)) (extend Reader IOFactory (assoc default-streams-impl :make-reader (fn [x opts] (BufferedReader. x)))) (extend BufferedReader IOFactory (assoc default-streams-impl :make-reader (fn [x opts] x))) (extend Writer IOFactory (assoc default-streams-impl :make-writer (fn [x opts] (BufferedWriter. x)))) (extend BufferedWriter IOFactory (assoc default-streams-impl :make-writer (fn [x opts] x))) (extend OutputStream IOFactory (assoc default-streams-impl :make-output-stream (fn [x opts] (BufferedOutputStream. x)) :make-writer outputstream->writer)) (extend BufferedOutputStream IOFactory (assoc default-streams-impl :make-output-stream (fn [x opts] x) :make-writer outputstream->writer)) (extend File IOFactory (assoc default-streams-impl :make-input-stream (fn [^File x opts] (make-input-stream (FileInputStream. x) opts)) :make-output-stream (fn [^File x opts] (make-output-stream (FileOutputStream. x (append? opts)) opts)))) (extend URL IOFactory (assoc default-streams-impl :make-input-stream (fn [^URL x opts] (make-input-stream (if (= "file" (.getProtocol x)) (FileInputStream. (.getPath x)) (.openStream x)) opts)) :make-output-stream (fn [^URL x opts] (if (= "file" (.getProtocol x)) (make-output-stream (File. (.getPath x)) opts) (throw (IllegalArgumentException. (str "Can not write to non-file URL <" x ">"))))))) (extend URI IOFactory (assoc default-streams-impl :make-input-stream (fn [^URI x opts] (make-input-stream (.toURL x) opts)) :make-output-stream (fn [^URI x opts] (make-output-stream (.toURL x) opts)))) (extend String IOFactory (assoc default-streams-impl :make-input-stream (fn [^String x opts] (try (make-input-stream (URL. x) opts) (catch MalformedURLException e (make-input-stream (File. x) opts)))) :make-output-stream (fn [^String x opts] (try (make-output-stream (URL. x) opts) (catch MalformedURLException err (make-output-stream (File. x) opts)))))) (extend Socket IOFactory (assoc default-streams-impl :make-input-stream (fn [^Socket x opts] (make-input-stream (.getInputStream x) opts)) :make-output-stream (fn [^Socket x opts] (make-output-stream (.getOutputStream x) opts)))) (extend byte-array-type IOFactory (assoc default-streams-impl :make-input-stream (fn [x opts] (make-input-stream (ByteArrayInputStream. x) opts)))) (extend char-array-type IOFactory (assoc default-streams-impl :make-reader (fn [x opts] (make-reader (CharArrayReader. x) opts)))) (extend Object IOFactory default-streams-impl) (defmulti #^{:doc "Internal helper for copy" :private true :arglists '([input output opts])} do-copy (fn [input output opts] [(type input) (type output)])) (defmethod do-copy [InputStream OutputStream] [#^InputStream input #^OutputStream output opts] (let [buffer (make-array Byte/TYPE (buffer-size opts))] (loop [] (let [size (.read input buffer)] (when (pos? size) (do (.write output buffer 0 size) (recur))))))) (defmethod do-copy [InputStream Writer] [#^InputStream input #^Writer output opts] (let [#^"[B" buffer (make-array Byte/TYPE (buffer-size opts))] (loop [] (let [size (.read input buffer)] (when (pos? size) (let [chars (.toCharArray (String. buffer 0 size (encoding opts)))] (do (.write output chars) (recur)))))))) (defmethod do-copy [InputStream File] [#^InputStream input #^File output opts] (with-open [out (FileOutputStream. output)] (do-copy input out opts))) (defmethod do-copy [Reader OutputStream] [#^Reader input #^OutputStream output opts] (let [#^"[C" buffer (make-array Character/TYPE (buffer-size opts))] (loop [] (let [size (.read input buffer)] (when (pos? size) (let [bytes (.getBytes (String. buffer 0 size) (encoding opts))] (do (.write output bytes) (recur)))))))) (defmethod do-copy [Reader Writer] [#^Reader input #^Writer output opts] (let [#^"[C" buffer (make-array Character/TYPE (buffer-size opts))] (loop [] (let [size (.read input buffer)] (when (pos? size) (do (.write output buffer 0 size) (recur))))))) (defmethod do-copy [Reader File] [#^Reader input #^File output opts] (with-open [out (FileOutputStream. output)] (do-copy input out opts))) (defmethod do-copy [File OutputStream] [#^File input #^OutputStream output opts] (with-open [in (FileInputStream. input)] (do-copy in output opts))) (defmethod do-copy [File Writer] [#^File input #^Writer output opts] (with-open [in (FileInputStream. input)] (do-copy in output opts))) (defmethod do-copy [File File] [#^File input #^File output opts] (with-open [in (FileInputStream. input) out (FileOutputStream. output)] (do-copy in out opts))) (defmethod do-copy [String OutputStream] [#^String input #^OutputStream output opts] (do-copy (StringReader. input) output opts)) (defmethod do-copy [String Writer] [#^String input #^Writer output opts] (do-copy (StringReader. input) output opts)) (defmethod do-copy [String File] [#^String input #^File output opts] (do-copy (StringReader. input) output opts)) (defmethod do-copy [char-array-type OutputStream] [input #^OutputStream output opts] (do-copy (CharArrayReader. input) output opts)) (defmethod do-copy [char-array-type Writer] [input #^Writer output opts] (do-copy (CharArrayReader. input) output opts)) (defmethod do-copy [char-array-type File] [input #^File output opts] (do-copy (CharArrayReader. input) output opts)) (defmethod do-copy [byte-array-type OutputStream] [#^"[B" input #^OutputStream output opts] (do-copy (ByteArrayInputStream. input) output opts)) (defmethod do-copy [byte-array-type Writer] [#^"[B" input #^Writer output opts] (do-copy (ByteArrayInputStream. input) output opts)) (defmethod do-copy [byte-array-type File] [#^"[B" input #^Writer output opts] (do-copy (ByteArrayInputStream. input) output opts)) (defn copy "Copies input to output. Returns nil or throws IOException. Input may be an InputStream, Reader, File, byte[], or String. Output may be an OutputStream, Writer, or File. Options are key/value pairs and may be one of :buffer-size buffer size to use, default is 1024. :encoding encoding to use if converting between byte and char streams. Does not close any streams except those it opens itself (on a File)." {:added "1.2"} [input output & opts] (do-copy input output (when opts (apply hash-map opts)))) (defn ^String as-relative-path "Take an as-file-able thing and return a string if it is a relative path, else IllegalArgumentException." {:added "1.2"} [x] (let [^File f (as-file x)] (if (.isAbsolute f) (throw (IllegalArgumentException. (str f " is not a relative path"))) (.getPath f)))) (defn ^File file "Returns a java.io.File, passing each arg to as-file. Multiple-arg versions treat the first argument as parent and subsequent args as children relative to the parent." {:added "1.2"} ([arg] (as-file arg)) ([parent child] (File. ^File (as-file parent) ^String (as-relative-path child))) ([parent child & more] (reduce file (file parent child) more))) (defn delete-file "Delete file f. Raise an exception if it fails unless silently is true." {:added "1.2"} [f & [silently]] (or (.delete (file f)) silently (throw (java.io.IOException. (str "Couldn't delete " f))))) (defn make-parents "Given the same arg(s) as for file, creates all parent directories of the file they represent." {:added "1.2"} [f & more] (.mkdirs (.getParentFile ^File (apply file f more)))) (defn ^URL resource "Returns the URL for a named resource. Use the context class loader if no loader is specified." {:added "1.2"} ([n] (resource n (.getContextClassLoader (Thread/currentThread)))) ([n ^ClassLoader loader] (.getResource loader n))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/java/javadoc.clj000066400000000000000000000062451157562347600234120ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Christophe Grand, Stuart Sierra", :doc "A repl helper to quickly open javadocs."} clojure.java.javadoc (:use [clojure.java.browse :only (browse-url)] ) (:import (java.io File))) (def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:") (def *feeling-lucky* true) (def *local-javadocs* (ref (list))) (def *core-java-api* (if (= "1.5" (System/getProperty "java.specification.version")) "http://java.sun.com/j2se/1.5.0/docs/api/" "http://java.sun.com/javase/6/docs/api/")) (def *remote-javadocs* (ref (sorted-map "java." *core-java-api* "javax." *core-java-api* "org.ietf.jgss." *core-java-api* "org.omg." *core-java-api* "org.w3c.dom." *core-java-api* "org.xml.sax." *core-java-api* "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" "org.apache.commons.io." "http://commons.apache.org/io/api-release/" "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) (defn add-local-javadoc "Adds to the list of local Javadoc paths." {:added "1.2"} [path] (dosync (commute *local-javadocs* conj path))) (defn add-remote-javadoc "Adds to the list of remote Javadoc URLs. package-prefix is the beginning of the package name that has docs at this URL." {:added "1.2"} [package-prefix url] (dosync (commute *remote-javadocs* assoc package-prefix url))) (defn- javadoc-url "Searches for a URL for the given class name. Tries *local-javadocs* first, then *remote-javadocs*. Returns a string." {:tag String, :added "1.2"} [^String classname] (let [file-path (.replace classname \. File/separatorChar) url-path (.replace classname \. \/)] (if-let [file ^File (first (filter #(.exists ^File %) (map #(File. (str %) (str file-path ".html")) @*local-javadocs*)))] (-> file .toURI str) ;; If no local file, try remote URLs: (or (some (fn [[prefix url]] (when (.startsWith classname prefix) (str url url-path ".html"))) @*remote-javadocs*) ;; if *feeling-lucky* try a web search (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html")))))) (defn javadoc "Opens a browser window displaying the javadoc for the argument. Tries *local-javadocs* first, then *remote-javadocs*." {:added "1.2"} [class-or-object] (let [^Class c (if (instance? Class class-or-object) class-or-object (class class-or-object))] (if-let [url (javadoc-url (.getName c))] (browse-url url) (println "Could not find Javadoc for" c)))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/java/shell.clj000066400000000000000000000121041157562347600231010ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Chris Houser, Stuart Halloway", :doc "Conveniently launch a sub-process providing its stdin and collecting its stdout"} clojure.java.shell (:use [clojure.java.io :only (as-file copy)]) (:import (java.io OutputStreamWriter ByteArrayOutputStream StringWriter) (java.nio.charset Charset))) (def *sh-dir* nil) (def *sh-env* nil) (defmacro with-sh-dir "Sets the directory for use with sh, see sh for details." {:added "1.2"} [dir & forms] `(binding [*sh-dir* ~dir] ~@forms)) (defmacro with-sh-env "Sets the environment for use with sh, see sh for details." {:added "1.2"} [env & forms] `(binding [*sh-env* ~env] ~@forms)) (defn- aconcat "Concatenates arrays of given type." [type & xs] (let [target (make-array type (apply + (map count xs)))] (loop [i 0 idx 0] (when-let [a (nth xs i nil)] (System/arraycopy a 0 target idx (count a)) (recur (inc i) (+ idx (count a))))) target)) (defn- parse-args [args] (let [default-encoding "UTF-8" ;; see sh doc string default-opts {:out-enc default-encoding :in-enc default-encoding :dir *sh-dir* :env *sh-env*} [cmd opts] (split-with string? args)] [cmd (merge default-opts (apply hash-map opts))])) (defn- ^"[Ljava.lang.String;" as-env-strings "Helper so that callers can pass a Clojure map for the :env to sh." [arg] (cond (nil? arg) nil (map? arg) (into-array String (map (fn [[k v]] (str (name k) "=" v)) arg)) true arg)) (defn- stream-to-bytes [in] (with-open [bout (ByteArrayOutputStream.)] (copy in bout) (.toByteArray bout))) (defn- stream-to-string ([in] (stream-to-string in (.name (Charset/defaultCharset)))) ([in enc] (with-open [bout (StringWriter.)] (copy in bout :encoding enc) (.toString bout)))) (defn- stream-to-enc [stream enc] (if (= enc :bytes) (stream-to-bytes stream) (stream-to-string stream enc))) (defn sh "Passes the given strings to Runtime.exec() to launch a sub-process. Options are :in may be given followed by a String or byte array specifying input to be fed to the sub-process's stdin. :in-enc option may be given followed by a String, used as a character encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to convert the input string specified by the :in option to the sub-process's stdin. Defaults to UTF-8. If the :in option provides a byte array, then the bytes are passed unencoded, and this option is ignored. :out-enc option may be given followed by :bytes or a String. If a String is given, it will be used as a character encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to convert the sub-process's stdout to a String which is returned. If :bytes is given, the sub-process's stdout will be stored in a byte array and returned. Defaults to UTF-8. :env override the process env with a map (or the underlying Java String[] if you are a masochist). :dir override the process dir with a String or java.io.File. You can bind :env or :dir for multiple operations using with-sh-env and with-sh-dir. sh returns a map of :exit => sub-process's exit code :out => sub-process's stdout (as byte[] or String) :err => sub-process's stderr (String via platform default encoding)" {:added "1.2"} [& args] (let [[cmd opts] (parse-args args) proc (.exec (Runtime/getRuntime) ^"[Ljava.lang.String;" (into-array cmd) (as-env-strings (:env opts)) (as-file (:dir opts))) {:keys [in in-enc out-enc]} opts] (if in (future (if (instance? (class (byte-array 0)) in) (with-open [os (.getOutputStream proc)] (.write os ^"[B" in)) (with-open [osw (OutputStreamWriter. (.getOutputStream proc) ^String in-enc)] (.write osw ^String in)))) (.close (.getOutputStream proc))) (with-open [stdout (.getInputStream proc) stderr (.getErrorStream proc)] (let [out (future (stream-to-enc stdout out-enc)) err (future (stream-to-string stderr)) exit-code (.waitFor proc)] {:exit exit-code :out @out :err @err})))) (comment (println (sh "ls" "-l")) (println (sh "ls" "-l" "/no-such-thing")) (println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) (println (sh "cat" :in "x\u25bax\n")) (println (sh "echo" "x\u25bax")) (println (sh "echo" "x\u25bax" :out-enc "ISO-8859-1")) ; reads 4 single-byte chars (println (sh "cat" "myimage.png" :out-enc :bytes)) ; reads binary file into bytes[] (println (sh "cmd" "/c dir 1>&2")) ) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/main.clj000066400000000000000000000300771157562347600220060ustar00rootroot00000000000000;; Copyright (c) Rich Hickey All rights reserved. The use and ;; distribution terms for this software are covered by the Eclipse Public ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found ;; in the file epl-v10.html at the root of this distribution. By using this ;; software in any fashion, you are agreeing to be bound by the terms of ;; this license. You must not remove this notice, or any other, from this ;; software. ;; Originally contributed by Stephen C. Gilardi (ns ^{:doc "Top-level main function for Clojure REPL and scripts." :author "Stephen C. Gilardi and Rich Hickey"} clojure.main (:refer-clojure :exclude [with-bindings]) (:import (clojure.lang Compiler Compiler$CompilerException LineNumberingPushbackReader RT))) (declare main) (defmacro with-bindings "Executes body in the context of thread-local bindings for several vars that often need to be set!: *ns* *warn-on-reflection* *math-context* *print-meta* *print-length* *print-level* *compile-path* *command-line-args* *1 *2 *3 *e" [& body] `(binding [*ns* *ns* *warn-on-reflection* *warn-on-reflection* *math-context* *math-context* *print-meta* *print-meta* *print-length* *print-length* *print-level* *print-level* *compile-path* (System/getProperty "clojure.compile.path" "classes") *command-line-args* *command-line-args* *assert* *assert* *1 nil *2 nil *3 nil *e nil] ~@body)) (defn repl-prompt "Default :prompt hook for repl" [] (printf "%s=> " (ns-name *ns*))) (defn skip-if-eol "If the next character on stream s is a newline, skips it, otherwise leaves the stream untouched. Returns :line-start, :stream-end, or :body to indicate the relative location of the next character on s. The stream must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing all of CR, LF, and CRLF to a single \\newline." [s] (let [c (.read s)] (cond (= c (int \newline)) :line-start (= c -1) :stream-end :else (do (.unread s c) :body)))) (defn skip-whitespace "Skips whitespace characters on stream s. Returns :line-start, :stream-end, or :body to indicate the relative location of the next character on s. Interprets comma as whitespace and semicolon as comment to end of line. Does not interpret #! as comment to end of line because only one character of lookahead is available. The stream must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing all of CR, LF, and CRLF to a single \\newline." [s] (loop [c (.read s)] (cond (= c (int \newline)) :line-start (= c -1) :stream-end (= c (int \;)) (do (.readLine s) :line-start) (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s)) :else (do (.unread s c) :body)))) (defn repl-read "Default :read hook for repl. Reads from *in* which must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing all of CR, LF, and CRLF into a single \\newline. repl-read: - skips whitespace, then - returns request-prompt on start of line, or - returns request-exit on end of stream, or - reads an object from the input stream, then - skips the next input character if it's end of line, then - returns the object." [request-prompt request-exit] (or ({:line-start request-prompt :stream-end request-exit} (skip-whitespace *in*)) (let [input (read)] (skip-if-eol *in*) input))) (defn- root-cause "Returns the initial cause of an exception or error by peeling off all of its wrappers" [^Throwable throwable] (loop [cause throwable] (if-let [cause (.getCause cause)] (recur cause) cause))) (defn repl-exception "Returns CompilerExceptions in tact, but only the root cause of other throwables" [throwable] (if (instance? Compiler$CompilerException throwable) throwable (root-cause throwable))) (defn repl-caught "Default :caught hook for repl" [e] (.println *err* (repl-exception e))) (defn repl "Generic, reusable, read-eval-print loop. By default, reads from *in*, writes to *out*, and prints exception summaries to *err*. If you use the default :read hook, *in* must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing CR, LF, and CRLF into a single \\newline. Options are sequential keyword-value pairs. Available options and their defaults: - :init, function of no arguments, initialization hook called with bindings for set!-able vars in place. default: #() - :need-prompt, function of no arguments, called before each read-eval-print except the first, the user will be prompted if it returns true. default: (if (instance? LineNumberingPushbackReader *in*) #(.atLineStart *in*) #(identity true)) - :prompt, function of no arguments, prompts for more input. default: repl-prompt - :flush, function of no arguments, flushes output default: flush - :read, function of two arguments, reads from *in*: - returns its first argument to request a fresh prompt - depending on need-prompt, this may cause the repl to prompt before reading again - returns its second argument to request an exit from the repl - else returns the next object read from the input stream default: repl-read - :eval, funtion of one argument, returns the evaluation of its argument default: eval - :print, function of one argument, prints its argument to the output default: prn - :caught, function of one argument, a throwable, called when read, eval, or print throws an exception or error default: repl-caught" [& options] (let [cl (.getContextClassLoader (Thread/currentThread))] (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl))) (let [{:keys [init need-prompt prompt flush read eval print caught] :or {init #() need-prompt (if (instance? LineNumberingPushbackReader *in*) #(.atLineStart ^LineNumberingPushbackReader *in*) #(identity true)) prompt repl-prompt flush flush read repl-read eval eval print prn caught repl-caught}} (apply hash-map options) request-prompt (Object.) request-exit (Object.) read-eval-print (fn [] (try (let [input (read request-prompt request-exit)] (or (#{request-prompt request-exit} input) (let [value (eval input)] (print value) (set! *3 *2) (set! *2 *1) (set! *1 value)))) (catch Throwable e (caught e) (set! *e e))))] (with-bindings (try (init) (catch Throwable e (caught e) (set! *e e))) (use '[clojure.repl :only (source apropos dir)]) (use '[clojure.java.javadoc :only (javadoc)]) (use '[clojure.pprint :only (pp pprint)]) (prompt) (flush) (loop [] (when-not (try (= (read-eval-print) request-exit) (catch Throwable e (caught e) (set! *e e) nil)) (when (need-prompt) (prompt) (flush)) (recur)))))) (defn load-script "Loads Clojure source from a file or resource given its path. Paths beginning with @ or @/ are considered relative to classpath." [^String path] (if (.startsWith path "@") (RT/loadResourceScript (.substring path (if (.startsWith path "@/") 2 1))) (Compiler/loadFile path))) (defn- init-opt "Load a script" [path] (load-script path)) (defn- eval-opt "Evals expressions in str, prints each non-nil result using prn" [str] (let [eof (Object.) reader (LineNumberingPushbackReader. (java.io.StringReader. str))] (loop [input (read reader false eof)] (when-not (= input eof) (let [value (eval input)] (when-not (nil? value) (prn value)) (recur (read reader false eof))))))) (defn- init-dispatch "Returns the handler associated with an init opt" [opt] ({"-i" init-opt "--init" init-opt "-e" eval-opt "--eval" eval-opt} opt)) (defn- initialize "Common initialize routine for repl, script, and null opts" [args inits] (in-ns 'user) (set! *command-line-args* args) (doseq [[opt arg] inits] ((init-dispatch opt) arg))) (defn- repl-opt "Start a repl with args and inits. Print greeting if no eval options were present" [[_ & args] inits] (when-not (some #(= eval-opt (init-dispatch (first %))) inits) (println "Clojure" (clojure-version))) (repl :init #(initialize args inits)) (prn) (System/exit 0)) (defn- script-opt "Run a script from a file, resource, or standard in with args and inits" [[path & args] inits] (with-bindings (initialize args inits) (if (= path "-") (load-reader *in*) (load-script path)))) (defn- null-opt "No repl or script opt present, just bind args and run inits" [args inits] (with-bindings (initialize args inits))) (defn- help-opt "Print help text for main" [_ _] (println (:doc (meta (var main))))) (defn- main-dispatch "Returns the handler associated with a main option" [opt] (or ({"-r" repl-opt "--repl" repl-opt nil null-opt "-h" help-opt "--help" help-opt "-?" help-opt} opt) script-opt)) (defn- legacy-repl "Called by the clojure.lang.Repl.main stub to run a repl with args specified the old way" [args] (println "WARNING: clojure.lang.Repl is deprecated. Instead, use clojure.main like this: java -cp clojure.jar clojure.main -i init.clj -r args...") (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits)))) (defn- legacy-script "Called by the clojure.lang.Script.main stub to run a script with args specified the old way" [args] (println "WARNING: clojure.lang.Script is deprecated. Instead, use clojure.main like this: java -cp clojure.jar clojure.main -i init.clj script.clj args...") (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] (null-opt args (map vector (repeat "-i") inits)))) (defn main "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*] With no options or args, runs an interactive Read-Eval-Print Loop init options: -i, --init path Load a file or resource -e, --eval string Evaluate expressions in string; print non-nil values main options: -r, --repl Run a repl path Run a script from from a file or resource - Run a script from standard input -h, -?, --help Print this help message and exit operation: - Establishes thread-local bindings for commonly set!-able vars - Enters the user namespace - Binds *command-line-args* to a seq of strings containing command line args that appear after any main option - Runs all init options in order - Runs a repl or script if requested The init options may be repeated and mixed freely, but must appear before any main option. The appearance of any eval option before running a repl suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\". Paths may be absolute or relative in the filesystem or relative to classpath. Classpath-relative paths have prefix of @ or @/" [& args] (try (if args (loop [[opt arg & more :as args] args inits []] (if (init-dispatch opt) (recur more (conj inits [opt arg])) ((main-dispatch opt) args inits))) (repl-opt nil nil)) (finally (flush)))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/parallel.clj000066400000000000000000000211751157562347600226550ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "DEPRECATED Wrapper of the ForkJoin library (JSR-166)." :author "Rich Hickey"} clojure.parallel) (alias 'parallel 'clojure.parallel) (comment " The parallel library wraps the ForkJoin library scheduled for inclusion in JDK 7: http://gee.cs.oswego.edu/dl/concurrency-interest/index.html You'll need jsr166y.jar in your classpath in order to use this library. The basic idea is that Clojure collections, and most efficiently vectors, can be turned into parallel arrays for use by this library with the function par, although most of the functions take collections and will call par if needed, so normally you will only need to call par explicitly in order to attach bound/filter/map ops. Parallel arrays support the attachment of bounds, filters and mapping functions prior to realization/calculation, which happens as the result of any of several operations on the array (pvec/psort/pfilter-nils/pfilter-dupes). Rather than perform composite operations in steps, as would normally be done with sequences, maps and filters are instead attached and thus composed by providing ops to par. Note that there is an order sensitivity to the attachments - bounds precede filters precede mappings. All operations then happen in parallel, using multiple threads and a sophisticated work-stealing system supported by fork-join, either when the array is realized, or to perform aggregate operations like preduce/pmin/pmax etc. A parallel array can be realized into a Clojure vector using pvec. ") (import '(jsr166y.forkjoin ParallelArray ParallelArrayWithBounds ParallelArrayWithFilter ParallelArrayWithMapping Ops$Op Ops$BinaryOp Ops$Reducer Ops$Predicate Ops$BinaryPredicate Ops$IntAndObjectPredicate Ops$IntAndObjectToObject)) (defn- op [f] (proxy [Ops$Op] [] (op [x] (f x)))) (defn- binary-op [f] (proxy [Ops$BinaryOp] [] (op [x y] (f x y)))) (defn- int-and-object-to-object [f] (proxy [Ops$IntAndObjectToObject] [] (op [i x] (f x i)))) (defn- reducer [f] (proxy [Ops$Reducer] [] (op [x y] (f x y)))) (defn- predicate [f] (proxy [Ops$Predicate] [] (op [x] (boolean (f x))))) (defn- binary-predicate [f] (proxy [Ops$BinaryPredicate] [] (op [x y] (boolean (f x y))))) (defn- int-and-object-predicate [f] (proxy [Ops$IntAndObjectPredicate] [] (op [i x] (boolean (f x i))))) (defn par "Creates a parallel array from coll. ops, if supplied, perform on-the-fly filtering or transformations during parallel realization or calculation. ops form a chain, and bounds must precede filters, must precede maps. ops must be a set of keyword value pairs of the following forms: :bound [start end] Only elements from start (inclusive) to end (exclusive) will be processed when the array is realized. :filter pred Filter preds remove elements from processing when the array is realized. pred must be a function of one argument whose return will be processed via boolean. :filter-index pred2 pred2 must be a function of two arguments, which will be an element of the collection and the corresponding index, whose return will be processed via boolean. :filter-with [pred2 coll2] pred2 must be a function of two arguments, which will be corresponding elements of the 2 collections. :map f Map fns will be used to transform elements when the array is realized. f must be a function of one argument. :map-index f2 f2 must be a function of two arguments, which will be an element of the collection and the corresponding index. :map-with [f2 coll2] f2 must be a function of two arguments, which will be corresponding elements of the 2 collections." ([coll] (if (instance? ParallelArrayWithMapping coll) coll (. ParallelArray createUsingHandoff (to-array coll) (. ParallelArray defaultExecutor)))) ([coll & ops] (reduce (fn [pa [op args]] (cond (= op :bound) (. pa withBounds (args 0) (args 1)) (= op :filter) (. pa withFilter (predicate args)) (= op :filter-with) (. pa withFilter (binary-predicate (args 0)) (par (args 1))) (= op :filter-index) (. pa withIndexedFilter (int-and-object-predicate args)) (= op :map) (. pa withMapping (parallel/op args)) (= op :map-with) (. pa withMapping (binary-op (args 0)) (par (args 1))) (= op :map-index) (. pa withIndexedMapping (int-and-object-to-object args)) :else (throw (Exception. (str "Unsupported par op: " op))))) (par coll) (partition 2 ops)))) ;;;;;;;;;;;;;;;;;;;;; aggregate operations ;;;;;;;;;;;;;;;;;;;;;; (defn pany "Returns some (random) element of the coll if it satisfies the bound/filter/map" [coll] (. (par coll) any)) (defn pmax "Returns the maximum element, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (. (par coll) max)) ([coll comp] (. (par coll) max comp))) (defn pmin "Returns the minimum element, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (. (par coll) min)) ([coll comp] (. (par coll) min comp))) (defn- summary-map [s] {:min (.min s) :max (.max s) :size (.size s) :min-index (.indexOfMin s) :max-index (.indexOfMax s)}) (defn psummary "Returns a map of summary statistics (min. max, size, min-index, max-index, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (summary-map (. (par coll) summary))) ([coll comp] (summary-map (. (par coll) summary comp)))) (defn preduce "Returns the reduction of the realized elements of coll using function f. Note f will not necessarily be called consecutively, and so must be commutative. Also note that (f base an-element) might be performed many times, i.e. base is not an initial value as with sequential reduce." [f base coll] (. (par coll) (reduce (reducer f) base))) ;;;;;;;;;;;;;;;;;;;;; collection-producing operations ;;;;;;;;;;;;;;;;;;;;;; (defn- pa-to-vec [pa] (vec (. pa getArray))) (defn- pall "Realizes a copy of the coll as a parallel array, with any bounds/filters/maps applied" [coll] (if (instance? ParallelArrayWithMapping coll) (. coll all) (par coll))) (defn pvec "Returns the realized contents of the parallel array pa as a Clojure vector" [pa] (pa-to-vec (pall pa))) (defn pdistinct "Returns a parallel array of the distinct elements of coll" [coll] (pa-to-vec (. (pall coll) allUniqueElements))) ;this doesn't work, passes null to reducer? (defn- pcumulate [coll f init] (.. (pall coll) (precumulate (reducer f) init))) (defn psort "Returns a new vector consisting of the realized items in coll, sorted, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (pa-to-vec (. (pall coll) sort))) ([coll comp] (pa-to-vec (. (pall coll) sort comp)))) (defn pfilter-nils "Returns a vector containing the non-nil (realized) elements of coll" [coll] (pa-to-vec (. (pall coll) removeNulls))) (defn pfilter-dupes "Returns a vector containing the (realized) elements of coll, without any consecutive duplicates" [coll] (pa-to-vec (. (pall coll) removeConsecutiveDuplicates))) (comment (load-file "src/parallel.clj") (refer 'parallel) (pdistinct [1 2 3 2 1]) ;(pcumulate [1 2 3 2 1] + 0) ;broken, not exposed (def a (make-array Object 1000000)) (dotimes i (count a) (aset a i (rand-int i))) (time (reduce + 0 a)) (time (preduce + 0 a)) (time (count (distinct a))) (time (count (pdistinct a))) (preduce + 0 [1 2 3 2 1]) (preduce + 0 (psort a)) (pvec (par [11 2 3 2] :filter-index (fn [x i] (> i x)))) (pvec (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]])) (psummary ;or pvec/pmax etc (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]] :map #(* % 2))) (preduce + 0 (par [11 2 3 2] :filter-with [< [110 2 33 2]])) (time (reduce + 0 (map #(* % %) (range 1000000)))) (time (preduce + 0 (par (range 1000000) :map-index *))) (def v (range 1000000)) (time (preduce + 0 (par v :map-index *))) (time (preduce + 0 (par v :map #(* % %)))) (time (reduce + 0 (map #(* % %) v))) )clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint.clj000066400000000000000000000037331157562347600223750ustar00rootroot00000000000000;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 (ns ^{:author "Tom Faulhaber", :doc "A Pretty Printer for Clojure clojure.pprint implements a flexible system for printing structured data in a pleasing, easy-to-understand format. Basic use of the pretty printer is simple, just call pprint instead of println. More advanced users can use the building blocks provided to create custom output formats. Out of the box, pprint supports a simple structured format for basic data and a specialized format for Clojure source code. More advanced formats, including formats that don't look like Clojure data at all like XML and JSON, can be rendered by creating custom dispatch functions. In addition to the pprint function, this module contains cl-format, a text formatting function which is fully compatible with the format function in Common Lisp. Because pretty printing directives are directly integrated with cl-format, it supports very concise custom dispatch. It also provides a more powerful alternative to Clojure's standard format function. See documentation for pprint and cl-format for more information or complete documentation on the the clojure web site on github.", :added "1.2"} clojure.pprint (:refer-clojure :exclude (deftype))) (load "pprint/utilities") (load "pprint/column_writer") (load "pprint/pretty_writer") (load "pprint/pprint_base") (load "pprint/cl_format") (load "pprint/dispatch") nil clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/000077500000000000000000000000001157562347600216755ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/cl_format.clj000066400000000000000000002205241157562347600243420ustar00rootroot00000000000000;;; cl_format.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements the Common Lisp compatible format function as documented ;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at: ;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) (in-ns 'clojure.pprint) ;;; Forward references (declare compile-format) (declare execute-format) (declare init-navigator) ;;; End forward references (defn cl-format "An implementation of a Common Lisp compatible format function. cl-format formats its arguments to an output stream or string based on the format control string given. It supports sophisticated formatting of structured data. Writer is an instance of java.io.Writer, true to output to *out* or nil to output to a string, format-in is the format control string and the remaining arguments are the data to be formatted. The format control string is a string to be output with embedded 'format directives' describing how to format the various arguments passed in. If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format returns nil. For example: (let [results [46 38 22]] (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" (count results) results)) Prints to *out*: There are 3 results: 46, 38, 22 Detailed documentation on format control strings is available in the \"Common Lisp the Language, 2nd edition\", Chapter 22 (available online at: http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) and in the Common Lisp HyperSpec at http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm " {:added "1.2", :see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" "Common Lisp the Language"] ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" "Common Lisp HyperSpec"]]} [writer format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format writer compiled-format navigator))) (def ^{:private true} *format-str* nil) (defn- format-error [message offset] (let [full-message (str message \newline *format-str* \newline (apply str (repeat offset \space)) "^" \newline)] (throw (RuntimeException. full-message)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Argument navigators manage the argument list ;;; as the format statement moves through the list ;;; (possibly going forwards and backwards as it does so) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct ^{:private true} arg-navigator :seq :rest :pos ) (defn- init-navigator "Create a new arg-navigator from the sequence with the position set to 0" {:skip-wiki true} [s] (let [s (seq s)] (struct arg-navigator s s 0))) ;; TODO call format-error with offset (defn- next-arg [ navigator ] (let [ rst (:rest navigator) ] (if rst [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] (throw (new Exception "Not enough arguments for format definition"))))) (defn- next-arg-or-nil [navigator] (let [rst (:rest navigator)] (if rst [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] [nil navigator]))) ;; Get an argument off the arg list and compile it if it's not already compiled (defn- get-format-arg [navigator] (let [[raw-format navigator] (next-arg navigator) compiled-format (if (instance? String raw-format) (compile-format raw-format) raw-format)] [compiled-format navigator])) (declare relative-reposition) (defn- absolute-reposition [navigator position] (if (>= position (:pos navigator)) (relative-reposition navigator (- (:pos navigator) position)) (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position))) (defn- relative-reposition [navigator position] (let [newpos (+ (:pos navigator) position)] (if (neg? position) (absolute-reposition navigator newpos) (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos)))) (defstruct ^{:private true} compiled-directive :func :def :params :offset) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; When looking at the parameter list, we may need to manipulate ;;; the argument list as well (for 'V' and '#' parameter types). ;;; We hide all of this behind a function, but clients need to ;;; manage changing arg navigator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: validate parameters when they come from arg list (defn- realize-parameter [[param [raw-val offset]] navigator] (let [[real-param new-navigator] (cond (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary [raw-val navigator] (= raw-val :parameter-from-args) (next-arg navigator) (= raw-val :remaining-arg-count) [(count (:rest navigator)) navigator] true [raw-val navigator])] [[param [real-param offset]] new-navigator])) (defn- realize-parameter-list [parameter-map navigator] (let [[pairs new-navigator] (map-passing-context realize-parameter navigator parameter-map)] [(into {} pairs) new-navigator])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions that support individual directives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Common handling code for ~A and ~S ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare opt-base-str) (def ^{:private true} special-radix-markers {2 "#b" 8 "#o", 16 "#x"}) (defn- format-simple-number [n] (cond (integer? n) (if (= *print-base* 10) (str n (if *print-radix* ".")) (str (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) (opt-base-str *print-base* n))) (ratio? n) (str (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) (opt-base-str *print-base* (.numerator n)) "/" (opt-base-str *print-base* (.denominator n))) :else nil)) (defn- format-ascii [print-func params arg-navigator offsets] (let [ [arg arg-navigator] (next-arg arg-navigator) ^String base-output (or (format-simple-number arg) (print-func arg)) base-width (.length base-output) min-width (+ base-width (:minpad params)) width (if (>= min-width (:mincol params)) min-width (+ min-width (* (+ (quot (- (:mincol params) min-width 1) (:colinc params) ) 1) (:colinc params)))) chars (apply str (repeat (- width base-width) (:padchar params)))] (if (:at params) (print (str chars base-output)) (print (str base-output chars))) arg-navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the integer directives ~D, ~X, ~O, ~B and some ;;; of ~R ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- integral? "returns true if a number is actually an integer (that is, has no fractional part)" [x] (cond (integer? x) true (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part (float? x) (= x (Math/floor x)) (ratio? x) (let [^clojure.lang.Ratio r x] (= 0 (rem (.numerator r) (.denominator r)))) :else false)) (defn- remainders "Return the list of remainders (essentially the 'digits') of val in the given base" [base val] (reverse (first (consume #(if (pos? %) [(rem % base) (quot % base)] [nil nil]) val)))) ;;; TODO: xlated-val does not seem to be used here. (defn- base-str "Return val as a string in the given base" [base val] (if (zero? val) "0" (let [xlated-val (cond (float? val) (bigdec val) (ratio? val) (let [^clojure.lang.Ratio r val] (/ (.numerator r) (.denominator r))) :else val)] (apply str (map #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) (remainders base val)))))) (def ^{:private true} java-base-formats {8 "%o", 10 "%d", 16 "%x"}) (defn- opt-base-str "Return val as a string in the given base, using clojure.core/format if supported for improved performance" [base val] (let [format-str (get java-base-formats base)] (if (and format-str (integer? val)) (clojure.core/format format-str val) (base-str base val)))) (defn- group-by* [unit lis] (reverse (first (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis))))) (defn- format-integer [base params arg-navigator offsets] (let [[arg arg-navigator] (next-arg arg-navigator)] (if (integral? arg) (let [neg (neg? arg) pos-arg (if neg (- arg) arg) raw-str (opt-base-str base pos-arg) group-str (if (:colon params) (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str)) commas (repeat (count groups) (:commachar params))] (apply str (next (interleave commas groups)))) raw-str) ^String signed-str (cond neg (str "-" group-str) (:at params) (str "+" group-str) true group-str) padded-str (if (< (.length signed-str) (:mincol params)) (str (apply str (repeat (- (:mincol params) (.length signed-str)) (:padchar params))) signed-str) signed-str)] (print padded-str)) (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 :padchar (:padchar params) :at true} (init-navigator [arg]) nil)) arg-navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for english formats (~R and ~:R) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} english-cardinal-units ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"]) (def ^{:private true} english-ordinal-units ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth" "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"]) (def ^{:private true} english-cardinal-tens ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"]) (def ^{:private true} english-ordinal-tens ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth" "seventieth" "eightieth" "ninetieth"]) ;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales) ;; Number names from http://www.jimloy.com/math/billion.htm ;; We follow the rules for writing numbers from the Blue Book ;; (http://www.grammarbook.com/numbers/numbers.asp) (def ^{:private true} english-scale-numbers ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" "sextillion" "septillion" "octillion" "nonillion" "decillion" "undecillion" "duodecillion" "tredecillion" "quattuordecillion" "quindecillion" "sexdecillion" "septendecillion" "octodecillion" "novemdecillion" "vigintillion"]) (defn- format-simple-cardinal "Convert a number less than 1000 to a cardinal english string" [num] (let [hundreds (quot num 100) tens (rem num 100)] (str (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) (if (and (pos? hundreds) (pos? tens)) " ") (if (pos? tens) (if (< tens 20) (nth english-cardinal-units tens) (let [ten-digit (quot tens 10) unit-digit (rem tens 10)] (str (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) (if (and (pos? ten-digit) (pos? unit-digit)) "-") (if (pos? unit-digit) (nth english-cardinal-units unit-digit))))))))) (defn- add-english-scales "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string offset is a factor of 10^3 to multiply by" [parts offset] (let [cnt (count parts)] (loop [acc [] pos (dec cnt) this (first parts) remainder (next parts)] (if (nil? remainder) (str (apply str (interpose ", " acc)) (if (and (not (empty? this)) (not (empty? acc))) ", ") this (if (and (not (empty? this)) (pos? (+ pos offset))) (str " " (nth english-scale-numbers (+ pos offset))))) (recur (if (empty? this) acc (conj acc (str this " " (nth english-scale-numbers (+ pos offset))))) (dec pos) (first remainder) (next remainder)))))) (defn- format-cardinal-english [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (= 0 arg) (print "zero") (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs parts (remainders 1000 abs-arg)] (if (<= (count parts) (count english-scale-numbers)) (let [parts-strs (map format-simple-cardinal parts) full-str (add-english-scales parts-strs 0)] (print (str (if (neg? arg) "minus ") full-str))) (format-integer ;; for numbers > 10^63, we fall back on ~D 10 { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} (init-navigator [arg]) { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})))) navigator)) (defn- format-simple-ordinal "Convert a number less than 1000 to a ordinal english string Note this should only be used for the last one in the sequence" [num] (let [hundreds (quot num 100) tens (rem num 100)] (str (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) (if (and (pos? hundreds) (pos? tens)) " ") (if (pos? tens) (if (< tens 20) (nth english-ordinal-units tens) (let [ten-digit (quot tens 10) unit-digit (rem tens 10)] (if (and (pos? ten-digit) (not (pos? unit-digit))) (nth english-ordinal-tens ten-digit) (str (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) (if (and (pos? ten-digit) (pos? unit-digit)) "-") (if (pos? unit-digit) (nth english-ordinal-units unit-digit)))))) (if (pos? hundreds) "th"))))) (defn- format-ordinal-english [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (= 0 arg) (print "zeroth") (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs parts (remainders 1000 abs-arg)] (if (<= (count parts) (count english-scale-numbers)) (let [parts-strs (map format-simple-cardinal (drop-last parts)) head-str (add-english-scales parts-strs 1) tail-str (format-simple-ordinal (last parts))] (print (str (if (neg? arg) "minus ") (cond (and (not (empty? head-str)) (not (empty? tail-str))) (str head-str ", " tail-str) (not (empty? head-str)) (str head-str "th") :else tail-str)))) (do (format-integer ;; for numbers > 10^63, we fall back on ~D 10 { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} (init-navigator [arg]) { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}) (let [low-two-digits (rem arg 100) not-teens (or (< 11 low-two-digits) (> 19 low-two-digits)) low-digit (rem low-two-digits 10)] (print (cond (and (= low-digit 1) not-teens) "st" (and (= low-digit 2) not-teens) "nd" (and (= low-digit 3) not-teens) "rd" :else "th"))))))) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for roman numeral formats (~@R and ~@:R) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} old-roman-table [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"] [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"] [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"] [ "M" "MM" "MMM"]]) (def ^{:private true} new-roman-table [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"] [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"] [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"] [ "M" "MM" "MMM"]]) (defn- format-roman "Format a roman numeral using the specified look-up table" [table params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (and (number? arg) (> arg 0) (< arg 4000)) (let [digits (remainders 10 arg)] (loop [acc [] pos (dec (count digits)) digits digits] (if (empty? digits) (print (apply str acc)) (let [digit (first digits)] (recur (if (= 0 digit) acc (conj acc (nth (nth table pos) (dec digit)))) (dec pos) (next digits)))))) (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D 10 { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} (init-navigator [arg]) { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})) navigator)) (defn- format-old-roman [params navigator offsets] (format-roman old-roman-table params navigator offsets)) (defn- format-new-roman [params navigator offsets] (format-roman new-roman-table params navigator offsets)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for character formats (~C) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} special-chars { 8 "Backspace", 9 "Tab", 10 "Newline", 13 "Return", 32 "Space"}) (defn- pretty-character [params navigator offsets] (let [[c navigator] (next-arg navigator) as-int (int c) base-char (bit-and as-int 127) meta (bit-and as-int 128) special (get special-chars base-char)] (if (> meta 0) (print "Meta-")) (print (cond special special (< base-char 32) (str "Control-" (char (+ base-char 64))) (= base-char 127) "Control-?" :else (char base-char))) navigator)) (defn- readable-character [params navigator offsets] (let [[c navigator] (next-arg navigator)] (condp = (:char-format params) \o (cl-format true "\\o~3,'0o" (int c)) \u (cl-format true "\\u~4,'0x" (int c)) nil (pr c)) navigator)) (defn- plain-character [params navigator offsets] (let [[char navigator] (next-arg navigator)] (print char) navigator)) ;; Check to see if a result is an abort (~^) construct ;; TODO: move these funcs somewhere more appropriate (defn- abort? [context] (let [token (first context)] (or (= :up-arrow token) (= :colon-up-arrow token)))) ;; Handle the execution of "sub-clauses" in bracket constructions (defn- execute-sub-format [format args base-args] (second (map-passing-context (fn [element context] (if (abort? context) [nil context] ; just keep passing it along (let [[params args] (realize-parameter-list (:params element) context) [params offsets] (unzip-map params) params (assoc params :base-args base-args)] [nil (apply (:func element) [params args offsets])]))) args format))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for real number formats ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO - return exponent as int to eliminate double conversion (defn- float-parts-base "Produce string parts for the mantissa (normalized 1-9) and exponent" [^Object f] (let [^String s (.toLowerCase (.toString f)) exploc (.indexOf s (int \e))] (if (neg? exploc) (let [dotloc (.indexOf s (int \.))] (if (neg? dotloc) [s (str (dec (count s)))] [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))])) [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))]))) (defn- float-parts "Take care of leading and trailing zeros in decomposed floats" [f] (let [[m ^String e] (float-parts-base f) m1 (rtrim m \0) m2 (ltrim m1 \0) delta (- (count m1) (count m2)) ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)] (if (empty? m2) ["0" 0] [m2 (- (Integer/valueOf e) delta)]))) (defn- round-str [m e d w] (if (or d w) (let [len (count m) round-pos (if d (+ e d 1)) round-pos (if (and w (< (inc e) (dec w)) (or (nil? round-pos) (< (dec w) round-pos))) (dec w) round-pos) [m1 e1 round-pos len] (if (= round-pos 0) [(str "0" m) (inc e) 1 (inc len)] [m e round-pos len])] (if round-pos (if (neg? round-pos) ["0" 0 false] (if (> len round-pos) (let [round-char (nth m1 round-pos) ^String result (subs m1 0 round-pos)] (if (>= (int round-char) (int \5)) (let [result-val (Integer/valueOf result) leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1))) round-up-result (str leading-zeros (String/valueOf (+ result-val (if (neg? result-val) -1 1)))) expanded (> (count round-up-result) (count result))] [round-up-result e1 expanded]) [result e1 false])) [m e false])) [m e false])) [m e false])) (defn- expand-fixed [m e d] (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m) len (count m1) target-len (if d (+ e d 1) (inc e))] (if (< len target-len) (str m1 (apply str (repeat (- target-len len) \0))) m1))) (defn- insert-decimal "Insert the decimal point at the right spot in the number to match an exponent" [m e] (if (neg? e) (str "." m) (let [loc (inc e)] (str (subs m 0 loc) "." (subs m loc))))) (defn- get-fixed [m e d] (insert-decimal (expand-fixed m e d) e)) (defn- insert-scaled-decimal "Insert the decimal point at the right spot in the number to match an exponent" [m k] (if (neg? k) (str "." m) (str (subs m 0 k) "." (subs m k)))) ;; the function to render ~F directives ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases (defn- fixed-float [params navigator offsets] (let [w (:w params) d (:d params) [arg navigator] (next-arg navigator) [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg]) [mantissa exp] (float-parts abs) scaled-exp (+ exp (:k params)) add-sign (or (:at params) (neg? arg)) append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp)) [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp d (if w (- w (if add-sign 1 0)))) fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) prepend-zero (= (first fixed-repr) \.)] (if w (let [len (count fixed-repr) signed-len (if add-sign (inc len) len) prepend-zero (and prepend-zero (not (>= signed-len w))) append-zero (and append-zero (not (>= signed-len w))) full-len (if (or prepend-zero append-zero) (inc signed-len) signed-len)] (if (and (> full-len w) (:overflowchar params)) (print (apply str (repeat w (:overflowchar params)))) (print (str (apply str (repeat (- w full-len) (:padchar params))) (if add-sign sign) (if prepend-zero "0") fixed-repr (if append-zero "0"))))) (print (str (if add-sign sign) (if prepend-zero "0") fixed-repr (if append-zero "0")))) navigator)) ;; the function to render ~E directives ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases ;; TODO: define ~E representation for Infinity (defn- exponential-float [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))] (let [w (:w params) d (:d params) e (:e params) k (:k params) expchar (or (:exponentchar params) \E) add-sign (or (:at params) (neg? arg)) prepend-zero (<= k 0) ^Integer scaled-exp (- exp (dec k)) scaled-exp-str (str (Math/abs scaled-exp)) scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) (if e (apply str (repeat (- e (count scaled-exp-str)) \0))) scaled-exp-str) exp-width (count scaled-exp-str) base-mantissa-width (count mantissa) scaled-mantissa (str (apply str (repeat (- k) \0)) mantissa (if d (apply str (repeat (- d (dec base-mantissa-width) (if (neg? k) (- k) 0)) \0)))) w-mantissa (if w (- w exp-width)) [rounded-mantissa _ incr-exp] (round-str scaled-mantissa 0 (cond (= k 0) (dec d) (pos? k) d (neg? k) (dec d)) (if w-mantissa (- w-mantissa (if add-sign 1 0)))) full-mantissa (insert-scaled-decimal rounded-mantissa k) append-zero (and (= k (count rounded-mantissa)) (nil? d))] (if (not incr-exp) (if w (let [len (+ (count full-mantissa) exp-width) signed-len (if add-sign (inc len) len) prepend-zero (and prepend-zero (not (= signed-len w))) full-len (if prepend-zero (inc signed-len) signed-len) append-zero (and append-zero (< full-len w))] (if (and (or (> full-len w) (and e (> (- exp-width 2) e))) (:overflowchar params)) (print (apply str (repeat w (:overflowchar params)))) (print (str (apply str (repeat (- w full-len (if append-zero 1 0) ) (:padchar params))) (if add-sign (if (neg? arg) \- \+)) (if prepend-zero "0") full-mantissa (if append-zero "0") scaled-exp-str)))) (print (str (if add-sign (if (neg? arg) \- \+)) (if prepend-zero "0") full-mantissa (if append-zero "0") scaled-exp-str))) (recur [rounded-mantissa (inc exp)])))) navigator)) ;; the function to render ~G directives ;; This just figures out whether to pass the request off to ~F or ~E based ;; on the algorithm in CLtL. ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases ;; TODO: refactor so that float-parts isn't called twice (defn- general-float [params navigator offsets] (let [[arg _] (next-arg navigator) [mantissa exp] (float-parts (if (neg? arg) (- arg) arg)) w (:w params) d (:d params) e (:e params) n (if (= arg 0.0) 0 (inc exp)) ee (if e (+ e 2) 4) ww (if w (- w ee)) d (if d d (max (count mantissa) (min n 7))) dd (- d n)] (if (<= 0 dd d) (let [navigator (fixed-float {:w ww, :d dd, :k 0, :overflowchar (:overflowchar params), :padchar (:padchar params), :at (:at params)} navigator offsets)] (print (apply str (repeat ee \space))) navigator) (exponential-float params navigator offsets)))) ;; the function to render ~$ directives ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases (defn- dollar-float [params navigator offsets] (let [[^Double arg navigator] (next-arg navigator) [mantissa exp] (float-parts (Math/abs arg)) d (:d params) ; digits after the decimal n (:n params) ; minimum digits before the decimal w (:w params) ; minimum field width add-sign (or (:at params) (neg? arg)) [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil) ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr) full-len (+ (count full-repr) (if add-sign 1 0))] (print (str (if (and (:colon params) add-sign) (if (neg? arg) \- \+)) (apply str (repeat (- w full-len) (:padchar params))) (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+)) full-repr)) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the '~[...~]' conditional construct in its ;;; different flavors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ~[...~] without any modifiers chooses one of the clauses based on the param or ;; next argument ;; TODO check arg is positive int (defn- choice-conditional [params arg-navigator offsets] (let [arg (:selector params) [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator)) clauses (:clauses params) clause (if (or (neg? arg) (>= arg (count clauses))) (first (:else params)) (nth clauses arg))] (if clause (execute-sub-format clause navigator (:base-args params)) navigator))) ;; ~:[...~] with the colon reads the next argument treating it as a truth value (defn- boolean-conditional [params arg-navigator offsets] (let [[arg navigator] (next-arg arg-navigator) clauses (:clauses params) clause (if arg (second clauses) (first clauses))] (if clause (execute-sub-format clause navigator (:base-args params)) navigator))) ;; ~@[...~] with the at sign executes the conditional if the next arg is not ;; nil/false without consuming the arg (defn- check-arg-conditional [params arg-navigator offsets] (let [[arg navigator] (next-arg arg-navigator) clauses (:clauses params) clause (if arg (first clauses))] (if arg (if clause (execute-sub-format clause arg-navigator (:base-args params)) arg-navigator) navigator))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the '~{...~}' iteration construct in its ;;; different flavors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ~{...~} without any modifiers uses the next argument as an argument list that ;; is consumed by all the iterations (defn- iterate-sublist [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator]) [arg-list navigator] (next-arg navigator) args (init-navigator arg-list)] (loop [count 0 args args last-pos -1] (if (and (not max-count) (= (:pos args) last-pos) (> count 1)) ;; TODO get the offset in here and call format exception (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!"))) (if (or (and (empty? (:rest args)) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [iter-result (execute-sub-format clause args (:base-args params))] (if (= :up-arrow (first iter-result)) navigator (recur (inc count) iter-result (:pos args)))))))) ;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the ;; sublists is used as the arglist for a single iteration. (defn- iterate-list-of-sublists [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator]) [arg-list navigator] (next-arg navigator)] (loop [count 0 arg-list arg-list] (if (or (and (empty? arg-list) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [iter-result (execute-sub-format clause (init-navigator (first arg-list)) (init-navigator (next arg-list)))] (if (= :colon-up-arrow (first iter-result)) navigator (recur (inc count) (next arg-list)))))))) ;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations ;; is consumed by all the iterations (defn- iterate-main-list [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator])] (loop [count 0 navigator navigator last-pos -1] (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1)) ;; TODO get the offset in here and call format exception (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!"))) (if (or (and (empty? (:rest navigator)) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [iter-result (execute-sub-format clause navigator (:base-args params))] (if (= :up-arrow (first iter-result)) (second iter-result) (recur (inc count) iter-result (:pos navigator)))))))) ;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one ;; of which is consumed with each iteration (defn- iterate-main-sublists [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator]) ] (loop [count 0 navigator navigator] (if (or (and (empty? (:rest navigator)) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [[sublist navigator] (next-arg-or-nil navigator) iter-result (execute-sub-format clause (init-navigator sublist) navigator)] (if (= :colon-up-arrow (first iter-result)) navigator (recur (inc count) navigator))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The '~< directive has two completely different meanings ;;; in the '~<...~>' form it does justification, but with ;;; ~<...~:>' it represents the logical block operation of the ;;; pretty printer. ;;; ;;; Unfortunately, the current architecture decides what function ;;; to call at form parsing time before the sub-clauses have been ;;; folded, so it is left to run-time to make the decision. ;;; ;;; TODO: make it possible to make these decisions at compile-time. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare format-logical-block) (declare justify-clauses) (defn- logical-block-or-justify [params navigator offsets] (if (:colon (:right-params params)) (format-logical-block params navigator offsets) (justify-clauses params navigator offsets))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the '~<...~>' justification directive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- render-clauses [clauses navigator base-navigator] (loop [clauses clauses acc [] navigator navigator] (if (empty? clauses) [acc navigator] (let [clause (first clauses) [iter-result result-str] (binding [*out* (java.io.StringWriter.)] [(execute-sub-format clause navigator base-navigator) (.toString *out*)])] (if (= :up-arrow (first iter-result)) [acc (second iter-result)] (recur (next clauses) (conj acc result-str) iter-result)))))) ;; TODO support for ~:; constructions (defn- justify-clauses [params navigator offsets] (let [[[eol-str] new-navigator] (when-let [else (:else params)] (render-clauses else navigator (:base-args params))) navigator (or new-navigator navigator) [else-params new-navigator] (when-let [p (:else-params params)] (realize-parameter-list p navigator)) navigator (or new-navigator navigator) min-remaining (or (first (:min-remaining else-params)) 0) max-columns (or (first (:max-columns else-params)) (get-max-column *out*)) clauses (:clauses params) [strs navigator] (render-clauses clauses navigator (:base-args params)) slots (max 1 (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0))) chars (reduce + (map count strs)) mincol (:mincol params) minpad (:minpad params) colinc (:colinc params) minout (+ chars (* slots minpad)) result-columns (if (<= minout mincol) mincol (+ mincol (* colinc (+ 1 (quot (- minout mincol 1) colinc))))) total-pad (- result-columns chars) pad (max minpad (quot total-pad slots)) extra-pad (- total-pad (* pad slots)) pad-str (apply str (repeat pad (:padchar params)))] (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) max-columns)) (print eol-str)) (loop [slots slots extra-pad extra-pad strs strs pad-only (or (:colon params) (and (= (count strs) 1) (not (:at params))))] (if (seq strs) (do (print (str (if (not pad-only) (first strs)) (if (or pad-only (next strs) (:at params)) pad-str) (if (pos? extra-pad) (:padchar params)))) (recur (dec slots) (dec extra-pad) (if pad-only strs (next strs)) false)))) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for case modification with ~(...~). ;;; We do this by wrapping the underlying writer with ;;; a special writer to do the appropriate modification. This ;;; allows us to support arbitrary-sized output and sources ;;; that may block. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- downcase-writer "Returns a proxy that wraps writer, converting all characters to lower case" [^java.io.Writer writer] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s ^String x] (.write writer (.toLowerCase s))) Integer (let [c ^Character x] (.write writer (int (Character/toLowerCase (char c)))))))))) (defn- upcase-writer "Returns a proxy that wraps writer, converting all characters to upper case" [^java.io.Writer writer] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s ^String x] (.write writer (.toUpperCase s))) Integer (let [c ^Character x] (.write writer (int (Character/toUpperCase (char c)))))))))) (defn- capitalize-string "Capitalizes the words in a string. If first? is false, don't capitalize the first character of the string even if it's a letter." [s first?] (let [^Character f (first s) s (if (and first? f (Character/isLetter f)) (str (Character/toUpperCase f) (subs s 1)) s)] (apply str (first (consume (fn [s] (if (empty? s) [nil nil] (let [m (re-matcher #"\W\w" s) match (re-find m) offset (and match (inc (.start m)))] (if offset [(str (subs s 0 offset) (Character/toUpperCase ^Character (nth s offset))) (subs s (inc offset))] [s nil])))) s))))) (defn- capitalize-word-writer "Returns a proxy that wraps writer, captializing all words" [^java.io.Writer writer] (let [last-was-whitespace? (ref true)] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s ^String x] (.write writer ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?)) (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (nth s (dec (count s))))))) Integer (let [c (char x)] (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] (.write writer (int mod-c)) (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x)))))))))))) (defn- init-cap-writer "Returns a proxy that wraps writer, capitalizing the first word" [^java.io.Writer writer] (let [capped (ref false)] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s (.toLowerCase ^String x)] (if (not @capped) (let [m (re-matcher #"\S" s) match (re-find m) offset (and match (.start m))] (if offset (do (.write writer (str (subs s 0 offset) (Character/toUpperCase ^Character (nth s offset)) (.toLowerCase ^String (subs s (inc offset))))) (dosync (ref-set capped true))) (.write writer s))) (.write writer (.toLowerCase s)))) Integer (let [c ^Character (char x)] (if (and (not @capped) (Character/isLetter c)) (do (dosync (ref-set capped true)) (.write writer (int (Character/toUpperCase c)))) (.write writer (int (Character/toLowerCase c))))))))))) (defn- modify-case [make-writer params navigator offsets] (let [clause (first (:clauses params))] (binding [*out* (make-writer *out*)] (execute-sub-format clause navigator (:base-args params))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; If necessary, wrap the writer in a PrettyWriter object ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn get-pretty-writer "Returns the java.io.Writer passed in wrapped in a pretty writer proxy, unless it's already a pretty writer. Generally, it is unneccesary to call this function, since pprint, write, and cl-format all call it if they need to. However if you want the state to be preserved across calls, you will want to wrap them with this. For example, when you want to generate column-aware output with multiple calls to cl-format, do it like in this example: (defn print-table [aseq column-width] (binding [*out* (get-pretty-writer *out*)] (doseq [row aseq] (doseq [col row] (cl-format true \"~4D~7,vT\" col column-width)) (prn)))) Now when you run: user> (print-table (map #(vector % (* % %) (* % % %)) (range 1 11)) 8) It prints a table of squares and cubes for the numbers from 1 to 10: 1 1 1 2 4 8 3 9 27 4 16 64 5 25 125 6 36 216 7 49 343 8 64 512 9 81 729 10 100 1000" {:added "1.2"} [writer] (if (pretty-writer? writer) writer (pretty-writer writer *print-right-margin* *print-miser-width*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for column-aware operations ~&, ~T ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn fresh-line "Make a newline if *out* is not already at the beginning of the line. If *out* is not a pretty writer (which keeps track of columns), this function always outputs a newline." {:added "1.2"} [] (if (instance? clojure.lang.IDeref *out*) (if (not (= 0 (get-column (:base @@*out*)))) (prn)) (prn))) (defn- absolute-tabulation [params navigator offsets] (let [colnum (:colnum params) colinc (:colinc params) current (get-column (:base @@*out*)) space-count (cond (< current colnum) (- colnum current) (= colinc 0) 0 :else (- colinc (rem (- current colnum) colinc)))] (print (apply str (repeat space-count \space)))) navigator) (defn- relative-tabulation [params navigator offsets] (let [colrel (:colnum params) colinc (:colinc params) start-col (+ colrel (get-column (:base @@*out*))) offset (if (pos? colinc) (rem start-col colinc) 0) space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))] (print (apply str (repeat space-count \space)))) navigator) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for accessing the pretty printer from a format ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: support ~@; per-line-prefix separator ;; TODO: get the whole format wrapped so we can start the lb at any column (defn- format-logical-block [params navigator offsets] (let [clauses (:clauses params) clause-count (count clauses) prefix (cond (> clause-count 1) (:string (:params (first (first clauses)))) (:colon params) "(") body (nth clauses (if (> clause-count 1) 1 0)) suffix (cond (> clause-count 2) (:string (:params (first (nth clauses 2)))) (:colon params) ")") [arg navigator] (next-arg navigator)] (pprint-logical-block :prefix prefix :suffix suffix (execute-sub-format body (init-navigator arg) (:base-args params))) navigator)) (defn- set-indent [params navigator offsets] (let [relative-to (if (:colon params) :current :block)] (pprint-indent relative-to (:n params)) navigator)) ;;; TODO: support ~:T section options for ~T (defn- conditional-newline [params navigator offsets] (let [kind (if (:colon params) (if (:at params) :mandatory :fill) (if (:at params) :miser :linear))] (pprint-newline kind) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The table of directives we support, each with its params, ;;; properties, and the compilation function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; We start with a couple of helpers (defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ] [char, {:directive char, :params `(array-map ~@params), :flags flags, :bracket-info bracket-info, :generator-fn (concat '(fn [ params offset]) generator-fn) }]) (defmacro ^{:private true} defdirectives [ & directives ] `(def ^{:private true} directive-table (hash-map ~@(mapcat process-directive-table-element directives)))) (defdirectives (\A [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] #{ :at :colon :both} {} #(format-ascii print-str %1 %2 %3)) (\S [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] #{ :at :colon :both} {} #(format-ascii pr-str %1 %2 %3)) (\D [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 10 %1 %2 %3)) (\B [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 2 %1 %2 %3)) (\O [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 8 %1 %2 %3)) (\X [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 16 %1 %2 %3)) (\R [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} (do (cond ; ~R is overloaded with bizareness (first (:base params)) #(format-integer (:base %1) %1 %2 %3) (and (:at params) (:colon params)) #(format-old-roman %1 %2 %3) (:at params) #(format-new-roman %1 %2 %3) (:colon params) #(format-ordinal-english %1 %2 %3) true #(format-cardinal-english %1 %2 %3)))) (\P [ ] #{ :at :colon :both } {} (fn [params navigator offsets] (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator) strs (if (:at params) ["y" "ies"] ["" "s"]) [arg navigator] (next-arg navigator)] (print (if (= arg 1) (first strs) (second strs))) navigator))) (\C [:char-format [nil Character]] #{ :at :colon :both } {} (cond (:colon params) pretty-character (:at params) readable-character :else plain-character)) (\F [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] :padchar [\space Character] ] #{ :at } {} fixed-float) (\E [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] :overflowchar [nil Character] :padchar [\space Character] :exponentchar [nil Character] ] #{ :at } {} exponential-float) (\G [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] :overflowchar [nil Character] :padchar [\space Character] :exponentchar [nil Character] ] #{ :at } {} general-float) (\$ [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]] #{ :at :colon :both} {} dollar-float) (\% [ :count [1 Integer] ] #{ } {} (fn [params arg-navigator offsets] (dotimes [i (:count params)] (prn)) arg-navigator)) (\& [ :count [1 Integer] ] #{ :pretty } {} (fn [params arg-navigator offsets] (let [cnt (:count params)] (if (pos? cnt) (fresh-line)) (dotimes [i (dec cnt)] (prn))) arg-navigator)) (\| [ :count [1 Integer] ] #{ } {} (fn [params arg-navigator offsets] (dotimes [i (:count params)] (print \formfeed)) arg-navigator)) (\~ [ :n [1 Integer] ] #{ } {} (fn [params arg-navigator offsets] (let [n (:n params)] (print (apply str (repeat n \~))) arg-navigator))) (\newline ;; Whitespace supression is handled in the compilation loop [ ] #{:colon :at} {} (fn [params arg-navigator offsets] (if (:at params) (prn)) arg-navigator)) (\T [ :colnum [1 Integer] :colinc [1 Integer] ] #{ :at :pretty } {} (if (:at params) #(relative-tabulation %1 %2 %3) #(absolute-tabulation %1 %2 %3))) (\* [ :n [1 Integer] ] #{ :colon :at } {} (fn [params navigator offsets] (let [n (:n params)] (if (:at params) (absolute-reposition navigator n) (relative-reposition navigator (if (:colon params) (- n) n))) ))) (\? [ ] #{ :at } {} (if (:at params) (fn [params navigator offsets] ; args from main arg list (let [[subformat navigator] (get-format-arg navigator)] (execute-sub-format subformat navigator (:base-args params)))) (fn [params navigator offsets] ; args from sub-list (let [[subformat navigator] (get-format-arg navigator) [subargs navigator] (next-arg navigator) sub-navigator (init-navigator subargs)] (execute-sub-format subformat sub-navigator (:base-args params)) navigator)))) (\( [ ] #{ :colon :at :both} { :right \), :allows-separator nil, :else nil } (let [mod-case-writer (cond (and (:at params) (:colon params)) upcase-writer (:colon params) capitalize-word-writer (:at params) init-cap-writer :else downcase-writer)] #(modify-case mod-case-writer %1 %2 %3))) (\) [] #{} {} nil) (\[ [ :selector [nil Integer] ] #{ :colon :at } { :right \], :allows-separator true, :else :last } (cond (:colon params) boolean-conditional (:at params) check-arg-conditional true choice-conditional)) (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] #{ :colon } { :separator true } nil) (\] [] #{} {} nil) (\{ [ :max-iterations [nil Integer] ] #{ :colon :at :both} { :right \}, :allows-separator false } (cond (and (:at params) (:colon params)) iterate-main-sublists (:colon params) iterate-list-of-sublists (:at params) iterate-main-list true iterate-sublist)) (\} [] #{:colon} {} nil) (\< [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]] #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first } logical-block-or-justify) (\> [] #{:colon} {} nil) ;; TODO: detect errors in cases where colon not allowed (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] #{:colon} {} (fn [params navigator offsets] (let [arg1 (:arg1 params) arg2 (:arg2 params) arg3 (:arg3 params) exit (if (:colon params) :colon-up-arrow :up-arrow)] (cond (and arg1 arg2 arg3) (if (<= arg1 arg2 arg3) [exit navigator] navigator) (and arg1 arg2) (if (= arg1 arg2) [exit navigator] navigator) arg1 (if (= arg1 0) [exit navigator] navigator) true ; TODO: handle looking up the arglist stack for info (if (if (:colon params) (empty? (:rest (:base-args params))) (empty? (:rest navigator))) [exit navigator] navigator))))) (\W [] #{:at :colon :both} {} (if (or (:at params) (:colon params)) (let [bindings (concat (if (:at params) [:level nil :length nil] []) (if (:colon params) [:pretty true] []))] (fn [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (apply write arg bindings) [:up-arrow navigator] navigator)))) (fn [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (write-out arg) [:up-arrow navigator] navigator))))) (\_ [] #{:at :colon :both} {} conditional-newline) (\I [:n [0 Integer]] #{:colon} {} set-indent) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code to manage the parameters and flags associated with each ;;; directive in the format string. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))") (def ^{:private true} special-params #{ :parameter-from-args :remaining-arg-count }) (defn- extract-param [[s offset saw-comma]] (let [m (re-matcher param-pattern s) param (re-find m)] (if param (let [token-str (first (re-groups m)) remainder (subs s (.end m)) new-offset (+ offset (.end m))] (if (not (= \, (nth remainder 0))) [ [token-str offset] [remainder new-offset false]] [ [token-str offset] [(subs remainder 1) (inc new-offset) true]])) (if saw-comma (format-error "Badly formed parameters in format directive" offset) [ nil [s offset]])))) (defn- extract-params [s offset] (consume extract-param [s offset false])) (defn- translate-param "Translate the string representation of a param to the internalized representation" [[^String p offset]] [(cond (= (.length p) 0) nil (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1) true (new Integer p)) offset]) (def ^{:private true} flag-defs { \: :colon, \@ :at }) (defn- extract-flags [s offset] (consume (fn [[s offset flags]] (if (empty? s) [nil [s offset flags]] (let [flag (get flag-defs (first s))] (if flag (if (contains? flags flag) (format-error (str "Flag \"" (first s) "\" appears more than once in a directive") offset) [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]]) [nil [s offset flags]])))) [s offset {}])) (defn- check-flags [def flags] (let [allowed (:flags def)] (if (and (not (:at allowed)) (:at flags)) (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"") (nth (:at flags) 1))) (if (and (not (:colon allowed)) (:colon flags)) (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"") (nth (:colon flags) 1))) (if (and (not (:both allowed)) (:at flags) (:colon flags)) (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" (:directive def) "\"") (min (nth (:colon flags) 1) (nth (:at flags) 1)))))) (defn- map-params "Takes a directive definition and the list of actual parameters and a map of flags and returns a map of the parameters and flags with defaults filled in. We check to make sure that there are the right types and number of parameters as well." [def params flags offset] (check-flags def flags) (if (> (count params) (count (:params def))) (format-error (cl-format nil "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed" (:directive def) (count params) (count (:params def))) (second (first params)))) (doall (map #(let [val (first %1)] (if (not (or (nil? val) (contains? special-params val) (instance? (second (second %2)) val))) (format-error (str "Parameter " (name (first %2)) " has bad type in directive \"" (:directive def) "\": " (class val)) (second %1))) ) params (:params def))) (merge ; create the result map (into (array-map) ; start with the default values, make sure the order is right (reverse (for [[name [default]] (:params def)] [name [default offset]]))) (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils flags)) ; and finally add the flags (defn- compile-directive [s offset] (let [[raw-params [rest offset]] (extract-params s offset) [_ [rest offset flags]] (extract-flags rest offset) directive (first rest) def (get directive-table (Character/toUpperCase ^Character directive)) params (if def (map-params def (map translate-param raw-params) flags offset))] (if (not directive) (format-error "Format string ended in the middle of a directive" offset)) (if (not def) (format-error (str "Directive \"" directive "\" is undefined") offset)) [(struct compiled-directive ((:generator-fn def) params offset) def params offset) (let [remainder (subs rest 1) offset (inc offset) trim? (and (= \newline (:directive def)) (not (:colon params))) trim-count (if trim? (prefix-count remainder [\space \tab]) 0) remainder (subs remainder trim-count) offset (+ offset trim-count)] [remainder offset])])) (defn- compile-raw-string [s offset] (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset)) (defn- right-bracket [this] (:right (:bracket-info (:def this)))) (defn- separator? [this] (:separator (:bracket-info (:def this)))) (defn- else-separator? [this] (and (:separator (:bracket-info (:def this))) (:colon (:params this)))) (declare collect-clauses) (defn- process-bracket [this remainder] (let [[subex remainder] (collect-clauses (:bracket-info (:def this)) (:offset this) remainder)] [(struct compiled-directive (:func this) (:def this) (merge (:params this) (tuple-map subex (:offset this))) (:offset this)) remainder])) (defn- process-clause [bracket-info offset remainder] (consume (fn [remainder] (if (empty? remainder) (format-error "No closing bracket found." offset) (let [this (first remainder) remainder (next remainder)] (cond (right-bracket this) (process-bracket this remainder) (= (:right bracket-info) (:directive (:def this))) [ nil [:right-bracket (:params this) nil remainder]] (else-separator? this) [nil [:else nil (:params this) remainder]] (separator? this) [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~; true [this remainder])))) remainder)) (defn- collect-clauses [bracket-info offset remainder] (second (consume (fn [[clause-map saw-else remainder]] (let [[clause [type right-params else-params remainder]] (process-clause bracket-info offset remainder)] (cond (= type :right-bracket) [nil [(merge-with concat clause-map {(if saw-else :else :clauses) [clause] :right-params right-params}) remainder]] (= type :else) (cond (:else clause-map) (format-error "Two else clauses (\"~:;\") inside bracket construction." offset) (not (:else bracket-info)) (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." offset) (and (= :first (:else bracket-info)) (seq (:clauses clause-map))) (format-error "The else clause (\"~:;\") is only allowed in the first position for this directive." offset) true ; if the ~:; is in the last position, the else clause ; is next, this was a regular clause (if (= :first (:else bracket-info)) [true [(merge-with concat clause-map { :else [clause] :else-params else-params}) false remainder]] [true [(merge-with concat clause-map { :clauses [clause] }) true remainder]])) (= type :separator) (cond saw-else (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset) (not (:allows-separator bracket-info)) (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." offset) true [true [(merge-with concat clause-map { :clauses [clause] }) false remainder]])))) [{ :clauses [] } false remainder]))) (defn- process-nesting "Take a linearly compiled format and process the bracket directives to give it the appropriate tree structure" [format] (first (consume (fn [remainder] (let [this (first remainder) remainder (next remainder) bracket (:bracket-info (:def this))] (if (:right bracket) (process-bracket this remainder) [this remainder]))) format))) (defn- compile-format "Compiles format-str into a compiled format which can be used as an argument to cl-format just like a plain format string. Use this function for improved performance when you're using the same format string repeatedly" [ format-str ] ; (prlabel compiling format-str) (binding [*format-str* format-str] (process-nesting (first (consume (fn [[^String s offset]] (if (empty? s) [nil s] (let [tilde (.indexOf s (int \~))] (cond (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]] (zero? tilde) (compile-directive (subs s 1) (inc offset)) true [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]])))) [format-str 0]))))) (defn- needs-pretty "determine whether a given compiled format has any directives that depend on the column number or pretty printing" [format] (loop [format format] (if (empty? format) false (if (or (:pretty (:flags (:def (first format)))) (some needs-pretty (first (:clauses (:params (first format))))) (some needs-pretty (first (:else (:params (first format)))))) true (recur (next format)))))) (defn- execute-format "Executes the format with the arguments." {:skip-wiki true} ([stream format args] (let [^java.io.Writer real-stream (cond (not stream) (java.io.StringWriter.) (true? stream) *out* :else stream) ^java.io.Writer wrapped-stream (if (and (needs-pretty format) (not (pretty-writer? real-stream))) (get-pretty-writer real-stream) real-stream)] (binding [*out* wrapped-stream] (try (execute-format format args) (finally (if-not (identical? real-stream wrapped-stream) (.flush wrapped-stream)))) (if (not stream) (.toString real-stream))))) ([format args] (map-passing-context (fn [element context] (if (abort? context) [nil context] (let [[params args] (realize-parameter-list (:params element) context) [params offsets] (unzip-map params) params (assoc params :base-args args)] [nil (apply (:func element) [params args offsets])]))) args format) nil)) ;;; This is a bad idea, but it prevents us from leaking private symbols ;;; This should all be replaced by really compiled formats anyway. (def ^{:private true} cached-compile (memoize compile-format)) (defmacro formatter "Makes a function which can directly run format-in. The function is fn [stream & args] ... and returns nil unless the stream is nil (meaning output to a string) in which case it returns the resulting string. format-in can be either a control string or a previously compiled format." {:added "1.2"} [format-in] `(let [format-in# ~format-in my-c-c# (var-get (get (ns-interns (the-ns 'clojure.pprint)) '~'cached-compile)) my-e-f# (var-get (get (ns-interns (the-ns 'clojure.pprint)) '~'execute-format)) my-i-n# (var-get (get (ns-interns (the-ns 'clojure.pprint)) '~'init-navigator)) cf# (if (string? format-in#) (my-c-c# format-in#) format-in#)] (fn [stream# & args#] (let [navigator# (my-i-n# args#)] (my-e-f# stream# cf# navigator#))))) (defmacro formatter-out "Makes a function which can directly run format-in. The function is fn [& args] ... and returns nil. This version of the formatter macro is designed to be used with *out* set to an appropriate Writer. In particular, this is meant to be used as part of a pretty printer dispatch method. format-in can be either a control string or a previously compiled format." {:added "1.2"} [format-in] `(let [format-in# ~format-in cf# (if (string? format-in#) (#'clojure.pprint/cached-compile format-in#) format-in#)] (fn [& args#] (let [navigator# (#'clojure.pprint/init-navigator args#)] (#'clojure.pprint/execute-format cf# navigator#))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/column_writer.clj000066400000000000000000000051541157562347600252650ustar00rootroot00000000000000;;; column_writer.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; Revised to use proxy instead of gen-class April 2010 ;; This module implements a column-aware wrapper around an instance of java.io.Writer (in-ns 'clojure.pprint) (import [clojure.lang IDeref] [java.io Writer]) (def ^{:private true} *default-page-width* 72) (defn- get-field [^Writer this sym] (sym @@this)) (defn- set-field [^Writer this sym new-val] (alter @this assoc sym new-val)) (defn- get-column [this] (get-field this :cur)) (defn- get-line [this] (get-field this :line)) (defn- get-max-column [this] (get-field this :max)) (defn- set-max-column [this new-max] (dosync (set-field this :max new-max)) nil) (defn- get-writer [this] (get-field this :base)) (defn- c-write-char [^Writer this ^Integer c] (dosync (if (= c (int \newline)) (do (set-field this :cur 0) (set-field this :line (inc (get-field this :line)))) (set-field this :cur (inc (get-field this :cur))))) (.write ^Writer (get-field this :base) c)) (defn- column-writer ([writer] (column-writer writer *default-page-width*)) ([writer max-columns] (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})] (proxy [Writer IDeref] [] (deref [] fields) (write ([^chars cbuf ^Integer off ^Integer len] (let [^Writer writer (get-field this :base)] (.write writer cbuf off len))) ([x] (condp = (class x) String (let [^String s x nl (.lastIndexOf s (int \newline))] (dosync (if (neg? nl) (set-field this :cur (+ (get-field this :cur) (count s))) (do (set-field this :cur (- (count s) nl 1)) (set-field this :line (+ (get-field this :line) (count (filter #(= % \newline) s))))))) (.write ^Writer (get-field this :base) s)) Integer (c-write-char this x)))))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/dispatch.clj000066400000000000000000000431471157562347600241770ustar00rootroot00000000000000;; dispatch.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements the default dispatch tables for pretty printing code and ;; data. (in-ns 'clojure.pprint) (defn- use-method "Installs a function as a new method of multimethod associated with dispatch-value. " [multifn dispatch-val func] (. multifn addMethod dispatch-val func)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementations of specific dispatch table entries ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handle forms that can be "back-translated" to reader macros ;;; Not all reader macros can be dealt with this way or at all. ;;; Macros that we can't deal with at all are: ;;; ; - The comment character is aborbed by the reader and never is part of the form ;;; ` - Is fully processed at read time into a lisp expression (which will contain concats ;;; and regular quotes). ;;; ~@ - Also fully eaten by the processing of ` and can't be used outside. ;;; , - is whitespace and is lost (like all other whitespace). Formats can generate commas ;;; where they deem them useful to help readability. ;;; ^ - Adding metadata completely disappears at read time and the data appears to be ;;; completely lost. ;;; ;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{}) ;;; or directly by printing the objects using Clojure's built-in print functions (like ;;; :keyword, \char, or ""). The notable exception is #() which is special-cased. (def ^{:private true} reader-macros {'quote "'", 'clojure.core/deref "@", 'var "#'", 'clojure.core/unquote "~"}) (defn- pprint-reader-macro [alis] (let [^String macro-char (reader-macros (first alis))] (when (and macro-char (= 2 (count alis))) (.write ^java.io.Writer *out* macro-char) (write-out (second alis)) true))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Dispatch for the basic data types when interpreted ;; as data (as opposed to code). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; TODO: inline these formatter statements into funcs so that we ;;; are a little easier on the stack. (Or, do "real" compilation, a ;;; la Common Lisp) ;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>")) (defn- pprint-simple-list [alis] (pprint-logical-block :prefix "(" :suffix ")" (loop [alis (seq alis)] (when alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next alis))))))) (defn- pprint-list [alis] (if-not (pprint-reader-macro alis) (pprint-simple-list alis))) ;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>")) (defn- pprint-vector [avec] (pprint-logical-block :prefix "[" :suffix "]" (loop [aseq (seq avec)] (when aseq (write-out (first aseq)) (when (next aseq) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next aseq))))))) (def ^{:private true} pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) ;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) (defn- pprint-map [amap] (pprint-logical-block :prefix "{" :suffix "}" (loop [aseq (seq amap)] (when aseq (pprint-logical-block (write-out (ffirst aseq)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (write-out (fnext (first aseq)))) (when (next aseq) (.write ^java.io.Writer *out* ", ") (pprint-newline :linear) (recur (next aseq))))))) (def ^{:private true} pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) ;;; TODO: don't block on promise (currently impossible) (def ^{:private true} type-map {"core$future_call" "Future", "core$promise" "Promise"}) (defn- map-ref-type "Map ugly type names to something simpler" [name] (or (when-let [match (re-find #"^[^$]+\$[^$]+" name)] (type-map match)) name)) (defn- pprint-ideref [o] (let [prefix (format "#<%s@%x%s: " (map-ref-type (.getSimpleName (class o))) (System/identityHashCode o) (if (and (instance? clojure.lang.Agent o) (agent-error o)) " FAILED" ""))] (pprint-logical-block :prefix prefix :suffix ">" (pprint-indent :block (-> (count prefix) (- 2) -)) (pprint-newline :linear) (write-out (cond (and (future? o) (not (future-done? o))) :pending :else @o))))) (def ^{:private true} pprint-pqueue (formatter-out "~<<-(~;~@{~w~^ ~_~}~;)-<~:>")) (defn- pprint-simple-default [obj] (cond (.isArray (class obj)) (pprint-array obj) (and *print-suppress-namespaces* (symbol? obj)) (print (name obj)) :else (pr obj))) (defmulti simple-dispatch "The pretty print dispatch function for simple data structure format." {:added "1.2" :arglists '[[object]]} class) (use-method simple-dispatch clojure.lang.ISeq pprint-list) (use-method simple-dispatch clojure.lang.IPersistentVector pprint-vector) (use-method simple-dispatch clojure.lang.IPersistentMap pprint-map) (use-method simple-dispatch clojure.lang.IPersistentSet pprint-set) (use-method simple-dispatch clojure.lang.PersistentQueue pprint-pqueue) (use-method simple-dispatch clojure.lang.IDeref pprint-ideref) (use-method simple-dispatch nil pr) (use-method simple-dispatch :default pprint-simple-default) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Dispatch for the code table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare pprint-simple-code-list) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something that looks like a simple def (sans metadata, since the reader ;;; won't give it to us now). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something that looks like a defn or defmacro ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format the params and body of a defn with a single arity (defn- single-defn [alis has-doc-str?] (if (seq alis) (do (if has-doc-str? ((formatter-out " ~_")) ((formatter-out " ~@_"))) ((formatter-out "~{~w~^ ~_~}") alis)))) ;;; Format the param and body sublists of a defn with multiple arities (defn- multi-defn [alis has-doc-str?] (if (seq alis) ((formatter-out " ~_~{~w~^ ~_~}") alis))) ;;; TODO: figure out how to support capturing metadata in defns (we might need a ;;; special reader) (defn- pprint-defn [alis] (if (next alis) (let [[defn-sym defn-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map stuff] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block :prefix "(" :suffix ")" ((formatter-out "~w ~1I~@_~w") defn-sym defn-name) (if doc-str ((formatter-out " ~_~w") doc-str)) (if attr-map ((formatter-out " ~_~w") attr-map)) ;; Note: the multi-defn case will work OK for malformed defns too (cond (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) :else (multi-defn stuff (or doc-str attr-map))))) (pprint-simple-code-list alis))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something with a binding form ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- pprint-binding-form [binding-vec] (pprint-logical-block :prefix "[" :suffix "]" (loop [binding binding-vec] (when (seq binding) (pprint-logical-block binding (write-out (first binding)) (when (next binding) (.write ^java.io.Writer *out* " ") (pprint-newline :miser) (write-out (second binding)))) (when (next (rest binding)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next (rest binding)))))))) (defn- pprint-let [alis] (let [base-sym (first alis)] (pprint-logical-block :prefix "(" :suffix ")" (if (and (next alis) (vector? (second alis))) (do ((formatter-out "~w ~1I~@_") base-sym) (pprint-binding-form (second alis)) ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis)))) (pprint-simple-code-list alis))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something that looks like "if" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>")) (defn- pprint-cond [alis] (pprint-logical-block :prefix "(" :suffix ")" (pprint-indent :block 1) (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (loop [alis (next alis)] (when alis (pprint-logical-block alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :miser) (write-out (second alis)))) (when (next (rest alis)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next (rest alis))))))))) (defn- pprint-condp [alis] (if (> (count alis) 3) (pprint-logical-block :prefix "(" :suffix ")" (pprint-indent :block 1) (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis) (loop [alis (seq (drop 3 alis))] (when alis (pprint-logical-block alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :miser) (write-out (second alis)))) (when (next (rest alis)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next (rest alis))))))) (pprint-simple-code-list alis))) ;;; The map of symbols that are defined in an enclosing #() anonymous function (def ^{:private true} *symbol-map* {}) (defn- pprint-anon-func [alis] (let [args (second alis) nlis (first (rest (rest alis)))] (if (vector? args) (binding [*symbol-map* (if (= 1 (count args)) {(first args) "%"} (into {} (map #(vector %1 (str \% %2)) args (range 1 (inc (count args))))))] ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis)) (pprint-simple-code-list alis)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The master definitions for formatting lists in code (that is, (fn args...) or ;;; special forms). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is ;;; easier on the stack. (defn- pprint-simple-code-list [alis] (pprint-logical-block :prefix "(" :suffix ")" (pprint-indent :block 1) (loop [alis (seq alis)] (when alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next alis))))))) ;;; Take a map with symbols as keys and add versions with no namespace. ;;; That is, if ns/sym->val is in the map, add sym->val to the result. (defn- two-forms [amap] (into {} (mapcat identity (for [x amap] [x [(symbol (name (first x))) (second x)]])))) (defn- add-core-ns [amap] (let [core "clojure.core"] (into {} (map #(let [[s f] %] (if (not (or (namespace s) (special-symbol? s))) [(symbol core (name s)) f] %)) amap)))) (def ^{:private true} *code-table* (two-forms (add-core-ns {'def pprint-hold-first, 'defonce pprint-hold-first, 'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn, 'let pprint-let, 'loop pprint-let, 'binding pprint-let, 'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let, 'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let, 'when-first pprint-let, 'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if, 'cond pprint-cond, 'condp pprint-condp, 'fn* pprint-anon-func, '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first, 'locking pprint-hold-first, 'struct pprint-hold-first, 'struct-map pprint-hold-first, }))) (defn- pprint-code-list [alis] (if-not (pprint-reader-macro alis) (if-let [special-form (*code-table* (first alis))] (special-form alis) (pprint-simple-code-list alis)))) (defn- pprint-code-symbol [sym] (if-let [arg-num (sym *symbol-map*)] (print arg-num) (if *print-suppress-namespaces* (print (name sym)) (pr sym)))) (defmulti code-dispatch "The pretty print dispatch function for pretty printing Clojure code." {:added "1.2" :arglists '[[object]]} class) (use-method code-dispatch clojure.lang.ISeq pprint-code-list) (use-method code-dispatch clojure.lang.Symbol pprint-code-symbol) ;; The following are all exact copies of simple-dispatch (use-method code-dispatch clojure.lang.IPersistentVector pprint-vector) (use-method code-dispatch clojure.lang.IPersistentMap pprint-map) (use-method code-dispatch clojure.lang.IPersistentSet pprint-set) (use-method code-dispatch clojure.lang.PersistentQueue pprint-pqueue) (use-method code-dispatch clojure.lang.IDeref pprint-ideref) (use-method code-dispatch nil pr) (use-method code-dispatch :default pprint-simple-default) (set-pprint-dispatch simple-dispatch) ;;; For testing (comment (with-pprint-dispatch code-dispatch (pprint '(defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))))) (with-pprint-dispatch code-dispatch (pprint '(defn cl-format [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))))) (with-pprint-dispatch code-dispatch (pprint '(defn- -write ([this x] (condp = (class x) String (let [s0 (write-initial-lines this x) s (.replaceFirst s0 "\\s+$" "") white-space (.substring s0 (count s)) mode (getf :mode)] (if (= mode :writing) (dosync (write-white-space this) (.col_write this s) (setf :trailing-white-space white-space)) (add-to-buffer this (make-buffer-blob s white-space)))) Integer (let [c ^Character x] (if (= (getf :mode) :writing) (do (write-white-space this) (.col_write this x)) (if (= c (int \newline)) (write-initial-lines this "\n") (add-to-buffer this (make-buffer-blob (str (char c)) nil)))))))))) (with-pprint-dispatch code-dispatch (pprint '(defn pprint-defn [writer alis] (if (next alis) (let [[defn-sym defn-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map stuff] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block writer :prefix "(" :suffix ")" (cl-format true "~w ~1I~@_~w" defn-sym defn-name) (if doc-str (cl-format true " ~_~w" doc-str)) (if attr-map (cl-format true " ~_~w" attr-map)) ;; Note: the multi-defn case will work OK for malformed defns too (cond (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) :else (multi-defn stuff (or doc-str attr-map))))) (pprint-simple-code-list writer alis))))) ) nil clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/pprint_base.clj000066400000000000000000000341621157562347600247030ustar00rootroot00000000000000;;; pprint_base.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements the generic pretty print functions and special variables (in-ns 'clojure.pprint) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Variables that control the pretty printer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core ;;; TODO: use *print-dup* here (or is it supplanted by other variables?) ;;; TODO: make dispatch items like "(let..." get counted in *print-length* ;;; constructs (def ^{:doc "Bind to true if you want write to use pretty printing", :added "1.2"} *print-pretty* true) (defonce ; If folks have added stuff here, don't overwrite ^{:doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch to modify.", :added "1.2"} *print-pprint-dispatch* nil) (def ^{:doc "Pretty printing will try to avoid anything going beyond this column. Set it to nil to have pprint let the line be arbitrarily long. This will ignore all non-mandatory newlines.", :added "1.2"} *print-right-margin* 72) (def ^{:doc "The column at which to enter miser style. Depending on the dispatch table, miser style add newlines in more places to try to keep lines short allowing for further levels of nesting.", :added "1.2"} *print-miser-width* 40) ;;; TODO implement output limiting (def ^{:private true, :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"} *print-lines* nil) ;;; TODO: implement circle and shared (def ^{:private true, :doc "Mark circular structures (N.B. This is not yet used)"} *print-circle* nil) ;;; TODO: should we just use *print-dup* here? (def ^{:private true, :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"} *print-shared* nil) (def ^{:doc "Don't print namespaces with symbols. This is particularly useful when pretty printing the results of macro expansions" :added "1.2"} *print-suppress-namespaces* nil) ;;; TODO: support print-base and print-radix in cl-format ;;; TODO: support print-base and print-radix in rationals (def ^{:doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the radix specifier is in the form #XXr where XX is the decimal value of *print-base* " :added "1.2"} *print-radix* nil) (def ^{:doc "The base to use for printing integers and rationals." :added "1.2"} *print-base* 10) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal variables that keep track of where we are in the ;; structure ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{ :private true } *current-level* 0) (def ^{ :private true } *current-length* nil) ;; TODO: add variables for length, lines. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for the write function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare format-simple-number) (def ^{:private true} orig-pr pr) (defn- pr-with-base [x] (if-let [s (format-simple-number x)] (print s) (orig-pr x))) (def ^{:private true} write-option-table {;:array *print-array* :base 'clojure.pprint/*print-base*, ;;:case *print-case*, :circle 'clojure.pprint/*print-circle*, ;;:escape *print-escape*, ;;:gensym *print-gensym*, :length 'clojure.core/*print-length*, :level 'clojure.core/*print-level*, :lines 'clojure.pprint/*print-lines*, :miser-width 'clojure.pprint/*print-miser-width*, :dispatch 'clojure.pprint/*print-pprint-dispatch*, :pretty 'clojure.pprint/*print-pretty*, :radix 'clojure.pprint/*print-radix*, :readably 'clojure.core/*print-readably*, :right-margin 'clojure.pprint/*print-right-margin*, :suppress-namespaces 'clojure.pprint/*print-suppress-namespaces*}) (defmacro ^{:private true} binding-map [amap & body] (let [] `(do (. clojure.lang.Var (pushThreadBindings ~amap)) (try ~@body (finally (. clojure.lang.Var (popThreadBindings))))))) (defn- table-ize [t m] (apply hash-map (mapcat #(when-let [v (get t (key %))] [(find-var v) (val %)]) m))) (defn- pretty-writer? "Return true iff x is a PrettyWriter" [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x))) (defn- make-pretty-writer "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width" [base-writer right-margin miser-width] (pretty-writer base-writer right-margin miser-width)) (defmacro ^{:private true} with-pretty-writer [base-writer & body] `(let [base-writer# ~base-writer new-writer# (not (pretty-writer? base-writer#))] (binding [*out* (if new-writer# (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*) base-writer#)] ~@body (.flush *out*)))) ;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc. (defn write-out "Write an object to *out* subject to the current bindings of the printer control variables. Use the kw-args argument to override individual variables for this call (and any recursive calls). *out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility of the caller. This method is primarily intended for use by pretty print dispatch functions that already know that the pretty printer will have set up their environment appropriately. Normal library clients should use the standard \"write\" interface. " {:added "1.2"} [object] (let [length-reached (and *current-length* *print-length* (>= *current-length* *print-length*))] (if-not *print-pretty* (pr object) (if length-reached (print "...") (do (if *current-length* (set! *current-length* (inc *current-length*))) (*print-pprint-dispatch* object)))) length-reached)) (defn write "Write an object subject to the current bindings of the printer control variables. Use the kw-args argument to override individual variables for this call (and any recursive calls). Returns the string result if :stream is nil or nil otherwise. The following keyword arguments can be passed with values: Keyword Meaning Default value :stream Writer for output or nil true (indicates *out*) :base Base to use for writing rationals Current value of *print-base* :circle* If true, mark circular structures Current value of *print-circle* :length Maximum elements to show in sublists Current value of *print-length* :level Maximum depth Current value of *print-level* :lines* Maximum lines of output Current value of *print-lines* :miser-width Width to enter miser mode Current value of *print-miser-width* :dispatch The pretty print dispatch function Current value of *print-pprint-dispatch* :pretty If true, do pretty printing Current value of *print-pretty* :radix If true, prepend a radix specifier Current value of *print-radix* :readably* If true, print readably Current value of *print-readably* :right-margin The column for the right margin Current value of *print-right-margin* :suppress-namespaces If true, no namespaces in symbols Current value of *print-suppress-namespaces* * = not yet supported " {:added "1.2"} [object & kw-args] (let [options (merge {:stream true} (apply hash-map kw-args))] (binding-map (table-ize write-option-table options) (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) (let [optval (if (contains? options :stream) (:stream options) true) base-writer (condp = optval nil (java.io.StringWriter.) true *out* optval)] (if *print-pretty* (with-pretty-writer base-writer (write-out object)) (binding [*out* base-writer] (pr object))) (if (nil? optval) (.toString ^java.io.StringWriter base-writer))))))) (defn pprint "Pretty print object to the optional output writer. If the writer is not provided, print the object to the currently bound value of *out*." {:added "1.2"} ([object] (pprint object *out*)) ([object writer] (with-pretty-writer writer (binding [*print-pretty* true] (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) (write-out object))) (if (not (= 0 (get-column *out*))) (.write *out* (int \newline)))))) (defmacro pp "A convenience macro that pretty prints the last thing output. This is exactly equivalent to (pprint *1)." {:added "1.2"} [] `(pprint *1)) (defn set-pprint-dispatch "Set the pretty print dispatch function to a function matching (fn [obj] ...) where obj is the object to pretty print. That function will be called with *out* set to a pretty printing writer to which it should do its printing. For example functions, see simple-dispatch and code-dispatch in clojure.pprint.dispatch.clj." {:added "1.2"} [function] (let [old-meta (meta #'*print-pprint-dispatch*)] (alter-var-root #'*print-pprint-dispatch* (constantly function)) (alter-meta! #'*print-pprint-dispatch* (constantly old-meta))) nil) (defmacro with-pprint-dispatch "Execute body with the pretty print dispatch function bound to function." {:added "1.2"} [function & body] `(binding [*print-pprint-dispatch* ~function] ~@body)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for the functional interface to the pretty printer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- parse-lb-options [opts body] (loop [body body acc []] (if (opts (first body)) (recur (drop 2 body) (concat acc (take 2 body))) [(apply hash-map acc) body]))) (defn- check-enumerated-arg [arg choices] (if-not (choices arg) (throw (IllegalArgumentException. ;; TODO clean up choices string (str "Bad argument: " arg ". It must be one of " choices))))) (defn- level-exceeded [] (and *print-level* (>= *current-level* *print-level*))) (defmacro pprint-logical-block "Execute the body as a pretty printing logical block with output to *out* which must be a pretty printing writer. When used from pprint or cl-format, this can be assumed. This function is intended for use when writing custom dispatch functions. Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, and :suffix." {:added "1.2", :arglists '[[options* body]]} [& args] (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] `(do (if (#'clojure.pprint/level-exceeded) (.write ^java.io.Writer *out* "#") (do (push-thread-bindings {#'clojure.pprint/*current-level* (inc (var-get #'clojure.pprint/*current-level*)) #'clojure.pprint/*current-length* 0}) (try (#'clojure.pprint/start-block *out* ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) ~@body (#'clojure.pprint/end-block *out*) (finally (pop-thread-bindings))))) nil))) (defn pprint-newline "Print a conditional newline to a pretty printing stream. kind specifies if the newline is :linear, :miser, :fill, or :mandatory. This function is intended for use when writing custom dispatch functions. Output is sent to *out* which must be a pretty printing writer." {:added "1.2"} [kind] (check-enumerated-arg kind #{:linear :miser :fill :mandatory}) (nl *out* kind)) (defn pprint-indent "Create an indent at this point in the pretty printing stream. This defines how following lines are indented. relative-to can be either :block or :current depending whether the indent should be computed relative to the start of the logical block or the current column position. n is an offset. This function is intended for use when writing custom dispatch functions. Output is sent to *out* which must be a pretty printing writer." {:added "1.2"} [relative-to n] (check-enumerated-arg relative-to #{:block :current}) (indent *out* relative-to n)) ;; TODO a real implementation for pprint-tab (defn pprint-tab "Tab at this point in the pretty printing stream. kind specifies whether the tab is :line, :section, :line-relative, or :section-relative. Colnum and colinc specify the target column and the increment to move the target forward if the output is already past the original target. This function is intended for use when writing custom dispatch functions. Output is sent to *out* which must be a pretty printing writer. THIS FUNCTION IS NOT YET IMPLEMENTED." {:added "1.2"} [kind colnum colinc] (check-enumerated-arg kind #{:line :section :line-relative :section-relative}) (throw (UnsupportedOperationException. "pprint-tab is not yet implemented"))) nil clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/pretty_writer.clj000066400000000000000000000411001157562347600253060ustar00rootroot00000000000000;;; pretty_writer.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; Revised to use proxy instead of gen-class April 2010 ;; This module implements a wrapper around a java.io.Writer which implements the ;; core of the XP algorithm. (in-ns 'clojure.pprint) (import [clojure.lang IDeref] [java.io Writer]) ;; TODO: Support for tab directives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Forward declarations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare get-miser-width) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Macros to simplify dealing with types and classes. These are ;;; really utilities, but I'm experimenting with them here. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro ^{:private true} getf "Get the value of the field a named by the argument (which should be a keyword)." [sym] `(~sym @@~'this)) (defmacro ^{:private true} setf [sym new-val] "Set the value of the field SYM to NEW-VAL" `(alter @~'this assoc ~sym ~new-val)) (defmacro ^{:private true} deftype [type-name & fields] (let [name-str (name type-name)] `(do (defstruct ~type-name :type-tag ~@fields) (alter-meta! #'~type-name assoc :private true) (defn- ~(symbol (str "make-" name-str)) [& vals#] (apply struct ~type-name ~(keyword name-str) vals#)) (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The data structures used by pretty-writer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct ^{:private true} logical-block :parent :section :start-col :indent :done-nl :intra-block-nl :prefix :per-line-prefix :suffix :logical-block-callback) (defn- ancestor? [parent child] (loop [child (:parent child)] (cond (nil? child) false (identical? parent child) true :else (recur (:parent child))))) (defstruct ^{:private true} section :parent) (defn- buffer-length [l] (let [l (seq l)] (if l (- (:end-pos (last l)) (:start-pos (first l))) 0))) ; A blob of characters (aka a string) (deftype buffer-blob :data :trailing-white-space :start-pos :end-pos) ; A newline (deftype nl-t :type :logical-block :start-pos :end-pos) (deftype start-block-t :logical-block :start-pos :end-pos) (deftype end-block-t :logical-block :start-pos :end-pos) (deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions to write tokens in the output buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare emit-nl) (defmulti ^{:private true} write-token #(:type-tag %2)) (defmethod write-token :start-block-t [^Writer this token] (when-let [cb (getf :logical-block-callback)] (cb :start)) (let [lb (:logical-block token)] (dosync (when-let [^String prefix (:prefix lb)] (.write (getf :base) prefix)) (let [col (get-column (getf :base))] (ref-set (:start-col lb) col) (ref-set (:indent lb) col))))) (defmethod write-token :end-block-t [^Writer this token] (when-let [cb (getf :logical-block-callback)] (cb :end)) (when-let [^String suffix (:suffix (:logical-block token))] (.write (getf :base) suffix))) (defmethod write-token :indent-t [^Writer this token] (let [lb (:logical-block token)] (ref-set (:indent lb) (+ (:offset token) (condp = (:relative-to token) :block @(:start-col lb) :current (get-column (getf :base))))))) (defmethod write-token :buffer-blob [^Writer this token] (.write (getf :base) ^String (:data token))) (defmethod write-token :nl-t [^Writer this token] ; (prlabel wt @(:done-nl (:logical-block token))) ; (prlabel wt (:type token) (= (:type token) :mandatory)) (if (or (= (:type token) :mandatory) (and (not (= (:type token) :fill)) @(:done-nl (:logical-block token)))) (emit-nl this token) (if-let [^String tws (getf :trailing-white-space)] (.write (getf :base) tws))) (dosync (setf :trailing-white-space nil))) (defn- write-tokens [^Writer this tokens force-trailing-whitespace] (doseq [token tokens] (if-not (= (:type-tag token) :nl-t) (if-let [^String tws (getf :trailing-white-space)] (.write (getf :base) tws))) (write-token this token) (setf :trailing-white-space (:trailing-white-space token))) (let [^String tws (getf :trailing-white-space)] (when (and force-trailing-whitespace tws) (.write (getf :base) tws) (setf :trailing-white-space nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; emit-nl? method defs for each type of new line. This makes ;;; the decision about whether to print this type of new line. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- tokens-fit? [^Writer this tokens] ;;; (prlabel tf? (get-column (getf :base) (buffer-length tokens)) (let [maxcol (get-max-column (getf :base))] (or (nil? maxcol) (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol)))) (defn- linear-nl? [this lb section] ; (prlabel lnl? @(:done-nl lb) (tokens-fit? this section)) (or @(:done-nl lb) (not (tokens-fit? this section)))) (defn- miser-nl? [^Writer this lb section] (let [miser-width (get-miser-width this) maxcol (get-max-column (getf :base))] (and miser-width maxcol (>= @(:start-col lb) (- maxcol miser-width)) (linear-nl? this lb section)))) (defmulti ^{:private true} emit-nl? (fn [t _ _ _] (:type t))) (defmethod emit-nl? :linear [newl this section _] (let [lb (:logical-block newl)] (linear-nl? this lb section))) (defmethod emit-nl? :miser [newl this section _] (let [lb (:logical-block newl)] (miser-nl? this lb section))) (defmethod emit-nl? :fill [newl this section subsection] (let [lb (:logical-block newl)] (or @(:intra-block-nl lb) (not (tokens-fit? this subsection)) (miser-nl? this lb section)))) (defmethod emit-nl? :mandatory [_ _ _ _] true) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Various support functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- get-section [buffer] (let [nl (first buffer) lb (:logical-block nl) section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb))) (next buffer)))] [section (seq (drop (inc (count section)) buffer))])) (defn- get-sub-section [buffer] (let [nl (first buffer) lb (:logical-block nl) section (seq (take-while #(let [nl-lb (:logical-block %)] (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb))))) (next buffer)))] section)) (defn- update-nl-state [lb] (dosync (ref-set (:intra-block-nl lb) false) (ref-set (:done-nl lb) true) (loop [lb (:parent lb)] (if lb (do (ref-set (:done-nl lb) true) (ref-set (:intra-block-nl lb) true) (recur (:parent lb))))))) (defn- emit-nl [^Writer this nl] (.write (getf :base) (int \newline)) (dosync (setf :trailing-white-space nil)) (let [lb (:logical-block nl) ^String prefix (:per-line-prefix lb)] (if prefix (.write (getf :base) prefix)) (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix)) \space))] (.write (getf :base) istr)) (update-nl-state lb))) (defn- split-at-newline [tokens] (let [pre (seq (take-while #(not (nl-t? %)) tokens))] [pre (seq (drop (count pre) tokens))])) ;;; Methods for showing token strings for debugging (defmulti ^{:private true} tok :type-tag) (defmethod tok :nl-t [token] (:type token)) (defmethod tok :buffer-blob [token] (str \" (:data token) (:trailing-white-space token) \")) (defmethod tok :default [token] (:type-tag token)) (defn- toks [toks] (map tok toks)) ;;; write-token-string is called when the set of tokens in the buffer ;;; is longer than the available space on the line (defn- write-token-string [this tokens] (let [[a b] (split-at-newline tokens)] ;; (prlabel wts (toks a) (toks b)) (if a (write-tokens this a false)) (if b (let [[section remainder] (get-section b) newl (first b)] ;; (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) (let [do-nl (emit-nl? newl this section (get-sub-section b)) result (if do-nl (do ;; (prlabel emit-nl (:type newl)) (emit-nl this newl) (next b)) b) long-section (not (tokens-fit? this result)) result (if long-section (let [rem2 (write-token-string this section)] ;;; (prlabel recurse (toks rem2)) (if (= rem2 section) (do ; If that didn't produce any output, it has no nls ; so we'll force it (write-tokens this section false) remainder) (into [] (concat rem2 remainder)))) result) ;; ff (prlabel wts (toks result)) ] result))))) (defn- write-line [^Writer this] (dosync (loop [buffer (getf :buffer)] ;; (prlabel wl1 (toks buffer)) (setf :buffer (into [] buffer)) (if (not (tokens-fit? this buffer)) (let [new-buffer (write-token-string this buffer)] ;; (prlabel wl new-buffer) (if-not (identical? buffer new-buffer) (recur new-buffer))))))) ;;; Add a buffer token to the buffer and see if it's time to start ;;; writing (defn- add-to-buffer [^Writer this token] ; (prlabel a2b token) (dosync (setf :buffer (conj (getf :buffer) token)) (if (not (tokens-fit? this (getf :buffer))) (write-line this)))) ;;; Write all the tokens that have been buffered (defn- write-buffered-output [^Writer this] (write-line this) (if-let [buf (getf :buffer)] (do (write-tokens this buf true) (setf :buffer [])))) ;;; If there are newlines in the string, print the lines up until the last newline, ;;; making the appropriate adjustments. Return the remainder of the string (defn- write-initial-lines [^Writer this ^String s] (let [lines (.split s "\n" -1)] (if (= (count lines) 1) s (dosync (let [^String prefix (:per-line-prefix (first (getf :logical-blocks))) ^String l (first lines)] (if (= :buffering (getf :mode)) (let [oldpos (getf :pos) newpos (+ oldpos (count l))] (setf :pos newpos) (add-to-buffer this (make-buffer-blob l nil oldpos newpos)) (write-buffered-output this)) (.write (getf :base) l)) (.write (getf :base) (int \newline)) (doseq [^String l (next (butlast lines))] (.write (getf :base) l) (.write (getf :base) (int \newline)) (if prefix (.write (getf :base) prefix))) (setf :buffering :writing) (last lines)))))) (defn- write-white-space [^Writer this] (if-let [^String tws (getf :trailing-white-space)] (dosync (.write (getf :base) tws) (setf :trailing-white-space nil)))) (defn- p-write-char [^Writer this ^Integer c] (if (= (getf :mode) :writing) (do (write-white-space this) (.write (getf :base) c)) (if (= c \newline) (write-initial-lines this "\n") (let [oldpos (getf :pos) newpos (inc oldpos)] (dosync (setf :pos newpos) (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Initialize the pretty-writer instance ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- pretty-writer [writer max-columns miser-width] (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false)) fields (ref {:pretty-writer true :base (column-writer writer max-columns) :logical-blocks lb :sections nil :mode :writing :buffer [] :buffer-block lb :buffer-level 1 :miser-width miser-width :trailing-white-space nil :pos 0})] (proxy [Writer IDeref] [] (deref [] fields) (write ([x] ;; (prlabel write x (getf :mode)) (condp = (class x) String (let [^String s0 (write-initial-lines this x) ^String s (.replaceFirst s0 "\\s+$" "") white-space (.substring s0 (count s)) mode (getf :mode)] (dosync (if (= mode :writing) (do (write-white-space this) (.write (getf :base) s) (setf :trailing-white-space white-space)) (let [oldpos (getf :pos) newpos (+ oldpos (count s0))] (setf :pos newpos) (add-to-buffer this (make-buffer-blob s white-space oldpos newpos)))))) Integer (p-write-char this x)))) (flush [] (if (= (getf :mode) :buffering) (dosync (write-tokens this (getf :buffer) true) (setf :buffer [])) (write-white-space this))) (close [] (.flush this))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Methods for pretty-writer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- start-block [^Writer this ^String prefix ^String per-line-prefix ^String suffix] (dosync (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0) (ref false) (ref false) prefix per-line-prefix suffix)] (setf :logical-blocks lb) (if (= (getf :mode) :writing) (do (write-white-space this) (when-let [cb (getf :logical-block-callback)] (cb :start)) (if prefix (.write (getf :base) prefix)) (let [col (get-column (getf :base))] (ref-set (:start-col lb) col) (ref-set (:indent lb) col))) (let [oldpos (getf :pos) newpos (+ oldpos (if prefix (count prefix) 0))] (setf :pos newpos) (add-to-buffer this (make-start-block-t lb oldpos newpos))))))) (defn- end-block [^Writer this] (dosync (let [lb (getf :logical-blocks) ^String suffix (:suffix lb)] (if (= (getf :mode) :writing) (do (write-white-space this) (if suffix (.write (getf :base) suffix)) (when-let [cb (getf :logical-block-callback)] (cb :end))) (let [oldpos (getf :pos) newpos (+ oldpos (if suffix (count suffix) 0))] (setf :pos newpos) (add-to-buffer this (make-end-block-t lb oldpos newpos)))) (setf :logical-blocks (:parent lb))))) (defn- nl [^Writer this type] (dosync (setf :mode :buffering) (let [pos (getf :pos)] (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos))))) (defn- indent [^Writer this relative-to offset] (dosync (let [lb (getf :logical-blocks)] (if (= (getf :mode) :writing) (do (write-white-space this) (ref-set (:indent lb) (+ offset (condp = relative-to :block @(:start-col lb) :current (get-column (getf :base)))))) (let [pos (getf :pos)] (add-to-buffer this (make-indent-t lb relative-to offset pos pos))))))) (defn- get-miser-width [^Writer this] (getf :miser-width)) (defn- set-miser-width [^Writer this new-miser-width] (dosync (setf :miser-width new-miser-width))) (defn- set-logical-block-callback [^Writer this f] (dosync (setf :logical-block-callback f))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/pprint/utilities.clj000066400000000000000000000070441157562347600244070ustar00rootroot00000000000000;;; utilities.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements some utility function used in formatting and pretty ;; printing. The functions here could go in a more general purpose library, ;; perhaps. (in-ns 'clojure.pprint) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helper functions for digesting formats in the various ;;; phases of their lives. ;;; These functions are actually pretty general. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- map-passing-context [func initial-context lis] (loop [context initial-context lis lis acc []] (if (empty? lis) [acc context] (let [this (first lis) remainder (next lis) [result new-context] (apply func [this context])] (recur new-context remainder (conj acc result)))))) (defn- consume [func initial-context] (loop [context initial-context acc []] (let [[result new-context] (apply func [context])] (if (not result) [acc new-context] (recur new-context (conj acc result)))))) (defn- consume-while [func initial-context] (loop [context initial-context acc []] (let [[result continue new-context] (apply func [context])] (if (not continue) [acc context] (recur new-context (conj acc result)))))) (defn- unzip-map [m] "Take a map that has pairs in the value slots and produce a pair of maps, the first having all the first elements of the pairs and the second all the second elements of the pairs" [(into {} (for [[k [v1 v2]] m] [k v1])) (into {} (for [[k [v1 v2]] m] [k v2]))]) (defn- tuple-map [m v1] "For all the values, v, in the map, replace them with [v v1]" (into {} (for [[k v] m] [k [v v1]]))) (defn- rtrim [s c] "Trim all instances of c from the end of sequence s" (let [len (count s)] (if (and (pos? len) (= (nth s (dec (count s))) c)) (loop [n (dec len)] (cond (neg? n) "" (not (= (nth s n) c)) (subs s 0 (inc n)) true (recur (dec n)))) s))) (defn- ltrim [s c] "Trim all instances of c from the beginning of sequence s" (let [len (count s)] (if (and (pos? len) (= (nth s 0) c)) (loop [n 0] (if (or (= n len) (not (= (nth s n) c))) (subs s n) (recur (inc n)))) s))) (defn- prefix-count [aseq val] "Return the number of times that val occurs at the start of sequence aseq, if val is a seq itself, count the number of times any element of val occurs at the beginning of aseq" (let [test (if (coll? val) (set val) #{val})] (loop [pos 0] (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) pos (recur (inc pos)))))) (defn- prerr [& args] "Println to *err*" (binding [*out* *err*] (apply println args))) (defmacro ^{:private true} prlabel [prefix arg & more-args] "Print args to *err* in name = value format" `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) (cons arg (seq more-args)))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/repl.clj000066400000000000000000000055371157562347600220270ustar00rootroot00000000000000; Copyright (c) Chris Houser, Dec 2008. All rights reserved. ; The use and distribution terms for this software are covered by the ; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) ; which can be found in the file CPL.TXT at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Utilities meant to be used interactively at the REPL (ns #^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim, Christophe Grande" :doc "Utilities meant to be used interactively at the REPL"} clojure.repl (:import (java.io LineNumberReader InputStreamReader PushbackReader) (clojure.lang RT Reflector))) ;; ---------------------------------------------------------------------- ;; Examine Clojure functions (Vars, really) (defn source-fn "Returns a string of the source code for the given symbol, if it can find it. This requires that the symbol resolve to a Var defined in a namespace for which the .clj is in the classpath. Returns nil if it can't find the source. For most REPL usage, 'source' is more convenient. Example: (source-fn 'filter)" [x] (when-let [v (resolve x)] (when-let [filepath (:file (meta v))] (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)] (with-open [rdr (LineNumberReader. (InputStreamReader. strm))] (dotimes [_ (dec (:line (meta v)))] (.readLine rdr)) (let [text (StringBuilder.) pbr (proxy [PushbackReader] [rdr] (read [] (let [i (proxy-super read)] (.append text (char i)) i)))] (read (PushbackReader. pbr)) (str text))))))) (defmacro source "Prints the source code for the given symbol, if it can find it. This requires that the symbol resolve to a Var defined in a namespace for which the .clj is in the classpath. Example: (source filter)" [n] `(println (or (source-fn '~n) (str "Source not found")))) (defn apropos "Given a regular expression or stringable thing, return a seq of all definitions in all currently-loaded namespaces that match the str-or-pattern." [str-or-pattern] (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) #(re-find str-or-pattern (str %)) #(.contains (str %) (str str-or-pattern)))] (mapcat (fn [ns] (filter matches? (keys (ns-publics ns)))) (all-ns)))) (defn dir-fn "Returns a sorted seq of symbols naming public vars in a namespace" [ns] (sort (map first (ns-publics (the-ns ns))))) (defmacro dir "Prints a sorted directory of public vars in a namespace" [nsname] `(doseq [v# (dir-fn '~nsname)] (println v#))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/set.clj000066400000000000000000000121511157562347600216460ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Set operations such as union/intersection." :author "Rich Hickey"} clojure.set) (defn- bubble-max-key [k coll] "Move a maximal element of coll according to fn k (which returns a number) to the front of coll." (let [max (apply max-key k coll)] (cons max (remove #(identical? max %) coll)))) (defn union "Return a set that is the union of the input sets" {:added "1.0"} ([] #{}) ([s1] s1) ([s1 s2] (if (< (count s1) (count s2)) (reduce conj s2 s1) (reduce conj s1 s2))) ([s1 s2 & sets] (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))] (reduce into (first bubbled-sets) (rest bubbled-sets))))) (defn intersection "Return a set that is the intersection of the input sets" {:added "1.0"} ([s1] s1) ([s1 s2] (if (< (count s2) (count s1)) (recur s2 s1) (reduce (fn [result item] (if (contains? s2 item) result (disj result item))) s1 s1))) ([s1 s2 & sets] (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))] (reduce intersection (first bubbled-sets) (rest bubbled-sets))))) (defn difference "Return a set that is the first set without elements of the remaining sets" {:added "1.0"} ([s1] s1) ([s1 s2] (if (< (count s1) (count s2)) (reduce (fn [result item] (if (contains? s2 item) (disj result item) result)) s1 s1) (reduce disj s1 s2))) ([s1 s2 & sets] (reduce difference s1 (conj sets s2)))) (defn select "Returns a set of the elements for which pred is true" {:added "1.0"} [pred xset] (reduce (fn [s k] (if (pred k) s (disj s k))) xset xset)) (defn project "Returns a rel of the elements of xrel with only the keys in ks" {:added "1.0"} [xrel ks] (set (map #(select-keys % ks) xrel))) (defn rename-keys "Returns the map with the keys in kmap renamed to the vals in kmap" {:added "1.0"} [map kmap] (reduce (fn [m [old new]] (if (and (not= old new) (contains? m old)) (-> m (assoc new (get m old)) (dissoc old)) m)) map kmap)) (defn rename "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap" {:added "1.0"} [xrel kmap] (set (map #(rename-keys % kmap) xrel))) (defn index "Returns a map of the distinct values of ks in the xrel mapped to a set of the maps in xrel with the corresponding values of ks." {:added "1.0"} [xrel ks] (reduce (fn [m x] (let [ik (select-keys x ks)] (assoc m ik (conj (get m ik #{}) x)))) {} xrel)) (defn map-invert "Returns the map with the vals mapped to the keys." {:added "1.0"} [m] (reduce (fn [m [k v]] (assoc m v k)) {} m)) (defn join "When passed 2 rels, returns the rel corresponding to the natural join. When passed an additional keymap, joins on the corresponding keys." {:added "1.0"} ([xrel yrel] ;natural join (if (and (seq xrel) (seq yrel)) (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel)))) [r s] (if (<= (count xrel) (count yrel)) [xrel yrel] [yrel xrel]) idx (index r ks)] (reduce (fn [ret x] (let [found (idx (select-keys x ks))] (if found (reduce #(conj %1 (merge %2 x)) ret found) ret))) #{} s)) #{})) ([xrel yrel km] ;arbitrary key mapping (let [[r s k] (if (<= (count xrel) (count yrel)) [xrel yrel (map-invert km)] [yrel xrel km]) idx (index r (vals k))] (reduce (fn [ret x] (let [found (idx (rename-keys (select-keys x (keys k)) k))] (if found (reduce #(conj %1 (merge %2 x)) ret found) ret))) #{} s)))) (defn subset? "Is set1 a subset of set2?" {:added "1.2", :tag Boolean} [set1 set2] (and (<= (count set1) (count set2)) (every? set2 set1))) (defn superset? "Is set1 a superset of set2?" {:added "1.2", :tag Boolean} [set1 set2] (and (>= (count set1) (count set2)) (every? set1 set2))) (comment (refer 'set) (def xs #{{:a 11 :b 1 :c 1 :d 4} {:a 2 :b 12 :c 2 :d 6} {:a 3 :b 3 :c 3 :d 8 :f 42}}) (def ys #{{:a 11 :b 11 :c 11 :e 5} {:a 12 :b 11 :c 12 :e 3} {:a 3 :b 3 :c 3 :e 7 }}) (join xs ys) (join xs (rename ys {:b :yb :c :yc}) {:a :a}) (union #{:a :b :c} #{:c :d :e }) (difference #{:a :b :c} #{:c :d :e}) (intersection #{:a :b :c} #{:c :d :e}) (index ys [:b]) ) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/stacktrace.clj000066400000000000000000000046021157562347600232010ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; stacktrace.clj: print Clojure-centric stack traces ;; by Stuart Sierra ;; January 6, 2009 (ns ^{:doc "Print stack traces oriented towards Clojure, not Java." :author "Stuart Sierra"} clojure.stacktrace) (defn root-cause "Returns the last 'cause' Throwable in a chain of Throwables." {:added "1.1"} [tr] (if-let [cause (.getCause tr)] (recur cause) tr)) (defn print-trace-element "Prints a Clojure-oriented view of one element in a stack trace." {:added "1.1"} [e] (let [class (.getClassName e) method (.getMethodName e)] (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)] (if (and match (= "invoke" method)) (apply printf "%s/%s" (rest match)) (printf "%s.%s" class method)))) (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e))) (defn print-throwable "Prints the class and message of a Throwable." {:added "1.1"} [tr] (printf "%s: %s" (.getName (class tr)) (.getMessage tr))) (defn print-stack-trace "Prints a Clojure-oriented stack trace of tr, a Throwable. Prints a maximum of n stack frames (default: unlimited). Does not print chained exceptions (causes)." {:added "1.1"} ([tr] (print-stack-trace tr nil)) ([tr n] (let [st (.getStackTrace tr)] (print-throwable tr) (newline) (print " at ") (print-trace-element (first st)) (newline) (doseq [e (if (nil? n) (rest st) (take (dec n) (rest st)))] (print " ") (print-trace-element e) (newline))))) (defn print-cause-trace "Like print-stack-trace but prints chained exceptions (causes)." {:added "1.1"} ([tr] (print-cause-trace tr nil)) ([tr n] (print-stack-trace tr n) (when-let [cause (.getCause tr)] (print "Caused by: " ) (recur cause n)))) (defn e "REPL utility. Prints a brief stack trace for the root cause of the most recent exception." {:added "1.1"} [] (print-stack-trace (root-cause *e) 8)) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/string.clj000066400000000000000000000200061157562347600223570ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Clojure String utilities It is poor form to (:use clojure.string). Instead, use require with :as to specify a prefix, e.g. (ns your.namespace.here (:require '[clojure.string :as str])) Design notes for clojure.string: 1. Strings are objects (as opposed to sequences). As such, the string being manipulated is the first argument to a function; passing nil will result in a NullPointerException unless documented otherwise. If you want sequence-y behavior instead, use a sequence. 2. Functions are generally not lazy, and call straight to host methods where those are available and efficient. 3. Functions take advantage of String implementation details to write high-performing loop/recurs instead of using higher-order functions. (This is not idiomatic in general-purpose application code.) 4. When a function is documented to accept a string argument, it will take any implementation of the correct *interface* on the host platform. In Java, this is CharSequence, which is more general than String. In ordinary usage you will almost always pass concrete strings. If you are doing something unusual, e.g. passing a mutable implementation of CharSequence, then thead-safety is your responsibility." :author "Stuart Sierra, Stuart Halloway, David Liebke"} clojure.string (:refer-clojure :exclude (replace reverse)) (:import (java.util.regex Pattern) clojure.lang.LazilyPersistentVector)) (defn ^String reverse "Returns s with its characters reversed." {:added "1.2"} [^CharSequence s] (.toString (.reverse (StringBuilder. s)))) (defn- replace-by [^CharSequence s re f] (let [m (re-matcher re s)] (let [buffer (StringBuffer. (.length s))] (loop [] (if (.find m) (do (.appendReplacement m buffer (f (re-groups m))) (recur)) (do (.appendTail m buffer) (.toString buffer))))))) (defn ^String replace "Replaces all instance of match with replacement in s. match/replacement can be: string / string char / char pattern / (string or function of match). See also replace-first." {:added "1.2"} [^CharSequence s match replacement] (let [s (.toString s)] (cond (instance? Character match) (.replace s ^Character match ^Character replacement) (instance? CharSequence match) (.replace s ^CharSequence match ^CharSequence replacement) (instance? Pattern match) (if (instance? CharSequence replacement) (.replaceAll (re-matcher ^Pattern match s) (.toString ^CharSequence replacement)) (replace-by s match replacement)) :else (throw (IllegalArgumentException. (str "Invalid match arg: " match)))))) (defn- replace-first-by [^CharSequence s ^Pattern re f] (let [m (re-matcher re s)] (let [buffer (StringBuffer. (.length s))] (if (.find m) (let [rep (f (re-groups m))] (.appendReplacement m buffer rep) (.appendTail m buffer) (str buffer)))))) (defn- replace-first-char [^CharSequence s ^Character match replace] (let [s (.toString s) i (.indexOf s (int match))] (if (= -1 i) s (str (subs s 0 i) replace (subs s (inc i)))))) (defn ^String replace-first "Replaces the first instance of match with replacement in s. match/replacement can be: char / char string / string pattern / (string or function of match). See also replace-all." {:added "1.2"} [^CharSequence s match replacement] (let [s (.toString s)] (cond (instance? Character match) (replace-first-char s match replacement) (instance? CharSequence match) (.replaceFirst s (Pattern/quote (.toString ^CharSequence match)) (.toString ^CharSequence replacement)) (instance? Pattern match) (if (instance? CharSequence replacement) (.replaceFirst (re-matcher ^Pattern match s) (.toString ^CharSequence replacement)) (replace-first-by s match replacement)) :else (throw (IllegalArgumentException. (str "Invalid match arg: " match)))))) (defn ^String join "Returns a string of all elements in coll, separated by an optional separator. Like Perl's join." {:added "1.2"} ([coll] (apply str coll)) ([separator [x & more]] (loop [sb (StringBuilder. (str x)) more more sep (str separator)] (if more (recur (-> sb (.append sep) (.append (str (first more)))) (next more) sep) (str sb))))) (defn ^String capitalize "Converts first character of the string to upper-case, all other characters to lower-case." {:added "1.2"} [^CharSequence s] (let [s (.toString s)] (if (< (count s) 2) (.toUpperCase s) (str (.toUpperCase (subs s 0 1)) (.toLowerCase (subs s 1)))))) (defn ^String upper-case "Converts string to all upper-case." {:added "1.2"} [^CharSequence s] (.. s toString toUpperCase)) (defn ^String lower-case "Converts string to all lower-case." {:added "1.2"} [^CharSequence s] (.. s toString toLowerCase)) (defn split "Splits string on a regular expression. Optional argument limit is the maximum number of splits. Not lazy. Returns vector of the splits." {:added "1.2"} ([^CharSequence s ^Pattern re] (LazilyPersistentVector/createOwning (.split re s))) ([ ^CharSequence s ^Pattern re limit] (LazilyPersistentVector/createOwning (.split re s limit)))) (defn split-lines "Splits s on \\n or \\r\\n." {:added "1.2"} [^CharSequence s] (split s #"\r?\n")) (defn ^String trim "Removes whitespace from both ends of string." {:added "1.2"} [^CharSequence s] (.. s toString trim)) (defn ^String triml "Removes whitespace from the left side of string." {:added "1.2"} [^CharSequence s] (loop [index (int 0)] (if (= (.length s) index) "" (if (Character/isWhitespace (.charAt s index)) (recur (inc index)) (.. s (subSequence index (.length s)) toString))))) (defn ^String trimr "Removes whitespace from the right side of string." {:added "1.2"} [^CharSequence s] (loop [index (.length s)] (if (zero? index) "" (if (Character/isWhitespace (.charAt s (dec index))) (recur (dec index)) (.. s (subSequence 0 index) toString))))) (defn ^String trim-newline "Removes all trailing newline \\n or return \\r characters from string. Similar to Perl's chomp." {:added "1.2"} [^CharSequence s] (loop [index (.length s)] (if (zero? index) "" (let [ch (.charAt s (dec index))] (if (or (= ch \newline) (= ch \return)) (recur (dec index)) (.. s (subSequence 0 index) toString)))))) (defn blank? "True if s is nil, empty, or contains only whitespace." {:added "1.2"} [^CharSequence s] (if s (loop [index (int 0)] (if (= (.length s) index) true (if (Character/isWhitespace (.charAt s index)) (recur (inc index)) false))) true)) (defn ^String escape "Return a new string, using cmap to escape each character ch from s as follows: If (cmap ch) is nil, append ch to the new string. If (cmap ch) is non-nil, append (str (cmap ch)) instead." {:added "1.2"} [^CharSequence s cmap] (loop [index (int 0) buffer (StringBuilder. (.length s))] (if (= (.length s) index) (.toString buffer) (let [ch (.charAt s index)] (if-let [replacement (cmap ch)] (.append buffer replacement) (.append buffer ch)) (recur (inc index) buffer))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/template.clj000066400000000000000000000036471157562347600227000ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; template.clj - anonymous functions that pre-evaluate sub-expressions ;; By Stuart Sierra ;; June 23, 2009 ;; CHANGE LOG ;; ;; June 23, 2009: complete rewrite, eliminated _1,_2,... argument ;; syntax ;; ;; January 20, 2009: added "template?" and checks for valid template ;; expressions. ;; ;; December 15, 2008: first version (ns ^{:doc "Macros that expand to repeated copies of a template expression." :author "Stuart Sierra"} clojure.template (:require [clojure.walk :as walk])) (defn apply-template "For use in macros. argv is an argument list, as in defn. expr is a quoted expression using the symbols in argv. values is a sequence of values to be used for the arguments. apply-template will recursively replace argument symbols in expr with their corresponding values, returning a modified expr. Example: (apply-template '[x] '(+ x x) '[2]) ;=> (+ 2 2)" [argv expr values] (assert (vector? argv)) (assert (every? symbol? argv)) (walk/prewalk-replace (zipmap argv values) expr)) (defmacro do-template "Repeatedly copies expr (in a do block) for each group of arguments in values. values are automatically partitioned by the number of arguments in argv, an argument vector as in defn. Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5)) ;=> (do (+ 4 2) (+ 5 3))" [argv expr & values] (let [c (count argv)] `(do ~@(map (fn [a] (apply-template argv expr a)) (partition c values))))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/test.clj000066400000000000000000000602311157562347600220340ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; test.clj: test framework for Clojure ;; by Stuart Sierra ;; March 28, 2009 ;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for ;; contributions and suggestions. (ns ^{:author "Stuart Sierra, with contributions and suggestions by Chas Emerick, Allen Rohner, and Stuart Halloway", :doc "A unit testing framework. ASSERTIONS The core of the library is the \"is\" macro, which lets you make assertions of any arbitrary expression: (is (= 4 (+ 2 2))) (is (instance? Integer 256)) (is (.startsWith \"abcde\" \"ab\")) You can type an \"is\" expression directly at the REPL, which will print a message if it fails. user> (is (= 5 (+ 2 2))) FAIL in (:1) expected: (= 5 (+ 2 2)) actual: (not (= 5 4)) false The \"expected:\" line shows you the original expression, and the \"actual:\" shows you what actually happened. In this case, it shows that (+ 2 2) returned 4, which is not = to 5. Finally, the \"false\" on the last line is the value returned from the expression. The \"is\" macro always returns the result of the inner expression. There are two special assertions for testing exceptions. The \"(is (thrown? c ...))\" form tests if an exception of class c is thrown: (is (thrown? ArithmeticException (/ 1 0))) \"(is (thrown-with-msg? c re ...))\" does the same thing and also tests that the message on the exception matches the regular expression re: (is (thrown-with-msg? ArithmeticException #\"Divide by zero\" (/ 1 0))) DOCUMENTING TESTS \"is\" takes an optional second argument, a string describing the assertion. This message will be included in the error report. (is (= 5 (+ 2 2)) \"Crazy arithmetic\") In addition, you can document groups of assertions with the \"testing\" macro, which takes a string followed by any number of assertions. The string will be included in failure reports. Calls to \"testing\" may be nested, and all of the strings will be joined together with spaces in the final report, in a style similar to RSpec (testing \"Arithmetic\" (testing \"with positive integers\" (is (= 4 (+ 2 2))) (is (= 7 (+ 3 4)))) (testing \"with negative integers\" (is (= -4 (+ -2 -2))) (is (= -1 (+ 3 -4))))) Note that, unlike RSpec, the \"testing\" macro may only be used INSIDE a \"deftest\" or \"with-test\" form (see below). DEFINING TESTS There are two ways to define tests. The \"with-test\" macro takes a defn or def form as its first argument, followed by any number of assertions. The tests will be stored as metadata on the definition. (with-test (defn my-function [x y] (+ x y)) (is (= 4 (my-function 2 2))) (is (= 7 (my-function 3 4)))) As of Clojure SVN rev. 1221, this does not work with defmacro. See http://code.google.com/p/clojure/issues/detail?id=51 The other way lets you define tests separately from the rest of your code, even in a different namespace: (deftest addition (is (= 4 (+ 2 2))) (is (= 7 (+ 3 4)))) (deftest subtraction (is (= 1 (- 4 3))) (is (= 3 (- 7 4)))) This creates functions named \"addition\" and \"subtraction\", which can be called like any other function. Therefore, tests can be grouped and composed, in a style similar to the test framework in Peter Seibel's \"Practical Common Lisp\" (deftest arithmetic (addition) (subtraction)) The names of the nested tests will be joined in a list, like \"(arithmetic addition)\", in failure reports. You can use nested tests to set up a context shared by several tests. RUNNING TESTS Run tests with the function \"(run-tests namespaces...)\": (run-tests 'your.namespace 'some.other.namespace) If you don't specify any namespaces, the current namespace is used. To run all tests in all namespaces, use \"(run-all-tests)\". By default, these functions will search for all tests defined in a namespace and run them in an undefined order. However, if you are composing tests, as in the \"arithmetic\" example above, you probably do not want the \"addition\" and \"subtraction\" tests run separately. In that case, you must define a special function named \"test-ns-hook\" that runs your tests in the correct order: (defn test-ns-hook [] (arithmetic)) OMITTING TESTS FROM PRODUCTION CODE You can bind the variable \"*load-tests*\" to false when loading or compiling code in production. This will prevent any tests from being created by \"with-test\" or \"deftest\". FIXTURES (new) Fixtures allow you to run code before and after tests, to set up the context in which tests should be run. A fixture is just a function that calls another function passed as an argument. It looks like this: (defn my-fixture [f] Perform setup, establish bindings, whatever. (f) Then call the function we were passed. Tear-down / clean-up code here. ) Fixtures are attached to namespaces in one of two ways. \"each\" fixtures are run repeatedly, once for each test function created with \"deftest\" or \"with-test\". \"each\" fixtures are useful for establishing a consistent before/after state for each test, like clearing out database tables. \"each\" fixtures can be attached to the current namespace like this: (use-fixtures :each fixture1 fixture2 ...) The fixture1, fixture2 are just functions like the example above. They can also be anonymous functions, like this: (use-fixtures :each (fn [f] setup... (f) cleanup...)) The other kind of fixture, a \"once\" fixture, is only run once, around ALL the tests in the namespace. \"once\" fixtures are useful for tasks that only need to be performed once, like establishing database connections, or for time-consuming tasks. Attach \"once\" fixtures to the current namespace like this: (use-fixtures :once fixture1 fixture2 ...) SAVING TEST OUTPUT TO A FILE All the test reporting functions write to the var *test-out*. By default, this is the same as *out*, but you can rebind it to any PrintWriter. For example, it could be a file opened with clojure.java.io/writer. EXTENDING TEST-IS (ADVANCED) You can extend the behavior of the \"is\" macro by defining new methods for the \"assert-expr\" multimethod. These methods are called during expansion of the \"is\" macro, so they should return quoted forms to be evaluated. You can plug in your own test-reporting framework by rebinding the \"report\" function: (report event) The 'event' argument is a map. It will always have a :type key, whose value will be a keyword signaling the type of event being reported. Standard events with :type value of :pass, :fail, and :error are called when an assertion passes, fails, and throws an exception, respectively. In that case, the event will also have the following keys: :expected The form that was expected to be true :actual A form representing what actually occurred :message The string message given as an argument to 'is' The \"testing\" strings will be a list in \"*testing-contexts*\", and the vars being tested will be a list in \"*testing-vars*\". Your \"report\" function should wrap any printing calls in the \"with-test-out\" macro, which rebinds *out* to the current value of *test-out*. For additional event types, see the examples in the code. "} clojure.test (:require [clojure.template :as temp] [clojure.stacktrace :as stack])) ;; Nothing is marked "private" here, so you can rebind things to plug ;; in your own testing or reporting frameworks. ;;; USER-MODIFIABLE GLOBALS (defonce ^{:doc "True by default. If set to false, no test functions will be created by deftest, set-test, or with-test. Use this to omit tests when compiling or loading production code." :added "1.1"} *load-tests* true) (def ^{:doc "The maximum depth of stack traces to print when an Exception is thrown during a test. Defaults to nil, which means print the complete stack trace." :added "1.1"} *stack-trace-depth* nil) ;;; GLOBALS USED BY THE REPORTING FUNCTIONS (def *report-counters* nil) ; bound to a ref of a map in test-ns (def *initial-report-counters* ; used to initialize *report-counters* {:test 0, :pass 0, :fail 0, :error 0}) (def *testing-vars* (list)) ; bound to hierarchy of vars being tested (def *testing-contexts* (list)) ; bound to hierarchy of "testing" strings (def *test-out* *out*) ; PrintWriter for test reporting output (defmacro with-test-out "Runs body with *out* bound to the value of *test-out*." {:added "1.1"} [& body] `(binding [*out* *test-out*] ~@body)) ;;; UTILITIES FOR REPORTING FUNCTIONS (defn file-position "Returns a vector [filename line-number] for the nth call up the stack. Deprecated in 1.2: The information needed for test reporting is now on :file and :line keys in the result map." {:added "1.1" :deprecated "1.2"} [n] (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)] [(.getFileName s) (.getLineNumber s)])) (defn testing-vars-str "Returns a string representation of the current test. Renders names in *testing-vars* as a list, then the source file and line of current assertion." {:added "1.1"} [m] (let [{:keys [file line]} m] (str ;; Uncomment to include namespace in failure report: ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ " (reverse (map #(:name (meta %)) *testing-vars*)) " (" file ":" line ")"))) (defn testing-contexts-str "Returns a string representation of the current test context. Joins strings in *testing-contexts* with spaces." {:added "1.1"} [] (apply str (interpose " " (reverse *testing-contexts*)))) (defn inc-report-counter "Increments the named counter in *report-counters*, a ref to a map. Does nothing if *report-counters* is nil." {:added "1.1"} [name] (when *report-counters* (dosync (commute *report-counters* assoc name (inc (or (*report-counters* name) 0)))))) ;;; TEST RESULT REPORTING (defmulti ^{:doc "Generic reporting function, may be overridden to plug in different report formats (e.g., TAP, JUnit). Assertions such as 'is' call 'report' to indicate results. The argument given to 'report' will be a map with a :type key. See the documentation at the top of test_is.clj for more information on the types of arguments for 'report'." :dynamic true :added "1.1"} report :type) (defn- file-and-line [exception depth] (let [^StackTraceElement s (nth (.getStackTrace exception) depth)] {:file (.getFileName s) :line (.getLineNumber s)})) (defn do-report "Add file and line information to a test result and call report. If you are writing a custom assert-expr method, call this function to pass test results to report." {:added "1.2"} [m] (report (case (:type m) :fail (merge (file-and-line (new java.lang.Throwable) 1) m) :error (merge (file-and-line (:actual m) 0) m) m))) (defmethod report :default [m] (with-test-out (prn m))) (defmethod report :pass [m] (with-test-out (inc-report-counter :pass))) (defmethod report :fail [m] (with-test-out (inc-report-counter :fail) (println "\nFAIL in" (testing-vars-str m)) (when (seq *testing-contexts*) (println (testing-contexts-str))) (when-let [message (:message m)] (println message)) (println "expected:" (pr-str (:expected m))) (println " actual:" (pr-str (:actual m))))) (defmethod report :error [m] (with-test-out (inc-report-counter :error) (println "\nERROR in" (testing-vars-str m)) (when (seq *testing-contexts*) (println (testing-contexts-str))) (when-let [message (:message m)] (println message)) (println "expected:" (pr-str (:expected m))) (print " actual: ") (let [actual (:actual m)] (if (instance? Throwable actual) (stack/print-cause-trace actual *stack-trace-depth*) (prn actual))))) (defmethod report :summary [m] (with-test-out (println "\nRan" (:test m) "tests containing" (+ (:pass m) (:fail m) (:error m)) "assertions.") (println (:fail m) "failures," (:error m) "errors."))) (defmethod report :begin-test-ns [m] (with-test-out (println "\nTesting" (ns-name (:ns m))))) ;; Ignore these message types: (defmethod report :end-test-ns [m]) (defmethod report :begin-test-var [m]) (defmethod report :end-test-var [m]) ;;; UTILITIES FOR ASSERTIONS (defn get-possibly-unbound-var "Like var-get but returns nil if the var is unbound." {:added "1.1"} [v] (try (var-get v) (catch IllegalStateException e nil))) (defn function? "Returns true if argument is a function or a symbol that resolves to a function (not a macro)." {:added "1.1"} [x] (if (symbol? x) (when-let [v (resolve x)] (when-let [value (get-possibly-unbound-var v)] (and (fn? value) (not (:macro (meta v)))))) (fn? x))) (defn assert-predicate "Returns generic assertion code for any functional predicate. The 'expected' argument to 'report' will contains the original form, the 'actual' argument will contain the form with all its sub-forms evaluated. If the predicate returns false, the 'actual' form will be wrapped in (not...)." {:added "1.1"} [msg form] (let [args (rest form) pred (first form)] `(let [values# (list ~@args) result# (apply ~pred values#)] (if result# (do-report {:type :pass, :message ~msg, :expected '~form, :actual (cons ~pred values#)}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual (list '~'not (cons '~pred values#))})) result#))) (defn assert-any "Returns generic assertion code for any test, including macros, Java method calls, or isolated symbols." {:added "1.1"} [msg form] `(let [value# ~form] (if value# (do-report {:type :pass, :message ~msg, :expected '~form, :actual value#}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual value#})) value#)) ;;; ASSERTION METHODS ;; You don't call these, but you can add methods to extend the 'is' ;; macro. These define different kinds of tests, based on the first ;; symbol in the test expression. (defmulti assert-expr (fn [msg form] (cond (nil? form) :always-fail (seq? form) (first form) :else :default))) (defmethod assert-expr :always-fail [msg form] ;; nil test: always fail `(do-report {:type :fail, :message ~msg})) (defmethod assert-expr :default [msg form] (if (and (sequential? form) (function? (first form))) (assert-predicate msg form) (assert-any msg form))) (defmethod assert-expr 'instance? [msg form] ;; Test if x is an instance of y. `(let [klass# ~(nth form 1) object# ~(nth form 2)] (let [result# (instance? klass# object#)] (if result# (do-report {:type :pass, :message ~msg, :expected '~form, :actual (class object#)}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual (class object#)})) result#))) (defmethod assert-expr 'thrown? [msg form] ;; (is (thrown? c expr)) ;; Asserts that evaluating expr throws an exception of class c. ;; Returns the exception thrown. (let [klass (second form) body (nthnext form 2)] `(try ~@body (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch ~klass e# (do-report {:type :pass, :message ~msg, :expected '~form, :actual e#}) e#)))) (defmethod assert-expr 'thrown-with-msg? [msg form] ;; (is (thrown-with-msg? c re expr)) ;; Asserts that evaluating expr throws an exception of class c. ;; Also asserts that the message string of the exception matches ;; (with re-find) the regular expression re. (let [klass (nth form 1) re (nth form 2) body (nthnext form 3)] `(try ~@body (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch ~klass e# (let [m# (.getMessage e#)] (if (re-find ~re m#) (do-report {:type :pass, :message ~msg, :expected '~form, :actual e#}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual e#}))) e#)))) (defmacro try-expr "Used by the 'is' macro to catch unexpected exceptions. You don't call this." {:added "1.1"} [msg form] `(try ~(assert-expr msg form) (catch Throwable t# (do-report {:type :error, :message ~msg, :expected '~form, :actual t#})))) ;;; ASSERTION MACROS ;; You use these in your tests. (defmacro is "Generic assertion macro. 'form' is any predicate test. 'msg' is an optional message to attach to the assertion. Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\") Special forms: (is (thrown? c body)) checks that an instance of c is thrown from body, fails if not; then returns the thing thrown. (is (thrown-with-msg? c re body)) checks that an instance of c is thrown AND that the message on the exception matches (with re-find) the regular expression re." {:added "1.1"} ([form] `(is ~form nil)) ([form msg] `(try-expr ~msg ~form))) (defmacro are "Checks multiple assertions with a template expression. See clojure.template/do-template for an explanation of templates. Example: (are [x y] (= x y) 2 (+ 1 1) 4 (* 2 2)) Expands to: (do (is (= 2 (+ 1 1))) (is (= 4 (* 2 2)))) Note: This breaks some reporting features, such as line numbers." {:added "1.1"} [argv expr & args] `(temp/do-template ~argv (is ~expr) ~@args)) (defmacro testing "Adds a new string to the list of testing contexts. May be nested, but must occur inside a test function (deftest)." {:added "1.1"} [string & body] `(binding [*testing-contexts* (conj *testing-contexts* ~string)] ~@body)) ;;; DEFINING TESTS (defmacro with-test "Takes any definition form (that returns a Var) as the first argument. Remaining body goes in the :test metadata function for that Var. When *load-tests* is false, only evaluates the definition, ignoring the tests." {:added "1.1"} [definition & body] (if *load-tests* `(doto ~definition (alter-meta! assoc :test (fn [] ~@body))) definition)) (defmacro deftest "Defines a test function with no arguments. Test functions may call other tests, so tests may be composed. If you compose tests, you should also define a function named test-ns-hook; run-tests will call test-ns-hook instead of testing all vars. Note: Actually, the test body goes in the :test metadata on the var, and the real function (the value of the var) calls test-var on itself. When *load-tests* is false, deftest is ignored." {:added "1.1"} [name & body] (when *load-tests* `(def ~(vary-meta name assoc :test `(fn [] ~@body)) (fn [] (test-var (var ~name)))))) (defmacro deftest- "Like deftest but creates a private var." {:added "1.1"} [name & body] (when *load-tests* `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true) (fn [] (test-var (var ~name)))))) (defmacro set-test "Experimental. Sets :test metadata of the named var to a fn with the given body. The var must already exist. Does not modify the value of the var. When *load-tests* is false, set-test is ignored." {:added "1.1"} [name & body] (when *load-tests* `(alter-meta! (var ~name) assoc :test (fn [] ~@body)))) ;;; DEFINING FIXTURES (defn- add-ns-meta "Adds elements in coll to the current namespace metadata as the value of key." {:added "1.1"} [key coll] (alter-meta! *ns* assoc key coll)) (defmulti use-fixtures "Wrap test runs in a fixture function to perform setup and teardown. Using a fixture-type of :each wraps every test individually, while:once wraps the whole run in a single function." {:added "1.1"} (fn [fixture-type & args] fixture-type)) (defmethod use-fixtures :each [fixture-type & args] (add-ns-meta ::each-fixtures args)) (defmethod use-fixtures :once [fixture-type & args] (add-ns-meta ::once-fixtures args)) (defn- default-fixture "The default, empty, fixture function. Just calls its argument." {:added "1.1"} [f] (f)) (defn compose-fixtures "Composes two fixture functions, creating a new fixture function that combines their behavior." {:added "1.1"} [f1 f2] (fn [g] (f1 (fn [] (f2 g))))) (defn join-fixtures "Composes a collection of fixtures, in order. Always returns a valid fixture function, even if the collection is empty." {:added "1.1"} [fixtures] (reduce compose-fixtures default-fixture fixtures)) ;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS (defn test-var "If v has a function in its :test metadata, calls that function, with *testing-vars* bound to (conj *testing-vars* v)." {:dynamic true, :added "1.1"} [v] (when-let [t (:test (meta v))] (binding [*testing-vars* (conj *testing-vars* v)] (do-report {:type :begin-test-var, :var v}) (inc-report-counter :test) (try (t) (catch Throwable e (do-report {:type :error, :message "Uncaught exception, not in assertion." :expected nil, :actual e}))) (do-report {:type :end-test-var, :var v})))) (defn test-all-vars "Calls test-var on every var interned in the namespace, with fixtures." {:added "1.1"} [ns] (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns))) each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))] (once-fixture-fn (fn [] (doseq [v (vals (ns-interns ns))] (when (:test (meta v)) (each-fixture-fn (fn [] (test-var v))))))))) (defn test-ns "If the namespace defines a function named test-ns-hook, calls that. Otherwise, calls test-all-vars on the namespace. 'ns' is a namespace object or a symbol. Internally binds *report-counters* to a ref initialized to *inital-report-counters*. Returns the final, dereferenced state of *report-counters*." {:added "1.1"} [ns] (binding [*report-counters* (ref *initial-report-counters*)] (let [ns-obj (the-ns ns)] (do-report {:type :begin-test-ns, :ns ns-obj}) ;; If the namespace has a test-ns-hook function, call that: (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))] ((var-get v)) ;; Otherwise, just test every var in the namespace. (test-all-vars ns-obj)) (do-report {:type :end-test-ns, :ns ns-obj})) @*report-counters*)) ;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS (defn run-tests "Runs all tests in the given namespaces; prints results. Defaults to current namespace if none given. Returns a map summarizing test results." {:added "1.1"} ([] (run-tests *ns*)) ([& namespaces] (let [summary (assoc (apply merge-with + (map test-ns namespaces)) :type :summary)] (do-report summary) summary))) (defn run-all-tests "Runs all tests in all namespaces; prints results. Optional argument is a regular expression; only namespaces with names matching the regular expression (with re-matches) will be tested." {:added "1.1"} ([] (apply run-tests (all-ns))) ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns))))) (defn successful? "Returns true if the given test summary indicates all tests were successful, false otherwise." {:added "1.1"} [summary] (and (zero? (:fail summary 0)) (zero? (:error summary 0)))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/test/000077500000000000000000000000001157562347600213405ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/test/junit.clj000066400000000000000000000123771157562347600231750ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; test/junit.clj: Extension to clojure.test for JUnit-compatible XML output ;; by Jason Sankey ;; June 2009 ;; DOCUMENTATION ;; (ns ^{:doc "clojure.test extension for JUnit-compatible XML output. JUnit (http://junit.org/) is the most popular unit-testing library for Java. As such, tool support for JUnit output formats is common. By producing compatible output from tests, this tool support can be exploited. To use, wrap any calls to clojure.test/run-tests in the with-junit-output macro, like this: (use 'clojure.test) (use 'clojure.test.junit) (with-junit-output (run-tests 'my.cool.library)) To write the output to a file, rebind clojure.test/*test-out* to your own PrintWriter (perhaps opened using clojure.java.io/writer)." :author "Jason Sankey"} clojure.test.junit (:require [clojure.stacktrace :as stack] [clojure.test :as t])) ;; copied from clojure.contrib.lazy-xml (def ^{:private true} escape-xml-map (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp]))) (defn- escape-xml [text] (apply str (map #(escape-xml-map % %) text))) (def *var-context*) (def *depth*) (defn indent [] (dotimes [n (* *depth* 4)] (print " "))) (defn start-element [tag pretty & [attrs]] (if pretty (indent)) (print (str "<" tag)) (if (seq attrs) (doseq [[key value] attrs] (print (str " " (name key) "=\"" (escape-xml value) "\"")))) (print ">") (if pretty (println)) (set! *depth* (inc *depth*))) (defn element-content [content] (print (escape-xml content))) (defn finish-element [tag pretty] (set! *depth* (dec *depth*)) (if pretty (indent)) (print (str "")) (if pretty (println))) (defn test-name [vars] (apply str (interpose "." (reverse (map #(:name (meta %)) vars))))) (defn package-class [name] (let [i (.lastIndexOf name ".")] (if (< i 0) [nil name] [(.substring name 0 i) (.substring name (+ i 1))]))) (defn start-case [name classname] (start-element 'testcase true {:name name :classname classname})) (defn finish-case [] (finish-element 'testcase true)) (defn suite-attrs [package classname] (let [attrs {:name classname}] (if package (assoc attrs :package package) attrs))) (defn start-suite [name] (let [[package classname] (package-class name)] (start-element 'testsuite true (suite-attrs package classname)))) (defn finish-suite [] (finish-element 'testsuite true)) (defn message-el [tag message expected-str actual-str] (indent) (start-element tag false (if message {:message message} {})) (element-content (let [[file line] (t/file-position 5) detail (apply str (interpose "\n" [(str "expected: " expected-str) (str " actual: " actual-str) (str " at: " file ":" line)]))] (if message (str message "\n" detail) detail))) (finish-element tag false) (println)) (defn failure-el [message expected actual] (message-el 'failure message (pr-str expected) (pr-str actual))) (defn error-el [message expected actual] (message-el 'error message (pr-str expected) (if (instance? Throwable actual) (with-out-str (stack/print-cause-trace actual t/*stack-trace-depth*)) (prn actual)))) ;; This multimethod will override test-is/report (defmulti junit-report :type) (defmethod junit-report :begin-test-ns [m] (t/with-test-out (start-suite (name (ns-name (:ns m)))))) (defmethod junit-report :end-test-ns [_] (t/with-test-out (finish-suite))) (defmethod junit-report :begin-test-var [m] (t/with-test-out (let [var (:var m)] (binding [*var-context* (conj *var-context* var)] (start-case (test-name *var-context*) (name (ns-name (:ns (meta var))))))))) (defmethod junit-report :end-test-var [m] (t/with-test-out (finish-case))) (defmethod junit-report :pass [m] (t/with-test-out (t/inc-report-counter :pass))) (defmethod junit-report :fail [m] (t/with-test-out (t/inc-report-counter :fail) (failure-el (:message m) (:expected m) (:actual m)))) (defmethod junit-report :error [m] (t/with-test-out (t/inc-report-counter :error) (error-el (:message m) (:expected m) (:actual m)))) (defmethod junit-report :default [_]) (defmacro with-junit-output "Execute body with modified test-is reporting functions that write JUnit-compatible XML output." {:added "1.1"} [& body] `(binding [t/report junit-report *var-context* (list) *depth* 1] (println "") (println "") (let [result# ~@body] (println "") result#))) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/test/tap.clj000066400000000000000000000067011157562347600226220ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; test_is/tap.clj: Extension to test for TAP output ;; by Stuart Sierra ;; March 31, 2009 ;; Inspired by ClojureCheck by Meikel Brandmeyer: ;; http://kotka.de/projects/clojure/clojurecheck.html ;; DOCUMENTATION ;; (ns ^{:doc "clojure.test extensions for the Test Anything Protocol (TAP) TAP is a simple text-based syntax for reporting test results. TAP was originally develped for Perl, and now has implementations in several languages. For more information on TAP, see http://testanything.org/ and http://search.cpan.org/~petdance/TAP-1.0.0/TAP.pm To use this library, wrap any calls to clojure.test/run-tests in the with-tap-output macro, like this: (use 'clojure.test) (use 'clojure.test.tap) (with-tap-output (run-tests 'my.cool.library))" :author "Stuart Sierra"} clojure.test.tap (:require [clojure.test :as t] [clojure.stacktrace :as stack])) (defn print-tap-plan "Prints a TAP plan line like '1..n'. n is the number of tests" {:added "1.1"} [n] (println (str "1.." n))) (defn print-tap-diagnostic "Prints a TAP diagnostic line. data is a (possibly multi-line) string." {:added "1.1"} [data] (doseq [line (.split ^String data "\n")] (println "#" line))) (defn print-tap-pass "Prints a TAP 'ok' line. msg is a string, with no line breaks" {:added "1.1"} [msg] (println "ok" msg)) (defn print-tap-fail "Prints a TAP 'not ok' line. msg is a string, with no line breaks" {:added "1.1"} [msg] (println "not ok" msg)) ;; This multimethod will override test/report (defmulti tap-report (fn [data] (:type data))) (defmethod tap-report :default [data] (t/with-test-out (print-tap-diagnostic (pr-str data)))) (defmethod tap-report :pass [data] (t/with-test-out (t/inc-report-counter :pass) (print-tap-pass (t/testing-vars-str)) (when (seq t/*testing-contexts*) (print-tap-diagnostic (t/testing-contexts-str))) (when (:message data) (print-tap-diagnostic (:message data))) (print-tap-diagnostic (str "expected:" (pr-str (:expected data)))) (print-tap-diagnostic (str " actual:" (pr-str (:actual data)))))) (defmethod tap-report :error [data] (t/with-test-out (t/inc-report-counter :error) (print-tap-fail (t/testing-vars-str)) (when (seq t/*testing-contexts*) (print-tap-diagnostic (t/testing-contexts-str))) (when (:message data) (print-tap-diagnostic (:message data))) (print-tap-diagnostic "expected:" (pr-str (:expected data))) (print-tap-diagnostic " actual: ") (print-tap-diagnostic (with-out-str (if (instance? Throwable (:actual data)) (stack/print-cause-trace (:actual data) t/*stack-trace-depth*) (prn (:actual data))))))) (defmethod tap-report :summary [data] (t/with-test-out (print-tap-plan (+ (:pass data) (:fail data) (:error data))))) (defmacro with-tap-output "Execute body with modified test reporting functions that produce TAP output" {:added "1.1"} [& body] `(binding [t/report tap-report] ~@body)) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/version.properties000066400000000000000000000002071157562347600241630ustar00rootroot00000000000000clojure.version.major=1 clojure.version.minor=2 clojure.version.incremental=1 clojure.version.qualifier= clojure.version.interim=false clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/walk.clj000066400000000000000000000104631157562347600220150ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; walk.clj - generic tree walker with replacement ;; by Stuart Sierra ;; December 15, 2008 ;; CHANGE LOG: ;; ;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk' ;; ;; * December 9, 2008: first version (ns ^{:author "Stuart Sierra", :doc "This file defines a generic tree walker for Clojure data structures. It takes any data structure (list, vector, map, set, seq), calls a function on every element, and uses the return value of the function in place of the original. This makes it fairly easy to write recursive search-and-replace functions, as shown in the examples. Note: \"walk\" supports all Clojure data structures EXCEPT maps created with sorted-map-by. There is no (obvious) way to retrieve the sorting function."} clojure.walk) (defn walk "Traverses form, an arbitrary data structure. inner and outer are functions. Applies inner to each element of form, building up a data structure of the same type, then applies outer to the result. Recognizes all Clojure data structures except sorted-map-by. Consumes seqs as with doall." {:added "1.1"} [inner outer form] (cond (list? form) (outer (apply list (map inner form))) (seq? form) (outer (doall (map inner form))) (vector? form) (outer (vec (map inner form))) (map? form) (outer (into (if (sorted? form) (sorted-map) {}) (map inner form))) (set? form) (outer (into (if (sorted? form) (sorted-set) #{}) (map inner form))) :else (outer form))) (defn postwalk "Performs a depth-first, post-order traversal of form. Calls f on each sub-form, uses f's return value in place of the original. Recognizes all Clojure data structures except sorted-map-by. Consumes seqs as with doall." {:added "1.1"} [f form] (walk (partial postwalk f) f form)) (defn prewalk "Like postwalk, but does pre-order traversal." {:added "1.1"} [f form] (walk (partial prewalk f) identity (f form))) ;; Note: I wanted to write: ;; ;; (defn walk ;; [f form] ;; (let [pf (partial walk f)] ;; (if (coll? form) ;; (f (into (empty form) (map pf form))) ;; (f form)))) ;; ;; but this throws a ClassCastException when applied to a map. (defn postwalk-demo "Demonstrates the behavior of postwalk by printing each form as it is walked. Returns form." {:added "1.1"} [form] (postwalk (fn [x] (print "Walked: ") (prn x) x) form)) (defn prewalk-demo "Demonstrates the behavior of prewalk by printing each form as it is walked. Returns form." {:added "1.1"} [form] (prewalk (fn [x] (print "Walked: ") (prn x) x) form)) (defn keywordize-keys "Recursively transforms all map keys from strings to keywords." {:added "1.1"} [m] (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))] ;; only apply to maps (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) (defn stringify-keys "Recursively transforms all map keys from keywords to strings." {:added "1.1"} [m] (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))] ;; only apply to maps (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) (defn prewalk-replace "Recursively transforms form by replacing keys in smap with their values. Like clojure/replace but works on any data structure. Does replacement at the root of the tree first." {:added "1.1"} [smap form] (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form)) (defn postwalk-replace "Recursively transforms form by replacing keys in smap with their values. Like clojure/replace but works on any data structure. Does replacement at the leaves of the tree first." {:added "1.1"} [smap form] (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form)) (defn macroexpand-all "Recursively performs all possible macroexpansions in form." {:added "1.1"} [form] (prewalk (fn [x] (if (seq? x) (macroexpand x) x)) form)) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/xml.clj000066400000000000000000000105521157562347600216560ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "XML reading/writing." :author "Rich Hickey"} clojure.xml (:import (org.xml.sax ContentHandler Attributes SAXException) (javax.xml.parsers SAXParser SAXParserFactory))) (def *stack*) (def *current*) (def *state*) ; :element :chars :between (def *sb*) (defstruct element :tag :attrs :content) (def tag (accessor element :tag)) (def attrs (accessor element :attrs)) (def content (accessor element :content)) (def content-handler (let [push-content (fn [e c] (assoc e :content (conj (or (:content e) []) c))) push-chars (fn [] (when (and (= *state* :chars) (some (complement #(Character/isWhitespace (char %))) (str *sb*))) (set! *current* (push-content *current* (str *sb*)))))] (new clojure.lang.XMLHandler (proxy [ContentHandler] [] (startElement [uri local-name q-name ^Attributes atts] (let [attrs (fn [ret i] (if (neg? i) ret (recur (assoc ret (clojure.lang.Keyword/intern (symbol (.getQName atts i))) (.getValue atts (int i))) (dec i)))) e (struct element (. clojure.lang.Keyword (intern (symbol q-name))) (when (pos? (.getLength atts)) (attrs {} (dec (.getLength atts)))))] (push-chars) (set! *stack* (conj *stack* *current*)) (set! *current* e) (set! *state* :element)) nil) (endElement [uri local-name q-name] (push-chars) (set! *current* (push-content (peek *stack*) *current*)) (set! *stack* (pop *stack*)) (set! *state* :between) nil) (characters [^chars ch start length] (when-not (= *state* :chars) (set! *sb* (new StringBuilder))) (let [^StringBuilder sb *sb*] (.append sb ch (int start) (int length)) (set! *state* :chars)) nil) (setDocumentLocator [locator]) (startDocument []) (endDocument []) (startPrefixMapping [prefix uri]) (endPrefixMapping [prefix]) (ignorableWhitespace [ch start length]) (processingInstruction [target data]) (skippedEntity [name]) )))) (defn startparse-sax [s ch] (.. SAXParserFactory (newInstance) (newSAXParser) (parse s ch))) (defn parse "Parses and loads the source s, which can be a File, InputStream or String naming a URI. Returns a tree of the xml/element struct-map, which has the keys :tag, :attrs, and :content. and accessor fns tag, attrs, and content. Other parsers can be supplied by passing startparse, a fn taking a source and a ContentHandler and returning a parser" {:added "1.0"} ([s] (parse s startparse-sax)) ([s startparse] (binding [*stack* nil *current* (struct element) *state* :between *sb* nil] (startparse s content-handler) ((:content *current*) 0)))) (defn emit-element [e] (if (instance? String e) (println e) (do (print (str "<" (name (:tag e)))) (when (:attrs e) (doseq [attr (:attrs e)] (print (str " " (name (key attr)) "='" (val attr)"'")))) (if (:content e) (do (println ">") (doseq [c (:content e)] (emit-element c)) (println (str ""))) (println "/>"))))) (defn emit [x] (println "") (emit-element x)) ;(export '(tag attrs content parse element emit emit-element)) ;(load-file "/Users/rich/dev/clojure/src/xml.clj") ;(def x (xml/parse "http://arstechnica.com/journals.rssx")) clojure1.2_1.2.1+dfsg.orig/src/clj/clojure/zip.clj000066400000000000000000000225031157562347600216570ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;functional hierarchical zipper, with navigation, editing and enumeration ;see Huet (ns ^{:doc "Functional hierarchical zipper, with navigation, editing, and enumeration. See Huet" :author "Rich Hickey"} clojure.zip (:refer-clojure :exclude (replace remove next))) (defn zipper "Creates a new zipper structure. branch? is a fn that, given a node, returns true if can have children, even if it currently doesn't. children is a fn that, given a branch node, returns a seq of its children. make-node is a fn that, given an existing node and a seq of children, returns a new branch node with the supplied children. root is the root node." {:added "1.0"} [branch? children make-node root] ^{:zip/branch? branch? :zip/children children :zip/make-node make-node} [root nil]) (defn seq-zip "Returns a zipper for nested sequences, given a root sequence" {:added "1.0"} [root] (zipper seq? identity (fn [node children] (with-meta children (meta node))) root)) (defn vector-zip "Returns a zipper for nested vectors, given a root vector" {:added "1.0"} [root] (zipper vector? seq (fn [node children] (with-meta (vec children) (meta node))) root)) (defn xml-zip "Returns a zipper for xml elements (as from xml/parse), given a root element" {:added "1.0"} [root] (zipper (complement string?) (comp seq :content) (fn [node children] (assoc node :content (and children (apply vector children)))) root)) (defn node "Returns the node at loc" {:added "1.0"} [loc] (loc 0)) (defn branch? "Returns true if the node at loc is a branch" {:added "1.0"} [loc] ((:zip/branch? (meta loc)) (node loc))) (defn children "Returns a seq of the children of node at loc, which must be a branch" {:added "1.0"} [loc] (if (branch? loc) ((:zip/children (meta loc)) (node loc)) (throw (Exception. "called children on a leaf node")))) (defn make-node "Returns a new branch node, given an existing node and new children. The loc is only used to supply the constructor." {:added "1.0"} [loc node children] ((:zip/make-node (meta loc)) node children)) (defn path "Returns a seq of nodes leading to this loc" {:added "1.0"} [loc] (:pnodes (loc 1))) (defn lefts "Returns a seq of the left siblings of this loc" {:added "1.0"} [loc] (seq (:l (loc 1)))) (defn rights "Returns a seq of the right siblings of this loc" {:added "1.0"} [loc] (:r (loc 1))) (defn down "Returns the loc of the leftmost child of the node at this loc, or nil if no children" {:added "1.0"} [loc] (when (branch? loc) (let [[node path] loc [c & cnext :as cs] (children loc)] (when cs (with-meta [c {:l [] :pnodes (if path (conj (:pnodes path) node) [node]) :ppath path :r cnext}] (meta loc)))))) (defn up "Returns the loc of the parent of the node at this loc, or nil if at the top" {:added "1.0"} [loc] (let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc] (when pnodes (let [pnode (peek pnodes)] (with-meta (if changed? [(make-node loc pnode (concat l (cons node r))) (and ppath (assoc ppath :changed? true))] [pnode ppath]) (meta loc)))))) (defn root "zips all the way up and returns the root node, reflecting any changes." {:added "1.0"} [loc] (if (= :end (loc 1)) (node loc) (let [p (up loc)] (if p (recur p) (node loc))))) (defn right "Returns the loc of the right sibling of the node at this loc, or nil" {:added "1.0"} [loc] (let [[node {l :l [r & rnext :as rs] :r :as path}] loc] (when (and path rs) (with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc))))) (defn rightmost "Returns the loc of the rightmost sibling of the node at this loc, or self" {:added "1.0"} [loc] (let [[node {l :l r :r :as path}] loc] (if (and path r) (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc)) loc))) (defn left "Returns the loc of the left sibling of the node at this loc, or nil" {:added "1.0"} [loc] (let [[node {l :l r :r :as path}] loc] (when (and path (seq l)) (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc))))) (defn leftmost "Returns the loc of the leftmost sibling of the node at this loc, or self" {:added "1.0"} [loc] (let [[node {l :l r :r :as path}] loc] (if (and path (seq l)) (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc)) loc))) (defn insert-left "Inserts the item as the left sibling of the node at this loc, without moving" {:added "1.0"} [loc item] (let [[node {l :l :as path}] loc] (if (nil? path) (throw (new Exception "Insert at top")) (with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc))))) (defn insert-right "Inserts the item as the right sibling of the node at this loc, without moving" {:added "1.0"} [loc item] (let [[node {r :r :as path}] loc] (if (nil? path) (throw (new Exception "Insert at top")) (with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc))))) (defn replace "Replaces the node at this loc, without moving" {:added "1.0"} [loc node] (let [[_ path] loc] (with-meta [node (assoc path :changed? true)] (meta loc)))) (defn edit "Replaces the node at this loc with the value of (f node args)" {:added "1.0"} [loc f & args] (replace loc (apply f (node loc) args))) (defn insert-child "Inserts the item as the leftmost child of the node at this loc, without moving" {:added "1.0"} [loc item] (replace loc (make-node loc (node loc) (cons item (children loc))))) (defn append-child "Inserts the item as the rightmost child of the node at this loc, without moving" {:added "1.0"} [loc item] (replace loc (make-node loc (node loc) (concat (children loc) [item])))) (defn next "Moves to the next loc in the hierarchy, depth-first. When reaching the end, returns a distinguished loc detectable via end?. If already at the end, stays there." {:added "1.0"} [loc] (if (= :end (loc 1)) loc (or (and (branch? loc) (down loc)) (right loc) (loop [p loc] (if (up p) (or (right (up p)) (recur (up p))) [(node p) :end]))))) (defn prev "Moves to the previous loc in the hierarchy, depth-first. If already at the root, returns nil." {:added "1.0"} [loc] (if-let [lloc (left loc)] (loop [loc lloc] (if-let [child (and (branch? loc) (down loc))] (recur (rightmost child)) loc)) (up loc))) (defn end? "Returns true if loc represents the end of a depth-first walk" {:added "1.0"} [loc] (= :end (loc 1))) (defn remove "Removes the node at loc, returning the loc that would have preceded it in a depth-first walk." {:added "1.0"} [loc] (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc] (if (nil? path) (throw (new Exception "Remove at top")) (if (pos? (count l)) (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))] (if-let [child (and (branch? loc) (down loc))] (recur (rightmost child)) loc)) (with-meta [(make-node loc (peek pnodes) rs) (and ppath (assoc ppath :changed? true))] (meta loc)))))) (comment (load-file "/Users/rich/dev/clojure/src/zip.clj") (refer 'zip) (def data '[[a * b] + [c * d]]) (def dz (vector-zip data)) (right (down (right (right (down dz))))) (lefts (right (down (right (right (down dz)))))) (rights (right (down (right (right (down dz)))))) (up (up (right (down (right (right (down dz))))))) (path (right (down (right (right (down dz)))))) (-> dz down right right down right) (-> dz down right right down right (replace '/) root) (-> dz next next (edit str) next next next (replace '/) root) (-> dz next next next next next next next next next remove root) (-> dz next next next next next next next next next remove (insert-right 'e) root) (-> dz next next next next next next next next next remove up (append-child 'e) root) (end? (-> dz next next next next next next next next next remove next)) (-> dz next remove next remove root) (loop [loc dz] (if (end? loc) (root loc) (recur (next (if (= '* (node loc)) (replace loc '/) loc))))) (loop [loc dz] (if (end? loc) (root loc) (recur (next (if (= '* (node loc)) (remove loc) loc))))) ) clojure1.2_1.2.1+dfsg.orig/src/jvm/000077500000000000000000000000001157562347600167425ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/000077500000000000000000000000001157562347600204055ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/000077500000000000000000000000001157562347600213265ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/AFn.java000066400000000000000000000407101157562347600226370ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 25, 2006 4:05:37 PM */ package clojure.lang; public abstract class AFn implements IFn { public Object call() throws Exception{ return invoke(); } public void run(){ try { invoke(); } catch(Exception e) { throw new RuntimeException(e); } } public Object invoke() throws Exception{ return throwArity(0); } public Object invoke(Object arg1) throws Exception{ return throwArity(1); } public Object invoke(Object arg1, Object arg2) throws Exception{ return throwArity(2); } public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ return throwArity(3); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ return throwArity(4); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ return throwArity(5); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ return throwArity(6); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception{ return throwArity(7); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception{ return throwArity(8); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception{ return throwArity(9); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception{ return throwArity(10); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ return throwArity(11); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ return throwArity(12); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ return throwArity(13); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception{ return throwArity(14); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception{ return throwArity(15); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception{ return throwArity(16); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception{ return throwArity(17); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ return throwArity(18); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ return throwArity(19); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception{ return throwArity(20); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception{ return throwArity(21); } public Object applyTo(ISeq arglist) throws Exception{ return applyToHelper(this, Util.ret1(arglist,arglist = null)); } static public Object applyToHelper(IFn ifn, ISeq arglist) throws Exception{ switch(RT.boundedLength(arglist, 20)) { case 0: arglist = null; return ifn.invoke(); case 1: return ifn.invoke(Util.ret1(arglist.first(),arglist = null)); case 2: return ifn.invoke(arglist.first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 3: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 4: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 5: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 6: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 7: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 8: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 9: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 10: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 11: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 12: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 13: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 14: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 15: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 16: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 17: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 18: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 19: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); case 20: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , Util.ret1((arglist = arglist.next()).first(),arglist = null) ); default: return ifn.invoke(arglist.first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , (arglist = arglist.next()).first() , RT.seqToArray(Util.ret1(arglist.next(),arglist = null))); } } public Object throwArity(int n){ String name = getClass().getSimpleName(); int suffix = name.lastIndexOf("__"); throw new IllegalArgumentException("Wrong number of args (" + n + ") passed to: " + (suffix == -1 ? name : name.substring(0, suffix)).replace('_', '-')); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/AFunction.java000066400000000000000000000020401157562347600240530ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 16, 2008 */ package clojure.lang; import java.io.Serializable; import java.util.Comparator; public abstract class AFunction extends AFn implements IObj, Comparator, Fn, Serializable { public volatile MethodImplCache __methodImplCache; public int compare(Object o1, Object o2){ try { Object o = invoke(o1, o2); if(o instanceof Boolean) { if(RT.booleanCast(o)) return -1; return RT.booleanCast(invoke(o2,o1))? 1 : 0; } Number n = (Number) o; return n.intValue(); } catch(Exception e) { throw new RuntimeException(e); } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/AMapEntry.java000066400000000000000000000055151157562347600240370ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 1, 2008 */ package clojure.lang; import java.io.StringWriter; public abstract class AMapEntry extends APersistentVector implements IMapEntry{ public Object nth(int i){ if(i == 0) return key(); else if(i == 1) return val(); else throw new IndexOutOfBoundsException(); } private IPersistentVector asVector(){ return LazilyPersistentVector.createOwning(key(), val()); } public IPersistentVector assocN(int i, Object val){ return asVector().assocN(i, val); } public int count(){ return 2; } public ISeq seq(){ return asVector().seq(); } public IPersistentVector cons(Object o){ return asVector().cons(o); } public IPersistentCollection empty(){ return null; } public IPersistentStack pop(){ return LazilyPersistentVector.createOwning(key()); } public Object setValue(Object value){ throw new UnsupportedOperationException(); } /* public boolean equals(Object obj){ return APersistentVector.doEquals(this, obj); } public int hashCode(){ //must match logic in APersistentVector return 31 * (31 + Util.hash(key())) + Util.hash(val()); // return Util.hashCombine(Util.hashCombine(0, Util.hash(key())), Util.hash(val())); } public String toString(){ StringWriter sw = new StringWriter(); try { RT.print(this, sw); } catch(Exception e) { //checked exceptions stink! throw new RuntimeException(e); } return sw.toString(); } public int length(){ return 2; } public Object nth(int i){ if(i == 0) return key(); else if(i == 1) return val(); else throw new IndexOutOfBoundsException(); } private IPersistentVector asVector(){ return LazilyPersistentVector.createOwning(key(), val()); } public IPersistentVector assocN(int i, Object val){ return asVector().assocN(i, val); } public int count(){ return 2; } public ISeq seq(){ return asVector().seq(); } public IPersistentVector cons(Object o){ return asVector().cons(o); } public boolean containsKey(Object key){ return asVector().containsKey(key); } public IMapEntry entryAt(Object key){ return asVector().entryAt(key); } public Associative assoc(Object key, Object val){ return asVector().assoc(key, val); } public Object valAt(Object key){ return asVector().valAt(key); } public Object valAt(Object key, Object notFound){ return asVector().valAt(key, notFound); } public Object peek(){ return val(); } public ISeq rseq() throws Exception{ return asVector().rseq(); } */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/APersistentMap.java000066400000000000000000000167561157562347600251070ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.Serializable; import java.util.*; public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence { int _hash = -1; public String toString(){ return RT.printString(this); } public IPersistentCollection cons(Object o){ if(o instanceof Map.Entry) { Map.Entry e = (Map.Entry) o; return assoc(e.getKey(), e.getValue()); } else if(o instanceof IPersistentVector) { IPersistentVector v = (IPersistentVector) o; if(v.count() != 2) throw new IllegalArgumentException("Vector arg to map conj must be a pair"); return assoc(v.nth(0), v.nth(1)); } IPersistentMap ret = this; for(ISeq es = RT.seq(o); es != null; es = es.next()) { Map.Entry e = (Map.Entry) es.first(); ret = ret.assoc(e.getKey(), e.getValue()); } return ret; } public boolean equals(Object obj){ return mapEquals(this, obj); } static public boolean mapEquals(IPersistentMap m1, Object obj){ if(m1 == obj) return true; if(!(obj instanceof Map)) return false; Map m = (Map) obj; if(m.size() != m1.count() || m.hashCode() != m1.hashCode()) return false; for(ISeq s = m1.seq(); s != null; s = s.next()) { Map.Entry e = (Map.Entry) s.first(); boolean found = m.containsKey(e.getKey()); if(!found || !Util.equals(e.getValue(), m.get(e.getKey()))) return false; } return true; } public boolean equiv(Object obj){ if(!(obj instanceof Map)) return false; if(obj instanceof IPersistentMap && !(obj instanceof MapEquivalence)) return false; Map m = (Map) obj; if(m.size() != size()) return false; for(ISeq s = seq(); s != null; s = s.next()) { Map.Entry e = (Map.Entry) s.first(); boolean found = m.containsKey(e.getKey()); if(!found || !Util.equiv(e.getValue(), m.get(e.getKey()))) return false; } return true; } public int hashCode(){ if(_hash == -1) { this._hash = mapHash(this); } return _hash; } static public int mapHash(IPersistentMap m){ int hash = 0; for(ISeq s = m.seq(); s != null; s = s.next()) { Map.Entry e = (Map.Entry) s.first(); hash += (e.getKey() == null ? 0 : e.getKey().hashCode()) ^ (e.getValue() == null ? 0 : e.getValue().hashCode()); } return hash; } static public class KeySeq extends ASeq{ ISeq seq; static public KeySeq create(ISeq seq){ if(seq == null) return null; return new KeySeq(seq); } private KeySeq(ISeq seq){ this.seq = seq; } private KeySeq(IPersistentMap meta, ISeq seq){ super(meta); this.seq = seq; } public Object first(){ return ((Map.Entry) seq.first()).getKey(); } public ISeq next(){ return create(seq.next()); } public KeySeq withMeta(IPersistentMap meta){ return new KeySeq(meta, seq); } } static public class ValSeq extends ASeq{ ISeq seq; static public ValSeq create(ISeq seq){ if(seq == null) return null; return new ValSeq(seq); } private ValSeq(ISeq seq){ this.seq = seq; } private ValSeq(IPersistentMap meta, ISeq seq){ super(meta); this.seq = seq; } public Object first(){ return ((Map.Entry) seq.first()).getValue(); } public ISeq next(){ return create(seq.next()); } public ValSeq withMeta(IPersistentMap meta){ return new ValSeq(meta, seq); } } public Object invoke(Object arg1) throws Exception{ return valAt(arg1); } public Object invoke(Object arg1, Object notFound) throws Exception{ return valAt(arg1, notFound); } // java.util.Map implementation public void clear(){ throw new UnsupportedOperationException(); } public boolean containsValue(Object value){ return values().contains(value); } public Set entrySet(){ return new AbstractSet(){ public Iterator iterator(){ return APersistentMap.this.iterator(); } public int size(){ return count(); } public int hashCode(){ return APersistentMap.this.hashCode(); } public boolean contains(Object o){ if(o instanceof Entry) { Entry e = (Entry) o; Entry found = entryAt(e.getKey()); if(found != null && Util.equals(found.getValue(), e.getValue())) return true; } return false; } }; } public Object get(Object key){ return valAt(key); } public boolean isEmpty(){ return count() == 0; } public Set keySet(){ return new AbstractSet(){ public Iterator iterator(){ final Iterator mi = APersistentMap.this.iterator(); return new Iterator(){ public boolean hasNext(){ return mi.hasNext(); } public Object next(){ Entry e = (Entry) mi.next(); return e.getKey(); } public void remove(){ throw new UnsupportedOperationException(); } }; } public int size(){ return count(); } public boolean contains(Object o){ return APersistentMap.this.containsKey(o); } }; } public Object put(Object key, Object value){ throw new UnsupportedOperationException(); } public void putAll(Map t){ throw new UnsupportedOperationException(); } public Object remove(Object key){ throw new UnsupportedOperationException(); } public int size(){ return count(); } public Collection values(){ return new AbstractCollection(){ public Iterator iterator(){ final Iterator mi = APersistentMap.this.iterator(); return new Iterator(){ public boolean hasNext(){ return mi.hasNext(); } public Object next(){ Entry e = (Entry) mi.next(); return e.getValue(); } public void remove(){ throw new UnsupportedOperationException(); } }; } public int size(){ return count(); } }; } /* // java.util.Collection implementation public Object[] toArray(){ return RT.seqToArray(seq()); } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection c){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection c){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection c){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection c){ for(Object o : c) { if(!contains(o)) return false; } return true; } public Object[] toArray(Object[] a){ if(a.length >= count()) { ISeq s = seq(); for(int i = 0; s != null; ++i, s = s.rest()) { a[i] = s.first(); } if(a.length > count()) a[count()] = null; return a; } else return toArray(); } public int size(){ return count(); } public boolean isEmpty(){ return count() == 0; } public boolean contains(Object o){ if(o instanceof Map.Entry) { Map.Entry e = (Map.Entry) o; Map.Entry v = entryAt(e.getKey()); return (v != null && Util.equal(v.getValue(), e.getValue())); } return false; } */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/APersistentSet.java000066400000000000000000000057101157562347600251110ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; import java.io.Serializable; import java.util.Collection; import java.util.Iterator; import java.util.Set; public abstract class APersistentSet extends AFn implements IPersistentSet, Collection, Set, Serializable { int _hash = -1; final IPersistentMap impl; protected APersistentSet(IPersistentMap impl){ this.impl = impl; } public String toString(){ return RT.printString(this); } public boolean contains(Object key){ return impl.containsKey(key); } public Object get(Object key){ return impl.valAt(key); } public int count(){ return impl.count(); } public ISeq seq(){ return RT.keys(impl); } public Object invoke(Object arg1) throws Exception{ return get(arg1); } public boolean equals(Object obj){ if(this == obj) return true; if(!(obj instanceof Set)) return false; Set m = (Set) obj; if(m.size() != count() || m.hashCode() != hashCode()) return false; for(Object aM : m) { if(!contains(aM)) return false; } // for(ISeq s = seq(); s != null; s = s.rest()) // { // if(!m.contains(s.first())) // return false; // } return true; } public boolean equiv(Object o){ return equals(o); } public int hashCode(){ if(_hash == -1) { //int hash = count(); int hash = 0; for(ISeq s = seq(); s != null; s = s.next()) { Object e = s.first(); // hash = Util.hashCombine(hash, Util.hash(e)); hash += Util.hash(e); } this._hash = hash; } return _hash; } public Object[] toArray(){ return RT.seqToArray(seq()); } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection c){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection c){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection c){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection c){ for(Object o : c) { if(!contains(o)) return false; } return true; } public Object[] toArray(Object[] a){ if(a.length >= count()) { ISeq s = seq(); for(int i = 0; s != null; ++i, s = s.next()) { a[i] = s.first(); } if(a.length > count()) a[count()] = null; return a; } else return toArray(); } public int size(){ return count(); } public boolean isEmpty(){ return count() == 0; } public Iterator iterator(){ return new SeqIterator(seq()); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/APersistentVector.java000066400000000000000000000257601157562347600256270ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 18, 2007 */ package clojure.lang; import java.io.Serializable; import java.util.*; public abstract class APersistentVector extends AFn implements IPersistentVector, Iterable, List, RandomAccess, Comparable, Serializable { int _hash = -1; public String toString(){ return RT.printString(this); } public ISeq seq(){ if(count() > 0) return new Seq(this, 0); return null; } public ISeq rseq(){ if(count() > 0) return new RSeq(this, count() - 1); return null; } static boolean doEquals(IPersistentVector v, Object obj){ if(v == obj) return true; if(obj instanceof List || obj instanceof IPersistentVector) { Collection ma = (Collection) obj; if(ma.size() != v.count() || ma.hashCode() != v.hashCode()) return false; for(Iterator i1 = ((List) v).iterator(), i2 = ma.iterator(); i1.hasNext();) { if(!Util.equals(i1.next(), i2.next())) return false; } return true; } // if(obj instanceof IPersistentVector) // { // IPersistentVector ma = (IPersistentVector) obj; // if(ma.count() != v.count() || ma.hashCode() != v.hashCode()) // return false; // for(int i = 0; i < v.count(); i++) // { // if(!Util.equal(v.nth(i), ma.nth(i))) // return false; // } // } else { if(!(obj instanceof Sequential)) return false; ISeq ms = RT.seq(obj); for(int i = 0; i < v.count(); i++, ms = ms.next()) { if(ms == null || !Util.equals(v.nth(i), ms.first())) return false; } if(ms != null) return false; } return true; } static boolean doEquiv(IPersistentVector v, Object obj){ if(obj instanceof List || obj instanceof IPersistentVector) { Collection ma = (Collection) obj; if(ma.size() != v.count()) return false; for(Iterator i1 = ((List) v).iterator(), i2 = ma.iterator(); i1.hasNext();) { if(!Util.equiv(i1.next(), i2.next())) return false; } return true; } // if(obj instanceof IPersistentVector) // { // IPersistentVector ma = (IPersistentVector) obj; // if(ma.count() != v.count() || ma.hashCode() != v.hashCode()) // return false; // for(int i = 0; i < v.count(); i++) // { // if(!Util.equal(v.nth(i), ma.nth(i))) // return false; // } // } else { if(!(obj instanceof Sequential)) return false; ISeq ms = RT.seq(obj); for(int i = 0; i < v.count(); i++, ms = ms.next()) { if(ms == null || !Util.equiv(v.nth(i), ms.first())) return false; } if(ms != null) return false; } return true; } public boolean equals(Object obj){ return doEquals(this, obj); } public boolean equiv(Object obj){ return doEquiv(this, obj); } public int hashCode(){ if(_hash == -1) { int hash = 1; Iterator i = iterator(); while(i.hasNext()) { Object obj = i.next(); hash = 31 * hash + (obj == null ? 0 : obj.hashCode()); } // int hash = 0; // for(int i = 0; i < count(); i++) // { // hash = Util.hashCombine(hash, Util.hash(nth(i))); // } this._hash = hash; } return _hash; } public Object get(int index){ return nth(index); } public Object nth(int i, Object notFound){ if(i >= 0 && i < count()) return nth(i); return notFound; } public Object remove(int i){ throw new UnsupportedOperationException(); } public int indexOf(Object o){ for(int i = 0; i < count(); i++) if(Util.equiv(nth(i), o)) return i; return -1; } public int lastIndexOf(Object o){ for(int i = count() - 1; i >= 0; i--) if(Util.equiv(nth(i), o)) return i; return -1; } public ListIterator listIterator(){ return listIterator(0); } public ListIterator listIterator(final int index){ return new ListIterator(){ int nexti = index; public boolean hasNext(){ return nexti < count(); } public Object next(){ return nth(nexti++); } public boolean hasPrevious(){ return nexti > 0; } public Object previous(){ return nth(--nexti); } public int nextIndex(){ return nexti; } public int previousIndex(){ return nexti - 1; } public void remove(){ throw new UnsupportedOperationException(); } public void set(Object o){ throw new UnsupportedOperationException(); } public void add(Object o){ throw new UnsupportedOperationException(); } }; } public List subList(int fromIndex, int toIndex){ return (List) RT.subvec(this, fromIndex, toIndex); } public Object set(int i, Object o){ throw new UnsupportedOperationException(); } public void add(int i, Object o){ throw new UnsupportedOperationException(); } public boolean addAll(int i, Collection c){ throw new UnsupportedOperationException(); } public Object invoke(Object arg1) throws Exception{ if(Util.isInteger(arg1)) return nth(((Number) arg1).intValue()); throw new IllegalArgumentException("Key must be integer"); } public Iterator iterator(){ //todo - something more efficient return new Iterator(){ int i = 0; public boolean hasNext(){ return i < count(); } public Object next(){ return nth(i++); } public void remove(){ throw new UnsupportedOperationException(); } }; } public Object peek(){ if(count() > 0) return nth(count() - 1); return null; } public boolean containsKey(Object key){ if(!(Util.isInteger(key))) return false; int i = ((Number) key).intValue(); return i >= 0 && i < count(); } public IMapEntry entryAt(Object key){ if(Util.isInteger(key)) { int i = ((Number) key).intValue(); if(i >= 0 && i < count()) return new MapEntry(key, nth(i)); } return null; } public IPersistentVector assoc(Object key, Object val){ if(Util.isInteger(key)) { int i = ((Number) key).intValue(); return assocN(i, val); } throw new IllegalArgumentException("Key must be integer"); } public Object valAt(Object key, Object notFound){ if(Util.isInteger(key)) { int i = ((Number) key).intValue(); if(i >= 0 && i < count()) return nth(i); } return notFound; } public Object valAt(Object key){ return valAt(key, null); } // java.util.Collection implementation public Object[] toArray(){ return RT.seqToArray(seq()); } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection c){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection c){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection c){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection c){ for(Object o : c) { if(!contains(o)) return false; } return true; } public Object[] toArray(Object[] a){ if(a.length >= count()) { ISeq s = seq(); for(int i = 0; s != null; ++i, s = s.next()) { a[i] = s.first(); } if(a.length > count()) a[count()] = null; return a; } else return toArray(); } public int size(){ return count(); } public boolean isEmpty(){ return count() == 0; } public boolean contains(Object o){ for(ISeq s = seq(); s != null; s = s.next()) { if(Util.equiv(s.first(), o)) return true; } return false; } public int length(){ return count(); } public int compareTo(Object o){ IPersistentVector v = (IPersistentVector) o; if(count() < v.count()) return -1; else if(count() > v.count()) return 1; for(int i = 0; i < count(); i++) { int c = Util.compare(nth(i),v.nth(i)); if(c != 0) return c; } return 0; } static class Seq extends ASeq implements IndexedSeq, IReduce{ //todo - something more efficient final IPersistentVector v; final int i; public Seq(IPersistentVector v, int i){ this.v = v; this.i = i; } Seq(IPersistentMap meta, IPersistentVector v, int i){ super(meta); this.v = v; this.i = i; } public Object first(){ return v.nth(i); } public ISeq next(){ if(i + 1 < v.count()) return new APersistentVector.Seq(v, i + 1); return null; } public int index(){ return i; } public int count(){ return v.count() - i; } public APersistentVector.Seq withMeta(IPersistentMap meta){ return new APersistentVector.Seq(meta, v, i); } public Object reduce(IFn f) throws Exception{ Object ret = v.nth(i); for(int x = i + 1; x < v.count(); x++) ret = f.invoke(ret, v.nth(x)); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, v.nth(i)); for(int x = i + 1; x < v.count(); x++) ret = f.invoke(ret, v.nth(x)); return ret; } } public static class RSeq extends ASeq implements IndexedSeq, Counted{ final IPersistentVector v; final int i; public RSeq(IPersistentVector vector, int i){ this.v = vector; this.i = i; } RSeq(IPersistentMap meta, IPersistentVector v, int i){ super(meta); this.v = v; this.i = i; } public Object first(){ return v.nth(i); } public ISeq next(){ if(i > 0) return new APersistentVector.RSeq(v, i - 1); return null; } public int index(){ return i; } public int count(){ return i + 1; } public APersistentVector.RSeq withMeta(IPersistentMap meta){ return new APersistentVector.RSeq(meta, v, i); } } static class SubVector extends APersistentVector implements IObj{ final IPersistentVector v; final int start; final int end; final IPersistentMap _meta; public SubVector(IPersistentMap meta, IPersistentVector v, int start, int end){ this._meta = meta; if(v instanceof APersistentVector.SubVector) { APersistentVector.SubVector sv = (APersistentVector.SubVector) v; start += sv.start; end += sv.start; v = sv.v; } this.v = v; this.start = start; this.end = end; } public Object nth(int i){ if(start + i >= end) throw new IndexOutOfBoundsException(); return v.nth(start + i); } public IPersistentVector assocN(int i, Object val){ if(start + i > end) throw new IndexOutOfBoundsException(); else if(start + i == end) return cons(val); return new SubVector(_meta, v.assocN(start + i, val), start, end); } public int count(){ return end - start; } public IPersistentVector cons(Object o){ return new SubVector(_meta, v.assocN(end, o), start, end + 1); } public IPersistentCollection empty(){ return PersistentVector.EMPTY.withMeta(meta()); } public IPersistentStack pop(){ if(end - 1 == start) { return PersistentVector.EMPTY; } return new SubVector(_meta, v, start, end - 1); } public SubVector withMeta(IPersistentMap meta){ if(meta == _meta) return this; return new SubVector(meta, v, start, end); } public IPersistentMap meta(){ return _meta; } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ARef.java000066400000000000000000000041201157562347600230030ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jan 1, 2009 */ package clojure.lang; import java.util.Map; public abstract class ARef extends AReference implements IRef{ protected volatile IFn validator = null; private volatile IPersistentMap watches = PersistentHashMap.EMPTY; public ARef(){ super(); } public ARef(IPersistentMap meta){ super(meta); } void validate(IFn vf, Object val){ try { if(vf != null && !RT.booleanCast(vf.invoke(val))) throw new IllegalStateException("Invalid reference state"); } catch(RuntimeException re) { throw re; } catch(Exception e) { throw new IllegalStateException("Invalid reference state", e); } } void validate(Object val){ validate(validator, val); } public void setValidator(IFn vf){ try { validate(vf, deref()); } catch(Exception e) { throw new RuntimeException(e); } validator = vf; } public IFn getValidator(){ return validator; } public IPersistentMap getWatches(){ return watches; } synchronized public IRef addWatch(Object key, IFn callback){ watches = watches.assoc(key, callback); return this; } synchronized public IRef removeWatch(Object key){ try { watches = watches.without(key); } catch(Exception e) { throw new RuntimeException(e); } return this; } public void notifyWatches(Object oldval, Object newval){ IPersistentMap ws = watches; if(ws.count() > 0) { for(ISeq s = ws.seq(); s != null; s = s.next()) { Map.Entry e = (Map.Entry) s.first(); IFn fn = (IFn) e.getValue(); try { if(fn != null) fn.invoke(e.getKey(), this, oldval, newval); } catch(Exception e1) { throw new RuntimeException(e1); } } } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/AReference.java000066400000000000000000000021401157562347600241650ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 31, 2008 */ package clojure.lang; public class AReference implements IReference { private IPersistentMap _meta; public AReference() { this(null); } public AReference(IPersistentMap meta) { _meta = meta; } synchronized public IPersistentMap meta() { return _meta; } synchronized public IPersistentMap alterMeta(IFn alter, ISeq args) throws Exception { _meta = (IPersistentMap) alter.applyTo(new Cons(_meta, args)); return _meta; } synchronized public IPersistentMap resetMeta(IPersistentMap m) { _meta = m; return m; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ASeq.java000066400000000000000000000122151157562347600230230ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.Serializable; import java.util.*; public abstract class ASeq extends Obj implements ISeq, List, Serializable { transient int _hash = -1; public String toString(){ return RT.printString(this); } public IPersistentCollection empty(){ return PersistentList.EMPTY; } protected ASeq(IPersistentMap meta){ super(meta); } protected ASeq(){ } public boolean equiv(Object obj){ if(!(obj instanceof Sequential || obj instanceof List)) return false; ISeq ms = RT.seq(obj); for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) { if(ms == null || !Util.equiv(s.first(), ms.first())) return false; } return ms == null; } public boolean equals(Object obj){ if(this == obj) return true; if(!(obj instanceof Sequential || obj instanceof List)) return false; ISeq ms = RT.seq(obj); for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) { if(ms == null || !Util.equals(s.first(), ms.first())) return false; } return ms == null; } public int hashCode(){ if(_hash == -1) { int hash = 1; for(ISeq s = seq(); s != null; s = s.next()) { hash = 31 * hash + (s.first() == null ? 0 : s.first().hashCode()); } this._hash = hash; } return _hash; } //public Object reduce(IFn f) throws Exception{ // Object ret = first(); // for(ISeq s = rest(); s != null; s = s.rest()) // ret = f.invoke(ret, s.first()); // return ret; //} // //public Object reduce(IFn f, Object start) throws Exception{ // Object ret = f.invoke(start, first()); // for(ISeq s = rest(); s != null; s = s.rest()) // ret = f.invoke(ret, s.first()); // return ret; //} //public Object peek(){ // return first(); //} // //public IPersistentList pop(){ // return rest(); //} public int count(){ int i = 1; for(ISeq s = next(); s != null; s = s.next(), i++) if(s instanceof Counted) return i + s.count(); return i; } final public ISeq seq(){ return this; } public ISeq cons(Object o){ return new Cons(o, this); } public ISeq more(){ ISeq s = next(); if(s == null) return PersistentList.EMPTY; return s; } //final public ISeq rest(){ // Seqable m = more(); // if(m == null) // return null; // return m.seq(); //} // java.util.Collection implementation public Object[] toArray(){ return RT.seqToArray(seq()); } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection c){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection c){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection c){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection c){ for(Object o : c) { if(!contains(o)) return false; } return true; } public Object[] toArray(Object[] a){ if(a.length >= count()) { ISeq s = seq(); for(int i = 0; s != null; ++i, s = s.next()) { a[i] = s.first(); } if(a.length > count()) a[count()] = null; return a; } else return toArray(); } public int size(){ return count(); } public boolean isEmpty(){ return seq() == null; } public boolean contains(Object o){ for(ISeq s = seq(); s != null; s = s.next()) { if(Util.equiv(s.first(), o)) return true; } return false; } public Iterator iterator(){ return new SeqIterator(this); } //////////// List stuff ///////////////// private List reify(){ return Collections.unmodifiableList(new ArrayList(this)); } public List subList(int fromIndex, int toIndex){ return reify().subList(fromIndex, toIndex); } public Object set(int index, Object element){ throw new UnsupportedOperationException(); } public Object remove(int index){ throw new UnsupportedOperationException(); } public int indexOf(Object o){ ISeq s = seq(); for(int i = 0; s != null; s = s.next(), i++) { if(Util.equiv(s.first(), o)) return i; } return -1; } public int lastIndexOf(Object o){ return reify().lastIndexOf(o); } public ListIterator listIterator(){ return reify().listIterator(); } public ListIterator listIterator(int index){ return reify().listIterator(index); } public Object get(int index){ return RT.nth(this, index); } public void add(int index, Object element){ throw new UnsupportedOperationException(); } public boolean addAll(int index, Collection c){ throw new UnsupportedOperationException(); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ATransientMap.java000066400000000000000000000043451157562347600247050ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.util.Map; import clojure.lang.PersistentHashMap.INode; abstract class ATransientMap extends AFn implements ITransientMap { abstract void ensureEditable(); abstract ITransientMap doAssoc(Object key, Object val); abstract ITransientMap doWithout(Object key); abstract Object doValAt(Object key, Object notFound); abstract int doCount(); abstract IPersistentMap doPersistent(); public ITransientMap conj(Object o) { ensureEditable(); if(o instanceof Map.Entry) { Map.Entry e = (Map.Entry) o; return assoc(e.getKey(), e.getValue()); } else if(o instanceof IPersistentVector) { IPersistentVector v = (IPersistentVector) o; if(v.count() != 2) throw new IllegalArgumentException("Vector arg to map conj must be a pair"); return assoc(v.nth(0), v.nth(1)); } ITransientMap ret = this; for(ISeq es = RT.seq(o); es != null; es = es.next()) { Map.Entry e = (Map.Entry) es.first(); ret = ret.assoc(e.getKey(), e.getValue()); } return ret; } public final Object invoke(Object arg1) throws Exception{ return valAt(arg1); } public final Object invoke(Object arg1, Object notFound) throws Exception{ return valAt(arg1, notFound); } public final Object valAt(Object key) { return valAt(key, null); } public final ITransientMap assoc(Object key, Object val) { ensureEditable(); return doAssoc(key, val); } public final ITransientMap without(Object key) { ensureEditable(); return doWithout(key); } public final IPersistentMap persistent() { ensureEditable(); return doPersistent(); } public final Object valAt(Object key, Object notFound) { ensureEditable(); return doValAt(key, notFound); } public final int count() { ensureEditable(); return doCount(); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ATransientSet.java000066400000000000000000000025221157562347600247160ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; public abstract class ATransientSet extends AFn implements ITransientSet{ ITransientMap impl; ATransientSet(ITransientMap impl) { this.impl = impl; } public int count() { return impl.count(); } public ITransientSet conj(Object val) { ITransientMap m = impl.assoc(val, val); if (m != impl) this.impl = m; return this; } public boolean contains(Object key) { return this != impl.valAt(key, this); } public ITransientSet disjoin(Object key) throws Exception { ITransientMap m = impl.without(key); if (m != impl) this.impl = m; return this; } public Object get(Object key) { return impl.valAt(key); } public Object invoke(Object key, Object notFound) throws Exception { return impl.valAt(key, notFound); } public Object invoke(Object key) throws Exception { return impl.valAt(key); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Agent.java000066400000000000000000000135101157562347600232270ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 17, 2007 */ package clojure.lang; import java.util.concurrent.*; import java.util.concurrent.atomic.AtomicReference; import java.util.Map; public class Agent extends ARef { static class ActionQueue { public final IPersistentStack q; public final Throwable error; // non-null indicates fail state static final ActionQueue EMPTY = new ActionQueue(PersistentQueue.EMPTY, null); public ActionQueue( IPersistentStack q, Throwable error ) { this.q = q; this.error = error; } } static final Keyword CONTINUE = Keyword.intern(null, "continue"); static final Keyword FAIL = Keyword.intern(null, "fail"); volatile Object state; AtomicReference aq = new AtomicReference(ActionQueue.EMPTY); volatile Keyword errorMode = CONTINUE; volatile IFn errorHandler = null; final public static ExecutorService pooledExecutor = Executors.newFixedThreadPool(2 + Runtime.getRuntime().availableProcessors()); final public static ExecutorService soloExecutor = Executors.newCachedThreadPool(); final static ThreadLocal nested = new ThreadLocal(); public static void shutdown(){ soloExecutor.shutdown(); pooledExecutor.shutdown(); } static class Action implements Runnable{ final Agent agent; final IFn fn; final ISeq args; final boolean solo; public Action(Agent agent, IFn fn, ISeq args, boolean solo){ this.agent = agent; this.args = args; this.fn = fn; this.solo = solo; } void execute(){ try { if(solo) soloExecutor.execute(this); else pooledExecutor.execute(this); } catch(Throwable error) { if(agent.errorHandler != null) { try { agent.errorHandler.invoke(agent, error); } catch(Throwable e) {} // ignore errorHandler errors } } } static void doRun(Action action){ try { Var.pushThreadBindings(RT.map(RT.AGENT, action.agent)); nested.set(PersistentVector.EMPTY); Throwable error = null; try { Object oldval = action.agent.state; Object newval = action.fn.applyTo(RT.cons(action.agent.state, action.args)); action.agent.setState(newval); action.agent.notifyWatches(oldval,newval); } catch(Throwable e) { error = e; } if(error == null) { releasePendingSends(); } else { nested.set(PersistentVector.EMPTY); if(action.agent.errorHandler != null) { try { action.agent.errorHandler.invoke(action.agent, error); } catch(Throwable e) {} // ignore errorHandler errors } if(action.agent.errorMode == CONTINUE) { error = null; } } boolean popped = false; ActionQueue next = null; while(!popped) { ActionQueue prior = action.agent.aq.get(); next = new ActionQueue(prior.q.pop(), error); popped = action.agent.aq.compareAndSet(prior, next); } if(error == null && next.q.count() > 0) ((Action) next.q.peek()).execute(); } finally { nested.set(null); Var.popThreadBindings(); } } public void run(){ doRun(this); } } public Agent(Object state) throws Exception{ this(state,null); } public Agent(Object state, IPersistentMap meta) throws Exception { super(meta); setState(state); } boolean setState(Object newState) throws Exception{ validate(newState); boolean ret = state != newState; state = newState; return ret; } public Object deref() throws Exception{ return state; } public Throwable getError(){ return aq.get().error; } public void setErrorMode(Keyword k){ errorMode = k; } public Keyword getErrorMode(){ return errorMode; } public void setErrorHandler(IFn f){ errorHandler = f; } public IFn getErrorHandler(){ return errorHandler; } synchronized public Object restart(Object newState, boolean clearActions){ if(getError() == null) { throw new RuntimeException("Agent does not need a restart"); } validate(newState); state = newState; if(clearActions) aq.set(ActionQueue.EMPTY); else { boolean restarted = false; ActionQueue prior = null; while(!restarted) { prior = aq.get(); restarted = aq.compareAndSet(prior, new ActionQueue(prior.q, null)); } if(prior.q.count() > 0) ((Action) prior.q.peek()).execute(); } return newState; } public Object dispatch(IFn fn, ISeq args, boolean solo) { Throwable error = getError(); if(error != null) { throw new RuntimeException("Agent is failed, needs restart", error); } Action action = new Action(this, fn, args, solo); dispatchAction(action); return this; } static void dispatchAction(Action action){ LockingTransaction trans = LockingTransaction.getRunning(); if(trans != null) trans.enqueue(action); else if(nested.get() != null) { nested.set(nested.get().cons(action)); } else action.agent.enqueue(action); } void enqueue(Action action){ boolean queued = false; ActionQueue prior = null; while(!queued) { prior = aq.get(); queued = aq.compareAndSet(prior, new ActionQueue((IPersistentStack)prior.q.cons(action), prior.error)); } if(prior.q.count() == 0 && prior.error == null) action.execute(); } public int getQueueCount(){ return aq.get().q.count(); } static public int releasePendingSends(){ IPersistentVector sends = nested.get(); if(sends == null) return 0; for(int i=0;i= 0 && i < count()) return nth(i); return notFound; } public int count(){ return end - off; } public IChunk dropFirst(){ if(off==end) throw new IllegalStateException("dropFirst of empty chunk"); return new ArrayChunk(array, off + 1, end); } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[off]); for(int x = off + 1; x < end; x++) ret = f.invoke(ret, array[x]); return ret; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ArraySeq.java000066400000000000000000000363611157562347600237310ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jun 19, 2006 */ package clojure.lang; import java.lang.reflect.Array; public class ArraySeq extends ASeq implements IndexedSeq, IReduce{ public final Object array; final int i; final Object[] oa; //ISeq _rest; static public ArraySeq create(){ return null; } static public ArraySeq create(Object... array){ if(array == null || array.length == 0) return null; return new ArraySeq(array, 0); } static ISeq createFromObject(Object array){ if(array == null || Array.getLength(array) == 0) return null; Class aclass = array.getClass(); if(aclass == int[].class) return new ArraySeq_int(null, (int[]) array, 0); if(aclass == float[].class) return new ArraySeq_float(null, (float[]) array, 0); if(aclass == double[].class) return new ArraySeq_double(null, (double[]) array, 0); if(aclass == long[].class) return new ArraySeq_long(null, (long[]) array, 0); if(aclass == byte[].class) return new ArraySeq_byte(null, (byte[]) array, 0); if(aclass == char[].class) return new ArraySeq_char(null, (char[]) array, 0); if(aclass == boolean[].class) return new ArraySeq_boolean(null, (boolean[]) array, 0); return new ArraySeq(array, 0); } ArraySeq(Object array, int i){ this.array = array; this.i = i; this.oa = (Object[]) (array instanceof Object[] ? array : null); // this._rest = this; } ArraySeq(IPersistentMap meta, Object array, int i){ super(meta); this.array = array; this.i = i; this.oa = (Object[]) (array instanceof Object[] ? array : null); } public Object first(){ if(oa != null) return oa[i]; return Reflector.prepRet(Array.get(array, i)); } public ISeq next(){ if(oa != null) { if(i + 1 < oa.length) return new ArraySeq(array, i + 1); } else { if(i + 1 < Array.getLength(array)) return new ArraySeq(array, i + 1); } return null; } public int count(){ if(oa != null) return oa.length - i; return Array.getLength(array) - i; } public int index(){ return i; } public ArraySeq withMeta(IPersistentMap meta){ return new ArraySeq(meta, array, i); } public Object reduce(IFn f) throws Exception{ if(oa != null) { Object ret = oa[i]; for(int x = i + 1; x < oa.length; x++) ret = f.invoke(ret, oa[x]); return ret; } Object ret = Reflector.prepRet(Array.get(array, i)); for(int x = i + 1; x < Array.getLength(array); x++) ret = f.invoke(ret, Reflector.prepRet(Array.get(array, x))); return ret; } public Object reduce(IFn f, Object start) throws Exception{ if(oa != null) { Object ret = f.invoke(start, oa[i]); for(int x = i + 1; x < oa.length; x++) ret = f.invoke(ret, oa[x]); return ret; } Object ret = f.invoke(start, Reflector.prepRet(Array.get(array, i))); for(int x = i + 1; x < Array.getLength(array); x++) ret = f.invoke(ret, Reflector.prepRet(Array.get(array, x))); return ret; } public int indexOf(Object o) { if (oa != null) { for (int j = i; j < oa.length; j++) if (Util.equals(o, oa[j])) return j - i; } else { int n = Array.getLength(array); for (int j = i; j < n; j++) if (Util.equals(o, Reflector.prepRet(Array.get(array, j)))) return j - i; } return -1; } public int lastIndexOf(Object o) { if (oa != null) { if (o == null) { for (int j = oa.length - 1 ; j >= i; j--) if (oa[j] == null) return j - i; } else { for (int j = oa.length - 1 ; j >= i; j--) if (o.equals(oa[j])) return j - i; } } else { if (o == null) { for (int j = Array.getLength(array) - 1 ; j >= i; j--) if (Reflector.prepRet(Array.get(array, j)) == null) return j - i; } else { for (int j = Array.getLength(array) - 1 ; j >= i; j--) if (o.equals(Reflector.prepRet(Array.get(array, j)))) return j - i; } } return -1; } //////////////////////////////////// specialized primitive versions /////////////////////////////// static public class ArraySeq_int extends ASeq implements IndexedSeq, IReduce{ public final int[] array; final int i; ArraySeq_int(IPersistentMap meta, int[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_int(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_int withMeta(IPersistentMap meta){ return new ArraySeq_int(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Integer) { int k = ((Integer) o).intValue(); for (int j = i; j < array.length; j++) if (k == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Integer) { int k = ((Integer) o).intValue(); for (int j = array.length - 1; j >= i; j--) if (k == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } static public class ArraySeq_float extends ASeq implements IndexedSeq, IReduce{ public final float[] array; final int i; ArraySeq_float(IPersistentMap meta, float[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_float(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_float withMeta(IPersistentMap meta){ return new ArraySeq_float(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Float) { float f = ((Float) o).floatValue(); for (int j = i; j < array.length; j++) if (f == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Float) { float f = ((Float) o).floatValue(); for (int j = array.length - 1; j >= i; j--) if (f == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } static public class ArraySeq_double extends ASeq implements IndexedSeq, IReduce{ public final double[] array; final int i; ArraySeq_double(IPersistentMap meta, double[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_double(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_double withMeta(IPersistentMap meta){ return new ArraySeq_double(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Double) { double d = ((Double) o).doubleValue(); for (int j = i; j < array.length; j++) if (d == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Double) { double d = ((Double) o).doubleValue(); for (int j = array.length - 1; j >= i; j--) if (d == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } static public class ArraySeq_long extends ASeq implements IndexedSeq, IReduce{ public final long[] array; final int i; ArraySeq_long(IPersistentMap meta, long[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_long(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_long withMeta(IPersistentMap meta){ return new ArraySeq_long(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Long) { long l = ((Long) o).longValue(); for (int j = i; j < array.length; j++) if (l == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Long) { long l = ((Long) o).longValue(); for (int j = array.length - 1; j >= i; j--) if (l == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } static public class ArraySeq_byte extends ASeq implements IndexedSeq, IReduce{ public final byte[] array; final int i; ArraySeq_byte(IPersistentMap meta, byte[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_byte(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_byte withMeta(IPersistentMap meta){ return new ArraySeq_byte(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Byte) { byte b = ((Byte) o).byteValue(); for (int j = i; j < array.length; j++) if (b == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Byte) { byte b = ((Byte) o).byteValue(); for (int j = array.length - 1; j >= i; j--) if (b == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } static public class ArraySeq_char extends ASeq implements IndexedSeq, IReduce{ public final char[] array; final int i; ArraySeq_char(IPersistentMap meta, char[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_char(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_char withMeta(IPersistentMap meta){ return new ArraySeq_char(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Character) { char c = ((Character) o).charValue(); for (int j = i; j < array.length; j++) if (c == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Character) { char c = ((Character) o).charValue(); for (int j = array.length - 1; j >= i; j--) if (c == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } static public class ArraySeq_boolean extends ASeq implements IndexedSeq, IReduce{ public final boolean[] array; final int i; ArraySeq_boolean(IPersistentMap meta, boolean[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return array[i]; } public ISeq next(){ if(i + 1 < array.length) return new ArraySeq_boolean(meta(), array, i + 1); return null; } public int count(){ return array.length - i; } public int index(){ return i; } public ArraySeq_boolean withMeta(IPersistentMap meta){ return new ArraySeq_boolean(meta, array, i); } public Object reduce(IFn f) throws Exception{ Object ret = array[i]; for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, array[i]); for(int x = i + 1; x < array.length; x++) ret = f.invoke(ret, array[x]); return ret; } public int indexOf(Object o) { if (o instanceof Boolean) { boolean b = ((Boolean) o).booleanValue(); for (int j = i; j < array.length; j++) if (b == array[j]) return j - i; } if (o == null) { return -1; } for (int j = i; j < array.length; j++) if (o.equals(array[j])) return j - i; return -1; } public int lastIndexOf(Object o) { if (o instanceof Boolean) { boolean b = ((Boolean) o).booleanValue(); for (int j = array.length - 1; j >= i; j--) if (b == array[j]) return j - i; } if (o == null) { return -1; } for (int j = array.length - 1; j >= i; j--) if (o.equals(array[j])) return j - i; return -1; } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Associative.java000066400000000000000000000012571157562347600244500ustar00rootroot00000000000000package clojure.lang; /** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ public interface Associative extends IPersistentCollection, ILookup{ boolean containsKey(Object key); IMapEntry entryAt(Object key); Associative assoc(Object key, Object val); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Atom.java000066400000000000000000000042361157562347600230760ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jan 1, 2009 */ package clojure.lang; import java.util.concurrent.atomic.AtomicReference; final public class Atom extends ARef{ final AtomicReference state; public Atom(Object state){ this.state = new AtomicReference(state); } public Atom(Object state, IPersistentMap meta){ super(meta); this.state = new AtomicReference(state); } public Object deref(){ return state.get(); } public Object swap(IFn f) throws Exception{ for(; ;) { Object v = deref(); Object newv = f.invoke(v); validate(newv); if(state.compareAndSet(v, newv)) { notifyWatches(v, newv); return newv; } } } public Object swap(IFn f, Object arg) throws Exception{ for(; ;) { Object v = deref(); Object newv = f.invoke(v, arg); validate(newv); if(state.compareAndSet(v, newv)) { notifyWatches(v, newv); return newv; } } } public Object swap(IFn f, Object arg1, Object arg2) throws Exception{ for(; ;) { Object v = deref(); Object newv = f.invoke(v, arg1, arg2); validate(newv); if(state.compareAndSet(v, newv)) { notifyWatches(v, newv); return newv; } } } public Object swap(IFn f, Object x, Object y, ISeq args) throws Exception{ for(; ;) { Object v = deref(); Object newv = f.applyTo(RT.listStar(v, x, y, args)); validate(newv); if(state.compareAndSet(v, newv)) { notifyWatches(v, newv); return newv; } } } public boolean compareAndSet(Object oldv, Object newv){ validate(newv); boolean ret = state.compareAndSet(oldv, newv); if(ret) notifyWatches(oldv, newv); return ret; } public Object reset(Object newval){ Object oldval = state.get(); validate(newval); state.set(newval); notifyWatches(oldval, newval); return newval; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Binding.java000066400000000000000000000013371157562347600235470ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; public class Binding{ public T val; public final Binding rest; public Binding(T val){ this.val = val; this.rest = null; } public Binding(T val, Binding rest){ this.val = val; this.rest = rest; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Box.java000066400000000000000000000011571157562347600227250ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 27, 2006 8:40:19 PM */ package clojure.lang; public class Box{ public Object val; public Box(Object val){ this.val = val; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ChunkBuffer.java000066400000000000000000000015571157562347600244030ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich May 26, 2009 */ package clojure.lang; final public class ChunkBuffer implements Counted{ Object[] buffer; int end; public ChunkBuffer(int capacity){ buffer = new Object[capacity]; end = 0; } public void add(Object o){ buffer[end++] = o; } public IChunk chunk(){ ArrayChunk ret = new ArrayChunk(buffer, 0, end); buffer = null; return ret; } public int count(){ return end; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ChunkedCons.java000066400000000000000000000027161157562347600244030ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich May 25, 2009 */ package clojure.lang; final public class ChunkedCons extends ASeq implements IChunkedSeq{ final IChunk chunk; final ISeq _more; ChunkedCons(IPersistentMap meta, IChunk chunk, ISeq more){ super(meta); this.chunk = chunk; this._more = more; } public ChunkedCons(IChunk chunk, ISeq more){ this(null,chunk, more); } public Obj withMeta(IPersistentMap meta){ if(meta != _meta) return new ChunkedCons(meta, chunk, _more); return this; } public Object first(){ return chunk.nth(0); } public ISeq next(){ if(chunk.count() > 1) return new ChunkedCons(chunk.dropFirst(), _more); return chunkedNext(); } public ISeq more(){ if(chunk.count() > 1) return new ChunkedCons(chunk.dropFirst(), _more); if(_more == null) return PersistentList.EMPTY; return _more; } public IChunk chunkedFirst(){ return chunk; } public ISeq chunkedNext(){ return chunkedMore().seq(); } public ISeq chunkedMore(){ if(_more == null) return PersistentList.EMPTY; return _more; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Compile.java000066400000000000000000000043701157562347600235650ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.OutputStreamWriter; import java.io.PrintWriter; import java.io.IOException; // Compiles libs and generates class files stored within the directory // named by the Java System property "clojure.compile.path". Arguments are // strings naming the libs to be compiled. The libs and compile-path must // all be within CLASSPATH. public class Compile{ private static final String PATH_PROP = "clojure.compile.path"; private static final String REFLECTION_WARNING_PROP = "clojure.compile.warn-on-reflection"; private static final Var compile_path = RT.var("clojure.core", "*compile-path*"); private static final Var compile = RT.var("clojure.core", "compile"); private static final Var warn_on_reflection = RT.var("clojure.core", "*warn-on-reflection*"); public static void main(String[] args) throws Exception{ OutputStreamWriter out = (OutputStreamWriter) RT.OUT.deref(); PrintWriter err = RT.errPrintWriter(); String path = System.getProperty(PATH_PROP); int count = args.length; if(path == null) { err.println("ERROR: Must set system property " + PATH_PROP + "\nto the location for compiled .class files." + "\nThis directory must also be on your CLASSPATH."); System.exit(1); } boolean warnOnReflection = System.getProperty(REFLECTION_WARNING_PROP, "false").equals("true"); try { Var.pushThreadBindings(RT.map(compile_path, path, warn_on_reflection, warnOnReflection)); for(String lib : args) { out.write("Compiling " + lib + " to " + path + "\n"); out.flush(); compile.invoke(Symbol.intern(lib)); } } finally { Var.popThreadBindings(); try { out.flush(); out.close(); } catch(IOException e) { e.printStackTrace(err); } } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Compiler.java000066400000000000000000006263141157562347600237570ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Aug 21, 2007 */ package clojure.lang; //* import clojure.asm.*; import clojure.asm.commons.Method; import clojure.asm.commons.GeneratorAdapter; //*/ /* import org.objectweb.asm.*; import org.objectweb.asm.commons.Method; import org.objectweb.asm.commons.GeneratorAdapter; import org.objectweb.asm.util.TraceClassVisitor; import org.objectweb.asm.util.CheckClassAdapter; //*/ import java.io.*; import java.util.*; import java.lang.reflect.Constructor; import java.lang.reflect.Modifier; public class Compiler implements Opcodes{ static final Symbol DEF = Symbol.create("def"); static final Symbol LOOP = Symbol.create("loop*"); static final Symbol RECUR = Symbol.create("recur"); static final Symbol IF = Symbol.create("if"); static final Symbol LET = Symbol.create("let*"); static final Symbol LETFN = Symbol.create("letfn*"); static final Symbol DO = Symbol.create("do"); static final Symbol FN = Symbol.create("fn*"); static final Symbol QUOTE = Symbol.create("quote"); static final Symbol THE_VAR = Symbol.create("var"); static final Symbol DOT = Symbol.create("."); static final Symbol ASSIGN = Symbol.create("set!"); //static final Symbol TRY_FINALLY = Symbol.create("try-finally"); static final Symbol TRY = Symbol.create("try"); static final Symbol CATCH = Symbol.create("catch"); static final Symbol FINALLY = Symbol.create("finally"); static final Symbol THROW = Symbol.create("throw"); static final Symbol MONITOR_ENTER = Symbol.create("monitor-enter"); static final Symbol MONITOR_EXIT = Symbol.create("monitor-exit"); static final Symbol IMPORT = Symbol.create("clojure.core", "import*"); //static final Symbol INSTANCE = Symbol.create("instance?"); static final Symbol DEFTYPE = Symbol.create("deftype*"); static final Symbol CASE = Symbol.create("case*"); //static final Symbol THISFN = Symbol.create("thisfn"); static final Symbol CLASS = Symbol.create("Class"); static final Symbol NEW = Symbol.create("new"); static final Symbol THIS = Symbol.create("this"); static final Symbol REIFY = Symbol.create("reify*"); //static final Symbol UNQUOTE = Symbol.create("unquote"); //static final Symbol UNQUOTE_SPLICING = Symbol.create("unquote-splicing"); //static final Symbol SYNTAX_QUOTE = Symbol.create("clojure.core", "syntax-quote"); static final Symbol LIST = Symbol.create("clojure.core", "list"); static final Symbol HASHMAP = Symbol.create("clojure.core", "hash-map"); static final Symbol VECTOR = Symbol.create("clojure.core", "vector"); static final Symbol IDENTITY = Symbol.create("clojure.core", "identity"); static final Symbol _AMP_ = Symbol.create("&"); static final Symbol ISEQ = Symbol.create("clojure.lang.ISeq"); static final Keyword inlineKey = Keyword.intern(null, "inline"); static final Keyword inlineAritiesKey = Keyword.intern(null, "inline-arities"); static final Keyword volatileKey = Keyword.intern(null, "volatile"); static final Keyword implementsKey = Keyword.intern(null, "implements"); static final String COMPILE_STUB_PREFIX = "compile__stub"; static final Keyword protocolKey = Keyword.intern(null, "protocol"); static final Keyword onKey = Keyword.intern(null, "on"); static final Symbol NS = Symbol.create("ns"); static final Symbol IN_NS = Symbol.create("in-ns"); //static final Symbol IMPORT = Symbol.create("import"); //static final Symbol USE = Symbol.create("use"); //static final Symbol IFN = Symbol.create("clojure.lang", "IFn"); static final public IPersistentMap specials = PersistentHashMap.create( DEF, new DefExpr.Parser(), LOOP, new LetExpr.Parser(), RECUR, new RecurExpr.Parser(), IF, new IfExpr.Parser(), CASE, new CaseExpr.Parser(), LET, new LetExpr.Parser(), LETFN, new LetFnExpr.Parser(), DO, new BodyExpr.Parser(), FN, null, QUOTE, new ConstantExpr.Parser(), THE_VAR, new TheVarExpr.Parser(), IMPORT, new ImportExpr.Parser(), DOT, new HostExpr.Parser(), ASSIGN, new AssignExpr.Parser(), DEFTYPE, new NewInstanceExpr.DeftypeParser(), REIFY, new NewInstanceExpr.ReifyParser(), // TRY_FINALLY, new TryFinallyExpr.Parser(), TRY, new TryExpr.Parser(), THROW, new ThrowExpr.Parser(), MONITOR_ENTER, new MonitorEnterExpr.Parser(), MONITOR_EXIT, new MonitorExitExpr.Parser(), // INSTANCE, new InstanceExpr.Parser(), // IDENTICAL, new IdenticalExpr.Parser(), //THISFN, null, CATCH, null, FINALLY, null, // CLASS, new ClassExpr.Parser(), NEW, new NewExpr.Parser(), // UNQUOTE, null, // UNQUOTE_SPLICING, null, // SYNTAX_QUOTE, null, _AMP_, null ); private static final int MAX_POSITIONAL_ARITY = 20; private static final Type OBJECT_TYPE; private static final Type KEYWORD_TYPE = Type.getType(Keyword.class); private static final Type VAR_TYPE = Type.getType(Var.class); private static final Type SYMBOL_TYPE = Type.getType(Symbol.class); //private static final Type NUM_TYPE = Type.getType(Num.class); private static final Type IFN_TYPE = Type.getType(IFn.class); private static final Type AFUNCTION_TYPE = Type.getType(AFunction.class); private static final Type RT_TYPE = Type.getType(RT.class); final static Type CLASS_TYPE = Type.getType(Class.class); final static Type NS_TYPE = Type.getType(Namespace.class); final static Type UTIL_TYPE = Type.getType(Util.class); final static Type REFLECTOR_TYPE = Type.getType(Reflector.class); final static Type THROWABLE_TYPE = Type.getType(Throwable.class); final static Type BOOLEAN_OBJECT_TYPE = Type.getType(Boolean.class); final static Type IPERSISTENTMAP_TYPE = Type.getType(IPersistentMap.class); final static Type IOBJ_TYPE = Type.getType(IObj.class); private static final Type[][] ARG_TYPES; private static final Type[] EXCEPTION_TYPES = {Type.getType(Exception.class)}; static { OBJECT_TYPE = Type.getType(Object.class); ARG_TYPES = new Type[MAX_POSITIONAL_ARITY + 2][]; for(int i = 0; i <= MAX_POSITIONAL_ARITY; ++i) { Type[] a = new Type[i]; for(int j = 0; j < i; j++) a[j] = OBJECT_TYPE; ARG_TYPES[i] = a; } Type[] a = new Type[MAX_POSITIONAL_ARITY + 1]; for(int j = 0; j < MAX_POSITIONAL_ARITY; j++) a[j] = OBJECT_TYPE; a[MAX_POSITIONAL_ARITY] = Type.getType("[Ljava/lang/Object;"); ARG_TYPES[MAX_POSITIONAL_ARITY + 1] = a; } //symbol->localbinding static final public Var LOCAL_ENV = Var.create(null); //vector static final public Var LOOP_LOCALS = Var.create(); //Label static final public Var LOOP_LABEL = Var.create(); //vector static final public Var CONSTANTS = Var.create(); //IdentityHashMap static final public Var CONSTANT_IDS = Var.create(); //vector static final public Var KEYWORD_CALLSITES = Var.create(); //vector static final public Var PROTOCOL_CALLSITES = Var.create(); //vector static final public Var VAR_CALLSITES = Var.create(); //keyword->constid static final public Var KEYWORDS = Var.create(); //var->constid static final public Var VARS = Var.create(); //FnFrame static final public Var METHOD = Var.create(null); //null or not static final public Var IN_CATCH_FINALLY = Var.create(null); //DynamicClassLoader static final public Var LOADER = Var.create(); //String static final public Var SOURCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), Symbol.create("*source-path*"), "NO_SOURCE_FILE"); //String static final public Var SOURCE_PATH = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), Symbol.create("*file*"), "NO_SOURCE_PATH"); //String static final public Var COMPILE_PATH = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), Symbol.create("*compile-path*"), null); //boolean static final public Var COMPILE_FILES = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), Symbol.create("*compile-files*"), Boolean.FALSE); static final public Var INSTANCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), Symbol.create("instance?")); static final public Var ADD_ANNOTATIONS = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")), Symbol.create("add-annotations")); //Integer static final public Var LINE = Var.create(0); //Integer static final public Var LINE_BEFORE = Var.create(0); static final public Var LINE_AFTER = Var.create(0); //Integer static final public Var NEXT_LOCAL_NUM = Var.create(0); //Integer static final public Var RET_LOCAL_NUM = Var.create(); static final public Var COMPILE_STUB_SYM = Var.create(null); static final public Var COMPILE_STUB_CLASS = Var.create(null); //PathNode chain static final public Var CLEAR_PATH = Var.create(null); //tail of PathNode chain static final public Var CLEAR_ROOT = Var.create(null); //LocalBinding -> Set static final public Var CLEAR_SITES = Var.create(null); public enum C{ STATEMENT, //value ignored EXPRESSION, //value required RETURN, //tail position relative to enclosing recur frame EVAL } interface Expr{ Object eval() throws Exception; void emit(C context, ObjExpr objx, GeneratorAdapter gen); boolean hasJavaClass() throws Exception; Class getJavaClass() throws Exception; } public static abstract class UntypedExpr implements Expr{ public Class getJavaClass(){ throw new IllegalArgumentException("Has no Java class"); } public boolean hasJavaClass(){ return false; } } interface IParser{ Expr parse(C context, Object form) throws Exception; } static boolean isSpecial(Object sym){ return specials.containsKey(sym); } static Symbol resolveSymbol(Symbol sym){ //already qualified or classname? if(sym.name.indexOf('.') > 0) return sym; if(sym.ns != null) { Namespace ns = namespaceFor(sym); if(ns == null || ns.name.name == sym.ns) return sym; return Symbol.create(ns.name.name, sym.name); } Object o = currentNS().getMapping(sym); if(o == null) return Symbol.intern(currentNS().name.name, sym.name); else if(o instanceof Class) return Symbol.intern(null, ((Class) o).getName()); else if(o instanceof Var) { Var v = (Var) o; return Symbol.create(v.ns.name.name, v.sym.name); } return null; } static class DefExpr implements Expr{ public final Var var; public final Expr init; public final Expr meta; public final boolean initProvided; public final String source; public final int line; final static Method bindRootMethod = Method.getMethod("void bindRoot(Object)"); final static Method setTagMethod = Method.getMethod("void setTag(clojure.lang.Symbol)"); final static Method setMetaMethod = Method.getMethod("void setMeta(clojure.lang.IPersistentMap)"); final static Method symcreate = Method.getMethod("clojure.lang.Symbol create(String, String)"); public DefExpr(String source, int line, Var var, Expr init, Expr meta, boolean initProvided){ this.source = source; this.line = line; this.var = var; this.init = init; this.meta = meta; this.initProvided = initProvided; } private boolean includesExplicitMetadata(MapExpr expr) { for(int i=0; i < expr.keyvals.count(); i += 2) { Keyword k = ((KeywordExpr) expr.keyvals.nth(i)).k; if ((k != RT.FILE_KEY) && (k != RT.DECLARED_KEY) && (k != RT.LINE_KEY)) return true; } return false; } public Object eval() throws Exception{ try { if(initProvided) { // if(init instanceof FnExpr && ((FnExpr) init).closes.count()==0) // var.bindRoot(new FnLoaderThunk((FnExpr) init,var)); // else var.bindRoot(init.eval()); } if(meta != null) { IPersistentMap metaMap = (IPersistentMap) meta.eval(); if (initProvided || includesExplicitMetadata((MapExpr) meta)) var.setMeta((IPersistentMap) meta.eval()); } return var; } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException(source, line, e); else throw (CompilerException) e; } } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ objx.emitVar(gen, var); if(meta != null) { if (initProvided || includesExplicitMetadata((MapExpr) meta)) { gen.dup(); meta.emit(C.EXPRESSION, objx, gen); gen.checkCast(IPERSISTENTMAP_TYPE); gen.invokeVirtual(VAR_TYPE, setMetaMethod); } } if(initProvided) { gen.dup(); init.emit(C.EXPRESSION, objx, gen); gen.invokeVirtual(VAR_TYPE, bindRootMethod); } if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return true; } public Class getJavaClass(){ return Var.class; } static class Parser implements IParser{ public Expr parse(C context, Object form) throws Exception{ //(def x) or (def x initexpr) if(RT.count(form) > 3) throw new Exception("Too many arguments to def"); else if(RT.count(form) < 2) throw new Exception("Too few arguments to def"); else if(!(RT.second(form) instanceof Symbol)) throw new Exception("First argument to def must be a Symbol"); Symbol sym = (Symbol) RT.second(form); Var v = lookupVar(sym, true); if(v == null) throw new Exception("Can't refer to qualified var that doesn't exist"); if(!v.ns.equals(currentNS())) { if(sym.ns == null) v = currentNS().intern(sym); // throw new Exception("Name conflict, can't def " + sym + " because namespace: " + currentNS().name + // " refers to:" + v); else throw new Exception("Can't create defs outside of current ns"); } IPersistentMap mm = sym.meta(); Object source_path = SOURCE_PATH.get(); source_path = source_path == null ? "NO_SOURCE_FILE" : source_path; mm = (IPersistentMap) RT.assoc(mm, RT.LINE_KEY, LINE.get()).assoc(RT.FILE_KEY, source_path); Expr meta = analyze(context == C.EVAL ? context : C.EXPRESSION, mm); return new DefExpr((String) SOURCE.deref(), (Integer) LINE.deref(), v, analyze(context == C.EVAL ? context : C.EXPRESSION, RT.third(form), v.sym.name), meta, RT.count(form) == 3); } } } public static class AssignExpr implements Expr{ public final AssignableExpr target; public final Expr val; public AssignExpr(AssignableExpr target, Expr val){ this.target = target; this.val = val; } public Object eval() throws Exception{ return target.evalAssign(val); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ target.emitAssign(context, objx, gen, val); } public boolean hasJavaClass() throws Exception{ return val.hasJavaClass(); } public Class getJavaClass() throws Exception{ return val.getJavaClass(); } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; if(RT.length(form) != 3) throw new IllegalArgumentException("Malformed assignment, expecting (set! target val)"); Expr target = analyze(C.EXPRESSION, RT.second(form)); if(!(target instanceof AssignableExpr)) throw new IllegalArgumentException("Invalid assignment target"); return new AssignExpr((AssignableExpr) target, analyze(C.EXPRESSION, RT.third(form))); } } } public static class VarExpr implements Expr, AssignableExpr{ public final Var var; public final Object tag; final static Method getMethod = Method.getMethod("Object get()"); final static Method setMethod = Method.getMethod("Object set(Object)"); public VarExpr(Var var, Symbol tag){ this.var = var; this.tag = tag != null ? tag : var.getTag(); } public Object eval() throws Exception{ return var.deref(); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ objx.emitVar(gen, var); gen.invokeVirtual(VAR_TYPE, getMethod); if(context == C.STATEMENT) { gen.pop(); } } public boolean hasJavaClass(){ return tag != null; } public Class getJavaClass() throws Exception{ return HostExpr.tagToClass(tag); } public Object evalAssign(Expr val) throws Exception{ return var.set(val.eval()); } public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val){ objx.emitVar(gen, var); val.emit(C.EXPRESSION, objx, gen); gen.invokeVirtual(VAR_TYPE, setMethod); if(context == C.STATEMENT) gen.pop(); } } public static class TheVarExpr implements Expr{ public final Var var; public TheVarExpr(Var var){ this.var = var; } public Object eval() throws Exception{ return var; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ objx.emitVar(gen, var); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws ClassNotFoundException{ return Var.class; } static class Parser implements IParser{ public Expr parse(C context, Object form) throws Exception{ Symbol sym = (Symbol) RT.second(form); Var v = lookupVar(sym, false); if(v != null) return new TheVarExpr(v); throw new Exception("Unable to resolve var: " + sym + " in this context"); } } } public static class KeywordExpr implements Expr{ public final Keyword k; public KeywordExpr(Keyword k){ this.k = k; } public Object eval() throws Exception{ return k; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ objx.emitKeyword(gen, k); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws ClassNotFoundException{ return Keyword.class; } } public static class ImportExpr implements Expr{ public final String c; final static Method forNameMethod = Method.getMethod("Class forName(String)"); final static Method importClassMethod = Method.getMethod("Class importClass(Class)"); final static Method derefMethod = Method.getMethod("Object deref()"); public ImportExpr(String c){ this.c = c; } public Object eval() throws Exception{ Namespace ns = (Namespace) RT.CURRENT_NS.deref(); ns.importClass(RT.classForName(c)); return null; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.getStatic(RT_TYPE,"CURRENT_NS",VAR_TYPE); gen.invokeVirtual(VAR_TYPE, derefMethod); gen.checkCast(NS_TYPE); gen.push(c); gen.invokeStatic(CLASS_TYPE, forNameMethod); gen.invokeVirtual(NS_TYPE, importClassMethod); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return false; } public Class getJavaClass() throws ClassNotFoundException{ throw new IllegalArgumentException("ImportExpr has no Java class"); } static class Parser implements IParser{ public Expr parse(C context, Object form) throws Exception{ return new ImportExpr((String) RT.second(form)); } } } public static abstract class LiteralExpr implements Expr{ abstract Object val(); public Object eval(){ return val(); } } static interface AssignableExpr{ Object evalAssign(Expr val) throws Exception; void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val); } static public interface MaybePrimitiveExpr extends Expr{ public boolean canEmitPrimitive(); public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen); } static public abstract class HostExpr implements Expr, MaybePrimitiveExpr{ final static Type BOOLEAN_TYPE = Type.getType(Boolean.class); final static Type CHAR_TYPE = Type.getType(Character.class); final static Type INTEGER_TYPE = Type.getType(Integer.class); final static Type LONG_TYPE = Type.getType(Long.class); final static Type FLOAT_TYPE = Type.getType(Float.class); final static Type DOUBLE_TYPE = Type.getType(Double.class); final static Type SHORT_TYPE = Type.getType(Short.class); final static Type BYTE_TYPE = Type.getType(Byte.class); final static Type NUMBER_TYPE = Type.getType(Number.class); final static Method charValueMethod = Method.getMethod("char charValue()"); final static Method booleanValueMethod = Method.getMethod("boolean booleanValue()"); final static Method charValueOfMethod = Method.getMethod("Character valueOf(char)"); final static Method intValueOfMethod = Method.getMethod("Integer valueOf(int)"); final static Method longValueOfMethod = Method.getMethod("Long valueOf(long)"); final static Method floatValueOfMethod = Method.getMethod("Float valueOf(float)"); final static Method doubleValueOfMethod = Method.getMethod("Double valueOf(double)"); final static Method shortValueOfMethod = Method.getMethod("Short valueOf(short)"); final static Method byteValueOfMethod = Method.getMethod("Byte valueOf(byte)"); final static Method intValueMethod = Method.getMethod("int intValue()"); final static Method longValueMethod = Method.getMethod("long longValue()"); final static Method floatValueMethod = Method.getMethod("float floatValue()"); final static Method doubleValueMethod = Method.getMethod("double doubleValue()"); final static Method byteValueMethod = Method.getMethod("byte byteValue()"); final static Method shortValueMethod = Method.getMethod("short shortValue()"); final static Method fromIntMethod = Method.getMethod("clojure.lang.Num from(int)"); final static Method fromLongMethod = Method.getMethod("clojure.lang.Num from(long)"); final static Method fromDoubleMethod = Method.getMethod("clojure.lang.Num from(double)"); //* public static void emitBoxReturn(ObjExpr objx, GeneratorAdapter gen, Class returnType){ if(returnType.isPrimitive()) { if(returnType == boolean.class) { Label falseLabel = gen.newLabel(); Label endLabel = gen.newLabel(); gen.ifZCmp(GeneratorAdapter.EQ, falseLabel); gen.getStatic(BOOLEAN_OBJECT_TYPE, "TRUE", BOOLEAN_OBJECT_TYPE); gen.goTo(endLabel); gen.mark(falseLabel); gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE); // NIL_EXPR.emit(C.EXPRESSION, fn, gen); gen.mark(endLabel); } else if(returnType == void.class) { NIL_EXPR.emit(C.EXPRESSION, objx, gen); } else if(returnType == char.class) { gen.invokeStatic(CHAR_TYPE, charValueOfMethod); } else { if(returnType == int.class) //gen.invokeStatic(NUM_TYPE, fromIntMethod); gen.invokeStatic(INTEGER_TYPE, intValueOfMethod); else if(returnType == float.class) { //gen.visitInsn(F2D); gen.invokeStatic(FLOAT_TYPE, floatValueOfMethod); //m = floatValueOfMethod; } else if(returnType == double.class) gen.invokeStatic(DOUBLE_TYPE, doubleValueOfMethod); else if(returnType == long.class) gen.invokeStatic(LONG_TYPE, longValueOfMethod); else if(returnType == byte.class) gen.invokeStatic(BYTE_TYPE, byteValueOfMethod); else if(returnType == short.class) gen.invokeStatic(SHORT_TYPE, shortValueOfMethod); } } } //*/ public static void emitUnboxArg(ObjExpr objx, GeneratorAdapter gen, Class paramType){ if(paramType.isPrimitive()) { if(paramType == boolean.class) { gen.checkCast(BOOLEAN_TYPE); gen.invokeVirtual(BOOLEAN_TYPE, booleanValueMethod); // Label falseLabel = gen.newLabel(); // Label endLabel = gen.newLabel(); // gen.ifNull(falseLabel); // gen.push(1); // gen.goTo(endLabel); // gen.mark(falseLabel); // gen.push(0); // gen.mark(endLabel); } else if(paramType == char.class) { gen.checkCast(CHAR_TYPE); gen.invokeVirtual(CHAR_TYPE, charValueMethod); } else { Method m = intValueMethod; gen.checkCast(NUMBER_TYPE); if(paramType == int.class) m = intValueMethod; else if(paramType == float.class) m = floatValueMethod; else if(paramType == double.class) m = doubleValueMethod; else if(paramType == long.class) m = longValueMethod; else if(paramType == byte.class) m = byteValueMethod; else if(paramType == short.class) m = shortValueMethod; gen.invokeVirtual(NUMBER_TYPE, m); } } else { gen.checkCast(Type.getType(paramType)); } } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; //(. x fieldname-sym) or //(. x 0-ary-method) // (. x methodname-sym args+) // (. x (methodname-sym args?)) if(RT.length(form) < 3) throw new IllegalArgumentException("Malformed member expression, expecting (. target member ...)"); //determine static or instance //static target must be symbol, either fully.qualified.Classname or Classname that has been imported int line = (Integer) LINE.deref(); String source = (String) SOURCE.deref(); Class c = maybeClass(RT.second(form), false); //at this point c will be non-null if static Expr instance = null; if(c == null) instance = analyze(context == C.EVAL ? context : C.EXPRESSION, RT.second(form)); boolean maybeField = RT.length(form) == 3 && (RT.third(form) instanceof Symbol || RT.third(form) instanceof Keyword); if(maybeField && !(RT.third(form) instanceof Keyword)) { Symbol sym = (Symbol) RT.third(form); if(c != null) maybeField = Reflector.getMethods(c, 0, munge(sym.name), true).size() == 0; else if(instance != null && instance.hasJavaClass() && instance.getJavaClass() != null) maybeField = Reflector.getMethods(instance.getJavaClass(), 0, munge(sym.name), false).size() == 0; } if(maybeField) //field { Symbol sym = (RT.third(form) instanceof Keyword)? ((Keyword)RT.third(form)).sym :(Symbol) RT.third(form); Symbol tag = tagOf(form); if(c != null) { return new StaticFieldExpr(line, c, munge(sym.name), tag); } else return new InstanceFieldExpr(line, instance, munge(sym.name), tag); } else { ISeq call = (ISeq) ((RT.third(form) instanceof ISeq) ? RT.third(form) : RT.next(RT.next(form))); if(!(RT.first(call) instanceof Symbol)) throw new IllegalArgumentException("Malformed member expression"); Symbol sym = (Symbol) RT.first(call); Symbol tag = tagOf(form); PersistentVector args = PersistentVector.EMPTY; for(ISeq s = RT.next(call); s != null; s = s.next()) args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first())); if(c != null) return new StaticMethodExpr(source, line, tag, c, munge(sym.name), args); else return new InstanceMethodExpr(source, line, tag, instance, munge(sym.name), args); } } } private static Class maybeClass(Object form, boolean stringOk) throws Exception{ if(form instanceof Class) return (Class) form; Class c = null; if(form instanceof Symbol) { Symbol sym = (Symbol) form; if(sym.ns == null) //if ns-qualified can't be classname { if(Util.equals(sym,COMPILE_STUB_SYM.get())) return (Class) COMPILE_STUB_CLASS.get(); if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') c = RT.classForName(sym.name); else { Object o = currentNS().getMapping(sym); if(o instanceof Class) c = (Class) o; } } } else if(stringOk && form instanceof String) c = RT.classForName((String) form); return c; } /* private static String maybeClassName(Object form, boolean stringOk){ String className = null; if(form instanceof Symbol) { Symbol sym = (Symbol) form; if(sym.ns == null) //if ns-qualified can't be classname { if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') className = sym.name; else { IPersistentMap imports = (IPersistentMap) ((Var) RT.NS_IMPORTS.get()).get(); className = (String) imports.valAt(sym); } } } else if(stringOk && form instanceof String) className = (String) form; return className; } */ static Class tagToClass(Object tag) throws Exception{ Class c = maybeClass(tag, true); if(tag instanceof Symbol) { Symbol sym = (Symbol) tag; if(sym.ns == null) //if ns-qualified can't be classname { if(sym.name.equals("objects")) c = Object[].class; else if(sym.name.equals("ints")) c = int[].class; else if(sym.name.equals("longs")) c = long[].class; else if(sym.name.equals("floats")) c = float[].class; else if(sym.name.equals("doubles")) c = double[].class; else if(sym.name.equals("chars")) c = char[].class; else if(sym.name.equals("shorts")) c = short[].class; else if(sym.name.equals("bytes")) c = byte[].class; else if(sym.name.equals("booleans")) c = boolean[].class; } } if(c != null) return c; throw new IllegalArgumentException("Unable to resolve classname: " + tag); } } static abstract class FieldExpr extends HostExpr{ } static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{ public final Expr target; public final Class targetClass; public final java.lang.reflect.Field field; public final String fieldName; public final int line; public final Symbol tag; final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String)"); final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)"); public InstanceFieldExpr(int line, Expr target, String fieldName, Symbol tag) throws Exception{ this.target = target; this.targetClass = target.hasJavaClass() ? target.getJavaClass() : null; this.field = targetClass != null ? Reflector.getField(targetClass, fieldName, false) : null; this.fieldName = fieldName; this.line = line; this.tag = tag; if(field == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) { RT.errPrintWriter() .format("Reflection warning, %s:%d - reference to field %s can't be resolved.\n", SOURCE_PATH.deref(), line, fieldName); } } public Object eval() throws Exception{ return Reflector.invokeNoArgInstanceMember(target.eval(), fieldName); } public boolean canEmitPrimitive(){ return targetClass != null && field != null && Util.isPrimitive(field.getType()); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(targetClass != null && field != null) { target.emit(C.EXPRESSION, objx, gen); gen.checkCast(getType(targetClass)); gen.getField(getType(targetClass), fieldName, Type.getType(field.getType())); } else throw new UnsupportedOperationException("Unboxed emit of unknown member"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(targetClass != null && field != null) { target.emit(C.EXPRESSION, objx, gen); gen.checkCast(getType(targetClass)); gen.getField(getType(targetClass), fieldName, Type.getType(field.getType())); //if(context != C.STATEMENT) HostExpr.emitBoxReturn(objx, gen, field.getType()); if(context == C.STATEMENT) { gen.pop(); } } else { target.emit(C.EXPRESSION, objx, gen); gen.push(fieldName); gen.invokeStatic(REFLECTOR_TYPE, invokeNoArgInstanceMember); if(context == C.STATEMENT) gen.pop(); } } public boolean hasJavaClass() throws Exception{ return field != null || tag != null; } public Class getJavaClass() throws Exception{ return tag != null ? HostExpr.tagToClass(tag) : field.getType(); } public Object evalAssign(Expr val) throws Exception{ return Reflector.setInstanceField(target.eval(), fieldName, val.eval()); } public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val){ gen.visitLineNumber(line, gen.mark()); if(targetClass != null && field != null) { target.emit(C.EXPRESSION, objx, gen); gen.checkCast(Type.getType(targetClass)); val.emit(C.EXPRESSION, objx, gen); gen.dupX1(); HostExpr.emitUnboxArg(objx, gen, field.getType()); gen.putField(Type.getType(targetClass), fieldName, Type.getType(field.getType())); } else { target.emit(C.EXPRESSION, objx, gen); gen.push(fieldName); val.emit(C.EXPRESSION, objx, gen); gen.invokeStatic(REFLECTOR_TYPE, setInstanceFieldMethod); } if(context == C.STATEMENT) gen.pop(); } } static class StaticFieldExpr extends FieldExpr implements AssignableExpr{ //final String className; public final String fieldName; public final Class c; public final java.lang.reflect.Field field; public final Symbol tag; // final static Method getStaticFieldMethod = Method.getMethod("Object getStaticField(String,String)"); // final static Method setStaticFieldMethod = Method.getMethod("Object setStaticField(String,String,Object)"); final int line; public StaticFieldExpr(int line, Class c, String fieldName, Symbol tag) throws Exception{ //this.className = className; this.fieldName = fieldName; this.line = line; //c = Class.forName(className); this.c = c; field = c.getField(fieldName); this.tag = tag; } public Object eval() throws Exception{ return Reflector.getStaticField(c, fieldName); } public boolean canEmitPrimitive(){ return Util.isPrimitive(field.getType()); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); gen.getStatic(Type.getType(c), fieldName, Type.getType(field.getType())); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); gen.getStatic(Type.getType(c), fieldName, Type.getType(field.getType())); //if(context != C.STATEMENT) HostExpr.emitBoxReturn(objx, gen, field.getType()); if(context == C.STATEMENT) { gen.pop(); } // gen.push(className); // gen.push(fieldName); // gen.invokeStatic(REFLECTOR_TYPE, getStaticFieldMethod); } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws Exception{ //Class c = Class.forName(className); //java.lang.reflect.Field field = c.getField(fieldName); return tag != null ? HostExpr.tagToClass(tag) : field.getType(); } public Object evalAssign(Expr val) throws Exception{ return Reflector.setStaticField(c, fieldName, val.eval()); } public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val){ gen.visitLineNumber(line, gen.mark()); val.emit(C.EXPRESSION, objx, gen); gen.dup(); HostExpr.emitUnboxArg(objx, gen, field.getType()); gen.putStatic(Type.getType(c), fieldName, Type.getType(field.getType())); if(context == C.STATEMENT) gen.pop(); } } static Class maybePrimitiveType(Expr e){ try { if(e instanceof MaybePrimitiveExpr && e.hasJavaClass() && ((MaybePrimitiveExpr)e).canEmitPrimitive()) { Class c = e.getJavaClass(); if(Util.isPrimitive(c)) return c; } } catch(Exception ex) { throw new RuntimeException(ex); } return null; } static abstract class MethodExpr extends HostExpr{ static void emitArgsAsArray(IPersistentVector args, ObjExpr objx, GeneratorAdapter gen){ gen.push(args.count()); gen.newArray(OBJECT_TYPE); for(int i = 0; i < args.count(); i++) { gen.dup(); gen.push(i); ((Expr) args.nth(i)).emit(C.EXPRESSION, objx, gen); gen.arrayStore(OBJECT_TYPE); } } public static void emitTypedArgs(ObjExpr objx, GeneratorAdapter gen, Class[] parameterTypes, IPersistentVector args){ for(int i = 0; i < parameterTypes.length; i++) { Expr e = (Expr) args.nth(i); try { if(maybePrimitiveType(e) == parameterTypes[i]) { ((MaybePrimitiveExpr) e).emitUnboxed(C.EXPRESSION, objx, gen); } else { e.emit(C.EXPRESSION, objx, gen); HostExpr.emitUnboxArg(objx, gen, parameterTypes[i]); } } catch(Exception e1) { e1.printStackTrace(RT.errPrintWriter()); } } } } static class InstanceMethodExpr extends MethodExpr{ public final Expr target; public final String methodName; public final IPersistentVector args; public final String source; public final int line; public final Symbol tag; public final java.lang.reflect.Method method; final static Method invokeInstanceMethodMethod = Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])"); public InstanceMethodExpr(String source, int line, Symbol tag, Expr target, String methodName, IPersistentVector args) throws Exception{ this.source = source; this.line = line; this.args = args; this.methodName = methodName; this.target = target; this.tag = tag; if(target.hasJavaClass() && target.getJavaClass() != null) { List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false); if(methods.isEmpty()) method = null; //throw new IllegalArgumentException("No matching method found"); else { int methodidx = 0; if(methods.size() > 1) { ArrayList params = new ArrayList(); ArrayList rets = new ArrayList(); for(int i = 0; i < methods.size(); i++) { java.lang.reflect.Method m = (java.lang.reflect.Method) methods.get(i); params.add(m.getParameterTypes()); rets.add(m.getReturnType()); } methodidx = getMatchingParams(methodName, params, args, rets); } java.lang.reflect.Method m = (java.lang.reflect.Method) (methodidx >= 0 ? methods.get(methodidx) : null); if(m != null && !Modifier.isPublic(m.getDeclaringClass().getModifiers())) { //public method of non-public class, try to find it in hierarchy m = Reflector.getAsMethodOfPublicBase(m.getDeclaringClass(), m); } method = m; } } else method = null; if(method == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) { RT.errPrintWriter() .format("Reflection warning, %s:%d - call to %s can't be resolved.\n", SOURCE_PATH.deref(), line, methodName); } } public Object eval() throws Exception{ try { Object targetval = target.eval(); Object[] argvals = new Object[args.count()]; for(int i = 0; i < args.count(); i++) argvals[i] = ((Expr) args.nth(i)).eval(); if(method != null) { LinkedList ms = new LinkedList(); ms.add(method); return Reflector.invokeMatchingMethod(methodName, ms, targetval, argvals); } return Reflector.invokeInstanceMethod(targetval, methodName, argvals); } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException(source, line, e); else throw (CompilerException) e; } } public boolean canEmitPrimitive(){ return method != null && Util.isPrimitive(method.getReturnType()); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(method != null) { Type type = Type.getType(method.getDeclaringClass()); target.emit(C.EXPRESSION, objx, gen); //if(!method.getDeclaringClass().isInterface()) gen.checkCast(type); MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); if(method.getDeclaringClass().isInterface()) gen.invokeInterface(type, m); else gen.invokeVirtual(type, m); } else throw new UnsupportedOperationException("Unboxed emit of unknown member"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(method != null) { Type type = Type.getType(method.getDeclaringClass()); target.emit(C.EXPRESSION, objx, gen); //if(!method.getDeclaringClass().isInterface()) gen.checkCast(type); MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); if(method.getDeclaringClass().isInterface()) gen.invokeInterface(type, m); else gen.invokeVirtual(type, m); //if(context != C.STATEMENT || method.getReturnType() == Void.TYPE) HostExpr.emitBoxReturn(objx, gen, method.getReturnType()); } else { target.emit(C.EXPRESSION, objx, gen); gen.push(methodName); emitArgsAsArray(args, objx, gen); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } gen.invokeStatic(REFLECTOR_TYPE, invokeInstanceMethodMethod); } if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return method != null || tag != null; } public Class getJavaClass() throws Exception{ return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType(); } } static class StaticMethodExpr extends MethodExpr{ //final String className; public final Class c; public final String methodName; public final IPersistentVector args; public final String source; public final int line; public final java.lang.reflect.Method method; public final Symbol tag; final static Method forNameMethod = Method.getMethod("Class forName(String)"); final static Method invokeStaticMethodMethod = Method.getMethod("Object invokeStaticMethod(Class,String,Object[])"); public StaticMethodExpr(String source, int line, Symbol tag, Class c, String methodName, IPersistentVector args) throws Exception{ this.c = c; this.methodName = methodName; this.args = args; this.source = source; this.line = line; this.tag = tag; List methods = Reflector.getMethods(c, args.count(), methodName, true); if(methods.isEmpty()) throw new IllegalArgumentException("No matching method: " + methodName); int methodidx = 0; if(methods.size() > 1) { ArrayList params = new ArrayList(); ArrayList rets = new ArrayList(); for(int i = 0; i < methods.size(); i++) { java.lang.reflect.Method m = (java.lang.reflect.Method) methods.get(i); params.add(m.getParameterTypes()); rets.add(m.getReturnType()); } methodidx = getMatchingParams(methodName, params, args, rets); } method = (java.lang.reflect.Method) (methodidx >= 0 ? methods.get(methodidx) : null); if(method == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) { RT.errPrintWriter() .format("Reflection warning, %s:%d - call to %s can't be resolved.\n", SOURCE_PATH.deref(), line, methodName); } } public Object eval() throws Exception{ try { Object[] argvals = new Object[args.count()]; for(int i = 0; i < args.count(); i++) argvals[i] = ((Expr) args.nth(i)).eval(); if(method != null) { LinkedList ms = new LinkedList(); ms.add(method); return Reflector.invokeMatchingMethod(methodName, ms, null, argvals); } return Reflector.invokeStaticMethod(c, methodName, argvals); } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException(source, line, e); else throw (CompilerException) e; } } public boolean canEmitPrimitive(){ return method != null && Util.isPrimitive(method.getReturnType()); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(method != null) { MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); //Type type = Type.getObjectType(className.replace('.', '/')); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } Type type = Type.getType(c); Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); gen.invokeStatic(type, m); } else throw new UnsupportedOperationException("Unboxed emit of unknown member"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(method != null) { MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); //Type type = Type.getObjectType(className.replace('.', '/')); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } Type type = Type.getType(c); Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); gen.invokeStatic(type, m); //if(context != C.STATEMENT || method.getReturnType() == Void.TYPE) HostExpr.emitBoxReturn(objx, gen, method.getReturnType()); } else { gen.push(c.getName()); gen.invokeStatic(CLASS_TYPE, forNameMethod); gen.push(methodName); emitArgsAsArray(args, objx, gen); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } gen.invokeStatic(REFLECTOR_TYPE, invokeStaticMethodMethod); } if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return method != null || tag != null; } public Class getJavaClass() throws Exception{ return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType(); } } static class UnresolvedVarExpr implements Expr{ public final Symbol symbol; public UnresolvedVarExpr(Symbol symbol){ this.symbol = symbol; } public boolean hasJavaClass(){ return false; } public Class getJavaClass() throws Exception{ throw new IllegalArgumentException( "UnresolvedVarExpr has no Java class"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ } public Object eval() throws Exception{ throw new IllegalArgumentException( "UnresolvedVarExpr cannot be evalled"); } } static class ConstantExpr extends LiteralExpr{ //stuff quoted vals in classloader at compile time, pull out at runtime //this won't work for static compilation... public final Object v; public final int id; public ConstantExpr(Object v){ this.v = v; this.id = registerConstant(v); // this.id = RT.nextID(); // DynamicClassLoader loader = (DynamicClassLoader) LOADER.get(); // loader.registerQuotedVal(id, v); } Object val(){ return v; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ objx.emitConstant(gen, id); if(context == C.STATEMENT) { gen.pop(); // gen.loadThis(); // gen.invokeVirtual(OBJECT_TYPE, getClassMethod); // gen.invokeVirtual(CLASS_TYPE, getClassLoaderMethod); // gen.checkCast(DYNAMIC_CLASSLOADER_TYPE); // gen.push(id); // gen.invokeVirtual(DYNAMIC_CLASSLOADER_TYPE, getQuotedValMethod); } } public boolean hasJavaClass(){ return Modifier.isPublic(v.getClass().getModifiers()); //return false; } public Class getJavaClass() throws Exception{ return v.getClass(); //throw new IllegalArgumentException("Has no Java class"); } static class Parser implements IParser{ public Expr parse(C context, Object form){ Object v = RT.second(form); if(v == null) return NIL_EXPR; // Class fclass = v.getClass(); // if(fclass == Keyword.class) // return registerKeyword((Keyword) v); // else if(v instanceof Num) // return new NumExpr((Num) v); // else if(fclass == String.class) // return new StringExpr((String) v); // else if(fclass == Character.class) // return new CharExpr((Character) v); // else if(v instanceof IPersistentCollection && ((IPersistentCollection) v).count() == 0) // return new EmptyExpr(v); else return new ConstantExpr(v); } } } static class NilExpr extends LiteralExpr{ Object val(){ return null; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitInsn(Opcodes.ACONST_NULL); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws Exception{ return null; } } final static NilExpr NIL_EXPR = new NilExpr(); static class BooleanExpr extends LiteralExpr{ public final boolean val; public BooleanExpr(boolean val){ this.val = val; } Object val(){ return val ? RT.T : RT.F; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ if(val) gen.getStatic(BOOLEAN_OBJECT_TYPE, "TRUE", BOOLEAN_OBJECT_TYPE); else gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE); if(context == C.STATEMENT) { gen.pop(); } } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws Exception{ return Boolean.class; } } final static BooleanExpr TRUE_EXPR = new BooleanExpr(true); final static BooleanExpr FALSE_EXPR = new BooleanExpr(false); static class StringExpr extends LiteralExpr{ public final String str; public StringExpr(String str){ this.str = str; } Object val(){ return str; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ if(context != C.STATEMENT) gen.push(str); } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws Exception{ return String.class; } } static class MonitorEnterExpr extends UntypedExpr{ final Expr target; public MonitorEnterExpr(Expr target){ this.target = target; } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval monitor-enter"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ target.emit(C.EXPRESSION, objx, gen); gen.monitorEnter(); NIL_EXPR.emit(context, objx, gen); } static class Parser implements IParser{ public Expr parse(C context, Object form) throws Exception{ return new MonitorEnterExpr(analyze(C.EXPRESSION, RT.second(form))); } } } static class MonitorExitExpr extends UntypedExpr{ final Expr target; public MonitorExitExpr(Expr target){ this.target = target; } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval monitor-exit"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ target.emit(C.EXPRESSION, objx, gen); gen.monitorExit(); NIL_EXPR.emit(context, objx, gen); } static class Parser implements IParser{ public Expr parse(C context, Object form) throws Exception{ return new MonitorExitExpr(analyze(C.EXPRESSION, RT.second(form))); } } } public static class TryExpr implements Expr{ public final Expr tryExpr; public final Expr finallyExpr; public final PersistentVector catchExprs; public final int retLocal; public final int finallyLocal; public static class CatchClause{ //final String className; public final Class c; public final LocalBinding lb; public final Expr handler; Label label; Label endLabel; public CatchClause(Class c, LocalBinding lb, Expr handler){ this.c = c; this.lb = lb; this.handler = handler; } } public TryExpr(Expr tryExpr, PersistentVector catchExprs, Expr finallyExpr, int retLocal, int finallyLocal){ this.tryExpr = tryExpr; this.catchExprs = catchExprs; this.finallyExpr = finallyExpr; this.retLocal = retLocal; this.finallyLocal = finallyLocal; } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval try"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ Label startTry = gen.newLabel(); Label endTry = gen.newLabel(); Label end = gen.newLabel(); Label ret = gen.newLabel(); Label finallyLabel = gen.newLabel(); for(int i = 0; i < catchExprs.count(); i++) { CatchClause clause = (CatchClause) catchExprs.nth(i); clause.label = gen.newLabel(); clause.endLabel = gen.newLabel(); } gen.mark(startTry); tryExpr.emit(context, objx, gen); if(context != C.STATEMENT) gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), retLocal); gen.mark(endTry); if(finallyExpr != null) finallyExpr.emit(C.STATEMENT, objx, gen); gen.goTo(ret); for(int i = 0; i < catchExprs.count(); i++) { CatchClause clause = (CatchClause) catchExprs.nth(i); gen.mark(clause.label); //exception should be on stack //put in clause local gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), clause.lb.idx); clause.handler.emit(context, objx, gen); if(context != C.STATEMENT) gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), retLocal); gen.mark(clause.endLabel); if(finallyExpr != null) finallyExpr.emit(C.STATEMENT, objx, gen); gen.goTo(ret); } if(finallyExpr != null) { gen.mark(finallyLabel); //exception should be on stack gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), finallyLocal); finallyExpr.emit(C.STATEMENT, objx, gen); gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), finallyLocal); gen.throwException(); } gen.mark(ret); if(context != C.STATEMENT) gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), retLocal); gen.mark(end); for(int i = 0; i < catchExprs.count(); i++) { CatchClause clause = (CatchClause) catchExprs.nth(i); gen.visitTryCatchBlock(startTry, endTry, clause.label, clause.c.getName().replace('.', '/')); } if(finallyExpr != null) { gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null); for(int i = 0; i < catchExprs.count(); i++) { CatchClause clause = (CatchClause) catchExprs.nth(i); gen.visitTryCatchBlock(clause.label, clause.endLabel, finallyLabel, null); } } for(int i = 0; i < catchExprs.count(); i++) { CatchClause clause = (CatchClause) catchExprs.nth(i); gen.visitLocalVariable(clause.lb.name, "Ljava/lang/Object;", null, clause.label, clause.endLabel, clause.lb.idx); } } public boolean hasJavaClass() throws Exception{ return tryExpr.hasJavaClass(); } public Class getJavaClass() throws Exception{ return tryExpr.getJavaClass(); } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; // if(context == C.EVAL || context == C.EXPRESSION) if(context != C.RETURN) return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); //(try try-expr* catch-expr* finally-expr?) //catch-expr: (catch class sym expr*) //finally-expr: (finally expr*) PersistentVector body = PersistentVector.EMPTY; PersistentVector catches = PersistentVector.EMPTY; Expr bodyExpr = null; Expr finallyExpr = null; boolean caught = false; int retLocal = getAndIncLocalNum(); int finallyLocal = getAndIncLocalNum(); for(ISeq fs = form.next(); fs != null; fs = fs.next()) { Object f = fs.first(); Object op = (f instanceof ISeq) ? ((ISeq) f).first() : null; if(!Util.equals(op, CATCH) && !Util.equals(op, FINALLY)) { if(caught) throw new Exception("Only catch or finally clause can follow catch in try expression"); body = body.cons(f); } else { if(bodyExpr == null) bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); if(Util.equals(op, CATCH)) { Class c = HostExpr.maybeClass(RT.second(f), false); if(c == null) throw new IllegalArgumentException("Unable to resolve classname: " + RT.second(f)); if(!(RT.third(f) instanceof Symbol)) throw new IllegalArgumentException( "Bad binding form, expected symbol, got: " + RT.third(f)); Symbol sym = (Symbol) RT.third(f); if(sym.getNamespace() != null) throw new Exception("Can't bind qualified name:" + sym); IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(), NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref(), IN_CATCH_FINALLY, RT.T); try { Var.pushThreadBindings(dynamicBindings); LocalBinding lb = registerLocal(sym, (Symbol) (RT.second(f) instanceof Symbol ? RT.second(f) : null), null,false); Expr handler = (new BodyExpr.Parser()).parse(context, RT.next(RT.next(RT.next(f)))); catches = catches.cons(new CatchClause(c, lb, handler)); } finally { Var.popThreadBindings(); } caught = true; } else //finally { if(fs.next() != null) throw new Exception("finally clause must be last in try expression"); try { Var.pushThreadBindings(RT.map(IN_CATCH_FINALLY, RT.T)); finallyExpr = (new BodyExpr.Parser()).parse(C.STATEMENT, RT.next(f)); } finally { Var.popThreadBindings(); } } } } if(bodyExpr == null) bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); return new TryExpr(bodyExpr, catches, finallyExpr, retLocal, finallyLocal); } } } //static class TryFinallyExpr implements Expr{ // final Expr tryExpr; // final Expr finallyExpr; // // // public TryFinallyExpr(Expr tryExpr, Expr finallyExpr){ // this.tryExpr = tryExpr; // this.finallyExpr = finallyExpr; // } // // public Object eval() throws Exception{ // throw new UnsupportedOperationException("Can't eval try"); // } // // public void emit(C context, FnExpr fn, GeneratorAdapter gen){ // Label startTry = gen.newLabel(); // Label endTry = gen.newLabel(); // Label end = gen.newLabel(); // Label finallyLabel = gen.newLabel(); // gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null); // gen.mark(startTry); // tryExpr.emit(context, fn, gen); // gen.mark(endTry); // finallyExpr.emit(C.STATEMENT, fn, gen); // gen.goTo(end); // gen.mark(finallyLabel); // //exception should be on stack // finallyExpr.emit(C.STATEMENT, fn, gen); // gen.throwException(); // gen.mark(end); // } // // public boolean hasJavaClass() throws Exception{ // return tryExpr.hasJavaClass(); // } // // public Class getJavaClass() throws Exception{ // return tryExpr.getJavaClass(); // } // // static class Parser implements IParser{ // public Expr parse(C context, Object frm) throws Exception{ // ISeq form = (ISeq) frm; // //(try-finally try-expr finally-expr) // if(form.count() != 3) // throw new IllegalArgumentException( // "Wrong number of arguments, expecting: (try-finally try-expr finally-expr) "); // // if(context == C.EVAL || context == C.EXPRESSION) // return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); // // return new TryFinallyExpr(analyze(context, RT.second(form)), // analyze(C.STATEMENT, RT.third(form))); // } // } //} static class ThrowExpr extends UntypedExpr{ public final Expr excExpr; public ThrowExpr(Expr excExpr){ this.excExpr = excExpr; } public Object eval() throws Exception{ throw new Exception("Can't eval throw"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ excExpr.emit(C.EXPRESSION, objx, gen); gen.checkCast(THROWABLE_TYPE); gen.throwException(); } static class Parser implements IParser{ public Expr parse(C context, Object form) throws Exception{ if(context == C.EVAL) return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); return new ThrowExpr(analyze(C.EXPRESSION, RT.second(form))); } } } static public boolean subsumes(Class[] c1, Class[] c2){ //presumes matching lengths Boolean better = false; for(int i = 0; i < c1.length; i++) { if(c1[i] != c2[i])// || c2[i].isPrimitive() && c1[i] == Object.class)) { if(!c1[i].isPrimitive() && c2[i].isPrimitive() //|| Number.class.isAssignableFrom(c1[i]) && c2[i].isPrimitive() || c2[i].isAssignableFrom(c1[i])) better = true; else return false; } } return better; } static int getMatchingParams(String methodName, ArrayList paramlists, IPersistentVector argexprs, List rets) throws Exception{ //presumes matching lengths int matchIdx = -1; boolean tied = false; boolean foundExact = false; for(int i = 0; i < paramlists.size(); i++) { boolean match = true; ISeq aseq = argexprs.seq(); int exact = 0; for(int p = 0; match && p < argexprs.count() && aseq != null; ++p, aseq = aseq.next()) { Expr arg = (Expr) aseq.first(); Class aclass = arg.hasJavaClass() ? arg.getJavaClass() : Object.class; Class pclass = paramlists.get(i)[p]; if(arg.hasJavaClass() && aclass == pclass) exact++; else match = Reflector.paramArgTypeMatch(pclass, aclass); } if(exact == argexprs.count()) { if(!foundExact || matchIdx == -1 || rets.get(matchIdx).isAssignableFrom(rets.get(i))) matchIdx = i; foundExact = true; } else if(match && !foundExact) { if(matchIdx == -1) matchIdx = i; else { if(subsumes(paramlists.get(i), paramlists.get(matchIdx))) { matchIdx = i; tied = false; } else if(Arrays.equals(paramlists.get(matchIdx), paramlists.get(i))) { if(rets.get(matchIdx).isAssignableFrom(rets.get(i))) matchIdx = i; } else if(!(subsumes(paramlists.get(matchIdx), paramlists.get(i)))) tied = true; } } } if(tied) throw new IllegalArgumentException("More than one matching method found: " + methodName); return matchIdx; } public static class NewExpr implements Expr{ public final IPersistentVector args; public final Constructor ctor; public final Class c; final static Method invokeConstructorMethod = Method.getMethod("Object invokeConstructor(Class,Object[])"); // final static Method forNameMethod = Method.getMethod("Class classForName(String)"); final static Method forNameMethod = Method.getMethod("Class forName(String)"); public NewExpr(Class c, IPersistentVector args, int line) throws Exception{ this.args = args; this.c = c; Constructor[] allctors = c.getConstructors(); ArrayList ctors = new ArrayList(); ArrayList params = new ArrayList(); ArrayList rets = new ArrayList(); for(int i = 0; i < allctors.length; i++) { Constructor ctor = allctors[i]; if(ctor.getParameterTypes().length == args.count()) { ctors.add(ctor); params.add(ctor.getParameterTypes()); rets.add(c); } } if(ctors.isEmpty()) throw new IllegalArgumentException("No matching ctor found for " + c); int ctoridx = 0; if(ctors.size() > 1) { ctoridx = getMatchingParams(c.getName(), params, args, rets); } this.ctor = ctoridx >= 0 ? (Constructor) ctors.get(ctoridx) : null; if(ctor == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) { RT.errPrintWriter() .format("Reflection warning, %s:%d - call to %s ctor can't be resolved.\n", SOURCE_PATH.deref(), line, c.getName()); } } public Object eval() throws Exception{ Object[] argvals = new Object[args.count()]; for(int i = 0; i < args.count(); i++) argvals[i] = ((Expr) args.nth(i)).eval(); if(this.ctor != null) { return ctor.newInstance(Reflector.boxArgs(ctor.getParameterTypes(), argvals)); } return Reflector.invokeConstructor(c, argvals); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ if(this.ctor != null) { Type type = getType(c); gen.newInstance(type); gen.dup(); MethodExpr.emitTypedArgs(objx, gen, ctor.getParameterTypes(), args); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } gen.invokeConstructor(type, new Method("", Type.getConstructorDescriptor(ctor))); } else { gen.push(destubClassName(c.getName())); gen.invokeStatic(CLASS_TYPE, forNameMethod); MethodExpr.emitArgsAsArray(args, objx, gen); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } gen.invokeStatic(REFLECTOR_TYPE, invokeConstructorMethod); } if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass(){ return true; } public Class getJavaClass() throws Exception{ return c; } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ int line = (Integer) LINE.deref(); ISeq form = (ISeq) frm; //(new Classname args...) if(form.count() < 2) throw new Exception("wrong number of arguments, expecting: (new Classname args...)"); Class c = HostExpr.maybeClass(RT.second(form), false); if(c == null) throw new IllegalArgumentException("Unable to resolve classname: " + RT.second(form)); PersistentVector args = PersistentVector.EMPTY; for(ISeq s = RT.next(RT.next(form)); s != null; s = s.next()) args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first())); return new NewExpr(c, args, line); } } } public static class MetaExpr implements Expr{ public final Expr expr; public final MapExpr meta; final static Type IOBJ_TYPE = Type.getType(IObj.class); final static Method withMetaMethod = Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)"); public MetaExpr(Expr expr, MapExpr meta){ this.expr = expr; this.meta = meta; } public Object eval() throws Exception{ return ((IObj) expr.eval()).withMeta((IPersistentMap) meta.eval()); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ expr.emit(C.EXPRESSION, objx, gen); gen.checkCast(IOBJ_TYPE); meta.emit(C.EXPRESSION, objx, gen); gen.checkCast(IPERSISTENTMAP_TYPE); gen.invokeInterface(IOBJ_TYPE, withMetaMethod); if(context == C.STATEMENT) { gen.pop(); } } public boolean hasJavaClass() throws Exception{ return expr.hasJavaClass(); } public Class getJavaClass() throws Exception{ return expr.getJavaClass(); } } public static class IfExpr implements Expr, MaybePrimitiveExpr{ public final Expr testExpr; public final Expr thenExpr; public final Expr elseExpr; public final int line; public IfExpr(int line, Expr testExpr, Expr thenExpr, Expr elseExpr){ this.testExpr = testExpr; this.thenExpr = thenExpr; this.elseExpr = elseExpr; this.line = line; } public Object eval() throws Exception{ Object t = testExpr.eval(); if(t != null && t != Boolean.FALSE) return thenExpr.eval(); return elseExpr.eval(); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ doEmit(context, objx, gen,false); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ doEmit(context, objx, gen, true); } public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUnboxed){ Label nullLabel = gen.newLabel(); Label falseLabel = gen.newLabel(); Label endLabel = gen.newLabel(); gen.visitLineNumber(line, gen.mark()); try { if(maybePrimitiveType(testExpr) == boolean.class) { ((MaybePrimitiveExpr) testExpr).emitUnboxed(C.EXPRESSION, objx, gen); gen.ifZCmp(gen.EQ, falseLabel); } else { testExpr.emit(C.EXPRESSION, objx, gen); gen.dup(); gen.ifNull(nullLabel); gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE); gen.visitJumpInsn(IF_ACMPEQ, falseLabel); } } catch(Exception e) { throw new RuntimeException(e); } if(emitUnboxed) ((MaybePrimitiveExpr)thenExpr).emitUnboxed(context, objx, gen); else thenExpr.emit(context, objx, gen); gen.goTo(endLabel); gen.mark(nullLabel); gen.pop(); gen.mark(falseLabel); if(emitUnboxed) ((MaybePrimitiveExpr)elseExpr).emitUnboxed(context, objx, gen); else elseExpr.emit(context, objx, gen); gen.mark(endLabel); } public boolean hasJavaClass() throws Exception{ return thenExpr.hasJavaClass() && elseExpr.hasJavaClass() && (thenExpr.getJavaClass() == elseExpr.getJavaClass() || (thenExpr.getJavaClass() == null && !elseExpr.getJavaClass().isPrimitive()) || (elseExpr.getJavaClass() == null && !thenExpr.getJavaClass().isPrimitive())); } public boolean canEmitPrimitive(){ try { return thenExpr instanceof MaybePrimitiveExpr && elseExpr instanceof MaybePrimitiveExpr && thenExpr.getJavaClass() == elseExpr.getJavaClass() && ((MaybePrimitiveExpr)thenExpr).canEmitPrimitive() && ((MaybePrimitiveExpr)elseExpr).canEmitPrimitive(); } catch(Exception e) { return false; } } public Class getJavaClass() throws Exception{ Class thenClass = thenExpr.getJavaClass(); if(thenClass != null) return thenClass; return elseExpr.getJavaClass(); } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; //(if test then) or (if test then else) if(form.count() > 4) throw new Exception("Too many arguments to if"); else if(form.count() < 3) throw new Exception("Too few arguments to if"); PathNode branch = new PathNode(PATHTYPE.BRANCH, (PathNode) CLEAR_PATH.get()); Expr testexpr = analyze(context == C.EVAL ? context : C.EXPRESSION, RT.second(form)); Expr thenexpr, elseexpr; try { Var.pushThreadBindings( RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); thenexpr = analyze(context, RT.third(form)); } finally{ Var.popThreadBindings(); } try { Var.pushThreadBindings( RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); elseexpr = analyze(context, RT.fourth(form)); } finally{ Var.popThreadBindings(); } return new IfExpr((Integer) LINE.deref(), testexpr, thenexpr, elseexpr); } } } static final public IPersistentMap CHAR_MAP = PersistentHashMap.create('-', "_", // '.', "_DOT_", ':', "_COLON_", '+', "_PLUS_", '>', "_GT_", '<', "_LT_", '=', "_EQ_", '~', "_TILDE_", '!', "_BANG_", '@', "_CIRCA_", '#', "_SHARP_", '$', "_DOLLARSIGN_", '%', "_PERCENT_", '^', "_CARET_", '&', "_AMPERSAND_", '*', "_STAR_", '|', "_BAR_", '{', "_LBRACE_", '}', "_RBRACE_", '[', "_LBRACK_", ']', "_RBRACK_", '/', "_SLASH_", '\\', "_BSLASH_", '?', "_QMARK_"); static public String munge(String name){ StringBuilder sb = new StringBuilder(); for(char c : name.toCharArray()) { String sub = (String) CHAR_MAP.valAt(c); if(sub != null) sb.append(sub); else sb.append(c); } return sb.toString(); } public static class EmptyExpr implements Expr{ public final Object coll; final static Type HASHMAP_TYPE = Type.getType(PersistentArrayMap.class); final static Type HASHSET_TYPE = Type.getType(PersistentHashSet.class); final static Type VECTOR_TYPE = Type.getType(PersistentVector.class); final static Type LIST_TYPE = Type.getType(PersistentList.class); final static Type EMPTY_LIST_TYPE = Type.getType(PersistentList.EmptyList.class); public EmptyExpr(Object coll){ this.coll = coll; } public Object eval() throws Exception{ return coll; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ if(coll instanceof IPersistentList) gen.getStatic(LIST_TYPE, "EMPTY", EMPTY_LIST_TYPE); else if(coll instanceof IPersistentVector) gen.getStatic(VECTOR_TYPE, "EMPTY", VECTOR_TYPE); else if(coll instanceof IPersistentMap) gen.getStatic(HASHMAP_TYPE, "EMPTY", HASHMAP_TYPE); else if(coll instanceof IPersistentSet) gen.getStatic(HASHSET_TYPE, "EMPTY", HASHSET_TYPE); else throw new UnsupportedOperationException("Unknown Collection type"); if(context == C.STATEMENT) { gen.pop(); } } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ if(coll instanceof IPersistentList) return IPersistentList.class; else if(coll instanceof IPersistentVector) return IPersistentVector.class; else if(coll instanceof IPersistentMap) return IPersistentMap.class; else if(coll instanceof IPersistentSet) return IPersistentSet.class; else throw new UnsupportedOperationException("Unknown Collection type"); } } public static class ListExpr implements Expr{ public final IPersistentVector args; final static Method arrayToListMethod = Method.getMethod("clojure.lang.ISeq arrayToList(Object[])"); public ListExpr(IPersistentVector args){ this.args = args; } public Object eval() throws Exception{ IPersistentVector ret = PersistentVector.EMPTY; for(int i = 0; i < args.count(); i++) ret = (IPersistentVector) ret.cons(((Expr) args.nth(i)).eval()); return ret.seq(); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ MethodExpr.emitArgsAsArray(args, objx, gen); gen.invokeStatic(RT_TYPE, arrayToListMethod); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return IPersistentList.class; } } public static class MapExpr implements Expr{ public final IPersistentVector keyvals; final static Method mapMethod = Method.getMethod("clojure.lang.IPersistentMap map(Object[])"); public MapExpr(IPersistentVector keyvals){ this.keyvals = keyvals; } public Object eval() throws Exception{ Object[] ret = new Object[keyvals.count()]; for(int i = 0; i < keyvals.count(); i++) ret[i] = ((Expr) keyvals.nth(i)).eval(); return RT.map(ret); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ MethodExpr.emitArgsAsArray(keyvals, objx, gen); gen.invokeStatic(RT_TYPE, mapMethod); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return IPersistentMap.class; } static public Expr parse(C context, IPersistentMap form) throws Exception{ IPersistentVector keyvals = PersistentVector.EMPTY; for(ISeq s = RT.seq(form); s != null; s = s.next()) { IMapEntry e = (IMapEntry) s.first(); keyvals = (IPersistentVector) keyvals.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e.key())); keyvals = (IPersistentVector) keyvals.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e.val())); } Expr ret = new MapExpr(keyvals); if(form instanceof IObj && ((IObj) form).meta() != null) return new MetaExpr(ret, (MapExpr) MapExpr .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); else return ret; } } public static class SetExpr implements Expr{ public final IPersistentVector keys; final static Method setMethod = Method.getMethod("clojure.lang.IPersistentSet set(Object[])"); public SetExpr(IPersistentVector keys){ this.keys = keys; } public Object eval() throws Exception{ Object[] ret = new Object[keys.count()]; for(int i = 0; i < keys.count(); i++) ret[i] = ((Expr) keys.nth(i)).eval(); return RT.set(ret); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ MethodExpr.emitArgsAsArray(keys, objx, gen); gen.invokeStatic(RT_TYPE, setMethod); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return IPersistentSet.class; } static public Expr parse(C context, IPersistentSet form) throws Exception{ IPersistentVector keys = PersistentVector.EMPTY; for(ISeq s = RT.seq(form); s != null; s = s.next()) { Object e = s.first(); keys = (IPersistentVector) keys.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e)); } Expr ret = new SetExpr(keys); if(form instanceof IObj && ((IObj) form).meta() != null) return new MetaExpr(ret, (MapExpr) MapExpr .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); else return ret; } } public static class VectorExpr implements Expr{ public final IPersistentVector args; final static Method vectorMethod = Method.getMethod("clojure.lang.IPersistentVector vector(Object[])"); public VectorExpr(IPersistentVector args){ this.args = args; } public Object eval() throws Exception{ IPersistentVector ret = PersistentVector.EMPTY; for(int i = 0; i < args.count(); i++) ret = (IPersistentVector) ret.cons(((Expr) args.nth(i)).eval()); return ret; } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ MethodExpr.emitArgsAsArray(args, objx, gen); gen.invokeStatic(RT_TYPE, vectorMethod); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return IPersistentVector.class; } static public Expr parse(C context, IPersistentVector form) throws Exception{ IPersistentVector args = PersistentVector.EMPTY; for(int i = 0; i < form.count(); i++) args = (IPersistentVector) args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, form.nth(i))); Expr ret = new VectorExpr(args); if(form instanceof IObj && ((IObj) form).meta() != null) return new MetaExpr(ret, (MapExpr) MapExpr .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); else return ret; } } static class KeywordInvokeExpr implements Expr{ public final KeywordExpr kw; public final Object tag; public final Expr target; public final int line; public final int siteIndex; public final String source; static Type ILOOKUP_TYPE = Type.getType(ILookup.class); public KeywordInvokeExpr(String source, int line, Symbol tag, KeywordExpr kw, Expr target){ this.source = source; this.kw = kw; this.target = target; this.line = line; this.tag = tag; this.siteIndex = registerKeywordCallsite(kw.k); } public Object eval() throws Exception{ try { return kw.k.invoke(target.eval()); } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException(source, line, e); else throw (CompilerException) e; } } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ Label endLabel = gen.newLabel(); Label faultLabel = gen.newLabel(); gen.visitLineNumber(line, gen.mark()); gen.getStatic(objx.objtype, objx.thunkNameStatic(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE); gen.dup(); target.emit(C.EXPRESSION, objx, gen); gen.dupX2(); gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, Method.getMethod("Object get(Object)")); gen.dupX2(); gen.visitJumpInsn(IF_ACMPEQ, faultLabel); gen.pop(); gen.goTo(endLabel); gen.mark(faultLabel); gen.swap(); gen.pop(); gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE); gen.swap(); gen.loadThis(); gen.invokeInterface(ObjExpr.ILOOKUP_SITE_TYPE, Method.getMethod("Object fault(Object, clojure.lang.ILookupHost)")); gen.mark(endLabel); if(context == C.STATEMENT) gen.pop(); } public void emit2(C context, ObjExpr objx, GeneratorAdapter gen){ Label endLabel = gen.newLabel(); Label faultLabel = gen.newLabel(); gen.visitLineNumber(line, gen.mark()); target.emit(C.EXPRESSION, objx, gen); gen.dup(); gen.getStatic(objx.objtype, objx.thunkNameStatic(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE); gen.swap(); gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE); /// gen.loadThis(); gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, Method.getMethod("Object get(Object,clojure.lang.ILookupSite)")); // gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, // Method.getMethod("Object get(Object,clojure.lang.ILookupSite,clojure.lang.ILookupHost)")); gen.dup(); gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE); gen.visitJumpInsn(IF_ACMPEQ, faultLabel); gen.swap(); gen.pop(); gen.goTo(endLabel); gen.mark(faultLabel); gen.swap(); gen.loadThis(); gen.invokeInterface(ObjExpr.ILOOKUP_SITE_TYPE, Method.getMethod("Object fault(Object, clojure.lang.ILookupHost)")); gen.mark(endLabel); if(context == C.STATEMENT) gen.pop(); } public void emitInstance(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); gen.loadThis(); gen.getField(objx.objtype, objx.thunkName(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE); target.emit(C.EXPRESSION, objx, gen); gen.loadThis(); gen.getField(objx.objtype, objx.siteName(siteIndex),ObjExpr.ILOOKUP_SITE_TYPE); gen.loadThis(); gen.checkCast(Type.getType(ILookupHost.class)); gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, Method.getMethod("Object get(Object,clojure.lang.ILookupSite,clojure.lang.ILookupHost)")); if(context == C.STATEMENT) gen.pop(); } public void emitNormal(C context, ObjExpr objx, GeneratorAdapter gen){ Label slowLabel = gen.newLabel(); Label endLabel = gen.newLabel(); gen.visitLineNumber(line, gen.mark()); target.emit(C.EXPRESSION, objx, gen); gen.dup(); gen.instanceOf(ILOOKUP_TYPE); gen.ifZCmp(GeneratorAdapter.EQ, slowLabel); kw.emit(C.EXPRESSION, objx, gen); gen.invokeInterface(ILOOKUP_TYPE, new Method("valAt", OBJECT_TYPE, ARG_TYPES[1])); gen.goTo(endLabel); gen.mark(slowLabel); kw.emit(C.EXPRESSION, objx, gen); gen.invokeStatic(RT_TYPE, new Method("get", OBJECT_TYPE, ARG_TYPES[2])); gen.mark(endLabel); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return tag != null; } public Class getJavaClass() throws Exception{ return HostExpr.tagToClass(tag); } } //static class KeywordSiteInvokeExpr implements Expr{ // public final Expr site; // public final Object tag; // public final Expr target; // public final int line; // public final String source; // // public KeywordSiteInvokeExpr(String source, int line, Symbol tag, Expr site, Expr target){ // this.source = source; // this.site = site; // this.target = target; // this.line = line; // this.tag = tag; // } // // public Object eval() throws Exception{ // try // { // KeywordCallSite s = (KeywordCallSite) site.eval(); // return s.thunk.invoke(s,target.eval()); // } // catch(Throwable e) // { // if(!(e instanceof CompilerException)) // throw new CompilerException(source, line, e); // else // throw (CompilerException) e; // } // } // // public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ // gen.visitLineNumber(line, gen.mark()); // site.emit(C.EXPRESSION, objx, gen); // gen.dup(); // gen.getField(Type.getType(KeywordCallSite.class),"thunk",IFN_TYPE); // gen.swap(); // target.emit(C.EXPRESSION, objx, gen); // // gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[2])); // if(context == C.STATEMENT) // gen.pop(); // } // // public boolean hasJavaClass() throws Exception{ // return tag != null; // } // // public Class getJavaClass() throws Exception{ // return HostExpr.tagToClass(tag); // } // //} public static class InstanceOfExpr implements Expr, MaybePrimitiveExpr{ Expr expr; Class c; public InstanceOfExpr(Class c, Expr expr){ this.expr = expr; this.c = c; } public Object eval() throws Exception{ if(c.isInstance(expr.eval())) return RT.T; return RT.F; } public boolean canEmitPrimitive(){ return true; } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ expr.emit(C.EXPRESSION,objx,gen); gen.instanceOf(Type.getType(c)); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ emitUnboxed(context,objx,gen); HostExpr.emitBoxReturn(objx,gen,Boolean.TYPE); if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return Boolean.TYPE; } } static class InvokeExpr implements Expr{ public final Expr fexpr; public final Object tag; public final IPersistentVector args; public final int line; public final String source; public boolean isProtocol = false; public boolean isDirect = false; public int siteIndex = -1; public Class protocolOn; public java.lang.reflect.Method onMethod; static Keyword onKey = Keyword.intern("on"); static Keyword methodMapKey = Keyword.intern("method-map"); static Keyword dynamicKey = Keyword.intern("dynamic"); public InvokeExpr(String source, int line, Symbol tag, Expr fexpr, IPersistentVector args) throws Exception{ this.source = source; this.fexpr = fexpr; this.args = args; this.line = line; if(fexpr instanceof VarExpr) { Var fvar = ((VarExpr)fexpr).var; Var pvar = (Var)RT.get(fvar.meta(), protocolKey); if(pvar != null && PROTOCOL_CALLSITES.isBound()) { this.isProtocol = true; this.siteIndex = registerProtocolCallsite(((VarExpr)fexpr).var); Object pon = RT.get(pvar.get(), onKey); this.protocolOn = HostExpr.maybeClass(pon,false); if(this.protocolOn != null) { IPersistentMap mmap = (IPersistentMap) RT.get(pvar.get(), methodMapKey); Keyword mmapVal = (Keyword) mmap.valAt(Keyword.intern(fvar.sym)); if (mmapVal == null) { throw new IllegalArgumentException( "No method of interface: " + protocolOn.getName() + " found for function: " + fvar.sym + " of protocol: " + pvar.sym + " (The protocol method may have been defined before and removed.)"); } String mname = munge(mmapVal.sym.toString()); List methods = Reflector.getMethods(protocolOn, args.count() - 1, mname, false); if(methods.size() != 1) throw new IllegalArgumentException( "No single method: " + mname + " of interface: " + protocolOn.getName() + " found for function: " + fvar.sym + " of protocol: " + pvar.sym); this.onMethod = (java.lang.reflect.Method) methods.get(0); } } // else if(pvar == null && VAR_CALLSITES.isBound() // && fvar.ns.name.name.startsWith("clojure") // && !RT.booleanCast(RT.get(RT.meta(fvar),dynamicKey)) // ) // { // //todo - more specific criteria for binding these // this.isDirect = true; // this.siteIndex = registerVarCallsite(((VarExpr) fexpr).var); // } } this.tag = tag != null ? tag : (fexpr instanceof VarExpr ? ((VarExpr) fexpr).tag : null); } public Object eval() throws Exception{ try { IFn fn = (IFn) fexpr.eval(); PersistentVector argvs = PersistentVector.EMPTY; for(int i = 0; i < args.count(); i++) argvs = argvs.cons(((Expr) args.nth(i)).eval()); return fn.applyTo(RT.seq(argvs)); } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException(source, line, e); else throw (CompilerException) e; } } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.visitLineNumber(line, gen.mark()); if(isProtocol) { emitProto(context,objx,gen); } else if(isDirect) { Label callLabel = gen.newLabel(); gen.getStatic(objx.objtype, objx.varCallsiteName(siteIndex), IFN_TYPE); gen.dup(); gen.ifNonNull(callLabel); gen.pop(); fexpr.emit(C.EXPRESSION, objx, gen); gen.checkCast(IFN_TYPE); // gen.dup(); // gen.putStatic(objx.objtype, objx.varCallsiteName(siteIndex), IFN_TYPE); gen.mark(callLabel); emitArgsAndCall(0, context,objx,gen); } else { fexpr.emit(C.EXPRESSION, objx, gen); gen.checkCast(IFN_TYPE); emitArgsAndCall(0, context,objx,gen); } if(context == C.STATEMENT) gen.pop(); } public void emitProto(C context, ObjExpr objx, GeneratorAdapter gen){ Label onLabel = gen.newLabel(); Label callLabel = gen.newLabel(); Label endLabel = gen.newLabel(); Var v = ((VarExpr)fexpr).var; Expr e = (Expr) args.nth(0); e.emit(C.EXPRESSION, objx, gen); gen.dup(); //target, target gen.invokeStatic(UTIL_TYPE,Method.getMethod("Class classOf(Object)")); //target,class gen.loadThis(); gen.getField(objx.objtype, objx.cachedClassName(siteIndex),CLASS_TYPE); //target,class,cached-class gen.visitJumpInsn(IF_ACMPEQ, callLabel); //target if(protocolOn != null) { gen.dup(); //target, target gen.instanceOf(Type.getType(protocolOn)); gen.ifZCmp(GeneratorAdapter.NE, onLabel); } gen.mark(callLabel); //target gen.dup(); //target, target gen.invokeStatic(UTIL_TYPE,Method.getMethod("Class classOf(Object)")); //target,class gen.loadThis(); gen.swap(); gen.putField(objx.objtype, objx.cachedClassName(siteIndex),CLASS_TYPE); //target objx.emitVar(gen, v); gen.invokeVirtual(VAR_TYPE, Method.getMethod("Object getRawRoot()")); //target, proto-fn gen.swap(); emitArgsAndCall(1, context,objx,gen); gen.goTo(endLabel); gen.mark(onLabel); //target if(protocolOn != null) { MethodExpr.emitTypedArgs(objx, gen, onMethod.getParameterTypes(), RT.subvec(args,1,args.count())); if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } Method m = new Method(onMethod.getName(), Type.getReturnType(onMethod), Type.getArgumentTypes(onMethod)); gen.invokeInterface(Type.getType(protocolOn), m); HostExpr.emitBoxReturn(objx, gen, onMethod.getReturnType()); } gen.mark(endLabel); } void emitArgsAndCall(int firstArgToEmit, C context, ObjExpr objx, GeneratorAdapter gen){ for(int i = firstArgToEmit; i < Math.min(MAX_POSITIONAL_ARITY, args.count()); i++) { Expr e = (Expr) args.nth(i); e.emit(C.EXPRESSION, objx, gen); } if(args.count() > MAX_POSITIONAL_ARITY) { PersistentVector restArgs = PersistentVector.EMPTY; for(int i = MAX_POSITIONAL_ARITY; i < args.count(); i++) { restArgs = restArgs.cons(args.nth(i)); } MethodExpr.emitArgsAsArray(restArgs, objx, gen); } if(context == C.RETURN) { ObjMethod method = (ObjMethod) METHOD.deref(); method.emitClearLocals(gen); } gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[Math.min(MAX_POSITIONAL_ARITY + 1, args.count())])); } public boolean hasJavaClass() throws Exception{ return tag != null; } public Class getJavaClass() throws Exception{ return HostExpr.tagToClass(tag); } static public Expr parse(C context, ISeq form) throws Exception{ if(context != C.EVAL) context = C.EXPRESSION; Expr fexpr = analyze(context, form.first()); if(fexpr instanceof VarExpr && ((VarExpr)fexpr).var.equals(INSTANCE)) { if(RT.second(form) instanceof Symbol) { Class c = HostExpr.maybeClass(RT.second(form),false); if(c != null) return new InstanceOfExpr(c, analyze(context, RT.third(form))); } } if(fexpr instanceof KeywordExpr && RT.count(form) == 2 && KEYWORD_CALLSITES.isBound()) { // fexpr = new ConstantExpr(new KeywordCallSite(((KeywordExpr)fexpr).k)); Expr target = analyze(context, RT.second(form)); return new KeywordInvokeExpr((String) SOURCE.deref(), (Integer) LINE.deref(), tagOf(form), (KeywordExpr) fexpr, target); } PersistentVector args = PersistentVector.EMPTY; for(ISeq s = RT.seq(form.next()); s != null; s = s.next()) { args = args.cons(analyze(context, s.first())); } // if(args.count() > MAX_POSITIONAL_ARITY) // throw new IllegalArgumentException( // String.format("No more than %d args supported", MAX_POSITIONAL_ARITY)); return new InvokeExpr((String) SOURCE.deref(), (Integer) LINE.deref(), tagOf(form), fexpr, args); } } static class SourceDebugExtensionAttribute extends Attribute{ public SourceDebugExtensionAttribute(){ super("SourceDebugExtension"); } void writeSMAP(ClassWriter cw, String smap){ ByteVector bv = write(cw, null, -1, -1, -1); bv.putUTF8(smap); } } static public class FnExpr extends ObjExpr{ final static Type aFnType = Type.getType(AFunction.class); final static Type restFnType = Type.getType(RestFn.class); //if there is a variadic overload (there can only be one) it is stored here FnMethod variadicMethod = null; IPersistentCollection methods; // String superName = null; public FnExpr(Object tag){ super(tag); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return AFunction.class; } protected void emitMethods(ClassVisitor cv){ //override of invoke/doInvoke for each method for(ISeq s = RT.seq(methods); s != null; s = s.next()) { ObjMethod method = (ObjMethod) s.first(); method.emit(this, cv); } if(isVariadic()) { GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, Method.getMethod("int getRequiredArity()"), null, null, cv); gen.visitCode(); gen.push(variadicMethod.reqParms.count()); gen.returnValue(); gen.endMethod(); } } static Expr parse(C context, ISeq form, String name) throws Exception{ ISeq origForm = form; FnExpr fn = new FnExpr(tagOf(form)); fn.src = form; ObjMethod enclosingMethod = (ObjMethod) METHOD.deref(); if(((IMeta) form.first()).meta() != null) { fn.onceOnly = RT.booleanCast(RT.get(RT.meta(form.first()), Keyword.intern(null, "once"))); // fn.superName = (String) RT.get(RT.meta(form.first()), Keyword.intern(null, "super-name")); } //fn.thisName = name; String basename = enclosingMethod != null ? (enclosingMethod.objx.name + "$") : //"clojure.fns." + (munge(currentNS().name.name) + "$"); if(RT.second(form) instanceof Symbol) name = ((Symbol) RT.second(form)).name; String simpleName = name != null ? (munge(name).replace(".", "_DOT_") + (enclosingMethod != null ? "__" + RT.nextID() : "")) : ("fn" + "__" + RT.nextID()); fn.name = basename + simpleName; fn.internalName = fn.name.replace('.', '/'); fn.objtype = Type.getObjectType(fn.internalName); try { Var.pushThreadBindings( RT.map(CONSTANTS, PersistentVector.EMPTY, CONSTANT_IDS, new IdentityHashMap(), KEYWORDS, PersistentHashMap.EMPTY, VARS, PersistentHashMap.EMPTY, KEYWORD_CALLSITES, PersistentVector.EMPTY, PROTOCOL_CALLSITES, PersistentVector.EMPTY, VAR_CALLSITES, PersistentVector.EMPTY )); //arglist might be preceded by symbol naming this fn if(RT.second(form) instanceof Symbol) { fn.thisName = ((Symbol) RT.second(form)).name; form = RT.cons(FN, RT.next(RT.next(form))); } //now (fn [args] body...) or (fn ([args] body...) ([args2] body2...) ...) //turn former into latter if(RT.second(form) instanceof IPersistentVector) form = RT.list(FN, RT.next(form)); fn.line = (Integer) LINE.deref(); FnMethod[] methodArray = new FnMethod[MAX_POSITIONAL_ARITY + 1]; FnMethod variadicMethod = null; for(ISeq s = RT.next(form); s != null; s = RT.next(s)) { FnMethod f = FnMethod.parse(fn, (ISeq) RT.first(s)); if(f.isVariadic()) { if(variadicMethod == null) variadicMethod = f; else throw new Exception("Can't have more than 1 variadic overload"); } else if(methodArray[f.reqParms.count()] == null) methodArray[f.reqParms.count()] = f; else throw new Exception("Can't have 2 overloads with same arity"); } if(variadicMethod != null) { for(int i = variadicMethod.reqParms.count() + 1; i <= MAX_POSITIONAL_ARITY; i++) if(methodArray[i] != null) throw new Exception( "Can't have fixed arity function with more params than variadic function"); } IPersistentCollection methods = null; for(int i = 0; i < methodArray.length; i++) if(methodArray[i] != null) methods = RT.conj(methods, methodArray[i]); if(variadicMethod != null) methods = RT.conj(methods, variadicMethod); fn.methods = methods; fn.variadicMethod = variadicMethod; fn.keywords = (IPersistentMap) KEYWORDS.deref(); fn.vars = (IPersistentMap) VARS.deref(); fn.constants = (PersistentVector) CONSTANTS.deref(); fn.keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref(); fn.protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref(); fn.varCallsites = (IPersistentVector) VAR_CALLSITES.deref(); fn.constantsID = RT.nextID(); // DynamicClassLoader loader = (DynamicClassLoader) LOADER.get(); // loader.registerConstants(fn.constantsID, fn.constants.toArray()); } finally { Var.popThreadBindings(); } fn.compile(fn.isVariadic() ? "clojure/lang/RestFn" : "clojure/lang/AFunction",null,fn.onceOnly); fn.getCompiledClass(); if(origForm instanceof IObj && ((IObj) origForm).meta() != null) return new MetaExpr(fn, (MapExpr) MapExpr .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) origForm).meta())); else return fn; } public final ObjMethod variadicMethod(){ return variadicMethod; } boolean isVariadic(){ return variadicMethod != null; } public final IPersistentCollection methods(){ return methods; } } static public class ObjExpr implements Expr{ static final String CONST_PREFIX = "const__"; String name; //String simpleName; String internalName; String thisName; Type objtype; public final Object tag; //localbinding->itself IPersistentMap closes = PersistentHashMap.EMPTY; //localbndingexprs IPersistentVector closesExprs = PersistentVector.EMPTY; //symbols IPersistentSet volatiles = PersistentHashSet.EMPTY; //symbol->lb IPersistentMap fields = null; //Keyword->KeywordExpr IPersistentMap keywords = PersistentHashMap.EMPTY; IPersistentMap vars = PersistentHashMap.EMPTY; Class compiledClass; int line; PersistentVector constants; int constantsID; int altCtorDrops = 0; IPersistentVector keywordCallsites; IPersistentVector protocolCallsites; IPersistentVector varCallsites; boolean onceOnly = false; Object src; final static Method voidctor = Method.getMethod("void ()"); protected IPersistentMap classMeta; public final String name(){ return name; } // public final String simpleName(){ // return simpleName; // } public final String internalName(){ return internalName; } public final String thisName(){ return thisName; } public final Type objtype(){ return objtype; } public final IPersistentMap closes(){ return closes; } public final IPersistentMap keywords(){ return keywords; } public final IPersistentMap vars(){ return vars; } public final Class compiledClass(){ return compiledClass; } public final int line(){ return line; } public final PersistentVector constants(){ return constants; } public final int constantsID(){ return constantsID; } final static Method kwintern = Method.getMethod("clojure.lang.Keyword intern(String, String)"); final static Method symcreate = Method.getMethod("clojure.lang.Symbol create(String)"); final static Method varintern = Method.getMethod("clojure.lang.Var intern(clojure.lang.Symbol, clojure.lang.Symbol)"); final static Type DYNAMIC_CLASSLOADER_TYPE = Type.getType(DynamicClassLoader.class); final static Method getClassMethod = Method.getMethod("Class getClass()"); final static Method getClassLoaderMethod = Method.getMethod("ClassLoader getClassLoader()"); final static Method getConstantsMethod = Method.getMethod("Object[] getConstants(int)"); final static Method readStringMethod = Method.getMethod("Object readString(String)"); final static Type ILOOKUP_SITE_TYPE = Type.getType(ILookupSite.class); final static Type ILOOKUP_THUNK_TYPE = Type.getType(ILookupThunk.class); final static Type KEYWORD_LOOKUPSITE_TYPE = Type.getType(KeywordLookupSite.class); private DynamicClassLoader loader; private byte[] bytecode; public ObjExpr(Object tag){ this.tag = tag; } static String trimGenID(String name){ int i = name.lastIndexOf("__"); return i==-1?name:name.substring(0,i); } Type[] ctorTypes(){ IPersistentVector tv = isDeftype()?PersistentVector.EMPTY:RT.vector(IPERSISTENTMAP_TYPE); for(ISeq s = RT.keys(closes); s != null; s = s.next()) { LocalBinding lb = (LocalBinding) s.first(); if(lb.getPrimitiveType() != null) tv = tv.cons(Type.getType(lb.getPrimitiveType())); else tv = tv.cons(OBJECT_TYPE); } Type[] ret = new Type[tv.count()]; for(int i = 0; i < tv.count(); i++) ret[i] = (Type) tv.nth(i); return ret; } void compile(String superName, String[] interfaceNames, boolean oneTimeUse) throws Exception{ //create bytecode for a class //with name current_ns.defname[$letname]+ //anonymous fns get names fn__id //derived from AFn/RestFn if(keywordCallsites.count() > 0) { if(interfaceNames == null) interfaceNames = new String[]{"clojure/lang/ILookupHost"}; else { String[] inames = new String[interfaceNames.length + 1]; System.arraycopy(interfaceNames,0,inames,0,interfaceNames.length); inames[interfaceNames.length] = "clojure/lang/ILookupHost"; interfaceNames = inames; } } ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS); // ClassWriter cw = new ClassWriter(0); ClassVisitor cv = cw; // ClassVisitor cv = new TraceClassVisitor(new CheckClassAdapter(cw), new PrintWriter(System.out)); //ClassVisitor cv = new TraceClassVisitor(cw, new PrintWriter(System.out)); cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER + ACC_FINAL, internalName, null,superName,interfaceNames); // superName != null ? superName : // (isVariadic() ? "clojure/lang/RestFn" : "clojure/lang/AFunction"), null); String source = (String) SOURCE.deref(); int lineBefore = (Integer) LINE_BEFORE.deref(); int lineAfter = (Integer) LINE_AFTER.deref() + 1; if(source != null && SOURCE_PATH.deref() != null) { //cv.visitSource(source, null); String smap = "SMAP\n" + ((source.lastIndexOf('.') > 0) ? source.substring(0, source.lastIndexOf('.')) :source) // : simpleName) + ".java\n" + "Clojure\n" + "*S Clojure\n" + "*F\n" + "+ 1 " + source + "\n" + (String) SOURCE_PATH.deref() + "\n" + "*L\n" + String.format("%d#1,%d:%d\n", lineBefore, lineAfter - lineBefore, lineBefore) + "*E"; cv.visitSource(source, smap); } addAnnotation(cv, classMeta); //static fields for constants for(int i = 0; i < constants.count(); i++) { cv.visitField(ACC_PUBLIC + ACC_FINAL + ACC_STATIC, constantName(i), constantType(i).getDescriptor(), null, null); } //static fields for lookup sites for(int i = 0; i < keywordCallsites.count(); i++) { cv.visitField(ACC_FINAL + ACC_STATIC, siteNameStatic(i), KEYWORD_LOOKUPSITE_TYPE.getDescriptor(), null, null); cv.visitField(ACC_STATIC, thunkNameStatic(i), ILOOKUP_THUNK_TYPE.getDescriptor(), null, null); } for(int i=0;i ()"), null, null, cv); clinitgen.visitCode(); clinitgen.visitLineNumber(line, clinitgen.mark()); if(constants.count() > 0) { emitConstants(clinitgen); } if(keywordCallsites.count() > 0) emitKeywordCallsites(clinitgen); for(int i=0;i", Type.VOID_TYPE, ctorTypes()); GeneratorAdapter ctorgen = new GeneratorAdapter(ACC_PUBLIC, m, null, null, cv); Label start = ctorgen.newLabel(); Label end = ctorgen.newLabel(); ctorgen.visitCode(); ctorgen.visitLineNumber(line, ctorgen.mark()); ctorgen.visitLabel(start); ctorgen.loadThis(); // if(superName != null) ctorgen.invokeConstructor(Type.getObjectType(superName), voidctor); // else if(isVariadic()) //RestFn ctor takes reqArity arg // { // ctorgen.push(variadicMethod.reqParms.count()); // ctorgen.invokeConstructor(restFnType, restfnctor); // } // else // ctorgen.invokeConstructor(aFnType, voidctor); if(!isDeftype()) { ctorgen.loadThis(); ctorgen.visitVarInsn(IPERSISTENTMAP_TYPE.getOpcode(Opcodes.ILOAD), 1); ctorgen.putField(objtype, "__meta", IPERSISTENTMAP_TYPE); } int a = isDeftype()?1:2; for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a) { LocalBinding lb = (LocalBinding) s.first(); ctorgen.loadThis(); Class primc = lb.getPrimitiveType(); if(primc != null) { ctorgen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), a); ctorgen.putField(objtype, lb.name, Type.getType(primc)); if(primc == Long.TYPE || primc == Double.TYPE) ++a; } else { ctorgen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), a); ctorgen.putField(objtype, lb.name, OBJECT_TYPE); } closesExprs = closesExprs.cons(new LocalBindingExpr(lb, null)); } ctorgen.visitLabel(end); ctorgen.returnValue(); ctorgen.endMethod(); if(altCtorDrops > 0) { //ctor that takes closed-overs and inits base + fields Type[] ctorTypes = ctorTypes(); Type[] altCtorTypes = new Type[ctorTypes.length-altCtorDrops]; for(int i=0;i", Type.VOID_TYPE, altCtorTypes); ctorgen = new GeneratorAdapter(ACC_PUBLIC, alt, null, null, cv); ctorgen.visitCode(); ctorgen.loadThis(); ctorgen.loadArgs(); for(int i=0;i", Type.VOID_TYPE, ctorTypes)); ctorgen.returnValue(); ctorgen.endMethod(); } if(!isDeftype()) { //ctor that takes closed-overs but not meta Type[] ctorTypes = ctorTypes(); Type[] noMetaCtorTypes = new Type[ctorTypes.length-1]; for(int i=1;i", Type.VOID_TYPE, noMetaCtorTypes); ctorgen = new GeneratorAdapter(ACC_PUBLIC, alt, null, null, cv); ctorgen.visitCode(); ctorgen.loadThis(); ctorgen.visitInsn(Opcodes.ACONST_NULL); //null meta ctorgen.loadArgs(); ctorgen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes)); ctorgen.returnValue(); ctorgen.endMethod(); //meta() Method meth = Method.getMethod("clojure.lang.IPersistentMap meta()"); GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, meth, null, null, cv); gen.visitCode(); gen.loadThis(); gen.getField(objtype,"__meta",IPERSISTENTMAP_TYPE); gen.returnValue(); gen.endMethod(); //withMeta() meth = Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)"); gen = new GeneratorAdapter(ACC_PUBLIC, meth, null, null, cv); gen.visitCode(); gen.newInstance(objtype); gen.dup(); gen.loadArg(0); for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a) { LocalBinding lb = (LocalBinding) s.first(); gen.loadThis(); Class primc = lb.getPrimitiveType(); if(primc != null) { gen.getField(objtype, lb.name, Type.getType(primc)); } else { gen.getField(objtype, lb.name, OBJECT_TYPE); } } gen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes)); gen.returnValue(); gen.endMethod(); } emitMethods(cv); if(keywordCallsites.count() > 0) { Method meth = Method.getMethod("void swapThunk(int,clojure.lang.ILookupThunk)"); GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, meth, null, null, cv); gen.visitCode(); Label endLabel = gen.newLabel(); Label[] labels = new Label[keywordCallsites.count()]; for(int i = 0; i < keywordCallsites.count();i++) { labels[i] = gen.newLabel(); } gen.loadArg(0); gen.visitTableSwitchInsn(0,keywordCallsites.count()-1,endLabel,labels); for(int i = 0; i < keywordCallsites.count();i++) { gen.mark(labels[i]); // gen.loadThis(); gen.loadArg(1); gen.putStatic(objtype, thunkNameStatic(i),ILOOKUP_THUNK_TYPE); gen.goTo(endLabel); } gen.mark(endLabel); gen.returnValue(); gen.endMethod(); } //end of class cv.visitEnd(); bytecode = cw.toByteArray(); if(RT.booleanCast(COMPILE_FILES.deref())) writeClassFile(internalName, bytecode); // else // getCompiledClass(); } private void emitKeywordCallsites(GeneratorAdapter clinitgen){ for(int i=0;i(int,clojure.lang.Keyword)")); clinitgen.dup(); clinitgen.putStatic(objtype, siteNameStatic(i), KEYWORD_LOOKUPSITE_TYPE); clinitgen.putStatic(objtype, thunkNameStatic(i), ILOOKUP_THUNK_TYPE); } } protected void emitMethods(ClassVisitor gen){ } void emitListAsObjectArray(Object value, GeneratorAdapter gen){ gen.push(((List) value).size()); gen.newArray(OBJECT_TYPE); int i = 0; for(Iterator it = ((List) value).iterator(); it.hasNext(); i++) { gen.dup(); gen.push(i); emitValue(it.next(), gen); gen.arrayStore(OBJECT_TYPE); } } void emitValue(Object value, GeneratorAdapter gen){ boolean partial = true; //System.out.println(value.getClass().toString()); if(value instanceof String) { gen.push((String) value); } else if(value instanceof Integer) { gen.push(((Integer) value).intValue()); gen.invokeStatic(Type.getType(Integer.class), Method.getMethod("Integer valueOf(int)")); } else if(value instanceof Double) { gen.push(((Double) value).doubleValue()); gen.invokeStatic(Type.getType(Double.class), Method.getMethod("Double valueOf(double)")); } else if(value instanceof Character) { gen.push(((Character) value).charValue()); gen.invokeStatic(Type.getType(Character.class), Method.getMethod("Character valueOf(char)")); } else if(value instanceof Class) { Class cc = (Class)value; if(cc.isPrimitive()) { Type bt; if ( cc == boolean.class ) bt = Type.getType(Boolean.class); else if ( cc == byte.class ) bt = Type.getType(Byte.class); else if ( cc == char.class ) bt = Type.getType(Character.class); else if ( cc == double.class ) bt = Type.getType(Double.class); else if ( cc == float.class ) bt = Type.getType(Float.class); else if ( cc == int.class ) bt = Type.getType(Integer.class); else if ( cc == long.class ) bt = Type.getType(Long.class); else if ( cc == short.class ) bt = Type.getType(Short.class); else throw new RuntimeException( "Can't embed unknown primitive in code: " + value); gen.getStatic( bt, "TYPE", Type.getType(Class.class) ); } else { gen.push(destubClassName(cc.getName())); gen.invokeStatic(Type.getType(Class.class), Method.getMethod("Class forName(String)")); } } else if(value instanceof Symbol) { gen.push(((Symbol) value).ns); gen.push(((Symbol) value).name); gen.invokeStatic(Type.getType(Symbol.class), Method.getMethod("clojure.lang.Symbol create(String,String)")); } else if(value instanceof Keyword) { emitValue(((Keyword) value).sym, gen); gen.invokeStatic(Type.getType(Keyword.class), Method.getMethod("clojure.lang.Keyword intern(clojure.lang.Symbol)")); } // else if(value instanceof KeywordCallSite) // { // emitValue(((KeywordCallSite) value).k.sym, gen); // gen.invokeStatic(Type.getType(KeywordCallSite.class), // Method.getMethod("clojure.lang.KeywordCallSite create(clojure.lang.Symbol)")); // } else if(value instanceof Var) { Var var = (Var) value; gen.push(var.ns.name.toString()); gen.push(var.sym.toString()); gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)")); } else if(value instanceof IPersistentMap) { List entries = new ArrayList(); for(Map.Entry entry : (Set) ((Map) value).entrySet()) { entries.add(entry.getKey()); entries.add(entry.getValue()); } emitListAsObjectArray(entries, gen); gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.IPersistentMap map(Object[])")); } else if(value instanceof IPersistentVector) { emitListAsObjectArray(value, gen); gen.invokeStatic(RT_TYPE, Method.getMethod( "clojure.lang.IPersistentVector vector(Object[])")); } else if(value instanceof ISeq || value instanceof IPersistentList) { emitListAsObjectArray(value, gen); gen.invokeStatic(Type.getType(java.util.Arrays.class), Method.getMethod("java.util.List asList(Object[])")); gen.invokeStatic(Type.getType(PersistentList.class), Method.getMethod( "clojure.lang.IPersistentList create(java.util.List)")); } else { String cs = null; try { cs = RT.printString(value); //System.out.println("WARNING SLOW CODE: " + value.getClass() + " -> " + cs); } catch(Exception e) { throw new RuntimeException( "Can't embed object in code, maybe print-dup not defined: " + value); } if(cs.length() == 0) throw new RuntimeException( "Can't embed unreadable object in code: " + value); if(cs.startsWith("#<")) throw new RuntimeException( "Can't embed unreadable object in code: " + cs); gen.push(cs); gen.invokeStatic(RT_TYPE, readStringMethod); partial = false; } if(partial) { if(value instanceof IObj && RT.count(((IObj) value).meta()) > 0) { gen.checkCast(IOBJ_TYPE); emitValue(((IObj) value).meta(), gen); gen.checkCast(IPERSISTENTMAP_TYPE); gen.invokeInterface(IOBJ_TYPE, Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)")); } } } void emitConstants(GeneratorAdapter clinitgen){ try { Var.pushThreadBindings(RT.map(RT.PRINT_DUP, RT.T)); for(int i = 0; i < constants.count(); i++) { emitValue(constants.nth(i), clinitgen); clinitgen.checkCast(constantType(i)); clinitgen.putStatic(objtype, constantName(i), constantType(i)); } } finally { Var.popThreadBindings(); } } boolean isMutable(LocalBinding lb){ return isVolatile(lb) || RT.booleanCast(RT.contains(fields, lb.sym)) && RT.booleanCast(RT.get(lb.sym.meta(), Keyword.intern("unsynchronized-mutable"))); } boolean isVolatile(LocalBinding lb){ return RT.booleanCast(RT.contains(fields, lb.sym)) && RT.booleanCast(RT.get(lb.sym.meta(), Keyword.intern("volatile-mutable"))); } boolean isDeftype(){ return fields != null; } void emitClearCloses(GeneratorAdapter gen){ // int a = 1; // for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a) // { // LocalBinding lb = (LocalBinding) s.first(); // Class primc = lb.getPrimitiveType(); // if(primc == null) // { // gen.loadThis(); // gen.visitInsn(Opcodes.ACONST_NULL); // gen.putField(objtype, lb.name, OBJECT_TYPE); // } // } } synchronized Class getCompiledClass(){ if(compiledClass == null) try { // if(RT.booleanCast(COMPILE_FILES.deref())) // compiledClass = RT.classForName(name);//loader.defineClass(name, bytecode); // else { loader = (DynamicClassLoader) LOADER.deref(); compiledClass = loader.defineClass(name, bytecode, src); } } catch(Exception e) { throw new RuntimeException(e); } return compiledClass; } public Object eval() throws Exception{ if(isDeftype()) return null; return getCompiledClass().newInstance(); } public void emitLetFnInits(GeneratorAdapter gen, ObjExpr objx, IPersistentSet letFnLocals){ //objx arg is enclosing objx, not this gen.checkCast(objtype); for(ISeq s = RT.keys(closes); s != null; s = s.next()) { LocalBinding lb = (LocalBinding) s.first(); if(letFnLocals.contains(lb)) { Class primc = lb.getPrimitiveType(); gen.dup(); if(primc != null) { objx.emitUnboxedLocal(gen, lb); gen.putField(objtype, lb.name, Type.getType(primc)); } else { objx.emitLocal(gen, lb, false); gen.putField(objtype, lb.name, OBJECT_TYPE); } } } gen.pop(); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ //emitting a Fn means constructing an instance, feeding closed-overs from enclosing scope, if any //objx arg is enclosing objx, not this // getCompiledClass(); if(isDeftype()) { gen.visitInsn(Opcodes.ACONST_NULL); } else { gen.newInstance(objtype); gen.dup(); gen.visitInsn(Opcodes.ACONST_NULL); for(ISeq s = RT.seq(closesExprs); s != null; s = s.next()) { LocalBindingExpr lbe = (LocalBindingExpr) s.first(); LocalBinding lb = lbe.b; if(lb.getPrimitiveType() != null) objx.emitUnboxedLocal(gen, lb); else objx.emitLocal(gen, lb, lbe.shouldClear); } gen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes())); } if(context == C.STATEMENT) gen.pop(); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return (compiledClass != null) ? compiledClass : (tag != null) ? HostExpr.tagToClass(tag) : IFn.class; } public void emitAssignLocal(GeneratorAdapter gen, LocalBinding lb,Expr val){ if(!isMutable(lb)) throw new IllegalArgumentException("Cannot assign to non-mutable: " + lb.name); Class primc = lb.getPrimitiveType(); gen.loadThis(); if(primc != null) { if(!(val instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr) val).canEmitPrimitive())) throw new IllegalArgumentException("Must assign primitive to primitive mutable: " + lb.name); MaybePrimitiveExpr me = (MaybePrimitiveExpr) val; me.emitUnboxed(C.EXPRESSION, this, gen); gen.putField(objtype, lb.name, Type.getType(primc)); } else { val.emit(C.EXPRESSION, this, gen); gen.putField(objtype, lb.name, OBJECT_TYPE); } } private void emitLocal(GeneratorAdapter gen, LocalBinding lb, boolean clear){ if(closes.containsKey(lb)) { Class primc = lb.getPrimitiveType(); gen.loadThis(); if(primc != null) { gen.getField(objtype, lb.name, Type.getType(primc)); HostExpr.emitBoxReturn(this, gen, primc); } else { gen.getField(objtype, lb.name, OBJECT_TYPE); if(onceOnly && clear && lb.canBeCleared) { gen.loadThis(); gen.visitInsn(Opcodes.ACONST_NULL); gen.putField(objtype, lb.name, OBJECT_TYPE); } } } else { Class primc = lb.getPrimitiveType(); // String rep = lb.sym.name + " " + lb.toString().substring(lb.toString().lastIndexOf('@')); if(lb.isArg) { gen.loadArg(lb.idx-1); if(primc != null) HostExpr.emitBoxReturn(this, gen, primc); else { if(clear && lb.canBeCleared) { // System.out.println("clear: " + rep); gen.visitInsn(Opcodes.ACONST_NULL); gen.storeArg(lb.idx - 1); } else { // System.out.println("use: " + rep); } } } else { if(primc != null) { gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), lb.idx); HostExpr.emitBoxReturn(this, gen, primc); } else { gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), lb.idx); if(clear && lb.canBeCleared) { // System.out.println("clear: " + rep); gen.visitInsn(Opcodes.ACONST_NULL); gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), lb.idx); } else { // System.out.println("use: " + rep); } } } } } private void emitUnboxedLocal(GeneratorAdapter gen, LocalBinding lb){ Class primc = lb.getPrimitiveType(); if(closes.containsKey(lb)) { gen.loadThis(); gen.getField(objtype, lb.name, Type.getType(primc)); } else if(lb.isArg) gen.loadArg(lb.idx-1); else gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), lb.idx); } public void emitVar(GeneratorAdapter gen, Var var){ Integer i = (Integer) vars.valAt(var); emitConstant(gen, i); //gen.getStatic(fntype, munge(var.sym.toString()), VAR_TYPE); } public void emitKeyword(GeneratorAdapter gen, Keyword k){ Integer i = (Integer) keywords.valAt(k); emitConstant(gen, i); // gen.getStatic(fntype, munge(k.sym.toString()), KEYWORD_TYPE); } public void emitConstant(GeneratorAdapter gen, int id){ gen.getStatic(objtype, constantName(id), constantType(id)); } String constantName(int id){ return CONST_PREFIX + id; } String siteName(int n){ return "__site__" + n; } String siteNameStatic(int n){ return siteName(n) + "__"; } String thunkName(int n){ return "__thunk__" + n; } String cachedClassName(int n){ return "__cached_class__" + n; } String cachedProtoFnName(int n){ return "__cached_proto_fn__" + n; } String cachedProtoImplName(int n){ return "__cached_proto_impl__" + n; } String varCallsiteName(int n){ return "__var__callsite__" + n; } String thunkNameStatic(int n){ return thunkName(n) + "__"; } Type constantType(int id){ Object o = constants.nth(id); Class c = o.getClass(); if(Modifier.isPublic(c.getModifiers())) { //can't emit derived fn types due to visibility if(LazySeq.class.isAssignableFrom(c)) return Type.getType(ISeq.class); else if(c == Keyword.class) return Type.getType(Keyword.class); // else if(c == KeywordCallSite.class) // return Type.getType(KeywordCallSite.class); else if(RestFn.class.isAssignableFrom(c)) return Type.getType(RestFn.class); else if(AFn.class.isAssignableFrom(c)) return Type.getType(AFn.class); else if(c == Var.class) return Type.getType(Var.class); else if(c == String.class) return Type.getType(String.class); // return Type.getType(c); } return OBJECT_TYPE; } } enum PATHTYPE { PATH, BRANCH; } static class PathNode{ final PATHTYPE type; final PathNode parent; PathNode(PATHTYPE type, PathNode parent) { this.type = type; this.parent = parent; } } static PathNode clearPathRoot(){ return (PathNode) CLEAR_ROOT.get(); } enum PSTATE{ REQ, REST, DONE } public static class FnMethod extends ObjMethod{ //localbinding->localbinding PersistentVector reqParms = PersistentVector.EMPTY; LocalBinding restParm = null; public FnMethod(ObjExpr objx, ObjMethod parent){ super(objx, parent); } static FnMethod parse(ObjExpr objx, ISeq form) throws Exception{ //([args] body...) IPersistentVector parms = (IPersistentVector) RT.first(form); ISeq body = RT.next(form); try { FnMethod method = new FnMethod(objx, (ObjMethod) METHOD.deref()); method.line = (Integer) LINE.deref(); //register as the current method and set up a new env frame PathNode pnode = (PathNode) CLEAR_PATH.get(); if(pnode == null) pnode = new PathNode(PATHTYPE.PATH,null); Var.pushThreadBindings( RT.map( METHOD, method, LOCAL_ENV, LOCAL_ENV.deref(), LOOP_LOCALS, null, NEXT_LOCAL_NUM, 0 ,CLEAR_PATH, pnode ,CLEAR_ROOT, pnode ,CLEAR_SITES, PersistentHashMap.EMPTY )); //register 'this' as local 0 //registerLocal(THISFN, null, null); if(objx.thisName != null) registerLocal(Symbol.intern(objx.thisName), null, null,false); else getAndIncLocalNum(); PSTATE state = PSTATE.REQ; PersistentVector argLocals = PersistentVector.EMPTY; for(int i = 0; i < parms.count(); i++) { if(!(parms.nth(i) instanceof Symbol)) throw new IllegalArgumentException("fn params must be Symbols"); Symbol p = (Symbol) parms.nth(i); if(p.getNamespace() != null) throw new Exception("Can't use qualified name as parameter: " + p); if(p.equals(_AMP_)) { if(state == PSTATE.REQ) state = PSTATE.REST; else throw new Exception("Invalid parameter list"); } else { LocalBinding lb = registerLocal(p, state == PSTATE.REST ? ISEQ : tagOf(p), null,true); argLocals = argLocals.cons(lb); switch(state) { case REQ: method.reqParms = method.reqParms.cons(lb); break; case REST: method.restParm = lb; state = PSTATE.DONE; break; default: throw new Exception("Unexpected parameter"); } } } if(method.reqParms.count() > MAX_POSITIONAL_ARITY) throw new Exception("Can't specify more than " + MAX_POSITIONAL_ARITY + " params"); LOOP_LOCALS.set(argLocals); method.argLocals = argLocals; method.body = (new BodyExpr.Parser()).parse(C.RETURN, body); return method; } finally { Var.popThreadBindings(); } } public final PersistentVector reqParms(){ return reqParms; } public final LocalBinding restParm(){ return restParm; } boolean isVariadic(){ return restParm != null; } int numParams(){ return reqParms.count() + (isVariadic() ? 1 : 0); } String getMethodName(){ return isVariadic()?"doInvoke":"invoke"; } Type getReturnType(){ return OBJECT_TYPE; } Type[] getArgTypes(){ if(isVariadic() && reqParms.count() == MAX_POSITIONAL_ARITY) { Type[] ret = new Type[MAX_POSITIONAL_ARITY + 1]; for(int i = 0;ilocalbinding IPersistentMap locals = null; //num->localbinding IPersistentMap indexlocals = null; Expr body = null; ObjExpr objx; PersistentVector argLocals; int maxLocal = 0; int line; PersistentHashSet localsUsedInCatchFinally = PersistentHashSet.EMPTY; protected IPersistentMap methodMeta; public final IPersistentMap locals(){ return locals; } public final Expr body(){ return body; } public final ObjExpr objx(){ return objx; } public final PersistentVector argLocals(){ return argLocals; } public final int maxLocal(){ return maxLocal; } public final int line(){ return line; } public ObjMethod(ObjExpr objx, ObjMethod parent){ this.parent = parent; this.objx = objx; } abstract int numParams(); abstract String getMethodName(); abstract Type getReturnType(); abstract Type[] getArgTypes(); public void emit(ObjExpr fn, ClassVisitor cv){ Method m = new Method(getMethodName(), getReturnType(), getArgTypes()); GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC, m, null, //todo don't hardwire this EXCEPTION_TYPES, cv); gen.visitCode(); Label loopLabel = gen.mark(); gen.visitLineNumber(line, loopLabel); try { Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel, METHOD, this)); body.emit(C.RETURN, fn, gen); Label end = gen.mark(); gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0); for(ISeq lbs = argLocals.seq(); lbs != null; lbs = lbs.next()) { LocalBinding lb = (LocalBinding) lbs.first(); gen.visitLocalVariable(lb.name, "Ljava/lang/Object;", null, loopLabel, end, lb.idx); } } finally { Var.popThreadBindings(); } gen.returnValue(); //gen.visitMaxs(1, 1); gen.endMethod(); } void emitClearLocals(GeneratorAdapter gen){ } void emitClearLocalsOld(GeneratorAdapter gen){ for(int i=0;i 0) { // Object dummy; if(sites != null) { for(ISeq s = sites.seq();s!=null;s = s.next()) { LocalBindingExpr o = (LocalBindingExpr) s.first(); PathNode common = commonPath(clearPath,o.clearPath); if(common != null && common.type == PATHTYPE.PATH) o.shouldClear = false; // else // dummy = null; } } if(clearRoot == b.clearPathRoot) { this.shouldClear = true; sites = RT.conj(sites,this); CLEAR_SITES.set(RT.assoc(CLEAR_SITES.get(), b, sites)); } // else // dummy = null; } } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval locals"); } public boolean canEmitPrimitive(){ return b.getPrimitiveType() != null; } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ objx.emitUnboxedLocal(gen, b); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ if(context != C.STATEMENT) objx.emitLocal(gen, b, shouldClear); } public Object evalAssign(Expr val) throws Exception{ throw new UnsupportedOperationException("Can't eval locals"); } public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val){ objx.emitAssignLocal(gen, b,val); if(context != C.STATEMENT) objx.emitLocal(gen, b, false); } public boolean hasJavaClass() throws Exception{ return tag != null || b.hasJavaClass(); } public Class getJavaClass() throws Exception{ if(tag != null) return HostExpr.tagToClass(tag); return b.getJavaClass(); } } public static class BodyExpr implements Expr, MaybePrimitiveExpr{ PersistentVector exprs; public final PersistentVector exprs(){ return exprs; } public BodyExpr(PersistentVector exprs){ this.exprs = exprs; } static class Parser implements IParser{ public Expr parse(C context, Object frms) throws Exception{ ISeq forms = (ISeq) frms; if(Util.equals(RT.first(forms), DO)) forms = RT.next(forms); PersistentVector exprs = PersistentVector.EMPTY; for(; forms != null; forms = forms.next()) { Expr e = (context != C.EVAL && (context == C.STATEMENT || forms.next() != null)) ? analyze(C.STATEMENT, forms.first()) : analyze(context, forms.first()); exprs = exprs.cons(e); } if(exprs.count() == 0) exprs = exprs.cons(NIL_EXPR); return new BodyExpr(exprs); } } public Object eval() throws Exception{ Object ret = null; for(Object o : exprs) { Expr e = (Expr) o; ret = e.eval(); } return ret; } public boolean canEmitPrimitive(){ return lastExpr() instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr)lastExpr()).canEmitPrimitive(); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ for(int i = 0; i < exprs.count() - 1; i++) { Expr e = (Expr) exprs.nth(i); e.emit(C.STATEMENT, objx, gen); } MaybePrimitiveExpr last = (MaybePrimitiveExpr) exprs.nth(exprs.count() - 1); last.emitUnboxed(context, objx, gen); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ for(int i = 0; i < exprs.count() - 1; i++) { Expr e = (Expr) exprs.nth(i); e.emit(C.STATEMENT, objx, gen); } Expr last = (Expr) exprs.nth(exprs.count() - 1); last.emit(context, objx, gen); } public boolean hasJavaClass() throws Exception{ return lastExpr().hasJavaClass(); } public Class getJavaClass() throws Exception{ return lastExpr().getJavaClass(); } private Expr lastExpr(){ return (Expr) exprs.nth(exprs.count() - 1); } } public static class BindingInit{ LocalBinding binding; Expr init; public final LocalBinding binding(){ return binding; } public final Expr init(){ return init; } public BindingInit(LocalBinding binding, Expr init){ this.binding = binding; this.init = init; } } public static class LetFnExpr implements Expr{ public final PersistentVector bindingInits; public final Expr body; public LetFnExpr(PersistentVector bindingInits, Expr body){ this.bindingInits = bindingInits; this.body = body; } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; //(letfns* [var (fn [args] body) ...] body...) if(!(RT.second(form) instanceof IPersistentVector)) throw new IllegalArgumentException("Bad binding form, expected vector"); IPersistentVector bindings = (IPersistentVector) RT.second(form); if((bindings.count() % 2) != 0) throw new IllegalArgumentException("Bad binding form, expected matched symbol expression pairs"); ISeq body = RT.next(RT.next(form)); if(context == C.EVAL) return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(), NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref()); try { Var.pushThreadBindings(dynamicBindings); //pre-seed env (like Lisp labels) PersistentVector lbs = PersistentVector.EMPTY; for(int i = 0; i < bindings.count(); i += 2) { if(!(bindings.nth(i) instanceof Symbol)) throw new IllegalArgumentException( "Bad binding form, expected symbol, got: " + bindings.nth(i)); Symbol sym = (Symbol) bindings.nth(i); if(sym.getNamespace() != null) throw new Exception("Can't let qualified name: " + sym); LocalBinding lb = registerLocal(sym, tagOf(sym), null,false); lb.canBeCleared = false; lbs = lbs.cons(lb); } PersistentVector bindingInits = PersistentVector.EMPTY; for(int i = 0; i < bindings.count(); i += 2) { Symbol sym = (Symbol) bindings.nth(i); Expr init = analyze(C.EXPRESSION, bindings.nth(i + 1), sym.name); LocalBinding lb = (LocalBinding) lbs.nth(i / 2); lb.init = init; BindingInit bi = new BindingInit(lb, init); bindingInits = bindingInits.cons(bi); } return new LetFnExpr(bindingInits, (new BodyExpr.Parser()).parse(context, body)); } finally { Var.popThreadBindings(); } } } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval letfns"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ for(int i = 0; i < bindingInits.count(); i++) { BindingInit bi = (BindingInit) bindingInits.nth(i); gen.visitInsn(Opcodes.ACONST_NULL); gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); } IPersistentSet lbset = PersistentHashSet.EMPTY; for(int i = 0; i < bindingInits.count(); i++) { BindingInit bi = (BindingInit) bindingInits.nth(i); lbset = (IPersistentSet) lbset.cons(bi.binding); bi.init.emit(C.EXPRESSION, objx, gen); gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); } for(int i = 0; i < bindingInits.count(); i++) { BindingInit bi = (BindingInit) bindingInits.nth(i); ObjExpr fe = (ObjExpr) bi.init; gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), bi.binding.idx); fe.emitLetFnInits(gen, objx, lbset); } Label loopLabel = gen.mark(); body.emit(context, objx, gen); Label end = gen.mark(); // gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0); for(ISeq bis = bindingInits.seq(); bis != null; bis = bis.next()) { BindingInit bi = (BindingInit) bis.first(); String lname = bi.binding.name; if(lname.endsWith("__auto__")) lname += RT.nextID(); Class primc = maybePrimitiveType(bi.init); if(primc != null) gen.visitLocalVariable(lname, Type.getDescriptor(primc), null, loopLabel, end, bi.binding.idx); else gen.visitLocalVariable(lname, "Ljava/lang/Object;", null, loopLabel, end, bi.binding.idx); } } public boolean hasJavaClass() throws Exception{ return body.hasJavaClass(); } public Class getJavaClass() throws Exception{ return body.getJavaClass(); } } public static class LetExpr implements Expr, MaybePrimitiveExpr{ public final PersistentVector bindingInits; public final Expr body; public final boolean isLoop; public LetExpr(PersistentVector bindingInits, Expr body, boolean isLoop){ this.bindingInits = bindingInits; this.body = body; this.isLoop = isLoop; } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; //(let [var val var2 val2 ...] body...) boolean isLoop = RT.first(form).equals(LOOP); if(!(RT.second(form) instanceof IPersistentVector)) throw new IllegalArgumentException("Bad binding form, expected vector"); IPersistentVector bindings = (IPersistentVector) RT.second(form); if((bindings.count() % 2) != 0) throw new IllegalArgumentException("Bad binding form, expected matched symbol expression pairs"); ISeq body = RT.next(RT.next(form)); if(context == C.EVAL || (context == C.EXPRESSION && isLoop)) return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(), NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref()); if(isLoop) dynamicBindings = dynamicBindings.assoc(LOOP_LOCALS, null); try { Var.pushThreadBindings(dynamicBindings); PersistentVector bindingInits = PersistentVector.EMPTY; PersistentVector loopLocals = PersistentVector.EMPTY; for(int i = 0; i < bindings.count(); i += 2) { if(!(bindings.nth(i) instanceof Symbol)) throw new IllegalArgumentException( "Bad binding form, expected symbol, got: " + bindings.nth(i)); Symbol sym = (Symbol) bindings.nth(i); if(sym.getNamespace() != null) throw new Exception("Can't let qualified name: " + sym); Expr init = analyze(C.EXPRESSION, bindings.nth(i + 1), sym.name); //sequential enhancement of env (like Lisp let*) LocalBinding lb = registerLocal(sym, tagOf(sym), init,false); BindingInit bi = new BindingInit(lb, init); bindingInits = bindingInits.cons(bi); if(isLoop) loopLocals = loopLocals.cons(lb); } if(isLoop) LOOP_LOCALS.set(loopLocals); Expr bodyExpr; try { if(isLoop) { PathNode root = new PathNode(PATHTYPE.PATH, (PathNode) CLEAR_PATH.get()); Var.pushThreadBindings( RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,root), CLEAR_ROOT, new PathNode(PATHTYPE.PATH,root))); } bodyExpr = (new BodyExpr.Parser()).parse(isLoop ? C.RETURN : context, body); } finally{ if(isLoop) Var.popThreadBindings(); } return new LetExpr(bindingInits, bodyExpr, isLoop); } finally { Var.popThreadBindings(); } } } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval let/loop"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ doEmit(context, objx, gen, false); } public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ doEmit(context, objx, gen, true); } public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUnboxed){ for(int i = 0; i < bindingInits.count(); i++) { BindingInit bi = (BindingInit) bindingInits.nth(i); Class primc = maybePrimitiveType(bi.init); if(primc != null) { ((MaybePrimitiveExpr) bi.init).emitUnboxed(C.EXPRESSION, objx, gen); gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ISTORE), bi.binding.idx); } else { bi.init.emit(C.EXPRESSION, objx, gen); gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); } } Label loopLabel = gen.mark(); if(isLoop) { try { Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel)); if(emitUnboxed) ((MaybePrimitiveExpr)body).emitUnboxed(context, objx, gen); else body.emit(context, objx, gen); } finally { Var.popThreadBindings(); } } else { if(emitUnboxed) ((MaybePrimitiveExpr)body).emitUnboxed(context, objx, gen); else body.emit(context, objx, gen); } Label end = gen.mark(); // gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0); for(ISeq bis = bindingInits.seq(); bis != null; bis = bis.next()) { BindingInit bi = (BindingInit) bis.first(); String lname = bi.binding.name; if(lname.endsWith("__auto__")) lname += RT.nextID(); Class primc = maybePrimitiveType(bi.init); if(primc != null) gen.visitLocalVariable(lname, Type.getDescriptor(primc), null, loopLabel, end, bi.binding.idx); else gen.visitLocalVariable(lname, "Ljava/lang/Object;", null, loopLabel, end, bi.binding.idx); } } public boolean hasJavaClass() throws Exception{ return body.hasJavaClass(); } public Class getJavaClass() throws Exception{ return body.getJavaClass(); } public boolean canEmitPrimitive(){ return body instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr)body).canEmitPrimitive(); } } public static class RecurExpr implements Expr{ public final IPersistentVector args; public final IPersistentVector loopLocals; public RecurExpr(IPersistentVector loopLocals, IPersistentVector args){ this.loopLocals = loopLocals; this.args = args; } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval recur"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ Label loopLabel = (Label) LOOP_LABEL.deref(); if(loopLabel == null) throw new IllegalStateException(); for(int i = 0; i < loopLocals.count(); i++) { LocalBinding lb = (LocalBinding) loopLocals.nth(i); Expr arg = (Expr) args.nth(i); if(lb.getPrimitiveType() != null) { Class primc = lb.getPrimitiveType(); try { if(!(arg instanceof MaybePrimitiveExpr && arg.hasJavaClass() && arg.getJavaClass() == primc)) throw new IllegalArgumentException("recur arg for primitive local: " + lb.name + " must be matching primitive"); } catch(Exception e) { throw new RuntimeException(e); } ((MaybePrimitiveExpr) arg).emitUnboxed(C.EXPRESSION, objx, gen); } else { arg.emit(C.EXPRESSION, objx, gen); } } for(int i = loopLocals.count() - 1; i >= 0; i--) { LocalBinding lb = (LocalBinding) loopLocals.nth(i); Class primc = lb.getPrimitiveType(); if(lb.isArg) gen.storeArg(lb.idx-1); else { if(primc != null) gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ISTORE), lb.idx); else gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), lb.idx); } } gen.goTo(loopLabel); } public boolean hasJavaClass() throws Exception{ return true; } public Class getJavaClass() throws Exception{ return null; } static class Parser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; IPersistentVector loopLocals = (IPersistentVector) LOOP_LOCALS.deref(); if(context != C.RETURN || loopLocals == null) throw new UnsupportedOperationException("Can only recur from tail position"); if(IN_CATCH_FINALLY.deref() != null) throw new UnsupportedOperationException("Cannot recur from catch/finally"); PersistentVector args = PersistentVector.EMPTY; for(ISeq s = RT.seq(form.next()); s != null; s = s.next()) { args = args.cons(analyze(C.EXPRESSION, s.first())); } if(args.count() != loopLocals.count()) throw new IllegalArgumentException( String.format("Mismatched argument count to recur, expected: %d args, got: %d", loopLocals.count(), args.count())); return new RecurExpr(loopLocals, args); } } } private static LocalBinding registerLocal(Symbol sym, Symbol tag, Expr init, boolean isArg) throws Exception{ int num = getAndIncLocalNum(); LocalBinding b = new LocalBinding(num, sym, tag, init, isArg, clearPathRoot()); IPersistentMap localsMap = (IPersistentMap) LOCAL_ENV.deref(); LOCAL_ENV.set(RT.assoc(localsMap, b.sym, b)); ObjMethod method = (ObjMethod) METHOD.deref(); method.locals = (IPersistentMap) RT.assoc(method.locals, b, b); method.indexlocals = (IPersistentMap) RT.assoc(method.indexlocals, num, b); return b; } private static int getAndIncLocalNum(){ int num = ((Number) NEXT_LOCAL_NUM.deref()).intValue(); ObjMethod m = (ObjMethod) METHOD.deref(); if(num > m.maxLocal) m.maxLocal = num; NEXT_LOCAL_NUM.set(num + 1); return num; } public static Expr analyze(C context, Object form) throws Exception{ return analyze(context, form, null); } private static Expr analyze(C context, Object form, String name) throws Exception{ //todo symbol macro expansion? try { if(form instanceof LazySeq) { form = RT.seq(form); if(form == null) form = PersistentList.EMPTY; } if(form == null) return NIL_EXPR; else if(form == Boolean.TRUE) return TRUE_EXPR; else if(form == Boolean.FALSE) return FALSE_EXPR; Class fclass = form.getClass(); if(fclass == Symbol.class) return analyzeSymbol((Symbol) form); else if(fclass == Keyword.class) return registerKeyword((Keyword) form); // else if(form instanceof Num) // return new NumExpr((Num) form); else if(fclass == String.class) return new StringExpr(((String) form).intern()); // else if(fclass == Character.class) // return new CharExpr((Character) form); else if(form instanceof IPersistentCollection && ((IPersistentCollection) form).count() == 0) { Expr ret = new EmptyExpr(form); if(RT.meta(form) != null) ret = new MetaExpr(ret, (MapExpr) MapExpr .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta())); return ret; } else if(form instanceof ISeq) return analyzeSeq(context, (ISeq) form, name); else if(form instanceof IPersistentVector) return VectorExpr.parse(context, (IPersistentVector) form); else if(form instanceof IPersistentMap) return MapExpr.parse(context, (IPersistentMap) form); else if(form instanceof IPersistentSet) return SetExpr.parse(context, (IPersistentSet) form); // else //throw new UnsupportedOperationException(); return new ConstantExpr(form); } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e); else throw (CompilerException) e; } } static public class CompilerException extends Exception{ public CompilerException(String source, int line, Throwable cause){ super(errorMsg(source, line, cause.toString()), cause); } public String toString(){ return getMessage(); } } static public Var isMacro(Object op) throws Exception{ //no local macros for now if(op instanceof Symbol && referenceLocal((Symbol) op) != null) return null; if(op instanceof Symbol || op instanceof Var) { Var v = (op instanceof Var) ? (Var) op : lookupVar((Symbol) op, false); if(v != null && v.isMacro()) { if(v.ns != currentNS() && !v.isPublic()) throw new IllegalStateException("var: " + v + " is not public"); return v; } } return null; } static public IFn isInline(Object op, int arity) throws Exception{ //no local inlines for now if(op instanceof Symbol && referenceLocal((Symbol) op) != null) return null; if(op instanceof Symbol || op instanceof Var) { Var v = (op instanceof Var) ? (Var) op : lookupVar((Symbol) op, false); if(v != null) { if(v.ns != currentNS() && !v.isPublic()) throw new IllegalStateException("var: " + v + " is not public"); IFn ret = (IFn) RT.get(v.meta(), inlineKey); if(ret != null) { IFn arityPred = (IFn) RT.get(v.meta(), inlineAritiesKey); if(arityPred == null || RT.booleanCast(arityPred.invoke(arity))) return ret; } } } return null; } public static boolean namesStaticMember(Symbol sym){ return sym.ns != null && namespaceFor(sym) == null; } public static Object preserveTag(ISeq src, Object dst) { Symbol tag = tagOf(src); if (tag != null && dst instanceof IObj) { IPersistentMap meta = RT.meta(dst); return ((IObj) dst).withMeta((IPersistentMap) RT.assoc(meta, RT.TAG_KEY, tag)); } return dst; } public static Object macroexpand1(Object x) throws Exception{ if(x instanceof ISeq) { ISeq form = (ISeq) x; Object op = RT.first(form); if(isSpecial(op)) return x; //macro expansion Var v = isMacro(op); if(v != null) { return v.applyTo(RT.cons(form,RT.cons(LOCAL_ENV.get(),form.next()))); } else { if(op instanceof Symbol) { Symbol sym = (Symbol) op; String sname = sym.name; //(.substring s 2 5) => (. s substring 2 5) if(sym.name.charAt(0) == '.') { if(RT.length(form) < 2) throw new IllegalArgumentException( "Malformed member expression, expecting (.member target ...)"); Symbol meth = Symbol.intern(sname.substring(1)); Object target = RT.second(form); if(HostExpr.maybeClass(target, false) != null) { target = ((IObj)RT.list(IDENTITY, target)).withMeta(RT.map(RT.TAG_KEY,CLASS)); } return preserveTag(form, RT.listStar(DOT, target, meth, form.next().next())); } else if(namesStaticMember(sym)) { Symbol target = Symbol.intern(sym.ns); Class c = HostExpr.maybeClass(target, false); if(c != null) { Symbol meth = Symbol.intern(sym.name); return preserveTag(form, RT.listStar(DOT, target, meth, form.next())); } } else { //(s.substring 2 5) => (. s substring 2 5) //also (package.class.name ...) (. package.class name ...) int idx = sname.lastIndexOf('.'); // if(idx > 0 && idx < sname.length() - 1) // { // Symbol target = Symbol.intern(sname.substring(0, idx)); // Symbol meth = Symbol.intern(sname.substring(idx + 1)); // return RT.listStar(DOT, target, meth, form.rest()); // } //(StringBuilder. "foo") => (new StringBuilder "foo") //else if(idx == sname.length() - 1) return RT.listStar(NEW, Symbol.intern(sname.substring(0, idx)), form.next()); } } } } return x; } static Object macroexpand(Object form) throws Exception{ Object exf = macroexpand1(form); if(exf != form) return macroexpand(exf); return form; } private static Expr analyzeSeq(C context, ISeq form, String name) throws Exception{ Integer line = (Integer) LINE.deref(); if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY)) line = (Integer) RT.meta(form).valAt(RT.LINE_KEY); Var.pushThreadBindings( RT.map(LINE, line)); try { Object me = macroexpand1(form); if(me != form) return analyze(context, me, name); Object op = RT.first(form); if(op == null) throw new IllegalArgumentException("Can't call nil"); IFn inline = isInline(op, RT.count(RT.next(form))); if(inline != null) return analyze(context, preserveTag(form, inline.applyTo(RT.next(form)))); IParser p; if(op.equals(FN)) return FnExpr.parse(context, form, name); else if((p = (IParser) specials.valAt(op)) != null) return p.parse(context, form); else return InvokeExpr.parse(context, form); } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e); else throw (CompilerException) e; } finally { Var.popThreadBindings(); } } static String errorMsg(String source, int line, String s){ return String.format("%s (%s:%d)", s, source, line); } public static Object eval(Object form) throws Exception{ return eval(form, true); } public static Object eval(Object form, boolean freshLoader) throws Exception{ boolean createdLoader = false; if(true)//!LOADER.isBound()) { Var.pushThreadBindings(RT.map(LOADER, RT.makeClassLoader())); createdLoader = true; } try { Integer line = (Integer) LINE.deref(); if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY)) line = (Integer) RT.meta(form).valAt(RT.LINE_KEY); Var.pushThreadBindings(RT.map(LINE, line)); try { form = macroexpand(form); if(form instanceof IPersistentCollection && Util.equals(RT.first(form), DO)) { ISeq s = RT.next(form); for(; RT.next(s) != null; s = RT.next(s)) eval(RT.first(s),false); return eval(RT.first(s),false); } else if(form instanceof IPersistentCollection && !(RT.first(form) instanceof Symbol && ((Symbol) RT.first(form)).name.startsWith("def"))) { ObjExpr fexpr = (ObjExpr) analyze(C.EXPRESSION, RT.list(FN, PersistentVector.EMPTY, form), "eval" + RT.nextID()); IFn fn = (IFn) fexpr.eval(); return fn.invoke(); } else { Expr expr = analyze(C.EVAL, form); return expr.eval(); } } finally { Var.popThreadBindings(); } } catch(Throwable e) { if(!(e instanceof CompilerException)) throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e); else throw (CompilerException) e; } finally { if(createdLoader) Var.popThreadBindings(); } } private static int registerConstant(Object o){ if(!CONSTANTS.isBound()) return -1; PersistentVector v = (PersistentVector) CONSTANTS.deref(); IdentityHashMap ids = (IdentityHashMap) CONSTANT_IDS.deref(); Integer i = ids.get(o); if(i != null) return i; CONSTANTS.set(RT.conj(v, o)); ids.put(o, v.count()); return v.count(); } private static KeywordExpr registerKeyword(Keyword keyword){ if(!KEYWORDS.isBound()) return new KeywordExpr(keyword); IPersistentMap keywordsMap = (IPersistentMap) KEYWORDS.deref(); Object id = RT.get(keywordsMap, keyword); if(id == null) { KEYWORDS.set(RT.assoc(keywordsMap, keyword, registerConstant(keyword))); } return new KeywordExpr(keyword); // KeywordExpr ke = (KeywordExpr) RT.get(keywordsMap, keyword); // if(ke == null) // KEYWORDS.set(RT.assoc(keywordsMap, keyword, ke = new KeywordExpr(keyword))); // return ke; } private static int registerKeywordCallsite(Keyword keyword){ if(!KEYWORD_CALLSITES.isBound()) throw new IllegalAccessError("KEYWORD_CALLSITES is not bound"); IPersistentVector keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref(); keywordCallsites = keywordCallsites.cons(keyword); KEYWORD_CALLSITES.set(keywordCallsites); return keywordCallsites.count()-1; } private static int registerProtocolCallsite(Var v){ if(!PROTOCOL_CALLSITES.isBound()) throw new IllegalAccessError("PROTOCOL_CALLSITES is not bound"); IPersistentVector protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref(); protocolCallsites = protocolCallsites.cons(v); PROTOCOL_CALLSITES.set(protocolCallsites); return protocolCallsites.count()-1; } private static int registerVarCallsite(Var v){ if(!VAR_CALLSITES.isBound()) throw new IllegalAccessError("VAR_CALLSITES is not bound"); IPersistentVector varCallsites = (IPersistentVector) VAR_CALLSITES.deref(); varCallsites = varCallsites.cons(v); VAR_CALLSITES.set(varCallsites); return varCallsites.count()-1; } static ISeq fwdPath(PathNode p1){ ISeq ret = null; for(;p1 != null;p1 = p1.parent) ret = RT.cons(p1,ret); return ret; } static PathNode commonPath(PathNode n1, PathNode n2){ ISeq xp = fwdPath(n1); ISeq yp = fwdPath(n2); if(RT.first(xp) != RT.first(yp)) return null; while(RT.second(xp) != null && RT.second(xp) == RT.second(yp)) { xp = xp.next(); yp = yp.next(); } return (PathNode) RT.first(xp); } static void addAnnotation(Object visitor, IPersistentMap meta){ try{ if(meta != null && ADD_ANNOTATIONS.isBound()) ADD_ANNOTATIONS.invoke(visitor, meta); } catch (Exception e) { throw new RuntimeException(e); } } static void addParameterAnnotation(Object visitor, IPersistentMap meta, int i){ try{ if(meta != null && ADD_ANNOTATIONS.isBound()) ADD_ANNOTATIONS.invoke(visitor, meta, i); } catch (Exception e) { throw new RuntimeException(e); } } private static Expr analyzeSymbol(Symbol sym) throws Exception{ Symbol tag = tagOf(sym); if(sym.ns == null) //ns-qualified syms are always Vars { LocalBinding b = referenceLocal(sym); if(b != null) { return new LocalBindingExpr(b, tag); } } else { if(namespaceFor(sym) == null) { Symbol nsSym = Symbol.create(sym.ns); Class c = HostExpr.maybeClass(nsSym, false); if(c != null) { if(Reflector.getField(c, sym.name, true) != null) return new StaticFieldExpr((Integer) LINE.deref(), c, sym.name, tag); throw new Exception("Unable to find static field: " + sym.name + " in " + c); } } } //Var v = lookupVar(sym, false); // Var v = lookupVar(sym, false); // if(v != null) // return new VarExpr(v, tag); Object o = resolve(sym); if(o instanceof Var) { Var v = (Var) o; if(isMacro(v) != null) throw new Exception("Can't take value of a macro: " + v); registerVar(v); return new VarExpr(v, tag); } else if(o instanceof Class) return new ConstantExpr(o); else if(o instanceof Symbol) return new UnresolvedVarExpr((Symbol) o); throw new Exception("Unable to resolve symbol: " + sym + " in this context"); } static String destubClassName(String className){ //skip over prefix + '.' or '/' if(className.startsWith(COMPILE_STUB_PREFIX)) return className.substring(COMPILE_STUB_PREFIX.length()+1); return className; } static Type getType(Class c){ String descriptor = Type.getType(c).getDescriptor(); if(descriptor.startsWith("L")) descriptor = "L" + destubClassName(descriptor.substring(1)); return Type.getType(descriptor); } static Object resolve(Symbol sym, boolean allowPrivate) throws Exception{ return resolveIn(currentNS(), sym, allowPrivate); } static Object resolve(Symbol sym) throws Exception{ return resolveIn(currentNS(), sym, false); } static Namespace namespaceFor(Symbol sym){ return namespaceFor(currentNS(), sym); } static Namespace namespaceFor(Namespace inns, Symbol sym){ //note, presumes non-nil sym.ns // first check against currentNS' aliases... Symbol nsSym = Symbol.create(sym.ns); Namespace ns = inns.lookupAlias(nsSym); if(ns == null) { // ...otherwise check the Namespaces map. ns = Namespace.find(nsSym); } return ns; } static public Object resolveIn(Namespace n, Symbol sym, boolean allowPrivate) throws Exception{ //note - ns-qualified vars must already exist if(sym.ns != null) { Namespace ns = namespaceFor(n, sym); if(ns == null) throw new Exception("No such namespace: " + sym.ns); Var v = ns.findInternedVar(Symbol.create(sym.name)); if(v == null) throw new Exception("No such var: " + sym); else if(v.ns != currentNS() && !v.isPublic() && !allowPrivate) throw new IllegalStateException("var: " + sym + " is not public"); return v; } else if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') { return RT.classForName(sym.name); } else if(sym.equals(NS)) return RT.NS_VAR; else if(sym.equals(IN_NS)) return RT.IN_NS_VAR; else { if(Util.equals(sym,COMPILE_STUB_SYM.get())) return COMPILE_STUB_CLASS.get(); Object o = n.getMapping(sym); if(o == null) { if(RT.booleanCast(RT.ALLOW_UNRESOLVED_VARS.deref())) { return sym; } else { throw new Exception("Unable to resolve symbol: " + sym + " in this context"); } } return o; } } static public Object maybeResolveIn(Namespace n, Symbol sym) throws Exception{ //note - ns-qualified vars must already exist if(sym.ns != null) { Namespace ns = namespaceFor(n, sym); if(ns == null) return null; Var v = ns.findInternedVar(Symbol.create(sym.name)); if(v == null) return null; return v; } else if(sym.name.indexOf('.') > 0 && !sym.name.endsWith(".") || sym.name.charAt(0) == '[') { return RT.classForName(sym.name); } else if(sym.equals(NS)) return RT.NS_VAR; else if(sym.equals(IN_NS)) return RT.IN_NS_VAR; else { Object o = n.getMapping(sym); return o; } } static Var lookupVar(Symbol sym, boolean internNew) throws Exception{ Var var = null; //note - ns-qualified vars in other namespaces must already exist if(sym.ns != null) { Namespace ns = namespaceFor(sym); if(ns == null) return null; //throw new Exception("No such namespace: " + sym.ns); Symbol name = Symbol.create(sym.name); if(internNew && ns == currentNS()) var = currentNS().intern(name); else var = ns.findInternedVar(name); } else if(sym.equals(NS)) var = RT.NS_VAR; else if(sym.equals(IN_NS)) var = RT.IN_NS_VAR; else { //is it mapped? Object o = currentNS().getMapping(sym); if(o == null) { //introduce a new var in the current ns if(internNew) var = currentNS().intern(Symbol.create(sym.name)); } else if(o instanceof Var) { var = (Var) o; } else { throw new Exception("Expecting var, but " + sym + " is mapped to " + o); } } if(var != null) registerVar(var); return var; } private static void registerVar(Var var) throws Exception{ if(!VARS.isBound()) return; IPersistentMap varsMap = (IPersistentMap) VARS.deref(); Object id = RT.get(varsMap, var); if(id == null) { VARS.set(RT.assoc(varsMap, var, registerConstant(var))); } // if(varsMap != null && RT.get(varsMap, var) == null) // VARS.set(RT.assoc(varsMap, var, var)); } static Namespace currentNS(){ return (Namespace) RT.CURRENT_NS.deref(); } static void closeOver(LocalBinding b, ObjMethod method){ if(b != null && method != null) { if(RT.get(method.locals, b) == null) { method.objx.closes = (IPersistentMap) RT.assoc(method.objx.closes, b, b); closeOver(b, method.parent); } else if(IN_CATCH_FINALLY.deref() != null) { method.localsUsedInCatchFinally = (PersistentHashSet) method.localsUsedInCatchFinally.cons(b.idx); } } } static LocalBinding referenceLocal(Symbol sym) throws Exception{ if(!LOCAL_ENV.isBound()) return null; LocalBinding b = (LocalBinding) RT.get(LOCAL_ENV.deref(), sym); if(b != null) { ObjMethod method = (ObjMethod) METHOD.deref(); closeOver(b, method); } return b; } private static Symbol tagOf(Object o){ Object tag = RT.get(RT.meta(o), RT.TAG_KEY); if(tag instanceof Symbol) return (Symbol) tag; else if(tag instanceof String) return Symbol.intern(null, (String) tag); return null; } public static Object loadFile(String file) throws Exception{ // File fo = new File(file); // if(!fo.exists()) // return null; FileInputStream f = new FileInputStream(file); try { return load(new InputStreamReader(f, RT.UTF8), new File(file).getAbsolutePath(), (new File(file)).getName()); } finally { f.close(); } } public static Object load(Reader rdr) throws Exception{ return load(rdr, null, "NO_SOURCE_FILE"); } public static Object load(Reader rdr, String sourcePath, String sourceName) throws Exception{ Object EOF = new Object(); Object ret = null; LineNumberingPushbackReader pushbackReader = (rdr instanceof LineNumberingPushbackReader) ? (LineNumberingPushbackReader) rdr : new LineNumberingPushbackReader(rdr); Var.pushThreadBindings( RT.map(LOADER, RT.makeClassLoader(), SOURCE_PATH, sourcePath, SOURCE, sourceName, METHOD, null, LOCAL_ENV, null, LOOP_LOCALS, null, NEXT_LOCAL_NUM, 0, RT.CURRENT_NS, RT.CURRENT_NS.deref(), LINE_BEFORE, pushbackReader.getLineNumber(), LINE_AFTER, pushbackReader.getLineNumber() )); try { for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF; r = LispReader.read(pushbackReader, false, EOF, false)) { LINE_AFTER.set(pushbackReader.getLineNumber()); ret = eval(r,false); LINE_BEFORE.set(pushbackReader.getLineNumber()); } } catch(LispReader.ReaderException e) { throw new CompilerException(sourceName, e.line, e.getCause()); } finally { Var.popThreadBindings(); } return ret; } static public void writeClassFile(String internalName, byte[] bytecode) throws Exception{ String genPath = (String) COMPILE_PATH.deref(); if(genPath == null) throw new Exception("*compile-path* not set"); String[] dirs = internalName.split("/"); String p = genPath; for(int i = 0; i < dirs.length - 1; i++) { p += File.separator + dirs[i]; (new File(p)).mkdir(); } String path = genPath + File.separator + internalName + ".class"; File cf = new File(path); cf.createNewFile(); FileOutputStream cfs = new FileOutputStream(cf); try { cfs.write(bytecode); cfs.flush(); cfs.getFD().sync(); } finally { cfs.close(); } } public static void pushNS(){ Var.pushThreadBindings(PersistentHashMap.create(Var.intern(Symbol.create("clojure.core"), Symbol.create("*ns*")), null)); } public static ILookupThunk getLookupThunk(Object target, Keyword k){ return null; //To change body of created methods use File | Settings | File Templates. } static void compile1(GeneratorAdapter gen, ObjExpr objx, Object form) throws Exception{ Integer line = (Integer) LINE.deref(); if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY)) line = (Integer) RT.meta(form).valAt(RT.LINE_KEY); Var.pushThreadBindings( RT.map(LINE, line ,LOADER, RT.makeClassLoader() )); try { form = macroexpand(form); if(form instanceof IPersistentCollection && Util.equals(RT.first(form), DO)) { for(ISeq s = RT.next(form); s != null; s = RT.next(s)) { compile1(gen, objx, RT.first(s)); } } else { Expr expr = analyze(C.EVAL, form); objx.keywords = (IPersistentMap) KEYWORDS.deref(); objx.vars = (IPersistentMap) VARS.deref(); objx.constants = (PersistentVector) CONSTANTS.deref(); expr.emit(C.EXPRESSION, objx, gen); expr.eval(); } } finally { Var.popThreadBindings(); } } public static Object compile(Reader rdr, String sourcePath, String sourceName) throws Exception{ if(COMPILE_PATH.deref() == null) throw new Exception("*compile-path* not set"); Object EOF = new Object(); Object ret = null; LineNumberingPushbackReader pushbackReader = (rdr instanceof LineNumberingPushbackReader) ? (LineNumberingPushbackReader) rdr : new LineNumberingPushbackReader(rdr); Var.pushThreadBindings( RT.map(SOURCE_PATH, sourcePath, SOURCE, sourceName, METHOD, null, LOCAL_ENV, null, LOOP_LOCALS, null, NEXT_LOCAL_NUM, 0, RT.CURRENT_NS, RT.CURRENT_NS.deref(), LINE_BEFORE, pushbackReader.getLineNumber(), LINE_AFTER, pushbackReader.getLineNumber(), CONSTANTS, PersistentVector.EMPTY, CONSTANT_IDS, new IdentityHashMap(), KEYWORDS, PersistentHashMap.EMPTY, VARS, PersistentHashMap.EMPTY // ,LOADER, RT.makeClassLoader() )); try { //generate loader class ObjExpr objx = new ObjExpr(null); objx.internalName = sourcePath.replace(File.separator, "/").substring(0, sourcePath.lastIndexOf('.')) + RT.LOADER_SUFFIX; objx.objtype = Type.getObjectType(objx.internalName); ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS); ClassVisitor cv = cw; cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, objx.internalName, null, "java/lang/Object", null); //static load method GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, Method.getMethod("void load ()"), null, null, cv); gen.visitCode(); for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF; r = LispReader.read(pushbackReader, false, EOF, false)) { LINE_AFTER.set(pushbackReader.getLineNumber()); compile1(gen, objx, r); LINE_BEFORE.set(pushbackReader.getLineNumber()); } //end of load gen.returnValue(); gen.endMethod(); //static fields for constants for(int i = 0; i < objx.constants.count(); i++) { cv.visitField(ACC_PUBLIC + ACC_FINAL + ACC_STATIC, objx.constantName(i), objx.constantType(i).getDescriptor(), null, null); } //static init for constants, keywords and vars GeneratorAdapter clinitgen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, Method.getMethod("void ()"), null, null, cv); clinitgen.visitCode(); Label startTry = clinitgen.newLabel(); Label endTry = clinitgen.newLabel(); Label end = clinitgen.newLabel(); Label finallyLabel = clinitgen.newLabel(); if(objx.constants.count() > 0) { objx.emitConstants(clinitgen); } clinitgen.invokeStatic(Type.getType(Compiler.class), Method.getMethod("void pushNS()")); clinitgen.mark(startTry); clinitgen.invokeStatic(objx.objtype, Method.getMethod("void load()")); clinitgen.mark(endTry); clinitgen.invokeStatic(VAR_TYPE, Method.getMethod("void popThreadBindings()")); clinitgen.goTo(end); clinitgen.mark(finallyLabel); //exception should be on stack clinitgen.invokeStatic(VAR_TYPE, Method.getMethod("void popThreadBindings()")); clinitgen.throwException(); clinitgen.mark(end); clinitgen.visitTryCatchBlock(startTry, endTry, finallyLabel, null); //end of static init clinitgen.returnValue(); clinitgen.endMethod(); //end of class cv.visitEnd(); writeClassFile(objx.internalName, cw.toByteArray()); } catch(LispReader.ReaderException e) { throw new CompilerException(sourceName, e.line, e.getCause()); } finally { Var.popThreadBindings(); } return ret; } static public class NewInstanceExpr extends ObjExpr{ //IPersistentMap optionsMap = PersistentArrayMap.EMPTY; IPersistentCollection methods; Map mmap; Map> covariants; public NewInstanceExpr(Object tag){ super(tag); } static class DeftypeParser implements IParser{ public Expr parse(C context, final Object frm) throws Exception{ ISeq rform = (ISeq) frm; //(deftype* tagname classname [fields] :implements [interfaces] :tag tagname methods*) rform = RT.next(rform); String tagname = ((Symbol) rform.first()).toString(); rform = rform.next(); Symbol classname = (Symbol) rform.first(); rform = rform.next(); IPersistentVector fields = (IPersistentVector) rform.first(); rform = rform.next(); IPersistentMap opts = PersistentHashMap.EMPTY; while(rform != null && rform.first() instanceof Keyword) { opts = opts.assoc(rform.first(), RT.second(rform)); rform = rform.next().next(); } ObjExpr ret = build((IPersistentVector)RT.get(opts,implementsKey,PersistentVector.EMPTY),fields,null,tagname, classname, (Symbol) RT.get(opts,RT.TAG_KEY),rform, frm); return ret; } } static class ReifyParser implements IParser{ public Expr parse(C context, Object frm) throws Exception{ //(reify this-name? [interfaces] (method-name [args] body)*) ISeq form = (ISeq) frm; ObjMethod enclosingMethod = (ObjMethod) METHOD.deref(); String basename = enclosingMethod != null ? (trimGenID(enclosingMethod.objx.name) + "$") : (munge(currentNS().name.name) + "$"); String simpleName = "reify__" + RT.nextID(); String classname = basename + simpleName; ISeq rform = RT.next(form); IPersistentVector interfaces = ((IPersistentVector) RT.first(rform)).cons(Symbol.intern("clojure.lang.IObj")); rform = RT.next(rform); ObjExpr ret = build(interfaces, null, null, classname, Symbol.intern(classname), null, rform, frm); if(frm instanceof IObj && ((IObj) frm).meta() != null) return new MetaExpr(ret, (MapExpr) MapExpr .parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) frm).meta())); else return ret; } } static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSyms, Symbol thisSym, String tagName, Symbol className, Symbol typeTag, ISeq methodForms, Object frm) throws Exception{ NewInstanceExpr ret = new NewInstanceExpr(null); ret.src = frm; ret.name = className.toString(); ret.classMeta = RT.meta(className); ret.internalName = ret.name.replace('.', '/'); ret.objtype = Type.getObjectType(ret.internalName); if(thisSym != null) ret.thisName = thisSym.name; if(fieldSyms != null) { IPersistentMap fmap = PersistentHashMap.EMPTY; Object[] closesvec = new Object[2 * fieldSyms.count()]; for(int i=0;i= 0 && ((Symbol)fieldSyms.nth(i)).name.startsWith("__");--i) ret.altCtorDrops++; } //todo - set up volatiles // ret.volatiles = PersistentHashSet.create(RT.seq(RT.get(ret.optionsMap, volatileKey))); PersistentVector interfaces = PersistentVector.EMPTY; for(ISeq s = RT.seq(interfaceSyms);s!=null;s = s.next()) { Class c = (Class) resolve((Symbol) s.first()); if(!c.isInterface()) throw new IllegalArgumentException("only interfaces are supported, had: " + c.getName()); interfaces = interfaces.cons(c); } Class superClass = Object.class; Map[] mc = gatherMethods(superClass,RT.seq(interfaces)); Map overrideables = mc[0]; Map covariants = mc[1]; ret.mmap = overrideables; ret.covariants = covariants; String[] inames = interfaceNames(interfaces); Class stub = compileStub(slashname(superClass),ret, inames, frm); Symbol thistag = Symbol.intern(null,stub.getName()); try { Var.pushThreadBindings( RT.map(CONSTANTS, PersistentVector.EMPTY, CONSTANT_IDS, new IdentityHashMap(), KEYWORDS, PersistentHashMap.EMPTY, VARS, PersistentHashMap.EMPTY, KEYWORD_CALLSITES, PersistentVector.EMPTY, PROTOCOL_CALLSITES, PersistentVector.EMPTY, VAR_CALLSITES, PersistentVector.EMPTY )); if(ret.isDeftype()) { Var.pushThreadBindings(RT.map(METHOD, null, LOCAL_ENV, ret.fields , COMPILE_STUB_SYM, Symbol.intern(null, tagName) , COMPILE_STUB_CLASS, stub)); } //now (methodname [args] body)* ret.line = (Integer) LINE.deref(); IPersistentCollection methods = null; for(ISeq s = methodForms; s != null; s = RT.next(s)) { NewInstanceMethod m = NewInstanceMethod.parse(ret, (ISeq) RT.first(s),thistag, overrideables); methods = RT.conj(methods, m); } ret.methods = methods; ret.keywords = (IPersistentMap) KEYWORDS.deref(); ret.vars = (IPersistentMap) VARS.deref(); ret.constants = (PersistentVector) CONSTANTS.deref(); ret.constantsID = RT.nextID(); ret.keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref(); ret.protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref(); ret.varCallsites = (IPersistentVector) VAR_CALLSITES.deref(); } finally { if(ret.isDeftype()) Var.popThreadBindings(); Var.popThreadBindings(); } ret.compile(slashname(superClass),inames,false); ret.getCompiledClass(); return ret; } /*** * Current host interop uses reflection, which requires pre-existing classes * Work around this by: * Generate a stub class that has the same interfaces and fields as the class we are generating. * Use it as a type hint for this, and bind the simple name of the class to this stub (in resolve etc) * Unmunge the name (using a magic prefix) on any code gen for classes */ static Class compileStub(String superName, NewInstanceExpr ret, String[] interfaceNames, Object frm){ ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS); ClassVisitor cv = cw; cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, COMPILE_STUB_PREFIX + "/" + ret.internalName, null,superName,interfaceNames); //instance fields for closed-overs for(ISeq s = RT.keys(ret.closes); s != null; s = s.next()) { LocalBinding lb = (LocalBinding) s.first(); int access = ACC_PUBLIC + (ret.isVolatile(lb) ? ACC_VOLATILE : ret.isMutable(lb) ? 0 : ACC_FINAL); if(lb.getPrimitiveType() != null) cv.visitField(access , lb.name, Type.getType(lb.getPrimitiveType()).getDescriptor(), null, null); else //todo - when closed-overs are fields, use more specific types here and in ctor and emitLocal? cv.visitField(access , lb.name, OBJECT_TYPE.getDescriptor(), null, null); } //ctor that takes closed-overs and does nothing Method m = new Method("", Type.VOID_TYPE, ret.ctorTypes()); GeneratorAdapter ctorgen = new GeneratorAdapter(ACC_PUBLIC, m, null, null, cv); ctorgen.visitCode(); ctorgen.loadThis(); ctorgen.invokeConstructor(Type.getObjectType(superName), voidctor); ctorgen.returnValue(); ctorgen.endMethod(); if(ret.altCtorDrops > 0) { Type[] ctorTypes = ret.ctorTypes(); Type[] altCtorTypes = new Type[ctorTypes.length-ret.altCtorDrops]; for(int i=0;i", Type.VOID_TYPE, altCtorTypes); ctorgen = new GeneratorAdapter(ACC_PUBLIC, alt, null, null, cv); ctorgen.visitCode(); ctorgen.loadThis(); ctorgen.loadArgs(); for(int i=0;i", Type.VOID_TYPE, ctorTypes)); ctorgen.returnValue(); ctorgen.endMethod(); } //end of class cv.visitEnd(); byte[] bytecode = cw.toByteArray(); DynamicClassLoader loader = (DynamicClassLoader) LOADER.deref(); return loader.defineClass(COMPILE_STUB_PREFIX + "." + ret.name, bytecode, frm); } static String[] interfaceNames(IPersistentVector interfaces){ int icnt = interfaces.count(); String[] inames = icnt > 0 ? new String[icnt] : null; for(int i=0;i> e : covariants.entrySet()) { java.lang.reflect.Method m = mmap.get(e.getKey()); Class[] params = m.getParameterTypes(); Type[] argTypes = new Type[params.length]; for(int i = 0; i < params.length; i++) { argTypes[i] = Type.getType(params[i]); } Method target = new Method(m.getName(), Type.getType(m.getReturnType()), argTypes); for(Class retType : e.getValue()) { Method meth = new Method(m.getName(), Type.getType(retType), argTypes); GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_BRIDGE, meth, null, //todo don't hardwire this EXCEPTION_TYPES, cv); gen.visitCode(); gen.loadThis(); gen.loadArgs(); gen.invokeInterface(Type.getType(m.getDeclaringClass()),target); gen.returnValue(); gen.endMethod(); } } } static public IPersistentVector msig(java.lang.reflect.Method m){ return RT.vector(m.getName(), RT.seq(m.getParameterTypes()),m.getReturnType()); } static void considerMethod(java.lang.reflect.Method m, Map mm){ IPersistentVector mk = msig(m); int mods = m.getModifiers(); if(!(mm.containsKey(mk) || !(Modifier.isPublic(mods) || Modifier.isProtected(mods)) || Modifier.isStatic(mods) || Modifier.isFinal(mods))) { mm.put(mk, m); } } static void gatherMethods(Class c, Map mm){ for(; c != null; c = c.getSuperclass()) { for(java.lang.reflect.Method m : c.getDeclaredMethods()) considerMethod(m, mm); for(java.lang.reflect.Method m : c.getMethods()) considerMethod(m, mm); } } static public Map[] gatherMethods(Class sc, ISeq interfaces){ Map allm = new HashMap(); gatherMethods(sc, allm); for(; interfaces != null; interfaces = interfaces.next()) gatherMethods((Class) interfaces.first(), allm); Map mm = new HashMap(); Map> covariants = new HashMap>(); for(Object o : allm.entrySet()) { Map.Entry e = (Map.Entry) o; IPersistentVector mk = (IPersistentVector) e.getKey(); mk = (IPersistentVector) mk.pop(); java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue(); if(mm.containsKey(mk)) //covariant return { Set cvs = covariants.get(mk); if(cvs == null) { cvs = new HashSet(); covariants.put(mk,cvs); } java.lang.reflect.Method om = mm.get(mk); if(om.getReturnType().isAssignableFrom(m.getReturnType())) { cvs.add(om.getReturnType()); mm.put(mk, m); } else cvs.add(m.getReturnType()); } else mm.put(mk, m); } return new Map[]{mm,covariants}; } } public static class NewInstanceMethod extends ObjMethod{ String name; Type[] argTypes; Type retType; Class retClass; Class[] exclasses; static Symbol dummyThis = Symbol.intern(null,"dummy_this_dlskjsdfower"); private IPersistentVector parms; public NewInstanceMethod(ObjExpr objx, ObjMethod parent){ super(objx, parent); } int numParams(){ return argLocals.count(); } String getMethodName(){ return name; } Type getReturnType(){ return retType; } Type[] getArgTypes(){ return argTypes; } static public IPersistentVector msig(String name,Class[] paramTypes){ return RT.vector(name,RT.seq(paramTypes)); } static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag, Map overrideables) throws Exception{ //(methodname [this-name args*] body...) //this-name might be nil NewInstanceMethod method = new NewInstanceMethod(objx, (ObjMethod) METHOD.deref()); Symbol dotname = (Symbol)RT.first(form); Symbol name = (Symbol) Symbol.intern(null,munge(dotname.name)).withMeta(RT.meta(dotname)); IPersistentVector parms = (IPersistentVector) RT.second(form); if(parms.count() == 0) { throw new IllegalArgumentException("Must supply at least one argument for 'this' in: " + dotname); } Symbol thisName = (Symbol) parms.nth(0); parms = RT.subvec(parms,1,parms.count()); ISeq body = RT.next(RT.next(form)); try { method.line = (Integer) LINE.deref(); //register as the current method and set up a new env frame PathNode pnode = new PathNode(PATHTYPE.PATH, (PathNode) CLEAR_PATH.get()); Var.pushThreadBindings( RT.map( METHOD, method, LOCAL_ENV, LOCAL_ENV.deref(), LOOP_LOCALS, null, NEXT_LOCAL_NUM, 0 ,CLEAR_PATH, pnode ,CLEAR_ROOT, pnode ,CLEAR_SITES, PersistentHashMap.EMPTY )); //register 'this' as local 0 if(thisName != null) registerLocal((thisName == null) ? dummyThis:thisName,thistag, null,false); else getAndIncLocalNum(); PersistentVector argLocals = PersistentVector.EMPTY; method.retClass = tagClass(tagOf(name)); method.argTypes = new Type[parms.count()]; boolean hinted = tagOf(name) != null; Class[] pclasses = new Class[parms.count()]; Symbol[] psyms = new Symbol[parms.count()]; for(int i = 0; i < parms.count(); i++) { if(!(parms.nth(i) instanceof Symbol)) throw new IllegalArgumentException("params must be Symbols"); Symbol p = (Symbol) parms.nth(i); Object tag = tagOf(p); if(tag != null) hinted = true; if(p.getNamespace() != null) p = Symbol.create(p.name); Class pclass = tagClass(tag); pclasses[i] = pclass; psyms[i] = p; } Map matches = findMethodsWithNameAndArity(name.name, parms.count(), overrideables); Object mk = msig(name.name, pclasses); java.lang.reflect.Method m = null; if(matches.size() > 0) { //multiple methods if(matches.size() > 1) { //must be hinted and match one method if(!hinted) throw new IllegalArgumentException("Must hint overloaded method: " + name.name); m = (java.lang.reflect.Method) matches.get(mk); if(m == null) throw new IllegalArgumentException("Can't find matching overloaded method: " + name.name); if(m.getReturnType() != method.retClass) throw new IllegalArgumentException("Mismatched return type: " + name.name + ", expected: " + m.getReturnType().getName() + ", had: " + method.retClass.getName()); } else //one match { //if hinted, validate match, if(hinted) { m = (java.lang.reflect.Method) matches.get(mk); if(m == null) throw new IllegalArgumentException("Can't find matching method: " + name.name + ", leave off hints for auto match."); if(m.getReturnType() != method.retClass) throw new IllegalArgumentException("Mismatched return type: " + name.name + ", expected: " + m.getReturnType().getName() + ", had: " + method.retClass.getName()); } else //adopt found method sig { m = (java.lang.reflect.Method) matches.values().iterator().next(); method.retClass = m.getReturnType(); pclasses = m.getParameterTypes(); } } } // else if(findMethodsWithName(name.name,allmethods).size()>0) // throw new IllegalArgumentException("Can't override/overload method: " + name.name); else throw new IllegalArgumentException("Can't define method not in interfaces: " + name.name); //else //validate unque name+arity among additional methods method.retType = Type.getType(method.retClass); method.exclasses = m.getExceptionTypes(); for(int i = 0; i < parms.count(); i++) { LocalBinding lb = registerLocal(psyms[i], null, new MethodParamExpr(pclasses[i]),true); argLocals = argLocals.assocN(i,lb); method.argTypes[i] = Type.getType(pclasses[i]); } for(int i = 0; i < parms.count(); i++) { if(pclasses[i] == long.class || pclasses[i] == double.class) getAndIncLocalNum(); } LOOP_LOCALS.set(argLocals); method.name = name.name; method.methodMeta = RT.meta(name); method.parms = parms; method.argLocals = argLocals; method.body = (new BodyExpr.Parser()).parse(C.RETURN, body); return method; } finally { Var.popThreadBindings(); } } private static Map findMethodsWithNameAndArity(String name, int arity, Map mm){ Map ret = new HashMap(); for(Object o : mm.entrySet()) { Map.Entry e = (Map.Entry) o; java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue(); if(name.equals(m.getName()) && m.getParameterTypes().length == arity) ret.put(e.getKey(), e.getValue()); } return ret; } private static Map findMethodsWithName(String name, Map mm){ Map ret = new HashMap(); for(Object o : mm.entrySet()) { Map.Entry e = (Map.Entry) o; java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue(); if(name.equals(m.getName())) ret.put(e.getKey(), e.getValue()); } return ret; } public void emit(ObjExpr obj, ClassVisitor cv){ Method m = new Method(getMethodName(), getReturnType(), getArgTypes()); Type[] extypes = null; if(exclasses.length > 0) { extypes = new Type[exclasses.length]; for(int i=0;i tests; public final HashMap thens; public final boolean allKeywords; public final int line; final static Method hashMethod = Method.getMethod("int hash(Object)"); final static Method hashCodeMethod = Method.getMethod("int hashCode()"); final static Method equalsMethod = Method.getMethod("boolean equals(Object, Object)"); public CaseExpr(int line, LocalBindingExpr expr, int shift, int mask, int low, int high, Expr defaultExpr, HashMap tests,HashMap thens, boolean allKeywords){ this.expr = expr; this.shift = shift; this.mask = mask; this.low = low; this.high = high; this.defaultExpr = defaultExpr; this.tests = tests; this.thens = thens; this.line = line; this.allKeywords = allKeywords; } public Object eval() throws Exception{ throw new UnsupportedOperationException("Can't eval case"); } public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ Label defaultLabel = gen.newLabel(); Label endLabel = gen.newLabel(); HashMap labels = new HashMap(); for(Integer i : tests.keySet()) { labels.put(i, gen.newLabel()); } Label[] la = new Label[(high-low)+1]; for(int i=low;i<=high;i++) { la[i-low] = labels.containsKey(i) ? labels.get(i) : defaultLabel; } gen.visitLineNumber(line, gen.mark()); expr.emit(C.EXPRESSION, objx, gen); gen.invokeStatic(UTIL_TYPE,hashMethod); gen.push(shift); gen.visitInsn(ISHR); gen.push(mask); gen.visitInsn(IAND); gen.visitTableSwitchInsn(low, high, defaultLabel, la); for(Integer i : labels.keySet()) { gen.mark(labels.get(i)); expr.emit(C.EXPRESSION, objx, gen); tests.get(i).emit(C.EXPRESSION, objx, gen); if(allKeywords) { gen.visitJumpInsn(IF_ACMPNE, defaultLabel); } else { gen.invokeStatic(UTIL_TYPE, equalsMethod); gen.ifZCmp(GeneratorAdapter.EQ, defaultLabel); } thens.get(i).emit(C.EXPRESSION,objx,gen); gen.goTo(endLabel); } gen.mark(defaultLabel); defaultExpr.emit(C.EXPRESSION, objx, gen); gen.mark(endLabel); if(context == C.STATEMENT) gen.pop(); } static class Parser implements IParser{ //(case* expr shift mask low high default map identity?) //prepared by case macro and presumed correct //case macro binds actual expr in let so expr is always a local, //no need to worry about multiple evaluation public Expr parse(C context, Object frm) throws Exception{ ISeq form = (ISeq) frm; if(context == C.EVAL) return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form))); PersistentVector args = PersistentVector.create(form.next()); HashMap tests = new HashMap(); HashMap thens = new HashMap(); LocalBindingExpr testexpr = (LocalBindingExpr) analyze(C.EXPRESSION, args.nth(0)); testexpr.shouldClear = false; PathNode branch = new PathNode(PATHTYPE.BRANCH, (PathNode) CLEAR_PATH.get()); for(Object o : ((Map)args.nth(6)).entrySet()) { Map.Entry e = (Map.Entry) o; Integer minhash = (Integer) e.getKey(); MapEntry me = (MapEntry) e.getValue(); Expr testExpr = new ConstantExpr(me.getKey()); tests.put(minhash, testExpr); Expr thenExpr; try { Var.pushThreadBindings( RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); thenExpr = analyze(context, me.getValue()); } finally{ Var.popThreadBindings(); } thens.put(minhash, thenExpr); } Expr defaultExpr; try { Var.pushThreadBindings( RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch))); defaultExpr = analyze(context, args.nth(5)); } finally{ Var.popThreadBindings(); } return new CaseExpr((Integer) LINE.deref(), testexpr, (Integer)args.nth(1), (Integer)args.nth(2), (Integer)args.nth(3), (Integer)args.nth(4), defaultExpr, tests,thens,args.nth(7) != RT.F); } } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Cons.java000066400000000000000000000022731157562347600230770ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 25, 2006 11:01:29 AM */ package clojure.lang; import java.io.Serializable; final public class Cons extends ASeq implements Serializable { private final Object _first; private final ISeq _more; public Cons(Object first, ISeq _more){ this._first = first; this._more = _more; } public Cons(IPersistentMap meta, Object _first, ISeq _more){ super(meta); this._first = _first; this._more = _more; } public Object first(){ return _first; } public ISeq next(){ return more().seq(); } public ISeq more(){ if(_more == null) return PersistentList.EMPTY; return _more; } public int count(){ return 1 + RT.count(_more); } public Cons withMeta(IPersistentMap meta){ return new Cons(meta, _first, _more); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Counted.java000066400000000000000000000012101157562347600235640ustar00rootroot00000000000000package clojure.lang; /** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ /* A class that implements Counted promises that it is a collection * that implement a constant-time count() */ public interface Counted { int count(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Delay.java000066400000000000000000000016071157562347600232330ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jun 28, 2007 */ package clojure.lang; public class Delay implements IDeref{ Object val; IFn fn; public Delay(IFn fn){ this.fn = fn; this.val = null; } static public Object force(Object x) throws Exception{ return (x instanceof Delay) ? ((Delay) x).deref() : x; } synchronized public Object deref() throws Exception{ if(fn != null) { val = fn.invoke(); fn = null; } return val; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/DynamicClassLoader.java000066400000000000000000000043771157562347600257050ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Aug 21, 2007 */ package clojure.lang; import java.lang.ref.Reference; import java.util.HashMap; import java.util.Map; import java.util.concurrent.ConcurrentHashMap; import java.net.URLClassLoader; import java.net.URL; import java.lang.ref.ReferenceQueue; import java.lang.ref.SoftReference; public class DynamicClassLoader extends URLClassLoader{ HashMap constantVals = new HashMap(); static ConcurrentHashMap>classCache = new ConcurrentHashMap >(); static final URL[] EMPTY_URLS = new URL[]{}; static final ReferenceQueue rq = new ReferenceQueue(); public DynamicClassLoader(){ //pseudo test in lieu of hasContextClassLoader() super(EMPTY_URLS,(Thread.currentThread().getContextClassLoader() == null || Thread.currentThread().getContextClassLoader() == ClassLoader.getSystemClassLoader())? Compiler.class.getClassLoader():Thread.currentThread().getContextClassLoader()); } public DynamicClassLoader(ClassLoader parent){ super(EMPTY_URLS,parent); } public Class defineClass(String name, byte[] bytes, Object srcForm){ Util.clearCache(rq, classCache); Class c = defineClass(name, bytes, 0, bytes.length); classCache.put(name, new SoftReference(c,rq)); return c; } protected Class findClass(String name) throws ClassNotFoundException{ Reference cr = classCache.get(name); if(cr != null) { Class c = cr.get(); if(c != null) return c; else classCache.remove(name, cr); } return super.findClass(name); } public void registerConstants(int id, Object[] val){ constantVals.put(id, val); } public Object[] getConstants(int id){ return constantVals.get(id); } public void addURL(URL url){ super.addURL(url); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/EnumerationSeq.java000066400000000000000000000033661157562347600251400ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; import java.io.IOException; import java.io.NotSerializableException; import java.util.Enumeration; public class EnumerationSeq extends ASeq{ final Enumeration iter; final State state; static class State{ volatile Object val; volatile Object _rest; } public static EnumerationSeq create(Enumeration iter){ if(iter.hasMoreElements()) return new EnumerationSeq(iter); return null; } EnumerationSeq(Enumeration iter){ this.iter = iter; state = new State(); this.state.val = state; this.state._rest = state; } EnumerationSeq(IPersistentMap meta, Enumeration iter, State state){ super(meta); this.iter = iter; this.state = state; } public Object first(){ if(state.val == state) synchronized(state) { if(state.val == state) state.val = iter.nextElement(); } return state.val; } public ISeq next(){ if(state._rest == state) synchronized(state) { if(state._rest == state) { first(); state._rest = create(iter); } } return (ISeq) state._rest; } public EnumerationSeq withMeta(IPersistentMap meta){ return new EnumerationSeq(meta, iter, state); } private void writeObject (java.io.ObjectOutputStream out) throws IOException { throw new NotSerializableException(getClass().getName()); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Fn.java000066400000000000000000000010471157562347600225360ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 25, 2008 */ package clojure.lang; public interface Fn{ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IChunk.java000066400000000000000000000012061157562347600233510ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jun 18, 2009 */ package clojure.lang; public interface IChunk extends Indexed{ IChunk dropFirst(); Object reduce(IFn f, Object start) throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IChunkedSeq.java000066400000000000000000000012631157562347600243360ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich May 24, 2009 */ package clojure.lang; public interface IChunkedSeq extends ISeq{ IChunk chunkedFirst() throws Exception; ISeq chunkedNext() throws Exception; ISeq chunkedMore() throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IDeref.java000066400000000000000000000011131157562347600233230ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Feb 9, 2009 */ package clojure.lang; public interface IDeref{ Object deref() throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IEditableCollection.java000066400000000000000000000011341157562347600260260ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 17, 2009 */ package clojure.lang; public interface IEditableCollection{ ITransientCollection asTransient(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IFn.java000066400000000000000000000117771157562347600226620ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 25, 2006 3:54:03 PM */ package clojure.lang; import java.util.concurrent.Callable; public interface IFn extends Callable, Runnable{ public Object invoke() throws Exception; public Object invoke(Object arg1) throws Exception; public Object invoke(Object arg1, Object arg2) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception; public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception; public Object applyTo(ISeq arglist) throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IKeywordLookup.java000066400000000000000000000011331157562347600251160ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Oct 31, 2009 */ package clojure.lang; public interface IKeywordLookup{ ILookupThunk getLookupThunk(Keyword k); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ILookup.java000066400000000000000000000011611157562347600235520ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Aug 2, 2009 */ package clojure.lang; public interface ILookup{ Object valAt(Object key); Object valAt(Object key, Object notFound); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ILookupHost.java000066400000000000000000000011341157562347600244100ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 2, 2009 */ package clojure.lang; public interface ILookupHost{ void swapThunk(int n, ILookupThunk thunk); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ILookupSite.java000066400000000000000000000011401157562347600243740ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 2, 2009 */ package clojure.lang; public interface ILookupSite{ Object fault(Object target, ILookupHost host); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ILookupThunk.java000066400000000000000000000011151157562347600245630ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 2, 2009 */ package clojure.lang; public interface ILookupThunk{ Object get(Object target); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IMapEntry.java000066400000000000000000000011371157562347600240430ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ package clojure.lang; import java.util.Map; public interface IMapEntry extends Map.Entry{ Object key(); Object val(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IMeta.java000066400000000000000000000011061157562347600231660ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 31, 2008 */ package clojure.lang; public interface IMeta { IPersistentMap meta(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IObj.java000066400000000000000000000011431157562347600230130ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; public interface IObj extends IMeta { public IObj withMeta(IPersistentMap meta); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IPersistentCollection.java000066400000000000000000000012521157562347600264560ustar00rootroot00000000000000package clojure.lang; /** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ public interface IPersistentCollection extends Seqable { int count(); IPersistentCollection cons(Object o); IPersistentCollection empty(); boolean equiv(Object o); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IPersistentList.java000066400000000000000000000011031157562347600252710ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ package clojure.lang; public interface IPersistentList extends Sequential, IPersistentStack{ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IPersistentMap.java000066400000000000000000000013631157562347600251030ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ package clojure.lang; public interface IPersistentMap extends Iterable, Associative, Counted{ IPersistentMap assoc(Object key, Object val); IPersistentMap assocEx(Object key, Object val) throws Exception; IPersistentMap without(Object key) throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IPersistentSet.java000066400000000000000000000013341157562347600251170ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; public interface IPersistentSet extends IPersistentCollection, Counted{ public IPersistentSet disjoin(Object key) throws Exception; public boolean contains(Object key); public Object get(Object key); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IPersistentStack.java000066400000000000000000000011731157562347600254320ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Sep 19, 2007 */ package clojure.lang; public interface IPersistentStack extends IPersistentCollection{ Object peek(); IPersistentStack pop(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IPersistentVector.java000066400000000000000000000013111157562347600256210ustar00rootroot00000000000000package clojure.lang; /** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ public interface IPersistentVector extends Associative, Sequential, IPersistentStack, Reversible, Indexed{ int length(); IPersistentVector assocN(int i, Object val); IPersistentVector cons(Object o); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IProxy.java000066400000000000000000000013311157562347600234210ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Feb 27, 2008 */ package clojure.lang; public interface IProxy{ public void __initClojureFnMappings(IPersistentMap m); public void __updateClojureFnMappings(IPersistentMap m); public IPersistentMap __getClojureFnMappings(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IReduce.java000066400000000000000000000012111157562347600235040ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jun 11, 2008 */ package clojure.lang; public interface IReduce{ Object reduce(IFn f) throws Exception; Object reduce(IFn f, Object start) throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IRef.java000066400000000000000000000013421157562347600230160ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 18, 2007 */ package clojure.lang; public interface IRef extends IDeref{ void setValidator(IFn vf); IFn getValidator(); IPersistentMap getWatches(); IRef addWatch(Object key, IFn callback); IRef removeWatch(Object key); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IReference.java000066400000000000000000000012631157562347600242020ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 31, 2008 */ package clojure.lang; public interface IReference extends IMeta { IPersistentMap alterMeta(IFn alter, ISeq args) throws Exception; IPersistentMap resetMeta(IPersistentMap m); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ISeq.java000066400000000000000000000014571157562347600230410ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ package clojure.lang; /** * A persistent, functional, sequence interface *

* ISeqs are immutable values, i.e. neither first(), nor rest() changes * or invalidates the ISeq */ public interface ISeq extends IPersistentCollection, Sequential{ Object first(); ISeq next(); ISeq more(); ISeq cons(Object o); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ITransientAssociative.java000066400000000000000000000012261157562347600264450ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 17, 2009 */ package clojure.lang; public interface ITransientAssociative extends ITransientCollection, ILookup{ ITransientAssociative assoc(Object key, Object val); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ITransientCollection.java000066400000000000000000000012061157562347600262640ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 17, 2009 */ package clojure.lang; public interface ITransientCollection{ ITransientCollection conj(Object val); IPersistentCollection persistent(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ITransientMap.java000066400000000000000000000013121157562347600247040ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 17, 2009 */ package clojure.lang; public interface ITransientMap extends ITransientAssociative, Counted{ ITransientMap assoc(Object key, Object val); ITransientMap without(Object key); IPersistentMap persistent(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ITransientSet.java000066400000000000000000000013311157562347600247230ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; public interface ITransientSet extends ITransientCollection, Counted{ public ITransientSet disjoin(Object key) throws Exception; public boolean contains(Object key); public Object get(Object key); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ITransientVector.java000066400000000000000000000012421157562347600254330ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 17, 2009 */ package clojure.lang; public interface ITransientVector extends ITransientAssociative, Indexed{ ITransientVector assocN(int i, Object val); ITransientVector pop(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Indexed.java000066400000000000000000000011641157562347600235530ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich May 24, 2009 */ package clojure.lang; public interface Indexed extends Counted{ Object nth(int i); Object nth(int i, Object notFound); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IndexedSeq.java000066400000000000000000000011021157562347600242140ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ package clojure.lang; public interface IndexedSeq extends ISeq, Counted{ public int index(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/IteratorSeq.java000066400000000000000000000033651157562347600244420ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.IOException; import java.io.NotSerializableException; import java.util.Iterator; public class IteratorSeq extends ASeq{ final Iterator iter; final State state; static class State{ volatile Object val; volatile Object _rest; } public static IteratorSeq create(Iterator iter){ if(iter.hasNext()) return new IteratorSeq(iter); return null; } IteratorSeq(Iterator iter){ this.iter = iter; state = new State(); this.state.val = state; this.state._rest = state; } IteratorSeq(IPersistentMap meta, Iterator iter, State state){ super(meta); this.iter = iter; this.state = state; } public Object first(){ if(state.val == state) synchronized(state) { if(state.val == state) state.val = iter.next(); } return state.val; } public ISeq next(){ if(state._rest == state) synchronized(state) { if(state._rest == state) { first(); state._rest = create(iter); } } return (ISeq) state._rest; } public IteratorSeq withMeta(IPersistentMap meta){ return new IteratorSeq(meta, iter, state); } private void writeObject (java.io.ObjectOutputStream out) throws IOException { throw new NotSerializableException(getClass().getName()); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Keyword.java000066400000000000000000000172021157562347600236170ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 29, 2006 10:39:05 AM */ package clojure.lang; import java.io.ObjectStreamException; import java.io.Serializable; import java.lang.ref.Reference; import java.lang.ref.WeakReference; import java.util.concurrent.ConcurrentHashMap; import java.lang.ref.ReferenceQueue; import java.lang.ref.SoftReference; public final class Keyword implements IFn, Comparable, Named, Serializable { private static ConcurrentHashMap> table = new ConcurrentHashMap(); static final ReferenceQueue rq = new ReferenceQueue(); public final Symbol sym; final int hash; public static Keyword intern(Symbol sym){ Util.clearCache(rq, table); Keyword k = new Keyword(sym); Reference existingRef = table.putIfAbsent(sym, new WeakReference(k,rq)); if(existingRef == null) return k; Keyword existingk = existingRef.get(); if(existingk != null) return existingk; //entry died in the interim, do over table.remove(sym, existingRef); return intern(sym); } public static Keyword intern(String ns, String name){ return intern(Symbol.intern(ns, name)); } public static Keyword intern(String nsname){ return intern(Symbol.intern(nsname)); } private Keyword(Symbol sym){ this.sym = sym; hash = sym.hashCode() + 0x9e3779b9; } public final int hashCode(){ return hash; } public String toString(){ return ":" + sym; } public Object throwArity(){ throw new IllegalArgumentException("Wrong number of args passed to keyword: " + toString()); } public Object call() throws Exception{ return throwArity(); } public void run(){ throw new UnsupportedOperationException(); } public Object invoke() throws Exception{ return throwArity(); } public int compareTo(Object o){ return sym.compareTo(((Keyword) o).sym); } public String getNamespace(){ return sym.getNamespace(); } public String getName(){ return sym.getName(); } private Object readResolve() throws ObjectStreamException{ return intern(sym); } /** * Indexer implements IFn for attr access * * @param obj - must be IPersistentMap * @return the value at the key or nil if not found * @throws Exception */ final public Object invoke(Object obj) throws Exception{ if(obj instanceof ILookup) return ((ILookup)obj).valAt(this); return RT.get(obj, this); } final public Object invoke(Object obj, Object notFound) throws Exception{ if(obj instanceof ILookup) return ((ILookup)obj).valAt(this,notFound); return RT.get(obj, this, notFound); } public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception{ return throwArity(); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception{ return throwArity(); } public Object applyTo(ISeq arglist) throws Exception{ return AFn.applyToHelper(this, arglist); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/KeywordLookupSite.java000066400000000000000000000032331157562347600256350ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 2, 2009 */ package clojure.lang; public final class KeywordLookupSite implements ILookupSite, ILookupThunk{ final int n; final Keyword k; public KeywordLookupSite(int n, Keyword k){ this.n = n; this.k = k; } public Object fault(Object target, ILookupHost host){ if(target instanceof IKeywordLookup) { return install(target, host); } else if(target instanceof ILookup) { host.swapThunk(n,ilookupThunk(target.getClass())); return ((ILookup) target).valAt(k); } host.swapThunk(n,this); return RT.get(target, k); } public Object get(Object target){ if(target instanceof IKeywordLookup || target instanceof ILookup) return this; return RT.get(target,k); } private ILookupThunk ilookupThunk(final Class c){ return new ILookupThunk(){ public Object get(Object target){ if(target != null && target.getClass() == c) return ((ILookup) target).valAt(k); return this; } }; } private Object install(Object target, ILookupHost host){ ILookupThunk t = ((IKeywordLookup)target).getLookupThunk(k); if(t != null) { host.swapThunk(n,t); return t.get(target); } host.swapThunk(n,ilookupThunk(target.getClass())); return ((ILookup) target).valAt(k); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/LazilyPersistentVector.java000066400000000000000000000020551157562347600267030ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich May 14, 2008 */ package clojure.lang; import java.util.Collection; public class LazilyPersistentVector{ static public IPersistentVector createOwning(Object... items){ if(items.length == 0) return PersistentVector.EMPTY; else if(items.length <= 32) return new PersistentVector(items.length, 5, PersistentVector.EMPTY_NODE,items); return PersistentVector.create(items); } static public IPersistentVector create(Collection coll){ if(!(coll instanceof ISeq) && coll.size() <= 32) return createOwning(coll.toArray()); return PersistentVector.create(RT.seq(coll)); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/LazySeq.java000066400000000000000000000104771157562347600235720ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jan 31, 2009 */ package clojure.lang; import java.util.*; public final class LazySeq extends Obj implements ISeq, List{ private IFn fn; private Object sv; private ISeq s; public LazySeq(IFn fn){ this.fn = fn; } private LazySeq(IPersistentMap meta, ISeq s){ super(meta); this.fn = null; this.s = s; } public Obj withMeta(IPersistentMap meta){ return new LazySeq(meta, seq()); } final synchronized Object sval(){ if(fn != null) { try { sv = fn.invoke(); fn = null; } catch(Exception e) { throw new RuntimeException(e); } } if(sv != null) return sv; return s; } final synchronized public ISeq seq(){ sval(); if(sv != null) { Object ls = sv; sv = null; while(ls instanceof LazySeq) { ls = ((LazySeq)ls).sval(); } s = RT.seq(ls); } return s; } public int count(){ int c = 0; for(ISeq s = seq(); s != null; s = s.next()) ++c; return c; } public Object first(){ seq(); if(s == null) return null; return s.first(); } public ISeq next(){ seq(); if(s == null) return null; return s.next(); } public ISeq more(){ seq(); if(s == null) return PersistentList.EMPTY; return s.more(); } public ISeq cons(Object o){ return RT.cons(o, seq()); } public IPersistentCollection empty(){ return PersistentList.EMPTY; } public boolean equiv(Object o){ return equals(o); } public int hashCode(){ return Util.hash(seq()); } public boolean equals(Object o){ ISeq s = seq(); if(s != null) return s.equiv(o); else return (o instanceof Sequential || o instanceof List) && RT.seq(o) == null; } // java.util.Collection implementation public Object[] toArray(){ return RT.seqToArray(seq()); } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection c){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection c){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection c){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection c){ for(Object o : c) { if(!contains(o)) return false; } return true; } public Object[] toArray(Object[] a){ if(a.length >= count()) { ISeq s = seq(); for(int i = 0; s != null; ++i, s = s.next()) { a[i] = s.first(); } if(a.length > count()) a[count()] = null; return a; } else return toArray(); } public int size(){ return count(); } public boolean isEmpty(){ return seq() == null; } public boolean contains(Object o){ for(ISeq s = seq(); s != null; s = s.next()) { if(Util.equiv(s.first(), o)) return true; } return false; } public Iterator iterator(){ return new SeqIterator(seq()); } //////////// List stuff ///////////////// private List reify(){ return new ArrayList(this); } public List subList(int fromIndex, int toIndex){ return reify().subList(fromIndex, toIndex); } public Object set(int index, Object element){ throw new UnsupportedOperationException(); } public Object remove(int index){ throw new UnsupportedOperationException(); } public int indexOf(Object o){ ISeq s = seq(); for(int i = 0; s != null; s = s.next(), i++) { if(Util.equiv(s.first(), o)) return i; } return -1; } public int lastIndexOf(Object o){ return reify().lastIndexOf(o); } public ListIterator listIterator(){ return reify().listIterator(); } public ListIterator listIterator(int index){ return reify().listIterator(index); } public Object get(int index){ return RT.nth(this, index); } public void add(int index, Object element){ throw new UnsupportedOperationException(); } public boolean addAll(int index, Collection c){ throw new UnsupportedOperationException(); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/LineNumberingPushbackReader.java000066400000000000000000000037471157562347600275460ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ package clojure.lang; import java.io.PushbackReader; import java.io.Reader; import java.io.LineNumberReader; import java.io.IOException; public class LineNumberingPushbackReader extends PushbackReader{ // This class is a PushbackReader that wraps a LineNumberReader. The code // here to handle line terminators only mentions '\n' because // LineNumberReader collapses all occurrences of CR, LF, and CRLF into a // single '\n'. private static final int newline = (int) '\n'; private boolean _atLineStart = true; private boolean _prev; public LineNumberingPushbackReader(Reader r){ super(new LineNumberReader(r)); } public int getLineNumber(){ return ((LineNumberReader) in).getLineNumber() + 1; } public int read() throws IOException{ int c = super.read(); _prev = _atLineStart; _atLineStart = (c == newline) || (c == -1); return c; } public void unread(int c) throws IOException{ super.unread(c); _atLineStart = _prev; } public String readLine() throws IOException{ int c = read(); String line; switch (c) { case -1: line = null; break; case newline: line = ""; break; default: String first = String.valueOf((char) c); String rest = ((LineNumberReader)in).readLine(); line = (rest == null) ? first : first + rest; _prev = false; _atLineStart = true; break; } return line; } public boolean atLineStart(){ return _atLineStart; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/LispReader.java000066400000000000000000000725721157562347600242400ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.*; import java.util.regex.Pattern; import java.util.regex.Matcher; import java.util.ArrayList; import java.util.List; import java.util.Map; import java.math.BigInteger; import java.math.BigDecimal; import java.lang.*; public class LispReader{ static final Symbol QUOTE = Symbol.create("quote"); static final Symbol THE_VAR = Symbol.create("var"); //static Symbol SYNTAX_QUOTE = Symbol.create(null, "syntax-quote"); static Symbol UNQUOTE = Symbol.create("clojure.core", "unquote"); static Symbol UNQUOTE_SPLICING = Symbol.create("clojure.core", "unquote-splicing"); static Symbol CONCAT = Symbol.create("clojure.core", "concat"); static Symbol SEQ = Symbol.create("clojure.core", "seq"); static Symbol LIST = Symbol.create("clojure.core", "list"); static Symbol APPLY = Symbol.create("clojure.core", "apply"); static Symbol HASHMAP = Symbol.create("clojure.core", "hash-map"); static Symbol HASHSET = Symbol.create("clojure.core", "hash-set"); static Symbol VECTOR = Symbol.create("clojure.core", "vector"); static Symbol WITH_META = Symbol.create("clojure.core", "with-meta"); static Symbol META = Symbol.create("clojure.core", "meta"); static Symbol DEREF = Symbol.create("clojure.core", "deref"); //static Symbol DEREF_BANG = Symbol.create("clojure.core", "deref!"); static IFn[] macros = new IFn[256]; static IFn[] dispatchMacros = new IFn[256]; //static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^:/]][^:/]*/)?[\\D&&[^:/]][^:/]*"); static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^/]].*/)?([\\D&&[^/]][^/]*)"); //static Pattern varPat = Pattern.compile("([\\D&&[^:\\.]][^:\\.]*):([\\D&&[^:\\.]][^:\\.]*)"); //static Pattern intPat = Pattern.compile("[-+]?[0-9]+\\.?"); static Pattern intPat = Pattern.compile( "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)"); static Pattern ratioPat = Pattern.compile("([-+]?[0-9]+)/([0-9]+)"); static Pattern floatPat = Pattern.compile("([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"); static final Symbol SLASH = Symbol.create("/"); static final Symbol CLOJURE_SLASH = Symbol.create("clojure.core","/"); //static Pattern accessorPat = Pattern.compile("\\.[a-zA-Z_]\\w*"); //static Pattern instanceMemberPat = Pattern.compile("\\.([a-zA-Z_][\\w\\.]*)\\.([a-zA-Z_]\\w*)"); //static Pattern staticMemberPat = Pattern.compile("([a-zA-Z_][\\w\\.]*)\\.([a-zA-Z_]\\w*)"); //static Pattern classNamePat = Pattern.compile("([a-zA-Z_][\\w\\.]*)\\."); //symbol->gensymbol static Var GENSYM_ENV = Var.create(null); //sorted-map num->gensymbol static Var ARG_ENV = Var.create(null); static { macros['"'] = new StringReader(); macros[';'] = new CommentReader(); macros['\''] = new WrappingReader(QUOTE); macros['@'] = new WrappingReader(DEREF);//new DerefReader(); macros['^'] = new MetaReader(); macros['`'] = new SyntaxQuoteReader(); macros['~'] = new UnquoteReader(); macros['('] = new ListReader(); macros[')'] = new UnmatchedDelimiterReader(); macros['['] = new VectorReader(); macros[']'] = new UnmatchedDelimiterReader(); macros['{'] = new MapReader(); macros['}'] = new UnmatchedDelimiterReader(); // macros['|'] = new ArgVectorReader(); macros['\\'] = new CharacterReader(); macros['%'] = new ArgReader(); macros['#'] = new DispatchReader(); dispatchMacros['^'] = new MetaReader(); dispatchMacros['\''] = new VarReader(); dispatchMacros['"'] = new RegexReader(); dispatchMacros['('] = new FnReader(); dispatchMacros['{'] = new SetReader(); dispatchMacros['='] = new EvalReader(); dispatchMacros['!'] = new CommentReader(); dispatchMacros['<'] = new UnreadableReader(); dispatchMacros['_'] = new DiscardReader(); } static boolean isWhitespace(int ch){ return Character.isWhitespace(ch) || ch == ','; } static void unread(PushbackReader r, int ch) throws IOException{ if(ch != -1) r.unread(ch); } public static class ReaderException extends Exception{ final int line; public ReaderException(int line, Throwable cause){ super(cause); this.line = line; } } static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive) throws Exception{ try { for(; ;) { int ch = r.read(); while(isWhitespace(ch)) ch = r.read(); if(ch == -1) { if(eofIsError) throw new Exception("EOF while reading"); return eofValue; } if(Character.isDigit(ch)) { Object n = readNumber(r, (char) ch); if(RT.suppressRead()) return null; return n; } IFn macroFn = getMacro(ch); if(macroFn != null) { Object ret = macroFn.invoke(r, (char) ch); if(RT.suppressRead()) return null; //no op macros return the reader if(ret == r) continue; return ret; } if(ch == '+' || ch == '-') { int ch2 = r.read(); if(Character.isDigit(ch2)) { unread(r, ch2); Object n = readNumber(r, (char) ch); if(RT.suppressRead()) return null; return n; } unread(r, ch2); } String token = readToken(r, (char) ch); if(RT.suppressRead()) return null; return interpretToken(token); } } catch(Exception e) { if(isRecursive || !(r instanceof LineNumberingPushbackReader)) throw e; LineNumberingPushbackReader rdr = (LineNumberingPushbackReader) r; //throw new Exception(String.format("ReaderError:(%d,1) %s", rdr.getLineNumber(), e.getMessage()), e); throw new ReaderException(rdr.getLineNumber(), e); } } static private String readToken(PushbackReader r, char initch) throws Exception{ StringBuilder sb = new StringBuilder(); sb.append(initch); for(; ;) { int ch = r.read(); if(ch == -1 || isWhitespace(ch) || isTerminatingMacro(ch)) { unread(r, ch); return sb.toString(); } sb.append((char) ch); } } static private Object readNumber(PushbackReader r, char initch) throws Exception{ StringBuilder sb = new StringBuilder(); sb.append(initch); for(; ;) { int ch = r.read(); if(ch == -1 || isWhitespace(ch) || isMacro(ch)) { unread(r, ch); break; } sb.append((char) ch); } String s = sb.toString(); Object n = matchNumber(s); if(n == null) throw new NumberFormatException("Invalid number: " + s); return n; } static private int readUnicodeChar(String token, int offset, int length, int base) throws Exception{ if(token.length() != offset + length) throw new IllegalArgumentException("Invalid unicode character: \\" + token); int uc = 0; for(int i = offset; i < offset + length; ++i) { int d = Character.digit(token.charAt(i), base); if(d == -1) throw new IllegalArgumentException("Invalid digit: " + (char) d); uc = uc * base + d; } return (char) uc; } static private int readUnicodeChar(PushbackReader r, int initch, int base, int length, boolean exact) throws Exception{ int uc = Character.digit(initch, base); if(uc == -1) throw new IllegalArgumentException("Invalid digit: " + initch); int i = 1; for(; i < length; ++i) { int ch = r.read(); if(ch == -1 || isWhitespace(ch) || isMacro(ch)) { unread(r, ch); break; } int d = Character.digit(ch, base); if(d == -1) throw new IllegalArgumentException("Invalid digit: " + (char) ch); uc = uc * base + d; } if(i != length && exact) throw new IllegalArgumentException("Invalid character length: " + i + ", should be: " + length); return uc; } static private Object interpretToken(String s) throws Exception{ if(s.equals("nil")) { return null; } else if(s.equals("true")) { return RT.T; } else if(s.equals("false")) { return RT.F; } else if(s.equals("/")) { return SLASH; } else if(s.equals("clojure.core//")) { return CLOJURE_SLASH; } Object ret = null; ret = matchSymbol(s); if(ret != null) return ret; throw new Exception("Invalid token: " + s); } private static Object matchSymbol(String s){ Matcher m = symbolPat.matcher(s); if(m.matches()) { int gc = m.groupCount(); String ns = m.group(1); String name = m.group(2); if(ns != null && ns.endsWith(":/") || name.endsWith(":") || s.indexOf("::", 1) != -1) return null; if(s.startsWith("::")) { Symbol ks = Symbol.intern(s.substring(2)); Namespace kns; if(ks.ns != null) kns = Compiler.namespaceFor(ks); else kns = Compiler.currentNS(); //auto-resolving keyword if (kns != null) return Keyword.intern(kns.name.name,ks.name); else return null; } boolean isKeyword = s.charAt(0) == ':'; Symbol sym = Symbol.intern(s.substring(isKeyword ? 1 : 0)); if(isKeyword) return Keyword.intern(sym); return sym; } return null; } private static Object matchNumber(String s){ Matcher m = intPat.matcher(s); if(m.matches()) { if(m.group(2) != null) return 0; boolean negate = (m.group(1).equals("-")); String n; int radix = 10; if((n = m.group(3)) != null) radix = 10; else if((n = m.group(4)) != null) radix = 16; else if((n = m.group(5)) != null) radix = 8; else if((n = m.group(7)) != null) radix = Integer.parseInt(m.group(6)); if(n == null) return null; BigInteger bn = new BigInteger(n, radix); return Numbers.reduce(negate ? bn.negate() : bn); } m = floatPat.matcher(s); if(m.matches()) { if(m.group(4) != null) return new BigDecimal(m.group(1)); return Double.parseDouble(s); } m = ratioPat.matcher(s); if(m.matches()) { return Numbers.divide(new BigInteger(m.group(1)), new BigInteger(m.group(2))); } return null; } static private IFn getMacro(int ch){ if(ch < macros.length) return macros[ch]; return null; } static private boolean isMacro(int ch){ return (ch < macros.length && macros[ch] != null); } static private boolean isTerminatingMacro(int ch){ return (ch != '#' && ch < macros.length && macros[ch] != null); } public static class RegexReader extends AFn{ static StringReader stringrdr = new StringReader(); public Object invoke(Object reader, Object doublequote) throws Exception{ StringBuilder sb = new StringBuilder(); Reader r = (Reader) reader; for(int ch = r.read(); ch != '"'; ch = r.read()) { if(ch == -1) throw new Exception("EOF while reading regex"); sb.append( (char) ch ); if(ch == '\\') //escape { ch = r.read(); if(ch == -1) throw new Exception("EOF while reading regex"); sb.append( (char) ch ) ; } } return Pattern.compile(sb.toString()); } } public static class StringReader extends AFn{ public Object invoke(Object reader, Object doublequote) throws Exception{ StringBuilder sb = new StringBuilder(); Reader r = (Reader) reader; for(int ch = r.read(); ch != '"'; ch = r.read()) { if(ch == -1) throw new Exception("EOF while reading string"); if(ch == '\\') //escape { ch = r.read(); if(ch == -1) throw new Exception("EOF while reading string"); switch(ch) { case 't': ch = '\t'; break; case 'r': ch = '\r'; break; case 'n': ch = '\n'; break; case '\\': break; case '"': break; case 'b': ch = '\b'; break; case 'f': ch = '\f'; break; case 'u': { ch = r.read(); if (Character.digit(ch, 16) == -1) throw new Exception("Invalid unicode escape: \\u" + (char) ch); ch = readUnicodeChar((PushbackReader) r, ch, 16, 4, true); break; } default: { if(Character.isDigit(ch)) { ch = readUnicodeChar((PushbackReader) r, ch, 8, 3, false); if(ch > 0377) throw new Exception("Octal escape sequence must be in range [0, 377]."); } else throw new Exception("Unsupported escape character: \\" + (char) ch); } } } sb.append((char) ch); } return sb.toString(); } } public static class CommentReader extends AFn{ public Object invoke(Object reader, Object semicolon) throws Exception{ Reader r = (Reader) reader; int ch; do { ch = r.read(); } while(ch != -1 && ch != '\n' && ch != '\r'); return r; } } public static class DiscardReader extends AFn{ public Object invoke(Object reader, Object underscore) throws Exception{ PushbackReader r = (PushbackReader) reader; read(r, true, null, true); return r; } } public static class WrappingReader extends AFn{ final Symbol sym; public WrappingReader(Symbol sym){ this.sym = sym; } public Object invoke(Object reader, Object quote) throws Exception{ PushbackReader r = (PushbackReader) reader; Object o = read(r, true, null, true); return RT.list(sym, o); } } public static class DeprecatedWrappingReader extends AFn{ final Symbol sym; final String macro; public DeprecatedWrappingReader(Symbol sym, String macro){ this.sym = sym; this.macro = macro; } public Object invoke(Object reader, Object quote) throws Exception{ System.out.println("WARNING: reader macro " + macro + " is deprecated; use " + sym.getName() + " instead"); PushbackReader r = (PushbackReader) reader; Object o = read(r, true, null, true); return RT.list(sym, o); } } public static class VarReader extends AFn{ public Object invoke(Object reader, Object quote) throws Exception{ PushbackReader r = (PushbackReader) reader; Object o = read(r, true, null, true); // if(o instanceof Symbol) // { // Object v = Compiler.maybeResolveIn(Compiler.currentNS(), (Symbol) o); // if(v instanceof Var) // return v; // } return RT.list(THE_VAR, o); } } /* static class DerefReader extends AFn{ public Object invoke(Object reader, Object quote) throws Exception{ PushbackReader r = (PushbackReader) reader; int ch = r.read(); if(ch == -1) throw new Exception("EOF while reading character"); if(ch == '!') { Object o = read(r, true, null, true); return RT.list(DEREF_BANG, o); } else { r.unread(ch); Object o = read(r, true, null, true); return RT.list(DEREF, o); } } } */ public static class DispatchReader extends AFn{ public Object invoke(Object reader, Object hash) throws Exception{ int ch = ((Reader) reader).read(); if(ch == -1) throw new Exception("EOF while reading character"); IFn fn = dispatchMacros[ch]; if(fn == null) throw new Exception(String.format("No dispatch macro for: %c", (char) ch)); return fn.invoke(reader, ch); } } static Symbol garg(int n){ return Symbol.intern(null, (n == -1 ? "rest" : ("p" + n)) + "__" + RT.nextID() + "#"); } public static class FnReader extends AFn{ public Object invoke(Object reader, Object lparen) throws Exception{ PushbackReader r = (PushbackReader) reader; if(ARG_ENV.deref() != null) throw new IllegalStateException("Nested #()s are not allowed"); try { Var.pushThreadBindings( RT.map(ARG_ENV, PersistentTreeMap.EMPTY)); r.unread('('); Object form = read(r, true, null, true); PersistentVector args = PersistentVector.EMPTY; PersistentTreeMap argsyms = (PersistentTreeMap) ARG_ENV.deref(); ISeq rargs = argsyms.rseq(); if(rargs != null) { int higharg = (Integer) ((Map.Entry) rargs.first()).getKey(); if(higharg > 0) { for(int i = 1; i <= higharg; ++i) { Object sym = argsyms.valAt(i); if(sym == null) sym = garg(i); args = args.cons(sym); } } Object restsym = argsyms.valAt(-1); if(restsym != null) { args = args.cons(Compiler._AMP_); args = args.cons(restsym); } } return RT.list(Compiler.FN, args, form); } finally { Var.popThreadBindings(); } } } static Symbol registerArg(int n){ PersistentTreeMap argsyms = (PersistentTreeMap) ARG_ENV.deref(); if(argsyms == null) { throw new IllegalStateException("arg literal not in #()"); } Symbol ret = (Symbol) argsyms.valAt(n); if(ret == null) { ret = garg(n); ARG_ENV.set(argsyms.assoc(n, ret)); } return ret; } static class ArgReader extends AFn{ public Object invoke(Object reader, Object pct) throws Exception{ PushbackReader r = (PushbackReader) reader; if(ARG_ENV.deref() == null) { return interpretToken(readToken(r, '%')); } int ch = r.read(); unread(r, ch); //% alone is first arg if(ch == -1 || isWhitespace(ch) || isTerminatingMacro(ch)) { return registerArg(1); } Object n = read(r, true, null, true); if(n.equals(Compiler._AMP_)) return registerArg(-1); if(!(n instanceof Number)) throw new IllegalStateException("arg literal must be %, %& or %integer"); return registerArg(((Number) n).intValue()); } } public static class MetaReader extends AFn{ public Object invoke(Object reader, Object caret) throws Exception{ PushbackReader r = (PushbackReader) reader; int line = -1; if(r instanceof LineNumberingPushbackReader) line = ((LineNumberingPushbackReader) r).getLineNumber(); Object meta = read(r, true, null, true); if(meta instanceof Symbol || meta instanceof Keyword || meta instanceof String) meta = RT.map(RT.TAG_KEY, meta); else if(!(meta instanceof IPersistentMap)) throw new IllegalArgumentException("Metadata must be Symbol,Keyword,String or Map"); Object o = read(r, true, null, true); if(o instanceof IMeta) { if(line != -1 && o instanceof ISeq) meta = ((IPersistentMap) meta).assoc(RT.LINE_KEY, line); if(o instanceof IReference) { ((IReference)o).resetMeta((IPersistentMap) meta); return o; } return ((IObj) o).withMeta((IPersistentMap) meta); } else throw new IllegalArgumentException("Metadata can only be applied to IMetas"); } } public static class SyntaxQuoteReader extends AFn{ public Object invoke(Object reader, Object backquote) throws Exception{ PushbackReader r = (PushbackReader) reader; try { Var.pushThreadBindings( RT.map(GENSYM_ENV, PersistentHashMap.EMPTY)); Object form = read(r, true, null, true); return syntaxQuote(form); } finally { Var.popThreadBindings(); } } static Object syntaxQuote(Object form) throws Exception{ Object ret; if(Compiler.isSpecial(form)) ret = RT.list(Compiler.QUOTE, form); else if(form instanceof Symbol) { Symbol sym = (Symbol) form; if(sym.ns == null && sym.name.endsWith("#")) { IPersistentMap gmap = (IPersistentMap) GENSYM_ENV.deref(); if(gmap == null) throw new IllegalStateException("Gensym literal not in syntax-quote"); Symbol gs = (Symbol) gmap.valAt(sym); if(gs == null) GENSYM_ENV.set(gmap.assoc(sym, gs = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1) + "__" + RT.nextID() + "__auto__"))); sym = gs; } else if(sym.ns == null && sym.name.endsWith(".")) { Symbol csym = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1)); csym = Compiler.resolveSymbol(csym); sym = Symbol.intern(null, csym.name.concat(".")); } else if(sym.ns == null && sym.name.startsWith(".")) { // Simply quote method names. } else { Object maybeClass = null; if(sym.ns != null) maybeClass = Compiler.currentNS().getMapping( Symbol.intern(null, sym.ns)); if(maybeClass instanceof Class) { // Classname/foo -> package.qualified.Classname/foo sym = Symbol.intern( ((Class)maybeClass).getName(), sym.name); } else sym = Compiler.resolveSymbol(sym); } ret = RT.list(Compiler.QUOTE, sym); } else if(isUnquote(form)) return RT.second(form); else if(isUnquoteSplicing(form)) throw new IllegalStateException("splice not in list"); else if(form instanceof IPersistentCollection) { if(form instanceof IPersistentMap) { IPersistentVector keyvals = flattenMap(form); ret = RT.list(APPLY, HASHMAP, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(keyvals.seq())))); } else if(form instanceof IPersistentVector) { ret = RT.list(APPLY, VECTOR, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(((IPersistentVector) form).seq())))); } else if(form instanceof IPersistentSet) { ret = RT.list(APPLY, HASHSET, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(((IPersistentSet) form).seq())))); } else if(form instanceof ISeq || form instanceof IPersistentList) { ISeq seq = RT.seq(form); if(seq == null) ret = RT.cons(LIST,null); else ret = RT.list(SEQ, RT.cons(CONCAT, sqExpandList(seq))); } else throw new UnsupportedOperationException("Unknown Collection type"); } else if(form instanceof Keyword || form instanceof Number || form instanceof Character || form instanceof String) ret = form; else ret = RT.list(Compiler.QUOTE, form); if(form instanceof IObj && RT.meta(form) != null) { //filter line numbers IPersistentMap newMeta = ((IObj) form).meta().without(RT.LINE_KEY); if(newMeta.count() > 0) return RT.list(WITH_META, ret, syntaxQuote(((IObj) form).meta())); } return ret; } private static ISeq sqExpandList(ISeq seq) throws Exception{ PersistentVector ret = PersistentVector.EMPTY; for(; seq != null; seq = seq.next()) { Object item = seq.first(); if(isUnquote(item)) ret = ret.cons(RT.list(LIST, RT.second(item))); else if(isUnquoteSplicing(item)) ret = ret.cons(RT.second(item)); else ret = ret.cons(RT.list(LIST, syntaxQuote(item))); } return ret.seq(); } private static IPersistentVector flattenMap(Object form){ IPersistentVector keyvals = PersistentVector.EMPTY; for(ISeq s = RT.seq(form); s != null; s = s.next()) { IMapEntry e = (IMapEntry) s.first(); keyvals = (IPersistentVector) keyvals.cons(e.key()); keyvals = (IPersistentVector) keyvals.cons(e.val()); } return keyvals; } } static boolean isUnquoteSplicing(Object form){ return form instanceof ISeq && Util.equals(RT.first(form),UNQUOTE_SPLICING); } static boolean isUnquote(Object form){ return form instanceof ISeq && Util.equals(RT.first(form),UNQUOTE); } static class UnquoteReader extends AFn{ public Object invoke(Object reader, Object comma) throws Exception{ PushbackReader r = (PushbackReader) reader; int ch = r.read(); if(ch == -1) throw new Exception("EOF while reading character"); if(ch == '@') { Object o = read(r, true, null, true); return RT.list(UNQUOTE_SPLICING, o); } else { unread(r, ch); Object o = read(r, true, null, true); return RT.list(UNQUOTE, o); } } } public static class CharacterReader extends AFn{ public Object invoke(Object reader, Object backslash) throws Exception{ PushbackReader r = (PushbackReader) reader; int ch = r.read(); if(ch == -1) throw new Exception("EOF while reading character"); String token = readToken(r, (char) ch); if(token.length() == 1) return Character.valueOf(token.charAt(0)); else if(token.equals("newline")) return '\n'; else if(token.equals("space")) return ' '; else if(token.equals("tab")) return '\t'; else if(token.equals("backspace")) return '\b'; else if(token.equals("formfeed")) return '\f'; else if(token.equals("return")) return '\r'; else if(token.startsWith("u")) { char c = (char) readUnicodeChar(token, 1, 4, 16); if(c >= '\uD800' && c <= '\uDFFF') // surrogate code unit? throw new Exception("Invalid character constant: \\u" + Integer.toString(c, 16)); return c; } else if(token.startsWith("o")) { int len = token.length() - 1; if(len > 3) throw new Exception("Invalid octal escape sequence length: " + len); int uc = readUnicodeChar(token, 1, len, 8); if(uc > 0377) throw new Exception("Octal escape sequence must be in range [0, 377]."); return (char) uc; } throw new Exception("Unsupported character: \\" + token); } } public static class ListReader extends AFn{ public Object invoke(Object reader, Object leftparen) throws Exception{ PushbackReader r = (PushbackReader) reader; int line = -1; if(r instanceof LineNumberingPushbackReader) line = ((LineNumberingPushbackReader) r).getLineNumber(); List list = readDelimitedList(')', r, true); if(list.isEmpty()) return PersistentList.EMPTY; IObj s = (IObj) PersistentList.create(list); // IObj s = (IObj) RT.seq(list); if(line != -1) return s.withMeta(RT.map(RT.LINE_KEY, line)); else return s; } } static class CtorReader extends AFn{ static final Symbol cls = Symbol.create("class"); public Object invoke(Object reader, Object leftangle) throws Exception{ PushbackReader r = (PushbackReader) reader; // # // # // # List list = readDelimitedList('>', r, true); if(list.isEmpty()) throw new Exception("Must supply 'class', classname or classname/staticMethod"); Symbol s = (Symbol) list.get(0); Object[] args = list.subList(1, list.size()).toArray(); if(s.equals(cls)) { return RT.classForName(args[0].toString()); } else if(s.ns != null) //static method { String classname = s.ns; String method = s.name; return Reflector.invokeStaticMethod(classname, method, args); } else { return Reflector.invokeConstructor(RT.classForName(s.name), args); } } } public static class EvalReader extends AFn{ public Object invoke(Object reader, Object eq) throws Exception{ if (!RT.booleanCast(RT.READEVAL.deref())) { throw new Exception("EvalReader not allowed when *read-eval* is false."); } PushbackReader r = (PushbackReader) reader; Object o = read(r, true, null, true); if(o instanceof Symbol) { return RT.classForName(o.toString()); } else if(o instanceof IPersistentList) { Symbol fs = (Symbol) RT.first(o); if(fs.equals(THE_VAR)) { Symbol vs = (Symbol) RT.second(o); return RT.var(vs.ns, vs.name); //Compiler.resolve((Symbol) RT.second(o),true); } if(fs.name.endsWith(".")) { Object[] args = RT.toArray(RT.next(o)); return Reflector.invokeConstructor(RT.classForName(fs.name.substring(0, fs.name.length() - 1)), args); } if(Compiler.namesStaticMember(fs)) { Object[] args = RT.toArray(RT.next(o)); return Reflector.invokeStaticMethod(fs.ns, fs.name, args); } Object v = Compiler.maybeResolveIn(Compiler.currentNS(), fs); if(v instanceof Var) { return ((IFn) v).applyTo(RT.next(o)); } throw new Exception("Can't resolve " + fs); } else throw new IllegalArgumentException("Unsupported #= form"); } } //static class ArgVectorReader extends AFn{ // public Object invoke(Object reader, Object leftparen) throws Exception{ // PushbackReader r = (PushbackReader) reader; // return ArgVector.create(readDelimitedList('|', r, true)); // } // //} public static class VectorReader extends AFn{ public Object invoke(Object reader, Object leftparen) throws Exception{ PushbackReader r = (PushbackReader) reader; return LazilyPersistentVector.create(readDelimitedList(']', r, true)); } } public static class MapReader extends AFn{ public Object invoke(Object reader, Object leftparen) throws Exception{ PushbackReader r = (PushbackReader) reader; return RT.map(readDelimitedList('}', r, true).toArray()); } } public static class SetReader extends AFn{ public Object invoke(Object reader, Object leftbracket) throws Exception{ PushbackReader r = (PushbackReader) reader; return PersistentHashSet.createWithCheck(readDelimitedList('}', r, true)); } } public static class UnmatchedDelimiterReader extends AFn{ public Object invoke(Object reader, Object rightdelim) throws Exception{ throw new Exception("Unmatched delimiter: " + rightdelim); } } public static class UnreadableReader extends AFn{ public Object invoke(Object reader, Object leftangle) throws Exception{ throw new Exception("Unreadable form"); } } public static List readDelimitedList(char delim, PushbackReader r, boolean isRecursive) throws Exception{ ArrayList a = new ArrayList(); for(; ;) { int ch = r.read(); while(isWhitespace(ch)) ch = r.read(); if(ch == -1) throw new Exception("EOF while reading"); if(ch == delim) break; IFn macroFn = getMacro(ch); if(macroFn != null) { Object mret = macroFn.invoke(r, (char) ch); //no op macros return the reader if(mret != r) a.add(mret); } else { unread(r, ch); Object o = read(r, true, null, isRecursive); if(o != r) a.add(o); } } return a; } /* public static void main(String[] args) throws Exception{ //RT.init(); PushbackReader rdr = new PushbackReader( new java.io.StringReader( "(+ 21 21)" ) ); Object input = LispReader.read(rdr, false, new Object(), false ); System.out.println(Compiler.eval(input)); } public static void main(String[] args){ LineNumberingPushbackReader r = new LineNumberingPushbackReader(new InputStreamReader(System.in)); OutputStreamWriter w = new OutputStreamWriter(System.out); Object ret = null; try { for(; ;) { ret = LispReader.read(r, true, null, false); RT.print(ret, w); w.write('\n'); if(ret != null) w.write(ret.getClass().toString()); w.write('\n'); w.flush(); } } catch(Exception e) { e.printStackTrace(); } } */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/LockingTransaction.java000066400000000000000000000343701157562347600257740ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 26, 2007 */ package clojure.lang; import java.util.*; import java.util.concurrent.atomic.AtomicInteger; import java.util.concurrent.atomic.AtomicLong; import java.util.concurrent.Callable; import java.util.concurrent.TimeUnit; import java.util.concurrent.CountDownLatch; @SuppressWarnings({"SynchronizeOnNonFinalField"}) public class LockingTransaction{ public static final int RETRY_LIMIT = 10000; public static final int LOCK_WAIT_MSECS = 100; public static final long BARGE_WAIT_NANOS = 10 * 1000000; //public static int COMMUTE_RETRY_LIMIT = 10; static final int RUNNING = 0; static final int COMMITTING = 1; static final int RETRY = 2; static final int KILLED = 3; static final int COMMITTED = 4; final static ThreadLocal transaction = new ThreadLocal(); static class RetryEx extends Error{ } static class AbortException extends Exception{ } public static class Info{ final AtomicInteger status; final long startPoint; final CountDownLatch latch; public Info(int status, long startPoint){ this.status = new AtomicInteger(status); this.startPoint = startPoint; this.latch = new CountDownLatch(1); } public boolean running(){ int s = status.get(); return s == RUNNING || s == COMMITTING; } } static class CFn{ final IFn fn; final ISeq args; public CFn(IFn fn, ISeq args){ this.fn = fn; this.args = args; } } //total order on transactions //transactions will consume a point for init, for each retry, and on commit if writing final private static AtomicLong lastPoint = new AtomicLong(); void getReadPoint(){ readPoint = lastPoint.incrementAndGet(); } long getCommitPoint(){ return lastPoint.incrementAndGet(); } void stop(int status){ if(info != null) { synchronized(info) { info.status.set(status); info.latch.countDown(); } info = null; vals.clear(); sets.clear(); commutes.clear(); //actions.clear(); } } Info info; long readPoint; long startPoint; long startTime; final RetryEx retryex = new RetryEx(); final ArrayList actions = new ArrayList(); final HashMap vals = new HashMap(); final HashSet sets = new HashSet(); final TreeMap> commutes = new TreeMap>(); final HashSet ensures = new HashSet(); //all hold readLock void tryWriteLock(Ref ref){ try { if(!ref.lock.writeLock().tryLock(LOCK_WAIT_MSECS, TimeUnit.MILLISECONDS)) throw retryex; } catch(InterruptedException e) { throw retryex; } } //returns the most recent val Object lock(Ref ref){ //can't upgrade readLock, so release it releaseIfEnsured(ref); boolean unlocked = true; try { tryWriteLock(ref); unlocked = false; if(ref.tvals != null && ref.tvals.point > readPoint) throw retryex; Info refinfo = ref.tinfo; //write lock conflict if(refinfo != null && refinfo != info && refinfo.running()) { if(!barge(refinfo)) { ref.lock.writeLock().unlock(); unlocked = true; return blockAndBail(refinfo); } } ref.tinfo = info; return ref.tvals == null ? null : ref.tvals.val; } finally { if(!unlocked) ref.lock.writeLock().unlock(); } } private Object blockAndBail(Info refinfo){ //stop prior to blocking stop(RETRY); try { refinfo.latch.await(LOCK_WAIT_MSECS, TimeUnit.MILLISECONDS); } catch(InterruptedException e) { //ignore } throw retryex; } private void releaseIfEnsured(Ref ref){ if(ensures.contains(ref)) { ensures.remove(ref); ref.lock.readLock().unlock(); } } void abort() throws AbortException{ stop(KILLED); throw new AbortException(); } private boolean bargeTimeElapsed(){ return System.nanoTime() - startTime > BARGE_WAIT_NANOS; } private boolean barge(Info refinfo){ boolean barged = false; //if this transaction is older // try to abort the other if(bargeTimeElapsed() && startPoint < refinfo.startPoint) { barged = refinfo.status.compareAndSet(RUNNING, KILLED); if(barged) refinfo.latch.countDown(); } return barged; } static LockingTransaction getEx(){ LockingTransaction t = transaction.get(); if(t == null || t.info == null) throw new IllegalStateException("No transaction running"); return t; } static public boolean isRunning(){ return getRunning() != null; } static LockingTransaction getRunning(){ LockingTransaction t = transaction.get(); if(t == null || t.info == null) return null; return t; } static public Object runInTransaction(Callable fn) throws Exception{ LockingTransaction t = transaction.get(); if(t == null) transaction.set(t = new LockingTransaction()); if(t.info != null) return fn.call(); return t.run(fn); } static class Notify{ final public Ref ref; final public Object oldval; final public Object newval; Notify(Ref ref, Object oldval, Object newval){ this.ref = ref; this.oldval = oldval; this.newval = newval; } } Object run(Callable fn) throws Exception{ boolean done = false; Object ret = null; ArrayList locked = new ArrayList(); ArrayList notify = new ArrayList(); for(int i = 0; !done && i < RETRY_LIMIT; i++) { try { getReadPoint(); if(i == 0) { startPoint = readPoint; startTime = System.nanoTime(); } info = new Info(RUNNING, startPoint); ret = fn.call(); //make sure no one has killed us before this point, and can't from now on if(info.status.compareAndSet(RUNNING, COMMITTING)) { for(Map.Entry> e : commutes.entrySet()) { Ref ref = e.getKey(); if(sets.contains(ref)) continue; boolean wasEnsured = ensures.contains(ref); //can't upgrade readLock, so release it releaseIfEnsured(ref); tryWriteLock(ref); locked.add(ref); if(wasEnsured && ref.tvals != null && ref.tvals.point > readPoint) throw retryex; Info refinfo = ref.tinfo; if(refinfo != null && refinfo != info && refinfo.running()) { if(!barge(refinfo)) throw retryex; } Object val = ref.tvals == null ? null : ref.tvals.val; vals.put(ref, val); for(CFn f : e.getValue()) { vals.put(ref, f.fn.applyTo(RT.cons(vals.get(ref), f.args))); } } for(Ref ref : sets) { tryWriteLock(ref); locked.add(ref); } //validate and enqueue notifications for(Map.Entry e : vals.entrySet()) { Ref ref = e.getKey(); ref.validate(ref.getValidator(), e.getValue()); } //at this point, all values calced, all refs to be written locked //no more client code to be called long msecs = System.currentTimeMillis(); long commitPoint = getCommitPoint(); for(Map.Entry e : vals.entrySet()) { Ref ref = e.getKey(); Object oldval = ref.tvals == null ? null : ref.tvals.val; Object newval = e.getValue(); int hcount = ref.histCount(); if(ref.tvals == null) { ref.tvals = new Ref.TVal(newval, commitPoint, msecs); } else if((ref.faults.get() > 0 && hcount < ref.maxHistory) || hcount < ref.minHistory) { ref.tvals = new Ref.TVal(newval, commitPoint, msecs, ref.tvals); ref.faults.set(0); } else { ref.tvals = ref.tvals.next; ref.tvals.val = newval; ref.tvals.point = commitPoint; ref.tvals.msecs = msecs; } if(ref.getWatches().count() > 0) notify.add(new Notify(ref, oldval, newval)); } done = true; info.status.set(COMMITTED); } } catch(RetryEx retry) { //eat this so we retry rather than fall out } finally { for(int k = locked.size() - 1; k >= 0; --k) { locked.get(k).lock.writeLock().unlock(); } locked.clear(); for(Ref r : ensures) { r.lock.readLock().unlock(); } ensures.clear(); stop(done ? COMMITTED : RETRY); try { if(done) //re-dispatch out of transaction { for(Notify n : notify) { n.ref.notifyWatches(n.oldval, n.newval); } for(Agent.Action action : actions) { Agent.dispatchAction(action); } } } finally { notify.clear(); actions.clear(); } } } if(!done) throw new Exception("Transaction failed after reaching retry limit"); return ret; } public void enqueue(Agent.Action action){ actions.add(action); } Object doGet(Ref ref){ if(!info.running()) throw retryex; if(vals.containsKey(ref)) return vals.get(ref); try { ref.lock.readLock().lock(); if(ref.tvals == null) throw new IllegalStateException(ref.toString() + " is unbound."); Ref.TVal ver = ref.tvals; do { if(ver.point <= readPoint) return ver.val; } while((ver = ver.prior) != ref.tvals); } finally { ref.lock.readLock().unlock(); } //no version of val precedes the read point ref.faults.incrementAndGet(); throw retryex; } Object doSet(Ref ref, Object val){ if(!info.running()) throw retryex; if(commutes.containsKey(ref)) throw new IllegalStateException("Can't set after commute"); if(!sets.contains(ref)) { sets.add(ref); lock(ref); } vals.put(ref, val); return val; } void doEnsure(Ref ref){ if(!info.running()) throw retryex; if(ensures.contains(ref)) return; ref.lock.readLock().lock(); //someone completed a write after our snapshot if(ref.tvals != null && ref.tvals.point > readPoint) { ref.lock.readLock().unlock(); throw retryex; } Info refinfo = ref.tinfo; //writer exists if(refinfo != null && refinfo.running()) { ref.lock.readLock().unlock(); if(refinfo != info) //not us, ensure is doomed { blockAndBail(refinfo); } } else ensures.add(ref); } Object doCommute(Ref ref, IFn fn, ISeq args) throws Exception{ if(!info.running()) throw retryex; if(!vals.containsKey(ref)) { Object val = null; try { ref.lock.readLock().lock(); val = ref.tvals == null ? null : ref.tvals.val; } finally { ref.lock.readLock().unlock(); } vals.put(ref, val); } ArrayList fns = commutes.get(ref); if(fns == null) commutes.put(ref, fns = new ArrayList()); fns.add(new CFn(fn, args)); Object ret = fn.applyTo(RT.cons(vals.get(ref), args)); vals.put(ref, ret); return ret; } /* //for test static CyclicBarrier barrier; static ArrayList items; public static void main(String[] args){ try { if(args.length != 4) System.err.println("Usage: LockingTransaction nthreads nitems niters ninstances"); int nthreads = Integer.parseInt(args[0]); int nitems = Integer.parseInt(args[1]); int niters = Integer.parseInt(args[2]); int ninstances = Integer.parseInt(args[3]); if(items == null) { ArrayList temp = new ArrayList(nitems); for(int i = 0; i < nitems; i++) temp.add(new Ref(0)); items = temp; } class Incr extends AFn{ public Object invoke(Object arg1) throws Exception{ Integer i = (Integer) arg1; return i + 1; } public Obj withMeta(IPersistentMap meta){ throw new UnsupportedOperationException(); } } class Commuter extends AFn implements Callable{ int niters; List items; Incr incr; public Commuter(int niters, List items){ this.niters = niters; this.items = items; this.incr = new Incr(); } public Object call() throws Exception{ long nanos = 0; for(int i = 0; i < niters; i++) { long start = System.nanoTime(); LockingTransaction.runInTransaction(this); nanos += System.nanoTime() - start; } return nanos; } public Object invoke() throws Exception{ for(Ref tref : items) { LockingTransaction.getEx().doCommute(tref, incr); } return null; } public Obj withMeta(IPersistentMap meta){ throw new UnsupportedOperationException(); } } class Incrementer extends AFn implements Callable{ int niters; List items; public Incrementer(int niters, List items){ this.niters = niters; this.items = items; } public Object call() throws Exception{ long nanos = 0; for(int i = 0; i < niters; i++) { long start = System.nanoTime(); LockingTransaction.runInTransaction(this); nanos += System.nanoTime() - start; } return nanos; } public Object invoke() throws Exception{ for(Ref tref : items) { //Transaction.get().doTouch(tref); // LockingTransaction t = LockingTransaction.getEx(); // int val = (Integer) t.doGet(tref); // t.doSet(tref, val + 1); int val = (Integer) tref.get(); tref.set(val + 1); } return null; } public Obj withMeta(IPersistentMap meta){ throw new UnsupportedOperationException(); } } ArrayList> tasks = new ArrayList(nthreads); for(int i = 0; i < nthreads; i++) { ArrayList si; synchronized(items) { si = (ArrayList) items.clone(); } Collections.shuffle(si); tasks.add(new Incrementer(niters, si)); //tasks.add(new Commuter(niters, si)); } ExecutorService e = Executors.newFixedThreadPool(nthreads); if(barrier == null) barrier = new CyclicBarrier(ninstances); System.out.println("waiting for other instances..."); barrier.await(); System.out.println("starting"); long start = System.nanoTime(); List> results = e.invokeAll(tasks); long estimatedTime = System.nanoTime() - start; System.out.printf("nthreads: %d, nitems: %d, niters: %d, time: %d%n", nthreads, nitems, niters, estimatedTime / 1000000); e.shutdown(); for(Future result : results) { System.out.printf("%d, ", result.get() / 1000000); } System.out.println(); System.out.println("waiting for other instances..."); barrier.await(); synchronized(items) { for(Ref item : items) { System.out.printf("%d, ", (Integer) item.currentVal()); } } System.out.println("\ndone"); System.out.flush(); } catch(Exception ex) { ex.printStackTrace(); } } */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/MapEntry.java000066400000000000000000000015771157562347600237420ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.util.Iterator; public class MapEntry extends AMapEntry{ final Object _key; final Object _val; public MapEntry(Object key, Object val){ this._key = key; this._val = val; } public Object key(){ return _key; } public Object val(){ return _val; } public Object getKey(){ return key(); } public Object getValue(){ return val(); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/MapEquivalence.java000066400000000000000000000011051157562347600250650ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Aug 4, 2010 */ package clojure.lang; //marker interface public interface MapEquivalence{ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/MethodImplCache.java000066400000000000000000000031031157562347600251540ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Nov 8, 2009 */ package clojure.lang; public final class MethodImplCache{ static public class Entry{ final public Class c; final public IFn fn; public Entry(Class c, IFn fn){ this.c = c; this.fn = fn; } } public final IPersistentMap protocol; public final Keyword methodk; public final int shift; public final int mask; public final Object[] table; //[class, entry. class, entry ...] volatile Entry mre = null; public MethodImplCache(IPersistentMap protocol, Keyword methodk){ this(protocol, methodk, 0, 0, RT.EMPTY_ARRAY); } public MethodImplCache(IPersistentMap protocol, Keyword methodk, int shift, int mask, Object[] table){ this.protocol = protocol; this.methodk = methodk; this.shift = shift; this.mask = mask; this.table = table; } public IFn fnFor(Class c){ Entry last = mre; if(last != null && last.c == c) return last.fn; return findFnFor(c); } IFn findFnFor(Class c){ int idx = ((Util.hash(c) >> shift) & mask) << 1; if(idx < table.length && table[idx] == c) { Entry e = ((Entry) table[idx + 1]); mre = e; return e != null ? e.fn : null; } return null; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/MultiFn.java000066400000000000000000000614141157562347600235550ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Sep 13, 2007 */ package clojure.lang; import java.util.Map; public class MultiFn extends AFn{ final public IFn dispatchFn; final public Object defaultDispatchVal; final public IRef hierarchy; final String name; IPersistentMap methodTable; IPersistentMap preferTable; IPersistentMap methodCache; Object cachedHierarchy; static final Var assoc = RT.var("clojure.core", "assoc"); static final Var dissoc = RT.var("clojure.core", "dissoc"); static final Var isa = RT.var("clojure.core", "isa?"); static final Var parents = RT.var("clojure.core", "parents"); public MultiFn(String name, IFn dispatchFn, Object defaultDispatchVal, IRef hierarchy) throws Exception{ this.name = name; this.dispatchFn = dispatchFn; this.defaultDispatchVal = defaultDispatchVal; this.methodTable = PersistentHashMap.EMPTY; this.methodCache = getMethodTable(); this.preferTable = PersistentHashMap.EMPTY; this.hierarchy = hierarchy; cachedHierarchy = null; } synchronized public MultiFn reset(){ methodTable = methodCache = preferTable = PersistentHashMap.EMPTY; cachedHierarchy = null; return this; } synchronized public MultiFn addMethod(Object dispatchVal, IFn method) throws Exception{ methodTable = getMethodTable().assoc(dispatchVal, method); resetCache(); return this; } synchronized public MultiFn removeMethod(Object dispatchVal) throws Exception{ methodTable = getMethodTable().without(dispatchVal); resetCache(); return this; } synchronized public MultiFn preferMethod(Object dispatchValX, Object dispatchValY) throws Exception{ if(prefers(dispatchValY, dispatchValX)) throw new IllegalStateException( String.format("Preference conflict in multimethod '%s': %s is already preferred to %s", name, dispatchValY, dispatchValX)); preferTable = getPreferTable().assoc(dispatchValX, RT.conj((IPersistentCollection) RT.get(getPreferTable(), dispatchValX, PersistentHashSet.EMPTY), dispatchValY)); resetCache(); return this; } private boolean prefers(Object x, Object y) throws Exception{ IPersistentSet xprefs = (IPersistentSet) getPreferTable().valAt(x); if(xprefs != null && xprefs.contains(y)) return true; for(ISeq ps = RT.seq(parents.invoke(y)); ps != null; ps = ps.next()) { if(prefers(x, ps.first())) return true; } for(ISeq ps = RT.seq(parents.invoke(x)); ps != null; ps = ps.next()) { if(prefers(ps.first(), y)) return true; } return false; } private boolean isA(Object x, Object y) throws Exception{ return RT.booleanCast(isa.invoke(hierarchy.deref(), x, y)); } private boolean dominates(Object x, Object y) throws Exception{ return prefers(x, y) || isA(x, y); } private IPersistentMap resetCache() throws Exception{ methodCache = getMethodTable(); cachedHierarchy = hierarchy.deref(); return methodCache; } synchronized public IFn getMethod(Object dispatchVal) throws Exception{ if(cachedHierarchy != hierarchy.deref()) resetCache(); IFn targetFn = (IFn) methodCache.valAt(dispatchVal); if(targetFn != null) return targetFn; targetFn = findAndCacheBestMethod(dispatchVal); if(targetFn != null) return targetFn; targetFn = (IFn) getMethodTable().valAt(defaultDispatchVal); return targetFn; } private IFn getFn(Object dispatchVal) throws Exception{ IFn targetFn = getMethod(dispatchVal); if(targetFn == null) throw new IllegalArgumentException(String.format("No method in multimethod '%s' for dispatch value: %s", name, dispatchVal)); return targetFn; } private IFn findAndCacheBestMethod(Object dispatchVal) throws Exception{ Map.Entry bestEntry = null; for(Object o : getMethodTable()) { Map.Entry e = (Map.Entry) o; if(isA(dispatchVal, e.getKey())) { if(bestEntry == null || dominates(e.getKey(), bestEntry.getKey())) bestEntry = e; if(!dominates(bestEntry.getKey(), e.getKey())) throw new IllegalArgumentException( String.format( "Multiple methods in multimethod '%s' match dispatch value: %s -> %s and %s, and neither is preferred", name, dispatchVal, e.getKey(), bestEntry.getKey())); } } if(bestEntry == null) return null; //ensure basis has stayed stable throughout, else redo if(cachedHierarchy == hierarchy.deref()) { //place in cache methodCache = methodCache.assoc(dispatchVal, bestEntry.getValue()); return (IFn) bestEntry.getValue(); } else { resetCache(); return findAndCacheBestMethod(dispatchVal); } } public Object invoke() throws Exception{ return getFn(dispatchFn.invoke()).invoke(); } public Object invoke(Object arg1) throws Exception{ return getFn(dispatchFn.invoke(arg1)).invoke(Util.ret1(arg1,arg1=null)); } public Object invoke(Object arg1, Object arg2) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null)); } public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null)); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception{ return getFn( dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20, args)). invoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null), args); } public IPersistentMap getMethodTable() { return methodTable; } public IPersistentMap getPreferTable() { return preferTable; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Named.java000066400000000000000000000011241157562347600232130ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Sep 20, 2007 */ package clojure.lang; public interface Named{ String getNamespace(); String getName(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Namespace.java000066400000000000000000000145561157562347600241000ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jan 23, 2008 */ package clojure.lang; import java.io.ObjectStreamException; import java.io.Serializable; import java.util.concurrent.ConcurrentHashMap; import java.util.concurrent.atomic.AtomicReference; public class Namespace extends AReference implements Serializable { final public Symbol name; transient final AtomicReference mappings = new AtomicReference(); transient final AtomicReference aliases = new AtomicReference(); final static ConcurrentHashMap namespaces = new ConcurrentHashMap(); public String toString(){ return name.toString(); } Namespace(Symbol name){ super(name.meta()); this.name = name; mappings.set(RT.DEFAULT_IMPORTS); aliases.set(RT.map()); } public static ISeq all(){ return RT.seq(namespaces.values()); } public Symbol getName(){ return name; } public IPersistentMap getMappings(){ return mappings.get(); } public Var intern(Symbol sym){ if(sym.ns != null) { throw new IllegalArgumentException("Can't intern namespace-qualified symbol"); } IPersistentMap map = getMappings(); Object o; Var v = null; while((o = map.valAt(sym)) == null) { if(v == null) v = new Var(this, sym); IPersistentMap newMap = map.assoc(sym, v); mappings.compareAndSet(map, newMap); map = getMappings(); } if(o instanceof Var && ((Var) o).ns == this) return (Var) o; if(v == null) v = new Var(this, sym); warnOrFailOnReplace(sym, o, v); while(!mappings.compareAndSet(map, map.assoc(sym, v))) map = getMappings(); return v; } private void warnOrFailOnReplace(Symbol sym, Object o, Object v){ if (o instanceof Var) { Namespace ns = ((Var)o).ns; if (ns == this) return; if (ns != RT.CLOJURE_NS) throw new IllegalStateException(sym + " already refers to: " + o + " in namespace: " + name); } RT.errPrintWriter().println("WARNING: " + sym + " already refers to: " + o + " in namespace: " + name + ", being replaced by: " + v); } Object reference(Symbol sym, Object val){ if(sym.ns != null) { throw new IllegalArgumentException("Can't intern namespace-qualified symbol"); } IPersistentMap map = getMappings(); Object o; while((o = map.valAt(sym)) == null) { IPersistentMap newMap = map.assoc(sym, val); mappings.compareAndSet(map, newMap); map = getMappings(); } if(o == val) return o; warnOrFailOnReplace(sym, o, val); while(!mappings.compareAndSet(map, map.assoc(sym, val))) map = getMappings(); return val; } public static boolean areDifferentInstancesOfSameClassName(Class cls1, Class cls2) { return (cls1 != cls2) && (cls1.getName().equals(cls2.getName())); } Class referenceClass(Symbol sym, Class val){ if(sym.ns != null) { throw new IllegalArgumentException("Can't intern namespace-qualified symbol"); } IPersistentMap map = getMappings(); Class c = (Class) map.valAt(sym); while((c == null) || (areDifferentInstancesOfSameClassName(c, val))) { IPersistentMap newMap = map.assoc(sym, val); mappings.compareAndSet(map, newMap); map = getMappings(); c = (Class) map.valAt(sym); } if(c == val) return c; throw new IllegalStateException(sym + " already refers to: " + c + " in namespace: " + name); } public void unmap(Symbol sym) throws Exception{ if(sym.ns != null) { throw new IllegalArgumentException("Can't unintern namespace-qualified symbol"); } IPersistentMap map = getMappings(); while(map.containsKey(sym)) { IPersistentMap newMap = map.without(sym); mappings.compareAndSet(map, newMap); map = getMappings(); } } public Class importClass(Symbol sym, Class c){ return referenceClass(sym, c); } public Class importClass(Class c){ String n = c.getName(); return importClass(Symbol.intern(n.substring(n.lastIndexOf('.') + 1)), c); } public Var refer(Symbol sym, Var var){ return (Var) reference(sym, var); } public static Namespace findOrCreate(Symbol name){ Namespace ns = namespaces.get(name); if(ns != null) return ns; Namespace newns = new Namespace(name); ns = namespaces.putIfAbsent(name, newns); return ns == null ? newns : ns; } public static Namespace remove(Symbol name){ if(name.equals(RT.CLOJURE_NS.name)) throw new IllegalArgumentException("Cannot remove clojure namespace"); return namespaces.remove(name); } public static Namespace find(Symbol name){ return namespaces.get(name); } public Object getMapping(Symbol name){ return mappings.get().valAt(name); } public Var findInternedVar(Symbol symbol){ Object o = mappings.get().valAt(symbol); if(o != null && o instanceof Var && ((Var) o).ns == this) return (Var) o; return null; } public IPersistentMap getAliases(){ return aliases.get(); } public Namespace lookupAlias(Symbol alias){ IPersistentMap map = getAliases(); return (Namespace) map.valAt(alias); } public void addAlias(Symbol alias, Namespace ns){ if (alias == null || ns == null) throw new NullPointerException("Expecting Symbol + Namespace"); IPersistentMap map = getAliases(); while(!map.containsKey(alias)) { IPersistentMap newMap = map.assoc(alias, ns); aliases.compareAndSet(map, newMap); map = getAliases(); } // you can rebind an alias, but only to the initially-aliased namespace. if(!map.valAt(alias).equals(ns)) throw new IllegalStateException("Alias " + alias + " already exists in namespace " + name + ", aliasing " + map.valAt(alias)); } public void removeAlias(Symbol alias) throws Exception{ IPersistentMap map = getAliases(); while(map.containsKey(alias)) { IPersistentMap newMap = map.without(alias); aliases.compareAndSet(map, newMap); map = getAliases(); } } private Object readResolve() throws ObjectStreamException { // ensures that serialized namespaces are "deserialized" to the // namespace in the present runtime return findOrCreate(name); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Numbers.java000066400000000000000000002663351157562347600236230ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 31, 2008 */ package clojure.lang; import java.math.BigInteger; import java.math.BigDecimal; import java.math.MathContext; public class Numbers{ static interface Ops{ Ops combine(Ops y); Ops opsWith(IntegerOps x); Ops opsWith(LongOps x); Ops opsWith(FloatOps x); Ops opsWith(DoubleOps x); Ops opsWith(RatioOps x); Ops opsWith(BigIntegerOps x); Ops opsWith(BigDecimalOps x); public boolean isZero(Number x); public boolean isPos(Number x); public boolean isNeg(Number x); public Number add(Number x, Number y); public Number multiply(Number x, Number y); public Number divide(Number x, Number y); public Number quotient(Number x, Number y); public Number remainder(Number x, Number y); public boolean equiv(Number x, Number y); public boolean lt(Number x, Number y); public Number negate(Number x); public Number inc(Number x); public Number dec(Number x); } static interface BitOps{ BitOps combine(BitOps y); BitOps bitOpsWith(IntegerBitOps x); BitOps bitOpsWith(LongBitOps x); BitOps bitOpsWith(BigIntegerBitOps x); public Number not(Number x); public Number and(Number x, Number y); public Number or(Number x, Number y); public Number xor(Number x, Number y); public Number andNot(Number x, Number y); public Number clearBit(Number x, int n); public Number setBit(Number x, int n); public Number flipBit(Number x, int n); public boolean testBit(Number x, int n); public Number shiftLeft(Number x, int n); public Number shiftRight(Number x, int n); } static public boolean isZero(Object x){ return ops(x).isZero((Number)x); } static public boolean isPos(Object x){ return ops(x).isPos((Number)x); } static public boolean isNeg(Object x){ return ops(x).isNeg((Number)x); } static public Number minus(Object x){ return ops(x).negate((Number)x); } static public Number inc(Object x){ return ops(x).inc((Number)x); } static public Number dec(Object x){ return ops(x).dec((Number)x); } static public Number add(Object x, Object y){ return ops(x).combine(ops(y)).add((Number)x, (Number)y); } static public Number minus(Object x, Object y){ Ops yops = ops(y); return ops(x).combine(yops).add((Number)x, yops.negate((Number)y)); } static public Number multiply(Object x, Object y){ return ops(x).combine(ops(y)).multiply((Number)x, (Number)y); } static public Number divide(Object x, Object y){ Ops yops = ops(y); if(yops.isZero((Number)y)) throw new ArithmeticException("Divide by zero"); return ops(x).combine(yops).divide((Number)x, (Number)y); } static public Number quotient(Number x, Number y){ Ops yops = ops(y); if(yops.isZero(y)) throw new ArithmeticException("Divide by zero"); return reduce(ops(x).combine(yops).quotient(x, y)); } static public Number remainder(Number x, Number y){ Ops yops = ops(y); if(yops.isZero(y)) throw new ArithmeticException("Divide by zero"); return reduce(ops(x).combine(yops).remainder(x, y)); } static Number quotient(double n, double d){ double q = n / d; if(q <= Integer.MAX_VALUE && q >= Integer.MIN_VALUE) { return (int) q; } else { //bigint quotient return reduce(new BigDecimal(q).toBigInteger()); } } static Number remainder(double n, double d){ double q = n / d; if(q <= Integer.MAX_VALUE && q >= Integer.MIN_VALUE) { return (n - ((int) q) * d); } else { //bigint quotient Number bq = reduce(new BigDecimal(q).toBigInteger()); return (n - bq.doubleValue() * d); } } static public boolean equiv(Object x, Object y){ return equiv((Number) x, (Number) y); } static public boolean equiv(Number x, Number y){ return ops(x).combine(ops(y)).equiv(x, y); } static public boolean lt(Object x, Object y){ return ops(x).combine(ops(y)).lt((Number)x, (Number)y); } static public boolean lte(Object x, Object y){ return !ops(x).combine(ops(y)).lt((Number)y, (Number)x); } static public boolean gt(Object x, Object y){ return ops(x).combine(ops(y)).lt((Number)y, (Number)x); } static public boolean gte(Object x, Object y){ return !ops(x).combine(ops(y)).lt((Number)x, (Number)y); } static public int compare(Number x, Number y){ Ops ops = ops(x).combine(ops(y)); if(ops.lt(x, y)) return -1; else if(ops.lt(y, x)) return 1; return 0; } static BigInteger toBigInteger(Object x){ if(x instanceof BigInteger) return (BigInteger) x; else return BigInteger.valueOf(((Number) x).longValue()); } static BigDecimal toBigDecimal(Object x){ if(x instanceof BigDecimal) return (BigDecimal) x; else if(x instanceof BigInteger) return new BigDecimal((BigInteger) x); else return BigDecimal.valueOf(((Number) x).longValue()); } static Ratio toRatio(Object x){ if(x instanceof Ratio) return (Ratio) x; else if(x instanceof BigDecimal) { BigDecimal bx = (BigDecimal) x; BigInteger bv = bx.unscaledValue(); int scale = bx.scale(); if(scale < 0) return new Ratio(bv.multiply(BigInteger.TEN.pow(-scale)), BigInteger.ONE); else return new Ratio(bv, BigInteger.TEN.pow(scale)); } return new Ratio(toBigInteger(x), BigInteger.ONE); } static public Number rationalize(Number x){ if(x instanceof Float || x instanceof Double) return rationalize(BigDecimal.valueOf(x.doubleValue())); else if(x instanceof BigDecimal) { BigDecimal bx = (BigDecimal) x; BigInteger bv = bx.unscaledValue(); int scale = bx.scale(); if(scale < 0) return bv.multiply(BigInteger.TEN.pow(-scale)); else return divide(bv, BigInteger.TEN.pow(scale)); } return x; } static public Number reduce(Number val){ if(val instanceof Long) return reduce(val.longValue()); else if (val instanceof BigInteger) return reduce((BigInteger) val); return val; } static public Number reduce(BigInteger val){ int bitLength = val.bitLength(); if(bitLength < 32) return val.intValue(); else if(bitLength < 64) return val.longValue(); else return val; } static public Number reduce(long val){ if(val >= Integer.MIN_VALUE && val <= Integer.MAX_VALUE) return (int) val; else return val; } static public Number divide(BigInteger n, BigInteger d){ if(d.equals(BigInteger.ZERO)) throw new ArithmeticException("Divide by zero"); BigInteger gcd = n.gcd(d); if(gcd.equals(BigInteger.ZERO)) return 0; n = n.divide(gcd); d = d.divide(gcd); if(d.equals(BigInteger.ONE)) return reduce(n); else if(d.equals(BigInteger.ONE.negate())) return reduce(n.negate()); return new Ratio((d.signum() < 0 ? n.negate() : n), (d.signum() < 0 ? d.negate() : d)); } static public Number not(Object x){ return bitOps(x).not((Number)x); } static public Number and(Object x, Object y){ return bitOps(x).combine(bitOps(y)).and((Number)x, (Number)y); } static public Number or(Object x, Object y){ return bitOps(x).combine(bitOps(y)).or((Number)x, (Number)y); } static public Number xor(Object x, Object y){ return bitOps(x).combine(bitOps(y)).xor((Number)x, (Number)y); } static public Number andNot(Number x, Number y){ return bitOps(x).combine(bitOps(y)).andNot(x, y); } static public Number clearBit(Number x, int n){ if(n < 0) throw new ArithmeticException("Negative bit index"); return bitOps(x).clearBit(x, n); } static public Number setBit(Number x, int n){ if(n < 0) throw new ArithmeticException("Negative bit index"); return bitOps(x).setBit(x, n); } static public Number flipBit(Number x, int n){ if(n < 0) throw new ArithmeticException("Negative bit index"); return bitOps(x).flipBit(x, n); } static public boolean testBit(Number x, int n){ if(n < 0) throw new ArithmeticException("Negative bit index"); return bitOps(x).testBit(x, n); } static public Number shiftLeft(Object x, Object n){ return bitOps(x).shiftLeft((Number)x, ((Number)n).intValue()); } static public int shiftLeft(int x, int n){ return x << n; } static public Number shiftRight(Object x, Object n){ return bitOps(x).shiftRight((Number)x, ((Number)n).intValue()); } static public int shiftRight(int x, int n){ return x >> n; } final static class IntegerOps implements Ops{ public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return LONG_OPS; } final public Ops opsWith(FloatOps x){ return FLOAT_OPS; } final public Ops opsWith(DoubleOps x){ return DOUBLE_OPS; } final public Ops opsWith(RatioOps x){ return RATIO_OPS; } final public Ops opsWith(BigIntegerOps x){ return BIGINTEGER_OPS; } final public Ops opsWith(BigDecimalOps x){ return BIGDECIMAL_OPS; } public boolean isZero(Number x){ return x.intValue() == 0; } public boolean isPos(Number x){ return x.intValue() > 0; } public boolean isNeg(Number x){ return x.intValue() < 0; } final public Number add(Number x, Number y){ long ret = x.longValue() + y.longValue(); if(ret <= Integer.MAX_VALUE && ret >= Integer.MIN_VALUE) return (int) ret; return ret; } final public Number multiply(Number x, Number y){ long ret = x.longValue() * y.longValue(); if(ret <= Integer.MAX_VALUE && ret >= Integer.MIN_VALUE) return (int) ret; return ret; } static int gcd(int u, int v){ while(v != 0) { int r = u % v; u = v; v = r; } return u; } public Number divide(Number x, Number y){ int n = x.intValue(); int val = y.intValue(); int gcd = gcd(n, val); if(gcd == 0) return 0; n = n / gcd; int d = val / gcd; if(d == 1) return n; if(d < 0) { n = -n; d = -d; } return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d)); } public Number quotient(Number x, Number y){ return x.intValue() / y.intValue(); } public Number remainder(Number x, Number y){ return x.intValue() % y.intValue(); } public boolean equiv(Number x, Number y){ return x.intValue() == y.intValue(); } public boolean lt(Number x, Number y){ return x.intValue() < y.intValue(); } //public Number subtract(Number x, Number y); final public Number negate(Number x){ int val = x.intValue(); if(val > Integer.MIN_VALUE) return -val; return -((long) val); } public Number inc(Number x){ int val = x.intValue(); if(val < Integer.MAX_VALUE) return val + 1; return (long) val + 1; } public Number dec(Number x){ int val = x.intValue(); if(val > Integer.MIN_VALUE) return val - 1; return (long) val - 1; } } final static class LongOps implements Ops{ public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return this; } final public Ops opsWith(FloatOps x){ return FLOAT_OPS; } final public Ops opsWith(DoubleOps x){ return DOUBLE_OPS; } final public Ops opsWith(RatioOps x){ return RATIO_OPS; } final public Ops opsWith(BigIntegerOps x){ return BIGINTEGER_OPS; } final public Ops opsWith(BigDecimalOps x){ return BIGDECIMAL_OPS; } public boolean isZero(Number x){ return x.longValue() == 0; } public boolean isPos(Number x){ return x.longValue() > 0; } public boolean isNeg(Number x){ return x.longValue() < 0; } final public Number add(Number x, Number y){ long lx = x.longValue(), ly = y.longValue(); long ret = lx + ly; if ((ret ^ lx) < 0 && (ret ^ ly) < 0) return BIGINTEGER_OPS.add(x, y); return ret; } final public Number multiply(Number x, Number y){ long lx = x.longValue(), ly = y.longValue(); long ret = lx * ly; if (ly != 0 && ret/ly != lx) return BIGINTEGER_OPS.multiply(x, y); return ret; } static long gcd(long u, long v){ while(v != 0) { long r = u % v; u = v; v = r; } return u; } public Number divide(Number x, Number y){ long n = x.longValue(); long val = y.longValue(); long gcd = gcd(n, val); if(gcd == 0) return 0; n = n / gcd; long d = val / gcd; if(d == 1) return n; if(d < 0) { n = -n; d = -d; } return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d)); } public Number quotient(Number x, Number y){ return x.longValue() / y.longValue(); } public Number remainder(Number x, Number y){ return x.longValue() % y.longValue(); } public boolean equiv(Number x, Number y){ return x.longValue() == y.longValue(); } public boolean lt(Number x, Number y){ return x.longValue() < y.longValue(); } //public Number subtract(Number x, Number y); final public Number negate(Number x){ long val = x.longValue(); if(val > Long.MIN_VALUE) return -val; return BigInteger.valueOf(val).negate(); } public Number inc(Number x){ long val = x.longValue(); if(val < Long.MAX_VALUE) return val + 1; return BIGINTEGER_OPS.inc(x); } public Number dec(Number x){ long val = x.longValue(); if(val > Long.MIN_VALUE) return val - 1; return BIGINTEGER_OPS.dec(x); } } final static class FloatOps implements Ops{ public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return this; } final public Ops opsWith(FloatOps x){ return this; } final public Ops opsWith(DoubleOps x){ return DOUBLE_OPS; } final public Ops opsWith(RatioOps x){ return this; } final public Ops opsWith(BigIntegerOps x){ return this; } final public Ops opsWith(BigDecimalOps x){ return this; } public boolean isZero(Number x){ return x.floatValue() == 0; } public boolean isPos(Number x){ return x.floatValue() > 0; } public boolean isNeg(Number x){ return x.floatValue() < 0; } final public Number add(Number x, Number y){ return x.floatValue() + y.floatValue(); } final public Number multiply(Number x, Number y){ return x.floatValue() * y.floatValue(); } public Number divide(Number x, Number y){ return x.floatValue() / y.floatValue(); } public Number quotient(Number x, Number y){ return Numbers.quotient(x.doubleValue(), y.doubleValue()); } public Number remainder(Number x, Number y){ return Numbers.remainder(x.doubleValue(), y.doubleValue()); } public boolean equiv(Number x, Number y){ return x.floatValue() == y.floatValue(); } public boolean lt(Number x, Number y){ return x.floatValue() < y.floatValue(); } //public Number subtract(Number x, Number y); final public Number negate(Number x){ return -x.floatValue(); } public Number inc(Number x){ return x.floatValue() + 1; } public Number dec(Number x){ return x.floatValue() - 1; } } final static class DoubleOps implements Ops{ public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return this; } final public Ops opsWith(FloatOps x){ return this; } final public Ops opsWith(DoubleOps x){ return this; } final public Ops opsWith(RatioOps x){ return this; } final public Ops opsWith(BigIntegerOps x){ return this; } final public Ops opsWith(BigDecimalOps x){ return this; } public boolean isZero(Number x){ return x.doubleValue() == 0; } public boolean isPos(Number x){ return x.doubleValue() > 0; } public boolean isNeg(Number x){ return x.doubleValue() < 0; } final public Number add(Number x, Number y){ return x.doubleValue() + y.doubleValue(); } final public Number multiply(Number x, Number y){ return x.doubleValue() * y.doubleValue(); } public Number divide(Number x, Number y){ return x.doubleValue() / y.doubleValue(); } public Number quotient(Number x, Number y){ return Numbers.quotient(x.doubleValue(), y.doubleValue()); } public Number remainder(Number x, Number y){ return Numbers.remainder(x.doubleValue(), y.doubleValue()); } public boolean equiv(Number x, Number y){ return x.doubleValue() == y.doubleValue(); } public boolean lt(Number x, Number y){ return x.doubleValue() < y.doubleValue(); } //public Number subtract(Number x, Number y); final public Number negate(Number x){ return -x.doubleValue(); } public Number inc(Number x){ return x.doubleValue() + 1; } public Number dec(Number x){ return x.doubleValue() - 1; } } final static class RatioOps implements Ops{ public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return this; } final public Ops opsWith(FloatOps x){ return FLOAT_OPS; } final public Ops opsWith(DoubleOps x){ return DOUBLE_OPS; } final public Ops opsWith(RatioOps x){ return this; } final public Ops opsWith(BigIntegerOps x){ return this; } final public Ops opsWith(BigDecimalOps x){ return this; } public boolean isZero(Number x){ Ratio r = (Ratio) x; return r.numerator.signum() == 0; } public boolean isPos(Number x){ Ratio r = (Ratio) x; return r.numerator.signum() > 0; } public boolean isNeg(Number x){ Ratio r = (Ratio) x; return r.numerator.signum() < 0; } final public Number add(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); return divide(ry.numerator.multiply(rx.denominator) .add(rx.numerator.multiply(ry.denominator)) , ry.denominator.multiply(rx.denominator)); } final public Number multiply(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); return Numbers.divide(ry.numerator.multiply(rx.numerator) , ry.denominator.multiply(rx.denominator)); } public Number divide(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); return Numbers.divide(ry.denominator.multiply(rx.numerator) , ry.numerator.multiply(rx.denominator)); } public Number quotient(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); BigInteger q = rx.numerator.multiply(ry.denominator).divide( rx.denominator.multiply(ry.numerator)); return reduce(q); } public Number remainder(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); BigInteger q = rx.numerator.multiply(ry.denominator).divide( rx.denominator.multiply(ry.numerator)); return Numbers.minus(x, Numbers.multiply(q, y)); } public boolean equiv(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); return rx.numerator.equals(ry.numerator) && rx.denominator.equals(ry.denominator); } public boolean lt(Number x, Number y){ Ratio rx = toRatio(x); Ratio ry = toRatio(y); return Numbers.lt(rx.numerator.multiply(ry.denominator), ry.numerator.multiply(rx.denominator)); } //public Number subtract(Number x, Number y); final public Number negate(Number x){ Ratio r = (Ratio) x; return new Ratio(r.numerator.negate(), r.denominator); } public Number inc(Number x){ return Numbers.add(x, 1); } public Number dec(Number x){ return Numbers.add(x, -1); } } final static class BigIntegerOps implements Ops{ public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return this; } final public Ops opsWith(FloatOps x){ return FLOAT_OPS; } final public Ops opsWith(DoubleOps x){ return DOUBLE_OPS; } final public Ops opsWith(RatioOps x){ return RATIO_OPS; } final public Ops opsWith(BigIntegerOps x){ return this; } final public Ops opsWith(BigDecimalOps x){ return BIGDECIMAL_OPS; } public boolean isZero(Number x){ BigInteger bx = toBigInteger(x); return bx.signum() == 0; } public boolean isPos(Number x){ BigInteger bx = toBigInteger(x); return bx.signum() > 0; } public boolean isNeg(Number x){ BigInteger bx = toBigInteger(x); return bx.signum() < 0; } final public Number add(Number x, Number y){ return reduce(toBigInteger(x).add(toBigInteger(y))); } final public Number multiply(Number x, Number y){ return reduce(toBigInteger(x).multiply(toBigInteger(y))); } public Number divide(Number x, Number y){ return Numbers.divide(toBigInteger(x), toBigInteger(y)); } public Number quotient(Number x, Number y){ return toBigInteger(x).divide(toBigInteger(y)); } public Number remainder(Number x, Number y){ return toBigInteger(x).remainder(toBigInteger(y)); } public boolean equiv(Number x, Number y){ return toBigInteger(x).equals(toBigInteger(y)); } public boolean lt(Number x, Number y){ return toBigInteger(x).compareTo(toBigInteger(y)) < 0; } //public Number subtract(Number x, Number y); final public Number negate(Number x){ return toBigInteger(x).negate(); } public Number inc(Number x){ BigInteger bx = toBigInteger(x); return reduce(bx.add(BigInteger.ONE)); } public Number dec(Number x){ BigInteger bx = toBigInteger(x); return reduce(bx.subtract(BigInteger.ONE)); } } final static class BigDecimalOps implements Ops{ final static Var MATH_CONTEXT = RT.MATH_CONTEXT; public Ops combine(Ops y){ return y.opsWith(this); } final public Ops opsWith(IntegerOps x){ return this; } final public Ops opsWith(LongOps x){ return this; } final public Ops opsWith(FloatOps x){ return FLOAT_OPS; } final public Ops opsWith(DoubleOps x){ return DOUBLE_OPS; } final public Ops opsWith(RatioOps x){ return RATIO_OPS; } final public Ops opsWith(BigIntegerOps x){ return this; } final public Ops opsWith(BigDecimalOps x){ return this; } public boolean isZero(Number x){ BigDecimal bx = (BigDecimal) x; return bx.signum() == 0; } public boolean isPos(Number x){ BigDecimal bx = (BigDecimal) x; return bx.signum() > 0; } public boolean isNeg(Number x){ BigDecimal bx = (BigDecimal) x; return bx.signum() < 0; } final public Number add(Number x, Number y){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); return mc == null ? toBigDecimal(x).add(toBigDecimal(y)) : toBigDecimal(x).add(toBigDecimal(y), mc); } final public Number multiply(Number x, Number y){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); return mc == null ? toBigDecimal(x).multiply(toBigDecimal(y)) : toBigDecimal(x).multiply(toBigDecimal(y), mc); } public Number divide(Number x, Number y){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); return mc == null ? toBigDecimal(x).divide(toBigDecimal(y)) : toBigDecimal(x).divide(toBigDecimal(y), mc); } public Number quotient(Number x, Number y){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); return mc == null ? toBigDecimal(x).divideToIntegralValue(toBigDecimal(y)) : toBigDecimal(x).divideToIntegralValue(toBigDecimal(y), mc); } public Number remainder(Number x, Number y){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); return mc == null ? toBigDecimal(x).remainder(toBigDecimal(y)) : toBigDecimal(x).remainder(toBigDecimal(y), mc); } public boolean equiv(Number x, Number y){ return toBigDecimal(x).equals(toBigDecimal(y)); } public boolean lt(Number x, Number y){ return toBigDecimal(x).compareTo(toBigDecimal(y)) < 0; } //public Number subtract(Number x, Number y); final public Number negate(Number x){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); return mc == null ? ((BigDecimal) x).negate() : ((BigDecimal) x).negate(mc); } public Number inc(Number x){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); BigDecimal bx = (BigDecimal) x; return mc == null ? bx.add(BigDecimal.ONE) : bx.add(BigDecimal.ONE, mc); } public Number dec(Number x){ MathContext mc = (MathContext) MATH_CONTEXT.deref(); BigDecimal bx = (BigDecimal) x; return mc == null ? bx.subtract(BigDecimal.ONE) : bx.subtract(BigDecimal.ONE, mc); } } final static class IntegerBitOps implements BitOps{ public BitOps combine(BitOps y){ return y.bitOpsWith(this); } final public BitOps bitOpsWith(IntegerBitOps x){ return this; } final public BitOps bitOpsWith(LongBitOps x){ return LONG_BITOPS; } final public BitOps bitOpsWith(BigIntegerBitOps x){ return BIGINTEGER_BITOPS; } public Number not(Number x){ return ~x.intValue(); } public Number and(Number x, Number y){ return x.intValue() & y.intValue(); } public Number or(Number x, Number y){ return x.intValue() | y.intValue(); } public Number xor(Number x, Number y){ return x.intValue() ^ y.intValue(); } public Number andNot(Number x, Number y){ return x.intValue() & ~y.intValue(); } public Number clearBit(Number x, int n){ if(n < 31) return x.intValue() & ~(1 << n); else if(n < 63) return x.longValue() & ~(1L << n); else return toBigInteger(x).clearBit(n); } public Number setBit(Number x, int n){ if(n < 31) return x.intValue() | (1 << n); else if(n < 63) return x.longValue() | (1L << n); else return toBigInteger(x).setBit(n); } public Number flipBit(Number x, int n){ if(n < 31) return x.intValue() ^ (1 << n); else if(n < 63) return x.longValue() ^ (1L << n); else return toBigInteger(x).flipBit(n); } public boolean testBit(Number x, int n){ if(n < 32) return (x.intValue() & (1 << n)) != 0; else if(n < 64) return (x.longValue() & (1L << n)) != 0; else return toBigInteger(x).testBit(n); } public Number shiftLeft(Number x, int n){ if(n < 32) { if(n < 0) return shiftRight(x, -n); return reduce(x.longValue() << n); } else return reduce(toBigInteger(x).shiftLeft(n)); } public Number shiftRight(Number x, int n){ if(n < 0) return shiftLeft(x, -n); return x.intValue() >> n; } } final static class LongBitOps implements BitOps{ public BitOps combine(BitOps y){ return y.bitOpsWith(this); } final public BitOps bitOpsWith(IntegerBitOps x){ return this; } final public BitOps bitOpsWith(LongBitOps x){ return this; } final public BitOps bitOpsWith(BigIntegerBitOps x){ return BIGINTEGER_BITOPS; } public Number not(Number x){ return ~x.longValue(); } public Number and(Number x, Number y){ return x.longValue() & y.longValue(); } public Number or(Number x, Number y){ return x.longValue() | y.longValue(); } public Number xor(Number x, Number y){ return x.longValue() ^ y.longValue(); } public Number andNot(Number x, Number y){ return x.longValue() & ~y.longValue(); } public Number clearBit(Number x, int n){ if(n < 63) return x.longValue() & ~(1L << n); else return toBigInteger(x).clearBit(n); } public Number setBit(Number x, int n){ if(n < 63) return x.longValue() | (1L << n); else return toBigInteger(x).setBit(n); } public Number flipBit(Number x, int n){ if(n < 63) return x.longValue() ^ (1L << n); else return toBigInteger(x).flipBit(n); } public boolean testBit(Number x, int n){ if(n < 64) return (x.longValue() & (1L << n)) != 0; else return toBigInteger(x).testBit(n); } public Number shiftLeft(Number x, int n){ if(n < 0) return shiftRight(x, -n); return reduce(toBigInteger(x).shiftLeft(n)); } public Number shiftRight(Number x, int n){ if(n < 0) return shiftLeft(x, -n); return x.longValue() >> n; } } final static class BigIntegerBitOps implements BitOps{ public BitOps combine(BitOps y){ return y.bitOpsWith(this); } final public BitOps bitOpsWith(IntegerBitOps x){ return this; } final public BitOps bitOpsWith(LongBitOps x){ return this; } final public BitOps bitOpsWith(BigIntegerBitOps x){ return this; } public Number not(Number x){ return toBigInteger(x).not(); } public Number and(Number x, Number y){ return toBigInteger(x).and(toBigInteger(y)); } public Number or(Number x, Number y){ return toBigInteger(x).or(toBigInteger(y)); } public Number xor(Number x, Number y){ return toBigInteger(x).xor(toBigInteger(y)); } public Number andNot(Number x, Number y){ return toBigInteger(x).andNot(toBigInteger(y)); } public Number clearBit(Number x, int n){ return toBigInteger(x).clearBit(n); } public Number setBit(Number x, int n){ return toBigInteger(x).setBit(n); } public Number flipBit(Number x, int n){ return toBigInteger(x).flipBit(n); } public boolean testBit(Number x, int n){ return toBigInteger(x).testBit(n); } public Number shiftLeft(Number x, int n){ return toBigInteger(x).shiftLeft(n); } public Number shiftRight(Number x, int n){ return toBigInteger(x).shiftRight(n); } } static final IntegerOps INTEGER_OPS = new IntegerOps(); static final LongOps LONG_OPS = new LongOps(); static final FloatOps FLOAT_OPS = new FloatOps(); static final DoubleOps DOUBLE_OPS = new DoubleOps(); static final RatioOps RATIO_OPS = new RatioOps(); static final BigIntegerOps BIGINTEGER_OPS = new BigIntegerOps(); static final BigDecimalOps BIGDECIMAL_OPS = new BigDecimalOps(); static final IntegerBitOps INTEGER_BITOPS = new IntegerBitOps(); static final LongBitOps LONG_BITOPS = new LongBitOps(); static final BigIntegerBitOps BIGINTEGER_BITOPS = new BigIntegerBitOps(); static Ops ops(Object x){ Class xc = x.getClass(); if(xc == Integer.class) return INTEGER_OPS; else if(xc == Double.class) return DOUBLE_OPS; else if(xc == Float.class) return FLOAT_OPS; else if(xc == BigInteger.class) return BIGINTEGER_OPS; else if(xc == Long.class) return LONG_OPS; else if(xc == Ratio.class) return RATIO_OPS; else if(xc == BigDecimal.class) return BIGDECIMAL_OPS; else return INTEGER_OPS; } static BitOps bitOps(Object x){ Class xc = x.getClass(); if(xc == Integer.class) return INTEGER_BITOPS; else if(xc == Long.class) return LONG_BITOPS; else if(xc == BigInteger.class) return BIGINTEGER_BITOPS; else if(xc == Double.class || xc == Float.class || xc == BigDecimalOps.class || xc == Ratio.class) throw new ArithmeticException("bit operation on non integer type: " + xc); else return INTEGER_BITOPS; } //final static ExecutorService executor = Executors.newCachedThreadPool(); //static public int minChunk = 100; //static int chunkSize(int alength){ // return Math.max(alength / Runtime.getRuntime().availableProcessors(), minChunk); //} // } // else // { // LinkedList> ops = new LinkedList>(); // for(int offset = 0;offset < xs.length;offset+=chunk) // { // final int start = offset; // final int end = Math.min(xs.length, start + chunk); // ops.add(new Callable(){ // public Float call() throws Exception{ // for(int i=start;i y; } static public boolean gte(float x, float y){ return x >= y; } static public boolean isPos(float x){ return x > 0; } static public boolean isNeg(float x){ return x < 0; } static public boolean isZero(float x){ return x == 0; } static public Number num(double x){ return x; } static public double add(double x, double y){ return x + y; } static public double minus(double x, double y){ return x - y; } static public double minus(double x){ return -x; } static public double inc(double x){ return x + 1; } static public double dec(double x){ return x - 1; } static public double multiply(double x, double y){ return x * y; } static public double divide(double x, double y){ return x / y; } static public boolean equiv(double x, double y){ return x == y; } static public boolean lt(double x, double y){ return x < y; } static public boolean lte(double x, double y){ return x <= y; } static public boolean gt(double x, double y){ return x > y; } static public boolean gte(double x, double y){ return x >= y; } static public boolean isPos(double x){ return x > 0; } static public boolean isNeg(double x){ return x < 0; } static public boolean isZero(double x){ return x == 0; } static int throwIntOverflow(){ throw new ArithmeticException("integer overflow"); } static public Number num(int x){ return x; } static public int unchecked_add(int x, int y){ return x + y; } static public int unchecked_subtract(int x, int y){ return x - y; } static public int unchecked_negate(int x){ return -x; } static public int unchecked_inc(int x){ return x + 1; } static public int unchecked_dec(int x){ return x - 1; } static public int unchecked_multiply(int x, int y){ return x * y; } static public int add(int x, int y){ int ret = x + y; if ((ret ^ x) < 0 && (ret ^ y) < 0) return throwIntOverflow(); return ret; } static public int not(int x){ return ~x; } static public int and(int x, int y){ return x & y; } static public int or(int x, int y){ return x | y; } static public int xor(int x, int y){ return x ^ y; } static public int minus(int x, int y){ int ret = x - y; if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) return throwIntOverflow(); return ret; } static public int minus(int x){ if(x == Integer.MIN_VALUE) return throwIntOverflow(); return -x; } static public int inc(int x){ if(x == Integer.MAX_VALUE) return throwIntOverflow(); return x + 1; } static public int dec(int x){ if(x == Integer.MIN_VALUE) return throwIntOverflow(); return x - 1; } static public int multiply(int x, int y){ int ret = x * y; if (y != 0 && ret/y != x) return throwIntOverflow(); return ret; } static public int unchecked_divide(int x, int y){ return x / y; } static public int unchecked_remainder(int x, int y){ return x % y; } static public boolean equiv(int x, int y){ return x == y; } static public boolean lt(int x, int y){ return x < y; } static public boolean lte(int x, int y){ return x <= y; } static public boolean gt(int x, int y){ return x > y; } static public boolean gte(int x, int y){ return x >= y; } static public boolean isPos(int x){ return x > 0; } static public boolean isNeg(int x){ return x < 0; } static public boolean isZero(int x){ return x == 0; } static public Number num(long x){ return x; } static public long unchecked_add(long x, long y){ return x + y; } static public long unchecked_subtract(long x, long y){ return x - y; } static public long unchecked_negate(long x){ return -x; } static public long unchecked_inc(long x){ return x + 1; } static public long unchecked_dec(long x){ return x - 1; } static public long unchecked_multiply(long x, long y){ return x * y; } static public long add(long x, long y){ long ret = x + y; if ((ret ^ x) < 0 && (ret ^ y) < 0) return throwIntOverflow(); return ret; } static public long minus(long x, long y){ long ret = x - y; if (((ret ^ x) < 0 && (ret ^ ~y) < 0)) return throwIntOverflow(); return ret; } static public long minus(long x){ if(x == Long.MIN_VALUE) return throwIntOverflow(); return -x; } static public long inc(long x){ if(x == Long.MAX_VALUE) return throwIntOverflow(); return x + 1; } static public long dec(long x){ if(x == Long.MIN_VALUE) return throwIntOverflow(); return x - 1; } static public long multiply(long x, long y){ long ret = x * y; if (y != 0 && ret/y != x) return throwIntOverflow(); return ret; } static public long unchecked_divide(long x, long y){ return x / y; } static public long unchecked_remainder(long x, long y){ return x % y; } static public boolean equiv(long x, long y){ return x == y; } static public boolean lt(long x, long y){ return x < y; } static public boolean lte(long x, long y){ return x <= y; } static public boolean gt(long x, long y){ return x > y; } static public boolean gte(long x, long y){ return x >= y; } static public boolean isPos(long x){ return x > 0; } static public boolean isNeg(long x){ return x < 0; } static public boolean isZero(long x){ return x == 0; } /* static public class F{ static public float add(float x, float y){ return x + y; } static public float subtract(float x, float y){ return x - y; } static public float negate(float x){ return -x; } static public float inc(float x){ return x + 1; } static public float dec(float x){ return x - 1; } static public float multiply(float x, float y){ return x * y; } static public float divide(float x, float y){ return x / y; } static public boolean equiv(float x, float y){ return x == y; } static public boolean lt(float x, float y){ return x < y; } static public boolean lte(float x, float y){ return x <= y; } static public boolean gt(float x, float y){ return x > y; } static public boolean gte(float x, float y){ return x >= y; } static public boolean pos(float x){ return x > 0; } static public boolean neg(float x){ return x < 0; } static public boolean zero(float x){ return x == 0; } static public float aget(float[] xs, int i){ return xs[i]; } static public float aset(float[] xs, int i, float v){ xs[i] = v; return v; } static public int alength(float[] xs){ return xs.length; } static public float[] aclone(float[] xs){ return xs.clone(); } static public float[] vec(int size, Object init){ float[] ret = new float[size]; if(init instanceof Number) { float f = ((Number) init).floatValue(); for(int i = 0; i < ret.length; i++) ret[i] = f; } else { ISeq s = RT.seq(init); for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).floatValue(); } return ret; } static public float[] vec(Object sizeOrSeq){ if(sizeOrSeq instanceof Number) return new float[((Number) sizeOrSeq).intValue()]; else { ISeq s = RT.seq(sizeOrSeq); int size = s.count(); float[] ret = new float[size]; for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).intValue(); return ret; } } static public float[] vsadd(float[] x, float y){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += y; return xs; } static public float[] vssub(float[] x, float y){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= y; return xs; } static public float[] vsdiv(float[] x, float y){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= y; return xs; } static public float[] vsmul(float[] x, float y){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= y; return xs; } static public float[] svdiv(float y, float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = y / xs[i]; return xs; } static public float[] vsmuladd(float[] x, float y, float[] zs){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + zs[i]; return xs; } static public float[] vsmulsub(float[] x, float y, float[] zs){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - zs[i]; return xs; } static public float[] vsmulsadd(float[] x, float y, float z){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + z; return xs; } static public float[] vsmulssub(float[] x, float y, float z){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - z; return xs; } static public float[] vabs(float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.abs(xs[i]); return xs; } static public float[] vnegabs(float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -Math.abs(xs[i]); return xs; } static public float[] vneg(float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -xs[i]; return xs; } static public float[] vsqr(float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= xs[i]; return xs; } static public float[] vsignedsqr(float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= Math.abs(xs[i]); return xs; } static public float[] vclip(float[] x, float low, float high){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < low) xs[i] = low; else if(xs[i] > high) xs[i] = high; } return xs; } static public IPersistentVector vclipcounts(float[] x, float low, float high){ final float[] xs = x.clone(); int lowc = 0; int highc = 0; for(int i = 0; i < xs.length; i++) { if(xs[i] < low) { ++lowc; xs[i] = low; } else if(xs[i] > high) { ++highc; xs[i] = high; } } return RT.vector(xs, lowc, highc); } static public float[] vthresh(float[] x, float thresh, float otherwise){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < thresh) xs[i] = otherwise; } return xs; } static public float[] vreverse(float[] x){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[xs.length - i - 1]; return xs; } static public float[] vrunningsum(float[] x){ final float[] xs = x.clone(); for(int i = 1; i < xs.length; i++) xs[i] = xs[i - 1] + xs[i]; return xs; } static public float[] vsort(float[] x){ final float[] xs = x.clone(); Arrays.sort(xs); return xs; } static public float vdot(float[] xs, float[] ys){ float ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * ys[i]; return ret; } static public float vmax(float[] xs){ if(xs.length == 0) return 0; float ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.max(ret, xs[i]); return ret; } static public float vmin(float[] xs){ if(xs.length == 0) return 0; float ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.min(ret, xs[i]); return ret; } static public float vmean(float[] xs){ if(xs.length == 0) return 0; return vsum(xs) / xs.length; } static public double vrms(float[] xs){ if(xs.length == 0) return 0; float ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * xs[i]; return Math.sqrt(ret / xs.length); } static public float vsum(float[] xs){ float ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i]; return ret; } static public boolean vequiv(float[] xs, float[] ys){ return Arrays.equals(xs, ys); } static public float[] vadd(float[] x, float[] ys){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += ys[i]; return xs; } static public float[] vsub(float[] x, float[] ys){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= ys[i]; return xs; } static public float[] vaddmul(float[] x, float[] ys, float[] zs){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * zs[i]; return xs; } static public float[] vsubmul(float[] x, float[] ys, float[] zs){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * zs[i]; return xs; } static public float[] vaddsmul(float[] x, float[] ys, float z){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * z; return xs; } static public float[] vsubsmul(float[] x, float[] ys, float z){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * z; return xs; } static public float[] vmulsadd(float[] x, float[] ys, float z){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + z; return xs; } static public float[] vdiv(float[] x, float[] ys){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= ys[i]; return xs; } static public float[] vmul(float[] x, float[] ys){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= ys[i]; return xs; } static public float[] vmuladd(float[] x, float[] ys, float[] zs){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + zs[i]; return xs; } static public float[] vmulsub(float[] x, float[] ys, float[] zs){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) - zs[i]; return xs; } static public float[] vmax(float[] x, float[] ys){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.max(xs[i], ys[i]); return xs; } static public float[] vmin(float[] x, float[] ys){ final float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.min(xs[i], ys[i]); return xs; } static public float[] vmap(IFn fn, float[] x) throws Exception{ float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i])).floatValue(); return xs; } static public float[] vmap(IFn fn, float[] x, float[] ys) throws Exception{ float[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i], ys[i])).floatValue(); return xs; } } static public class D{ static public double add(double x, double y){ return x + y; } static public double subtract(double x, double y){ return x - y; } static public double negate(double x){ return -x; } static public double inc(double x){ return x + 1; } static public double dec(double x){ return x - 1; } static public double multiply(double x, double y){ return x * y; } static public double divide(double x, double y){ return x / y; } static public boolean equiv(double x, double y){ return x == y; } static public boolean lt(double x, double y){ return x < y; } static public boolean lte(double x, double y){ return x <= y; } static public boolean gt(double x, double y){ return x > y; } static public boolean gte(double x, double y){ return x >= y; } static public boolean pos(double x){ return x > 0; } static public boolean neg(double x){ return x < 0; } static public boolean zero(double x){ return x == 0; } static public double aget(double[] xs, int i){ return xs[i]; } static public double aset(double[] xs, int i, double v){ xs[i] = v; return v; } static public int alength(double[] xs){ return xs.length; } static public double[] aclone(double[] xs){ return xs.clone(); } static public double[] vec(int size, Object init){ double[] ret = new double[size]; if(init instanceof Number) { double f = ((Number) init).doubleValue(); for(int i = 0; i < ret.length; i++) ret[i] = f; } else { ISeq s = RT.seq(init); for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).doubleValue(); } return ret; } static public double[] vec(Object sizeOrSeq){ if(sizeOrSeq instanceof Number) return new double[((Number) sizeOrSeq).intValue()]; else { ISeq s = RT.seq(sizeOrSeq); int size = s.count(); double[] ret = new double[size]; for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).intValue(); return ret; } } static public double[] vsadd(double[] x, double y){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += y; return xs; } static public double[] vssub(double[] x, double y){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= y; return xs; } static public double[] vsdiv(double[] x, double y){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= y; return xs; } static public double[] vsmul(double[] x, double y){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= y; return xs; } static public double[] svdiv(double y, double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = y / xs[i]; return xs; } static public double[] vsmuladd(double[] x, double y, double[] zs){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + zs[i]; return xs; } static public double[] vsmulsub(double[] x, double y, double[] zs){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - zs[i]; return xs; } static public double[] vsmulsadd(double[] x, double y, double z){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + z; return xs; } static public double[] vsmulssub(double[] x, double y, double z){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - z; return xs; } static public double[] vabs(double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.abs(xs[i]); return xs; } static public double[] vnegabs(double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -Math.abs(xs[i]); return xs; } static public double[] vneg(double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -xs[i]; return xs; } static public double[] vsqr(double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= xs[i]; return xs; } static public double[] vsignedsqr(double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= Math.abs(xs[i]); return xs; } static public double[] vclip(double[] x, double low, double high){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < low) xs[i] = low; else if(xs[i] > high) xs[i] = high; } return xs; } static public IPersistentVector vclipcounts(double[] x, double low, double high){ final double[] xs = x.clone(); int lowc = 0; int highc = 0; for(int i = 0; i < xs.length; i++) { if(xs[i] < low) { ++lowc; xs[i] = low; } else if(xs[i] > high) { ++highc; xs[i] = high; } } return RT.vector(xs, lowc, highc); } static public double[] vthresh(double[] x, double thresh, double otherwise){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < thresh) xs[i] = otherwise; } return xs; } static public double[] vreverse(double[] x){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[xs.length - i - 1]; return xs; } static public double[] vrunningsum(double[] x){ final double[] xs = x.clone(); for(int i = 1; i < xs.length; i++) xs[i] = xs[i - 1] + xs[i]; return xs; } static public double[] vsort(double[] x){ final double[] xs = x.clone(); Arrays.sort(xs); return xs; } static public double vdot(double[] xs, double[] ys){ double ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * ys[i]; return ret; } static public double vmax(double[] xs){ if(xs.length == 0) return 0; double ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.max(ret, xs[i]); return ret; } static public double vmin(double[] xs){ if(xs.length == 0) return 0; double ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.min(ret, xs[i]); return ret; } static public double vmean(double[] xs){ if(xs.length == 0) return 0; return vsum(xs) / xs.length; } static public double vrms(double[] xs){ if(xs.length == 0) return 0; double ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * xs[i]; return Math.sqrt(ret / xs.length); } static public double vsum(double[] xs){ double ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i]; return ret; } static public boolean vequiv(double[] xs, double[] ys){ return Arrays.equals(xs, ys); } static public double[] vadd(double[] x, double[] ys){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += ys[i]; return xs; } static public double[] vsub(double[] x, double[] ys){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= ys[i]; return xs; } static public double[] vaddmul(double[] x, double[] ys, double[] zs){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * zs[i]; return xs; } static public double[] vsubmul(double[] x, double[] ys, double[] zs){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * zs[i]; return xs; } static public double[] vaddsmul(double[] x, double[] ys, double z){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * z; return xs; } static public double[] vsubsmul(double[] x, double[] ys, double z){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * z; return xs; } static public double[] vmulsadd(double[] x, double[] ys, double z){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + z; return xs; } static public double[] vdiv(double[] x, double[] ys){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= ys[i]; return xs; } static public double[] vmul(double[] x, double[] ys){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= ys[i]; return xs; } static public double[] vmuladd(double[] x, double[] ys, double[] zs){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + zs[i]; return xs; } static public double[] vmulsub(double[] x, double[] ys, double[] zs){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) - zs[i]; return xs; } static public double[] vmax(double[] x, double[] ys){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.max(xs[i], ys[i]); return xs; } static public double[] vmin(double[] x, double[] ys){ final double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.min(xs[i], ys[i]); return xs; } static public double[] vmap(IFn fn, double[] x) throws Exception{ double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i])).doubleValue(); return xs; } static public double[] vmap(IFn fn, double[] x, double[] ys) throws Exception{ double[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i], ys[i])).doubleValue(); return xs; } } static public class I{ static public int add(int x, int y){ return x + y; } static public int subtract(int x, int y){ return x - y; } static public int negate(int x){ return -x; } static public int inc(int x){ return x + 1; } static public int dec(int x){ return x - 1; } static public int multiply(int x, int y){ return x * y; } static public int divide(int x, int y){ return x / y; } static public boolean equiv(int x, int y){ return x == y; } static public boolean lt(int x, int y){ return x < y; } static public boolean lte(int x, int y){ return x <= y; } static public boolean gt(int x, int y){ return x > y; } static public boolean gte(int x, int y){ return x >= y; } static public boolean pos(int x){ return x > 0; } static public boolean neg(int x){ return x < 0; } static public boolean zero(int x){ return x == 0; } static public int aget(int[] xs, int i){ return xs[i]; } static public int aset(int[] xs, int i, int v){ xs[i] = v; return v; } static public int alength(int[] xs){ return xs.length; } static public int[] aclone(int[] xs){ return xs.clone(); } static public int[] vec(int size, Object init){ int[] ret = new int[size]; if(init instanceof Number) { int f = ((Number) init).intValue(); for(int i = 0; i < ret.length; i++) ret[i] = f; } else { ISeq s = RT.seq(init); for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).intValue(); } return ret; } static public int[] vec(Object sizeOrSeq){ if(sizeOrSeq instanceof Number) return new int[((Number) sizeOrSeq).intValue()]; else { ISeq s = RT.seq(sizeOrSeq); int size = s.count(); int[] ret = new int[size]; for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).intValue(); return ret; } } static public int[] vsadd(int[] x, int y){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += y; return xs; } static public int[] vssub(int[] x, int y){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= y; return xs; } static public int[] vsdiv(int[] x, int y){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= y; return xs; } static public int[] vsmul(int[] x, int y){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= y; return xs; } static public int[] svdiv(int y, int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = y / xs[i]; return xs; } static public int[] vsmuladd(int[] x, int y, int[] zs){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + zs[i]; return xs; } static public int[] vsmulsub(int[] x, int y, int[] zs){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - zs[i]; return xs; } static public int[] vsmulsadd(int[] x, int y, int z){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + z; return xs; } static public int[] vsmulssub(int[] x, int y, int z){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - z; return xs; } static public int[] vabs(int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.abs(xs[i]); return xs; } static public int[] vnegabs(int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -Math.abs(xs[i]); return xs; } static public int[] vneg(int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -xs[i]; return xs; } static public int[] vsqr(int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= xs[i]; return xs; } static public int[] vsignedsqr(int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= Math.abs(xs[i]); return xs; } static public int[] vclip(int[] x, int low, int high){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < low) xs[i] = low; else if(xs[i] > high) xs[i] = high; } return xs; } static public IPersistentVector vclipcounts(int[] x, int low, int high){ final int[] xs = x.clone(); int lowc = 0; int highc = 0; for(int i = 0; i < xs.length; i++) { if(xs[i] < low) { ++lowc; xs[i] = low; } else if(xs[i] > high) { ++highc; xs[i] = high; } } return RT.vector(xs, lowc, highc); } static public int[] vthresh(int[] x, int thresh, int otherwise){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < thresh) xs[i] = otherwise; } return xs; } static public int[] vreverse(int[] x){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[xs.length - i - 1]; return xs; } static public int[] vrunningsum(int[] x){ final int[] xs = x.clone(); for(int i = 1; i < xs.length; i++) xs[i] = xs[i - 1] + xs[i]; return xs; } static public int[] vsort(int[] x){ final int[] xs = x.clone(); Arrays.sort(xs); return xs; } static public int vdot(int[] xs, int[] ys){ int ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * ys[i]; return ret; } static public int vmax(int[] xs){ if(xs.length == 0) return 0; int ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.max(ret, xs[i]); return ret; } static public int vmin(int[] xs){ if(xs.length == 0) return 0; int ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.min(ret, xs[i]); return ret; } static public double vmean(int[] xs){ if(xs.length == 0) return 0; return vsum(xs) / (double) xs.length; } static public double vrms(int[] xs){ if(xs.length == 0) return 0; int ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * xs[i]; return Math.sqrt(ret / (double) xs.length); } static public int vsum(int[] xs){ int ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i]; return ret; } static public boolean vequiv(int[] xs, int[] ys){ return Arrays.equals(xs, ys); } static public int[] vadd(int[] x, int[] ys){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += ys[i]; return xs; } static public int[] vsub(int[] x, int[] ys){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= ys[i]; return xs; } static public int[] vaddmul(int[] x, int[] ys, int[] zs){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * zs[i]; return xs; } static public int[] vsubmul(int[] x, int[] ys, int[] zs){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * zs[i]; return xs; } static public int[] vaddsmul(int[] x, int[] ys, int z){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * z; return xs; } static public int[] vsubsmul(int[] x, int[] ys, int z){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * z; return xs; } static public int[] vmulsadd(int[] x, int[] ys, int z){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + z; return xs; } static public int[] vdiv(int[] x, int[] ys){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= ys[i]; return xs; } static public int[] vmul(int[] x, int[] ys){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= ys[i]; return xs; } static public int[] vmuladd(int[] x, int[] ys, int[] zs){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + zs[i]; return xs; } static public int[] vmulsub(int[] x, int[] ys, int[] zs){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) - zs[i]; return xs; } static public int[] vmax(int[] x, int[] ys){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.max(xs[i], ys[i]); return xs; } static public int[] vmin(int[] x, int[] ys){ final int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.min(xs[i], ys[i]); return xs; } static public int[] vmap(IFn fn, int[] x) throws Exception{ int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i])).intValue(); return xs; } static public int[] vmap(IFn fn, int[] x, int[] ys) throws Exception{ int[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i], ys[i])).intValue(); return xs; } } static public class L{ static public long add(long x, long y){ return x + y; } static public long subtract(long x, long y){ return x - y; } static public long negate(long x){ return -x; } static public long inc(long x){ return x + 1; } static public long dec(long x){ return x - 1; } static public long multiply(long x, long y){ return x * y; } static public long divide(long x, long y){ return x / y; } static public boolean equiv(long x, long y){ return x == y; } static public boolean lt(long x, long y){ return x < y; } static public boolean lte(long x, long y){ return x <= y; } static public boolean gt(long x, long y){ return x > y; } static public boolean gte(long x, long y){ return x >= y; } static public boolean pos(long x){ return x > 0; } static public boolean neg(long x){ return x < 0; } static public boolean zero(long x){ return x == 0; } static public long aget(long[] xs, int i){ return xs[i]; } static public long aset(long[] xs, int i, long v){ xs[i] = v; return v; } static public int alength(long[] xs){ return xs.length; } static public long[] aclone(long[] xs){ return xs.clone(); } static public long[] vec(int size, Object init){ long[] ret = new long[size]; if(init instanceof Number) { long f = ((Number) init).longValue(); for(int i = 0; i < ret.length; i++) ret[i] = f; } else { ISeq s = RT.seq(init); for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).longValue(); } return ret; } static public long[] vec(Object sizeOrSeq){ if(sizeOrSeq instanceof Number) return new long[((Number) sizeOrSeq).intValue()]; else { ISeq s = RT.seq(sizeOrSeq); int size = s.count(); long[] ret = new long[size]; for(int i = 0; i < size && s != null; i++, s = s.rest()) ret[i] = ((Number) s.first()).intValue(); return ret; } } static public long[] vsadd(long[] x, long y){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += y; return xs; } static public long[] vssub(long[] x, long y){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= y; return xs; } static public long[] vsdiv(long[] x, long y){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= y; return xs; } static public long[] vsmul(long[] x, long y){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= y; return xs; } static public long[] svdiv(long y, long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = y / xs[i]; return xs; } static public long[] vsmuladd(long[] x, long y, long[] zs){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + zs[i]; return xs; } static public long[] vsmulsub(long[] x, long y, long[] zs){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - zs[i]; return xs; } static public long[] vsmulsadd(long[] x, long y, long z){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y + z; return xs; } static public long[] vsmulssub(long[] x, long y, long z){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[i] * y - z; return xs; } static public long[] vabs(long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.abs(xs[i]); return xs; } static public long[] vnegabs(long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -Math.abs(xs[i]); return xs; } static public long[] vneg(long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = -xs[i]; return xs; } static public long[] vsqr(long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= xs[i]; return xs; } static public long[] vsignedsqr(long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= Math.abs(xs[i]); return xs; } static public long[] vclip(long[] x, long low, long high){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < low) xs[i] = low; else if(xs[i] > high) xs[i] = high; } return xs; } static public IPersistentVector vclipcounts(long[] x, long low, long high){ final long[] xs = x.clone(); int lowc = 0; int highc = 0; for(int i = 0; i < xs.length; i++) { if(xs[i] < low) { ++lowc; xs[i] = low; } else if(xs[i] > high) { ++highc; xs[i] = high; } } return RT.vector(xs, lowc, highc); } static public long[] vthresh(long[] x, long thresh, long otherwise){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) { if(xs[i] < thresh) xs[i] = otherwise; } return xs; } static public long[] vreverse(long[] x){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = xs[xs.length - i - 1]; return xs; } static public long[] vrunningsum(long[] x){ final long[] xs = x.clone(); for(int i = 1; i < xs.length; i++) xs[i] = xs[i - 1] + xs[i]; return xs; } static public long[] vsort(long[] x){ final long[] xs = x.clone(); Arrays.sort(xs); return xs; } static public long vdot(long[] xs, long[] ys){ long ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * ys[i]; return ret; } static public long vmax(long[] xs){ if(xs.length == 0) return 0; long ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.max(ret, xs[i]); return ret; } static public long vmin(long[] xs){ if(xs.length == 0) return 0; long ret = xs[0]; for(int i = 0; i < xs.length; i++) ret = Math.min(ret, xs[i]); return ret; } static public double vmean(long[] xs){ if(xs.length == 0) return 0; return vsum(xs) / (double) xs.length; } static public double vrms(long[] xs){ if(xs.length == 0) return 0; long ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i] * xs[i]; return Math.sqrt(ret / (double) xs.length); } static public long vsum(long[] xs){ long ret = 0; for(int i = 0; i < xs.length; i++) ret += xs[i]; return ret; } static public boolean vequiv(long[] xs, long[] ys){ return Arrays.equals(xs, ys); } static public long[] vadd(long[] x, long[] ys){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] += ys[i]; return xs; } static public long[] vsub(long[] x, long[] ys){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] -= ys[i]; return xs; } static public long[] vaddmul(long[] x, long[] ys, long[] zs){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * zs[i]; return xs; } static public long[] vsubmul(long[] x, long[] ys, long[] zs){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * zs[i]; return xs; } static public long[] vaddsmul(long[] x, long[] ys, long z){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] + ys[i]) * z; return xs; } static public long[] vsubsmul(long[] x, long[] ys, long z){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] - ys[i]) * z; return xs; } static public long[] vmulsadd(long[] x, long[] ys, long z){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + z; return xs; } static public long[] vdiv(long[] x, long[] ys){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] /= ys[i]; return xs; } static public long[] vmul(long[] x, long[] ys){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] *= ys[i]; return xs; } static public long[] vmuladd(long[] x, long[] ys, long[] zs){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) + zs[i]; return xs; } static public long[] vmulsub(long[] x, long[] ys, long[] zs){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = (xs[i] * ys[i]) - zs[i]; return xs; } static public long[] vmax(long[] x, long[] ys){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.max(xs[i], ys[i]); return xs; } static public long[] vmin(long[] x, long[] ys){ final long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = Math.min(xs[i], ys[i]); return xs; } static public long[] vmap(IFn fn, long[] x) throws Exception{ long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i])).longValue(); return xs; } static public long[] vmap(IFn fn, long[] x, long[] ys) throws Exception{ long[] xs = x.clone(); for(int i = 0; i < xs.length; i++) xs[i] = ((Number) fn.invoke(xs[i], ys[i])).longValue(); return xs; } } */ //overload resolution static public Number add(int x, Object y){ return add((Object)x,y); } static public Number add(Object x, int y){ return add(x,(Object)y); } static public Number and(int x, Object y){ return and((Object)x,y); } static public Number and(Object x, int y){ return and(x,(Object)y); } static public Number or(int x, Object y){ return or((Object)x,y); } static public Number or(Object x, int y){ return or(x,(Object)y); } static public Number xor(int x, Object y){ return xor((Object)x,y); } static public Number xor(Object x, int y){ return xor(x,(Object)y); } static public Number add(float x, Object y){ return add((Object)x,y); } static public Number add(Object x, float y){ return add(x,(Object)y); } static public Number add(long x, Object y){ return add((Object)x,y); } static public Number add(Object x, long y){ return add(x,(Object)y); } static public Number add(double x, Object y){ return add((Object)x,y); } static public Number add(Object x, double y){ return add(x,(Object)y); } static public Number minus(int x, Object y){ return minus((Object)x,y); } static public Number minus(Object x, int y){ return minus(x,(Object)y); } static public Number minus(float x, Object y){ return minus((Object)x,y); } static public Number minus(Object x, float y){ return minus(x,(Object)y); } static public Number minus(long x, Object y){ return minus((Object)x,y); } static public Number minus(Object x, long y){ return minus(x,(Object)y); } static public Number minus(double x, Object y){ return minus((Object)x,y); } static public Number minus(Object x, double y){ return minus(x,(Object)y); } static public Number multiply(int x, Object y){ return multiply((Object)x,y); } static public Number multiply(Object x, int y){ return multiply(x,(Object)y); } static public Number multiply(float x, Object y){ return multiply((Object)x,y); } static public Number multiply(Object x, float y){ return multiply(x,(Object)y); } static public Number multiply(long x, Object y){ return multiply((Object)x,y); } static public Number multiply(Object x, long y){ return multiply(x,(Object)y); } static public Number multiply(double x, Object y){ return multiply((Object)x,y); } static public Number multiply(Object x, double y){ return multiply(x,(Object)y); } static public Number divide(int x, Object y){ return divide((Object)x,y); } static public Number divide(Object x, int y){ return divide(x,(Object)y); } static public Number divide(float x, Object y){ return divide((Object)x,y); } static public Number divide(Object x, float y){ return divide(x,(Object)y); } static public Number divide(long x, Object y){ return divide((Object)x,y); } static public Number divide(Object x, long y){ return divide(x,(Object)y); } static public Number divide(double x, Object y){ return divide((Object)x,y); } static public Number divide(Object x, double y){ return divide(x,(Object)y); } static public boolean lt(int x, Object y){ return lt((Object)x,y); } static public boolean lt(Object x, int y){ return lt(x,(Object)y); } static public boolean lt(float x, Object y){ return lt((Object)x,y); } static public boolean lt(Object x, float y){ return lt(x,(Object)y); } static public boolean lt(long x, Object y){ return lt((Object)x,y); } static public boolean lt(Object x, long y){ return lt(x,(Object)y); } static public boolean lt(double x, Object y){ return lt((Object)x,y); } static public boolean lt(Object x, double y){ return lt(x,(Object)y); } static public boolean lte(int x, Object y){ return lte((Object)x,y); } static public boolean lte(Object x, int y){ return lte(x,(Object)y); } static public boolean lte(float x, Object y){ return lte((Object)x,y); } static public boolean lte(Object x, float y){ return lte(x,(Object)y); } static public boolean lte(long x, Object y){ return lte((Object)x,y); } static public boolean lte(Object x, long y){ return lte(x,(Object)y); } static public boolean lte(double x, Object y){ return lte((Object)x,y); } static public boolean lte(Object x, double y){ return lte(x,(Object)y); } static public boolean gt(int x, Object y){ return gt((Object)x,y); } static public boolean gt(Object x, int y){ return gt(x,(Object)y); } static public boolean gt(float x, Object y){ return gt((Object)x,y); } static public boolean gt(Object x, float y){ return gt(x,(Object)y); } static public boolean gt(long x, Object y){ return gt((Object)x,y); } static public boolean gt(Object x, long y){ return gt(x,(Object)y); } static public boolean gt(double x, Object y){ return gt((Object)x,y); } static public boolean gt(Object x, double y){ return gt(x,(Object)y); } static public boolean gte(int x, Object y){ return gte((Object)x,y); } static public boolean gte(Object x, int y){ return gte(x,(Object)y); } static public boolean gte(float x, Object y){ return gte((Object)x,y); } static public boolean gte(Object x, float y){ return gte(x,(Object)y); } static public boolean gte(long x, Object y){ return gte((Object)x,y); } static public boolean gte(Object x, long y){ return gte(x,(Object)y); } static public boolean gte(double x, Object y){ return gte((Object)x,y); } static public boolean gte(Object x, double y){ return gte(x,(Object)y); } static public boolean equiv(int x, Object y){ return equiv((Object)x,y); } static public boolean equiv(Object x, int y){ return equiv(x,(Object)y); } static public boolean equiv(float x, Object y){ return equiv((Object)x,y); } static public boolean equiv(Object x, float y){ return equiv(x,(Object)y); } static public boolean equiv(long x, Object y){ return equiv((Object)x,y); } static public boolean equiv(Object x, long y){ return equiv(x,(Object)y); } static public boolean equiv(double x, Object y){ return equiv((Object)x,y); } static public boolean equiv(Object x, double y){ return equiv(x,(Object)y); } static public float add(int x, float y){ return add((float)x,y); } static public float add(float x, int y){ return add(x,(float)y); } static public double add(int x, double y){ return add((double)x,y); } static public double add(double x, int y){ return add(x,(double)y); } static public long add(int x, long y){ return add((long)x,y); } static public long add(long x, int y){ return add(x,(long)y); } static public float add(long x, float y){ return add((float)x,y); } static public float add(float x, long y){ return add(x,(float)y); } static public double add(long x, double y){ return add((double)x,y); } static public double add(double x, long y){ return add(x,(double)y); } static public double add(float x, double y){ return add((double)x,y); } static public double add(double x, float y){ return add(x,(double)y); } static public float minus(int x, float y){ return minus((float)x,y); } static public float minus(float x, int y){ return minus(x,(float)y); } static public double minus(int x, double y){ return minus((double)x,y); } static public double minus(double x, int y){ return minus(x,(double)y); } static public long minus(int x, long y){ return minus((long)x,y); } static public long minus(long x, int y){ return minus(x,(long)y); } static public float minus(long x, float y){ return minus((float)x,y); } static public float minus(float x, long y){ return minus(x,(float)y); } static public double minus(long x, double y){ return minus((double)x,y); } static public double minus(double x, long y){ return minus(x,(double)y); } static public double minus(float x, double y){ return minus((double)x,y); } static public double minus(double x, float y){ return minus(x,(double)y); } static public float multiply(int x, float y){ return multiply((float)x,y); } static public float multiply(float x, int y){ return multiply(x,(float)y); } static public double multiply(int x, double y){ return multiply((double)x,y); } static public double multiply(double x, int y){ return multiply(x,(double)y); } static public long multiply(int x, long y){ return multiply((long)x,y); } static public long multiply(long x, int y){ return multiply(x,(long)y); } static public float multiply(long x, float y){ return multiply((float)x,y); } static public float multiply(float x, long y){ return multiply(x,(float)y); } static public double multiply(long x, double y){ return multiply((double)x,y); } static public double multiply(double x, long y){ return multiply(x,(double)y); } static public double multiply(float x, double y){ return multiply((double)x,y); } static public double multiply(double x, float y){ return multiply(x,(double)y); } static public float divide(int x, float y){ return divide((float)x,y); } static public float divide(float x, int y){ return divide(x,(float)y); } static public double divide(int x, double y){ return divide((double)x,y); } static public double divide(double x, int y){ return divide(x,(double)y); } static public float divide(long x, float y){ return divide((float)x,y); } static public float divide(float x, long y){ return divide(x,(float)y); } static public double divide(long x, double y){ return divide((double)x,y); } static public double divide(double x, long y){ return divide(x,(double)y); } static public double divide(float x, double y){ return divide((double)x,y); } static public double divide(double x, float y){ return divide(x,(double)y); } static public boolean lt(int x, float y){ return lt((float)x,y); } static public boolean lt(float x, int y){ return lt(x,(float)y); } static public boolean lt(int x, double y){ return lt((double)x,y); } static public boolean lt(double x, int y){ return lt(x,(double)y); } static public boolean lt(int x, long y){ return lt((long)x,y); } static public boolean lt(long x, int y){ return lt(x,(long)y); } static public boolean lt(long x, float y){ return lt((float)x,y); } static public boolean lt(float x, long y){ return lt(x,(float)y); } static public boolean lt(long x, double y){ return lt((double)x,y); } static public boolean lt(double x, long y){ return lt(x,(double)y); } static public boolean lt(float x, double y){ return lt((double)x,y); } static public boolean lt(double x, float y){ return lt(x,(double)y); } static public boolean lte(int x, float y){ return lte((float)x,y); } static public boolean lte(float x, int y){ return lte(x,(float)y); } static public boolean lte(int x, double y){ return lte((double)x,y); } static public boolean lte(double x, int y){ return lte(x,(double)y); } static public boolean lte(int x, long y){ return lte((long)x,y); } static public boolean lte(long x, int y){ return lte(x,(long)y); } static public boolean lte(long x, float y){ return lte((float)x,y); } static public boolean lte(float x, long y){ return lte(x,(float)y); } static public boolean lte(long x, double y){ return lte((double)x,y); } static public boolean lte(double x, long y){ return lte(x,(double)y); } static public boolean lte(float x, double y){ return lte((double)x,y); } static public boolean lte(double x, float y){ return lte(x,(double)y); } static public boolean gt(int x, float y){ return gt((float)x,y); } static public boolean gt(float x, int y){ return gt(x,(float)y); } static public boolean gt(int x, double y){ return gt((double)x,y); } static public boolean gt(double x, int y){ return gt(x,(double)y); } static public boolean gt(int x, long y){ return gt((long)x,y); } static public boolean gt(long x, int y){ return gt(x,(long)y); } static public boolean gt(long x, float y){ return gt((float)x,y); } static public boolean gt(float x, long y){ return gt(x,(float)y); } static public boolean gt(long x, double y){ return gt((double)x,y); } static public boolean gt(double x, long y){ return gt(x,(double)y); } static public boolean gt(float x, double y){ return gt((double)x,y); } static public boolean gt(double x, float y){ return gt(x,(double)y); } static public boolean gte(int x, float y){ return gte((float)x,y); } static public boolean gte(float x, int y){ return gte(x,(float)y); } static public boolean gte(int x, double y){ return gte((double)x,y); } static public boolean gte(double x, int y){ return gte(x,(double)y); } static public boolean gte(int x, long y){ return gte((long)x,y); } static public boolean gte(long x, int y){ return gte(x,(long)y); } static public boolean gte(long x, float y){ return gte((float)x,y); } static public boolean gte(float x, long y){ return gte(x,(float)y); } static public boolean gte(long x, double y){ return gte((double)x,y); } static public boolean gte(double x, long y){ return gte(x,(double)y); } static public boolean gte(float x, double y){ return gte((double)x,y); } static public boolean gte(double x, float y){ return gte(x,(double)y); } static public boolean equiv(int x, float y){ return equiv((float)x,y); } static public boolean equiv(float x, int y){ return equiv(x,(float)y); } static public boolean equiv(int x, double y){ return equiv((double)x,y); } static public boolean equiv(double x, int y){ return equiv(x,(double)y); } static public boolean equiv(int x, long y){ return equiv((long)x,y); } static public boolean equiv(long x, int y){ return equiv(x,(long)y); } static public boolean equiv(long x, float y){ return equiv((float)x,y); } static public boolean equiv(float x, long y){ return equiv(x,(float)y); } static public boolean equiv(long x, double y){ return equiv((double)x,y); } static public boolean equiv(double x, long y){ return equiv(x,(double)y); } static public boolean equiv(float x, double y){ return equiv((double)x,y); } static public boolean equiv(double x, float y){ return equiv(x,(double)y); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Obj.java000066400000000000000000000015251157562347600227060ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 25, 2006 3:44:58 PM */ package clojure.lang; import java.io.Serializable; public abstract class Obj implements IObj, Serializable { final IPersistentMap _meta; public Obj(IPersistentMap meta){ this._meta = meta; } public Obj(){ _meta = null; } final public IPersistentMap meta(){ return _meta; } abstract public Obj withMeta(IPersistentMap meta); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentArrayMap.java000066400000000000000000000173071157562347600257760ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.Serializable; import java.util.Arrays; import java.util.Iterator; import java.util.Map; /** * Simple implementation of persistent map on an array *

* Note that instances of this class are constant values * i.e. add/remove etc return new values *

* Copies array on every change, so only appropriate for _very_small_ maps *

* null keys and values are ok, but you won't be able to distinguish a null value via valAt - use contains/entryAt */ public class PersistentArrayMap extends APersistentMap implements IObj, IEditableCollection { final Object[] array; static final int HASHTABLE_THRESHOLD = 16; public static final PersistentArrayMap EMPTY = new PersistentArrayMap(); private final IPersistentMap _meta; static public IPersistentMap create(Map other){ ITransientMap ret = EMPTY.asTransient(); for(Object o : other.entrySet()) { Map.Entry e = (Entry) o; ret = ret.assoc(e.getKey(), e.getValue()); } return ret.persistent(); } protected PersistentArrayMap(){ this.array = new Object[]{}; this._meta = null; } public PersistentArrayMap withMeta(IPersistentMap meta){ return new PersistentArrayMap(meta, array); } PersistentArrayMap create(Object... init){ return new PersistentArrayMap(meta(), init); } IPersistentMap createHT(Object[] init){ return PersistentHashMap.create(meta(), init); } static public PersistentArrayMap createWithCheck(Object[] init){ for(int i=0;i< init.length;i += 2) { for(int j=i+2;j= 0; } public IMapEntry entryAt(Object key){ int i = indexOf(key); if(i >= 0) return new MapEntry(array[i],array[i+1]); return null; } public IPersistentMap assocEx(Object key, Object val) throws Exception{ int i = indexOf(key); Object[] newArray; if(i >= 0) { throw new Exception("Key already present"); } else //didn't have key, grow { if(array.length > HASHTABLE_THRESHOLD) return createHT(array).assocEx(key, val); newArray = new Object[array.length + 2]; if(array.length > 0) System.arraycopy(array, 0, newArray, 2, array.length); newArray[0] = key; newArray[1] = val; } return create(newArray); } public IPersistentMap assoc(Object key, Object val){ int i = indexOf(key); Object[] newArray; if(i >= 0) //already have key, same-sized replacement { if(array[i + 1] == val) //no change, no op return this; newArray = array.clone(); newArray[i + 1] = val; } else //didn't have key, grow { if(array.length > HASHTABLE_THRESHOLD) return createHT(array).assoc(key, val); newArray = new Object[array.length + 2]; if(array.length > 0) System.arraycopy(array, 0, newArray, 2, array.length); newArray[0] = key; newArray[1] = val; } return create(newArray); } public IPersistentMap without(Object key){ int i = indexOf(key); if(i >= 0) //have key, will remove { int newlen = array.length - 2; if(newlen == 0) return empty(); Object[] newArray = new Object[newlen]; for(int s = 0, d = 0; s < array.length; s += 2) { if(!equalKey(array[s], key)) //skip removal key { newArray[d] = array[s]; newArray[d + 1] = array[s + 1]; d += 2; } } return create(newArray); } //don't have key, no op return this; } public IPersistentMap empty(){ return (IPersistentMap) EMPTY.withMeta(meta()); } final public Object valAt(Object key, Object notFound){ int i = indexOf(key); if(i >= 0) return array[i + 1]; return notFound; } public Object valAt(Object key){ return valAt(key, null); } public int capacity(){ return count(); } private int indexOf(Object key){ for(int i = 0; i < array.length; i += 2) { if(equalKey(array[i], key)) return i; } return -1; } static boolean equalKey(Object k1, Object k2){ if(k1 == null) return k2 == null; return k1.equals(k2); } public Iterator iterator(){ return new Iter(array); } public ISeq seq(){ if(array.length > 0) return new Seq(array, 0); return null; } public IPersistentMap meta(){ return _meta; } static class Seq extends ASeq implements Counted{ final Object[] array; final int i; Seq(Object[] array, int i){ this.array = array; this.i = i; } public Seq(IPersistentMap meta, Object[] array, int i){ super(meta); this.array = array; this.i = i; } public Object first(){ return new MapEntry(array[i],array[i+1]); } public ISeq next(){ if(i + 2 < array.length) return new Seq(array, i + 2); return null; } public int count(){ return (array.length - i) / 2; } public Obj withMeta(IPersistentMap meta){ return new Seq(meta, array, i); } } static class Iter implements Iterator{ Object[] array; int i; //for iterator Iter(Object[] array){ this(array, -2); } //for entryAt Iter(Object[] array, int i){ this.array = array; this.i = i; } public boolean hasNext(){ return i < array.length - 2; } public Object next(){ i += 2; return new MapEntry(array[i],array[i+1]); } public void remove(){ throw new UnsupportedOperationException(); } } public ITransientMap asTransient(){ return new TransientArrayMap(array); } static final class TransientArrayMap extends ATransientMap { int len; final Object[] array; Thread owner; public TransientArrayMap(Object[] array){ this.owner = Thread.currentThread(); this.array = new Object[Math.max(HASHTABLE_THRESHOLD, array.length)]; System.arraycopy(array, 0, this.array, 0, array.length); this.len = array.length; } private int indexOf(Object key){ for(int i = 0; i < len; i += 2) { if(equalKey(array[i], key)) return i; } return -1; } ITransientMap doAssoc(Object key, Object val){ int i = indexOf(key); if(i >= 0) //already have key, { if(array[i + 1] != val) //no change, no op array[i + 1] = val; } else //didn't have key, grow { if(len >= array.length) return PersistentHashMap.create(array).asTransient().assoc(key, val); array[len++] = key; array[len++] = val; } return this; } ITransientMap doWithout(Object key) { int i = indexOf(key); if(i >= 0) //have key, will remove { if (len >= 2) { array[i] = array[len - 2]; array[i + 1] = array[len - 1]; } len -= 2; } return this; } Object doValAt(Object key, Object notFound) { int i = indexOf(key); if (i >= 0) return array[i + 1]; return notFound; } int doCount() { return len / 2; } IPersistentMap doPersistent(){ ensureEditable(); owner = null; Object[] a = new Object[len]; System.arraycopy(array,0,a,0,len); return new PersistentArrayMap(a); } void ensureEditable(){ if(owner == Thread.currentThread()) return; if(owner != null) throw new IllegalAccessError("Transient used by non-owner thread"); throw new IllegalAccessError("Transient used after persistent! call"); } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentHashMap.java000066400000000000000000000723511157562347600256030ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.Serializable; import java.util.Iterator; import java.util.List; import java.util.Map; import java.util.concurrent.atomic.AtomicReference; /* A persistent rendition of Phil Bagwell's Hash Array Mapped Trie Uses path copying for persistence HashCollision leaves vs. extended hashing Node polymorphism vs. conditionals No sub-tree pools or root-resizing Any errors are my own */ public class PersistentHashMap extends APersistentMap implements IEditableCollection, IObj { final int count; final INode root; final boolean hasNull; final Object nullValue; final IPersistentMap _meta; final public static PersistentHashMap EMPTY = new PersistentHashMap(0, null, false, null); final private static Object NOT_FOUND = new Object(); static public IPersistentMap create(Map other){ ITransientMap ret = EMPTY.asTransient(); for(Object o : other.entrySet()) { Map.Entry e = (Entry) o; ret = ret.assoc(e.getKey(), e.getValue()); } return ret.persistent(); } /* * @param init {key1,val1,key2,val2,...} */ public static PersistentHashMap create(Object... init){ ITransientMap ret = EMPTY.asTransient(); for(int i = 0; i < init.length; i += 2) { ret = ret.assoc(init[i], init[i + 1]); } return (PersistentHashMap) ret.persistent(); } public static PersistentHashMap createWithCheck(Object... init){ ITransientMap ret = EMPTY.asTransient(); for(int i = 0; i < init.length; i += 2) { ret = ret.assoc(init[i], init[i + 1]); if(ret.count() != i/2 + 1) throw new IllegalArgumentException("Duplicate key: " + init[i]); } return (PersistentHashMap) ret.persistent(); } static public PersistentHashMap create(ISeq items){ ITransientMap ret = EMPTY.asTransient(); for(; items != null; items = items.next().next()) { if(items.next() == null) throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); ret = ret.assoc(items.first(), RT.second(items)); } return (PersistentHashMap) ret.persistent(); } static public PersistentHashMap createWithCheck(ISeq items){ ITransientMap ret = EMPTY.asTransient(); for(int i=0; items != null; items = items.next().next(), ++i) { if(items.next() == null) throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); ret = ret.assoc(items.first(), RT.second(items)); if(ret.count() != i + 1) throw new IllegalArgumentException("Duplicate key: " + items.first()); } return (PersistentHashMap) ret.persistent(); } /* * @param init {key1,val1,key2,val2,...} */ public static PersistentHashMap create(IPersistentMap meta, Object... init){ return create(init).withMeta(meta); } PersistentHashMap(int count, INode root, boolean hasNull, Object nullValue){ this.count = count; this.root = root; this.hasNull = hasNull; this.nullValue = nullValue; this._meta = null; } public PersistentHashMap(IPersistentMap meta, int count, INode root, boolean hasNull, Object nullValue){ this._meta = meta; this.count = count; this.root = root; this.hasNull = hasNull; this.nullValue = nullValue; } public boolean containsKey(Object key){ if(key == null) return hasNull; return (root != null) ? root.find(0, Util.hash(key), key, NOT_FOUND) != NOT_FOUND : false; } public IMapEntry entryAt(Object key){ if(key == null) return hasNull ? new MapEntry(null, nullValue) : null; return (root != null) ? root.find(0, Util.hash(key), key) : null; } public IPersistentMap assoc(Object key, Object val){ if(key == null) { if(hasNull && val == nullValue) return this; return new PersistentHashMap(meta(), hasNull ? count : count + 1, root, true, val); } Box addedLeaf = new Box(null); INode newroot = (root == null ? BitmapIndexedNode.EMPTY : root) .assoc(0, Util.hash(key), key, val, addedLeaf); if(newroot == root) return this; return new PersistentHashMap(meta(), addedLeaf.val == null ? count : count + 1, newroot, hasNull, nullValue); } public Object valAt(Object key, Object notFound){ if(key == null) return hasNull ? nullValue : notFound; return root != null ? root.find(0, Util.hash(key), key, notFound) : notFound; } public Object valAt(Object key){ return valAt(key, null); } public IPersistentMap assocEx(Object key, Object val) throws Exception{ if(containsKey(key)) throw new Exception("Key already present"); return assoc(key, val); } public IPersistentMap without(Object key){ if(key == null) return hasNull ? new PersistentHashMap(meta(), count - 1, root, false, null) : this; if(root == null) return this; INode newroot = root.without(0, Util.hash(key), key); if(newroot == root) return this; return new PersistentHashMap(meta(), count - 1, newroot, hasNull, nullValue); } public Iterator iterator(){ return new SeqIterator(seq()); } public int count(){ return count; } public ISeq seq(){ ISeq s = root != null ? root.nodeSeq() : null; return hasNull ? new Cons(new MapEntry(null, nullValue), s) : s; } public IPersistentCollection empty(){ return EMPTY.withMeta(meta()); } static int mask(int hash, int shift){ //return ((hash << shift) >>> 27);// & 0x01f; return (hash >>> shift) & 0x01f; } public PersistentHashMap withMeta(IPersistentMap meta){ return new PersistentHashMap(meta, count, root, hasNull, nullValue); } public TransientHashMap asTransient() { return new TransientHashMap(this); } public IPersistentMap meta(){ return _meta; } static final class TransientHashMap extends ATransientMap { AtomicReference edit; INode root; int count; boolean hasNull; Object nullValue; final Box leafFlag = new Box(null); TransientHashMap(PersistentHashMap m) { this(new AtomicReference(Thread.currentThread()), m.root, m.count, m.hasNull, m.nullValue); } TransientHashMap(AtomicReference edit, INode root, int count, boolean hasNull, Object nullValue) { this.edit = edit; this.root = root; this.count = count; this.hasNull = hasNull; this.nullValue = nullValue; } ITransientMap doAssoc(Object key, Object val) { if (key == null) { if (this.nullValue != val) this.nullValue = val; if (!hasNull) { this.count++; this.hasNull = true; } return this; } // Box leafFlag = new Box(null); leafFlag.val = null; INode n = (root == null ? BitmapIndexedNode.EMPTY : root) .assoc(edit, 0, Util.hash(key), key, val, leafFlag); if (n != this.root) this.root = n; if(leafFlag.val != null) this.count++; return this; } ITransientMap doWithout(Object key) { if (key == null) { if (!hasNull) return this; hasNull = false; nullValue = null; this.count--; return this; } if (root == null) return this; // Box leafFlag = new Box(null); leafFlag.val = null; INode n = root.without(edit, 0, Util.hash(key), key, leafFlag); if (n != root) this.root = n; if(leafFlag.val != null) this.count--; return this; } IPersistentMap doPersistent() { edit.set(null); return new PersistentHashMap(count, root, hasNull, nullValue); } Object doValAt(Object key, Object notFound) { if (key == null) if (hasNull) return nullValue; else return notFound; if (root == null) return null; return root.find(0, Util.hash(key), key, notFound); } int doCount() { return count; } void ensureEditable(){ Thread owner = edit.get(); if(owner == Thread.currentThread()) return; if(owner != null) throw new IllegalAccessError("Transient used by non-owner thread"); throw new IllegalAccessError("Transient used after persistent! call"); } } static interface INode extends Serializable { INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf); INode without(int shift, int hash, Object key); IMapEntry find(int shift, int hash, Object key); Object find(int shift, int hash, Object key, Object notFound); ISeq nodeSeq(); INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf); INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf); } final static class ArrayNode implements INode{ int count; final INode[] array; final AtomicReference edit; ArrayNode(AtomicReference edit, int count, INode[] array){ this.array = array; this.edit = edit; this.count = count; } public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){ int idx = mask(hash, shift); INode node = array[idx]; if(node == null) return new ArrayNode(null, count + 1, cloneAndSet(array, idx, BitmapIndexedNode.EMPTY.assoc(shift + 5, hash, key, val, addedLeaf))); INode n = node.assoc(shift + 5, hash, key, val, addedLeaf); if(n == node) return this; return new ArrayNode(null, count, cloneAndSet(array, idx, n)); } public INode without(int shift, int hash, Object key){ int idx = mask(hash, shift); INode node = array[idx]; if(node == null) return this; INode n = node.without(shift + 5, hash, key); if(n == node) return this; if (n == null) { if (count <= 8) // shrink return pack(null, idx); return new ArrayNode(null, count - 1, cloneAndSet(array, idx, n)); } else return new ArrayNode(null, count, cloneAndSet(array, idx, n)); } public IMapEntry find(int shift, int hash, Object key){ int idx = mask(hash, shift); INode node = array[idx]; if(node == null) return null; return node.find(shift + 5, hash, key); } public Object find(int shift, int hash, Object key, Object notFound){ int idx = mask(hash, shift); INode node = array[idx]; if(node == null) return notFound; return node.find(shift + 5, hash, key, notFound); } public ISeq nodeSeq(){ return Seq.create(array); } private ArrayNode ensureEditable(AtomicReference edit){ if(this.edit == edit) return this; return new ArrayNode(edit, count, this.array.clone()); } private ArrayNode editAndSet(AtomicReference edit, int i, INode n){ ArrayNode editable = ensureEditable(edit); editable.array[i] = n; return editable; } private INode pack(AtomicReference edit, int idx) { Object[] newArray = new Object[2*(count - 1)]; int j = 1; int bitmap = 0; for(int i = 0; i < idx; i++) if (array[i] != null) { newArray[j] = array[i]; bitmap |= 1 << i; j += 2; } for(int i = idx + 1; i < array.length; i++) if (array[i] != null) { newArray[j] = array[i]; bitmap |= 1 << i; j += 2; } return new BitmapIndexedNode(edit, bitmap, newArray); } public INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf){ int idx = mask(hash, shift); INode node = array[idx]; if(node == null) { ArrayNode editable = editAndSet(edit, idx, BitmapIndexedNode.EMPTY.assoc(edit, shift + 5, hash, key, val, addedLeaf)); editable.count++; return editable; } INode n = node.assoc(edit, shift + 5, hash, key, val, addedLeaf); if(n == node) return this; return editAndSet(edit, idx, n); } public INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf){ int idx = mask(hash, shift); INode node = array[idx]; if(node == null) return this; INode n = node.without(edit, shift + 5, hash, key, removedLeaf); if(n == node) return this; if(n == null) { if (count <= 8) // shrink return pack(edit, idx); ArrayNode editable = editAndSet(edit, idx, n); editable.count--; return editable; } return editAndSet(edit, idx, n); } static class Seq extends ASeq { final INode[] nodes; final int i; final ISeq s; static ISeq create(INode[] nodes) { return create(null, nodes, 0, null); } private static ISeq create(IPersistentMap meta, INode[] nodes, int i, ISeq s) { if (s != null) return new Seq(meta, nodes, i, s); for(int j = i; j < nodes.length; j++) if (nodes[j] != null) { ISeq ns = nodes[j].nodeSeq(); if (ns != null) return new Seq(meta, nodes, j + 1, ns); } return null; } private Seq(IPersistentMap meta, INode[] nodes, int i, ISeq s) { super(meta); this.nodes = nodes; this.i = i; this.s = s; } public Obj withMeta(IPersistentMap meta) { return new Seq(meta, nodes, i, s); } public Object first() { return s.first(); } public ISeq next() { return create(null, nodes, i, s.next()); } } } final static class BitmapIndexedNode implements INode{ static final BitmapIndexedNode EMPTY = new BitmapIndexedNode(null, 0, new Object[0]); int bitmap; Object[] array; final AtomicReference edit; final int index(int bit){ return Integer.bitCount(bitmap & (bit - 1)); } BitmapIndexedNode(AtomicReference edit, int bitmap, Object[] array){ this.bitmap = bitmap; this.array = array; this.edit = edit; } public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){ int bit = bitpos(hash, shift); int idx = index(bit); if((bitmap & bit) != 0) { Object keyOrNull = array[2*idx]; Object valOrNode = array[2*idx+1]; if(keyOrNull == null) { INode n = ((INode) valOrNode).assoc(shift + 5, hash, key, val, addedLeaf); if(n == valOrNode) return this; return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, n)); } if(Util.equals(key, keyOrNull)) { if(val == valOrNode) return this; return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, val)); } addedLeaf.val = addedLeaf; return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx, null, 2*idx+1, createNode(shift + 5, keyOrNull, valOrNode, hash, key, val))); } else { int n = Integer.bitCount(bitmap); if(n >= 16) { INode[] nodes = new INode[32]; int jdx = mask(hash, shift); nodes[jdx] = EMPTY.assoc(shift + 5, hash, key, val, addedLeaf); int j = 0; for(int i = 0; i < 32; i++) if(((bitmap >>> i) & 1) != 0) { if (array[j] == null) nodes[i] = (INode) array[j+1]; else nodes[i] = EMPTY.assoc(shift + 5, Util.hash(array[j]), array[j], array[j+1], addedLeaf); j += 2; } return new ArrayNode(null, n + 1, nodes); } else { Object[] newArray = new Object[2*(n+1)]; System.arraycopy(array, 0, newArray, 0, 2*idx); newArray[2*idx] = key; addedLeaf.val = addedLeaf; newArray[2*idx+1] = val; System.arraycopy(array, 2*idx, newArray, 2*(idx+1), 2*(n-idx)); return new BitmapIndexedNode(null, bitmap | bit, newArray); } } } public INode without(int shift, int hash, Object key){ int bit = bitpos(hash, shift); if((bitmap & bit) == 0) return this; int idx = index(bit); Object keyOrNull = array[2*idx]; Object valOrNode = array[2*idx+1]; if(keyOrNull == null) { INode n = ((INode) valOrNode).without(shift + 5, hash, key); if (n == valOrNode) return this; if (n != null) return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, n)); if (bitmap == bit) return null; return new BitmapIndexedNode(null, bitmap ^ bit, removePair(array, idx)); } if(Util.equals(key, keyOrNull)) // TODO: collapse return new BitmapIndexedNode(null, bitmap ^ bit, removePair(array, idx)); return this; } public IMapEntry find(int shift, int hash, Object key){ int bit = bitpos(hash, shift); if((bitmap & bit) == 0) return null; int idx = index(bit); Object keyOrNull = array[2*idx]; Object valOrNode = array[2*idx+1]; if(keyOrNull == null) return ((INode) valOrNode).find(shift + 5, hash, key); if(Util.equals(key, keyOrNull)) return new MapEntry(keyOrNull, valOrNode); return null; } public Object find(int shift, int hash, Object key, Object notFound){ int bit = bitpos(hash, shift); if((bitmap & bit) == 0) return notFound; int idx = index(bit); Object keyOrNull = array[2*idx]; Object valOrNode = array[2*idx+1]; if(keyOrNull == null) return ((INode) valOrNode).find(shift + 5, hash, key, notFound); if(Util.equals(key, keyOrNull)) return valOrNode; return notFound; } public ISeq nodeSeq(){ return NodeSeq.create(array); } private BitmapIndexedNode ensureEditable(AtomicReference edit){ if(this.edit == edit) return this; int n = Integer.bitCount(bitmap); Object[] newArray = new Object[n >= 0 ? 2*(n+1) : 4]; // make room for next assoc System.arraycopy(array, 0, newArray, 0, 2*n); return new BitmapIndexedNode(edit, bitmap, newArray); } private BitmapIndexedNode editAndSet(AtomicReference edit, int i, Object a) { BitmapIndexedNode editable = ensureEditable(edit); editable.array[i] = a; return editable; } private BitmapIndexedNode editAndSet(AtomicReference edit, int i, Object a, int j, Object b) { BitmapIndexedNode editable = ensureEditable(edit); editable.array[i] = a; editable.array[j] = b; return editable; } private BitmapIndexedNode editAndRemovePair(AtomicReference edit, int bit, int i) { if (bitmap == bit) return null; BitmapIndexedNode editable = ensureEditable(edit); editable.bitmap ^= bit; System.arraycopy(editable.array, 2*(i+1), editable.array, 2*i, editable.array.length - 2*(i+1)); editable.array[editable.array.length - 2] = null; editable.array[editable.array.length - 1] = null; return editable; } public INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf){ int bit = bitpos(hash, shift); int idx = index(bit); if((bitmap & bit) != 0) { Object keyOrNull = array[2*idx]; Object valOrNode = array[2*idx+1]; if(keyOrNull == null) { INode n = ((INode) valOrNode).assoc(edit, shift + 5, hash, key, val, addedLeaf); if(n == valOrNode) return this; return editAndSet(edit, 2*idx+1, n); } if(Util.equals(key, keyOrNull)) { if(val == valOrNode) return this; return editAndSet(edit, 2*idx+1, val); } addedLeaf.val = addedLeaf; return editAndSet(edit, 2*idx, null, 2*idx+1, createNode(edit, shift + 5, keyOrNull, valOrNode, hash, key, val)); } else { int n = Integer.bitCount(bitmap); if(n*2 < array.length) { addedLeaf.val = addedLeaf; BitmapIndexedNode editable = ensureEditable(edit); System.arraycopy(editable.array, 2*idx, editable.array, 2*(idx+1), 2*(n-idx)); editable.array[2*idx] = key; editable.array[2*idx+1] = val; editable.bitmap |= bit; return editable; } if(n >= 16) { INode[] nodes = new INode[32]; int jdx = mask(hash, shift); nodes[jdx] = EMPTY.assoc(edit, shift + 5, hash, key, val, addedLeaf); int j = 0; for(int i = 0; i < 32; i++) if(((bitmap >>> i) & 1) != 0) { if (array[j] == null) nodes[i] = (INode) array[j+1]; else nodes[i] = EMPTY.assoc(edit, shift + 5, Util.hash(array[j]), array[j], array[j+1], addedLeaf); j += 2; } return new ArrayNode(edit, n + 1, nodes); } else { Object[] newArray = new Object[2*(n+4)]; System.arraycopy(array, 0, newArray, 0, 2*idx); newArray[2*idx] = key; addedLeaf.val = addedLeaf; newArray[2*idx+1] = val; System.arraycopy(array, 2*idx, newArray, 2*(idx+1), 2*(n-idx)); BitmapIndexedNode editable = ensureEditable(edit); editable.array = newArray; editable.bitmap |= bit; return editable; } } } public INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf){ int bit = bitpos(hash, shift); if((bitmap & bit) == 0) return this; int idx = index(bit); Object keyOrNull = array[2*idx]; Object valOrNode = array[2*idx+1]; if(keyOrNull == null) { INode n = ((INode) valOrNode).without(edit, shift + 5, hash, key, removedLeaf); if (n == valOrNode) return this; if (n != null) return editAndSet(edit, 2*idx+1, n); if (bitmap == bit) return null; removedLeaf.val = removedLeaf; return editAndRemovePair(edit, bit, idx); } if(Util.equals(key, keyOrNull)) { removedLeaf.val = removedLeaf; // TODO: collapse return editAndRemovePair(edit, bit, idx); } return this; } } final static class HashCollisionNode implements INode{ final int hash; int count; Object[] array; final AtomicReference edit; HashCollisionNode(AtomicReference edit, int hash, int count, Object... array){ this.edit = edit; this.hash = hash; this.count = count; this.array = array; } public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){ if(hash == this.hash) { int idx = findIndex(key); if(idx != -1) { if(array[idx + 1] == val) return this; return new HashCollisionNode(null, hash, count, cloneAndSet(array, idx + 1, val)); } Object[] newArray = new Object[array.length + 2]; System.arraycopy(array, 0, newArray, 0, array.length); newArray[array.length] = key; newArray[array.length + 1] = val; addedLeaf.val = addedLeaf; return new HashCollisionNode(edit, hash, count + 1, newArray); } // nest it in a bitmap node return new BitmapIndexedNode(null, bitpos(this.hash, shift), new Object[] {null, this}) .assoc(shift, hash, key, val, addedLeaf); } public INode without(int shift, int hash, Object key){ int idx = findIndex(key); if(idx == -1) return this; if(count == 1) return null; return new HashCollisionNode(null, hash, count - 1, removePair(array, idx/2)); } public IMapEntry find(int shift, int hash, Object key){ int idx = findIndex(key); if(idx < 0) return null; if(Util.equals(key, array[idx])) return new MapEntry(array[idx], array[idx+1]); return null; } public Object find(int shift, int hash, Object key, Object notFound){ int idx = findIndex(key); if(idx < 0) return notFound; if(Util.equals(key, array[idx])) return array[idx+1]; return notFound; } public ISeq nodeSeq(){ return NodeSeq.create(array); } public int findIndex(Object key){ for(int i = 0; i < 2*count; i+=2) { if(Util.equals(key, array[i])) return i; } return -1; } private HashCollisionNode ensureEditable(AtomicReference edit){ if(this.edit == edit) return this; return new HashCollisionNode(edit, hash, count, array); } private HashCollisionNode ensureEditable(AtomicReference edit, int count, Object[] array){ if(this.edit == edit) { this.array = array; this.count = count; return this; } return new HashCollisionNode(edit, hash, count, array); } private HashCollisionNode editAndSet(AtomicReference edit, int i, Object a) { HashCollisionNode editable = ensureEditable(edit); editable.array[i] = a; return editable; } private HashCollisionNode editAndSet(AtomicReference edit, int i, Object a, int j, Object b) { HashCollisionNode editable = ensureEditable(edit); editable.array[i] = a; editable.array[j] = b; return editable; } public INode assoc(AtomicReference edit, int shift, int hash, Object key, Object val, Box addedLeaf){ if(hash == this.hash) { int idx = findIndex(key); if(idx != -1) { if(array[idx + 1] == val) return this; return editAndSet(edit, idx+1, val); } if (array.length > 2*count) { addedLeaf.val = addedLeaf; HashCollisionNode editable = editAndSet(edit, 2*count, key, 2*count+1, val); editable.count++; return editable; } Object[] newArray = new Object[array.length + 2]; System.arraycopy(array, 0, newArray, 0, array.length); newArray[array.length] = key; newArray[array.length + 1] = val; addedLeaf.val = addedLeaf; return ensureEditable(edit, count + 1, newArray); } // nest it in a bitmap node return new BitmapIndexedNode(edit, bitpos(this.hash, shift), new Object[] {null, this, null, null}) .assoc(edit, shift, hash, key, val, addedLeaf); } public INode without(AtomicReference edit, int shift, int hash, Object key, Box removedLeaf){ int idx = findIndex(key); if(idx == -1) return this; if(count == 1) return null; HashCollisionNode editable = ensureEditable(edit); editable.array[idx] = editable.array[2*count-2]; editable.array[idx+1] = editable.array[2*count-1]; editable.array[2*count-2] = editable.array[2*count-1] = null; editable.count--; return editable; } } /* public static void main(String[] args){ try { ArrayList words = new ArrayList(); Scanner s = new Scanner(new File(args[0])); s.useDelimiter(Pattern.compile("\\W")); while(s.hasNext()) { String word = s.next(); words.add(word); } System.out.println("words: " + words.size()); IPersistentMap map = PersistentHashMap.EMPTY; //IPersistentMap map = new PersistentTreeMap(); //Map ht = new Hashtable(); Map ht = new HashMap(); Random rand; System.out.println("Building map"); long startTime = System.nanoTime(); for(Object word5 : words) { map = map.assoc(word5, word5); } rand = new Random(42); IPersistentMap snapshotMap = map; for(int i = 0; i < words.size() / 200; i++) { map = map.without(words.get(rand.nextInt(words.size() / 2))); } long estimatedTime = System.nanoTime() - startTime; System.out.println("count = " + map.count() + ", time: " + estimatedTime / 1000000); System.out.println("Building ht"); startTime = System.nanoTime(); for(Object word1 : words) { ht.put(word1, word1); } rand = new Random(42); for(int i = 0; i < words.size() / 200; i++) { ht.remove(words.get(rand.nextInt(words.size() / 2))); } estimatedTime = System.nanoTime() - startTime; System.out.println("count = " + ht.size() + ", time: " + estimatedTime / 1000000); System.out.println("map lookup"); startTime = System.nanoTime(); int c = 0; for(Object word2 : words) { if(!map.contains(word2)) ++c; } estimatedTime = System.nanoTime() - startTime; System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); System.out.println("ht lookup"); startTime = System.nanoTime(); c = 0; for(Object word3 : words) { if(!ht.containsKey(word3)) ++c; } estimatedTime = System.nanoTime() - startTime; System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); System.out.println("snapshotMap lookup"); startTime = System.nanoTime(); c = 0; for(Object word4 : words) { if(!snapshotMap.contains(word4)) ++c; } estimatedTime = System.nanoTime() - startTime; System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); } catch(FileNotFoundException e) { e.printStackTrace(); } } */ private static INode[] cloneAndSet(INode[] array, int i, INode a) { INode[] clone = array.clone(); clone[i] = a; return clone; } private static Object[] cloneAndSet(Object[] array, int i, Object a) { Object[] clone = array.clone(); clone[i] = a; return clone; } private static Object[] cloneAndSet(Object[] array, int i, Object a, int j, Object b) { Object[] clone = array.clone(); clone[i] = a; clone[j] = b; return clone; } private static Object[] removePair(Object[] array, int i) { Object[] newArray = new Object[array.length - 2]; System.arraycopy(array, 0, newArray, 0, 2*i); System.arraycopy(array, 2*(i+1), newArray, 2*i, newArray.length - 2*i); return newArray; } private static INode createNode(int shift, Object key1, Object val1, int key2hash, Object key2, Object val2) { int key1hash = Util.hash(key1); if(key1hash == key2hash) return new HashCollisionNode(null, key1hash, 2, new Object[] {key1, val1, key2, val2}); Box _ = new Box(null); AtomicReference edit = new AtomicReference(); return BitmapIndexedNode.EMPTY .assoc(edit, shift, key1hash, key1, val1, _) .assoc(edit, shift, key2hash, key2, val2, _); } private static INode createNode(AtomicReference edit, int shift, Object key1, Object val1, int key2hash, Object key2, Object val2) { int key1hash = Util.hash(key1); if(key1hash == key2hash) return new HashCollisionNode(null, key1hash, 2, new Object[] {key1, val1, key2, val2}); Box _ = new Box(null); return BitmapIndexedNode.EMPTY .assoc(edit, shift, key1hash, key1, val1, _) .assoc(edit, shift, key2hash, key2, val2, _); } private static int bitpos(int hash, int shift){ return 1 << mask(hash, shift); } static final class NodeSeq extends ASeq { final Object[] array; final int i; final ISeq s; NodeSeq(Object[] array, int i) { this(null, array, i, null); } static ISeq create(Object[] array) { return create(array, 0, null); } private static ISeq create(Object[] array, int i, ISeq s) { if(s != null) return new NodeSeq(null, array, i, s); for(int j = i; j < array.length; j+=2) { if(array[j] != null) return new NodeSeq(null, array, j, null); INode node = (INode) array[j+1]; if (node != null) { ISeq nodeSeq = node.nodeSeq(); if(nodeSeq != null) return new NodeSeq(null, array, j + 2, nodeSeq); } } return null; } NodeSeq(IPersistentMap meta, Object[] array, int i, ISeq s) { super(meta); this.array = array; this.i = i; this.s = s; } public Obj withMeta(IPersistentMap meta) { return new NodeSeq(meta, array, i, s); } public Object first() { if(s != null) return s.first(); return new MapEntry(array[i], array[i+1]); } public ISeq next() { if(s != null) return create(array, i, s.next()); return create(array, i + 2, null); } } }clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentHashSet.java000066400000000000000000000062301157562347600256120ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; import java.util.List; public class PersistentHashSet extends APersistentSet implements IObj, IEditableCollection { static public final PersistentHashSet EMPTY = new PersistentHashSet(null, PersistentHashMap.EMPTY); final IPersistentMap _meta; public static PersistentHashSet create(Object... init){ PersistentHashSet ret = EMPTY; for(int i = 0; i < init.length; i++) { ret = (PersistentHashSet) ret.cons(init[i]); } return ret; } public static PersistentHashSet create(List init){ PersistentHashSet ret = EMPTY; for(Object key : init) { ret = (PersistentHashSet) ret.cons(key); } return ret; } static public PersistentHashSet create(ISeq items){ PersistentHashSet ret = EMPTY; for(; items != null; items = items.next()) { ret = (PersistentHashSet) ret.cons(items.first()); } return ret; } public static PersistentHashSet createWithCheck(Object... init){ PersistentHashSet ret = EMPTY; for(int i = 0; i < init.length; i++) { ret = (PersistentHashSet) ret.cons(init[i]); if(ret.count() != i + 1) throw new IllegalArgumentException("Duplicate key: " + init[i]); } return ret; } public static PersistentHashSet createWithCheck(List init){ PersistentHashSet ret = EMPTY; int i=0; for(Object key : init) { ret = (PersistentHashSet) ret.cons(key); if(ret.count() != i + 1) throw new IllegalArgumentException("Duplicate key: " + key); ++i; } return ret; } static public PersistentHashSet createWithCheck(ISeq items){ PersistentHashSet ret = EMPTY; for(int i=0; items != null; items = items.next(), ++i) { ret = (PersistentHashSet) ret.cons(items.first()); if(ret.count() != i + 1) throw new IllegalArgumentException("Duplicate key: " + items.first()); } return ret; } PersistentHashSet(IPersistentMap meta, IPersistentMap impl){ super(impl); this._meta = meta; } public IPersistentSet disjoin(Object key) throws Exception{ if(contains(key)) return new PersistentHashSet(meta(),impl.without(key)); return this; } public IPersistentSet cons(Object o){ if(contains(o)) return this; return new PersistentHashSet(meta(),impl.assoc(o,o)); } public IPersistentCollection empty(){ return EMPTY.withMeta(meta()); } public PersistentHashSet withMeta(IPersistentMap meta){ return new PersistentHashSet(meta, impl); } public ITransientCollection asTransient() { return new TransientHashSet(((PersistentHashMap) impl).asTransient()); } public IPersistentMap meta(){ return _meta; } static final class TransientHashSet extends ATransientSet { TransientHashSet(ITransientMap impl) { super(impl); } public IPersistentCollection persistent() { return new PersistentHashSet(null, impl.persistent()); } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentList.java000066400000000000000000000142341157562347600251710ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.io.Serializable; import java.util.*; public class PersistentList extends ASeq implements IPersistentList, IReduce, List, Counted { private final Object _first; private final IPersistentList _rest; private final int _count; public static IFn creator = new RestFn(){ final public int getRequiredArity(){ return 0; } final protected Object doInvoke(Object args) throws Exception{ if(args instanceof ArraySeq) { Object[] argsarray = (Object[]) ((ArraySeq) args).array; IPersistentList ret = EMPTY; for(int i = argsarray.length - 1; i >= 0; --i) ret = (IPersistentList) ret.cons(argsarray[i]); return ret; } LinkedList list = new LinkedList(); for(ISeq s = RT.seq(args); s != null; s = s.next()) list.add(s.first()); return create(list); } public IObj withMeta(IPersistentMap meta){ throw new UnsupportedOperationException(); } public IPersistentMap meta(){ return null; } }; final public static EmptyList EMPTY = new EmptyList(null); public PersistentList(Object first){ this._first = first; this._rest = null; this._count = 1; } PersistentList(IPersistentMap meta, Object _first, IPersistentList _rest, int _count){ super(meta); this._first = _first; this._rest = _rest; this._count = _count; } public static IPersistentList create(List init){ IPersistentList ret = EMPTY; for(ListIterator i = init.listIterator(init.size()); i.hasPrevious();) { ret = (IPersistentList) ret.cons(i.previous()); } return ret; } public Object first(){ return _first; } public ISeq next(){ if(_count == 1) return null; return (ISeq) _rest; } public Object peek(){ return first(); } public IPersistentList pop(){ if(_rest == null) return EMPTY.withMeta(_meta); return _rest; } public int count(){ return _count; } public PersistentList cons(Object o){ return new PersistentList(meta(), o, this, _count + 1); } public IPersistentCollection empty(){ return EMPTY.withMeta(meta()); } public PersistentList withMeta(IPersistentMap meta){ if(meta != _meta) return new PersistentList(meta, _first, _rest, _count); return this; } public Object reduce(IFn f) throws Exception{ Object ret = first(); for(ISeq s = next(); s != null; s = s.next()) ret = f.invoke(ret, s.first()); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start, first()); for(ISeq s = next(); s != null; s = s.next()) ret = f.invoke(ret, s.first()); return ret; } static class EmptyList extends Obj implements IPersistentList, List, ISeq, Counted{ public int hashCode(){ return 1; } public boolean equals(Object o) { return (o instanceof Sequential || o instanceof List) && RT.seq(o) == null; } public boolean equiv(Object o){ return equals(o); } EmptyList(IPersistentMap meta){ super(meta); } public Object first() { return null; } public ISeq next() { return null; } public ISeq more() { return this; } public PersistentList cons(Object o){ return new PersistentList(meta(), o, null, 1); } public IPersistentCollection empty(){ return this; } public EmptyList withMeta(IPersistentMap meta){ if(meta != meta()) return new EmptyList(meta); return this; } public Object peek(){ return null; } public IPersistentList pop(){ throw new IllegalStateException("Can't pop empty list"); } public int count(){ return 0; } public ISeq seq(){ return null; } public int size(){ return 0; } public boolean isEmpty(){ return true; } public boolean contains(Object o){ return false; } public Iterator iterator(){ return new Iterator(){ public boolean hasNext(){ return false; } public Object next(){ throw new NoSuchElementException(); } public void remove(){ throw new UnsupportedOperationException(); } }; } public Object[] toArray(){ return RT.EMPTY_ARRAY; } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection collection){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection collection){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection collection){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection collection){ return collection.isEmpty(); } public Object[] toArray(Object[] objects){ if(objects.length > 0) objects[0] = null; return objects; } //////////// List stuff ///////////////// private List reify(){ return Collections.unmodifiableList(new ArrayList(this)); } public List subList(int fromIndex, int toIndex){ return reify().subList(fromIndex, toIndex); } public Object set(int index, Object element){ throw new UnsupportedOperationException(); } public Object remove(int index){ throw new UnsupportedOperationException(); } public int indexOf(Object o){ ISeq s = seq(); for(int i = 0; s != null; s = s.next(), i++) { if(Util.equiv(s.first(), o)) return i; } return -1; } public int lastIndexOf(Object o){ return reify().lastIndexOf(o); } public ListIterator listIterator(){ return reify().listIterator(); } public ListIterator listIterator(int index){ return reify().listIterator(index); } public Object get(int index){ return RT.nth(this, index); } public void add(int index, Object element){ throw new UnsupportedOperationException(); } public boolean addAll(int index, Collection c){ throw new UnsupportedOperationException(); } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentQueue.java000066400000000000000000000146051157562347600253440ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; import java.util.Collection; import java.util.Iterator; //import java.util.concurrent.ConcurrentLinkedQueue; /** * conses onto rear, peeks/pops from front * See Okasaki's Batched Queues * This differs in that it uses a PersistentArrayList as the rear, which is in-order, * so no reversing or suspensions required for persistent use */ public class PersistentQueue extends Obj implements IPersistentList, Collection{ final public static PersistentQueue EMPTY = new PersistentQueue(null, null, null); //* final ISeq f; final PersistentVector r; //static final int INITIAL_REAR_SIZE = 4; int _hash = -1; PersistentQueue(IPersistentMap meta, ISeq f, PersistentVector r){ super(meta); this.f = f; this.r = r; } public boolean equiv(Object obj){ if(!(obj instanceof Sequential)) return false; ISeq ms = RT.seq(obj); for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) { if(ms == null || !Util.equiv(s.first(), ms.first())) return false; } return ms == null; } public boolean equals(Object obj){ if(!(obj instanceof Sequential)) return false; ISeq ms = RT.seq(obj); for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next()) { if(ms == null || !Util.equals(s.first(), ms.first())) return false; } return ms == null; } public int hashCode(){ if(_hash == -1) { int hash = 0; for(ISeq s = seq(); s != null; s = s.next()) { hash = Util.hashCombine(hash, Util.hash(s.first())); } this._hash = hash; } return _hash; } public Object peek(){ return RT.first(f); } public PersistentQueue pop(){ if(f == null) //hmmm... pop of empty queue -> empty queue? return this; //throw new IllegalStateException("popping empty queue"); ISeq f1 = f.next(); PersistentVector r1 = r; if(f1 == null) { f1 = RT.seq(r); r1 = null; } return new PersistentQueue(meta(), f1, r1); } public int count(){ return RT.count(f) + RT.count(r); } public ISeq seq(){ if(f == null) return null; return new Seq(f, RT.seq(r)); } public PersistentQueue cons(Object o){ if(f == null) //empty return new PersistentQueue(meta(), RT.list(o), null); else return new PersistentQueue(meta(), f, (r != null ? r : PersistentVector.EMPTY).cons(o)); } public IPersistentCollection empty(){ return EMPTY.withMeta(meta()); } public PersistentQueue withMeta(IPersistentMap meta){ return new PersistentQueue(meta, f, r); } static class Seq extends ASeq{ final ISeq f; final ISeq rseq; Seq(ISeq f, ISeq rseq){ this.f = f; this.rseq = rseq; } Seq(IPersistentMap meta, ISeq f, ISeq rseq){ super(meta); this.f = f; this.rseq = rseq; } public Object first(){ return f.first(); } public ISeq next(){ ISeq f1 = f.next(); ISeq r1 = rseq; if(f1 == null) { if(rseq == null) return null; f1 = rseq; r1 = null; } return new Seq(f1, r1); } public int count(){ return RT.count(f) + RT.count(rseq); } public Seq withMeta(IPersistentMap meta){ return new Seq(meta, f, rseq); } } // java.util.Collection implementation public Object[] toArray(){ return RT.seqToArray(seq()); } public boolean add(Object o){ throw new UnsupportedOperationException(); } public boolean remove(Object o){ throw new UnsupportedOperationException(); } public boolean addAll(Collection c){ throw new UnsupportedOperationException(); } public void clear(){ throw new UnsupportedOperationException(); } public boolean retainAll(Collection c){ throw new UnsupportedOperationException(); } public boolean removeAll(Collection c){ throw new UnsupportedOperationException(); } public boolean containsAll(Collection c){ for(Object o : c) { if(contains(o)) return true; } return false; } public Object[] toArray(Object[] a){ if(a.length >= count()) { ISeq s = seq(); for(int i = 0; s != null; ++i, s = s.next()) { a[i] = s.first(); } if(a.length >= count()) a[count()] = null; return a; } else return toArray(); } public int size(){ return count(); } public boolean isEmpty(){ return count() == 0; } public boolean contains(Object o){ for(ISeq s = seq(); s != null; s = s.next()) { if(Util.equiv(s.first(), o)) return true; } return false; } public Iterator iterator(){ return new SeqIterator(seq()); } /* public static void main(String[] args){ if(args.length != 1) { System.err.println("Usage: PersistentQueue n"); return; } int n = Integer.parseInt(args[0]); long startTime, estimatedTime; Queue list = new LinkedList(); //Queue list = new ConcurrentLinkedQueue(); System.out.println("Queue"); startTime = System.nanoTime(); for(int i = 0; i < n; i++) { list.add(i); list.add(i); list.remove(); } for(int i = 0; i < n - 10; i++) { list.remove(); } estimatedTime = System.nanoTime() - startTime; System.out.println("time: " + estimatedTime / 1000000); System.out.println("peek: " + list.peek()); PersistentQueue q = PersistentQueue.EMPTY; System.out.println("PersistentQueue"); startTime = System.nanoTime(); for(int i = 0; i < n; i++) { q = q.cons(i); q = q.cons(i); q = q.pop(); } // IPersistentList lastq = null; // IPersistentList lastq2; for(int i = 0; i < n - 10; i++) { //lastq2 = lastq; //lastq = q; q = q.pop(); } estimatedTime = System.nanoTime() - startTime; System.out.println("time: " + estimatedTime / 1000000); System.out.println("peek: " + q.peek()); IPersistentList q2 = q; for(int i = 0; i < 10; i++) { q2 = (IPersistentList) q2.cons(i); } // for(ISeq s = q.seq();s != null;s = s.rest()) // System.out.println("q: " + s.first().toString()); // for(ISeq s = q2.seq();s != null;s = s.rest()) // System.out.println("q2: " + s.first().toString()); } */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentStructMap.java000066400000000000000000000134431157562347600262010ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 16, 2007 */ package clojure.lang; import java.util.Iterator; import java.util.Map; import java.io.Serializable; public class PersistentStructMap extends APersistentMap implements IObj{ public static class Def implements Serializable{ final ISeq keys; final IPersistentMap keyslots; Def(ISeq keys, IPersistentMap keyslots){ this.keys = keys; this.keyslots = keyslots; } } final Def def; final Object[] vals; final IPersistentMap ext; final IPersistentMap _meta; static public Def createSlotMap(ISeq keys){ if(keys == null) throw new IllegalArgumentException("Must supply keys"); int c = RT.count(keys); Object[] v = new Object[2*c]; int i = 0; for(ISeq s = keys; s != null; s = s.next(), i++) { v[2*i] = s.first(); v[2*i+1] = i; } return new Def(keys, RT.map(v)); } static public PersistentStructMap create(Def def, ISeq keyvals){ Object[] vals = new Object[def.keyslots.count()]; IPersistentMap ext = PersistentHashMap.EMPTY; for(; keyvals != null; keyvals = keyvals.next().next()) { if(keyvals.next() == null) throw new IllegalArgumentException(String.format("No value supplied for key: %s", keyvals.first())); Object k = keyvals.first(); Object v = RT.second(keyvals); Map.Entry e = def.keyslots.entryAt(k); if(e != null) vals[(Integer) e.getValue()] = v; else ext = ext.assoc(k, v); } return new PersistentStructMap(null, def, vals, ext); } static public PersistentStructMap construct(Def def, ISeq valseq){ Object[] vals = new Object[def.keyslots.count()]; IPersistentMap ext = PersistentHashMap.EMPTY; for(int i = 0; i < vals.length && valseq != null; valseq = valseq.next(), i++) { vals[i] = valseq.first(); } if(valseq != null) throw new IllegalArgumentException("Too many arguments to struct constructor"); return new PersistentStructMap(null, def, vals, ext); } static public IFn getAccessor(final Def def, Object key){ Map.Entry e = def.keyslots.entryAt(key); if(e != null) { final int i = (Integer) e.getValue(); return new AFn(){ public Object invoke(Object arg1) throws Exception{ PersistentStructMap m = (PersistentStructMap) arg1; if(m.def != def) throw new Exception("Accessor/struct mismatch"); return m.vals[i]; } }; } throw new IllegalArgumentException("Not a key of struct"); } protected PersistentStructMap(IPersistentMap meta, Def def, Object[] vals, IPersistentMap ext){ this._meta = meta; this.ext = ext; this.def = def; this.vals = vals; } /** * Returns a new instance of PersistentStructMap using the given parameters. * This function is used instead of the PersistentStructMap constructor by * all methods that return a new PersistentStructMap. This is done so as to * allow subclasses to return instances of their class from all * PersistentStructMap methods. */ protected PersistentStructMap makeNew(IPersistentMap meta, Def def, Object[] vals, IPersistentMap ext){ return new PersistentStructMap(meta, def, vals, ext); } public IObj withMeta(IPersistentMap meta){ if(meta == _meta) return this; return makeNew(meta, def, vals, ext); } public IPersistentMap meta(){ return _meta; } public boolean containsKey(Object key){ return def.keyslots.containsKey(key) || ext.containsKey(key); } public IMapEntry entryAt(Object key){ Map.Entry e = def.keyslots.entryAt(key); if(e != null) { return new MapEntry(e.getKey(), vals[(Integer) e.getValue()]); } return ext.entryAt(key); } public IPersistentMap assoc(Object key, Object val){ Map.Entry e = def.keyslots.entryAt(key); if(e != null) { int i = (Integer) e.getValue(); Object[] newVals = vals.clone(); newVals[i] = val; return makeNew(_meta, def, newVals, ext); } return makeNew(_meta, def, vals, ext.assoc(key, val)); } public Object valAt(Object key){ Integer i = (Integer) def.keyslots.valAt(key); if(i != null) { return vals[i]; } return ext.valAt(key); } public Object valAt(Object key, Object notFound){ Integer i = (Integer) def.keyslots.valAt(key); if(i != null) { return vals[i]; } return ext.valAt(key, notFound); } public IPersistentMap assocEx(Object key, Object val) throws Exception{ if(containsKey(key)) throw new Exception("Key already present"); return assoc(key, val); } public IPersistentMap without(Object key) throws Exception{ Map.Entry e = def.keyslots.entryAt(key); if(e != null) throw new Exception("Can't remove struct key"); IPersistentMap newExt = ext.without(key); if(newExt == ext) return this; return makeNew(_meta, def, vals, newExt); } public Iterator iterator(){ return new SeqIterator(seq()); } public int count(){ return vals.length + RT.count(ext); } public ISeq seq(){ return new Seq(null, def.keys, vals, 0, ext); } public IPersistentCollection empty(){ return construct(def, null); } static class Seq extends ASeq{ final int i; final ISeq keys; final Object[] vals; final IPersistentMap ext; public Seq(IPersistentMap meta, ISeq keys, Object[] vals, int i, IPersistentMap ext){ super(meta); this.i = i; this.keys = keys; this.vals = vals; this.ext = ext; } public Obj withMeta(IPersistentMap meta){ if(meta != _meta) return new Seq(meta, keys, vals, i, ext); return this; } public Object first(){ return new MapEntry(keys.first(), vals[i]); } public ISeq next(){ if(i + 1 < vals.length) return new Seq(_meta, keys.next(), vals, i + 1, ext); return ext.seq(); } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentTreeMap.java000066400000000000000000000530771157562347600256230ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich May 20, 2006 */ package clojure.lang; import java.util.*; /** * Persistent Red Black Tree * Note that instances of this class are constant values * i.e. add/remove etc return new values *

* See Okasaki, Kahrs, Larsen et al */ public class PersistentTreeMap extends APersistentMap implements IObj, Reversible, Sorted{ public final Comparator comp; public final Node tree; public final int _count; final IPersistentMap _meta; final static public PersistentTreeMap EMPTY = new PersistentTreeMap(); static public IPersistentMap create(Map other){ IPersistentMap ret = EMPTY; for(Object o : other.entrySet()) { Map.Entry e = (Entry) o; ret = ret.assoc(e.getKey(), e.getValue()); } return ret; } public PersistentTreeMap(){ this(RT.DEFAULT_COMPARATOR); } public PersistentTreeMap withMeta(IPersistentMap meta){ return new PersistentTreeMap(meta, comp, tree, _count); } private PersistentTreeMap(Comparator comp){ this(null, comp); } public PersistentTreeMap(IPersistentMap meta, Comparator comp){ this.comp = comp; this._meta = meta; tree = null; _count = 0; } PersistentTreeMap(IPersistentMap meta, Comparator comp, Node tree, int _count){ this._meta = meta; this.comp = comp; this.tree = tree; this._count = _count; } static public PersistentTreeMap create(ISeq items){ IPersistentMap ret = EMPTY; for(; items != null; items = items.next().next()) { if(items.next() == null) throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); ret = ret.assoc(items.first(), RT.second(items)); } return (PersistentTreeMap) ret; } static public PersistentTreeMap create(Comparator comp, ISeq items){ IPersistentMap ret = new PersistentTreeMap(comp); for(; items != null; items = items.next().next()) { if(items.next() == null) throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first())); ret = ret.assoc(items.first(), RT.second(items)); } return (PersistentTreeMap) ret; } public boolean containsKey(Object key){ return entryAt(key) != null; } public PersistentTreeMap assocEx(Object key, Object val) throws Exception{ Box found = new Box(null); Node t = add(tree, key, val, found); if(t == null) //null == already contains key { throw new Exception("Key already present"); } return new PersistentTreeMap(comp, t.blacken(), _count + 1, meta()); } public PersistentTreeMap assoc(Object key, Object val){ Box found = new Box(null); Node t = add(tree, key, val, found); if(t == null) //null == already contains key { Node foundNode = (Node) found.val; if(foundNode.val() == val) //note only get same collection on identity of val, not equals() return this; return new PersistentTreeMap(comp, replace(tree, key, val), _count, meta()); } return new PersistentTreeMap(comp, t.blacken(), _count + 1, meta()); } public PersistentTreeMap without(Object key){ Box found = new Box(null); Node t = remove(tree, key, found); if(t == null) { if(found.val == null)//null == doesn't contain key return this; //empty return new PersistentTreeMap(meta(), comp); } return new PersistentTreeMap(comp, t.blacken(), _count - 1, meta()); } public ISeq seq(){ if(_count > 0) return Seq.create(tree, true, _count); return null; } public IPersistentCollection empty(){ return new PersistentTreeMap(meta(), comp); } public ISeq rseq() throws Exception{ if(_count > 0) return Seq.create(tree, false, _count); return null; } public Comparator comparator(){ return comp; } public Object entryKey(Object entry){ return ((IMapEntry) entry).key(); } public ISeq seq(boolean ascending){ if(_count > 0) return Seq.create(tree, ascending, _count); return null; } public ISeq seqFrom(Object key, boolean ascending){ if(_count > 0) { ISeq stack = null; Node t = tree; while(t != null) { int c = doCompare(key, t.key); if(c == 0) { stack = RT.cons(t, stack); return new Seq(stack, ascending); } else if(ascending) { if(c < 0) { stack = RT.cons(t, stack); t = t.left(); } else t = t.right(); } else { if(c > 0) { stack = RT.cons(t, stack); t = t.right(); } else t = t.left(); } } if(stack != null) return new Seq(stack, ascending); } return null; } public NodeIterator iterator(){ return new NodeIterator(tree, true); } public NodeIterator reverseIterator(){ return new NodeIterator(tree, false); } public Iterator keys(){ return keys(iterator()); } public Iterator vals(){ return vals(iterator()); } public Iterator keys(NodeIterator it){ return new KeyIterator(it); } public Iterator vals(NodeIterator it){ return new ValIterator(it); } public Object minKey(){ Node t = min(); return t != null ? t.key : null; } public Node min(){ Node t = tree; if(t != null) { while(t.left() != null) t = t.left(); } return t; } public Object maxKey(){ Node t = max(); return t != null ? t.key : null; } public Node max(){ Node t = tree; if(t != null) { while(t.right() != null) t = t.right(); } return t; } public int depth(){ return depth(tree); } int depth(Node t){ if(t == null) return 0; return 1 + Math.max(depth(t.left()), depth(t.right())); } public Object valAt(Object key, Object notFound){ Node n = entryAt(key); return (n != null) ? n.val() : notFound; } public Object valAt(Object key){ return valAt(key, null); } public int capacity(){ return _count; } public int count(){ return _count; } public Node entryAt(Object key){ Node t = tree; while(t != null) { int c = doCompare(key, t.key); if(c == 0) return t; else if(c < 0) t = t.left(); else t = t.right(); } return t; } public int doCompare(Object k1, Object k2){ // if(comp != null) return comp.compare(k1, k2); // return ((Comparable) k1).compareTo(k2); } Node add(Node t, Object key, Object val, Box found){ if(t == null) { if(val == null) return new Red(key); return new RedVal(key, val); } int c = doCompare(key, t.key); if(c == 0) { found.val = t; return null; } Node ins = c < 0 ? add(t.left(), key, val, found) : add(t.right(), key, val, found); if(ins == null) //found below return null; if(c < 0) return t.addLeft(ins); return t.addRight(ins); } Node remove(Node t, Object key, Box found){ if(t == null) return null; //not found indicator int c = doCompare(key, t.key); if(c == 0) { found.val = t; return append(t.left(), t.right()); } Node del = c < 0 ? remove(t.left(), key, found) : remove(t.right(), key, found); if(del == null && found.val == null) //not found below return null; if(c < 0) { if(t.left() instanceof Black) return balanceLeftDel(t.key, t.val(), del, t.right()); else return red(t.key, t.val(), del, t.right()); } if(t.right() instanceof Black) return balanceRightDel(t.key, t.val(), t.left(), del); return red(t.key, t.val(), t.left(), del); // return t.removeLeft(del); // return t.removeRight(del); } static Node append(Node left, Node right){ if(left == null) return right; else if(right == null) return left; else if(left instanceof Red) { if(right instanceof Red) { Node app = append(left.right(), right.left()); if(app instanceof Red) return red(app.key, app.val(), red(left.key, left.val(), left.left(), app.left()), red(right.key, right.val(), app.right(), right.right())); else return red(left.key, left.val(), left.left(), red(right.key, right.val(), app, right.right())); } else return red(left.key, left.val(), left.left(), append(left.right(), right)); } else if(right instanceof Red) return red(right.key, right.val(), append(left, right.left()), right.right()); else //black/black { Node app = append(left.right(), right.left()); if(app instanceof Red) return red(app.key, app.val(), black(left.key, left.val(), left.left(), app.left()), black(right.key, right.val(), app.right(), right.right())); else return balanceLeftDel(left.key, left.val(), left.left(), black(right.key, right.val(), app, right.right())); } } static Node balanceLeftDel(Object key, Object val, Node del, Node right){ if(del instanceof Red) return red(key, val, del.blacken(), right); else if(right instanceof Black) return rightBalance(key, val, del, right.redden()); else if(right instanceof Red && right.left() instanceof Black) return red(right.left().key, right.left().val(), black(key, val, del, right.left().left()), rightBalance(right.key, right.val(), right.left().right(), right.right().redden())); else throw new UnsupportedOperationException("Invariant violation"); } static Node balanceRightDel(Object key, Object val, Node left, Node del){ if(del instanceof Red) return red(key, val, left, del.blacken()); else if(left instanceof Black) return leftBalance(key, val, left.redden(), del); else if(left instanceof Red && left.right() instanceof Black) return red(left.right().key, left.right().val(), leftBalance(left.key, left.val(), left.left().redden(), left.right().left()), black(key, val, left.right().right(), del)); else throw new UnsupportedOperationException("Invariant violation"); } static Node leftBalance(Object key, Object val, Node ins, Node right){ if(ins instanceof Red && ins.left() instanceof Red) return red(ins.key, ins.val(), ins.left().blacken(), black(key, val, ins.right(), right)); else if(ins instanceof Red && ins.right() instanceof Red) return red(ins.right().key, ins.right().val(), black(ins.key, ins.val(), ins.left(), ins.right().left()), black(key, val, ins.right().right(), right)); else return black(key, val, ins, right); } static Node rightBalance(Object key, Object val, Node left, Node ins){ if(ins instanceof Red && ins.right() instanceof Red) return red(ins.key, ins.val(), black(key, val, left, ins.left()), ins.right().blacken()); else if(ins instanceof Red && ins.left() instanceof Red) return red(ins.left().key, ins.left().val(), black(key, val, left, ins.left().left()), black(ins.key, ins.val(), ins.left().right(), ins.right())); else return black(key, val, left, ins); } Node replace(Node t, Object key, Object val){ int c = doCompare(key, t.key); return t.replace(t.key, c == 0 ? val : t.val(), c < 0 ? replace(t.left(), key, val) : t.left(), c > 0 ? replace(t.right(), key, val) : t.right()); } PersistentTreeMap(Comparator comp, Node tree, int count, IPersistentMap meta){ this._meta = meta; this.comp = comp; this.tree = tree; this._count = count; } static Red red(Object key, Object val, Node left, Node right){ if(left == null && right == null) { if(val == null) return new Red(key); return new RedVal(key, val); } if(val == null) return new RedBranch(key, left, right); return new RedBranchVal(key, val, left, right); } static Black black(Object key, Object val, Node left, Node right){ if(left == null && right == null) { if(val == null) return new Black(key); return new BlackVal(key, val); } if(val == null) return new BlackBranch(key, left, right); return new BlackBranchVal(key, val, left, right); } public IPersistentMap meta(){ return _meta; } static abstract class Node extends AMapEntry{ final Object key; Node(Object key){ this.key = key; } public Object key(){ return key; } public Object val(){ return null; } public Object getKey(){ return key(); } public Object getValue(){ return val(); } Node left(){ return null; } Node right(){ return null; } abstract Node addLeft(Node ins); abstract Node addRight(Node ins); abstract Node removeLeft(Node del); abstract Node removeRight(Node del); abstract Node blacken(); abstract Node redden(); Node balanceLeft(Node parent){ return black(parent.key, parent.val(), this, parent.right()); } Node balanceRight(Node parent){ return black(parent.key, parent.val(), parent.left(), this); } abstract Node replace(Object key, Object val, Node left, Node right); } static class Black extends Node{ public Black(Object key){ super(key); } Node addLeft(Node ins){ return ins.balanceLeft(this); } Node addRight(Node ins){ return ins.balanceRight(this); } Node removeLeft(Node del){ return balanceLeftDel(key, val(), del, right()); } Node removeRight(Node del){ return balanceRightDel(key, val(), left(), del); } Node blacken(){ return this; } Node redden(){ return new Red(key); } Node replace(Object key, Object val, Node left, Node right){ return black(key, val, left, right); } } static class BlackVal extends Black{ final Object val; public BlackVal(Object key, Object val){ super(key); this.val = val; } public Object val(){ return val; } Node redden(){ return new RedVal(key, val); } } static class BlackBranch extends Black{ final Node left; final Node right; public BlackBranch(Object key, Node left, Node right){ super(key); this.left = left; this.right = right; } public Node left(){ return left; } public Node right(){ return right; } Node redden(){ return new RedBranch(key, left, right); } } static class BlackBranchVal extends BlackBranch{ final Object val; public BlackBranchVal(Object key, Object val, Node left, Node right){ super(key, left, right); this.val = val; } public Object val(){ return val; } Node redden(){ return new RedBranchVal(key, val, left, right); } } static class Red extends Node{ public Red(Object key){ super(key); } Node addLeft(Node ins){ return red(key, val(), ins, right()); } Node addRight(Node ins){ return red(key, val(), left(), ins); } Node removeLeft(Node del){ return red(key, val(), del, right()); } Node removeRight(Node del){ return red(key, val(), left(), del); } Node blacken(){ return new Black(key); } Node redden(){ throw new UnsupportedOperationException("Invariant violation"); } Node replace(Object key, Object val, Node left, Node right){ return red(key, val, left, right); } } static class RedVal extends Red{ final Object val; public RedVal(Object key, Object val){ super(key); this.val = val; } public Object val(){ return val; } Node blacken(){ return new BlackVal(key, val); } } static class RedBranch extends Red{ final Node left; final Node right; public RedBranch(Object key, Node left, Node right){ super(key); this.left = left; this.right = right; } public Node left(){ return left; } public Node right(){ return right; } Node balanceLeft(Node parent){ if(left instanceof Red) return red(key, val(), left.blacken(), black(parent.key, parent.val(), right, parent.right())); else if(right instanceof Red) return red(right.key, right.val(), black(key, val(), left, right.left()), black(parent.key, parent.val(), right.right(), parent.right())); else return super.balanceLeft(parent); } Node balanceRight(Node parent){ if(right instanceof Red) return red(key, val(), black(parent.key, parent.val(), parent.left(), left), right.blacken()); else if(left instanceof Red) return red(left.key, left.val(), black(parent.key, parent.val(), parent.left(), left.left()), black(key, val(), left.right(), right)); else return super.balanceRight(parent); } Node blacken(){ return new BlackBranch(key, left, right); } } static class RedBranchVal extends RedBranch{ final Object val; public RedBranchVal(Object key, Object val, Node left, Node right){ super(key, left, right); this.val = val; } public Object val(){ return val; } Node blacken(){ return new BlackBranchVal(key, val, left, right); } } static public class Seq extends ASeq{ final ISeq stack; final boolean asc; final int cnt; public Seq(ISeq stack, boolean asc){ this.stack = stack; this.asc = asc; this.cnt = -1; } public Seq(ISeq stack, boolean asc, int cnt){ this.stack = stack; this.asc = asc; this.cnt = cnt; } Seq(IPersistentMap meta, ISeq stack, boolean asc, int cnt){ super(meta); this.stack = stack; this.asc = asc; this.cnt = cnt; } static Seq create(Node t, boolean asc, int cnt){ return new Seq(push(t, null, asc), asc, cnt); } static ISeq push(Node t, ISeq stack, boolean asc){ while(t != null) { stack = RT.cons(t, stack); t = asc ? t.left() : t.right(); } return stack; } public Object first(){ return stack.first(); } public ISeq next(){ Node t = (Node) stack.first(); ISeq nextstack = push(asc ? t.right() : t.left(), stack.next(), asc); if(nextstack != null) { return new Seq(nextstack, asc, cnt - 1); } return null; } public int count(){ if(cnt < 0) return super.count(); return cnt; } public Obj withMeta(IPersistentMap meta){ return new Seq(meta, stack, asc, cnt); } } static public class NodeIterator implements Iterator{ Stack stack = new Stack(); boolean asc; NodeIterator(Node t, boolean asc){ this.asc = asc; push(t); } void push(Node t){ while(t != null) { stack.push(t); t = asc ? t.left() : t.right(); } } public boolean hasNext(){ return !stack.isEmpty(); } public Object next(){ Node t = (Node) stack.pop(); push(asc ? t.right() : t.left()); return t; } public void remove(){ throw new UnsupportedOperationException(); } } static class KeyIterator implements Iterator{ NodeIterator it; KeyIterator(NodeIterator it){ this.it = it; } public boolean hasNext(){ return it.hasNext(); } public Object next(){ return ((Node) it.next()).key; } public void remove(){ throw new UnsupportedOperationException(); } } static class ValIterator implements Iterator{ NodeIterator it; ValIterator(NodeIterator it){ this.it = it; } public boolean hasNext(){ return it.hasNext(); } public Object next(){ return ((Node) it.next()).val(); } public void remove(){ throw new UnsupportedOperationException(); } } /* static public void main(String args[]){ if(args.length != 1) System.err.println("Usage: RBTree n"); int n = Integer.parseInt(args[0]); Integer[] ints = new Integer[n]; for(int i = 0; i < ints.length; i++) { ints[i] = i; } Collections.shuffle(Arrays.asList(ints)); //force the ListMap class loading now // try // { // // //PersistentListMap.EMPTY.assocEx(1, null).assocEx(2,null).assocEx(3,null); // } // catch(Exception e) // { // e.printStackTrace(); //To change body of catch statement use File | Settings | File Templates. // } System.out.println("Building set"); //IPersistentMap set = new PersistentArrayMap(); //IPersistentMap set = new PersistentHashtableMap(1001); IPersistentMap set = PersistentHashMap.EMPTY; //IPersistentMap set = new ListMap(); //IPersistentMap set = new ArrayMap(); //IPersistentMap set = new PersistentTreeMap(); // for(int i = 0; i < ints.length; i++) // { // Integer anInt = ints[i]; // set = set.add(anInt); // } long startTime = System.nanoTime(); for(Integer anInt : ints) { set = set.assoc(anInt, anInt); } //System.out.println("_count = " + set.count()); // System.out.println("_count = " + set._count + ", min: " + set.minKey() + ", max: " + set.maxKey() // + ", depth: " + set.depth()); for(Object aSet : set) { IMapEntry o = (IMapEntry) aSet; if(!set.contains(o.key())) System.err.println("Can't find: " + o.key()); //else if(n < 2000) // System.out.print(o.key().toString() + ","); } Random rand = new Random(42); for(int i = 0; i < ints.length / 2; i++) { Integer anInt = ints[rand.nextInt(n)]; set = set.without(anInt); } long estimatedTime = System.nanoTime() - startTime; System.out.println(); System.out.println("_count = " + set.count() + ", time: " + estimatedTime / 1000000); System.out.println("Building ht"); Hashtable ht = new Hashtable(1001); startTime = System.nanoTime(); // for(int i = 0; i < ints.length; i++) // { // Integer anInt = ints[i]; // ht.put(anInt,null); // } for(Integer anInt : ints) { ht.put(anInt, anInt); } //System.out.println("size = " + ht.size()); //Iterator it = ht.entrySet().iterator(); for(Object o1 : ht.entrySet()) { Map.Entry o = (Map.Entry) o1; if(!ht.containsKey(o.getKey())) System.err.println("Can't find: " + o); //else if(n < 2000) // System.out.print(o.toString() + ","); } rand = new Random(42); for(int i = 0; i < ints.length / 2; i++) { Integer anInt = ints[rand.nextInt(n)]; ht.remove(anInt); } estimatedTime = System.nanoTime() - startTime; System.out.println(); System.out.println("size = " + ht.size() + ", time: " + estimatedTime / 1000000); System.out.println("set lookup"); startTime = System.nanoTime(); int c = 0; for(Integer anInt : ints) { if(!set.contains(anInt)) ++c; } estimatedTime = System.nanoTime() - startTime; System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); System.out.println("ht lookup"); startTime = System.nanoTime(); c = 0; for(Integer anInt : ints) { if(!ht.containsKey(anInt)) ++c; } estimatedTime = System.nanoTime() - startTime; System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000); // System.out.println("_count = " + set._count + ", min: " + set.minKey() + ", max: " + set.maxKey() // + ", depth: " + set.depth()); } */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentTreeSet.java000066400000000000000000000045511157562347600256320ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; import java.util.Comparator; public class PersistentTreeSet extends APersistentSet implements IObj, Reversible, Sorted{ static public final PersistentTreeSet EMPTY = new PersistentTreeSet(null, PersistentTreeMap.EMPTY); final IPersistentMap _meta; static public PersistentTreeSet create(ISeq items){ PersistentTreeSet ret = EMPTY; for(; items != null; items = items.next()) { ret = (PersistentTreeSet) ret.cons(items.first()); } return ret; } static public PersistentTreeSet create(Comparator comp, ISeq items){ PersistentTreeSet ret = new PersistentTreeSet(null, new PersistentTreeMap(null, comp)); for(; items != null; items = items.next()) { ret = (PersistentTreeSet) ret.cons(items.first()); } return ret; } PersistentTreeSet(IPersistentMap meta, IPersistentMap impl){ super(impl); this._meta = meta; } public IPersistentSet disjoin(Object key) throws Exception{ if(contains(key)) return new PersistentTreeSet(meta(),impl.without(key)); return this; } public IPersistentSet cons(Object o){ if(contains(o)) return this; return new PersistentTreeSet(meta(),impl.assoc(o,o)); } public IPersistentCollection empty(){ return new PersistentTreeSet(meta(),(PersistentTreeMap)impl.empty()); } public ISeq rseq() throws Exception{ return APersistentMap.KeySeq.create(((Reversible) impl).rseq()); } public PersistentTreeSet withMeta(IPersistentMap meta){ return new PersistentTreeSet(meta, impl); } public Comparator comparator(){ return ((Sorted)impl).comparator(); } public Object entryKey(Object entry){ return entry; } public ISeq seq(boolean ascending){ PersistentTreeMap m = (PersistentTreeMap) impl; return RT.keys(m.seq(ascending)); } public ISeq seqFrom(Object key, boolean ascending){ PersistentTreeMap m = (PersistentTreeMap) impl; return RT.keys(m.seqFrom(key,ascending)); } public IPersistentMap meta(){ return _meta; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/PersistentVector.java000066400000000000000000000417371157562347600255300ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 5, 2007 */ package clojure.lang; import java.io.Serializable; import java.util.List; import java.util.concurrent.atomic.AtomicReference; public class PersistentVector extends APersistentVector implements IObj, IEditableCollection{ static class Node implements Serializable { transient final AtomicReference edit; final Object[] array; Node(AtomicReference edit, Object[] array){ this.edit = edit; this.array = array; } Node(AtomicReference edit){ this.edit = edit; this.array = new Object[32]; } } final static AtomicReference NOEDIT = new AtomicReference(null); final static Node EMPTY_NODE = new Node(NOEDIT, new Object[32]); final int cnt; final int shift; final Node root; final Object[] tail; final IPersistentMap _meta; public final static PersistentVector EMPTY = new PersistentVector(0, 5, EMPTY_NODE, new Object[]{}); static public PersistentVector create(ISeq items){ TransientVector ret = EMPTY.asTransient(); for(; items != null; items = items.next()) ret = ret.conj(items.first()); return ret.persistent(); } static public PersistentVector create(List items){ TransientVector ret = EMPTY.asTransient(); for(Object item : items) ret = ret.conj(item); return ret.persistent(); } static public PersistentVector create(Object... items){ TransientVector ret = EMPTY.asTransient(); for(Object item : items) ret = ret.conj(item); return ret.persistent(); } PersistentVector(int cnt, int shift, Node root, Object[] tail){ this._meta = null; this.cnt = cnt; this.shift = shift; this.root = root; this.tail = tail; } PersistentVector(IPersistentMap meta, int cnt, int shift, Node root, Object[] tail){ this._meta = meta; this.cnt = cnt; this.shift = shift; this.root = root; this.tail = tail; } public TransientVector asTransient(){ return new TransientVector(this); } final int tailoff(){ if(cnt < 32) return 0; return ((cnt - 1) >>> 5) << 5; } public Object[] arrayFor(int i){ if(i >= 0 && i < cnt) { if(i >= tailoff()) return tail; Node node = root; for(int level = shift; level > 0; level -= 5) node = (Node) node.array[(i >>> level) & 0x01f]; return node.array; } throw new IndexOutOfBoundsException(); } public Object nth(int i){ Object[] node = arrayFor(i); return node[i & 0x01f]; } public Object nth(int i, Object notFound){ if(i >= 0 && i < cnt) return nth(i); return notFound; } public PersistentVector assocN(int i, Object val){ if(i >= 0 && i < cnt) { if(i >= tailoff()) { Object[] newTail = new Object[tail.length]; System.arraycopy(tail, 0, newTail, 0, tail.length); newTail[i & 0x01f] = val; return new PersistentVector(meta(), cnt, shift, root, newTail); } return new PersistentVector(meta(), cnt, shift, doAssoc(shift, root, i, val), tail); } if(i == cnt) return cons(val); throw new IndexOutOfBoundsException(); } private static Node doAssoc(int level, Node node, int i, Object val){ Node ret = new Node(node.edit,node.array.clone()); if(level == 0) { ret.array[i & 0x01f] = val; } else { int subidx = (i >>> level) & 0x01f; ret.array[subidx] = doAssoc(level - 5, (Node) node.array[subidx], i, val); } return ret; } public int count(){ return cnt; } public PersistentVector withMeta(IPersistentMap meta){ return new PersistentVector(meta, cnt, shift, root, tail); } public IPersistentMap meta(){ return _meta; } public PersistentVector cons(Object val){ int i = cnt; //room in tail? // if(tail.length < 32) if(cnt - tailoff() < 32) { Object[] newTail = new Object[tail.length + 1]; System.arraycopy(tail, 0, newTail, 0, tail.length); newTail[tail.length] = val; return new PersistentVector(meta(), cnt + 1, shift, root, newTail); } //full tail, push into tree Node newroot; Node tailnode = new Node(root.edit,tail); int newshift = shift; //overflow root? if((cnt >>> 5) > (1 << shift)) { newroot = new Node(root.edit); newroot.array[0] = root; newroot.array[1] = newPath(root.edit,shift, tailnode); newshift += 5; } else newroot = pushTail(shift, root, tailnode); return new PersistentVector(meta(), cnt + 1, newshift, newroot, new Object[]{val}); } private Node pushTail(int level, Node parent, Node tailnode){ //if parent is leaf, insert node, // else does it map to an existing child? -> nodeToInsert = pushNode one more level // else alloc new path //return nodeToInsert placed in copy of parent int subidx = ((cnt - 1) >>> level) & 0x01f; Node ret = new Node(parent.edit, parent.array.clone()); Node nodeToInsert; if(level == 5) { nodeToInsert = tailnode; } else { Node child = (Node) parent.array[subidx]; nodeToInsert = (child != null)? pushTail(level-5,child, tailnode) :newPath(root.edit,level-5, tailnode); } ret.array[subidx] = nodeToInsert; return ret; } private static Node newPath(AtomicReference edit,int level, Node node){ if(level == 0) return node; Node ret = new Node(edit); ret.array[0] = newPath(edit, level - 5, node); return ret; } public IChunkedSeq chunkedSeq(){ if(count() == 0) return null; return new ChunkedSeq(this,0,0); } public ISeq seq(){ return chunkedSeq(); } static public final class ChunkedSeq extends ASeq implements IChunkedSeq{ public final PersistentVector vec; final Object[] node; final int i; public final int offset; public ChunkedSeq(PersistentVector vec, int i, int offset){ this.vec = vec; this.i = i; this.offset = offset; this.node = vec.arrayFor(i); } ChunkedSeq(IPersistentMap meta, PersistentVector vec, Object[] node, int i, int offset){ super(meta); this.vec = vec; this.node = node; this.i = i; this.offset = offset; } ChunkedSeq(PersistentVector vec, Object[] node, int i, int offset){ this.vec = vec; this.node = node; this.i = i; this.offset = offset; } public IChunk chunkedFirst() throws Exception{ return new ArrayChunk(node, offset); } public ISeq chunkedNext(){ if(i + node.length < vec.cnt) return new ChunkedSeq(vec,i+ node.length,0); return null; } public ISeq chunkedMore(){ ISeq s = chunkedNext(); if(s == null) return PersistentList.EMPTY; return s; } public Obj withMeta(IPersistentMap meta){ if(meta == this._meta) return this; return new ChunkedSeq(meta, vec, node, i, offset); } public Object first(){ return node[offset]; } public ISeq next(){ if(offset + 1 < node.length) return new ChunkedSeq(vec, node, i, offset + 1); return chunkedNext(); } } public IPersistentCollection empty(){ return EMPTY.withMeta(meta()); } //private Node pushTail(int level, Node node, Object[] tailNode, Box expansion){ // Object newchild; // if(level == 0) // { // newchild = tailNode; // } // else // { // newchild = pushTail(level - 5, (Object[]) arr[arr.length - 1], tailNode, expansion); // if(expansion.val == null) // { // Object[] ret = arr.clone(); // ret[arr.length - 1] = newchild; // return ret; // } // else // newchild = expansion.val; // } // //expansion // if(arr.length == 32) // { // expansion.val = new Object[]{newchild}; // return arr; // } // Object[] ret = new Object[arr.length + 1]; // System.arraycopy(arr, 0, ret, 0, arr.length); // ret[arr.length] = newchild; // expansion.val = null; // return ret; //} public PersistentVector pop(){ if(cnt == 0) throw new IllegalStateException("Can't pop empty vector"); if(cnt == 1) return EMPTY.withMeta(meta()); //if(tail.length > 1) if(cnt-tailoff() > 1) { Object[] newTail = new Object[tail.length - 1]; System.arraycopy(tail, 0, newTail, 0, newTail.length); return new PersistentVector(meta(), cnt - 1, shift, root, newTail); } Object[] newtail = arrayFor(cnt - 2); Node newroot = popTail(shift, root); int newshift = shift; if(newroot == null) { newroot = EMPTY_NODE; } if(shift > 5 && newroot.array[1] == null) { newroot = (Node) newroot.array[0]; newshift -= 5; } return new PersistentVector(meta(), cnt - 1, newshift, newroot, newtail); } private Node popTail(int level, Node node){ int subidx = ((cnt-2) >>> level) & 0x01f; if(level > 5) { Node newchild = popTail(level - 5, (Node) node.array[subidx]); if(newchild == null && subidx == 0) return null; else { Node ret = new Node(root.edit, node.array.clone()); ret.array[subidx] = newchild; return ret; } } else if(subidx == 0) return null; else { Node ret = new Node(root.edit, node.array.clone()); ret.array[subidx] = null; return ret; } } static final class TransientVector extends AFn implements ITransientVector, Counted{ int cnt; int shift; Node root; Object[] tail; TransientVector(int cnt, int shift, Node root, Object[] tail){ this.cnt = cnt; this.shift = shift; this.root = root; this.tail = tail; } TransientVector(PersistentVector v){ this(v.cnt, v.shift, editableRoot(v.root), editableTail(v.tail)); } public int count(){ ensureEditable(); return cnt; } Node ensureEditable(Node node){ if(node.edit == root.edit) return node; return new Node(root.edit, node.array.clone()); } void ensureEditable(){ Thread owner = root.edit.get(); if(owner == Thread.currentThread()) return; if(owner != null) throw new IllegalAccessError("Transient used by non-owner thread"); throw new IllegalAccessError("Transient used after persistent! call"); // root = editableRoot(root); // tail = editableTail(tail); } static Node editableRoot(Node node){ return new Node(new AtomicReference(Thread.currentThread()), node.array.clone()); } public PersistentVector persistent(){ ensureEditable(); // Thread owner = root.edit.get(); // if(owner != null && owner != Thread.currentThread()) // { // throw new IllegalAccessError("Mutation release by non-owner thread"); // } root.edit.set(null); Object[] trimmedTail = new Object[cnt-tailoff()]; System.arraycopy(tail,0,trimmedTail,0,trimmedTail.length); return new PersistentVector(cnt, shift, root, trimmedTail); } static Object[] editableTail(Object[] tl){ Object[] ret = new Object[32]; System.arraycopy(tl,0,ret,0,tl.length); return ret; } public TransientVector conj(Object val){ ensureEditable(); int i = cnt; //room in tail? if(i - tailoff() < 32) { tail[i & 0x01f] = val; ++cnt; return this; } //full tail, push into tree Node newroot; Node tailnode = new Node(root.edit, tail); tail = new Object[32]; tail[0] = val; int newshift = shift; //overflow root? if((cnt >>> 5) > (1 << shift)) { newroot = new Node(root.edit); newroot.array[0] = root; newroot.array[1] = newPath(root.edit,shift, tailnode); newshift += 5; } else newroot = pushTail(shift, root, tailnode); root = newroot; shift = newshift; ++cnt; return this; } private Node pushTail(int level, Node parent, Node tailnode){ //if parent is leaf, insert node, // else does it map to an existing child? -> nodeToInsert = pushNode one more level // else alloc new path //return nodeToInsert placed in parent parent = ensureEditable(parent); int subidx = ((cnt - 1) >>> level) & 0x01f; Node ret = parent; Node nodeToInsert; if(level == 5) { nodeToInsert = tailnode; } else { Node child = (Node) parent.array[subidx]; nodeToInsert = (child != null) ? pushTail(level - 5, child, tailnode) : newPath(root.edit, level - 5, tailnode); } ret.array[subidx] = nodeToInsert; return ret; } final private int tailoff(){ if(cnt < 32) return 0; return ((cnt-1) >>> 5) << 5; } private Object[] arrayFor(int i){ if(i >= 0 && i < cnt) { if(i >= tailoff()) return tail; Node node = root; for(int level = shift; level > 0; level -= 5) node = (Node) node.array[(i >>> level) & 0x01f]; return node.array; } throw new IndexOutOfBoundsException(); } public Object valAt(Object key){ //note - relies on ensureEditable in 2-arg valAt return valAt(key, null); } public Object valAt(Object key, Object notFound){ ensureEditable(); if(Util.isInteger(key)) { int i = ((Number) key).intValue(); if(i >= 0 && i < cnt) return nth(i); } return notFound; } public Object invoke(Object arg1) throws Exception{ //note - relies on ensureEditable in nth if(Util.isInteger(arg1)) return nth(((Number) arg1).intValue()); throw new IllegalArgumentException("Key must be integer"); } public Object nth(int i){ ensureEditable(); Object[] node = arrayFor(i); return node[i & 0x01f]; } public Object nth(int i, Object notFound){ if(i >= 0 && i < count()) return nth(i); return notFound; } public TransientVector assocN(int i, Object val){ ensureEditable(); if(i >= 0 && i < cnt) { if(i >= tailoff()) { tail[i & 0x01f] = val; return this; } root = doAssoc(shift, root, i, val); return this; } if(i == cnt) return conj(val); throw new IndexOutOfBoundsException(); } public TransientVector assoc(Object key, Object val){ //note - relies on ensureEditable in assocN if(Util.isInteger(key)) { int i = ((Number) key).intValue(); return assocN(i, val); } throw new IllegalArgumentException("Key must be integer"); } private Node doAssoc(int level, Node node, int i, Object val){ node = ensureEditable(node); Node ret = node; if(level == 0) { ret.array[i & 0x01f] = val; } else { int subidx = (i >>> level) & 0x01f; ret.array[subidx] = doAssoc(level - 5, (Node) node.array[subidx], i, val); } return ret; } public TransientVector pop(){ ensureEditable(); if(cnt == 0) throw new IllegalStateException("Can't pop empty vector"); if(cnt == 1) { cnt = 0; return this; } int i = cnt - 1; //pop in tail? if((i & 0x01f) > 0) { --cnt; return this; } Object[] newtail = arrayFor(cnt - 2); Node newroot = popTail(shift, root); int newshift = shift; if(newroot == null) { newroot = new Node(root.edit); } if(shift > 5 && newroot.array[1] == null) { newroot = ensureEditable((Node) newroot.array[0]); newshift -= 5; } root = newroot; shift = newshift; --cnt; tail = newtail; return this; } private Node popTail(int level, Node node){ node = ensureEditable(node); int subidx = ((cnt - 2) >>> level) & 0x01f; if(level > 5) { Node newchild = popTail(level - 5, (Node) node.array[subidx]); if(newchild == null && subidx == 0) return null; else { Node ret = node; ret.array[subidx] = newchild; return ret; } } else if(subidx == 0) return null; else { Node ret = node; ret.array[subidx] = null; return ret; } } } /* static public void main(String[] args){ if(args.length != 3) { System.err.println("Usage: PersistentVector size writes reads"); return; } int size = Integer.parseInt(args[0]); int writes = Integer.parseInt(args[1]); int reads = Integer.parseInt(args[2]); // Vector v = new Vector(size); ArrayList v = new ArrayList(size); // v.setSize(size); //PersistentArray p = new PersistentArray(size); PersistentVector p = PersistentVector.EMPTY; // MutableVector mp = p.mutable(); for(int i = 0; i < size; i++) { v.add(i); // v.set(i, i); //p = p.set(i, 0); p = p.cons(i); // mp = mp.conj(i); } Random rand; rand = new Random(42); long tv = 0; System.out.println("ArrayList"); long startTime = System.nanoTime(); for(int i = 0; i < writes; i++) { v.set(rand.nextInt(size), i); } for(int i = 0; i < reads; i++) { tv += (Integer) v.get(rand.nextInt(size)); } long estimatedTime = System.nanoTime() - startTime; System.out.println("time: " + estimatedTime / 1000000); System.out.println("PersistentVector"); rand = new Random(42); startTime = System.nanoTime(); long tp = 0; // PersistentVector oldp = p; //Random rand2 = new Random(42); MutableVector mp = p.mutable(); for(int i = 0; i < writes; i++) { // p = p.assocN(rand.nextInt(size), i); mp = mp.assocN(rand.nextInt(size), i); // mp = mp.assoc(rand.nextInt(size), i); //dummy set to force perverse branching //oldp = oldp.assocN(rand2.nextInt(size), i); } for(int i = 0; i < reads; i++) { // tp += (Integer) p.nth(rand.nextInt(size)); tp += (Integer) mp.nth(rand.nextInt(size)); } // p = mp.immutable(); //mp.cons(42); estimatedTime = System.nanoTime() - startTime; System.out.println("time: " + estimatedTime / 1000000); for(int i = 0; i < size / 2; i++) { mp = mp.pop(); // p = p.pop(); v.remove(v.size() - 1); } p = (PersistentVector) mp.immutable(); //mp.pop(); //should fail for(int i = 0; i < size / 2; i++) { tp += (Integer) p.nth(i); tv += (Integer) v.get(i); } System.out.println("Done: " + tv + ", " + tp); } // */ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/ProxyHandler.java000066400000000000000000000037731157562347600246220ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Oct 4, 2007 */ package clojure.lang; import java.lang.reflect.InvocationHandler; import java.lang.reflect.Method; public class ProxyHandler implements InvocationHandler{ //method-name-string->fn final IPersistentMap fns; public ProxyHandler(IPersistentMap fns){ this.fns = fns; } public Object invoke(Object proxy, Method method, Object[] args) throws Throwable{ Class rt = method.getReturnType(); IFn fn = (IFn) fns.valAt(method.getName()); if(fn == null) { if(rt == Void.TYPE) return null; else if(method.getName().equals("equals")) { return proxy == args[0]; } else if(method.getName().equals("hashCode")) { return System.identityHashCode(proxy); } else if(method.getName().equals("toString")) { return "Proxy: " + System.identityHashCode(proxy); } throw new UnsupportedOperationException(); } Object ret = fn.applyTo(ArraySeq.create(args)); if(rt == Void.TYPE) return null; else if(rt.isPrimitive()) { if(rt == Character.TYPE) return ret; else if(rt == Integer.TYPE) return ((Number) ret).intValue(); else if(rt == Long.TYPE) return ((Number) ret).longValue(); else if(rt == Float.TYPE) return ((Number) ret).floatValue(); else if(rt == Double.TYPE) return ((Number) ret).doubleValue(); else if(rt == Boolean.TYPE && !(ret instanceof Boolean)) return ret == null ? Boolean.FALSE : Boolean.TRUE; else if(rt == Byte.TYPE) return (byte) ((Number) ret).intValue(); else if(rt == Short.TYPE) return (short) ((Number) ret).intValue(); } return ret; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/RT.java000066400000000000000000001400751157562347600225250ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 25, 2006 4:28:27 PM */ package clojure.lang; import java.util.concurrent.atomic.AtomicInteger; import java.util.concurrent.Callable; import java.util.*; import java.util.regex.Matcher; import java.util.regex.Pattern; import java.io.*; import java.lang.reflect.Array; import java.math.BigDecimal; import java.math.BigInteger; import java.security.AccessController; import java.security.PrivilegedAction; import java.net.URL; import java.net.JarURLConnection; import java.nio.charset.Charset; public class RT{ static final public Boolean T = Boolean.TRUE;//Keyword.intern(Symbol.create(null, "t")); static final public Boolean F = Boolean.FALSE;//Keyword.intern(Symbol.create(null, "t")); static final public String LOADER_SUFFIX = "__init"; //simple-symbol->class final static IPersistentMap DEFAULT_IMPORTS = map( // Symbol.create("RT"), "clojure.lang.RT", // Symbol.create("Num"), "clojure.lang.Num", // Symbol.create("Symbol"), "clojure.lang.Symbol", // Symbol.create("Keyword"), "clojure.lang.Keyword", // Symbol.create("Var"), "clojure.lang.Var", // Symbol.create("Ref"), "clojure.lang.Ref", // Symbol.create("IFn"), "clojure.lang.IFn", // Symbol.create("IObj"), "clojure.lang.IObj", // Symbol.create("ISeq"), "clojure.lang.ISeq", // Symbol.create("IPersistentCollection"), // "clojure.lang.IPersistentCollection", // Symbol.create("IPersistentMap"), "clojure.lang.IPersistentMap", // Symbol.create("IPersistentList"), "clojure.lang.IPersistentList", // Symbol.create("IPersistentVector"), "clojure.lang.IPersistentVector", Symbol.create("Boolean"), Boolean.class, Symbol.create("Byte"), Byte.class, Symbol.create("Character"), Character.class, Symbol.create("Class"), Class.class, Symbol.create("ClassLoader"), ClassLoader.class, Symbol.create("Compiler"), Compiler.class, Symbol.create("Double"), Double.class, Symbol.create("Enum"), Enum.class, Symbol.create("Float"), Float.class, Symbol.create("InheritableThreadLocal"), InheritableThreadLocal.class, Symbol.create("Integer"), Integer.class, Symbol.create("Long"), Long.class, Symbol.create("Math"), Math.class, Symbol.create("Number"), Number.class, Symbol.create("Object"), Object.class, Symbol.create("Package"), Package.class, Symbol.create("Process"), Process.class, Symbol.create("ProcessBuilder"), ProcessBuilder.class, Symbol.create("Runtime"), Runtime.class, Symbol.create("RuntimePermission"), RuntimePermission.class, Symbol.create("SecurityManager"), SecurityManager.class, Symbol.create("Short"), Short.class, Symbol.create("StackTraceElement"), StackTraceElement.class, Symbol.create("StrictMath"), StrictMath.class, Symbol.create("String"), String.class, Symbol.create("StringBuffer"), StringBuffer.class, Symbol.create("StringBuilder"), StringBuilder.class, Symbol.create("System"), System.class, Symbol.create("Thread"), Thread.class, Symbol.create("ThreadGroup"), ThreadGroup.class, Symbol.create("ThreadLocal"), ThreadLocal.class, Symbol.create("Throwable"), Throwable.class, Symbol.create("Void"), Void.class, Symbol.create("Appendable"), Appendable.class, Symbol.create("CharSequence"), CharSequence.class, Symbol.create("Cloneable"), Cloneable.class, Symbol.create("Comparable"), Comparable.class, Symbol.create("Iterable"), Iterable.class, Symbol.create("Readable"), Readable.class, Symbol.create("Runnable"), Runnable.class, Symbol.create("Callable"), Callable.class, Symbol.create("BigInteger"), BigInteger.class, Symbol.create("BigDecimal"), BigDecimal.class, Symbol.create("ArithmeticException"), ArithmeticException.class, Symbol.create("ArrayIndexOutOfBoundsException"), ArrayIndexOutOfBoundsException.class, Symbol.create("ArrayStoreException"), ArrayStoreException.class, Symbol.create("ClassCastException"), ClassCastException.class, Symbol.create("ClassNotFoundException"), ClassNotFoundException.class, Symbol.create("CloneNotSupportedException"), CloneNotSupportedException.class, Symbol.create("EnumConstantNotPresentException"), EnumConstantNotPresentException.class, Symbol.create("Exception"), Exception.class, Symbol.create("IllegalAccessException"), IllegalAccessException.class, Symbol.create("IllegalArgumentException"), IllegalArgumentException.class, Symbol.create("IllegalMonitorStateException"), IllegalMonitorStateException.class, Symbol.create("IllegalStateException"), IllegalStateException.class, Symbol.create("IllegalThreadStateException"), IllegalThreadStateException.class, Symbol.create("IndexOutOfBoundsException"), IndexOutOfBoundsException.class, Symbol.create("InstantiationException"), InstantiationException.class, Symbol.create("InterruptedException"), InterruptedException.class, Symbol.create("NegativeArraySizeException"), NegativeArraySizeException.class, Symbol.create("NoSuchFieldException"), NoSuchFieldException.class, Symbol.create("NoSuchMethodException"), NoSuchMethodException.class, Symbol.create("NullPointerException"), NullPointerException.class, Symbol.create("NumberFormatException"), NumberFormatException.class, Symbol.create("RuntimeException"), RuntimeException.class, Symbol.create("SecurityException"), SecurityException.class, Symbol.create("StringIndexOutOfBoundsException"), StringIndexOutOfBoundsException.class, Symbol.create("TypeNotPresentException"), TypeNotPresentException.class, Symbol.create("UnsupportedOperationException"), UnsupportedOperationException.class, Symbol.create("AbstractMethodError"), AbstractMethodError.class, Symbol.create("AssertionError"), AssertionError.class, Symbol.create("ClassCircularityError"), ClassCircularityError.class, Symbol.create("ClassFormatError"), ClassFormatError.class, Symbol.create("Error"), Error.class, Symbol.create("ExceptionInInitializerError"), ExceptionInInitializerError.class, Symbol.create("IllegalAccessError"), IllegalAccessError.class, Symbol.create("IncompatibleClassChangeError"), IncompatibleClassChangeError.class, Symbol.create("InstantiationError"), InstantiationError.class, Symbol.create("InternalError"), InternalError.class, Symbol.create("LinkageError"), LinkageError.class, Symbol.create("NoClassDefFoundError"), NoClassDefFoundError.class, Symbol.create("NoSuchFieldError"), NoSuchFieldError.class, Symbol.create("NoSuchMethodError"), NoSuchMethodError.class, Symbol.create("OutOfMemoryError"), OutOfMemoryError.class, Symbol.create("StackOverflowError"), StackOverflowError.class, Symbol.create("ThreadDeath"), ThreadDeath.class, Symbol.create("UnknownError"), UnknownError.class, Symbol.create("UnsatisfiedLinkError"), UnsatisfiedLinkError.class, Symbol.create("UnsupportedClassVersionError"), UnsupportedClassVersionError.class, Symbol.create("VerifyError"), VerifyError.class, Symbol.create("VirtualMachineError"), VirtualMachineError.class, Symbol.create("Thread$UncaughtExceptionHandler"), Thread.UncaughtExceptionHandler.class, Symbol.create("Thread$State"), Thread.State.class, Symbol.create("Deprecated"), Deprecated.class, Symbol.create("Override"), Override.class, Symbol.create("SuppressWarnings"), SuppressWarnings.class // Symbol.create("Collection"), "java.util.Collection", // Symbol.create("Comparator"), "java.util.Comparator", // Symbol.create("Enumeration"), "java.util.Enumeration", // Symbol.create("EventListener"), "java.util.EventListener", // Symbol.create("Formattable"), "java.util.Formattable", // Symbol.create("Iterator"), "java.util.Iterator", // Symbol.create("List"), "java.util.List", // Symbol.create("ListIterator"), "java.util.ListIterator", // Symbol.create("Map"), "java.util.Map", // Symbol.create("Map$Entry"), "java.util.Map$Entry", // Symbol.create("Observer"), "java.util.Observer", // Symbol.create("Queue"), "java.util.Queue", // Symbol.create("RandomAccess"), "java.util.RandomAccess", // Symbol.create("Set"), "java.util.Set", // Symbol.create("SortedMap"), "java.util.SortedMap", // Symbol.create("SortedSet"), "java.util.SortedSet" ); // single instance of UTF-8 Charset, so as to avoid catching UnsupportedCharsetExceptions everywhere static public Charset UTF8 = Charset.forName("UTF-8"); static public final Namespace CLOJURE_NS = Namespace.findOrCreate(Symbol.create("clojure.core")); //static final Namespace USER_NS = Namespace.findOrCreate(Symbol.create("user")); final static public Var OUT = Var.intern(CLOJURE_NS, Symbol.create("*out*"), new OutputStreamWriter(System.out)); final static public Var IN = Var.intern(CLOJURE_NS, Symbol.create("*in*"), new LineNumberingPushbackReader(new InputStreamReader(System.in))); final static public Var ERR = Var.intern(CLOJURE_NS, Symbol.create("*err*"), new PrintWriter(new OutputStreamWriter(System.err), true)); final static Keyword TAG_KEY = Keyword.intern(null, "tag"); final static public Var AGENT = Var.intern(CLOJURE_NS, Symbol.create("*agent*"), null); final static public Var READEVAL = Var.intern(CLOJURE_NS, Symbol.create("*read-eval*"), T); final static public Var ASSERT = Var.intern(CLOJURE_NS, Symbol.create("*assert*"), T); final static public Var MATH_CONTEXT = Var.intern(CLOJURE_NS, Symbol.create("*math-context*"), null); static Keyword LINE_KEY = Keyword.intern(null, "line"); static Keyword FILE_KEY = Keyword.intern(null, "file"); static Keyword DECLARED_KEY = Keyword.intern(null, "declared"); final static public Var USE_CONTEXT_CLASSLOADER = Var.intern(CLOJURE_NS, Symbol.create("*use-context-classloader*"), T); //final static public Var CURRENT_MODULE = Var.intern(Symbol.create("clojure.core", "current-module"), // Module.findOrCreateModule("clojure/user")); final static Symbol LOAD_FILE = Symbol.create("load-file"); final static Symbol IN_NAMESPACE = Symbol.create("in-ns"); final static Symbol NAMESPACE = Symbol.create("ns"); static final Symbol IDENTICAL = Symbol.create("identical?"); final static Var CMD_LINE_ARGS = Var.intern(CLOJURE_NS, Symbol.create("*command-line-args*"), null); //symbol final public static Var CURRENT_NS = Var.intern(CLOJURE_NS, Symbol.create("*ns*"), CLOJURE_NS); final static Var FLUSH_ON_NEWLINE = Var.intern(CLOJURE_NS, Symbol.create("*flush-on-newline*"), T); final static Var PRINT_META = Var.intern(CLOJURE_NS, Symbol.create("*print-meta*"), F); final static Var PRINT_READABLY = Var.intern(CLOJURE_NS, Symbol.create("*print-readably*"), T); final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.create("*print-dup*"), F); final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.create("*warn-on-reflection*"), F); final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.create("*allow-unresolved-vars*"), F); final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("in-ns"), F); final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("ns"), F); static final Var PRINT_INITIALIZED = Var.intern(CLOJURE_NS, Symbol.create("print-initialized")); static final Var PR_ON = Var.intern(CLOJURE_NS, Symbol.create("pr-on")); //final static Var IMPORTS = Var.intern(CLOJURE_NS, Symbol.create("*imports*"), DEFAULT_IMPORTS); final static IFn inNamespace = new AFn(){ public Object invoke(Object arg1) throws Exception{ Symbol nsname = (Symbol) arg1; Namespace ns = Namespace.findOrCreate(nsname); CURRENT_NS.set(ns); return ns; } }; final static IFn bootNamespace = new AFn(){ public Object invoke(Object __form, Object __env,Object arg1) throws Exception{ Symbol nsname = (Symbol) arg1; Namespace ns = Namespace.findOrCreate(nsname); CURRENT_NS.set(ns); return ns; } }; public static List processCommandLine(String[] args){ List arglist = Arrays.asList(args); int split = arglist.indexOf("--"); if(split >= 0) { CMD_LINE_ARGS.bindRoot(RT.seq(arglist.subList(split + 1, args.length))); return arglist.subList(0, split); } return arglist; } // duck typing stderr plays nice with e.g. swank public static PrintWriter errPrintWriter(){ Writer w = (Writer) ERR.deref(); if (w instanceof PrintWriter) { return (PrintWriter) w; } else { return new PrintWriter(w); } } static public final Object[] EMPTY_ARRAY = new Object[]{}; static public final Comparator DEFAULT_COMPARATOR = new DefaultComparator(); private static final class DefaultComparator implements Comparator, Serializable { public int compare(Object o1, Object o2){ return Util.compare(o1, o2); } private Object readResolve() throws ObjectStreamException { // ensures that we aren't hanging onto a new default comparator for every // sorted set, etc., we deserialize return DEFAULT_COMPARATOR; } } static AtomicInteger id = new AtomicInteger(1); static public void addURL(Object url) throws Exception{ URL u = (url instanceof String) ? (new URL((String) url)) : (URL) url; ClassLoader ccl = Thread.currentThread().getContextClassLoader(); if(ccl instanceof DynamicClassLoader) ((DynamicClassLoader)ccl).addURL(u); else throw new IllegalAccessError("Context classloader is not a DynamicClassLoader"); } static{ Keyword dockw = Keyword.intern(null, "doc"); Keyword arglistskw = Keyword.intern(null, "arglists"); Symbol namesym = Symbol.create("name"); OUT.setTag(Symbol.create("java.io.Writer")); CURRENT_NS.setTag(Symbol.create("clojure.lang.Namespace")); AGENT.setMeta(map(dockw, "The agent currently running an action on this thread, else nil")); AGENT.setTag(Symbol.create("clojure.lang.Agent")); MATH_CONTEXT.setTag(Symbol.create("java.math.MathContext")); Var nv = Var.intern(CLOJURE_NS, NAMESPACE, bootNamespace); nv.setMacro(); Var v; v = Var.intern(CLOJURE_NS, IN_NAMESPACE, inNamespace); v.setMeta(map(dockw, "Sets *ns* to the namespace named by the symbol, creating it if needed.", arglistskw, list(vector(namesym)))); v = Var.intern(CLOJURE_NS, LOAD_FILE, new AFn(){ public Object invoke(Object arg1) throws Exception{ return Compiler.loadFile((String) arg1); } }); v.setMeta(map(dockw, "Sequentially read and evaluate the set of forms contained in the file.", arglistskw, list(vector(namesym)))); try { doInit(); } catch(Exception e) { throw new RuntimeException(e); } } static public Var var(String ns, String name){ return Var.intern(Namespace.findOrCreate(Symbol.intern(null, ns)), Symbol.intern(null, name)); } static public Var var(String ns, String name, Object init){ return Var.intern(Namespace.findOrCreate(Symbol.intern(null, ns)), Symbol.intern(null, name), init); } public static void loadResourceScript(String name) throws Exception{ loadResourceScript(name, true); } public static void maybeLoadResourceScript(String name) throws Exception{ loadResourceScript(name, false); } public static void loadResourceScript(String name, boolean failIfNotFound) throws Exception{ loadResourceScript(RT.class, name, failIfNotFound); } public static void loadResourceScript(Class c, String name) throws Exception{ loadResourceScript(c, name, true); } public static void loadResourceScript(Class c, String name, boolean failIfNotFound) throws Exception{ int slash = name.lastIndexOf('/'); String file = slash >= 0 ? name.substring(slash + 1) : name; InputStream ins = baseLoader().getResourceAsStream(name); if(ins != null) { try { Compiler.load(new InputStreamReader(ins, UTF8), name, file); } finally { ins.close(); } } else if(failIfNotFound) { throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + name); } } static public void init() throws Exception{ RT.errPrintWriter().println("No need to call RT.init() anymore"); } static public long lastModified(URL url, String libfile) throws Exception{ if(url.getProtocol().equals("jar")) { return ((JarURLConnection) url.openConnection()).getJarFile().getEntry(libfile).getTime(); } else { return url.openConnection().getLastModified(); } } static void compile(String cljfile) throws Exception{ InputStream ins = baseLoader().getResourceAsStream(cljfile); if(ins != null) { try { Compiler.compile(new InputStreamReader(ins, UTF8), cljfile, cljfile.substring(1 + cljfile.lastIndexOf("/"))); } finally { ins.close(); } } else throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + cljfile); } static public void load(String scriptbase) throws Exception{ load(scriptbase, true); } static public void load(String scriptbase, boolean failIfNotFound) throws Exception{ String classfile = scriptbase + LOADER_SUFFIX + ".class"; String cljfile = scriptbase + ".clj"; URL classURL = baseLoader().getResource(classfile); URL cljURL = baseLoader().getResource(cljfile); boolean loaded = false; if((classURL != null && (cljURL == null || lastModified(classURL, classfile) > lastModified(cljURL, cljfile))) || classURL == null) { try { Var.pushThreadBindings( RT.map(CURRENT_NS, CURRENT_NS.deref(), WARN_ON_REFLECTION, WARN_ON_REFLECTION.deref())); loaded = (loadClassForName(scriptbase.replace('/', '.') + LOADER_SUFFIX) != null); } finally { Var.popThreadBindings(); } } if(!loaded && cljURL != null) { if(booleanCast(Compiler.COMPILE_FILES.deref())) compile(cljfile); else loadResourceScript(RT.class, cljfile); } else if(!loaded && failIfNotFound) throw new FileNotFoundException(String.format("Could not locate %s or %s on classpath: ", classfile, cljfile)); } static void doInit() throws Exception{ load("clojure/core"); load("clojure/zip", false); load("clojure/xml", false); load("clojure/set", false); Var.pushThreadBindings( RT.map(CURRENT_NS, CURRENT_NS.deref(), WARN_ON_REFLECTION, WARN_ON_REFLECTION.deref())); try { Symbol USER = Symbol.create("user"); Symbol CLOJURE = Symbol.create("clojure.core"); Var in_ns = var("clojure.core", "in-ns"); Var refer = var("clojure.core", "refer"); in_ns.invoke(USER); refer.invoke(CLOJURE); maybeLoadResourceScript("user.clj"); } finally { Var.popThreadBindings(); } } static public int nextID(){ return id.getAndIncrement(); } ////////////// Collections support ///////////////////////////////// static public ISeq seq(Object coll){ if(coll instanceof ASeq) return (ASeq) coll; else if(coll instanceof LazySeq) return ((LazySeq) coll).seq(); else return seqFrom(coll); } static ISeq seqFrom(Object coll){ if(coll instanceof Seqable) return ((Seqable) coll).seq(); else if(coll == null) return null; else if(coll instanceof Iterable) return IteratorSeq.create(((Iterable) coll).iterator()); else if(coll.getClass().isArray()) return ArraySeq.createFromObject(coll); else if(coll instanceof CharSequence) return StringSeq.create((CharSequence) coll); else if(coll instanceof Map) return seq(((Map) coll).entrySet()); else { Class c = coll.getClass(); Class sc = c.getSuperclass(); throw new IllegalArgumentException("Don't know how to create ISeq from: " + c.getName()); } } static public ISeq keys(Object coll){ return APersistentMap.KeySeq.create(seq(coll)); } static public ISeq vals(Object coll){ return APersistentMap.ValSeq.create(seq(coll)); } static public IPersistentMap meta(Object x){ if(x instanceof IMeta) return ((IMeta) x).meta(); return null; } public static int count(Object o){ if(o instanceof Counted) return ((Counted) o).count(); return countFrom(Util.ret1(o, o = null)); } static int countFrom(Object o){ if(o == null) return 0; else if(o instanceof IPersistentCollection) { ISeq s = seq(o); o = null; int i = 0; for(; s != null; s = s.next()) { if(s instanceof Counted) return i + s.count(); i++; } return i; } else if(o instanceof CharSequence) return ((CharSequence) o).length(); else if(o instanceof Collection) return ((Collection) o).size(); else if(o instanceof Map) return ((Map) o).size(); else if(o.getClass().isArray()) return Array.getLength(o); throw new UnsupportedOperationException("count not supported on this type: " + o.getClass().getSimpleName()); } static public IPersistentCollection conj(IPersistentCollection coll, Object x){ if(coll == null) return new PersistentList(x); return coll.cons(x); } static public ISeq cons(Object x, Object coll){ //ISeq y = seq(coll); if(coll == null) return new PersistentList(x); else if(coll instanceof ISeq) return new Cons(x, (ISeq) coll); else return new Cons(x, seq(coll)); } static public Object first(Object x){ if(x instanceof ISeq) return ((ISeq) x).first(); ISeq seq = seq(x); if(seq == null) return null; return seq.first(); } static public Object second(Object x){ return first(next(x)); } static public Object third(Object x){ return first(next(next(x))); } static public Object fourth(Object x){ return first(next(next(next(x)))); } static public ISeq next(Object x){ if(x instanceof ISeq) return ((ISeq) x).next(); ISeq seq = seq(x); if(seq == null) return null; return seq.next(); } static public ISeq more(Object x){ if(x instanceof ISeq) return ((ISeq) x).more(); ISeq seq = seq(x); if(seq == null) return PersistentList.EMPTY; return seq.more(); } //static public Seqable more(Object x){ // Seqable ret = null; // if(x instanceof ISeq) // ret = ((ISeq) x).more(); // else // { // ISeq seq = seq(x); // if(seq == null) // ret = PersistentList.EMPTY; // else // ret = seq.more(); // } // if(ret == null) // ret = PersistentList.EMPTY; // return ret; //} static public Object peek(Object x){ if(x == null) return null; return ((IPersistentStack) x).peek(); } static public Object pop(Object x){ if(x == null) return null; return ((IPersistentStack) x).pop(); } static public Object get(Object coll, Object key){ if(coll instanceof ILookup) return ((ILookup) coll).valAt(key); return getFrom(coll, key); } static Object getFrom(Object coll, Object key){ if(coll == null) return null; else if(coll instanceof Map) { Map m = (Map) coll; return m.get(key); } else if(coll instanceof IPersistentSet) { IPersistentSet set = (IPersistentSet) coll; return set.get(key); } else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { int n = ((Number) key).intValue(); if(n >= 0 && n < count(coll)) return nth(coll, n); return null; } return null; } static public Object get(Object coll, Object key, Object notFound){ if(coll instanceof ILookup) return ((ILookup) coll).valAt(key, notFound); return getFrom(coll, key, notFound); } static Object getFrom(Object coll, Object key, Object notFound){ if(coll == null) return notFound; else if(coll instanceof Map) { Map m = (Map) coll; if(m.containsKey(key)) return m.get(key); return notFound; } else if(coll instanceof IPersistentSet) { IPersistentSet set = (IPersistentSet) coll; if(set.contains(key)) return set.get(key); return notFound; } else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { int n = ((Number) key).intValue(); return n >= 0 && n < count(coll) ? nth(coll, n) : notFound; } return notFound; } static public Associative assoc(Object coll, Object key, Object val){ if(coll == null) return new PersistentArrayMap(new Object[]{key, val}); return ((Associative) coll).assoc(key, val); } static public Object contains(Object coll, Object key){ if(coll == null) return F; else if(coll instanceof Associative) return ((Associative) coll).containsKey(key) ? T : F; else if(coll instanceof IPersistentSet) return ((IPersistentSet) coll).contains(key) ? T : F; else if(coll instanceof Map) { Map m = (Map) coll; return m.containsKey(key) ? T : F; } else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) { int n = ((Number) key).intValue(); return n >= 0 && n < count(coll); } return F; } static public Object find(Object coll, Object key){ if(coll == null) return null; else if(coll instanceof Associative) return ((Associative) coll).entryAt(key); else { Map m = (Map) coll; if(m.containsKey(key)) return new MapEntry(key, m.get(key)); return null; } } //takes a seq of key,val,key,val //returns tail starting at val of matching key if found, else null static public ISeq findKey(Keyword key, ISeq keyvals) throws Exception{ while(keyvals != null) { ISeq r = keyvals.next(); if(r == null) throw new Exception("Malformed keyword argslist"); if(keyvals.first() == key) return r; keyvals = r.next(); } return null; } static public Object dissoc(Object coll, Object key) throws Exception{ if(coll == null) return null; return ((IPersistentMap) coll).without(key); } static public Object nth(Object coll, int n){ if(coll instanceof Indexed) return ((Indexed) coll).nth(n); return nthFrom(Util.ret1(coll, coll = null), n); } static Object nthFrom(Object coll, int n){ if(coll == null) return null; else if(coll instanceof CharSequence) return Character.valueOf(((CharSequence) coll).charAt(n)); else if(coll.getClass().isArray()) return Reflector.prepRet(Array.get(coll, n)); else if(coll instanceof RandomAccess) return ((List) coll).get(n); else if(coll instanceof Matcher) return ((Matcher) coll).group(n); else if(coll instanceof Map.Entry) { Map.Entry e = (Map.Entry) coll; if(n == 0) return e.getKey(); else if(n == 1) return e.getValue(); throw new IndexOutOfBoundsException(); } else if(coll instanceof Sequential) { ISeq seq = RT.seq(coll); coll = null; for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) { if(i == n) return seq.first(); } throw new IndexOutOfBoundsException(); } else throw new UnsupportedOperationException( "nth not supported on this type: " + coll.getClass().getSimpleName()); } static public Object nth(Object coll, int n, Object notFound){ if(coll instanceof Indexed) { Indexed v = (Indexed) coll; return v.nth(n, notFound); } return nthFrom(coll, n, notFound); } static Object nthFrom(Object coll, int n, Object notFound){ if(coll == null) return notFound; else if(n < 0) return notFound; else if(coll instanceof CharSequence) { CharSequence s = (CharSequence) coll; if(n < s.length()) return Character.valueOf(s.charAt(n)); return notFound; } else if(coll.getClass().isArray()) { if(n < Array.getLength(coll)) return Reflector.prepRet(Array.get(coll, n)); return notFound; } else if(coll instanceof RandomAccess) { List list = (List) coll; if(n < list.size()) return list.get(n); return notFound; } else if(coll instanceof Matcher) { Matcher m = (Matcher) coll; if(n < m.groupCount()) return m.group(n); return notFound; } else if(coll instanceof Map.Entry) { Map.Entry e = (Map.Entry) coll; if(n == 0) return e.getKey(); else if(n == 1) return e.getValue(); return notFound; } else if(coll instanceof Sequential) { ISeq seq = RT.seq(coll); coll = null; for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) { if(i == n) return seq.first(); } return notFound; } else throw new UnsupportedOperationException( "nth not supported on this type: " + coll.getClass().getSimpleName()); } static public Object assocN(int n, Object val, Object coll){ if(coll == null) return null; else if(coll instanceof IPersistentVector) return ((IPersistentVector) coll).assocN(n, val); else if(coll instanceof Object[]) { //hmm... this is not persistent Object[] array = ((Object[]) coll); array[n] = val; return array; } else return null; } static boolean hasTag(Object o, Object tag){ return Util.equals(tag, RT.get(RT.meta(o), TAG_KEY)); } /** * ********************* Boxing/casts ****************************** */ static public Object box(Object x){ return x; } static public Character box(char x){ return Character.valueOf(x); } static public Object box(boolean x){ return x ? T : F; } static public Object box(Boolean x){ return x;// ? T : null; } static public Number box(byte x){ return x;//Num.from(x); } static public Number box(short x){ return x;//Num.from(x); } static public Number box(int x){ return x;//Num.from(x); } static public Number box(long x){ return x;//Num.from(x); } static public Number box(float x){ return x;//Num.from(x); } static public Number box(double x){ return x;//Num.from(x); } static public char charCast(Object x){ if(x instanceof Character) return ((Character) x).charValue(); long n = ((Number) x).longValue(); if(n < Character.MIN_VALUE || n > Character.MAX_VALUE) throw new IllegalArgumentException("Value out of range for char: " + x); return (char) n; } static public boolean booleanCast(Object x){ if(x instanceof Boolean) return ((Boolean) x).booleanValue(); return x != null; } static public boolean booleanCast(boolean x){ return x; } static public byte byteCast(Object x){ long n = ((Number) x).longValue(); if(n < Byte.MIN_VALUE || n > Byte.MAX_VALUE) throw new IllegalArgumentException("Value out of range for byte: " + x); return (byte) n; } static public short shortCast(Object x){ long n = ((Number) x).longValue(); if(n < Short.MIN_VALUE || n > Short.MAX_VALUE) throw new IllegalArgumentException("Value out of range for short: " + x); return (short) n; } static public int intCast(Object x){ if(x instanceof Integer) return ((Integer)x).intValue(); if(x instanceof Number) return intCast(((Number) x).longValue()); return ((Character) x).charValue(); } static public int intCast(char x){ return x; } static public int intCast(byte x){ return x; } static public int intCast(short x){ return x; } static public int intCast(int x){ return x; } static public int intCast(float x){ if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) throw new IllegalArgumentException("Value out of range for int: " + x); return (int) x; } static public int intCast(long x){ if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) throw new IllegalArgumentException("Value out of range for int: " + x); return (int) x; } static public int intCast(double x){ if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE) throw new IllegalArgumentException("Value out of range for int: " + x); return (int) x; } static public long longCast(Object x){ return ((Number) x).longValue(); } static public long longCast(int x){ return x; } static public long longCast(float x){ if(x < Long.MIN_VALUE || x > Long.MAX_VALUE) throw new IllegalArgumentException("Value out of range for long: " + x); return (long) x; } static public long longCast(long x){ return x; } static public long longCast(double x){ if(x < Long.MIN_VALUE || x > Long.MAX_VALUE) throw new IllegalArgumentException("Value out of range for long: " + x); return (long) x; } static public float floatCast(Object x){ if(x instanceof Float) return ((Float) x).floatValue(); double n = ((Number) x).doubleValue(); if(n < -Float.MAX_VALUE || n > Float.MAX_VALUE) throw new IllegalArgumentException("Value out of range for float: " + x); return (float) n; } static public float floatCast(int x){ return x; } static public float floatCast(float x){ return x; } static public float floatCast(long x){ return x; } static public float floatCast(double x){ if(x < -Float.MAX_VALUE || x > Float.MAX_VALUE) throw new IllegalArgumentException("Value out of range for float: " + x); return (float) x; } static public double doubleCast(Object x){ return ((Number) x).doubleValue(); } static public double doubleCast(int x){ return x; } static public double doubleCast(float x){ return x; } static public double doubleCast(long x){ return x; } static public double doubleCast(double x){ return x; } static public IPersistentMap map(Object... init){ if(init == null) return PersistentArrayMap.EMPTY; else if(init.length <= PersistentArrayMap.HASHTABLE_THRESHOLD) return PersistentArrayMap.createWithCheck(init); return PersistentHashMap.createWithCheck(init); } static public IPersistentSet set(Object... init){ return PersistentHashSet.createWithCheck(init); } static public IPersistentVector vector(Object... init){ return LazilyPersistentVector.createOwning(init); } static public IPersistentVector subvec(IPersistentVector v, int start, int end){ if(end < start || start < 0 || end > v.count()) throw new IndexOutOfBoundsException(); if(start == end) return PersistentVector.EMPTY; return new APersistentVector.SubVector(null, v, start, end); } /** * **************************************** list support ******************************* */ static public ISeq list(){ return null; } static public ISeq list(Object arg1){ return new PersistentList(arg1); } static public ISeq list(Object arg1, Object arg2){ return listStar(arg1, arg2, null); } static public ISeq list(Object arg1, Object arg2, Object arg3){ return listStar(arg1, arg2, arg3, null); } static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4){ return listStar(arg1, arg2, arg3, arg4, null); } static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5){ return listStar(arg1, arg2, arg3, arg4, arg5, null); } static public ISeq listStar(Object arg1, ISeq rest){ return (ISeq) cons(arg1, rest); } static public ISeq listStar(Object arg1, Object arg2, ISeq rest){ return (ISeq) cons(arg1, cons(arg2, rest)); } static public ISeq listStar(Object arg1, Object arg2, Object arg3, ISeq rest){ return (ISeq) cons(arg1, cons(arg2, cons(arg3, rest))); } static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, ISeq rest){ return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, rest)))); } static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, ISeq rest){ return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, cons(arg5, rest))))); } static public ISeq arrayToList(Object[] a) throws Exception{ ISeq ret = null; for(int i = a.length - 1; i >= 0; --i) ret = (ISeq) cons(a[i], ret); return ret; } static public Object[] object_array(Object sizeOrSeq){ if(sizeOrSeq instanceof Number) return new Object[((Number) sizeOrSeq).intValue()]; else { ISeq s = RT.seq(sizeOrSeq); int size = RT.count(s); Object[] ret = new Object[size]; for(int i = 0; i < size && s != null; i++, s = s.next()) ret[i] = s.first(); return ret; } } static public Object[] toArray(Object coll) throws Exception{ if(coll == null) return EMPTY_ARRAY; else if(coll instanceof Object[]) return (Object[]) coll; else if(coll instanceof Collection) return ((Collection) coll).toArray(); else if(coll instanceof Map) return ((Map) coll).entrySet().toArray(); else if(coll instanceof String) { char[] chars = ((String) coll).toCharArray(); Object[] ret = new Object[chars.length]; for(int i = 0; i < chars.length; i++) ret[i] = chars[i]; return ret; } else if(coll.getClass().isArray()) { ISeq s = (seq(coll)); Object[] ret = new Object[count(s)]; for(int i = 0; i < ret.length; i++, s = s.next()) ret[i] = s.first(); return ret; } else throw new Exception("Unable to convert: " + coll.getClass() + " to Object[]"); } static public Object[] seqToArray(ISeq seq){ int len = length(seq); Object[] ret = new Object[len]; for(int i = 0; seq != null; ++i, seq = seq.next()) ret[i] = seq.first(); return ret; } static public Object seqToTypedArray(ISeq seq) throws Exception{ Class type = (seq != null) ? seq.first().getClass() : Object.class; return seqToTypedArray(type, seq); } static public Object seqToTypedArray(Class type, ISeq seq) throws Exception{ Object ret = Array.newInstance(type, length(seq)); for(int i = 0; seq != null; ++i, seq = seq.next()) Array.set(ret, i, seq.first()); return ret; } static public int length(ISeq list){ int i = 0; for(ISeq c = list; c != null; c = c.next()) { i++; } return i; } static public int boundedLength(ISeq list, int limit) throws Exception{ int i = 0; for(ISeq c = list; c != null && i <= limit; c = c.next()) { i++; } return i; } ///////////////////////////////// reader support //////////////////////////////// static Character readRet(int ret){ if(ret == -1) return null; return box((char) ret); } static public Character readChar(Reader r) throws Exception{ int ret = r.read(); return readRet(ret); } static public Character peekChar(Reader r) throws Exception{ int ret; if(r instanceof PushbackReader) { ret = r.read(); ((PushbackReader) r).unread(ret); } else { r.mark(1); ret = r.read(); r.reset(); } return readRet(ret); } static public int getLineNumber(Reader r){ if(r instanceof LineNumberingPushbackReader) return ((LineNumberingPushbackReader) r).getLineNumber(); return 0; } static public LineNumberingPushbackReader getLineNumberingReader(Reader r){ if(isLineNumberingReader(r)) return (LineNumberingPushbackReader) r; return new LineNumberingPushbackReader(r); } static public boolean isLineNumberingReader(Reader r){ return r instanceof LineNumberingPushbackReader; } static public String resolveClassNameInContext(String className){ //todo - look up in context var return className; } static public boolean suppressRead(){ //todo - look up in suppress-read var return false; } static public String printString(Object x){ try { StringWriter sw = new StringWriter(); print(x, sw); return sw.toString(); } catch(Exception e) { throw new RuntimeException(e); } } static public Object readString(String s){ PushbackReader r = new PushbackReader(new StringReader(s)); try { return LispReader.read(r, true, null, false); } catch(Exception e) { throw new RuntimeException(e); } } static public void print(Object x, Writer w) throws Exception{ //call multimethod if(PRINT_INITIALIZED.isBound() && RT.booleanCast(PRINT_INITIALIZED.deref())) PR_ON.invoke(x, w); //* else { boolean readably = booleanCast(PRINT_READABLY.deref()); if(x instanceof Obj) { Obj o = (Obj) x; if(RT.count(o.meta()) > 0 && ((readably && booleanCast(PRINT_META.deref())) || booleanCast(PRINT_DUP.deref()))) { IPersistentMap meta = o.meta(); w.write("#^"); if(meta.count() == 1 && meta.containsKey(TAG_KEY)) print(meta.valAt(TAG_KEY), w); else print(meta, w); w.write(' '); } } if(x == null) w.write("nil"); else if(x instanceof ISeq || x instanceof IPersistentList) { w.write('('); printInnerSeq(seq(x), w); w.write(')'); } else if(x instanceof String) { String s = (String) x; if(!readably) w.write(s); else { w.write('"'); //w.write(x.toString()); for(int i = 0; i < s.length(); i++) { char c = s.charAt(i); switch(c) { case '\n': w.write("\\n"); break; case '\t': w.write("\\t"); break; case '\r': w.write("\\r"); break; case '"': w.write("\\\""); break; case '\\': w.write("\\\\"); break; case '\f': w.write("\\f"); break; case '\b': w.write("\\b"); break; default: w.write(c); } } w.write('"'); } } else if(x instanceof IPersistentMap) { w.write('{'); for(ISeq s = seq(x); s != null; s = s.next()) { IMapEntry e = (IMapEntry) s.first(); print(e.key(), w); w.write(' '); print(e.val(), w); if(s.next() != null) w.write(", "); } w.write('}'); } else if(x instanceof IPersistentVector) { IPersistentVector a = (IPersistentVector) x; w.write('['); for(int i = 0; i < a.count(); i++) { print(a.nth(i), w); if(i < a.count() - 1) w.write(' '); } w.write(']'); } else if(x instanceof IPersistentSet) { w.write("#{"); for(ISeq s = seq(x); s != null; s = s.next()) { print(s.first(), w); if(s.next() != null) w.write(" "); } w.write('}'); } else if(x instanceof Character) { char c = ((Character) x).charValue(); if(!readably) w.write(c); else { w.write('\\'); switch(c) { case '\n': w.write("newline"); break; case '\t': w.write("tab"); break; case ' ': w.write("space"); break; case '\b': w.write("backspace"); break; case '\f': w.write("formfeed"); break; case '\r': w.write("return"); break; default: w.write(c); } } } else if(x instanceof Class) { w.write("#="); w.write(((Class) x).getName()); } else if(x instanceof BigDecimal && readably) { w.write(x.toString()); w.write('M'); } else if(x instanceof Var) { Var v = (Var) x; w.write("#=(var " + v.ns.name + "/" + v.sym + ")"); } else if(x instanceof Pattern) { Pattern p = (Pattern) x; w.write("#\"" + p.pattern() + "\""); } else w.write(x.toString()); } //*/ } private static void printInnerSeq(ISeq x, Writer w) throws Exception{ for(ISeq s = x; s != null; s = s.next()) { print(s.first(), w); if(s.next() != null) w.write(' '); } } static public void formatAesthetic(Writer w, Object obj) throws IOException{ if(obj == null) w.write("null"); else w.write(obj.toString()); } static public void formatStandard(Writer w, Object obj) throws IOException{ if(obj == null) w.write("null"); else if(obj instanceof String) { w.write('"'); w.write((String) obj); w.write('"'); } else if(obj instanceof Character) { w.write('\\'); char c = ((Character) obj).charValue(); switch(c) { case '\n': w.write("newline"); break; case '\t': w.write("tab"); break; case ' ': w.write("space"); break; case '\b': w.write("backspace"); break; case '\f': w.write("formfeed"); break; default: w.write(c); } } else w.write(obj.toString()); } static public Object format(Object o, String s, Object... args) throws Exception{ Writer w; if(o == null) w = new StringWriter(); else if(Util.equals(o, T)) w = (Writer) OUT.deref(); else w = (Writer) o; doFormat(w, s, ArraySeq.create(args)); if(o == null) return w.toString(); return null; } static public ISeq doFormat(Writer w, String s, ISeq args) throws Exception{ for(int i = 0; i < s.length();) { char c = s.charAt(i++); switch(Character.toLowerCase(c)) { case '~': char d = s.charAt(i++); switch(Character.toLowerCase(d)) { case '%': w.write('\n'); break; case 't': w.write('\t'); break; case 'a': if(args == null) throw new IllegalArgumentException("Missing argument"); RT.formatAesthetic(w, RT.first(args)); args = RT.next(args); break; case 's': if(args == null) throw new IllegalArgumentException("Missing argument"); RT.formatStandard(w, RT.first(args)); args = RT.next(args); break; case '{': int j = s.indexOf("~}", i); //note - does not nest if(j == -1) throw new IllegalArgumentException("Missing ~}"); String subs = s.substring(i, j); for(ISeq sargs = RT.seq(RT.first(args)); sargs != null;) sargs = doFormat(w, subs, sargs); args = RT.next(args); i = j + 2; //skip ~} break; case '^': if(args == null) return null; break; case '~': w.write('~'); break; default: throw new IllegalArgumentException("Unsupported ~ directive: " + d); } break; default: w.write(c); } } return args; } ///////////////////////////////// values ////////////////////////// static public Object[] setValues(Object... vals){ //ThreadLocalData.setValues(vals); if(vals.length > 0) return vals;//[0]; return null; } static public ClassLoader makeClassLoader(){ return (ClassLoader) AccessController.doPrivileged(new PrivilegedAction(){ public Object run(){ try{ Var.pushThreadBindings(RT.map(USE_CONTEXT_CLASSLOADER, RT.T)); // getRootClassLoader(); return new DynamicClassLoader(baseLoader()); } finally{ Var.popThreadBindings(); } } }); } static public ClassLoader baseLoader(){ if(Compiler.LOADER.isBound()) return (ClassLoader) Compiler.LOADER.deref(); else if(booleanCast(USE_CONTEXT_CLASSLOADER.deref())) return Thread.currentThread().getContextClassLoader(); return Compiler.class.getClassLoader(); } static public Class classForName(String name) throws ClassNotFoundException{ return Class.forName(name, true, baseLoader()); } static public Class loadClassForName(String name) throws ClassNotFoundException{ try { Class.forName(name, false, baseLoader()); } catch(ClassNotFoundException e) { return null; } return Class.forName(name, true, baseLoader()); } static public float aget(float[] xs, int i){ return xs[i]; } static public float aset(float[] xs, int i, float v){ xs[i] = v; return v; } static public int alength(float[] xs){ return xs.length; } static public float[] aclone(float[] xs){ return xs.clone(); } static public double aget(double[] xs, int i){ return xs[i]; } static public double aset(double[] xs, int i, double v){ xs[i] = v; return v; } static public int alength(double[] xs){ return xs.length; } static public double[] aclone(double[] xs){ return xs.clone(); } static public int aget(int[] xs, int i){ return xs[i]; } static public int aset(int[] xs, int i, int v){ xs[i] = v; return v; } static public int alength(int[] xs){ return xs.length; } static public int[] aclone(int[] xs){ return xs.clone(); } static public long aget(long[] xs, int i){ return xs[i]; } static public long aset(long[] xs, int i, long v){ xs[i] = v; return v; } static public int alength(long[] xs){ return xs.length; } static public long[] aclone(long[] xs){ return xs.clone(); } static public char aget(char[] xs, int i){ return xs[i]; } static public char aset(char[] xs, int i, char v){ xs[i] = v; return v; } static public int alength(char[] xs){ return xs.length; } static public char[] aclone(char[] xs){ return xs.clone(); } static public byte aget(byte[] xs, int i){ return xs[i]; } static public byte aset(byte[] xs, int i, byte v){ xs[i] = v; return v; } static public int alength(byte[] xs){ return xs.length; } static public byte[] aclone(byte[] xs){ return xs.clone(); } static public short aget(short[] xs, int i){ return xs[i]; } static public short aset(short[] xs, int i, short v){ xs[i] = v; return v; } static public int alength(short[] xs){ return xs.length; } static public short[] aclone(short[] xs){ return xs.clone(); } static public boolean aget(boolean[] xs, int i){ return xs[i]; } static public boolean aset(boolean[] xs, int i, boolean v){ xs[i] = v; return v; } static public int alength(boolean[] xs){ return xs.length; } static public boolean[] aclone(boolean[] xs){ return xs.clone(); } static public Object aget(Object[] xs, int i){ return xs[i]; } static public Object aset(Object[] xs, int i, Object v){ xs[i] = v; return v; } static public int alength(Object[] xs){ return xs.length; } static public Object[] aclone(Object[] xs){ return xs.clone(); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Range.java000066400000000000000000000025531157562347600232320ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Apr 1, 2008 */ package clojure.lang; public class Range extends ASeq implements IReduce, Counted{ final int end; final int n; public Range(int start, int end){ this.end = end; this.n = start; } public Range(IPersistentMap meta, int start, int end){ super(meta); this.end = end; this.n = start; } public Obj withMeta(IPersistentMap meta){ if(meta == meta()) return this; return new Range(meta(), end, n); } public Object first(){ return n; } public ISeq next(){ if(n < end-1) return new Range(_meta, n + 1, end); return null; } public Object reduce(IFn f) throws Exception{ Object ret = n; for(int x = n+1;x < end;x++) ret = f.invoke(ret, x); return ret; } public Object reduce(IFn f, Object start) throws Exception{ Object ret = f.invoke(start,n); for(int x = n+1;x < end;x++) ret = f.invoke(ret, x); return ret; } public int count() { return end - n; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Ratio.java000066400000000000000000000037131157562347600232530ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 31, 2008 */ package clojure.lang; import java.math.BigInteger; import java.math.BigDecimal; import java.math.MathContext; public class Ratio extends Number implements Comparable{ final public BigInteger numerator; final public BigInteger denominator; public Ratio(BigInteger numerator, BigInteger denominator){ this.numerator = numerator; this.denominator = denominator; } public boolean equals(Object arg0){ return arg0 != null && arg0 instanceof Ratio && ((Ratio) arg0).numerator.equals(numerator) && ((Ratio) arg0).denominator.equals(denominator); } public int hashCode(){ return numerator.hashCode() ^ denominator.hashCode(); } public String toString(){ return numerator.toString() + "/" + denominator.toString(); } public int intValue(){ return (int) doubleValue(); } public long longValue(){ return bigIntegerValue().longValue(); } public float floatValue(){ return (float)doubleValue(); } public double doubleValue(){ return decimalValue(MathContext.DECIMAL64).doubleValue(); } public BigDecimal decimalValue(){ return decimalValue(MathContext.UNLIMITED); } public BigDecimal decimalValue(MathContext mc){ BigDecimal numerator = new BigDecimal(this.numerator); BigDecimal denominator = new BigDecimal(this.denominator); return numerator.divide(denominator, mc); } public BigInteger bigIntegerValue(){ return numerator.divide(denominator); } public int compareTo(Object o){ Number other = (Number)o; return Numbers.compare(this, other); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Ref.java000066400000000000000000000260631157562347600227140ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 25, 2007 */ package clojure.lang; import java.util.concurrent.atomic.AtomicInteger; import java.util.concurrent.atomic.AtomicLong; import java.util.concurrent.locks.ReentrantReadWriteLock; public class Ref extends ARef implements IFn, Comparable, IRef{ public int compareTo(Ref ref) { if(this.id == ref.id) return 0; else if(this.id < ref.id) return -1; else return 1; } public int getMinHistory(){ return minHistory; } public Ref setMinHistory(int minHistory){ this.minHistory = minHistory; return this; } public int getMaxHistory(){ return maxHistory; } public Ref setMaxHistory(int maxHistory){ this.maxHistory = maxHistory; return this; } public static class TVal{ Object val; long point; long msecs; TVal prior; TVal next; TVal(Object val, long point, long msecs, TVal prior){ this.val = val; this.point = point; this.msecs = msecs; this.prior = prior; this.next = prior.next; this.prior.next = this; this.next.prior = this; } TVal(Object val, long point, long msecs){ this.val = val; this.point = point; this.msecs = msecs; this.next = this; this.prior = this; } } TVal tvals; final AtomicInteger faults; final ReentrantReadWriteLock lock; LockingTransaction.Info tinfo; //IFn validator; final long id; volatile int minHistory = 0; volatile int maxHistory = 10; static final AtomicLong ids = new AtomicLong(); public Ref(Object initVal) throws Exception{ this(initVal, null); } public Ref(Object initVal,IPersistentMap meta) throws Exception{ super(meta); this.id = ids.getAndIncrement(); this.faults = new AtomicInteger(); this.lock = new ReentrantReadWriteLock(); tvals = new TVal(initVal, 0, System.currentTimeMillis()); } //the latest val // ok out of transaction Object currentVal(){ try { lock.readLock().lock(); if(tvals != null) return tvals.val; throw new IllegalStateException(this.toString() + " is unbound."); } finally { lock.readLock().unlock(); } } //* public Object deref(){ LockingTransaction t = LockingTransaction.getRunning(); if(t == null) return currentVal(); return t.doGet(this); } //void validate(IFn vf, Object val){ // try{ // if(vf != null && !RT.booleanCast(vf.invoke(val))) // throw new IllegalStateException("Invalid ref state"); // } // catch(RuntimeException re) // { // throw re; // } // catch(Exception e) // { // throw new IllegalStateException("Invalid ref state", e); // } //} // //public void setValidator(IFn vf){ // try // { // lock.writeLock().lock(); // validate(vf,currentVal()); // validator = vf; // } // finally // { // lock.writeLock().unlock(); // } //} // //public IFn getValidator(){ // try // { // lock.readLock().lock(); // return validator; // } // finally // { // lock.readLock().unlock(); // } //} public Object set(Object val){ return LockingTransaction.getEx().doSet(this, val); } public Object commute(IFn fn, ISeq args) throws Exception{ return LockingTransaction.getEx().doCommute(this, fn, args); } public Object alter(IFn fn, ISeq args) throws Exception{ LockingTransaction t = LockingTransaction.getEx(); return t.doSet(this, fn.applyTo(RT.cons(t.doGet(this), args))); } public void touch(){ LockingTransaction.getEx().doEnsure(this); } //*/ boolean isBound(){ try { lock.readLock().lock(); return tvals != null; } finally { lock.readLock().unlock(); } } public void trimHistory(){ try { lock.writeLock().lock(); if(tvals != null) { tvals.next = tvals; tvals.prior = tvals; } } finally { lock.writeLock().unlock(); } } public int getHistoryCount(){ try { lock.writeLock().lock(); return histCount(); } finally { lock.writeLock().unlock(); } } int histCount(){ if(tvals == null) return 0; else { int count = 0; for(TVal tv = tvals.next;tv != tvals;tv = tv.next) count++; return count; } } final public IFn fn(){ return (IFn) deref(); } public Object call() throws Exception{ return invoke(); } public void run(){ try { invoke(); } catch(Exception e) { throw new RuntimeException(e); } } public Object invoke() throws Exception{ return fn().invoke(); } public Object invoke(Object arg1) throws Exception{ return fn().invoke(arg1); } public Object invoke(Object arg1, Object arg2) throws Exception{ return fn().invoke(arg1, arg2); } public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ return fn().invoke(arg1, arg2, arg3); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20, args); } public Object applyTo(ISeq arglist) throws Exception{ return AFn.applyToHelper(this, arglist); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Reflector.java000066400000000000000000000310151157562347600241160ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Apr 19, 2006 */ package clojure.lang; import java.lang.reflect.*; import java.util.ArrayList; import java.util.Iterator; import java.util.List; import java.util.Arrays; public class Reflector{ public static Object invokeInstanceMethod(Object target, String methodName, Object[] args) throws Exception{ try { Class c = target.getClass(); List methods = getMethods(c, args.length, methodName, false); return invokeMatchingMethod(methodName, methods, target, args); } catch(InvocationTargetException e) { if(e.getCause() instanceof Exception) throw (Exception) e.getCause(); else if(e.getCause() instanceof Error) throw (Error) e.getCause(); throw e; } } private static String noMethodReport(String methodName, Object target){ return "No matching method found: " + methodName + (target==null?"":" for " + target.getClass()); } static Object invokeMatchingMethod(String methodName, List methods, Object target, Object[] args) throws Exception{ Method m = null; Object[] boxedArgs = null; if(methods.isEmpty()) { throw new IllegalArgumentException(noMethodReport(methodName,target)); } else if(methods.size() == 1) { m = (Method) methods.get(0); boxedArgs = boxArgs(m.getParameterTypes(), args); } else //overloaded w/same arity { Method foundm = null; for(Iterator i = methods.iterator(); i.hasNext();) { m = (Method) i.next(); Class[] params = m.getParameterTypes(); if(isCongruent(params, args)) { if(foundm == null || Compiler.subsumes(params, foundm.getParameterTypes())) { foundm = m; boxedArgs = boxArgs(params, args); } } } m = foundm; } if(m == null) throw new IllegalArgumentException(noMethodReport(methodName,target)); if(!Modifier.isPublic(m.getDeclaringClass().getModifiers())) { //public method of non-public class, try to find it in hierarchy Method oldm = m; m = getAsMethodOfPublicBase(m.getDeclaringClass(), m); if(m == null) throw new IllegalArgumentException("Can't call public method of non-public class: " + oldm.toString()); } try { return prepRet(m.invoke(target, boxedArgs)); } catch(InvocationTargetException e) { if(e.getCause() instanceof Exception) throw (Exception) e.getCause(); else if(e.getCause() instanceof Error) throw (Error) e.getCause(); throw e; } } public static Method getAsMethodOfPublicBase(Class c, Method m){ for(Class iface : c.getInterfaces()) { for(Method im : iface.getMethods()) { if(im.getName().equals(m.getName()) && Arrays.equals(m.getParameterTypes(), im.getParameterTypes())) { return im; } } } Class sc = c.getSuperclass(); if(sc == null) return null; for(Method scm : sc.getMethods()) { if(scm.getName().equals(m.getName()) && Arrays.equals(m.getParameterTypes(), scm.getParameterTypes()) && Modifier.isPublic(scm.getDeclaringClass().getModifiers())) { return scm; } } return getAsMethodOfPublicBase(sc, m); } public static Object invokeConstructor(Class c, Object[] args) throws Exception{ try { Constructor[] allctors = c.getConstructors(); ArrayList ctors = new ArrayList(); for(int i = 0; i < allctors.length; i++) { Constructor ctor = allctors[i]; if(ctor.getParameterTypes().length == args.length) ctors.add(ctor); } if(ctors.isEmpty()) { throw new IllegalArgumentException("No matching ctor found" + " for " + c); } else if(ctors.size() == 1) { Constructor ctor = (Constructor) ctors.get(0); return ctor.newInstance(boxArgs(ctor.getParameterTypes(), args)); } else //overloaded w/same arity { for(Iterator iterator = ctors.iterator(); iterator.hasNext();) { Constructor ctor = (Constructor) iterator.next(); Class[] params = ctor.getParameterTypes(); if(isCongruent(params, args)) { Object[] boxedArgs = boxArgs(params, args); return ctor.newInstance(boxedArgs); } } throw new IllegalArgumentException("No matching ctor found" + " for " + c); } } catch(InvocationTargetException e) { if(e.getCause() instanceof Exception) throw (Exception) e.getCause(); else if(e.getCause() instanceof Error) throw (Error) e.getCause(); throw e; } } public static Object invokeStaticMethodVariadic(String className, String methodName, Object... args) throws Exception{ return invokeStaticMethod(className, methodName, args); } public static Object invokeStaticMethod(String className, String methodName, Object[] args) throws Exception{ Class c = RT.classForName(className); try { return invokeStaticMethod(c, methodName, args); } catch(InvocationTargetException e) { if(e.getCause() instanceof Exception) throw (Exception) e.getCause(); else if(e.getCause() instanceof Error) throw (Error) e.getCause(); throw e; } } public static Object invokeStaticMethod(Class c, String methodName, Object[] args) throws Exception{ if(methodName.equals("new")) return invokeConstructor(c, args); List methods = getMethods(c, args.length, methodName, true); return invokeMatchingMethod(methodName, methods, null, args); } public static Object getStaticField(String className, String fieldName) throws Exception{ Class c = RT.classForName(className); return getStaticField(c, fieldName); } public static Object getStaticField(Class c, String fieldName) throws Exception{ // if(fieldName.equals("class")) // return c; Field f = getField(c, fieldName, true); if(f != null) { return prepRet(f.get(null)); } throw new IllegalArgumentException("No matching field found: " + fieldName + " for " + c); } public static Object setStaticField(String className, String fieldName, Object val) throws Exception{ Class c = RT.classForName(className); return setStaticField(c, fieldName, val); } public static Object setStaticField(Class c, String fieldName, Object val) throws Exception{ Field f = getField(c, fieldName, true); if(f != null) { f.set(null, boxArg(f.getType(), val)); return val; } throw new IllegalArgumentException("No matching field found: " + fieldName + " for " + c); } public static Object getInstanceField(Object target, String fieldName) throws Exception{ Class c = target.getClass(); Field f = getField(c, fieldName, false); if(f != null) { return prepRet(f.get(target)); } throw new IllegalArgumentException("No matching field found: " + fieldName + " for " + target.getClass()); } public static Object setInstanceField(Object target, String fieldName, Object val) throws Exception{ Class c = target.getClass(); Field f = getField(c, fieldName, false); if(f != null) { f.set(target, boxArg(f.getType(), val)); return val; } throw new IllegalArgumentException("No matching field found: " + fieldName + " for " + target.getClass()); } public static Object invokeNoArgInstanceMember(Object target, String name) throws Exception{ //favor method over field List meths = getMethods(target.getClass(), 0, name, false); if(meths.size() > 0) return invokeMatchingMethod(name, meths, target, RT.EMPTY_ARRAY); else return getInstanceField(target, name); } public static Object invokeInstanceMember(Object target, String name) throws Exception{ //check for field first Class c = target.getClass(); Field f = getField(c, name, false); if(f != null) //field get { return prepRet(f.get(target)); } return invokeInstanceMethod(target, name, RT.EMPTY_ARRAY); } public static Object invokeInstanceMember(String name, Object target, Object arg1) throws Exception{ //check for field first Class c = target.getClass(); Field f = getField(c, name, false); if(f != null) //field set { f.set(target, boxArg(f.getType(), arg1)); return arg1; } return invokeInstanceMethod(target, name, new Object[]{arg1}); } public static Object invokeInstanceMember(String name, Object target, Object... args) throws Exception{ return invokeInstanceMethod(target, name, args); } static public Field getField(Class c, String name, boolean getStatics){ Field[] allfields = c.getFields(); for(int i = 0; i < allfields.length; i++) { if(name.equals(allfields[i].getName()) && Modifier.isStatic(allfields[i].getModifiers()) == getStatics) return allfields[i]; } return null; } static public List getMethods(Class c, int arity, String name, boolean getStatics){ Method[] allmethods = c.getMethods(); ArrayList methods = new ArrayList(); ArrayList bridgeMethods = new ArrayList(); for(int i = 0; i < allmethods.length; i++) { Method method = allmethods[i]; if(name.equals(method.getName()) && Modifier.isStatic(method.getModifiers()) == getStatics && method.getParameterTypes().length == arity) { try { if(method.isBridge() && c.getMethod(method.getName(), method.getParameterTypes()) .equals(method)) bridgeMethods.add(method); else methods.add(method); } catch(NoSuchMethodException e) { } } // && (!method.isBridge() // || (c == StringBuilder.class && // c.getMethod(method.getName(), method.getParameterTypes()) // .equals(method)))) // { // methods.add(allmethods[i]); // } } if(methods.isEmpty()) methods.addAll(bridgeMethods); if(!getStatics && c.isInterface()) { allmethods = Object.class.getMethods(); for(int i = 0; i < allmethods.length; i++) { if(name.equals(allmethods[i].getName()) && Modifier.isStatic(allmethods[i].getModifiers()) == getStatics && allmethods[i].getParameterTypes().length == arity) { methods.add(allmethods[i]); } } } return methods; } static Object boxArg(Class paramType, Object arg){ if(!paramType.isPrimitive()) return paramType.cast(arg); else if(paramType == boolean.class) return Boolean.class.cast(arg); else if(paramType == char.class) return Character.class.cast(arg); else if(arg instanceof Number) { Number n = (Number) arg; if(paramType == int.class) return n.intValue(); else if(paramType == float.class) return n.floatValue(); else if(paramType == double.class) return n.doubleValue(); else if(paramType == long.class) return n.longValue(); else if(paramType == short.class) return n.shortValue(); else if(paramType == byte.class) return n.byteValue(); } throw new IllegalArgumentException("Unexpected param type, expected: " + paramType + ", given: " + arg.getClass().getName()); } static Object[] boxArgs(Class[] params, Object[] args){ if(params.length == 0) return null; Object[] ret = new Object[params.length]; for(int i = 0; i < params.length; i++) { Object arg = args[i]; Class paramType = params[i]; ret[i] = boxArg(paramType, arg); } return ret; } static public boolean paramArgTypeMatch(Class paramType, Class argType){ if(argType == null) return !paramType.isPrimitive(); if(paramType == argType || paramType.isAssignableFrom(argType)) return true; if(paramType == int.class) return argType == Integer.class;// || argType == FixNum.class; else if(paramType == float.class) return argType == Float.class; else if(paramType == double.class) return argType == Double.class;// || argType == DoubleNum.class; else if(paramType == long.class) return argType == Long.class;// || argType == BigNum.class; else if(paramType == char.class) return argType == Character.class; else if(paramType == short.class) return argType == Short.class; else if(paramType == byte.class) return argType == Byte.class; else if(paramType == boolean.class) return argType == Boolean.class; return false; } static boolean isCongruent(Class[] params, Object[] args){ boolean ret = false; if(args == null) return params.length == 0; if(params.length == args.length) { ret = true; for(int i = 0; ret && i < params.length; i++) { Object arg = args[i]; Class argType = (arg == null) ? null : arg.getClass(); Class paramType = params[i]; ret = paramArgTypeMatch(paramType, argType); } } return ret; } public static Object prepRet(Object x){ // if(c == boolean.class) // return ((Boolean) x).booleanValue() ? RT.T : null; if(x instanceof Boolean) return ((Boolean) x)?Boolean.TRUE:Boolean.FALSE; return x; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Repl.java000066400000000000000000000012241157562347600230720ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Oct 18, 2007 */ package clojure.lang; import clojure.main; public class Repl { public static void main(String[] args) throws Exception{ main.legacy_repl(args); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/RestFn.java000066400000000000000000005203221157562347600233760ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure.lang; public abstract class RestFn extends AFunction{ abstract public int getRequiredArity(); protected Object doInvoke(Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object args) throws Exception{ return null; } protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object args) throws Exception{ return null; } public Object applyTo(ISeq args) throws Exception{ if(RT.boundedLength(args, getRequiredArity()) <= getRequiredArity()) { return AFn.applyToHelper(this, Util.ret1(args,args = null)); } switch(getRequiredArity()) { case 0: return doInvoke(Util.ret1(args,args = null)); case 1: return doInvoke(args.first() , Util.ret1(args.next(),args=null)); case 2: return doInvoke(args.first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 3: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 4: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 5: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 6: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 7: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 8: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 9: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 10: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 11: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 12: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 13: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 14: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 15: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 16: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 17: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 18: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 19: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); case 20: return doInvoke(args.first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , (args = args.next()).first() , Util.ret1(args.next(),args=null)); } return throwArity(-1); } public Object invoke() throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(null); default: return throwArity(0); } } public Object invoke(Object arg1) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null))); case 1: return doInvoke(Util.ret1(arg1, arg1 = null), null); default: return throwArity(1); } } public Object invoke(Object arg1, Object arg2) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null))); case 1: return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null))); case 2: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), null); default: return throwArity(2); } } public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null))); case 1: return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null))); case 2: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), ArraySeq.create(Util.ret1(arg3, arg3 = null))); case 3: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), null); default: return throwArity(3); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null))); case 1: return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null))); case 2: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null))); case 3: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), ArraySeq.create(Util.ret1(arg4, arg4 = null))); case 4: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), null); default: return throwArity(4); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null))); case 1: return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null))); case 2: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null))); case 3: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), ArraySeq.create(Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null))); case 4: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), ArraySeq.create(Util.ret1(arg5, arg5 = null))); case 5: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), null); default: return throwArity(5); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); case 1: return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); case 2: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); case 3: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), ArraySeq.create(Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); case 4: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), ArraySeq.create(Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null))); case 5: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), ArraySeq.create(Util.ret1(arg6, arg6 = null))); case 6: return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null), null); default: return throwArity(6); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null))); case 1: return doInvoke(Util.ret1(arg1,arg1=null), ArraySeq.create(Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null))); case 2: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create(Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null))); case 3: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create(Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null))); case 4: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create(Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null))); case 5: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create(Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null))); case 6: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create(Util.ret1(arg7,arg7=null))); case 7: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), null); default: return throwArity(7); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 1: return doInvoke(Util.ret1(arg1,arg1=null), ArraySeq.create(Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 2: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create(Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 3: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create(Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 4: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create(Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 5: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create(Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 6: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create(Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null))); case 7: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create(Util.ret1(arg8,arg8=null))); case 8: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), null); default: return throwArity(8); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 1: return doInvoke(Util.ret1(arg1,arg1=null), ArraySeq.create(Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 2: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create(Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 3: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create(Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 4: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create(Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 5: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create(Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 6: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create(Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 7: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create(Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null))); case 8: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create(Util.ret1(arg9,arg9=null))); case 9: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), null); default: return throwArity(9); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 1: return doInvoke(Util.ret1(arg1,arg1=null), ArraySeq.create(Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 2: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create(Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 3: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create(Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 4: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create(Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 5: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create(Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 6: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create(Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 7: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create(Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 8: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create(Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), null); default: return throwArity(10); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), null); default: return throwArity(11); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), null); default: return throwArity(12); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke( ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), null); default: return throwArity(13); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create( Util.ret1(arg14,arg14=null))); case 14: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), null); default: return throwArity(14); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create( Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null))); case 14: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ArraySeq.create( Util.ret1(arg15,arg15=null))); case 15: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), null); default: return throwArity(15); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create( Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 14: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ArraySeq.create( Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null))); case 15: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), ArraySeq.create( Util.ret1(arg16,arg16=null))); case 16: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), null); default: return throwArity(16); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create( Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 14: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ArraySeq.create( Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 15: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), ArraySeq.create( Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null))); case 16: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), ArraySeq.create( Util.ret1(arg17,arg17=null))); case 17: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), null); default: return throwArity(17); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create( Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 14: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ArraySeq.create( Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 15: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), ArraySeq.create( Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 16: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), ArraySeq.create( Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null))); case 17: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), ArraySeq.create( Util.ret1(arg18,arg18=null))); case 18: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), null); default: return throwArity(18); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 1: ISeq packed = PersistentList.EMPTY; return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create(Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 3: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create( Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 4: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create( Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 5: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create( Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 6: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create( Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 7: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create( Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create( Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 9: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create( Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 10: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create( Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create( Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create( Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 13: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create( Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 14: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ArraySeq.create( Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 15: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), ArraySeq.create( Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 16: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), ArraySeq.create( Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 17: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), ArraySeq.create( Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null))); case 18: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), ArraySeq.create( Util.ret1(arg19,arg19=null))); case 19: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), null); default: return throwArity(19); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ArraySeq.create( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 1: return doInvoke( Util.ret1(arg1,arg1=null), ArraySeq.create( Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 2: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ArraySeq.create( Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 3: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ArraySeq.create(Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 4: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ArraySeq.create(Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 5: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ArraySeq.create(Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 6: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ArraySeq.create(Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 7: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ArraySeq.create(Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 8: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ArraySeq.create(Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 9: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ArraySeq.create(Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 10: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ArraySeq.create(Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ArraySeq.create(Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 12: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ArraySeq.create(Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 13: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ArraySeq.create(Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 14: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ArraySeq.create(Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 15: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), ArraySeq.create(Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 16: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), ArraySeq.create(Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 17: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), ArraySeq.create(Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 18: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), ArraySeq.create(Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 19: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), ArraySeq.create(Util.ret1(arg20,arg20=null))); case 20: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null), null); default: return throwArity(20); } } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception{ switch(getRequiredArity()) { case 0: return doInvoke(ontoArrayPrepend(args, Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 1: return doInvoke(Util.ret1(arg1,arg1=null), ontoArrayPrepend(args, Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 2: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), ontoArrayPrepend(args, Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 3: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), ontoArrayPrepend(args, Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 4: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), ontoArrayPrepend(args, Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 5: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), ontoArrayPrepend(args, Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 6: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), ontoArrayPrepend(args, Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 7: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), ontoArrayPrepend(args, Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 8: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), ontoArrayPrepend(args, Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 9: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), ontoArrayPrepend(args, Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 10: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), ontoArrayPrepend(args, Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 11: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), ontoArrayPrepend(args, Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 12: return doInvoke( Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), ontoArrayPrepend(args, Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 13: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), ontoArrayPrepend(args, Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 14: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), ontoArrayPrepend(args, Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 15: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), ontoArrayPrepend(args, Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 16: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), ontoArrayPrepend(args, Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 17: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), ontoArrayPrepend(args, Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 18: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), ontoArrayPrepend(args, Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null))); case 19: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), ontoArrayPrepend(args, Util.ret1(arg20,arg20=null))); case 20: return doInvoke(Util.ret1(arg1,arg1=null), Util.ret1(arg2,arg2=null), Util.ret1(arg3,arg3=null), Util.ret1(arg4,arg4=null), Util.ret1(arg5,arg5=null), Util.ret1(arg6,arg6=null), Util.ret1(arg7,arg7=null), Util.ret1(arg8,arg8=null), Util.ret1(arg9,arg9=null), Util.ret1(arg10,arg10=null), Util.ret1(arg11,arg11=null), Util.ret1(arg12,arg12=null), Util.ret1(arg13,arg13=null), Util.ret1(arg14,arg14=null), Util.ret1(arg15,arg15=null), Util.ret1(arg16,arg16=null), Util.ret1(arg17,arg17=null), Util.ret1(arg18,arg18=null), Util.ret1(arg19,arg19=null), Util.ret1(arg20,arg20=null), ArraySeq.create(args)); default: return throwArity(21); } } protected static ISeq ontoArrayPrepend(Object[] array, Object... args){ ISeq ret = ArraySeq.create(array); for(int i = args.length - 1; i >= 0; --i) ret = RT.cons(args[i], ret); return ret; } protected static ISeq findKey(Object key, ISeq args){ while(args != null) { if(key == args.first()) return args.next(); args = RT.next(args); args = RT.next(args); } return null; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Reversible.java000066400000000000000000000011141157562347600242700ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jan 5, 2008 */ package clojure.lang; public interface Reversible{ ISeq rseq() throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Script.java000066400000000000000000000012301157562347600234310ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Oct 18, 2007 */ package clojure.lang; import clojure.main; public class Script { public static void main(String[] args) throws Exception{ main.legacy_script(args); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/SeqEnumeration.java000066400000000000000000000014741157562347600251360ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 3, 2008 */ package clojure.lang; import java.util.Enumeration; public class SeqEnumeration implements Enumeration{ ISeq seq; public SeqEnumeration(ISeq seq){ this.seq = seq; } public boolean hasMoreElements(){ return seq != null; } public Object nextElement(){ Object ret = RT.first(seq); seq = RT.next(seq); return ret; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/SeqIterator.java000066400000000000000000000017461157562347600244430ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jun 19, 2007 */ package clojure.lang; import java.util.Iterator; import java.util.NoSuchElementException; public class SeqIterator implements Iterator{ ISeq seq; public SeqIterator(ISeq seq){ this.seq = seq; } public boolean hasNext(){ return seq != null; } public Object next() throws NoSuchElementException { if(seq == null) throw new NoSuchElementException(); Object ret = RT.first(seq); seq = RT.next(seq); return ret; } public void remove(){ throw new UnsupportedOperationException(); } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Seqable.java000066400000000000000000000010751157562347600235500ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jan 28, 2009 */ package clojure.lang; public interface Seqable { ISeq seq(); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Sequential.java000066400000000000000000000010241157562347600243000ustar00rootroot00000000000000package clojure.lang; /** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. */ public interface Sequential { } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Settable.java000066400000000000000000000012161157562347600237340ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 31, 2008 */ package clojure.lang; public interface Settable { Object doSet(Object val) throws Exception; Object doReset(Object val) throws Exception; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Sorted.java000066400000000000000000000013161157562347600234320ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Apr 15, 2008 */ package clojure.lang; import java.util.Comparator; public interface Sorted{ Comparator comparator(); Object entryKey(Object entry); ISeq seq(boolean ascending); ISeq seqFrom(Object key, boolean ascending); } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/StringSeq.java000066400000000000000000000023051157562347600241100ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 6, 2007 */ package clojure.lang; public class StringSeq extends ASeq implements IndexedSeq{ public final CharSequence s; public final int i; static public StringSeq create(CharSequence s){ if(s.length() == 0) return null; return new StringSeq(null, s, 0); } StringSeq(IPersistentMap meta, CharSequence s, int i){ super(meta); this.s = s; this.i = i; } public Obj withMeta(IPersistentMap meta){ if(meta == meta()) return this; return new StringSeq(meta, s, i); } public Object first(){ return Character.valueOf(s.charAt(i)); } public ISeq next(){ if(i + 1 < s.length()) return new StringSeq(_meta, s, i + 1); return null; } public int index(){ return i; } public int count(){ return s.length() - i; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Symbol.java000066400000000000000000000055771157562347600234540ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Mar 25, 2006 11:42:47 AM */ package clojure.lang; import java.io.Serializable; import java.io.ObjectStreamException; public class Symbol extends AFn implements IObj, Comparable, Named, Serializable{ //these must be interned strings! final String ns; final String name; final int hash; final IPersistentMap _meta; public String toString(){ if(ns != null) return ns + "/" + name; return name; } public String getNamespace(){ return ns; } public String getName(){ return name; } static public Symbol intern(String ns, String name){ return new Symbol(ns == null ? null : ns.intern(), name.intern()); } static public Symbol intern(String nsname){ int i = nsname.lastIndexOf('/'); if(i == -1 || nsname.equals("/")) return new Symbol(null, nsname.intern()); else return new Symbol(nsname.substring(0, i).intern(), nsname.substring(i + 1).intern()); } static public Symbol create(String name_interned){ return new Symbol(null, name_interned); } static public Symbol create(String ns_interned, String name_interned){ return new Symbol(ns_interned, name_interned); } private Symbol(String ns_interned, String name_interned){ this.name = name_interned; this.ns = ns_interned; this.hash = Util.hashCombine(name.hashCode(), Util.hash(ns)); this._meta = null; } public boolean equals(Object o){ if(this == o) return true; if(!(o instanceof Symbol)) return false; Symbol symbol = (Symbol) o; //identity compares intended, names are interned return name == symbol.name && ns == symbol.ns; } public int hashCode(){ return hash; } public IObj withMeta(IPersistentMap meta){ return new Symbol(meta, ns, name); } private Symbol(IPersistentMap meta, String ns, String name){ this.name = name; this.ns = ns; this._meta = meta; this.hash = Util.hashCombine(name.hashCode(), Util.hash(ns)); } public int compareTo(Object o){ Symbol s = (Symbol) o; if(this.equals(o)) return 0; if(this.ns == null && s.ns != null) return -1; if(this.ns != null) { if(s.ns == null) return 1; int nsc = this.ns.compareTo(s.ns); if(nsc != 0) return nsc; } return this.name.compareTo(s.name); } private Object readResolve() throws ObjectStreamException{ return intern(ns, name); } public Object invoke(Object obj) throws Exception{ return RT.get(obj, this); } public Object invoke(Object obj, Object notFound) throws Exception{ return RT.get(obj, this, notFound); } public IPersistentMap meta(){ return _meta; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/TransactionalHashMap.java000066400000000000000000000101531157562347600262350ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 31, 2008 */ package clojure.lang; import java.util.concurrent.ConcurrentMap; import java.util.*; public class TransactionalHashMap extends AbstractMap implements ConcurrentMap{ final Ref[] bins; IPersistentMap mapAt(int bin){ return (IPersistentMap) bins[bin].deref(); } final int binFor(Object k){ //spread hashes, a la Cliff Click int h = k.hashCode(); h ^= (h >>> 20) ^ (h >>> 12); h ^= (h >>> 7) ^ (h >>> 4); return h % bins.length; // return k.hashCode() % bins.length; } Entry entryAt(Object k){ return mapAt(binFor(k)).entryAt(k); } public TransactionalHashMap() throws Exception{ this(421); } public TransactionalHashMap(int nBins) throws Exception{ bins = new Ref[nBins]; for(int i = 0; i < nBins; i++) bins[i] = new Ref(PersistentHashMap.EMPTY); } public TransactionalHashMap(Map m) throws Exception{ this(m.size()); putAll(m); } public int size(){ int n = 0; for(int i = 0; i < bins.length; i++) { n += mapAt(i).count(); } return n; } public boolean isEmpty(){ return size() == 0; } public boolean containsKey(Object k){ return entryAt(k) != null; } public V get(Object k){ Entry e = entryAt(k); if(e != null) return (V) e.getValue(); return null; } public V put(K k, V v){ Ref r = bins[binFor(k)]; IPersistentMap map = (IPersistentMap) r.deref(); Object ret = map.valAt(k); r.set(map.assoc(k, v)); return (V) ret; } public V remove(Object k){ Ref r = bins[binFor(k)]; IPersistentMap map = (IPersistentMap) r.deref(); Object ret = map.valAt(k); //checked exceptions are a bad idea, especially in an interface try { r.set(map.without(k)); } catch(Exception e) { throw new RuntimeException(e); } return (V) ret; } public void putAll(Map map){ for(Iterator i = map.entrySet().iterator(); i.hasNext();) { Entry e = (Entry) i.next(); put(e.getKey(), e.getValue()); } } public void clear(){ for(int i = 0; i < bins.length; i++) { Ref r = bins[i]; IPersistentMap map = (IPersistentMap) r.deref(); if(map.count() > 0) { r.set(PersistentHashMap.EMPTY); } } } public Set> entrySet(){ final ArrayList> entries = new ArrayList(bins.length); for(int i = 0; i < bins.length; i++) { IPersistentMap map = mapAt(i); if(map.count() > 0) entries.addAll((Collection) RT.seq(map)); } return new AbstractSet>(){ public Iterator iterator(){ return Collections.unmodifiableList(entries).iterator(); } public int size(){ return entries.size(); } }; } public V putIfAbsent(K k, V v){ Ref r = bins[binFor(k)]; IPersistentMap map = (IPersistentMap) r.deref(); Entry e = map.entryAt(k); if(e == null) { r.set(map.assoc(k, v)); return null; } else return (V) e.getValue(); } public boolean remove(Object k, Object v){ Ref r = bins[binFor(k)]; IPersistentMap map = (IPersistentMap) r.deref(); Entry e = map.entryAt(k); if(e != null && e.getValue().equals(v)) { //checked exceptions are a bad idea, especially in an interface try { r.set(map.without(k)); } catch(Exception ex) { throw new RuntimeException(ex); } return true; } return false; } public boolean replace(K k, V oldv, V newv){ Ref r = bins[binFor(k)]; IPersistentMap map = (IPersistentMap) r.deref(); Entry e = map.entryAt(k); if(e != null && e.getValue().equals(oldv)) { r.set(map.assoc(k, newv)); return true; } return false; } public V replace(K k, V v){ Ref r = bins[binFor(k)]; IPersistentMap map = (IPersistentMap) r.deref(); Entry e = map.entryAt(k); if(e != null) { r.set(map.assoc(k, v)); return (V) e.getValue(); } return null; } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Util.java000066400000000000000000000053631157562347600231150ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Apr 19, 2008 */ package clojure.lang; import java.lang.ref.Reference; import java.math.BigInteger; import java.util.Map; import java.util.concurrent.ConcurrentHashMap; import java.lang.ref.SoftReference; import java.lang.ref.ReferenceQueue; import java.lang.ref.Reference; public class Util{ static public boolean equiv(Object k1, Object k2){ if(k1 == k2) return true; if(k1 != null) { if(k1 instanceof Number && k2 instanceof Number) return Numbers.equiv(k1, k2); else if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection) return pcequiv(k1,k2); return k1.equals(k2); } return false; } static public boolean pcequiv(Object k1, Object k2){ if(k1 instanceof IPersistentCollection) return ((IPersistentCollection)k1).equiv(k2); return ((IPersistentCollection)k2).equiv(k1); } static public boolean equals(Object k1, Object k2){ if(k1 == k2) return true; return k1 != null && k1.equals(k2); } static public boolean identical(Object k1, Object k2){ return k1 == k2; } static public Class classOf(Object x){ if(x != null) return x.getClass(); return null; } static public int compare(Object k1, Object k2){ if(k1 == k2) return 0; if(k1 != null) { if(k2 == null) return 1; if(k1 instanceof Number) return Numbers.compare((Number) k1, (Number) k2); return ((Comparable) k1).compareTo(k2); } return -1; } static public int hash(Object o){ if(o == null) return 0; return o.hashCode(); } static public int hashCombine(int seed, int hash){ //a la boost seed ^= hash + 0x9e3779b9 + (seed << 6) + (seed >> 2); return seed; } static public boolean isPrimitive(Class c){ return c != null && c.isPrimitive() && !(c == Void.TYPE); } static public boolean isInteger(Object x){ return x instanceof Integer || x instanceof Long || x instanceof BigInteger; } static public Object ret1(Object ret, Object nil){ return ret; } static public ISeq ret1(ISeq ret, Object nil){ return ret; } static public void clearCache(ReferenceQueue rq, ConcurrentHashMap> cache){ //cleanup any dead entries if(rq.poll() != null) { while(rq.poll() != null) ; for(Map.Entry> e : cache.entrySet()) { if(e.getValue().get() == null) cache.remove(e.getKey(), e.getValue()); } } } } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/Var.java000066400000000000000000000357171157562347600227360ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Jul 31, 2007 */ package clojure.lang; import java.util.concurrent.atomic.AtomicInteger; public final class Var extends ARef implements IFn, IRef, Settable{ static class Frame{ //Var->Box Associative bindings; //Var->val Associative frameBindings; Frame prev; public Frame(){ this(PersistentHashMap.EMPTY, PersistentHashMap.EMPTY, null); } public Frame(Associative frameBindings, Associative bindings, Frame prev){ this.frameBindings = frameBindings; this.bindings = bindings; this.prev = prev; } } static ThreadLocal dvals = new ThreadLocal(){ protected Frame initialValue(){ return new Frame(); } }; static Keyword privateKey = Keyword.intern(null, "private"); static IPersistentMap privateMeta = new PersistentArrayMap(new Object[]{privateKey, Boolean.TRUE}); static Keyword macroKey = Keyword.intern(null, "macro"); static Keyword nameKey = Keyword.intern(null, "name"); static Keyword nsKey = Keyword.intern(null, "ns"); //static Keyword tagKey = Keyword.intern(null, "tag"); volatile Object root; transient final AtomicInteger count; public final Symbol sym; public final Namespace ns; //IPersistentMap _meta; public static Var intern(Namespace ns, Symbol sym, Object root){ return intern(ns, sym, root, true); } public static Var intern(Namespace ns, Symbol sym, Object root, boolean replaceRoot){ Var dvout = ns.intern(sym); if(!dvout.hasRoot() || replaceRoot) dvout.bindRoot(root); return dvout; } public String toString(){ if(ns != null) return "#'" + ns.name + "/" + sym; return "#"; } public static Var find(Symbol nsQualifiedSym){ if(nsQualifiedSym.ns == null) throw new IllegalArgumentException("Symbol must be namespace-qualified"); Namespace ns = Namespace.find(Symbol.create(nsQualifiedSym.ns)); if(ns == null) throw new IllegalArgumentException("No such namespace: " + nsQualifiedSym.ns); return ns.findInternedVar(Symbol.create(nsQualifiedSym.name)); } public static Var intern(Symbol nsName, Symbol sym){ Namespace ns = Namespace.findOrCreate(nsName); return intern(ns, sym); } public static Var internPrivate(String nsName, String sym){ Namespace ns = Namespace.findOrCreate(Symbol.intern(nsName)); Var ret = intern(ns, Symbol.intern(sym)); ret.setMeta(privateMeta); return ret; } public static Var intern(Namespace ns, Symbol sym){ return ns.intern(sym); } public static Var create(){ return new Var(null, null); } public static Var create(Object root){ return new Var(null, null, root); } Var(Namespace ns, Symbol sym){ this.ns = ns; this.sym = sym; this.count = new AtomicInteger(); this.root = dvals; //use dvals as magic not-bound value setMeta(PersistentHashMap.EMPTY); } Var(Namespace ns, Symbol sym, Object root){ this(ns, sym); this.root = root; } public boolean isBound(){ return hasRoot() || (count.get() > 0 && dvals.get().bindings.containsKey(this)); } final public Object get(){ if(count.get() == 0 && root != dvals) return root; return deref(); } final public Object deref(){ Box b = getThreadBinding(); if(b != null) return b.val; if(hasRoot()) return root; throw new IllegalStateException(String.format("Var %s/%s is unbound.", ns, sym)); } public void setValidator(IFn vf){ if(hasRoot()) validate(vf, getRoot()); validator = vf; } public Object alter(IFn fn, ISeq args) throws Exception{ set(fn.applyTo(RT.cons(deref(), args))); return this; } public Object set(Object val){ validate(getValidator(), val); Box b = getThreadBinding(); if(b != null) return (b.val = val); //jury still out on this // if(hasRoot()) // { // bindRoot(val); // return val; // } throw new IllegalStateException(String.format("Can't change/establish root binding of: %s with set", sym)); } public Object doSet(Object val) throws Exception { return set(val); } public Object doReset(Object val) throws Exception { bindRoot(val); return val; } public void setMeta(IPersistentMap m) { //ensure these basis keys resetMeta(m.assoc(nameKey, sym).assoc(nsKey, ns)); } public void setMacro() { try { alterMeta(assoc, RT.list(macroKey, RT.T)); } catch (Exception e) { throw new RuntimeException(e); } } public boolean isMacro(){ return RT.booleanCast(meta().valAt(macroKey)); } //public void setExported(boolean state){ // _meta = _meta.assoc(privateKey, state); //} public boolean isPublic(){ return !RT.booleanCast(meta().valAt(privateKey)); } public Object getRoot(){ if(hasRoot()) return root; throw new IllegalStateException(String.format("Var %s/%s is unbound.", ns, sym)); } public Object getRawRoot(){ return root; } public Object getTag(){ return meta().valAt(RT.TAG_KEY); } public void setTag(Symbol tag) { try { alterMeta(assoc, RT.list(RT.TAG_KEY, tag)); } catch (Exception e) { throw new RuntimeException(e); } } final public boolean hasRoot(){ return root != dvals; } //binding root always clears macro flag synchronized public void bindRoot(Object root){ validate(getValidator(), root); Object oldroot = hasRoot()?this.root:null; this.root = root; try { alterMeta(dissoc, RT.list(macroKey)); } catch (Exception e) { throw new RuntimeException(e); } notifyWatches(oldroot,this.root); } synchronized void swapRoot(Object root){ validate(getValidator(), root); Object oldroot = hasRoot()?this.root:null; this.root = root; notifyWatches(oldroot,root); } synchronized public void unbindRoot(){ this.root = dvals; } synchronized public void commuteRoot(IFn fn) throws Exception{ Object newRoot = fn.invoke(root); validate(getValidator(), newRoot); Object oldroot = getRoot(); this.root = newRoot; notifyWatches(oldroot,newRoot); } synchronized public Object alterRoot(IFn fn, ISeq args) throws Exception{ Object newRoot = fn.applyTo(RT.cons(root, args)); validate(getValidator(), newRoot); Object oldroot = getRoot(); this.root = newRoot; notifyWatches(oldroot,newRoot); return newRoot; } public static void pushThreadBindings(Associative bindings){ Frame f = dvals.get(); Associative bmap = f.bindings; for(ISeq bs = bindings.seq(); bs != null; bs = bs.next()) { IMapEntry e = (IMapEntry) bs.first(); Var v = (Var) e.key(); v.validate(v.getValidator(), e.val()); v.count.incrementAndGet(); bmap = bmap.assoc(v, new Box(e.val())); } dvals.set(new Frame(bindings, bmap, f)); } public static void popThreadBindings(){ Frame f = dvals.get(); if(f.prev == null) throw new IllegalStateException("Pop without matching push"); for(ISeq bs = RT.keys(f.frameBindings); bs != null; bs = bs.next()) { Var v = (Var) bs.first(); v.count.decrementAndGet(); } dvals.set(f.prev); } public static void releaseThreadBindings(){ Frame f = dvals.get(); if(f.prev == null) throw new IllegalStateException("Release without full unwind"); for(ISeq bs = RT.keys(f.bindings); bs != null; bs = bs.next()) { Var v = (Var) bs.first(); v.count.decrementAndGet(); } dvals.set(null); } public static Associative getThreadBindings(){ Frame f = dvals.get(); IPersistentMap ret = PersistentHashMap.EMPTY; for(ISeq bs = f.bindings.seq(); bs != null; bs = bs.next()) { IMapEntry e = (IMapEntry) bs.first(); Var v = (Var) e.key(); Box b = (Box) e.val(); ret = ret.assoc(v, b.val); } return ret; } public final Box getThreadBinding(){ if(count.get() > 0) { IMapEntry e = dvals.get().bindings.entryAt(this); if(e != null) return (Box) e.val(); } return null; } final public IFn fn(){ return (IFn) deref(); } public Object call() throws Exception{ return invoke(); } public void run(){ try { invoke(); } catch(Exception e) { throw new RuntimeException(e); } } public Object invoke() throws Exception{ return fn().invoke(); } public Object invoke(Object arg1) throws Exception{ return fn().invoke(arg1); } public Object invoke(Object arg1, Object arg2) throws Exception{ return fn().invoke(arg1, arg2); } public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{ return fn().invoke(arg1, arg2, arg3); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20); } public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args) throws Exception{ return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20, args); } public Object applyTo(ISeq arglist) throws Exception{ return AFn.applyToHelper(this, arglist); } static IFn assoc = new AFn(){ @Override public Object invoke(Object m, Object k, Object v) throws Exception { return RT.assoc(m, k, v); } }; static IFn dissoc = new AFn() { @Override public Object invoke(Object c, Object k) throws Exception { return RT.dissoc(c, k); } }; } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/lang/XMLHandler.java000066400000000000000000000044721157562347600241360ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ /* rich Dec 17, 2007 */ package clojure.lang; import org.xml.sax.Attributes; import org.xml.sax.ContentHandler; import org.xml.sax.Locator; import org.xml.sax.SAXException; import org.xml.sax.helpers.DefaultHandler; public class XMLHandler extends DefaultHandler{ ContentHandler h; public XMLHandler(ContentHandler h){ this.h = h; } public void setDocumentLocator(Locator locator){ h.setDocumentLocator(locator); } public void startDocument() throws SAXException{ h.startDocument(); } public void endDocument() throws SAXException{ h.endDocument(); } public void startPrefixMapping(String prefix, String uri) throws SAXException{ h.startPrefixMapping(prefix, uri); } public void endPrefixMapping(String prefix) throws SAXException{ h.endPrefixMapping(prefix); } public void startElement(String uri, String localName, String qName, Attributes atts) throws SAXException{ h.startElement(uri, localName, qName, atts); } public void endElement(String uri, String localName, String qName) throws SAXException{ h.endElement(uri, localName, qName); } public void characters(char ch[], int start, int length) throws SAXException{ h.characters(ch, start, length); } public void ignorableWhitespace(char ch[], int start, int length) throws SAXException{ h.ignorableWhitespace(ch, start, length); } public void processingInstruction(String target, String data) throws SAXException{ h.processingInstruction(target, data); } public void skippedEntity(String name) throws SAXException{ h.skippedEntity(name); } /* public static void main(String[] args){ try { ContentHandler dummy = new DefaultHandler(); SAXParserFactory f = SAXParserFactory.newInstance(); //f.setNamespaceAware(true); SAXParser p = f.newSAXParser(); p.parse("http://arstechnica.com/journals.rssx",new XMLHandler(dummy)); } catch(Exception e) { e.printStackTrace(); } } //*/ } clojure1.2_1.2.1+dfsg.orig/src/jvm/clojure/main.java000066400000000000000000000025361157562347600222020ustar00rootroot00000000000000/** * Copyright (c) Rich Hickey. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. **/ package clojure; import clojure.lang.Symbol; import clojure.lang.Var; import clojure.lang.RT; public class main{ final static private Symbol CLOJURE_MAIN = Symbol.intern("clojure.main"); final static private Var REQUIRE = RT.var("clojure.core", "require"); final static private Var LEGACY_REPL = RT.var("clojure.main", "legacy-repl"); final static private Var LEGACY_SCRIPT = RT.var("clojure.main", "legacy-script"); final static private Var MAIN = RT.var("clojure.main", "main"); public static void legacy_repl(String[] args) throws Exception{ REQUIRE.invoke(CLOJURE_MAIN); LEGACY_REPL.invoke(RT.seq(args)); } public static void legacy_script(String[] args) throws Exception{ REQUIRE.invoke(CLOJURE_MAIN); LEGACY_SCRIPT.invoke(RT.seq(args)); } public static void main(String[] args) throws Exception{ REQUIRE.invoke(CLOJURE_MAIN); MAIN.applyTo(RT.seq(args)); } } clojure1.2_1.2.1+dfsg.orig/test/000077500000000000000000000000001157562347600163365ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/000077500000000000000000000000001157562347600200015ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure.clj000066400000000000000000000047101157562347600231770ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ;; clojure.test-clojure ;; ;; Tests for the facilities provided by Clojure ;; ;; scgilardi (gmail) ;; Created 22 October 2008 (ns clojure.test-clojure (:require [clojure.test :as t]) (:gen-class)) (def test-names [:reader :printer :compilation :evaluation :special :macros :metadata :ns-libs :logic :predicates :control :data-structures :numbers :sequences :for :multimethods :other-functions :vars :refs :agents :atoms :parallel :java-interop :test :test-fixtures ;; libraries :clojure-set :clojure-xml :clojure-zip :protocols :genclass :main :vectors :annotations :pprint :serialization :rt :repl :java.io :string :java.javadoc :java.shell :transients :def ]) (def test-namespaces (map #(symbol (str "clojure.test-clojure." (name %))) test-names)) (defn run "Runs all defined tests" [] (println "Loading tests...") (apply require :reload-all test-namespaces) (apply t/run-tests test-namespaces)) (defn run-ant "Runs all defined tests, prints report to *err*, throw if failures. This works well for running in an ant java task." [] (let [rpt t/report] (binding [;; binding to *err* because, in ant, when the test target ;; runs after compile-clojure, *out* doesn't print anything *out* *err* t/*test-out* *err* t/report (fn report [m] (if (= :summary (:type m)) (do (rpt m) (if (or (pos? (:fail m)) (pos? (:error m))) (throw (new Exception (str (:fail m) " failures, " (:error m) " errors."))))) (rpt m)))] (run)))) (defn -main "Run all defined tests from the command line" [& args] (run) (System/exit 0)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/000077500000000000000000000000001157562347600225035ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/agents.clj000066400000000000000000000073561157562347600244710ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Shawn Hoover (ns clojure.test-clojure.agents (:use clojure.test)) (deftest handle-all-throwables-during-agent-actions ;; Bug fixed in r1198; previously hung Clojure or didn't report agent errors ;; after OutOfMemoryError, yet wouldn't execute new actions. (let [agt (agent nil)] (send agt (fn [state] (throw (Throwable. "just testing Throwables")))) (try ;; Let the action finish; eat the "agent has errors" error that bubbles up (await-for 100 agt) (catch RuntimeException _)) (is (instance? Throwable (first (agent-errors agt)))) (is (= 1 (count (agent-errors agt)))) ;; And now send an action that should work (clear-agent-errors agt) (is (= nil @agt)) (send agt nil?) (is (true? (await-for 100 agt))) (is (true? @agt)))) (deftest default-modes (is (= :fail (error-mode (agent nil)))) (is (= :continue (error-mode (agent nil :error-handler println))))) (deftest continue-handler (let [err (atom nil) agt (agent 0 :error-mode :continue :error-handler #(reset! err %&))] (send agt /) (is (true? (await-for 100 agt))) (is (= 0 @agt)) (is (nil? (agent-error agt))) (is (= agt (first @err))) (is (true? (instance? ArithmeticException (second @err)))))) (deftest fail-handler (let [err (atom nil) agt (agent 0 :error-mode :fail :error-handler #(reset! err %&))] (send agt /) (Thread/sleep 100) (is (true? (instance? ArithmeticException (agent-error agt)))) (is (= 0 @agt)) (is (= agt (first @err))) (is (true? (instance? ArithmeticException (second @err)))) (is (thrown? RuntimeException (send agt inc))))) (deftest restart-no-clear (let [p (promise) agt (agent 1 :error-mode :fail)] (send agt (fn [v] @p)) (send agt /) (send agt inc) (send agt inc) (deliver p 0) (Thread/sleep 100) (is (= 0 @agt)) (is (= ArithmeticException (class (agent-error agt)))) (restart-agent agt 10) (is (true? (await-for 100 agt))) (is (= 12 @agt)) (is (nil? (agent-error agt))))) (deftest restart-clear (let [p (promise) agt (agent 1 :error-mode :fail)] (send agt (fn [v] @p)) (send agt /) (send agt inc) (send agt inc) (deliver p 0) (Thread/sleep 100) (is (= 0 @agt)) (is (= ArithmeticException (class (agent-error agt)))) (restart-agent agt 10 :clear-actions true) (is (true? (await-for 100 agt))) (is (= 10 @agt)) (is (nil? (agent-error agt))) (send agt inc) (is (true? (await-for 100 agt))) (is (= 11 @agt)) (is (nil? (agent-error agt))))) (deftest invalid-restart (let [p (promise) agt (agent 2 :error-mode :fail :validator even?)] (is (thrown? RuntimeException (restart-agent agt 4))) (send agt (fn [v] @p)) (send agt (partial + 2)) (send agt (partial + 2)) (deliver p 3) (Thread/sleep 100) (is (= 2 @agt)) (is (= IllegalStateException (class (agent-error agt)))) (is (thrown? RuntimeException (restart-agent agt 5))) (restart-agent agt 6) (is (true? (await-for 100 agt))) (is (= 10 @agt)) (is (nil? (agent-error agt))))) ; http://clojure.org/agents ; agent ; deref, @-reader-macro, agent-errors ; send send-off clear-agent-errors ; await await-for ; set-validator get-validator ; add-watch remove-watch ; shutdown-agents clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/annotations.clj000066400000000000000000000020231157562347600255270ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Authors: Stuart Halloway, Rich Hickey (ns clojure.test-clojure.annotations (:use clojure.test)) (defn vm-has-ws-annotations? "Does the vm have the ws annotations we use to test some annotation features. If not, fall back to Java 5 tests." [] (try (doseq [n ["javax.xml.ws.soap.Addressing" "javax.xml.ws.WebServiceRef" "javax.xml.ws.WebServiceRefs"]] (Class/forName n)) true (catch ClassNotFoundException e false))) (if (vm-has-ws-annotations?) (load "annotations/java_6_and_later") (load "annotations/java_5")) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/annotations/000077500000000000000000000000001157562347600250405ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/annotations/java_5.clj000066400000000000000000000033641157562347600267050ustar00rootroot00000000000000;; java 5 annotation tests (in-ns 'clojure.test-clojure.annotations) (import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType]) (definterface Foo (foo [])) (deftype #^{Deprecated true Retention RetentionPolicy/RUNTIME} Bar [#^int a #^{:tag int Deprecated true Retention RetentionPolicy/RUNTIME} b] Foo (#^{Deprecated true Retention RetentionPolicy/RUNTIME} foo [this] 42)) (defn annotation->map "Converts a Java annotation (which conceals data) into a map (which makes is usable). Not lazy. Works recursively. Returns non-annotations unscathed." [#^java.lang.annotation.Annotation o] (cond (instance? Annotation o) (let [type (.annotationType o) itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation)) data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))] (into {:annotationType (.annotationType o)} (map (fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))]) data-methods))) (or (sequential? o) (.isArray (class o))) (map annotation->map o) :else o)) (def expected-annotations #{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME} {:annotationType java.lang.Deprecated}}) (deftest test-annotations-on-type (is (= expected-annotations (into #{} (map annotation->map (.getAnnotations Bar)))))) (deftest test-annotations-on-field (is (= expected-annotations (into #{} (map annotation->map (.getAnnotations (.getField Bar "b"))))))) (deftest test-annotations-on-method (is (= expected-annotations (into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/annotations/java_6_and_later.clj000066400000000000000000000063161157562347600307170ustar00rootroot00000000000000;; java 6 annotation tests (in-ns 'clojure.test-clojure.annotations) (import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType] [javax.xml.ws WebServiceRef WebServiceRefs]) (definterface Foo (foo [])) (deftype #^{Deprecated true Retention RetentionPolicy/RUNTIME javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"] javax.xml.ws.soap.Addressing {:enabled false :required true} WebServiceRefs [(WebServiceRef {:name "fred" :type String}) (WebServiceRef {:name "ethel" :mappedName "lucy"})]} Bar [#^int a #^{:tag int Deprecated true Retention RetentionPolicy/RUNTIME javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"] javax.xml.ws.soap.Addressing {:enabled false :required true} WebServiceRefs [(WebServiceRef {:name "fred" :type String}) (WebServiceRef {:name "ethel" :mappedName "lucy"})]} b] Foo (#^{Deprecated true Retention RetentionPolicy/RUNTIME javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"] javax.xml.ws.soap.Addressing {:enabled false :required true} WebServiceRefs [(WebServiceRef {:name "fred" :type String}) (WebServiceRef {:name "ethel" :mappedName "lucy"})]} foo [this] 42)) (defn annotation->map "Converts a Java annotation (which conceals data) into a map (which makes is usable). Not lazy. Works recursively. Returns non-annotations unscathed." [#^java.lang.annotation.Annotation o] (cond (instance? Annotation o) (let [type (.annotationType o) itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation)) data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))] (into {:annotationType (.annotationType o)} (map (fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))]) data-methods))) (or (sequential? o) (.isArray (class o))) (map annotation->map o) :else o)) (def expected-annotations #{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME} {:annotationType javax.xml.ws.WebServiceRefs, :value [{:annotationType javax.xml.ws.WebServiceRef, :name "fred", :mappedName "", :type java.lang.String, :wsdlLocation "", :value java.lang.Object} {:annotationType javax.xml.ws.WebServiceRef, :name "ethel", :mappedName "lucy", :type java.lang.Object, :wsdlLocation "", :value java.lang.Object}]} {:annotationType javax.xml.ws.soap.Addressing, :enabled false, :required true} {:annotationType javax.annotation.processing.SupportedOptions, :value ["foo" "bar" "baz"]} {:annotationType java.lang.Deprecated}}) (deftest test-annotations-on-type (is (= expected-annotations (into #{} (map annotation->map (.getAnnotations Bar)))))) (deftest test-annotations-on-field (is (= expected-annotations (into #{} (map annotation->map (.getAnnotations (.getField Bar "b"))))))) (deftest test-annotations-on-method (is (= expected-annotations (into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/atoms.clj000066400000000000000000000012021157562347600243130ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;Author: Frantisek Sodomka (ns clojure.test-clojure.atoms (:use clojure.test)) ; http://clojure.org/atoms ; atom ; deref, @-reader-macro ; swap! reset! ; compare-and-set! clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/clojure_set.clj000066400000000000000000000160671157562347600255250ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Frantisek Sodomka (ns clojure.test-clojure.clojure-set (:use clojure.test) (:require [clojure.set :as set])) (deftest test-union (are [x y] (= x y) (set/union) #{} ; identity (set/union #{}) #{} (set/union #{1}) #{1} (set/union #{1 2 3}) #{1 2 3} ; 2 sets, at least one is empty (set/union #{} #{}) #{} (set/union #{} #{1}) #{1} (set/union #{} #{1 2 3}) #{1 2 3} (set/union #{1} #{}) #{1} (set/union #{1 2 3} #{}) #{1 2 3} ; 2 sets (set/union #{1} #{2}) #{1 2} (set/union #{1} #{1 2}) #{1 2} (set/union #{2} #{1 2}) #{1 2} (set/union #{1 2} #{3}) #{1 2 3} (set/union #{1 2} #{2 3}) #{1 2 3} ; 3 sets, some are empty (set/union #{} #{} #{}) #{} (set/union #{1} #{} #{}) #{1} (set/union #{} #{1} #{}) #{1} (set/union #{} #{} #{1}) #{1} (set/union #{1 2} #{2 3} #{}) #{1 2 3} ; 3 sets (set/union #{1 2} #{3 4} #{5 6}) #{1 2 3 4 5 6} (set/union #{1 2} #{2 3} #{1 3 4}) #{1 2 3 4} ; different data types (set/union #{1 2} #{:a :b} #{nil} #{false true} #{\c "abc"} #{[] [1 2]} #{{} {:a 1}} #{#{} #{1 2}}) #{1 2 :a :b nil false true \c "abc" [] [1 2] {} {:a 1} #{} #{1 2}} ; different types of sets (set/union (hash-set) (hash-set 1 2) (hash-set 2 3)) (hash-set 1 2 3) (set/union (sorted-set) (sorted-set 1 2) (sorted-set 2 3)) (sorted-set 1 2 3) (set/union (hash-set) (hash-set 1 2) (hash-set 2 3) (sorted-set) (sorted-set 4 5) (sorted-set 5 6)) (hash-set 1 2 3 4 5 6) ; also equals (sorted-set 1 2 3 4 5 6) )) (deftest test-intersection ; at least one argument is needed (is (thrown? IllegalArgumentException (set/intersection))) (are [x y] (= x y) ; identity (set/intersection #{}) #{} (set/intersection #{1}) #{1} (set/intersection #{1 2 3}) #{1 2 3} ; 2 sets, at least one is empty (set/intersection #{} #{}) #{} (set/intersection #{} #{1}) #{} (set/intersection #{} #{1 2 3}) #{} (set/intersection #{1} #{}) #{} (set/intersection #{1 2 3} #{}) #{} ; 2 sets (set/intersection #{1 2} #{1 2}) #{1 2} (set/intersection #{1 2} #{3 4}) #{} (set/intersection #{1 2} #{1}) #{1} (set/intersection #{1 2} #{2}) #{2} (set/intersection #{1 2 4} #{2 3 4 5}) #{2 4} ; 3 sets, some are empty (set/intersection #{} #{} #{}) #{} (set/intersection #{1} #{} #{}) #{} (set/intersection #{1} #{1} #{}) #{} (set/intersection #{1} #{} #{1}) #{} (set/intersection #{1 2} #{2 3} #{}) #{} ; 3 sets (set/intersection #{1 2} #{2 3} #{5 2}) #{2} (set/intersection #{1 2 3} #{1 3 4} #{1 3}) #{1 3} (set/intersection #{1 2 3} #{3 4 5} #{8 2 3}) #{3} ; different types of sets (set/intersection (hash-set 1 2) (hash-set 2 3)) #{2} (set/intersection (sorted-set 1 2) (sorted-set 2 3)) #{2} (set/intersection (hash-set 1 2) (hash-set 2 3) (sorted-set 1 2) (sorted-set 2 3)) #{2} )) (deftest test-difference (are [x y] (= x y) ; identity (set/difference #{}) #{} (set/difference #{1}) #{1} (set/difference #{1 2 3}) #{1 2 3} ; 2 sets (set/difference #{1 2} #{1 2}) #{} (set/difference #{1 2} #{3 4}) #{1 2} (set/difference #{1 2} #{1}) #{2} (set/difference #{1 2} #{2}) #{1} (set/difference #{1 2 4} #{2 3 4 5}) #{1} ; 3 sets (set/difference #{1 2} #{2 3} #{5 2}) #{1} (set/difference #{1 2 3} #{1 3 4} #{1 3}) #{2} (set/difference #{1 2 3} #{3 4 5} #{8 2 3}) #{1} )) (deftest test-select (are [x y] (= x y) (set/select integer? #{}) #{} (set/select integer? #{1 2}) #{1 2} (set/select integer? #{1 2 :a :b :c}) #{1 2} (set/select integer? #{:a :b :c}) #{}) ) (def compositions #{{:name "Art of the Fugue" :composer "J. S. Bach"} {:name "Musical Offering" :composer "J. S. Bach"} {:name "Requiem" :composer "Giuseppe Verdi"} {:name "Requiem" :composer "W. A. Mozart"}}) (deftest test-project (are [x y] (= x y) (set/project compositions [:name]) #{{:name "Art of the Fugue"} {:name "Requiem"} {:name "Musical Offering"}} (set/project compositions [:composer]) #{{:composer "W. A. Mozart"} {:composer "Giuseppe Verdi"} {:composer "J. S. Bach"}} (set/project compositions [:year]) #{{}} (set/project #{{}} [:name]) #{{}} )) (deftest test-rename (are [x y] (= x y) (set/rename compositions {:name :title}) #{{:title "Art of the Fugue" :composer "J. S. Bach"} {:title "Musical Offering" :composer "J. S. Bach"} {:title "Requiem" :composer "Giuseppe Verdi"} {:title "Requiem" :composer "W. A. Mozart"}} (set/rename compositions {:year :decade}) #{{:name "Art of the Fugue" :composer "J. S. Bach"} {:name "Musical Offering" :composer "J. S. Bach"} {:name "Requiem" :composer "Giuseppe Verdi"} {:name "Requiem" :composer "W. A. Mozart"}} (set/rename #{{}} {:year :decade}) #{{}})) (deftest test-rename-keys (are [x y] (= x y) (set/rename-keys {:a "one" :b "two"} {:a :z}) {:z "one" :b "two"} )) (deftest test-index (are [x y] (= x y) (set/index #{{:c 2} {:b 1} {:a 1 :b 2}} [:b]) {{:b 2} #{{:a 1 :b 2}}, {:b 1} #{{:b 1}} {} #{{:c 2}}} )) (deftest test-join (are [x y] (= x y) (set/join compositions compositions) compositions (set/join compositions #{{:name "Art of the Fugue" :genre "Classical"}}) #{{:name "Art of the Fugue" :composer "J. S. Bach" :genre "Classical"}} )) (deftest test-map-invert (are [x y] (= x y) (set/map-invert {:a "one" :b "two"}) {"one" :a "two" :b})) (deftest test-subset? (are [sub super] (set/subset? sub super) #{} #{} #{} #{1} #{1} #{1} #{1 2} #{1 2} #{1 2} #{1 2 42}) (are [notsub super] (not (set/subset? notsub super)) #{1} #{} #{2} #{1} #{1 3} #{1})) (deftest test-superset? (are [super sub] (set/superset? super sub) #{} #{} #{1} #{} #{1} #{1} #{1 2} #{1 2} #{1 2 42} #{1 2}) (are [notsuper sub] (not (set/superset? notsuper sub)) #{} #{1} #{2} #{1} #{1} #{1 3})) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/clojure_xml.clj000066400000000000000000000011571157562347600255240ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;Author: Frantisek Sodomka (ns clojure.test-clojure.clojure-xml (:use clojure.test) (:require [clojure.xml :as xml])) ; parse ; emit-element ; emit clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/clojure_zip.clj000066400000000000000000000015431157562347600255250ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.clojure-zip (:use clojure.test) (:require [clojure.zip :as zip])) ; zipper ; ; seq-zip ; vector-zip ; xml-zip ; ; node ; branch? ; children ; make-node ; path ; lefts ; rights ; down ; up ; root ; right ; rightmost ; left ; leftmost ; ; insert-left ; insert-right ; replace ; edit ; insert-child ; append-child ; next ; prev ; end? ; remove clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/compilation.clj000066400000000000000000000031631157562347600255160ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.compilation (:use clojure.test)) ; http://clojure.org/compilation ; compile ; gen-class, gen-interface (deftest test-compiler-metadata (let [m (meta #'when)] (are [x y] (= x y) (list? (:arglists m)) true (> (count (:arglists m)) 0) true (string? (:doc m)) true (> (.length (:doc m)) 0) true (string? (:file m)) true (> (.length (:file m)) 0) true (integer? (:line m)) true (> (:line m) 0) true (:macro m) true (:name m) 'when ))) (deftest test-embedded-constants (testing "Embedded constants" (is (eval `(= Boolean/TYPE ~Boolean/TYPE))) (is (eval `(= Byte/TYPE ~Byte/TYPE))) (is (eval `(= Character/TYPE ~Character/TYPE))) (is (eval `(= Double/TYPE ~Double/TYPE))) (is (eval `(= Float/TYPE ~Float/TYPE))) (is (eval `(= Integer/TYPE ~Integer/TYPE))) (is (eval `(= Long/TYPE ~Long/TYPE))) (is (eval `(= Short/TYPE ~Short/TYPE))))) (deftest test-compiler-resolution (testing "resolve nonexistent class create should return nil (assembla #262)" (is (nil? (resolve 'NonExistentClass.))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/control.clj000066400000000000000000000176761157562347600246760ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway ;; ;; Test "flow control" constructs. ;; (ns clojure.test-clojure.control (:use clojure.test [clojure.test-clojure.helpers :only (exception)])) ;; *** Helper functions *** (defn maintains-identity [f] (are [x] (= (f x) x) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} )) ; http://clojure.org/special_forms ; http://clojure.org/macros (deftest test-do (are [x y] (= x y) ; no params => nil (do) nil ; return last (do 1) 1 (do 1 2) 2 (do 1 2 3 4 5) 5 ; evaluate and return last (let [a (atom 0)] (do (reset! a (+ @a 1)) ; 1 (reset! a (+ @a 1)) ; 2 (reset! a (+ @a 1)) ; 3 @a)) 3 ) ; identity (= (do x) x) (maintains-identity (fn [_] (do _))) ) ;; loop/recur (deftest test-loop (are [x y] (= x y) 1 (loop [] 1) 3 (loop [a 1] (if (< a 3) (recur (inc a)) a)) [2 4 6] (loop [a [] b [1 2 3]] (if (seq b) (recur (conj a (* 2 (first b))) (next b)) a)) [6 4 2] (loop [a () b [1 2 3]] (if (seq b) (recur (conj a (* 2 (first b))) (next b)) a)) ) ) ;; throw, try ; if: see logic.clj (deftest test-when (are [x y] (= x y) 1 (when true 1) nil (when true) nil (when false) nil (when false (exception)) )) (deftest test-when-not (are [x y] (= x y) 1 (when-not false 1) nil (when-not true) nil (when-not false) nil (when-not true (exception)) )) (deftest test-if-not (are [x y] (= x y) 1 (if-not false 1) 1 (if-not false 1 (exception)) nil (if-not true 1) 2 (if-not true 1 2) nil (if-not true (exception)) 1 (if-not true (exception) 1) )) (deftest test-when-let (are [x y] (= x y) 1 (when-let [a 1] a) 2 (when-let [[a b] '(1 2)] b) nil (when-let [a false] (exception)) )) (deftest test-if-let (are [x y] (= x y) 1 (if-let [a 1] a) 2 (if-let [[a b] '(1 2)] b) nil (if-let [a false] (exception)) 1 (if-let [a false] a 1) 1 (if-let [[a b] nil] b 1) 1 (if-let [a false] (exception) 1) )) (deftest test-when-first (are [x y] (= x y) 1 (when-first [a [1 2]] a) 2 (when-first [[a b] '((1 2) 3)] b) nil (when-first [a nil] (exception)) )) (deftest test-cond (are [x y] (= x y) (cond) nil (cond nil true) nil (cond false true) nil (cond true 1 true (exception)) 1 (cond nil 1 false 2 true 3 true 4) 3 (cond nil 1 false 2 true 3 true (exception)) 3 ) ; false (are [x] (= (cond x :a true :b) :b) nil false ) ; true (are [x] (= (cond x :a true :b) :a) true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} ) ; evaluation (are [x y] (= x y) (cond (> 3 2) (+ 1 2) true :result true (exception)) 3 (cond (< 3 2) (+ 1 2) true :result true (exception)) :result ) ; identity (= (cond true x) x) (maintains-identity (fn [_] (cond true _))) ) (deftest test-condp (are [x] (= :pass x) (condp = 1 1 :pass 2 :fail) (condp = 1 2 :fail 1 :pass) (condp = 1 2 :fail :pass) (condp = 1 :pass) (condp = 1 2 :fail ;; doc of condp says result-expr is returned ;; shouldn't it say similar to cond: "evaluates and returns ;; the value of the corresponding expr and doesn't evaluate any of the ;; other tests or exprs." (identity :pass)) (condp + 1 1 :>> #(if (= % 2) :pass :fail)) (condp + 1 1 :>> #(if (= % 3) :fail :pass)) ) (is (thrown? IllegalArgumentException (condp = 1) )) (is (thrown? IllegalArgumentException (condp = 1 2 :fail) )) ) ; [for, doseq (for.clj)] (deftest test-dotimes ;; dotimes always returns nil (is (= nil (dotimes [n 1] n))) ;; test using an atom since dotimes is for modifying ;; test executes n times (is (= 3 (let [a (atom 0)] (dotimes [n 3] (swap! a inc)) @a) )) ;; test all values of n (is (= [0 1 2] (let [a (atom [])] (dotimes [n 3] (swap! a conj n)) @a))) (is (= [] (let [a (atom [])] (dotimes [n 0] (swap! a conj n)) @a))) ) (deftest test-while (is (= nil (while nil (throw (Exception. "never"))))) (is (= [0 nil] ;; a will dec to 0 ;; while always returns nil (let [a (atom 3) w (while (pos? @a) (swap! a dec))] [@a w]))) (is (thrown? Exception (while true (throw (Exception. "expected to throw"))))) ) ; locking, monitor-enter, monitor-exit ; case (deftest test-case (testing "can match many kinds of things" (let [two 2 test-fn #(case % 1 :number "foo" :string \a :char pow :symbol :zap :keyword (2 \b "bar") :one-of-many [1 2] :sequential-thing {:a 2} :map {:r 2 :d 2} :droid #{2 3 4 5} :set [1 [[[2]]]] :deeply-nested :default)] (are [result input] (= result (test-fn input)) :number 1 :string "foo" :char \a :keyword :zap :symbol 'pow :one-of-many 2 :one-of-many \b :one-of-many "bar" :sequential-thing [1 2] :sequential-thing (list 1 2) :sequential-thing [1 two] :map {:a 2} :map {:a two} :set #{2 3 4 5} :set #{two 3 4 5} :default #{2 3 4 5 6} :droid {:r 2 :d 2} :deeply-nested [1 [[[two]]]] :default :anything-not-appearing-above))) (testing "throws IllegalArgumentException if no match" (is (thrown-with-msg? IllegalArgumentException #"No matching clause: 2" (case 2 1 :ok)))) (testing "sorting doesn't matter" (let [test-fn #(case % {:b 2 :a 1} :map #{3 2 1} :set :default)] (are [result input] (= result (test-fn input)) :map {:a 1 :b 2} :map (sorted-map :a 1 :b 2) :set #{3 2 1} :set (sorted-set 2 1 3)))) (testing "test constants are *not* evaluated" (let [test-fn ;; never write code like this... #(case % (throw (RuntimeException. "boom")) :piece-of-throw-expr :no-match)] (are [result input] (= result (test-fn input)) :piece-of-throw-expr 'throw :piece-of-throw-expr '[RuntimeException. "boom"] :no-match nil)))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/data_structures.clj000066400000000000000000000503341157562347600264160ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.data-structures (:use clojure.test)) ;; *** Helper functions *** (defn diff [s1 s2] (seq (reduce disj (set s1) (set s2)))) ;; *** General *** (defstruct equality-struct :a :b) (deftest test-equality ; nil is not equal to any other value (are [x] (not (= nil x)) true false 0 0.0 \space "" #"" () [] #{} {} (lazy-seq nil) ; SVN 1292: fixed (= (lazy-seq nil) nil) (lazy-seq ()) (lazy-seq []) (lazy-seq {}) (lazy-seq #{}) (lazy-seq "") (lazy-seq (into-array [])) (new Object) ) ; numbers equality across types (see tests below - NOT IMPLEMENTED YET) ; ratios (is (= 1/2 0.5)) (is (= 1/1000 0.001)) (is (not= 2/3 0.6666666666666666)) ; vectors equal other seqs by items equality (are [x y] (= x y) '() [] ; regression fixed in r1208; was not equal '(1) [1] '(1 2) [1 2] [] '() ; same again, but vectors first [1] '(1) [1 2] '(1 2) ) (is (not= [1 2] '(2 1))) ; order of items matters ; list and vector vs. set and map (are [x y] (not= x y) ; only () equals [] () #{} () {} [] #{} [] {} #{} {} ; only '(1) equals [1] '(1) #{1} [1] #{1} ) ; sorted-map, hash-map and array-map - classes differ, but content is equal ;; TODO: reimplement all-are with new do-template? ;; (all-are (not= (class _1) (class _2)) ;; (sorted-map :a 1) ;; (hash-map :a 1) ;; (array-map :a 1)) ;; (all-are (= _1 _2) ;; (sorted-map) ;; (hash-map) ;; (array-map)) ;; (all-are (= _1 _2) ;; (sorted-map :a 1) ;; (hash-map :a 1) ;; (array-map :a 1)) ;; (all-are (= _1 _2) ;; (sorted-map :a 1 :z 3 :c 2) ;; (hash-map :a 1 :z 3 :c 2) ;; (array-map :a 1 :z 3 :c 2)) ; struct-map vs. sorted-map, hash-map and array-map (are [x] (and (not= (class (struct equality-struct 1 2)) (class x)) (= (struct equality-struct 1 2) x)) (sorted-map-by compare :a 1 :b 2) (sorted-map :a 1 :b 2) (hash-map :a 1 :b 2) (array-map :a 1 :b 2)) ; sorted-set vs. hash-set (is (not= (class (sorted-set 1)) (class (hash-set 1)))) (are [x y] (= x y) (sorted-set-by <) (hash-set) (sorted-set-by < 1) (hash-set 1) (sorted-set-by < 3 2 1) (hash-set 3 2 1) (sorted-set) (hash-set) (sorted-set 1) (hash-set 1) (sorted-set 3 2 1) (hash-set 3 2 1) )) ;; *** Collections *** (deftest test-count (are [x y] (= x y) (count nil) 0 (count ()) 0 (count '(1)) 1 (count '(1 2 3)) 3 (count []) 0 (count [1]) 1 (count [1 2 3]) 3 (count #{}) 0 (count #{1}) 1 (count #{1 2 3}) 3 (count {}) 0 (count {:a 1}) 1 (count {:a 1 :b 2 :c 3}) 3 (count "") 0 (count "a") 1 (count "abc") 3 (count (into-array [])) 0 (count (into-array [1])) 1 (count (into-array [1 2 3])) 3 (count (java.util.ArrayList. [])) 0 (count (java.util.ArrayList. [1])) 1 (count (java.util.ArrayList. [1 2 3])) 3 (count (java.util.HashMap. {})) 0 (count (java.util.HashMap. {:a 1})) 1 (count (java.util.HashMap. {:a 1 :b 2 :c 3})) 3 ) ; different types (are [x] (= (count [x]) 1) nil true false 0 0.0 "" \space () [] #{} {} )) (deftest test-conj ; doesn't work on strings or arrays (is (thrown? ClassCastException (conj "" \a))) (is (thrown? ClassCastException (conj (into-array []) 1))) (are [x y] (= x y) (conj nil 1) '(1) (conj nil 3 2 1) '(1 2 3) (conj nil nil) '(nil) (conj nil nil nil) '(nil nil) (conj nil nil nil 1) '(1 nil nil) ; list -> conj puts the item at the front of the list (conj () 1) '(1) (conj () 1 2) '(2 1) (conj '(2 3) 1) '(1 2 3) (conj '(2 3) 1 4 3) '(3 4 1 2 3) (conj () nil) '(nil) (conj () ()) '(()) ; vector -> conj puts the item at the end of the vector (conj [] 1) [1] (conj [] 1 2) [1 2] (conj [2 3] 1) [2 3 1] (conj [2 3] 1 4 3) [2 3 1 4 3] (conj [] nil) [nil] (conj [] []) [[]] ; map -> conj expects another (possibly single entry) map as the item, ; and returns a new map which is the old map plus the entries ; from the new, which may overwrite entries of the old. ; conj also accepts a MapEntry or a vector of two items (key and value). (conj {} {}) {} (conj {} {:a 1}) {:a 1} (conj {} {:a 1 :b 2}) {:a 1 :b 2} (conj {} {:a 1 :b 2} {:c 3}) {:a 1 :b 2 :c 3} (conj {} {:a 1 :b 2} {:a 3 :c 4}) {:a 3 :b 2 :c 4} (conj {:a 1} {:a 7}) {:a 7} (conj {:a 1} {:b 2}) {:a 1 :b 2} (conj {:a 1} {:a 7 :b 2}) {:a 7 :b 2} (conj {:a 1} {:a 7 :b 2} {:c 3}) {:a 7 :b 2 :c 3} (conj {:a 1} {:a 7 :b 2} {:b 4 :c 5}) {:a 7 :b 4 :c 5} (conj {} (first {:a 1})) {:a 1} ; MapEntry (conj {:a 1} (first {:b 2})) {:a 1 :b 2} (conj {:a 1} (first {:a 7})) {:a 7} (conj {:a 1} (first {:b 2}) (first {:a 5})) {:a 5 :b 2} (conj {} [:a 1]) {:a 1} ; vector (conj {:a 1} [:b 2]) {:a 1 :b 2} (conj {:a 1} [:a 7]) {:a 7} (conj {:a 1} [:b 2] [:a 5]) {:a 5 :b 2} (conj {} {nil {}}) {nil {}} (conj {} {{} nil}) {{} nil} (conj {} {{} {}}) {{} {}} ; set (conj #{} 1) #{1} (conj #{} 1 2 3) #{1 2 3} (conj #{2 3} 1) #{3 1 2} (conj #{3 2} 1) #{1 2 3} (conj #{2 3} 2) #{2 3} (conj #{2 3} 2 3) #{2 3} (conj #{2 3} 4 1 2 3) #{1 2 3 4} (conj #{} nil) #{nil} (conj #{} #{}) #{#{}} )) ;; *** Lists and Vectors *** (deftest test-peek ; doesn't work for sets and maps (is (thrown? ClassCastException (peek #{1}))) (is (thrown? ClassCastException (peek {:a 1}))) (are [x y] (= x y) (peek nil) nil ; list = first (peek ()) nil (peek '(1)) 1 (peek '(1 2 3)) 1 (peek '(nil)) nil ; special cases (peek '(1 nil)) 1 (peek '(nil 2)) nil (peek '(())) () (peek '(() nil)) () (peek '(() 2 nil)) () ; vector = last (peek []) nil (peek [1]) 1 (peek [1 2 3]) 3 (peek [nil]) nil ; special cases (peek [1 nil]) nil (peek [nil 2]) 2 (peek [[]]) [] (peek [[] nil]) nil (peek [[] 2 nil]) nil )) (deftest test-pop ; doesn't work for sets and maps (is (thrown? ClassCastException (pop #{1}))) (is (thrown? ClassCastException (pop #{:a 1}))) ; collection cannot be empty (is (thrown? IllegalStateException (pop ()))) (is (thrown? IllegalStateException (pop []))) (are [x y] (= x y) (pop nil) nil ; list - pop first (pop '(1)) () (pop '(1 2 3)) '(2 3) (pop '(nil)) () (pop '(1 nil)) '(nil) (pop '(nil 2)) '(2) (pop '(())) () (pop '(() nil)) '(nil) (pop '(() 2 nil)) '(2 nil) ; vector - pop last (pop [1]) [] (pop [1 2 3]) [1 2] (pop [nil]) [] (pop [1 nil]) [1] (pop [nil 2]) [nil] (pop [[]]) [] (pop [[] nil]) [[]] (pop [[] 2 nil]) [[] 2] )) ;; *** Lists (IPersistentList) *** (deftest test-list (are [x] (list? x) () '() (list) (list 1 2 3) ) ; order is important (are [x y] (not (= x y)) (list 1 2) (list 2 1) (list 3 1 2) (list 1 2 3) ) (are [x y] (= x y) '() () (list) '() (list 1) '(1) (list 1 2) '(1 2) ; nesting (list 1 (list 2 3) (list 3 (list 4 5 (list 6 (list 7))))) '(1 (2 3) (3 (4 5 (6 (7))))) ; different data structures (list true false nil) '(true false nil) (list 1 2.5 2/3 "ab" \x 'cd :kw) '(1 2.5 2/3 "ab" \x cd :kw) (list (list 1 2) [3 4] {:a 1 :b 2} #{:c :d}) '((1 2) [3 4] {:a 1 :b 2} #{:c :d}) ; evaluation (list (+ 1 2) [(+ 2 3) 'a] (list (* 2 3) 8)) '(3 [5 a] (6 8)) ; special cases (list nil) '(nil) (list 1 nil) '(1 nil) (list nil 2) '(nil 2) (list ()) '(()) (list 1 ()) '(1 ()) (list () 2) '(() 2) )) ;; *** Maps (IPersistentMap) *** (deftest test-find (are [x y] (= x y) (find {} :a) nil (find {:a 1} :a) [:a 1] (find {:a 1} :b) nil (find {:a 1 :b 2} :a) [:a 1] (find {:a 1 :b 2} :b) [:b 2] (find {:a 1 :b 2} :c) nil (find {} nil) nil (find {:a 1} nil) nil (find {:a 1 :b 2} nil) nil )) (deftest test-contains? ; contains? is designed to work preferably on maps and sets (are [x y] (= x y) (contains? {} :a) false (contains? {} nil) false (contains? {:a 1} :a) true (contains? {:a 1} :b) false (contains? {:a 1} nil) false (contains? {:a 1 :b 2} :a) true (contains? {:a 1 :b 2} :b) true (contains? {:a 1 :b 2} :c) false (contains? {:a 1 :b 2} nil) false ; sets (contains? #{} 1) false (contains? #{} nil) false (contains? #{1} 1) true (contains? #{1} 2) false (contains? #{1} nil) false (contains? #{1 2 3} 1) true (contains? #{1 2 3} 3) true (contains? #{1 2 3} 10) false (contains? #{1 2 3} nil) false) ; numerically indexed collections (e.g. vectors and Java arrays) ; => test if the numeric key is WITHIN THE RANGE OF INDEXES (are [x y] (= x y) (contains? [] 0) false (contains? [] -1) false (contains? [] 1) false (contains? [1] 0) true (contains? [1] -1) false (contains? [1] 1) false (contains? [1 2 3] 0) true (contains? [1 2 3] 2) true (contains? [1 2 3] 3) false (contains? [1 2 3] -1) false ; arrays (contains? (into-array []) 0) false (contains? (into-array []) -1) false (contains? (into-array []) 1) false (contains? (into-array [1]) 0) true (contains? (into-array [1]) -1) false (contains? (into-array [1]) 1) false (contains? (into-array [1 2 3]) 0) true (contains? (into-array [1 2 3]) 2) true (contains? (into-array [1 2 3]) 3) false (contains? (into-array [1 2 3]) -1) false) ; 'contains?' operates constant or logarithmic time, ; it WILL NOT perform a linear search for a value. (are [x] (= x false) (contains? '(1 2 3) 0) (contains? '(1 2 3) 1) (contains? '(1 2 3) 3) (contains? '(1 2 3) 10) (contains? '(1 2 3) nil) (contains? '(1 2 3) ()) )) (deftest test-keys (are [x y] (= x y) ; other than map data structures (keys ()) nil (keys []) nil (keys #{}) nil (keys "") nil ) (are [x y] (= x y) ; (class {:a 1}) => clojure.lang.PersistentArrayMap (keys {}) nil (keys {:a 1}) '(:a) (diff (keys {:a 1 :b 2}) '(:a :b)) nil ; (keys {:a 1 :b 2}) '(:a :b) ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap (keys (sorted-map)) nil (keys (sorted-map :a 1)) '(:a) (diff (keys (sorted-map :a 1 :b 2)) '(:a :b)) nil ; (keys (sorted-map :a 1 :b 2)) '(:a :b) ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap (keys (hash-map)) nil (keys (hash-map :a 1)) '(:a) (diff (keys (hash-map :a 1 :b 2)) '(:a :b)) nil )) ; (keys (hash-map :a 1 :b 2)) '(:a :b) (deftest test-vals (are [x y] (= x y) ; other than map data structures (vals ()) nil (vals []) nil (vals #{}) nil (vals "") nil ) (are [x y] (= x y) ; (class {:a 1}) => clojure.lang.PersistentArrayMap (vals {}) nil (vals {:a 1}) '(1) (diff (vals {:a 1 :b 2}) '(1 2)) nil ; (vals {:a 1 :b 2}) '(1 2) ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap (vals (sorted-map)) nil (vals (sorted-map :a 1)) '(1) (diff (vals (sorted-map :a 1 :b 2)) '(1 2)) nil ; (vals (sorted-map :a 1 :b 2)) '(1 2) ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap (vals (hash-map)) nil (vals (hash-map :a 1)) '(1) (diff (vals (hash-map :a 1 :b 2)) '(1 2)) nil )) ; (vals (hash-map :a 1 :b 2)) '(1 2) (deftest test-key (are [x] (= (key (first (hash-map x :value))) x) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} )) (deftest test-val (are [x] (= (val (first (hash-map :key x))) x) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} )) (deftest test-get (let [m {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}}] (is (thrown? IllegalArgumentException (get-in {:a 1} 5))) (are [x y] (= x y) (get m :a) 1 (get m :e) nil (get m :e 0) 0 (get m :b 0) 2 (get m :f 0) nil (get-in m [:c :e]) 4 (get-in m '(:c :e)) 4 (get-in m [:c :x]) nil (get-in m [:f]) nil (get-in m [:g]) false (get-in m [:h]) nil (get-in m []) m (get-in m nil) m (get-in m [:c :e] 0) 4 (get-in m '(:c :e) 0) 4 (get-in m [:c :x] 0) 0 (get-in m [:b] 0) 2 (get-in m [:f] 0) nil (get-in m [:g] 0) false (get-in m [:h] 0) 0 (get-in m [:x :y] {:y 1}) {:y 1} (get-in m [] 0) m (get-in m nil 0) m))) ;; *** Sets *** (deftest test-hash-set (are [x] (set? x) #{} #{1 2} (hash-set) (hash-set 1 2) ) ; order isn't important (are [x y] (= x y) #{1 2} #{2 1} #{3 1 2} #{1 2 3} (hash-set 1 2) (hash-set 2 1) (hash-set 3 1 2) (hash-set 1 2 3) ) (are [x y] (= x y) ; equal classes (class #{}) (class (hash-set)) (class #{1 2}) (class (hash-set 1 2)) ; creating (hash-set) #{} (hash-set 1) #{1} (hash-set 1 2) #{1 2} ; nesting (hash-set 1 (hash-set 2 3) (hash-set 3 (hash-set 4 5 (hash-set 6 (hash-set 7))))) #{1 #{2 3} #{3 #{4 5 #{6 #{7}}}}} ; different data structures (hash-set true false nil) #{true false nil} (hash-set 1 2.5 2/3 "ab" \x 'cd :kw) #{1 2.5 2/3 "ab" \x 'cd :kw} (hash-set (list 1 2) [3 4] {:a 1 :b 2} #{:c :d}) #{'(1 2) [3 4] {:a 1 :b 2} #{:c :d}} ; evaluation (hash-set (+ 1 2) [(+ 2 3) :a] (hash-set (* 2 3) 8)) #{3 [5 :a] #{6 8}} ; special cases (hash-set nil) #{nil} (hash-set 1 nil) #{1 nil} (hash-set nil 2) #{nil 2} (hash-set #{}) #{#{}} (hash-set 1 #{}) #{1 #{}} (hash-set #{} 2) #{#{} 2} )) (deftest test-sorted-set ; only compatible types can be used (is (thrown? ClassCastException (sorted-set 1 "a"))) (is (thrown? ClassCastException (sorted-set '(1 2) [3 4]))) ; creates set? (are [x] (set? x) (sorted-set) (sorted-set 1 2) ) ; equal and unique (are [x] (and (= (sorted-set x) #{x}) (= (sorted-set x x) (sorted-set x))) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () ; '(1 2) [] [1 2] {} ; {:a 1 :b 2} #{} ; #{1 2} ) ; cannot be cast to java.lang.Comparable (is (thrown? ClassCastException (sorted-set '(1 2) '(1 2)))) (is (thrown? ClassCastException (sorted-set {:a 1 :b 2} {:a 1 :b 2}))) (is (thrown? ClassCastException (sorted-set #{1 2} #{1 2}))) (are [x y] (= x y) ; generating (sorted-set) #{} (sorted-set 1) #{1} (sorted-set 1 2) #{1 2} ; sorting (seq (sorted-set 5 4 3 2 1)) '(1 2 3 4 5) ; special cases (sorted-set nil) #{nil} (sorted-set 1 nil) #{nil 1} (sorted-set nil 2) #{nil 2} (sorted-set #{}) #{#{}} )) (deftest test-sorted-set-by ; only compatible types can be used ; NB: not a ClassCastException, but a RuntimeException is thrown, ; requires discussion on whether this should be symmetric with test-sorted-set (is (thrown? Exception (sorted-set-by < 1 "a"))) (is (thrown? Exception (sorted-set-by < '(1 2) [3 4]))) ; creates set? (are [x] (set? x) (sorted-set-by <) (sorted-set-by < 1 2) ) ; equal and unique (are [x] (and (= (sorted-set-by compare x) #{x}) (= (sorted-set-by compare x x) (sorted-set-by compare x))) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () ; '(1 2) [] [1 2] {} ; {:a 1 :b 2} #{} ; #{1 2} ) ; cannot be cast to java.lang.Comparable ; NB: not a ClassCastException, but a RuntimeException is thrown, ; requires discussion on whether this should be symmetric with test-sorted-set (is (thrown? Exception (sorted-set-by compare '(1 2) '(1 2)))) (is (thrown? Exception (sorted-set-by compare {:a 1 :b 2} {:a 1 :b 2}))) (is (thrown? Exception (sorted-set-by compare #{1 2} #{1 2}))) (are [x y] (= x y) ; generating (sorted-set-by >) #{} (sorted-set-by > 1) #{1} (sorted-set-by > 1 2) #{1 2} ; sorting (seq (sorted-set-by < 5 4 3 2 1)) '(1 2 3 4 5) ; special cases (sorted-set-by compare nil) #{nil} (sorted-set-by compare 1 nil) #{nil 1} (sorted-set-by compare nil 2) #{nil 2} (sorted-set-by compare #{}) #{#{}} )) (deftest test-set ; set? (are [x] (set? (set x)) () '(1 2) [] [1 2] #{} #{1 2} {} {:a 1 :b 2} (into-array []) (into-array [1 2]) "" "abc" ) ; unique (are [x] (= (set [x x]) #{x}) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} ) ; conversion (are [x y] (= (set x) y) () #{} '(1 2) #{1 2} [] #{} [1 2] #{1 2} #{} #{} ; identity #{1 2} #{1 2} ; identity {} #{} {:a 1 :b 2} #{[:a 1] [:b 2]} (into-array []) #{} (into-array [1 2]) #{1 2} "" #{} "abc" #{\a \b \c} )) (deftest test-disj ; doesn't work on lists, vectors or maps (is (thrown? ClassCastException (disj '(1 2) 1))) (is (thrown? ClassCastException (disj [1 2] 1))) (is (thrown? ClassCastException (disj {:a 1} :a))) ; identity (are [x] (= (disj x) x) nil #{} #{1 2 3} ; different data types #{nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw [] [1 2] {} {:a 1 :b 2} #{} #{1 2}} ) ; type identity (are [x] (= (class (disj x)) (class x)) (hash-set) (hash-set 1 2) (sorted-set) (sorted-set 1 2) ) (are [x y] (= x y) (disj nil :a) nil (disj nil :a :b) nil (disj #{} :a) #{} (disj #{} :a :b) #{} (disj #{:a} :a) #{} (disj #{:a} :a :b) #{} (disj #{:a} :c) #{:a} (disj #{:a :b :c :d} :a) #{:b :c :d} (disj #{:a :b :c :d} :a :d) #{:b :c} (disj #{:a :b :c :d} :a :b :c) #{:d} (disj #{:a :b :c :d} :d :a :c :b) #{} (disj #{nil} :a) #{nil} (disj #{nil} #{}) #{nil} (disj #{nil} nil) #{} (disj #{#{}} nil) #{#{}} (disj #{#{}} #{}) #{} (disj #{#{nil}} #{nil}) #{} )) ;; *** Queues *** (deftest test-queues (let [EMPTY clojure.lang.PersistentQueue/EMPTY] (are [x y] (= x y) EMPTY EMPTY (into EMPTY (range 50)) (into EMPTY (range 50)) (range 5) (into EMPTY (range 5)) (range 1 6) (-> EMPTY (into (range 6)) pop)) (are [x y] (not= x y) (range 5) (into EMPTY (range 6)) (range 6) (into EMPTY (range 5)) (range 0 6) (-> EMPTY (into (range 6)) pop) (range 1 6) (-> EMPTY (into (range 7)) pop)))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/def.clj000066400000000000000000000014421157562347600237340ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.test-clojure.def (:use clojure.test clojure.test-clojure.helpers clojure.test-clojure.protocols)) (deftest defn-error-messages (testing "bad arglist forms" (is (fails-with-cause? IllegalArgumentException '#"Parameter declaration arg1 should be a vector" (eval-in-temp-ns (defn foo (arg1 arg2))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/evaluation.clj000066400000000000000000000167731157562347600253620ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Tests for the Clojure functions documented at the URL: ;; ;; http://clojure.org/Evaluation ;; ;; by J. McConnell ;; Created 22 October 2008 (ns clojure.test-clojure.evaluation (:use clojure.test)) (import '(java.lang Boolean) '(clojure.lang Compiler Compiler$CompilerException)) (defmacro test-that "Provides a useful way for specifying the purpose of tests. If the first-level forms are lists that make a call to a clojure.test function, it supplies the purpose as the msg argument to those functions. Otherwise, the purpose just acts like a comment and the forms are run unchanged." [purpose & test-forms] (let [tests (map #(if (= (:ns (meta (resolve (first %)))) (the-ns 'clojure.test)) (concat % (list purpose)) %) test-forms)] `(do ~@tests))) (deftest Eval (is (= (eval '(+ 1 2 3)) (Compiler/eval '(+ 1 2 3)))) (is (= (eval '(list 1 2 3)) '(1 2 3))) (is (= (eval '(list + 1 2 3)) (list clojure.core/+ 1 2 3))) (test-that "Non-closure fns are supported as code" (is (= (eval (eval '(list + 1 2 3))) 6))) (is (= (eval (list '+ 1 2 3)) 6))) ; not using Clojure's RT/classForName since a bug in it could hide a bug in ; eval's resolution (defn class-for-name [name] (java.lang.Class/forName name)) (defmacro in-test-ns [& body] `(binding [*ns* *ns*] (in-ns 'clojure.test-clojure.evaluation) ~@body)) ;;; Literals tests ;;; (defmacro #^{:private true} evaluates-to-itself? [expr] `(let [v# ~expr q# (quote ~expr)] (is (= (eval q#) q#) (str q# " does not evaluate to itself")))) (deftest Literals ; Strings, numbers, characters, nil and keywords should evaluate to themselves (evaluates-to-itself? "test") (evaluates-to-itself? "test multi-line string") (evaluates-to-itself? 1) (evaluates-to-itself? 1.0) (evaluates-to-itself? 1.123456789) (evaluates-to-itself? 1/2) (evaluates-to-itself? 1M) (evaluates-to-itself? 999999999999999999) (evaluates-to-itself? \a) (evaluates-to-itself? \newline) (evaluates-to-itself? nil) (evaluates-to-itself? :test) ; Boolean literals should evaluate to Boolean.{TRUE|FALSE} (is (identical? (eval true) Boolean/TRUE)) (is (identical? (eval false) Boolean/FALSE))) ;;; Symbol resolution tests ;;; (def foo "abc") (in-ns 'resolution-test) (def bar 123) (def #^{:private true} baz 456) (in-ns 'clojure.test-clojure.evaluation) (defn a-match? [re s] (not (nil? (re-matches re s)))) (defmacro throws-with-msg ([re form] `(throws-with-msg ~re ~form Exception)) ([re form x] `(throws-with-msg ~re ~form ~(if (instance? Exception x) x Exception) ~(if (instance? String x) x nil))) ([re form class msg] `(let [ex# (try ~form (catch ~class e# e#) (catch Exception e# (let [cause# (.getCause e#)] (if (= ~class (class cause#)) cause# (throw e#)))))] (is (a-match? ~re (.toString ex#)) (or ~msg (str "Expected exception that matched " (pr-str ~re) ", but got exception with message: \"" ex#)))))) (deftest SymbolResolution (test-that "If a symbol is namespace-qualified, the evaluated value is the value of the binding of the global var named by the symbol" (is (= (eval 'resolution-test/bar) 123))) (test-that "It is an error if there is no global var named by the symbol" (throws-with-msg #".*Unable to resolve symbol: bar.*" (eval 'bar))) (test-that "It is an error if the symbol reference is to a non-public var in a different namespace" (throws-with-msg #".*resolution-test/baz is not public.*" (eval 'resolution-test/baz) Compiler$CompilerException)) (test-that "If a symbol is package-qualified, its value is the Java class named by the symbol" (is (= (eval 'java.lang.Math) (class-for-name "java.lang.Math")))) (test-that "If a symbol is package-qualified, it is an error if there is no Class named by the symbol" (is (thrown? Compiler$CompilerException (eval 'java.lang.FooBar)))) (test-that "If a symbol is not qualified, the following applies, in this order: 1. If it names a special form it is considered a special form, and must be utilized accordingly. 2. A lookup is done in the current namespace to see if there is a mapping from the symbol to a class. If so, the symbol is considered to name a Java class object. 3. If in a local scope (i.e. in a function definition), a lookup is done to see if it names a local binding (e.g. a function argument or let-bound name). If so, the value is the value of the local binding. 4. A lookup is done in the current namespace to see if there is a mapping from the symbol to a var. If so, the value is the value of the binding of the var referred-to by the symbol. 5. It is an error." ; First (doall (for [form '(def if do let quote var fn loop recur throw try monitor-enter monitor-exit)] (is (thrown? Compiler$CompilerException (eval form))))) (let [if "foo"] (is (thrown? Compiler$CompilerException (eval 'if))) ; Second (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean")))) (let [Boolean "foo"] (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean")))) ; Third (is (= (eval '(let [foo "bar"] foo)) "bar")) ; Fourth (in-test-ns (is (= (eval 'foo) "abc"))) (is (thrown? Compiler$CompilerException (eval 'bar))) ; not in this namespace ; Fifth (is (thrown? Compiler$CompilerException (eval 'foobar))))) ;;; Metadata tests ;;; (defstruct struct-with-symbols (with-meta 'k {:a "A"})) (deftest Metadata (test-that "find returns key symbols and their metadata" (let [s (struct struct-with-symbols 1)] (is (= {:a "A"} (meta (first (find s 'k)))))))) ;;; Collections tests ;;; (def x 1) (def y 2) (deftest Collections (in-test-ns (test-that "Vectors and Maps yield vectors and (hash) maps whose contents are the evaluated values of the objects they contain." (is (= (eval '[x y 3]) [1 2 3])) (is (= (eval '{:x x :y y :z 3}) {:x 1 :y 2 :z 3})) (is (instance? clojure.lang.IPersistentMap (eval '{:x x :y y}))))) (in-test-ns (test-that "Metadata maps yield maps whose contents are the evaluated values of the objects they contain. If a vector or map has metadata, the evaluated metadata map will become the metadata of the resulting value." (is (= (eval #^{:x x} '[x y]) #^{:x 1} [1 2])))) (test-that "An empty list () evaluates to an empty list." (is (= (eval '()) ())) (is (empty? (eval ()))) (is (= (eval (list)) ()))) (test-that "Non-empty lists are considered calls" (is (thrown? Compiler$CompilerException (eval '(1 2 3)))))) (deftest Macros) (deftest Loading) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/for.clj000066400000000000000000000134461157562347600237730ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Tests for the Clojure 'for' macro ;; ;; by Chouser ;; Created Dec 2008 (ns clojure.test-clojure.for (:use clojure.test)) (deftest Docstring-Example (is (= (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y])) '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2] [4 0] [4 1] [4 2] [4 3] [5 0] [5 1] [5 2] [5 3] [5 4] [6 0] [6 1] [6 2] [6 3] [6 4] [6 5] [7 0] [7 1] [7 2] [7 3] [7 4] [7 5] [7 6] [8 0] [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7] [9 0] [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8] [10 0] [10 1] [10 2] [10 3] [10 4] [10 5] [10 6] [10 7] [10 8] [10 9] [11 0] [11 1] [11 2] [11 3] [11 4] [11 5] [11 6] [11 7] [11 8] [11 9] [11 10] [12 0] [12 1] [12 2] [12 3] [12 4] [12 5] [12 6] [12 7] [12 8] [12 9] [12 10] [12 11] [13 0] [13 1] [13 2] [13 3] [13 4] [13 5] [13 6] [13 7] [13 8] [13 9] [13 10] [13 11] [13 12] [14 0] [14 1] [14 2] [14 3] [14 4] [14 5] [14 6] [14 7] [14 8])))) (defmacro deftest-both [txt & ises] `(do (deftest ~(symbol (str "For-" txt)) ~@ises) (deftest ~(symbol (str "Doseq-" txt)) ~@(map (fn [[x-is [x-= [x-for binds body] value]]] (when (and (= x-is 'is) (= x-= '=) (= x-for 'for)) `(is (= (let [acc# (atom [])] (doseq ~binds (swap! acc# conj ~body)) @acc#) ~value)))) ises)))) (deftest-both When (is (= (for [x (range 10) :when (odd? x)] x) '(1 3 5 7 9))) (is (= (for [x (range 4) y (range 4) :when (odd? y)] [x y]) '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3]))) (is (= (for [x (range 4) y (range 4) :when (odd? x)] [x y]) '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3]))) (is (= (for [x (range 4) :when (odd? x) y (range 4)] [x y]) '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3]))) (is (= (for [x (range 5) y (range 5) :when (< x y)] [x y]) '([0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4])))) (defn only "Returns a lazy seq of increasing ints starting at 0. Trying to get the nth+1 value of the seq throws an exception. This is meant to help detecting over-eagerness in lazy seq consumers." [n] (lazy-cat (range n) (throw (Exception. "consumer went too far in lazy seq")))) (deftest-both While (is (= (for [x (only 6) :while (< x 5)] x) '(0 1 2 3 4))) (is (= (for [x (range 4) y (only 4) :while (< y 3)] [x y]) '([0 0] [0 1] [0 2] [1 0] [1 1] [1 2] [2 0] [2 1] [2 2] [3 0] [3 1] [3 2]))) (is (= (for [x (range 4) y (range 4) :while (< x 3)] [x y]) '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3] [2 0] [2 1] [2 2] [2 3]))) (is (= (for [x (only 4) :while (< x 3) y (range 4)] [x y]) '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3] [2 0] [2 1] [2 2] [2 3]))) (is (= (for [x (range 4) y (range 4) :while (even? x)] [x y]) '([0 0] [0 1] [0 2] [0 3] [2 0] [2 1] [2 2] [2 3]))) (is (= (for [x (only 2) :while (even? x) y (range 4)] [x y]) '([0 0] [0 1] [0 2] [0 3]))) (is (= (for [x (range 4) y (only 4) :while (< y x)] [x y]) '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2])))) (deftest-both While-and-When (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? y)] [x y]) '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3] [4 1] [4 3]))) (is (= (for [x (range 4) :when (odd? x) y (only 6) :while (< y 5)] [x y]) '([1 0] [1 1] [1 2] [1 3] [1 4] [3 0] [3 1] [3 2] [3 3] [3 4]))) (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? (+ x y))] [x y]) '([0 1] [0 3] [1 0] [1 2] [2 1] [2 3] [3 0] [3 2] [4 1] [4 3]))) (is (= (for [x (range 4) :when (odd? x) y (only 2) :while (odd? (+ x y))] [x y]) '([1 0] [3 0])))) (deftest-both While-and-When-Same-Binding (is (= (for [x (only 6) :while (< x 5) :when (odd? x)] x) '(1 3))) (is (= (for [x (only 6) :while (< x 5) ; if :while is false, :when should not be evaled :when (do (if (< x 5) (odd? x)))] x) '(1 3))) (is (= (for [a (range -2 5) :when (not= a 0) ; :when may guard :while :while (> (Math/abs (/ 1.0 a)) 1/3)] a) '(-2 -1 1 2)))) (deftest-both Nesting (is (= (for [x '(a b) y (interpose x '(1 2)) z (list x y)] [x y z]) '([a 1 a] [a 1 1] [a a a] [a a a] [a 2 a] [a 2 2] [b 1 b] [b 1 1] [b b b] [b b b] [b 2 b] [b 2 2]))) (is (= (for [x ['a nil] y [x 'b]] [x y]) '([a a] [a b] [nil nil] [nil b])))) (deftest-both Destructuring (is (= (for [{:syms [a b c]} (map #(zipmap '(a b c) (range % 5)) (range 3)) x [a b c]] (Integer. (str a b c x))) '(120 121 122 1231 1232 1233 2342 2343 2344)))) (deftest-both Let (is (= (for [x (range 3) y (range 3) :let [z (+ x y)] :when (odd? z)] [x y z]) '([0 1 1] [1 0 1] [1 2 3] [2 1 3]))) (is (= (for [x (range 6) :let [y (rem x 2)] :when (even? y) z [8 9]] [x z]) '([0 8] [0 9] [2 8] [2 9] [4 8] [4 9])))) ; :while must skip all subsequent chunks as well as the remainder of ; the current chunk: (deftest-both Chunked-While (is (= (for [x (range 100) :while (even? x)] x) '(0)))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/genclass.clj000066400000000000000000000062201157562347600247740ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Tests for clojure.core/gen-class" :author "Stuart Halloway, Daniel Solano Gómez"} clojure.test-clojure.genclass (:use clojure.test clojure.test-clojure.helpers) (:import [clojure.test_clojure.genclass.examples ExampleClass ExampleAnnotationClass] [java.lang.annotation ElementType Retention RetentionPolicy Target])) (deftest arg-support (let [example (ExampleClass.) o (Object.)] (is (= "foo with o, o" (.foo example o o))) (is (= "foo with o, i" (.foo example o (int 1)))) (is (thrown? java.lang.UnsupportedOperationException (.foo example o))))) (deftest name-munging (testing "mapping from Java fields to Clojure vars" (is (= #'clojure.test-clojure.genclass.examples/-foo-Object-int (get-field ExampleClass 'foo_Object_int__var))) (is (= #'clojure.test-clojure.genclass.examples/-toString (get-field ExampleClass 'toString__var))))) (deftest test-annotations (let [annot-class ExampleAnnotationClass foo-method (.getDeclaredMethod annot-class "foo" (into-array [String]))] (testing "Class annotations:" (is (= 2 (count (.getDeclaredAnnotations annot-class)))) (testing "@Deprecated" (let [deprecated (.getAnnotation annot-class Deprecated)] (is deprecated))) (testing "@Target([])" (let [resource (.getAnnotation annot-class Target)] (is (= 0 (count (.value resource))))))) (testing "Method annotations:" (testing "@Deprecated void foo(String):" (is (= 1 (count (.getDeclaredAnnotations foo-method)))) (is (.getAnnotation foo-method Deprecated)))) (testing "Parameter annotations:" (let [param-annots (.getParameterAnnotations foo-method)] (is (= 1 (alength param-annots))) (let [first-param-annots (aget param-annots 0)] (is (= 2 (alength first-param-annots))) (testing "void foo(@Retention(…) String)" (let [retention (aget first-param-annots 0)] (is (instance? Retention retention)) (= RetentionPolicy/SOURCE (.value retention)))) (testing "void foo(@Target(…) String)" (let [target (aget first-param-annots 1)] (is (instance? Target target)) (is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target))))))))))) (deftest genclass-option-validation (is (fails-with-cause? IllegalArgumentException #"Not a valid method name: has-hyphen" (@#'clojure.core/validate-generate-class-options {:methods '[[fine [] void] [has-hyphen [] void]]})))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/genclass/000077500000000000000000000000001157562347600243025ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/genclass/examples.clj000066400000000000000000000033301157562347600266110ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Test classes that are AOT-compile for the tests in clojure.test-clojure.genclass." :author "Stuart Halloway, Daniel Solano Gómez"} clojure.test-clojure.genclass.examples) (definterface ExampleInterface (foo [a]) (foo [a b]) (foo [a #^int b])) (gen-class :name clojure.test_clojure.genclass.examples.ExampleClass :implements [clojure.test_clojure.genclass.examples.ExampleInterface]) ;; -foo-Object unimplemented to test missing fn case (defn -foo-Object-Object [_ o1 o2] "foo with o, o") (defn -foo-Object-int [_ o i] "foo with o, i") (gen-class :name ^{Deprecated {} SuppressWarnings ["Warning1"] ; discarded java.lang.annotation.Target []} clojure.test_clojure.genclass.examples.ExampleAnnotationClass :prefix "annot-" :methods [[^{Deprecated {} Override {}} ;discarded foo [^{java.lang.annotation.Retention java.lang.annotation.RetentionPolicy/SOURCE java.lang.annotation.Target [java.lang.annotation.ElementType/TYPE java.lang.annotation.ElementType/PARAMETER]} String] void]]) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/helpers.clj000066400000000000000000000051401157562347600246370ustar00rootroot00000000000000; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stuart Halloway (ns clojure.test-clojure.helpers (:use clojure.test)) (defn temp-ns "Create and return a temporary ns, using clojure.core + uses" [& uses] (binding [*ns* *ns*] (in-ns (gensym)) (apply clojure.core/use 'clojure.core uses) *ns*)) (defmacro eval-in-temp-ns [& forms] `(binding [*ns* *ns*] (in-ns (gensym)) (clojure.core/use 'clojure.core) (eval '(do ~@forms)))) (defn causes [^Throwable throwable] (loop [causes [] t throwable] (if t (recur (conj causes t) (.getCause t)) causes))) ;; this is how I wish clojure.test/thrown? worked... ;; Does body throw expected exception, anywhere in the .getCause chain? (defmethod assert-expr 'fails-with-cause? [msg [_ exception-class msg-re & body :as form]] `(try ~@body (report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch Throwable t# (if (some (fn [cause#] (and (= ~exception-class (class cause#)) (re-find ~msg-re (.getMessage cause#)))) (causes t#)) (report {:type :pass, :message ~msg, :expected '~form, :actual t#}) (report {:type :fail, :message ~msg, :expected '~form, :actual t#}))))) (defn get-field "Access to private or protected field. field-name is a symbol or keyword." ([klass field-name] (get-field klass field-name nil)) ([klass field-name inst] (-> klass (.getDeclaredField (name field-name)) (doto (.setAccessible true)) (.get inst)))) (defn set-var-roots [maplike] (doseq [[var val] maplike] (alter-var-root var (fn [_] val)))) (defn with-var-roots* "Temporarily set var roots, run block, then put original roots back." [root-map f & args] (let [originals (doall (map (fn [[var _]] [var @var]) root-map))] (set-var-roots root-map) (try (apply f args) (finally (set-var-roots originals))))) (defmacro with-var-roots [root-map & body] `(with-var-roots* ~root-map (fn [] ~@body))) (defn exception "Use this function to ensure that execution of a program doesn't reach certain point." [] (throw (new Exception "Exception which should never occur"))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/java/000077500000000000000000000000001157562347600234245ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/java/io.clj000066400000000000000000000177711157562347600245420ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.test-clojure.java.io (:use clojure.test clojure.java.io) (:import (java.io File BufferedInputStream FileInputStream InputStreamReader InputStream FileOutputStream OutputStreamWriter OutputStream ByteArrayInputStream ByteArrayOutputStream) (java.net URL URI Socket ServerSocket))) (defn temp-file [prefix suffix] (doto (File/createTempFile prefix suffix) (.deleteOnExit))) (deftest test-spit-and-slurp (let [f (temp-file "clojure.java.io" "test")] (spit f "foobar") (is (= "foobar" (slurp f))) (spit f "foobar" :encoding "UTF-16") (is (= "foobar" (slurp f :encoding "UTF-16"))) (testing "deprecated arity" (is (= "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).\n" (with-out-str (is (= "foobar" (slurp f "UTF-16"))))))))) (deftest test-streams-defaults (let [f (temp-file "clojure.java.io" "test-reader-writer") content "testing"] (try (is (thrown? Exception (reader (Object.)))) (is (thrown? Exception (writer (Object.)))) (are [write-to read-from] (= content (do (spit write-to content :encoding "UTF-8") (slurp read-from :encoding "UTF-8"))) f f (.getAbsolutePath f) (.getAbsolutePath f) (.toURL f) (.toURL f) (.toURI f) (.toURI f) (FileOutputStream. f) (FileInputStream. f) (OutputStreamWriter. (FileOutputStream. f) "UTF-8") (reader f :encoding "UTF-8") f (FileInputStream. f) (writer f :encoding "UTF-8") (InputStreamReader. (FileInputStream. f) "UTF-8")) (is (= content (slurp (.getBytes content "UTF-8")))) (is (= content (slurp (.toCharArray content)))) (finally (.delete f))))) (defn bytes-should-equal [byte-array-1 byte-array-2 msg] (is (= @#'clojure.java.io/byte-array-type (class byte-array-1) (class byte-array-2)) msg) (is (= (into [] byte-array-1) (into [] byte-array-2)) msg)) (defn data-fixture "in memory fixture data for tests" [encoding] (let [bs (.getBytes "hello" encoding) cs (.toCharArray "hello") i (ByteArrayInputStream. bs) r (InputStreamReader. i) o (ByteArrayOutputStream.) w (OutputStreamWriter. o)] {:bs bs :i i :r r :o o :s "hello" :cs cs :w w})) (deftest test-copy (dorun (for [{:keys [in out flush] :as test} [{:in :i :out :o} {:in :i :out :w} {:in :r :out :o} {:in :r :out :w} {:in :cs :out :o} {:in :cs :out :w} {:in :bs :out :o} {:in :bs :out :w}] opts [{} {:buffer-size 256}]] (let [{:keys [s o] :as d} (data-fixture "UTF-8")] (apply copy (in d) (out d) (flatten (vec opts))) #_(when (= out :w) (.flush (:w d))) (.flush (out d)) (bytes-should-equal (.getBytes s "UTF-8") (.toByteArray o) (str "combination " test opts)))))) (deftest test-copy-encodings (testing "from inputstream UTF-16 to writer UTF-8" (let [{:keys [i s o w bs]} (data-fixture "UTF-16")] (copy i w :encoding "UTF-16") (.flush w) (bytes-should-equal (.getBytes s "UTF-8") (.toByteArray o) ""))) (testing "from reader UTF-8 to output-stream UTF-16" (let [{:keys [r o s]} (data-fixture "UTF-8")] (copy r o :encoding "UTF-16") (bytes-should-equal (.getBytes s "UTF-16") (.toByteArray o) "")))) (deftest test-as-file (are [result input] (= result (as-file input)) (File. "foo") "foo" (File. "bar") (File. "bar") (File. "baz") (URL. "file:baz") (File. "quux") (URI. "file:quux") nil nil)) (deftest test-file (are [result args] (= (File. result) (apply file args)) "foo" ["foo"] "foo/bar" ["foo" "bar"] "foo/bar/baz" ["foo" "bar" "baz"])) (deftest test-as-url (are [file-part input] (= (URL. (str "file:" file-part)) (as-url input)) "foo" "file:foo" "baz" (URL. "file:baz") "quux" (URI. "file:quux")) (is (nil? (as-url nil)))) (deftest test-delete-file (let [file (temp-file "test" "deletion") not-file (File. (str (java.util.UUID/randomUUID)))] (delete-file (.getAbsolutePath file)) (is (not (.exists file))) (is (thrown? java.io.IOException (delete-file not-file))) (is (= :silently (delete-file not-file :silently))))) (deftest test-as-relative-path (testing "strings" (is (= "foo" (as-relative-path "foo")))) (testing "absolute path strings are forbidden" (is (thrown? IllegalArgumentException (as-relative-path (.getAbsolutePath (File. "baz")))))) (testing "relative File paths" (is (= "bar" (as-relative-path (File. "bar"))))) (testing "absolute File paths are forbidden" (is (thrown? IllegalArgumentException (as-relative-path (File. (.getAbsolutePath (File. "quux")))))))) (defn stream-should-have [stream expected-bytes msg] (let [actual-bytes (byte-array (alength expected-bytes))] (.read stream actual-bytes) (is (= -1 (.read stream)) (str msg " : should be end of stream")) (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) (deftest test-input-stream (let [file (temp-file "test-input-stream" "txt") bytes (.getBytes "foobar")] (spit file "foobar") (doseq [[expr msg] [[file File] [(FileInputStream. file) FileInputStream] [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] [(.. file toURI) URI] [(.. file toURI toURL) URL] [(.. file toURI toURL toString) "URL as String"] [(.. file toString) "File as String"]]] (with-open [s (input-stream expr)] (stream-should-have s bytes msg))))) (deftest test-streams-buffering (let [data (.getBytes "")] (is (instance? java.io.BufferedReader (reader data))) (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) (is (instance? java.io.BufferedInputStream (input-stream data))) (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) (deftest test-resource (is (nil? (resource "non/existent/resource"))) (is (instance? URL (resource "clojure/core.clj"))) (let [file (temp-file "test-resource" "txt") url (as-url (.getParentFile file)) loader (java.net.URLClassLoader. (into-array [url]))] (is (nil? (resource "non/existent/resource" loader))) (is (instance? URL (resource (.getName file) loader))))) (deftest test-make-parents (let [tmp (System/getProperty "java.io.tmpdir")] (delete-file (file tmp "test-make-parents" "child" "grandchild") :silently) (delete-file (file tmp "test-make-parents" "child") :silently) (delete-file (file tmp "test-make-parents") :silently) (make-parents tmp "test-make-parents" "child" "grandchild") (is (.isDirectory (file tmp "test-make-parents" "child"))) (is (not (.isDirectory (file tmp "test-make-parents" "child" "grandchild")))) (delete-file (file tmp "test-make-parents" "child")) (delete-file (file tmp "test-make-parents")))) (deftest test-socket-iofactory (let [port 65321 server-socket (ServerSocket. port) client-socket (Socket. "localhost" port)] (try (is (instance? InputStream (input-stream client-socket))) (is (instance? OutputStream (output-stream client-socket))) (finally (.close server-socket) (.close client-socket))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/java/javadoc.clj000066400000000000000000000020131157562347600255210ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.test-clojure.java.javadoc (:use clojure.test [clojure.java.javadoc :as j]) (:import (java.io File))) (deftest javadoc-url-test (testing "for a core api" (binding [*feeling-lucky* false] (are [x y] (= x (#'j/javadoc-url y)) nil "foo.Bar" (str *core-java-api* "java/lang/String.html") "java.lang.String"))) (testing "for a remote javadoc" (binding [*remote-javadocs* (ref (sorted-map "java." "http://example.com/"))] (is (= "http://example.com/java/lang/Number.html" (#'j/javadoc-url "java.lang.Number")))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/java/shell.clj000066400000000000000000000034251157562347600252310ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.test-clojure.java.shell (:use clojure.test [clojure.java.shell :as sh]) (:import (java.io File))) (def platform-enc (.name (java.nio.charset.Charset/defaultCharset))) (def default-enc "UTF-8") (deftest test-parse-args (are [x y] (= x y) [[] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args []) [["ls"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls"]) [["ls" "-l"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"]) [["ls"] {:in-enc default-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "ISO-8859-1"]) [[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args [:in-enc platform-enc :out-enc platform-enc]))) (deftest test-with-sh-dir (are [x y] (= x y) nil *sh-dir* "foo" (with-sh-dir "foo" *sh-dir*))) (deftest test-with-sh-env (are [x y] (= x y) nil *sh-env* {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*))) (deftest test-as-env-strings (are [x y] (= x y) nil (#'sh/as-env-strings nil) ["FOO=BAR"] (seq (#'sh/as-env-strings {"FOO" "BAR"})) ["FOO_SYMBOL=BAR"] (seq (#'sh/as-env-strings {'FOO_SYMBOL "BAR"})) ["FOO_KEYWORD=BAR"] (seq (#'sh/as-env-strings {:FOO_KEYWORD "BAR"})))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/java_interop.clj000066400000000000000000000247221157562347600256650ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.java-interop (:use clojure.test)) ; http://clojure.org/java_interop ; http://clojure.org/compilation (deftest test-dot ; (.instanceMember instance args*) (are [x] (= x "FRED") (.toUpperCase "fred") (. "fred" toUpperCase) (. "fred" (toUpperCase)) ) (are [x] (= x true) (.startsWith "abcde" "ab") (. "abcde" startsWith "ab") (. "abcde" (startsWith "ab")) ) ; (.instanceMember Classname args*) (are [x] (= x "java.lang.String") (.getName String) (. (identity String) getName) (. (identity String) (getName)) ) ; (Classname/staticMethod args*) (are [x] (= x 7) (Math/abs -7) (. Math abs -7) (. Math (abs -7)) ) ; Classname/staticField (are [x] (= x 2147483647) Integer/MAX_VALUE (. Integer MAX_VALUE) )) (deftest test-double-dot (is (= (.. System (getProperties) (get "os.name")) (. (. System (getProperties)) (get "os.name"))))) (deftest test-doto (let [m (doto (new java.util.HashMap) (.put "a" 1) (.put "b" 2))] (are [x y] (= x y) (class m) java.util.HashMap m {"a" 1 "b" 2} ))) (deftest test-new ; Integer (are [expr cls value] (and (= (class expr) cls) (= expr value)) (new java.lang.Integer 42) java.lang.Integer 42 (java.lang.Integer. 123) java.lang.Integer 123 ) ; Date (are [x] (= (class x) java.util.Date) (new java.util.Date) (java.util.Date.) )) (deftest test-instance? ; evaluation (are [x y] (= x y) (instance? java.lang.Integer (+ 1 2)) true (instance? java.lang.Long (+ 1 2)) false ) ; different types (are [type literal] (instance? literal type) 1 java.lang.Integer 1.0 java.lang.Double 1M java.math.BigDecimal \a java.lang.Character "a" java.lang.String ) ; it is an int, nothing else (are [x y] (= (instance? x 42) y) java.lang.Integer true java.lang.Long false java.lang.Character false java.lang.String false )) ; set! ; memfn (deftest test-bean (let [b (bean java.awt.Color/black)] (are [x y] (= x y) (map? b) true (:red b) 0 (:green b) 0 (:blue b) 0 (:RGB b) -16777216 (:alpha b) 255 (:transparency b) 1 (:class b) java.awt.Color ))) ; proxy, proxy-super (deftest test-bases (are [x y] (= x y) (bases java.lang.Math) (list java.lang.Object) (bases java.lang.Integer) (list java.lang.Number java.lang.Comparable) )) (deftest test-supers (are [x y] (= x y) (supers java.lang.Math) #{java.lang.Object} (supers java.lang.Integer) #{java.lang.Number java.lang.Object java.lang.Comparable java.io.Serializable} )) ; Arrays: [alength] aget aset [make-array to-array into-array to-array-2d aclone] ; [float-array, int-array, etc] ; amap, areduce (defmacro deftest-type-array [type-array type] `(deftest ~(symbol (str "test-" type-array)) ; correct type (is (= (class (first (~type-array [1 2]))) (class (~type 1)))) ; given size (and empty) (are [x] (and (= (alength (~type-array x)) x) (= (vec (~type-array x)) (repeat x 0))) 0 1 5 ) ; copy of a sequence (are [x] (and (= (alength (~type-array x)) (count x)) (= (vec (~type-array x)) x)) [] [1] [1 -2 3 0 5] ) ; given size and init-value (are [x] (and (= (alength (~type-array x 42)) x) (= (vec (~type-array x 42)) (repeat x 42))) 0 1 5 ) ; given size and init-seq (are [x y z] (and (= (alength (~type-array x y)) x) (= (vec (~type-array x y)) z)) 0 [] [] 0 [1] [] 0 [1 2 3] [] 1 [] [0] 1 [1] [1] 1 [1 2 3] [1] 5 [] [0 0 0 0 0] 5 [1] [1 0 0 0 0] 5 [1 2 3] [1 2 3 0 0] 5 [1 2 3 4 5] [1 2 3 4 5] 5 [1 2 3 4 5 6 7] [1 2 3 4 5] ))) (deftest-type-array int-array int) (deftest-type-array long-array long) (deftest-type-array float-array float) (deftest-type-array double-array double) ; separate test for exceptions (doesn't work with above macro...) (deftest test-type-array-exceptions (are [x] (thrown? NegativeArraySizeException x) (int-array -1) (long-array -1) (float-array -1) (double-array -1) )) (deftest test-make-array ; negative size (is (thrown? NegativeArraySizeException (make-array Integer -1))) ; one-dimensional (are [x] (= (alength (make-array Integer x)) x) 0 1 5 ) (let [a (make-array Integer 5)] (aset a 3 42) (are [x y] (= x y) (aget a 3) 42 (class (aget a 3)) Integer )) ; multi-dimensional (let [a (make-array Integer 3 2 4)] (aset a 0 1 2 987) (are [x y] (= x y) (alength a) 3 (alength (first a)) 2 (alength (first (first a))) 4 (aget a 0 1 2) 987 (class (aget a 0 1 2)) Integer ))) (deftest test-to-array (let [v [1 "abc" :kw \c []] a (to-array v)] (are [x y] (= x y) ; length (alength a) (count v) ; content (vec a) v (class (aget a 0)) (class (nth v 0)) (class (aget a 1)) (class (nth v 1)) (class (aget a 2)) (class (nth v 2)) (class (aget a 3)) (class (nth v 3)) (class (aget a 4)) (class (nth v 4)) )) ; different kinds of collections (are [x] (and (= (alength (to-array x)) (count x)) (= (vec (to-array x)) (vec x))) () '(1 2) [] [1 2] (sorted-set) (sorted-set 1 2) (int-array 0) (int-array [1 2 3]) (to-array []) (to-array [1 2 3]) )) (deftest test-into-array ; compatible types only (is (thrown? IllegalArgumentException (into-array [1 "abc" :kw]))) (is (thrown? IllegalArgumentException (into-array [1.2 4]))) (is (thrown? IllegalArgumentException (into-array [(byte 2) (short 3)]))) ; simple case (let [v [1 2 3 4 5] a (into-array v)] (are [x y] (= x y) (alength a) (count v) (vec a) v (class (first a)) (class (first v)) )) ; given type (let [a (into-array Integer/TYPE [(byte 2) (short 3) (int 4)])] (are [x] (= x Integer) (class (aget a 0)) (class (aget a 1)) (class (aget a 2)) )) ; different kinds of collections (are [x] (and (= (alength (into-array x)) (count x)) (= (vec (into-array x)) (vec x)) (= (alength (into-array Integer/TYPE x)) (count x)) (= (vec (into-array Integer/TYPE x)) (vec x))) () '(1 2) [] [1 2] (sorted-set) (sorted-set 1 2) (int-array 0) (int-array [1 2 3]) (to-array []) (to-array [1 2 3]) )) (deftest test-to-array-2d ; needs to be a collection of collection(s) (is (thrown? Exception (to-array-2d [1 2 3]))) ; ragged array (let [v [[1] [2 3] [4 5 6]] a (to-array-2d v)] (are [x y] (= x y) (alength a) (count v) (alength (aget a 0)) (count (nth v 0)) (alength (aget a 1)) (count (nth v 1)) (alength (aget a 2)) (count (nth v 2)) (vec (aget a 0)) (nth v 0) (vec (aget a 1)) (nth v 1) (vec (aget a 2)) (nth v 2) )) ; empty array (let [a (to-array-2d [])] (are [x y] (= x y) (alength a) 0 (vec a) [] ))) (deftest test-alength (are [x] (= (alength x) 0) (int-array 0) (long-array 0) (float-array 0) (double-array 0) (boolean-array 0) (byte-array 0) (char-array 0) (short-array 0) (make-array Integer/TYPE 0) (to-array []) (into-array []) (to-array-2d []) ) (are [x] (= (alength x) 1) (int-array 1) (long-array 1) (float-array 1) (double-array 1) (boolean-array 1) (byte-array 1) (char-array 1) (short-array 1) (make-array Integer/TYPE 1) (to-array [1]) (into-array [1]) (to-array-2d [[1]]) ) (are [x] (= (alength x) 3) (int-array 3) (long-array 3) (float-array 3) (double-array 3) (boolean-array 3) (byte-array 3) (char-array 3) (short-array 3) (make-array Integer/TYPE 3) (to-array [1 "a" :k]) (into-array [1 2 3]) (to-array-2d [[1] [2 3] [4 5 6]]) )) (deftest test-aclone ; clone all arrays except 2D (are [x] (and (= (alength (aclone x)) (alength x)) (= (vec (aclone x)) (vec x))) (int-array 0) (long-array 0) (float-array 0) (double-array 0) (boolean-array 0) (byte-array 0) (char-array 0) (short-array 0) (make-array Integer/TYPE 0) (to-array []) (into-array []) (int-array [1 2 3]) (long-array [1 2 3]) (float-array [1 2 3]) (double-array [1 2 3]) (boolean-array [true false]) (byte-array [(byte 1) (byte 2)]) (char-array [\a \b \c]) (short-array [(short 1) (short 2)]) (make-array Integer/TYPE 3) (to-array [1 "a" :k]) (into-array [1 2 3]) ) ; clone 2D (are [x] (and (= (alength (aclone x)) (alength x)) (= (map alength (aclone x)) (map alength x)) (= (map vec (aclone x)) (map vec x))) (to-array-2d []) (to-array-2d [[1] [2 3] [4 5 6]]) )) ; Type Hints, *warn-on-reflection* ; #^ints, #^floats, #^longs, #^doubles ; Coercions: [int, long, float, double, char, boolean, short, byte] ; num ; ints/longs/floats/doubles (deftest test-boolean (are [x y] (and (instance? java.lang.Boolean (boolean x)) (= (boolean x) y)) nil false false false true true 0 true 1 true () true [1] true "" true \space true :kw true )) (deftest test-char ; int -> char (is (instance? java.lang.Character (char 65))) ; char -> char (is (instance? java.lang.Character (char \a))) (is (= (char \a) \a))) ;; Note: More coercions in numbers.clj clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load.clj000066400000000000000000000017621157562347600241220ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.test-clojure.load (:use clojure.test)) (deftest test-load (testing "Should ignore self-loads without comment" (is (nil? (require 'clojure.test-clojure.load.cyclic0)))) (testing "Should reject cyclic dependencies" (testing "a->b->a" (is (thrown-with-msg? Exception #".*Cyclic load dependency.*" (require 'clojure.test-clojure.load.cyclic1)))) (testing "a->b->c->d->b" (is (thrown-with-msg? Exception #".*Cyclic load dependency.*" (require 'clojure.test-clojure.load.cyclic3)))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/000077500000000000000000000000001157562347600234225ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic0.clj000066400000000000000000000011051157562347600254370ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic0 (:require clojure.test-clojure.load.cyclic0)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic1.clj000066400000000000000000000011051157562347600254400ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic1 (:require clojure.test-clojure.load.cyclic2)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic2.clj000066400000000000000000000011051157562347600254410ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic2 (:require clojure.test-clojure.load.cyclic1)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic3.clj000066400000000000000000000011051157562347600254420ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic3 (:require clojure.test-clojure.load.cyclic4)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic4.clj000066400000000000000000000011051157562347600254430ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic4 (:require clojure.test-clojure.load.cyclic5)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic5.clj000066400000000000000000000011051157562347600254440ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic5 (:require clojure.test-clojure.load.cyclic6)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/load/cyclic6.clj000066400000000000000000000011051157562347600254450ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ; Author: Stephen C. Gilardi (ns clojure.test-clojure.load.cyclic6 (:require clojure.test-clojure.load.cyclic4)) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/logic.clj000066400000000000000000000070501157562347600242740ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka ;; ;; Created 1/29/2009 (ns clojure.test-clojure.logic (:use clojure.test [clojure.test-clojure.helpers :only (exception)])) ;; *** Tests *** (deftest test-if ; true/false/nil (are [x y] (= x y) (if true :t) :t (if true :t :f) :t (if true :t (exception)) :t (if false :t) nil (if false :t :f) :f (if false (exception) :f) :f (if nil :t) nil (if nil :t :f) :f (if nil (exception) :f) :f ) ; zero/empty is true (are [x] (= (if x :t :f) :t) (byte 0) (short 0) (int 0) (long 0) (bigint 0) (float 0) (double 0) (bigdec 0) 0/2 "" #"" (symbol "") () [] {} #{} (into-array []) ) ; anything except nil/false is true (are [x] (= (if x :t :f) :t) (byte 2) (short 2) (int 2) (long 2) (bigint 2) (float 2) (double 2) (bigdec 2) 2/3 \a "abc" #"a*b" 'abc :kw '(1 2) [1 2] {:a 1 :b 2} #{1 2} (into-array [1 2]) (new java.util.Date) )) (deftest test-nil-punning (are [x y] (= (if x :no :yes) y) (first []) :yes (next [1]) :yes (rest [1]) :no (butlast [1]) :yes (seq nil) :yes (seq []) :yes (sequence nil) :no (sequence []) :no (lazy-seq nil) :no (lazy-seq []) :no (filter #(> % 10) [1 2 3]) :no (map identity []) :no (apply concat []) :no (concat) :no (concat []) :no (reverse nil) :no (reverse []) :no (sort nil) :no (sort []) :no )) (deftest test-and (are [x y] (= x y) (and) true (and true) true (and nil) nil (and false) false (and true nil) nil (and true false) false (and 1 true :kw 'abc "abc") "abc" (and 1 true :kw nil 'abc "abc") nil (and 1 true :kw nil (exception) 'abc "abc") nil (and 1 true :kw 'abc "abc" false) false (and 1 true :kw 'abc "abc" false (exception)) false )) (deftest test-or (are [x y] (= x y) (or) nil (or true) true (or nil) nil (or false) false (or nil false true) true (or nil false 1 2) 1 (or nil false "abc" :kw) "abc" (or false nil) nil (or nil false) false (or nil nil nil false) false (or nil true false) true (or nil true (exception) false) true (or nil false "abc" (exception)) "abc" )) (deftest test-not (is (thrown? IllegalArgumentException (not))) (are [x] (= (not x) true) nil false ) (are [x] (= (not x) false) true ; numbers 0 0.0 42 1.2 0/2 2/3 ; characters \space \tab \a ; strings "" "abc" ; regexes #"" #"a*b" ; symbols (symbol "") 'abc ; keywords :kw ; collections/arrays () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} (into-array []) (into-array [1 2]) ; Java objects (new java.util.Date) )) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/macros.clj000066400000000000000000000011671157562347600244660ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.macros (:use clojure.test)) ; http://clojure.org/macros ; -> ; defmacro definline macroexpand-1 macroexpand clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/main.clj000066400000000000000000000033131157562347600241210ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stuart Halloway (ns clojure.test-clojure.main (:use clojure.test) (:require [clojure.main :as main])) (deftest eval-opt (testing "evals and prints forms" (is (= "2\n4\n" (with-out-str (#'clojure.main/eval-opt "(+ 1 1) (+ 2 2)"))))) (testing "skips printing nils" (is (= ":a\n:c\n" (with-out-str (#'clojure.main/eval-opt ":a nil :c"))))) (testing "does not block access to *in* (#299)" (with-in-str "(+ 1 1)" (is (= "(+ 1 1)\n" (with-out-str (#'clojure.main/eval-opt "(read)"))))))) (defmacro with-err-str "Evaluates exprs in a context in which *err* is bound to a fresh StringWriter. Returns the string created by any nested printing calls." [& body] `(let [s# (new java.io.StringWriter) p# (new java.io.PrintWriter s#)] (binding [*err* p#] ~@body (str s#)))) (defn run-repl-and-return-err "Run repl, swallowing stdout and returing stderr." [in-str] (with-err-str (with-out-str (with-in-str in-str (main/repl))))) (deftest repl-exception-safety (testing "catches and prints exception on bad equals" (is (re-matches #"java\.lang\.NullPointerException\r?\n" (run-repl-and-return-err "(proxy [Object] [] (equals [o] (.toString nil)))"))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/metadata.clj000066400000000000000000000044701157562347600247620ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Authors: Stuart Halloway, Frantisek Sodomka (ns clojure.test-clojure.metadata (:use clojure.test [clojure.test-clojure.helpers :only (eval-in-temp-ns)])) (def public-namespaces '[clojure.core clojure.pprint clojure.inspector clojure.set clojure.stacktrace clojure.test clojure.walk clojure.xml clojure.zip clojure.java.io clojure.java.browse clojure.java.javadoc clojure.java.shell clojure.string]) (doseq [ns public-namespaces] (require ns)) (def public-vars (mapcat #(vals (ns-publics %)) public-namespaces)) (def public-vars-with-docstrings (filter (comp :doc meta) public-vars)) (deftest public-vars-with-docstrings-have-added (is (= [] (remove (comp :added meta) public-vars-with-docstrings)))) (deftest interaction-of-def-with-metadata (testing "initial def sets metadata" (let [v (eval-in-temp-ns (def ^{:a 1} foo 0) #'foo)] (is (= 1 (-> v meta :a))))) (testing "subsequent declare doesn't overwrite metadata" (let [v (eval-in-temp-ns (def ^{:b 2} bar 0) (declare bar) #'bar)] (is (= 2 (-> v meta :b)))) (testing "when compiled" (let [v (eval-in-temp-ns (def ^{:c 3} bar 0) (defn declare-bar [] (declare bar)) (declare-bar) #'bar)] (is (= 3 (-> v meta :c)))))) (testing "subsequent def with init-expr *does* overwrite metadata" (let [v (eval-in-temp-ns (def ^{:d 4} quux 0) (def quux 1) #'quux)] (is (nil? (-> v meta :d)))) (testing "when compiled" (let [v (eval-in-temp-ns (def ^{:e 5} quux 0) (defn def-quux [] (def quux 1)) (def-quux) #'quux)] (is (nil? (-> v meta :e))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/multimethods.clj000066400000000000000000000135641157562347600257240ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka, Robert Lachlan (ns clojure.test-clojure.multimethods (:use clojure.test [clojure.test-clojure.helpers :only (with-var-roots)]) (:require [clojure.set :as set])) ; http://clojure.org/multimethods ; defmulti ; defmethod ; remove-method ; prefer-method ; methods ; prefers (defmacro for-all [& args] `(dorun (for ~@args))) (defn hierarchy-tags "Return all tags in a derivation hierarchy" [h] (set/select #(instance? clojure.lang.Named %) (reduce into #{} (map keys (vals h))))) (defn transitive-closure "Return all objects reachable by calling f starting with o, not including o itself. f should return a collection." [o f] (loop [results #{} more #{o}] (let [new-objects (set/difference more results)] (if (seq new-objects) (recur (set/union results more) (reduce into #{} (map f new-objects))) (disj results o))))) (defn tag-descendants "Set of descedants which are tags (i.e. Named)." [& args] (set/select #(instance? clojure.lang.Named %) (or (apply descendants args) #{}))) (defn assert-valid-hierarchy [h] (let [tags (hierarchy-tags h)] (testing "ancestors are the transitive closure of parents" (for-all [tag tags] (is (= (transitive-closure tag #(parents h %)) (or (ancestors h tag) #{}))))) (testing "ancestors are transitive" (for-all [tag tags] (is (= (transitive-closure tag #(ancestors h %)) (or (ancestors h tag) #{}))))) (testing "tag descendants are transitive" (for-all [tag tags] (is (= (transitive-closure tag #(tag-descendants h %)) (or (tag-descendants h tag) #{}))))) (testing "a tag isa? all of its parents" (for-all [tag tags :let [parents (parents h tag)] parent parents] (is (isa? h tag parent)))) (testing "a tag isa? all of its ancestors" (for-all [tag tags :let [ancestors (ancestors h tag)] ancestor ancestors] (is (isa? h tag ancestor)))) (testing "all my descendants have me as an ancestor" (for-all [tag tags :let [descendants (descendants h tag)] descendant descendants] (is (isa? h descendant tag)))) (testing "there are no cycles in parents" (for-all [tag tags] (is (not (contains? (transitive-closure tag #(parents h %)) tag))))) (testing "there are no cycles in descendants" (for-all [tag tags] (is (not (contains? (descendants h tag) tag))))))) (def family (reduce #(apply derive (cons %1 %2)) (make-hierarchy) [[::parent-1 ::ancestor-1] [::parent-1 ::ancestor-2] [::parent-2 ::ancestor-2] [::child ::parent-2] [::child ::parent-1]])) (deftest cycles-are-forbidden (testing "a tag cannot be its own parent" (is (thrown-with-msg? Throwable #"\(not= tag parent\)" (derive family ::child ::child)))) (testing "a tag cannot be its own ancestor" (is (thrown-with-msg? Throwable #"Cyclic derivation: :clojure.test-clojure.multimethods/child has :clojure.test-clojure.multimethods/ancestor-1 as ancestor" (derive family ::ancestor-1 ::child))))) (deftest using-diamond-inheritance (let [diamond (reduce #(apply derive (cons %1 %2)) (make-hierarchy) [[::mammal ::animal] [::bird ::animal] [::griffin ::mammal] [::griffin ::bird]]) bird-no-more (underive diamond ::griffin ::bird)] (assert-valid-hierarchy diamond) (assert-valid-hierarchy bird-no-more) (testing "a griffin is a mammal, indirectly through mammal and bird" (is (isa? diamond ::griffin ::animal))) (testing "a griffin is a bird" (is (isa? diamond ::griffin ::bird))) (testing "after underive, griffin is no longer a bird" (is (not (isa? bird-no-more ::griffin ::bird)))) (testing "but it is still an animal, via mammal" (is (isa? bird-no-more ::griffin ::animal))))) (deftest derivation-world-bridges-to-java-inheritance (let [h (derive (make-hierarchy) java.util.Map ::map)] (testing "a Java class can be isa? a tag" (is (isa? h java.util.Map ::map))) (testing "if a Java class isa? a tag, so are its subclasses..." (is (isa? h java.util.HashMap ::map))) (testing "...but not its superclasses!" (is (not (isa? h java.util.Collection ::map)))))) (deftest global-hierarchy-test (with-var-roots {#'clojure.core/global-hierarchy (make-hierarchy)} (assert-valid-hierarchy @#'clojure.core/global-hierarchy) (testing "when you add some derivations..." (derive ::lion ::cat) (derive ::manx ::cat) (assert-valid-hierarchy @#'clojure.core/global-hierarchy)) (testing "...isa? sees the derivations" (is (isa? ::lion ::cat)) (is (not (isa? ::cat ::lion)))) (testing "... you can traverse the derivations" (is (= #{::manx ::lion} (descendants ::cat))) (is (= #{::cat} (parents ::manx))) (is (= #{::cat} (ancestors ::manx)))) (testing "then, remove a derivation..." (underive ::manx ::cat)) (testing "... traversals update accordingly" (is (= #{::lion} (descendants ::cat))) (is (nil? (parents ::manx))) (is (nil? (ancestors ::manx)))))) #_(defmacro for-all "Better than the actual for-all, if only it worked." [& args] `(reduce #(and %1 %2) (map true? (for ~@args)))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/ns_libs.clj000066400000000000000000000065541157562347600246400ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Authors: Frantisek Sodomka, Stuart Halloway (ns clojure.test-clojure.ns-libs (:use clojure.test)) ; http://clojure.org/namespaces ; in-ns ns create-ns ; alias import intern refer ; all-ns find-ns ; ns-name ns-aliases ns-imports ns-interns ns-map ns-publics ns-refers ; resolve ns-resolve namespace ; ns-unalias ns-unmap remove-ns ; http://clojure.org/libs ; require use ; loaded-libs (deftest test-require (is (thrown? Exception (require :foo))) (is (thrown? Exception (require)))) (deftest test-use (is (thrown? Exception (use :foo))) (is (thrown? Exception (use)))) (deftest reimporting-deftypes (let [inst1 (binding [*ns* *ns*] (eval '(do (ns exporter) (defrecord ReimportMe [a]) (ns importer) (import exporter.ReimportMe) (ReimportMe. 1)))) inst2 (binding [*ns* *ns*] (eval '(do (ns exporter) (defrecord ReimportMe [a b]) (ns importer) (import exporter.ReimportMe) (ReimportMe. 1 2))))] (testing "you can reimport a changed class and see the changes" (is (= [:a] (keys inst1))) (is (= [:a :b] (keys inst2)))) (testing "you cannot import same local name from a different namespace" (is (thrown? clojure.lang.Compiler$CompilerException #"ReimportMe already refers to: class exporter.ReimportMe in namespace: importer" (binding [*ns* *ns*] (eval '(do (ns exporter-2) (defrecord ReimportMe [a b]) (ns importer) (import exporter-2.ReimportMe) (ReimportMe. 1 2))))))))) (deftest naming-types (testing "you cannot use a name already referred from another namespace" (is (thrown? IllegalStateException #"String already refers to: class java.lang.String" (definterface String))) (is (thrown? IllegalStateException #"StringBuffer already refers to: class java.lang.StringBuffer" (deftype StringBuffer []))) (is (thrown? IllegalStateException #"Integer already refers to: class java.lang.Integer" (defrecord Integer []))))) (deftest refer-error-messages (let [temp-ns (gensym)] (binding [*ns* *ns*] (in-ns temp-ns) (eval '(def ^{:private true} hidden-var))) (testing "referring to something that does not exist" (is (thrown-with-msg? IllegalAccessError #"nonexistent-var does not exist" (refer temp-ns :only '(nonexistent-var))))) (testing "referring to something non-public" (is (thrown-with-msg? IllegalAccessError #"hidden-var is not public" (refer temp-ns :only '(hidden-var))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/numbers.clj000066400000000000000000000247441157562347600246630ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stephen C. Gilardi ;; scgilardi (gmail) ;; Created 30 October 2008 ;; (ns clojure.test-clojure.numbers (:use clojure.test)) ; TODO: ; == ; and more... ;; *** Types *** (deftest Coerced-Byte (let [v (byte 3)] (are [x] (true? x) (instance? Byte v) (number? v) (integer? v) (rational? v)))) (deftest Coerced-Short (let [v (short 3)] (are [x] (true? x) (instance? Short v) (number? v) (integer? v) (rational? v)))) (deftest Coerced-Integer (let [v (int 3)] (are [x] (true? x) (instance? Integer v) (number? v) (integer? v) (rational? v)))) (deftest Coerced-Long (let [v (long 3)] (are [x] (true? x) (instance? Long v) (number? v) (integer? v) (rational? v)))) (deftest Coerced-BigInteger (let [v (bigint 3)] (are [x] (true? x) (instance? BigInteger v) (number? v) (integer? v) (rational? v)))) (deftest Coerced-Float (let [v (float 3)] (are [x] (true? x) (instance? Float v) (number? v) (float? v)))) (deftest Coerced-Double (let [v (double 3)] (are [x] (true? x) (instance? Double v) (number? v) (float? v)))) (deftest Coerced-BigDecimal (let [v (bigdec 3)] (are [x] (true? x) (instance? BigDecimal v) (number? v) (decimal? v) (not (float? v))))) ;; *** Functions *** (defonce DELTA 1e-12) (deftest test-add (are [x y] (= x y) (+) 0 (+ 1) 1 (+ 1 2) 3 (+ 1 2 3) 6 (+ -1) -1 (+ -1 -2) -3 (+ -1 +2 -3) -2 (+ 1 -1) 0 (+ -1 1) 0 (+ 2/3) 2/3 (+ 2/3 1) 5/3 (+ 2/3 1/3) 1 ) (are [x y] (< (- x y) DELTA) (+ 1.2) 1.2 (+ 1.1 2.4) 3.5 (+ 1.1 2.2 3.3) 6.6 ) (is (> (+ Integer/MAX_VALUE 10) Integer/MAX_VALUE)) ; no overflow (is (thrown? ClassCastException (+ "ab" "cd"))) ) ; no string concatenation (deftest test-subtract (is (thrown? IllegalArgumentException (-))) (are [x y] (= x y) (- 1) -1 (- 1 2) -1 (- 1 2 3) -4 (- -2) 2 (- 1 -2) 3 (- 1 -2 -3) 6 (- 1 1) 0 (- -1 -1) 0 (- 2/3) -2/3 (- 2/3 1) -1/3 (- 2/3 1/3) 1/3 ) (are [x y] (< (- x y) DELTA) (- 1.2) -1.2 (- 2.2 1.1) 1.1 (- 6.6 2.2 1.1) 3.3 ) (is (< (- Integer/MIN_VALUE 10) Integer/MIN_VALUE)) ) ; no underflow (deftest test-multiply (are [x y] (= x y) (*) 1 (* 2) 2 (* 2 3) 6 (* 2 3 4) 24 (* -2) -2 (* 2 -3) -6 (* 2 -3 -1) 6 (* 1/2) 1/2 (* 1/2 1/3) 1/6 (* 1/2 1/3 -1/4) -1/24 ) (are [x y] (< (- x y) DELTA) (* 1.2) 1.2 (* 2.0 1.2) 2.4 (* 3.5 2.0 1.2) 8.4 ) (is (> (* 3 (int (/ Integer/MAX_VALUE 2.0))) Integer/MAX_VALUE)) ) ; no overflow (deftest test-ratios-simplify-to-ints-where-appropriate (testing "negative denominator (assembla #275)" (is (integer? (/ 1 -1/2))) (is (integer? (/ 0 -1/2))))) (deftest test-divide (are [x y] (= x y) (/ 1) 1 (/ 2) 1/2 (/ 3 2) 3/2 (/ 4 2) 2 (/ 24 3 2) 4 (/ 24 3 2 -1) -4 (/ -1) -1 (/ -2) -1/2 (/ -3 -2) 3/2 (/ -4 -2) 2 (/ -4 2) -2 ) (are [x y] (< (- x y) DELTA) (/ 4.5 3) 1.5 (/ 4.5 3.0 3.0) 0.5 ) (is (thrown? ArithmeticException (/ 0))) (is (thrown? ArithmeticException (/ 2 0))) (is (thrown? IllegalArgumentException (/))) ) ;; mod ;; http://en.wikipedia.org/wiki/Modulo_operation ;; http://mathforum.org/library/drmath/view/52343.html ;; ;; is mod correct? ;; http://groups.google.com/group/clojure/browse_frm/thread/2a0ee4d248f3d131# ;; ;; Issue 23: mod (modulo) operator ;; http://code.google.com/p/clojure/issues/detail?id=23 (deftest test-mod ; wrong number of args (is (thrown? IllegalArgumentException (mod))) (is (thrown? IllegalArgumentException (mod 1))) (is (thrown? IllegalArgumentException (mod 3 2 1))) ; divide by zero (is (thrown? ArithmeticException (mod 9 0))) (is (thrown? ArithmeticException (mod 0 0))) (are [x y] (= x y) (mod 4 2) 0 (mod 3 2) 1 (mod 6 4) 2 (mod 0 5) 0 (mod 2 1/2) 0 (mod 2/3 1/2) 1/6 (mod 1 2/3) 1/3 (mod 4.0 2.0) 0.0 (mod 4.5 2.0) 0.5 ; |num| > |div|, num != k * div (mod 42 5) 2 ; (42 / 5) * 5 + (42 mod 5) = 8 * 5 + 2 = 42 (mod 42 -5) -3 ; (42 / -5) * (-5) + (42 mod -5) = -9 * (-5) + (-3) = 42 (mod -42 5) 3 ; (-42 / 5) * 5 + (-42 mod 5) = -9 * 5 + 3 = -42 (mod -42 -5) -2 ; (-42 / -5) * (-5) + (-42 mod -5) = 8 * (-5) + (-2) = -42 ; |num| > |div|, num = k * div (mod 9 3) 0 ; (9 / 3) * 3 + (9 mod 3) = 3 * 3 + 0 = 9 (mod 9 -3) 0 (mod -9 3) 0 (mod -9 -3) 0 ; |num| < |div| (mod 2 5) 2 ; (2 / 5) * 5 + (2 mod 5) = 0 * 5 + 2 = 2 (mod 2 -5) -3 ; (2 / -5) * (-5) + (2 mod -5) = (-1) * (-5) + (-3) = 2 (mod -2 5) 3 ; (-2 / 5) * 5 + (-2 mod 5) = (-1) * 5 + 3 = -2 (mod -2 -5) -2 ; (-2 / -5) * (-5) + (-2 mod -5) = 0 * (-5) + (-2) = -2 ; num = 0, div != 0 (mod 0 3) 0 ; (0 / 3) * 3 + (0 mod 3) = 0 * 3 + 0 = 0 (mod 0 -3) 0 ) ) ;; rem & quot ;; http://en.wikipedia.org/wiki/Remainder (deftest test-rem ; wrong number of args (is (thrown? IllegalArgumentException (rem))) (is (thrown? IllegalArgumentException (rem 1))) (is (thrown? IllegalArgumentException (rem 3 2 1))) ; divide by zero (is (thrown? ArithmeticException (rem 9 0))) (is (thrown? ArithmeticException (rem 0 0))) (are [x y] (= x y) (rem 4 2) 0 (rem 3 2) 1 (rem 6 4) 2 (rem 0 5) 0 (rem 2 1/2) 0 (rem 2/3 1/2) 1/6 (rem 1 2/3) 1/3 (rem 4.0 2.0) 0.0 (rem 4.5 2.0) 0.5 ; |num| > |div|, num != k * div (rem 42 5) 2 ; (8 * 5) + 2 == 42 (rem 42 -5) 2 ; (-8 * -5) + 2 == 42 (rem -42 5) -2 ; (-8 * 5) + -2 == -42 (rem -42 -5) -2 ; (8 * -5) + -2 == -42 ; |num| > |div|, num = k * div (rem 9 3) 0 (rem 9 -3) 0 (rem -9 3) 0 (rem -9 -3) 0 ; |num| < |div| (rem 2 5) 2 (rem 2 -5) 2 (rem -2 5) -2 (rem -2 -5) -2 ; num = 0, div != 0 (rem 0 3) 0 (rem 0 -3) 0 ) ) (deftest test-quot ; wrong number of args (is (thrown? IllegalArgumentException (quot))) (is (thrown? IllegalArgumentException (quot 1))) (is (thrown? IllegalArgumentException (quot 3 2 1))) ; divide by zero (is (thrown? ArithmeticException (quot 9 0))) (is (thrown? ArithmeticException (quot 0 0))) (are [x y] (= x y) (quot 4 2) 2 (quot 3 2) 1 (quot 6 4) 1 (quot 0 5) 0 (quot 2 1/2) 4 (quot 2/3 1/2) 1 (quot 1 2/3) 1 (quot 4.0 2.0) 2.0 (quot 4.5 2.0) 2.0 ; |num| > |div|, num != k * div (quot 42 5) 8 ; (8 * 5) + 2 == 42 (quot 42 -5) -8 ; (-8 * -5) + 2 == 42 (quot -42 5) -8 ; (-8 * 5) + -2 == -42 (quot -42 -5) 8 ; (8 * -5) + -2 == -42 ; |num| > |div|, num = k * div (quot 9 3) 3 (quot 9 -3) -3 (quot -9 3) -3 (quot -9 -3) 3 ; |num| < |div| (quot 2 5) 0 (quot 2 -5) 0 (quot -2 5) 0 (quot -2 -5) 0 ; num = 0, div != 0 (quot 0 3) 0 (quot 0 -3) 0 ) ) ;; *** Predicates *** ;; pos? zero? neg? (deftest test-pos?-zero?-neg? (let [nums [[(byte 2) (byte 0) (byte -2)] [(short 3) (short 0) (short -3)] [(int 4) (int 0) (int -4)] [(long 5) (long 0) (long -5)] [(bigint 6) (bigint 0) (bigint -6)] [(float 7) (float 0) (float -7)] [(double 8) (double 0) (double -8)] [(bigdec 9) (bigdec 0) (bigdec -9)] [2/3 0 -2/3]] pred-result [[pos? [true false false]] [zero? [false true false]] [neg? [false false true]]] ] (doseq [pr pred-result] (doseq [n nums] (is (= (map (first pr) n) (second pr)) (pr-str (first pr) n)))))) ;; even? odd? (deftest test-even? (are [x] (true? x) (even? -4) (not (even? -3)) (even? 0) (not (even? 5)) (even? 8)) (is (thrown? ArithmeticException (even? 1/2))) (is (thrown? ArithmeticException (even? (double 10))))) (deftest test-odd? (are [x] (true? x) (not (odd? -4)) (odd? -3) (not (odd? 0)) (odd? 5) (not (odd? 8))) (is (thrown? ArithmeticException (odd? 1/2))) (is (thrown? ArithmeticException (odd? (double 10))))) (defn- expt "clojure.contrib.math/expt is a better and much faster impl, but this works. Math/pow overflows to Infinity." [x n] (apply * (replicate n x))) (deftest test-bit-shift-left (are [x y] (= x y) 2r10 (bit-shift-left 2r1 1) 2r100 (bit-shift-left 2r1 2) 2r1000 (bit-shift-left 2r1 3) 2r00101110 (bit-shift-left 2r00010111 1) 2r00101110 (apply bit-shift-left [2r00010111 1]) 2r01 (bit-shift-left 2r10 -1) (expt 2 32) (bit-shift-left 1 32) (expt 2 10000) (bit-shift-left 1 10000) )) (deftest test-bit-shift-right (are [x y] (= x y) 2r0 (bit-shift-right 2r1 1) 2r010 (bit-shift-right 2r100 1) 2r001 (bit-shift-right 2r100 2) 2r000 (bit-shift-right 2r100 3) 2r0001011 (bit-shift-right 2r00010111 1) 2r0001011 (apply bit-shift-right [2r00010111 1]) 2r100 (bit-shift-right 2r10 -1) 1 (bit-shift-right (expt 2 32) 32) 1 (bit-shift-right (expt 2 10000) 10000) )) ;; arrays (deftest test-array-types (are [x y z] (= (Class/forName x) (class y) (class z)) "[Z" (boolean-array 1) (booleans (boolean-array 1 true)) "[B" (byte-array 1) (bytes (byte-array 1 (byte 1))) "[C" (char-array 1) (chars (char-array 1 \a)) "[S" (short-array 1) (shorts (short-array 1 (short 1))) "[F" (float-array 1) (floats (float-array 1 1)) "[D" (double-array 1) (doubles (double-array 1 1)) "[I" (int-array 1) (ints (int-array 1 1)) "[J" (long-array 1) (longs (long-array 1 1)))) (deftest test-ratios (is (= (denominator 1/2) 2)) (is (= (numerator 1/2) 1)) (is (= (bigint (/ 100000000000000000000 3)) 33333333333333333333)) (is (= (long 10000000000000000000/3) 3333333333333333333))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/other_functions.clj000066400000000000000000000045051157562347600264120ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.other-functions (:use clojure.test)) ; http://clojure.org/other_functions ; [= not= (tests in data_structures.clj and elsewhere)] (deftest test-identity ; exactly 1 argument needed (is (thrown? IllegalArgumentException (identity))) (is (thrown? IllegalArgumentException (identity 1 2))) (are [x] (= (identity x) x) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} ) ; evaluation (are [x y] (= (identity x) y) (+ 1 2) 3 (> 5 0) true )) (deftest test-name (are [x y] (= x (name y)) "foo" :foo "bar" 'bar "quux" "quux")) (deftest test-fnil (let [f1 (fnil vector :a) f2 (fnil vector :a :b) f3 (fnil vector :a :b :c)] (are [result input] (= result [(apply f1 input) (apply f2 input) (apply f3 input)]) [[1 2 3 4] [1 2 3 4] [1 2 3 4]] [1 2 3 4] [[:a 2 3 4] [:a 2 3 4] [:a 2 3 4]] [nil 2 3 4] [[:a nil 3 4] [:a :b 3 4] [:a :b 3 4]] [nil nil 3 4] [[:a nil nil 4] [:a :b nil 4] [:a :b :c 4]] [nil nil nil 4] [[:a nil nil nil] [:a :b nil nil] [:a :b :c nil]] [nil nil nil nil])) (are [x y] (= x y) ((fnil + 0) nil 42) 42 ((fnil conj []) nil 42) [42] (reduce #(update-in %1 [%2] (fnil inc 0)) {} ["fun" "counting" "words" "fun"]) {"words" 1, "counting" 1, "fun" 2} (reduce #(update-in %1 [(first %2)] (fnil conj []) (second %2)) {} [[:a 1] [:a 2] [:b 3]]) {:b [3], :a [1 2]})) ; time assert comment doc ; partial ; comp ; complement ; constantly ; Printing ; pr prn print println newline ; pr-str prn-str print-str println-str [with-out-str (vars.clj)] ; Regex Support ; re-matcher re-find re-matches re-groups re-seq clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/parallel.clj000066400000000000000000000014621157562347600247740ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.parallel (:use clojure.test)) ;; !! Tests for the parallel library will be in a separate file clojure_parallel.clj !! ; future-call ; future ; pmap ; pcalls ; pvalues ;; pmap ;; (deftest pmap-does-its-thing ;; regression fixed in r1218; was OutOfMemoryError (is (= '(1) (pmap inc [0])))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/pprint.clj000066400000000000000000000013511157562347600245110ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber (ns clojure.test-clojure.pprint (:refer-clojure :exclude [format]) (:use [clojure.test :only (deftest are run-tests)] clojure.test-clojure.pprint.test-helper clojure.pprint)) (load "pprint/test_cl_format") (load "pprint/test_pretty") clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/pprint/000077500000000000000000000000001157562347600240175ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/pprint/test_cl_format.clj000066400000000000000000000753601157562347600275310ustar00rootroot00000000000000;;; test_cl_format.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This test set tests the basic cl-format functionality (in-ns 'clojure.test-clojure.pprint) (def format cl-format) ;; TODO tests for ~A, ~D, etc. ;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding (simple-tests d-tests (cl-format nil "~D" 0) "0" (cl-format nil "~D" 2e6) "2000000" (cl-format nil "~D" 2000000) "2000000" (cl-format nil "~:D" 2000000) "2,000,000" (cl-format nil "~D" 1/2) "1/2" (cl-format nil "~D" 'fred) "fred" ) (simple-tests base-tests (cl-format nil "~{~2r~^ ~}~%" (range 10)) "0 1 10 11 100 101 110 111 1000 1001\n" (with-out-str (dotimes [i 35] (binding [*print-base* (+ i 2)] ;print the decimal number 40 (write 40) ;in each base from 2 to 36 (if (zero? (mod i 10)) (prn) (cl-format true " "))))) "101000 1111 220 130 104 55 50 44 40 37 34 31 2c 2a 28 26 24 22 20 1j 1i 1h 1g 1f 1e 1d 1c 1b 1a 19 18 17 16 15 14 " (with-out-str (doseq [pb [2 3 8 10 16]] (binding [*print-radix* true ;print the integer 10 and *print-base* pb] ;the ratio 1/10 in bases 2, (cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16 "#b1010 #b1/1010 #3r101 #3r1/101 #o12 #o1/12 10. #10r1/10 #xa #x1/a ") (simple-tests cardinal-tests (cl-format nil "~R" 0) "zero" (cl-format nil "~R" 4) "four" (cl-format nil "~R" 15) "fifteen" (cl-format nil "~R" -15) "minus fifteen" (cl-format nil "~R" 25) "twenty-five" (cl-format nil "~R" 20) "twenty" (cl-format nil "~R" 200) "two hundred" (cl-format nil "~R" 203) "two hundred three" (cl-format nil "~R" 44879032) "forty-four million, eight hundred seventy-nine thousand, thirty-two" (cl-format nil "~R" -44879032) "minus forty-four million, eight hundred seventy-nine thousand, thirty-two" (cl-format nil "~R = ~:*~:D" 44000032) "forty-four million, thirty-two = 44,000,032" (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" (cl-format nil "~R = ~:*~:D" 2e6) "two million = 2,000,000" (cl-format nil "~R = ~:*~:D" 200000200000) "two hundred billion, two hundred thousand = 200,000,200,000") (simple-tests ordinal-tests (cl-format nil "~:R" 0) "zeroth" (cl-format nil "~:R" 4) "fourth" (cl-format nil "~:R" 15) "fifteenth" (cl-format nil "~:R" -15) "minus fifteenth" (cl-format nil "~:R" 25) "twenty-fifth" (cl-format nil "~:R" 20) "twentieth" (cl-format nil "~:R" 200) "two hundredth" (cl-format nil "~:R" 203) "two hundred third" (cl-format nil "~:R" 44879032) "forty-four million, eight hundred seventy-nine thousand, thirty-second" (cl-format nil "~:R" -44879032) "minus forty-four million, eight hundred seventy-nine thousand, thirty-second" (cl-format nil "~:R = ~:*~:D" 44000032) "forty-four million, thirty-second = 44,000,032" (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471) "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471" (cl-format nil "~:R = ~:*~:D" 2e6) "two millionth = 2,000,000") (simple-tests ordinal1-tests (cl-format nil "~:R" 1) "first" (cl-format nil "~:R" 11) "eleventh" (cl-format nil "~:R" 21) "twenty-first" (cl-format nil "~:R" 20) "twentieth" (cl-format nil "~:R" 220) "two hundred twentieth" (cl-format nil "~:R" 200) "two hundredth" (cl-format nil "~:R" 999) "nine hundred ninety-ninth" ) (simple-tests roman-tests (cl-format nil "~@R" 3) "III" (cl-format nil "~@R" 4) "IV" (cl-format nil "~@R" 9) "IX" (cl-format nil "~@R" 29) "XXIX" (cl-format nil "~@R" 429) "CDXXIX" (cl-format nil "~@:R" 429) "CCCCXXVIIII" (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII" (cl-format nil "~@R" 3429) "MMMCDXXIX" (cl-format nil "~@R" 3479) "MMMCDLXXIX" (cl-format nil "~@R" 3409) "MMMCDIX" (cl-format nil "~@R" 300) "CCC" (cl-format nil "~@R ~D" 300 20) "CCC 20" (cl-format nil "~@R" 5000) "5,000" (cl-format nil "~@R ~D" 5000 20) "5,000 20" (cl-format nil "~@R" "the quick") "the quick") (simple-tests c-tests (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n" (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n" (cl-format nil "~@C~%" \m) "\\m\n" (cl-format nil "~@C~%" (char 222)) "\\Þ\n" (cl-format nil "~@C~%" (char 8)) "\\backspace\n" (cl-format nil "~@C~%" (char 3)) "\\\n") (simple-tests e-tests (cl-format nil "*~E*" 0.0) "*0.0E+0*" (cl-format nil "*~6E*" 0.0) "*0.0E+0*" (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*" (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*" (cl-format nil "*~5E*" 0.0) "*0.E+0*" (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*" (cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*" (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*" (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*" (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*" ) (simple-tests $-tests (cl-format nil "~$" 22.3) "22.30" (cl-format nil "~$" 22.375) "22.38" (cl-format nil "~3,5$" 22.375) "00022.375" (cl-format nil "~3,5,8$" 22.375) "00022.375" (cl-format nil "~3,5,10$" 22.375) " 00022.375" (cl-format nil "~3,5,14@$" 22.375) " +00022.375" (cl-format nil "~3,5,14@$" 22.375) " +00022.375" (cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375" (cl-format nil "~3,,14@:$" 0.375) "+ 0.375" (cl-format nil "~1,1$" -12.0) "-12.0" (cl-format nil "~1,1$" 12.0) "12.0" (cl-format nil "~1,1$" 12.0) "12.0" (cl-format nil "~1,1@$" 12.0) "+12.0" (cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0" (cl-format nil "~1,1,8,' @$" 12.0) " +12.0" (cl-format nil "~1,1,8,' :$" 12.0) " 12.0" (cl-format nil "~1,1,8,' $" 12.0) " 12.0" (cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0" (cl-format nil "~1,1,8,' @$" -12.0) " -12.0" (cl-format nil "~1,1,8,' :$" -12.0) "- 12.0" (cl-format nil "~1,1,8,' $" -12.0) " -12.0" (cl-format nil "~1,1$" 0.001) "0.0" (cl-format nil "~2,1$" 0.001) "0.00" (cl-format nil "~1,1,6$" 0.001) " 0.0" (cl-format nil "~1,1,6$" 0.0015) " 0.0" (cl-format nil "~2,1,6$" 0.005) " 0.01" (cl-format nil "~2,1,6$" 0.01) " 0.01" (cl-format nil "~$" 0.099) "0.10" (cl-format nil "~1$" 0.099) "0.1" (cl-format nil "~1$" 0.1) "0.1" (cl-format nil "~1$" 0.99) "1.0" (cl-format nil "~1$" -0.99) "-1.0") (simple-tests f-tests (cl-format nil "~,1f" -12.0) "-12.0" (cl-format nil "~,0f" 9.4) "9." (cl-format nil "~,0f" 9.5) "10." (cl-format nil "~,0f" -0.99) "-1." (cl-format nil "~,1f" -0.99) "-1.0" (cl-format nil "~,2f" -0.99) "-0.99" (cl-format nil "~,3f" -0.99) "-0.990" (cl-format nil "~,0f" 0.99) "1." (cl-format nil "~,1f" 0.99) "1.0" (cl-format nil "~,2f" 0.99) "0.99" (cl-format nil "~,3f" 0.99) "0.990" (cl-format nil "~f" -1) "-1.0" (cl-format nil "~2f" -1) "-1." (cl-format nil "~3f" -1) "-1." (cl-format nil "~4f" -1) "-1.0" (cl-format nil "~8f" -1) " -1.0" (cl-format nil "~1,1f" 0.1) ".1") (simple-tests ampersand-tests (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5) "The quick brown elephant jumped over 5 lazy dogs" (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5) "The quick brown \nelephant jumped over 5 lazy dogs" (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) "The quick brown \nelephant jumped\n over 5 lazy dogs" (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) "The quick brown \nelephant jumped\n over 5 lazy dogs" (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs" (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10) "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs" (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n" (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n") (simple-tests t-tests (cl-format nil "~@{~&~A~8,4T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" (cl-format nil "~@{~&~A~,4T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" ) (simple-tests paren-tests (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here" (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here" (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT" (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!" ;; Test cases from CLtL 18.3 - string-upcase, et al. (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" (cl-format nil "~:(~A~)" " hello ") " Hello " (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") "Occluded Casements Forestall Inadvertent Defenestration" (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" (cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!" (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c" ) (simple-tests square-bracket-tests ;; Tests for format without modifiers (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n" (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n" (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n" (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n" (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n" (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n" (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n" (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n" (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n" ;; Tests for format with a colon (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n" (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n" (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n" (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n" (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n" ;; Tests for format with an at sign (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n" (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17) "We had 15 wins (out of 17 tries).\n" ;; Format tests with directives (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7) "Max 15: Blue team 7.\n" (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12) "Max 15: Red team 12.\n" (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, -1, "(system failure)") "Max 15: No team (system failure).\n" ;; Nested format tests (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" 15, 0, 7, true) "Max 15: Blue team 7 (complete success).\n" (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" 15, 0, 7, false) "Max 15: Blue team 7.\n" ;; Test the selector as part of the argument (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].") "The answer is nothing." (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4) "The answer is 4." (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22) "The answer is 7 out of 22." (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4) "The answer is something crazy." ) (simple-tests curly-brace-plain-tests ;; Iteration from sublist (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) "Coordinates are [0,1] [1,0]\n" (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) "Coordinates are\n" (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) "Coordinates are none\n" (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1]) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~{~:}~%" "" []) "Coordinates are\n" (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1]) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) "Coordinates are none\n" ) (simple-tests curly-brace-colon-tests ;; Iteration from list of sublists (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ]) "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) "Coordinates are [0,1] [1,0]\n" (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) "Coordinates are\n" (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) "Coordinates are none\n" (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]]) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~:{~:}~%" "" []) "Coordinates are\n" (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]]) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) "Coordinates are none\n" ) (simple-tests curly-brace-at-tests ;; Iteration from main list (cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) "Coordinates are [0,1] [1,0]\n" (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") "Coordinates are\n" (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") "Coordinates are none\n" (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~@{~:}~%" "") "Coordinates are\n" (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") "Coordinates are none\n" ) (simple-tests curly-brace-colon-at-tests ;; Iteration from sublists on the main arg list (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] ) "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ) "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1]) "Coordinates are [0,1] [1,0]\n" (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") "Coordinates are\n" (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") "Coordinates are none\n" (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1]) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~@:{~:}~%" "") "Coordinates are\n" (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1]) "Coordinates are [2,3] <1>\n" (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") "Coordinates are none\n" ) ;; TODO tests for ~^ in ~[ constructs and other brackets ;; TODO test ~:^ generates an error when used improperly ;; TODO test ~:^ works in ~@:{...~} (let [aseq '(a quick brown fox jumped over the lazy dog) lseq (mapcat identity (for [x aseq] [x (.length (name x))]))] (simple-tests up-tests (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog" (cl-format nil "~{~a~0^, ~}" aseq) "a" (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over" (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox" (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox" )) (simple-tests angle-bracket-tests (cl-format nil "~") "foobarbaz" (cl-format nil "~20") "foo bar baz" (cl-format nil "~,,2") "foo bar baz" (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz" (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz " (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz " (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz" (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz" (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar" (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo " (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo" ) (simple-tests angle-bracket-max-column-tests (cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s"))) "\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n" (cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s")))) (defn list-to-table [aseq column-width] (let [stream (get-pretty-writer (java.io.StringWriter.))] (binding [*out* stream] (doseq [row aseq] (doseq [col row] (cl-format true "~4D~7,vT" col column-width)) (prn))) (.flush stream) (.toString (:base @@(:base @@stream))))) (simple-tests column-writer-test (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8) " 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The following tests are the various examples from the format ;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn expt [base pow] (reduce * (repeat pow base))) (let [x 5, y "elephant", n 3] (simple-tests cltl-intro-tests (format nil "foo") "foo" (format nil "The answer is ~D." x) "The answer is 5." (format nil "The answer is ~3D." x) "The answer is 5." (format nil "The answer is ~3,'0D." x) "The answer is 005." (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007." (format nil "Look at the ~A!" y) "Look at the elephant!" (format nil "Type ~:C to ~A." (char 4) "delete all your files") "Type Control-D to delete all your files." (format nil "~D item~:P found." n) "3 items found." (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here." (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here." (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies.")) (simple-tests cltl-B-tests ;; CLtL didn't have the colons here, but the spec requires them (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" ;; This one was a nice idea, but nothing in the spec supports it working this way ;; (and SBCL doesn't work this way either) ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110") ) (simple-tests cltl-P-tests (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins") (defn foo [x] (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" x x x x x x)) (simple-tests cltl-F-tests (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0" (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0" (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006") (defn foo-e [x] (format nil "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" x x x x)) ;; Clojure doesn't support float/double differences in representation (simple-tests cltl-E-tests (foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one (foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" (foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" ; In Clojure, this is identical to the above ; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" (foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13" (foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120" ; Clojure doesn't support real numbers this large ; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200" ) (simple-tests cltl-E-scale-tests (map (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" (- k 5) 3.14159)) ;Prints 13 lines (range 13)) '("Scale factor -5: | 0.000003E+06|" "Scale factor -4: | 0.000031E+05|" "Scale factor -3: | 0.000314E+04|" "Scale factor -2: | 0.003142E+03|" "Scale factor -1: | 0.031416E+02|" "Scale factor 0: | 0.314159E+01|" "Scale factor 1: | 3.141590E+00|" "Scale factor 2: | 31.41590E-01|" "Scale factor 3: | 314.1590E-02|" "Scale factor 4: | 3141.590E-03|" "Scale factor 5: | 31415.90E-04|" "Scale factor 6: | 314159.0E-05|" "Scale factor 7: | 3141590.E-06|")) (defn foo-g [x] (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" x x x x)) ;; Clojure doesn't support float/double differences in representation (simple-tests cltl-G-tests (foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" (foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 " (foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 " (foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. " (foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2" (foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" ; In Clojure, this is identical to the above ; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" (foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12" (foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120" ; Clojure doesn't support real numbers this large ; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200" ) (defn type-clash-error [fun nargs argnum right-type wrong-type] (format nil ;; CLtL has this format string slightly wrong "~&Function ~S requires its ~:[~:R ~;~*~]~ argument to be of type ~S,~%but it was called ~ with an argument of type ~S.~%" fun (= nargs 1) argnum right-type wrong-type)) (simple-tests cltl-Newline-tests (type-clash-error 'aref nil 2 'integer 'vector) "Function aref requires its second argument to be of type integer, but it was called with an argument of type vector.\n" (type-clash-error 'car 1 1 'list 'short-float) "Function car requires its argument to be of type list, but it was called with an argument of type short-float.\n") (simple-tests cltl-?-tests (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) " 7" (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) " 7" (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) " 7" (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) " 14") (defn f [n] (format nil "~@(~R~) error~:P detected." n)) (simple-tests cltl-paren-tests (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" (f 0) "Zero errors detected." (f 1) "One error detected." (f 23) "Twenty-three errors detected.") (let [*print-level* nil *print-length* 5] (simple-tests cltl-bracket-tests (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" *print-level* *print-length*) " print length = 5")) (let [foo "Items:~#[ none~; ~S~; ~S and ~S~ ~:;~@{~#[~; and~] ~ ~S~^,~}~]."] (simple-tests cltl-bracket1-tests (format nil foo) "Items: none." (format nil foo 'foo) "Items: foo." (format nil foo 'foo 'bar) "Items: foo and bar." (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")) (simple-tests cltl-curly-bracket-tests (format nil "The winners are:~{ ~S~}." '(fred harry jill)) "The winners are: fred harry jill." (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) "Pairs: ." (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) "Pairs: ." (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) "Pairs: ." (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) "Pairs: .") (simple-tests cltl-angle-bracket-tests (format nil "~10") "foo bar" (format nil "~10:") " foo bar" (format nil "~10:@") " foo bar " (format nil "~10") " foobar" (format nil "~10:") " foobar" (format nil "~10@") "foobar " (format nil "~10:@") " foobar ") (let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P." tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here (simple-tests cltl-up-tests (format nil donestr) "Done." (format nil donestr 3) "Done. 3 warnings." (format nil donestr 1 5) "Done. 1 warning. 5 errors." (format nil tellstr 23) "Twenty-three." (format nil tellstr nil "losers") "Losers." (format nil tellstr 23 "losers") "Twenty-three losers." (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) " foo" (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) "foo bar" (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) "foo bar baz")) (simple-tests cltl-up-x3j13-tests (format nil "~:{/~S~^ ...~}" '((hot dog) (hamburger) (ice cream) (french fries))) "/hot .../hamburger/ice .../french ..." (format nil "~:{/~S~:^ ...~}" '((hot dog) (hamburger) (ice cream) (french fries))) "/hot .../hamburger .../ice .../french" (format nil "~:{/~S~#:^ ...~}" ;; This is wrong in CLtL '((hot dog) (hamburger) (ice cream) (french fries))) "/hot .../hamburger") clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/pprint/test_helper.clj000066400000000000000000000020041157562347600270230ustar00rootroot00000000000000;;; test_helper.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This is just a macro to make my tests a little cleaner (ns clojure.test-clojure.pprint.test-helper (:use [clojure.test :only (deftest is)])) (defn- back-match [x y] (re-matches y x)) (defmacro simple-tests [name & test-pairs] `(deftest ~name ~@(for [[x y] (partition 2 test-pairs)] (if (instance? java.util.regex.Pattern y) `(is (#'clojure.test-clojure.pprint.test-helper/back-match ~x ~y)) `(is (= ~x ~y)))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/pprint/test_pretty.clj000066400000000000000000000241531157562347600271040ustar00rootroot00000000000000;;; test_pretty.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 (in-ns 'clojure.test-clojure.pprint) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Unit tests for the pretty printer ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (simple-tests xp-fill-test (binding [*print-pprint-dispatch* simple-dispatch *print-right-margin* 38 *print-miser-width* nil] (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" '((x 4) (*print-length* nil) (z 2) (list nil)))) "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n" (binding [*print-pprint-dispatch* simple-dispatch *print-right-margin* 22] (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" '((x 4) (*print-length* nil) (z 2) (list nil)))) "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n") (simple-tests xp-miser-test (binding [*print-pprint-dispatch* simple-dispatch *print-right-margin* 10, *print-miser-width* 9] (cl-format nil "~:" '(first second third))) "(LIST\n first\n second\n third)" (binding [*print-pprint-dispatch* simple-dispatch *print-right-margin* 10, *print-miser-width* 8] (cl-format nil "~:" '(first second third))) "(LIST first second third)") (simple-tests mandatory-fill-test (cl-format nil "

~%~~%
~%" [ "hello" "gooodbye" ]) "
Usage: *hello*
       *gooodbye*
") (simple-tests prefix-suffix-test (binding [*print-pprint-dispatch* simple-dispatch *print-right-margin* 10, *print-miser-width* 10] (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third))) "{LIST\n first\n second\n third}") (simple-tests pprint-test (binding [*print-pprint-dispatch* simple-dispatch] (write '(defn foo [x y] (let [result (* x y)] (if (> result 400) (cl-format true "That number is too big") (cl-format true "The result of ~d x ~d is ~d" x y result)))) :stream nil)) "(defn foo [x y] (let [result (* x y)] (if (> result 400) (cl-format true \"That number is too big\") (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" (with-pprint-dispatch code-dispatch (write '(defn foo [x y] (let [result (* x y)] (if (> result 400) (cl-format true "That number is too big") (cl-format true "The result of ~d x ~d is ~d" x y result)))) :stream nil)) "(defn foo [x y] (let [result (* x y)] (if (> result 400) (cl-format true \"That number is too big\") (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" (binding [*print-pprint-dispatch* simple-dispatch *print-right-margin* 15] (write '(fn (cons (car x) (cdr y))) :stream nil)) "(fn\n (cons\n (car x)\n (cdr y)))" (with-pprint-dispatch code-dispatch (binding [*print-right-margin* 52] (write '(add-to-buffer this (make-buffer-blob (str (char c)) nil)) :stream nil))) "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))" ) (simple-tests pprint-reader-macro-test (with-pprint-dispatch code-dispatch (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])") :stream nil)) "(map #(first %) [[1 2 3] [4 5 6] [7]])" (with-pprint-dispatch code-dispatch (write (read-string "@@(ref (ref 1))") :stream nil)) "@@(ref (ref 1))" (with-pprint-dispatch code-dispatch (write (read-string "'foo") :stream nil)) "'foo" ) (simple-tests code-block-tests (with-out-str (with-pprint-dispatch code-dispatch (pprint '(defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator)))))) "(defn cl-format \"An implementation of a Common Lisp compatible format function\" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))) " (with-out-str (with-pprint-dispatch code-dispatch (pprint '(defn pprint-defn [writer alis] (if (next alis) (let [[defn-sym defn-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map stuff] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block writer :prefix "(" :suffix ")" (cl-format true "~w ~1I~@_~w" defn-sym defn-name) (if doc-str (cl-format true " ~_~w" doc-str)) (if attr-map (cl-format true " ~_~w" attr-map)) ;; Note: the multi-defn case will work OK for malformed defns too (cond (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) :else (multi-defn stuff (or doc-str attr-map))))) (pprint-simple-code-list writer alis)))))) "(defn pprint-defn [writer alis] (if (next alis) (let [[defn-sym defn-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map stuff] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block writer :prefix \"(\" :suffix \")\" (cl-format true \"~w ~1I~@_~w\" defn-sym defn-name) (if doc-str (cl-format true \" ~_~w\" doc-str)) (if attr-map (cl-format true \" ~_~w\" attr-map)) (cond (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) :else (multi-defn stuff (or doc-str attr-map))))) (pprint-simple-code-list writer alis))) ") (defn tst-pprint "A helper function to pprint to a string with a restricted right margin" [right-margin obj] (binding [*print-right-margin* right-margin *print-pretty* true] (write obj :stream nil))) ;;; A bunch of predefined data to print (def future-filled (future-call (fn [] 100))) @future-filled (def future-unfilled (future-call (fn [] (.acquire (java.util.concurrent.Semaphore. 0))))) (def promise-filled (promise)) (deliver promise-filled '(first second third)) (def promise-unfilled (promise)) (def basic-agent (agent '(first second third))) (defn failed-agent "must be a fn because you cannot await agents during load" [] (let [a (agent "foo")] (send a +) (try (await-for 100 a) (catch RuntimeException re)) a)) (def basic-atom (atom '(first second third))) (def basic-ref (ref '(first second third))) (def delay-forced (delay '(first second third))) (force delay-forced) (def delay-unforced (delay '(first second third))) (defrecord pprint-test-rec [a b c]) (simple-tests pprint-datastructures-tests (tst-pprint 20 future-filled) #"#" (tst-pprint 20 future-unfilled) #"#" (tst-pprint 20 promise-filled) #"#" ;; This hangs currently, cause we can't figure out whether a promise is filled ;;(tst-pprint 20 promise-unfilled) #"#" (tst-pprint 20 basic-agent) #"#" (tst-pprint 20 (failed-agent)) #"#" (tst-pprint 20 basic-atom) #"#" (tst-pprint 20 basic-ref) #"#" (tst-pprint 20 delay-forced) #"#" ;; Currently no way not to force the delay ;;(tst-pprint 20 delay-unforced) #"#" (tst-pprint 20 (pprint-test-rec. 'first 'second 'third)) "{:a first,\n :b second,\n :c third}" ;; basic java arrays: fails owing to assembla ticket #346 ;;(tst-pprint 10 (int-array (range 7))) "[0,\n 1,\n 2,\n 3,\n 4,\n 5,\n 6]" (tst-pprint 15 (reduce conj clojure.lang.PersistentQueue/EMPTY (range 10))) "<-(0\n 1\n 2\n 3\n 4\n 5\n 6\n 7\n 8\n 9)-<" ) ;;; Some simple tests of dispatch (defmulti test-dispatch "A test dispatch method" {:added "1.2" :arglists '[[object]]} #(and (seq %) (not (string? %)))) (defmethod test-dispatch true [avec] (pprint-logical-block :prefix "[" :suffix "]" (loop [aseq (seq avec)] (when aseq (write-out (first aseq)) (when (next aseq) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next aseq))))))) (defmethod test-dispatch false [aval] (pr aval)) (simple-tests dispatch-tests (with-pprint-dispatch test-dispatch (with-out-str (pprint '("hello" "there")))) "[\"hello\" \"there\"]\n" ) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/predicates.clj000066400000000000000000000061661157562347600253310ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka ;; ;; Created 1/28/2009 (ns clojure.test-clojure.predicates (:use clojure.test)) ;; *** Type predicates *** (def myvar 42) (def sample-data { :nil nil :bool-true true :bool-false false :byte (byte 7) :short (short 7) :int (int 7) :long (long 7) :bigint (bigint 7) :float (float 7) :double (double 7) :bigdec (bigdec 7) :ratio 2/3 :character \a :symbol 'abc :keyword :kw :empty-string "" :empty-regex #"" :empty-list () :empty-lazy-seq (lazy-seq nil) :empty-vector [] :empty-map {} :empty-set #{} :empty-array (into-array []) :string "abc" :regex #"a*b" :list '(1 2 3) :lazy-seq (lazy-seq [1 2 3]) :vector [1 2 3] :map {:a 1 :b 2 :c 3} :set #{1 2 3} :array (into-array [1 2 3]) :fn (fn [x] (* 2 x)) :class java.util.Date :object (new java.util.Date) :var (var myvar) :delay (delay (+ 1 2)) }) (def type-preds { nil? [:nil] true? [:bool-true] false? [:bool-false] ; boolean? integer? [:byte :short :int :long :bigint] float? [:float :double] decimal? [:bigdec] ratio? [:ratio] rational? [:byte :short :int :long :bigint :ratio :bigdec] number? [:byte :short :int :long :bigint :ratio :bigdec :float :double] ; character? symbol? [:symbol] keyword? [:keyword] string? [:empty-string :string] ; regex? list? [:empty-list :list] vector? [:empty-vector :vector] map? [:empty-map :map] set? [:empty-set :set] coll? [:empty-list :list :empty-lazy-seq :lazy-seq :empty-vector :vector :empty-map :map :empty-set :set] seq? [:empty-list :list :empty-lazy-seq :lazy-seq] ; array? fn? [:fn] ifn? [:fn :empty-vector :vector :empty-map :map :empty-set :set :keyword :symbol :var] class? [:class] var? [:var] delay? [:delay] }) ;; Test all type predicates against all data types ;; (defn- get-fn-name [f] (str (apply str (nthnext (first (.split (str f) "_")) (count "clojure.core$"))) "?")) (deftest test-type-preds (doseq [tp type-preds] (doseq [dt sample-data] (if (some #(= % (first dt)) (second tp)) (is ((first tp) (second dt)) (pr-str (list (get-fn-name (first tp)) (second dt)))) (is (not ((first tp) (second dt))) (pr-str (list 'not (list (get-fn-name (first tp)) (second dt))))))))) ;; Additional tests: ;; http://groups.google.com/group/clojure/browse_thread/thread/537761a06edb4b06/bfd4f0705b746a38 ;; (deftest test-string?-more (are [x] (not (string? x)) (new java.lang.StringBuilder "abc") (new java.lang.StringBuffer "xyz"))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/printer.clj000066400000000000000000000056631157562347600246720ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stephen C. Gilardi ;; clojure.test-clojure.printer ;; ;; scgilardi (gmail) ;; Created 29 October 2008 (ns clojure.test-clojure.printer (:use clojure.test)) (deftest print-length-empty-seq (let [coll () val "()"] (is (= val (binding [*print-length* 0] (print-str coll)))) (is (= val (binding [*print-length* 1] (print-str coll)))))) (deftest print-length-seq (let [coll (range 5) length-val '((0 "(...)") (1 "(0 ...)") (2 "(0 1 ...)") (3 "(0 1 2 ...)") (4 "(0 1 2 3 ...)") (5 "(0 1 2 3 4)"))] (doseq [[length val] length-val] (binding [*print-length* length] (is (= val (print-str coll))))))) (deftest print-length-empty-vec (let [coll [] val "[]"] (is (= val (binding [*print-length* 0] (print-str coll)))) (is (= val (binding [*print-length* 1] (print-str coll)))))) (deftest print-length-vec (let [coll [0 1 2 3 4] length-val '((0 "[...]") (1 "[0 ...]") (2 "[0 1 ...]") (3 "[0 1 2 ...]") (4 "[0 1 2 3 ...]") (5 "[0 1 2 3 4]"))] (doseq [[length val] length-val] (binding [*print-length* length] (is (= val (print-str coll))))))) (deftest print-level-seq (let [coll '(0 (1 (2 (3 (4))))) level-val '((0 "#") (1 "(0 #)") (2 "(0 (1 #))") (3 "(0 (1 (2 #)))") (4 "(0 (1 (2 (3 #))))") (5 "(0 (1 (2 (3 (4)))))"))] (doseq [[level val] level-val] (binding [*print-level* level] (is (= val (print-str coll))))))) (deftest print-level-length-coll (let [coll '(if (member x y) (+ (first x) 3) (foo (a b c d "Baz"))) level-length-val '((0 1 "#") (1 1 "(if ...)") (1 2 "(if # ...)") (1 3 "(if # # ...)") (1 4 "(if # # #)") (2 1 "(if ...)") (2 2 "(if (member x ...) ...)") (2 3 "(if (member x y) (+ # 3) ...)") (3 2 "(if (member x ...) ...)") (3 3 "(if (member x y) (+ (first x) 3) ...)") (3 4 "(if (member x y) (+ (first x) 3) (foo (a b c d ...)))") (3 5 "(if (member x y) (+ (first x) 3) (foo (a b c d Baz)))"))] (doseq [[level length val] level-length-val] (binding [*print-level* level *print-length* length] (is (= val (print-str coll))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/protocols.clj000066400000000000000000000305621157562347600252270ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stuart Halloway (ns clojure.test-clojure.protocols (:use clojure.test clojure.test-clojure.protocols.examples) (:require [clojure.test-clojure.protocols.more-examples :as other] [clojure.set :as set] clojure.test-clojure.helpers) (:import [clojure.test_clojure.protocols.examples ExampleInterface])) ;; temporary hack until I decide how to cleanly reload protocol (defn reload-example-protocols [] (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol assoc :impls {}) (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol assoc :impls {}) (require :reload 'clojure.test-clojure.protocols.examples 'clojure.test-clojure.protocols.more-examples)) (defn method-names "return sorted list of method names on a class" [c] (->> (.getMethods c) (map #(.getName %)) (sort))) (defrecord EmptyRecord []) (defrecord TestRecord [a b]) (defn r ([a b] (TestRecord. a b)) ([a b meta ext] (TestRecord. a b meta ext))) (defrecord MapEntry [k v] java.util.Map$Entry (getKey [_] k) (getValue [_] v)) (deftest protocols-test (testing "protocol fns have useful metadata" (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples) :protocol #'ExampleProtocol}] (are [m f] (= (merge (quote m) common-meta) (meta (var f))) {:name foo :arglists ([a]) :doc "method with one arg"} foo {:name bar :arglists ([a b]) :doc "method with two args"} bar {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux))) (testing "protocol fns throw IllegalArgumentException if no impl matches" (is (thrown-with-msg? IllegalArgumentException #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer" (foo 10)))) (testing "protocols generate a corresponding interface using _ instead of - for method names" (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol)))) (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)" (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] [] (foo [] "foo!"))] (is (= "foo!" (.foo obj)) "call through interface") (is (= "foo!" (foo obj)) "call through protocol"))) (testing "you can implement just part of a protocol if you want" (let [obj (reify ExampleProtocol (baz [a b] "two-arg baz!"))] (is (= "two-arg baz!" (baz obj nil))) (is (thrown? AbstractMethodError (baz obj))))) (testing "you can redefine a protocol with different methods" (eval '(defprotocol Elusive (old-method [x]))) (eval '(defprotocol Elusive (new-method [x]))) (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method)))))) (is (fails-with-cause? IllegalArgumentException #"No method of interface: user\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)" (eval '(old-method (reify Elusive (new-method [x] :new-method)))))))) (deftype ExtendTestWidget [name]) (deftype HasProtocolInline [] ExampleProtocol (foo [this] :inline)) (deftest extend-test (testing "you can extend a protocol to a class" (extend String ExampleProtocol {:foo identity}) (is (= "pow" (foo "pow")))) (testing "you can have two methods with the same name. Just use namespaces!" (extend String other/SimpleProtocol {:foo (fn [s] (.toUpperCase s))}) (is (= "POW" (other/foo "pow")))) (testing "you can extend deftype types" (extend ExtendTestWidget ExampleProtocol {:foo (fn [this] (str "widget " (.name this)))}) (is (= "widget z" (foo (ExtendTestWidget. "z")))))) (deftest illegal-extending (testing "you cannot extend a protocol to a type that implements the protocol inline" (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface" (eval '(extend clojure.test_clojure.protocols.HasProtocolInline clojure.test-clojure.protocols.examples/ExampleProtocol {:foo (fn [_] :extended)}))))) (testing "you cannot extend to an interface" (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol" (eval '(extend clojure.test_clojure.protocols.HasProtocolInline clojure.test_clojure.protocols.examples.ExampleProtocol {:foo (fn [_] :extended)})))))) (deftype ExtendsTestWidget [] ExampleProtocol) (deftest extends?-test (reload-example-protocols) (testing "returns false if a type does not implement the protocol at all" (is (false? (extends? other/SimpleProtocol ExtendsTestWidget)))) (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010 (is (true? (extends? ExampleProtocol ExtendsTestWidget)))) (testing "returns true if a type explicitly extends protocol" (extend ExtendsTestWidget other/SimpleProtocol {:foo identity}) (is (true? (extends? other/SimpleProtocol ExtendsTestWidget))))) (deftype ExtendersTestWidget []) (deftest extenders-test (reload-example-protocols) (testing "a fresh protocol has no extenders" (is (nil? (extenders ExampleProtocol)))) (testing "extending with no methods doesn't count!" (deftype Something []) (extend ::Something ExampleProtocol) (is (nil? (extenders ExampleProtocol)))) (testing "extending a protocol (and including an impl) adds an entry to extenders" (extend ExtendersTestWidget ExampleProtocol {:foo identity}) (is (= [ExtendersTestWidget] (extenders ExampleProtocol))))) (deftype SatisfiesTestWidget [] ExampleProtocol) (deftest satisifies?-test (reload-example-protocols) (let [whatzit (SatisfiesTestWidget.)] (testing "returns false if a type does not implement the protocol at all" (is (false? (satisfies? other/SimpleProtocol whatzit)))) (testing "returns true if a type implements the protocol directly" (is (true? (satisfies? ExampleProtocol whatzit)))) (testing "returns true if a type explicitly extends protocol" (extend SatisfiesTestWidget other/SimpleProtocol {:foo identity}) (is (true? (satisfies? other/SimpleProtocol whatzit))))) ) (deftype ReExtendingTestWidget []) (deftest re-extending-test (reload-example-protocols) (extend ReExtendingTestWidget ExampleProtocol {:foo (fn [_] "first foo") :baz (fn [_] "first baz")}) (testing "if you re-extend, the old implementation is replaced (not merged!)" (extend ReExtendingTestWidget ExampleProtocol {:baz (fn [_] "second baz") :bar (fn [_ _] "second bar")}) (let [whatzit (ReExtendingTestWidget.)] (is (thrown? IllegalArgumentException (foo whatzit))) (is (= "second bar" (bar whatzit nil))) (is (= "second baz" (baz whatzit)))))) (defrecord DefrecordObjectMethodsWidgetA [a]) (defrecord DefrecordObjectMethodsWidgetB [a]) (deftest defrecord-object-methods-test (testing "= depends on fields and type" (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1)))) (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2)))) (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1)))))) (deftest defrecord-acts-like-a-map (let [rec (r 1 2)] (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4}))) (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo}))) (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10}))))) (deftest degenerate-defrecord-test (let [empty (EmptyRecord.)] (is (nil? (seq empty))) (is (not (.containsValue empty :a))))) (deftest defrecord-interfaces-test (testing "java.util.Map" (let [rec (r 1 2)] (is (= 2 (.size rec))) (is (= 3 (.size (assoc rec :c 3)))) (is (not (.isEmpty rec))) (is (.isEmpty (EmptyRecord.))) (is (.containsKey rec :a)) (is (not (.containsKey rec :c))) (is (.containsValue rec 1)) (is (not (.containsValue rec 3))) (is (= 1 (.get rec :a))) (is (thrown? UnsupportedOperationException (.put rec :a 1))) (is (thrown? UnsupportedOperationException (.remove rec :a))) (is (thrown? UnsupportedOperationException (.putAll rec {}))) (is (thrown? UnsupportedOperationException (.clear rec))) (is (= #{:a :b} (.keySet rec))) (is (= #{1 2} (set (.values rec)))) (is (= #{[:a 1] [:b 2]} (.entrySet rec))) )) (testing "IPersistentCollection" (testing ".cons" (let [rec (r 1 2)] (are [x] (= rec (.cons rec x)) nil {}) (is (= (r 1 3) (.cons rec {:b 3}))) (is (= (r 1 4) (.cons rec [:b 4]))) (is (= (r 1 5) (.cons rec (MapEntry. :b 5)))))))) (defrecord RecordWithSpecificFieldNames [this that k m o]) (deftest defrecord-with-specific-field-names (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)] (is (= rec rec)) (is (= 1 (:this (with-meta rec {:foo :bar})))) (is (= 3 (get rec :k))) (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5]))) (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5})))) (deftest reify-test (testing "of an interface" (let [s :foo r (reify java.util.List (contains [_ o] (= s o)))] (testing "implemented methods" (is (true? (.contains r :foo))) (is (false? (.contains r :bar)))) (testing "unimplemented methods" (is (thrown? AbstractMethodError (.add r :baz)))))) (testing "of two interfaces" (let [r (reify java.util.List (contains [_ o] (= :foo o)) java.util.Collection (isEmpty [_] false))] (is (true? (.contains r :foo))) (is (false? (.contains r :bar))) (is (false? (.isEmpty r))))) (testing "you can't define a method twice" (is (fails-with-cause? java.lang.ClassFormatError #"^(Repetitive|Duplicate) method name" (eval '(reify java.util.List (size [_] 10) java.util.Collection (size [_] 20)))))) (testing "you can't define a method not on an interface/protocol/j.l.Object" (is (fails-with-cause? IllegalArgumentException #"^Can't define method not in interfaces: foo" (eval '(reify java.util.List (foo [_])))))) (testing "of a protocol" (let [r (reify ExampleProtocol (bar [this o] o) (baz [this] 1) (baz [this o] 2))] (= :foo (.bar r :foo)) (= 1 (.baz r)) (= 2 (.baz r nil)))) (testing "destructuring in method def" (let [r (reify ExampleProtocol (bar [this [_ _ item]] item))] (= :c (.bar r [:a :b :c])))) (testing "methods can recur" (let [r (reify java.util.List (get [_ index] (if (zero? index) :done (recur (dec index)))))] (is (= :done (.get r 0))) (is (= :done (.get r 1))))) (testing "disambiguating with type hints" (testing "you must hint an overloaded method" (is (fails-with-cause? IllegalArgumentException #"Must hint overloaded method: hinted" (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o])))))) (testing "hinting" (let [r (reify ExampleInterface (hinted [_ ^int i] (inc i)) (hinted [_ ^String s] (str s s)))] (is (= 2 (.hinted r 1))) (is (= "xoxo" (.hinted r "xo"))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/protocols/000077500000000000000000000000001157562347600245275ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/protocols/examples.clj000066400000000000000000000005631157562347600270430ustar00rootroot00000000000000(ns clojure.test-clojure.protocols.examples) (defprotocol ExampleProtocol "example protocol used by clojure tests" (foo [a] "method with one arg") (bar [a b] "method with two args") (^String baz [a] [a b] "method with multiple arities") (with-quux [a] "method name with a hyphen")) (definterface ExampleInterface (hinted [^int i]) (hinted [^String s])) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/protocols/more_examples.clj000066400000000000000000000003051157562347600300570ustar00rootroot00000000000000(ns clojure.test-clojure.protocols.more-examples) (defprotocol SimpleProtocol "example protocol used by clojure tests. Note that foo collides with examples/ExampleProtocol." (foo [a] "")) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/reader.clj000066400000000000000000000167421157562347600244510ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stephen C. Gilardi ;; ;; Tests for the Clojure functions documented at the URL: ;; ;; http://clojure.org/Reader ;; ;; scgilardi (gmail) ;; Created 22 October 2008 (ns clojure.test-clojure.reader (:use clojure.test)) ;; Symbols (deftest Symbols (is (= 'abc (symbol "abc"))) (is (= '*+!-_? (symbol "*+!-_?"))) (is (= 'abc:def:ghi (symbol "abc:def:ghi"))) (is (= 'abc/def (symbol "abc" "def"))) (is (= 'abc.def/ghi (symbol "abc.def" "ghi"))) (is (= 'abc/def.ghi (symbol "abc" "def.ghi"))) (is (= 'abc:def/ghi:jkl.mno (symbol "abc:def" "ghi:jkl.mno"))) (is (instance? clojure.lang.Symbol 'alphabet)) ) ;; Literals (deftest Literals ; 'nil 'false 'true are reserved by Clojure and are not symbols (is (= 'nil nil)) (is (= 'false false)) (is (= 'true true)) ) ;; Strings (deftest Strings (is (= "abcde" (str \a \b \c \d \e))) (is (= "abc def" (str \a \b \c \newline \space \space \d \e \f))) ) ;; Numbers (deftest Numbers ; Read Integer (is (instance? Integer 2147483647)) (is (instance? Integer +1)) (is (instance? Integer 1)) (is (instance? Integer +0)) (is (instance? Integer 0)) (is (instance? Integer -0)) (is (instance? Integer -1)) (is (instance? Integer -2147483648)) ; Read Long (is (instance? Long 2147483648)) (is (instance? Long -2147483649)) (is (instance? Long 9223372036854775807)) (is (instance? Long -9223372036854775808)) ;; Numeric constants of different types don't wash out. Regression fixed in ;; r1157. Previously the compiler saw 0 and 0.0 as the same constant and ;; caused the sequence to be built of Doubles. (let [x 0.0] (let [sequence (loop [i 0 l '()] (if (< i 5) (recur (inc i) (conj l i)) l))] (is (= [4 3 2 1 0] sequence)) (is (every? #(instance? Integer %) sequence)))) ; Read BigInteger (is (instance? BigInteger 9223372036854775808)) (is (instance? BigInteger -9223372036854775809)) (is (instance? BigInteger 10000000000000000000000000000000000000000000000000)) (is (instance? BigInteger -10000000000000000000000000000000000000000000000000)) ; Read Double (is (instance? Double +1.0e+1)) (is (instance? Double +1.e+1)) (is (instance? Double +1e+1)) (is (instance? Double +1.0e1)) (is (instance? Double +1.e1)) (is (instance? Double +1e1)) (is (instance? Double +1.0e-1)) (is (instance? Double +1.e-1)) (is (instance? Double +1e-1)) (is (instance? Double 1.0e+1)) (is (instance? Double 1.e+1)) (is (instance? Double 1e+1)) (is (instance? Double 1.0e1)) (is (instance? Double 1.e1)) (is (instance? Double 1e1)) (is (instance? Double 1.0e-1)) (is (instance? Double 1.e-1)) (is (instance? Double 1e-1)) (is (instance? Double -1.0e+1)) (is (instance? Double -1.e+1)) (is (instance? Double -1e+1)) (is (instance? Double -1.0e1)) (is (instance? Double -1.e1)) (is (instance? Double -1e1)) (is (instance? Double -1.0e-1)) (is (instance? Double -1.e-1)) (is (instance? Double -1e-1)) (is (instance? Double +1.0)) (is (instance? Double +1.)) (is (instance? Double 1.0)) (is (instance? Double 1.)) (is (instance? Double +0.0)) (is (instance? Double +0.)) (is (instance? Double 0.0)) (is (instance? Double 0.)) (is (instance? Double -0.0)) (is (instance? Double -0.)) (is (instance? Double -1.0)) (is (instance? Double -1.)) ; Read BigDecimal (is (instance? BigDecimal 9223372036854775808M)) (is (instance? BigDecimal -9223372036854775809M)) (is (instance? BigDecimal 2147483647M)) (is (instance? BigDecimal +1M)) (is (instance? BigDecimal 1M)) (is (instance? BigDecimal +0M)) (is (instance? BigDecimal 0M)) (is (instance? BigDecimal -0M)) (is (instance? BigDecimal -1M)) (is (instance? BigDecimal -2147483648M)) (is (instance? BigDecimal +1.0e+1M)) (is (instance? BigDecimal +1.e+1M)) (is (instance? BigDecimal +1e+1M)) (is (instance? BigDecimal +1.0e1M)) (is (instance? BigDecimal +1.e1M)) (is (instance? BigDecimal +1e1M)) (is (instance? BigDecimal +1.0e-1M)) (is (instance? BigDecimal +1.e-1M)) (is (instance? BigDecimal +1e-1M)) (is (instance? BigDecimal 1.0e+1M)) (is (instance? BigDecimal 1.e+1M)) (is (instance? BigDecimal 1e+1M)) (is (instance? BigDecimal 1.0e1M)) (is (instance? BigDecimal 1.e1M)) (is (instance? BigDecimal 1e1M)) (is (instance? BigDecimal 1.0e-1M)) (is (instance? BigDecimal 1.e-1M)) (is (instance? BigDecimal 1e-1M)) (is (instance? BigDecimal -1.0e+1M)) (is (instance? BigDecimal -1.e+1M)) (is (instance? BigDecimal -1e+1M)) (is (instance? BigDecimal -1.0e1M)) (is (instance? BigDecimal -1.e1M)) (is (instance? BigDecimal -1e1M)) (is (instance? BigDecimal -1.0e-1M)) (is (instance? BigDecimal -1.e-1M)) (is (instance? BigDecimal -1e-1M)) (is (instance? BigDecimal +1.0M)) (is (instance? BigDecimal +1.M)) (is (instance? BigDecimal 1.0M)) (is (instance? BigDecimal 1.M)) (is (instance? BigDecimal +0.0M)) (is (instance? BigDecimal +0.M)) (is (instance? BigDecimal 0.0M)) (is (instance? BigDecimal 0.M)) (is (instance? BigDecimal -0.0M)) (is (instance? BigDecimal -0.M)) (is (instance? BigDecimal -1.0M)) (is (instance? BigDecimal -1.M)) ) ;; Characters (deftest t-Characters) ;; nil (deftest t-nil) ;; Booleans (deftest t-Booleans) ;; Keywords (deftest t-Keywords (is (= :abc (keyword "abc"))) (is (= :abc (keyword 'abc))) (is (= :*+!-_? (keyword "*+!-_?"))) (is (= :abc:def:ghi (keyword "abc:def:ghi"))) (is (= :abc/def (keyword "abc" "def"))) (is (= :abc/def (keyword 'abc/def))) (is (= :abc.def/ghi (keyword "abc.def" "ghi"))) (is (= :abc/def.ghi (keyword "abc" "def.ghi"))) (is (= :abc:def/ghi:jkl.mno (keyword "abc:def" "ghi:jkl.mno"))) (is (instance? clojure.lang.Keyword :alphabet)) ) (deftest reading-keywords (are [x y] (= x (read-string y)) :foo ":foo" :foo/bar ":foo/bar" :user/foo "::foo") (are [err msg form] (thrown-with-msg? err msg (read-string form)) Exception #"Invalid token: foo:" "foo:" Exception #"Invalid token: :bar/" ":bar/" Exception #"Invalid token: ::does.not/exist" "::does.not/exist")) ;; Lists (deftest t-Lists) ;; Vectors (deftest t-Vectors) ;; Maps (deftest t-Maps) ;; Sets (deftest t-Sets) ;; Macro characters ;; Quote (') (deftest t-Quote) ;; Character (\) (deftest t-Character) ;; Comment (;) (deftest t-Comment) ;; Meta (^) (deftest t-Meta) ;; Deref (@) (deftest t-Deref) ;; Dispatch (#) ;; #{} - see Sets above ;; Regex patterns (#"pattern") (deftest t-Regex) ;; Metadata (#^) (deftest t-Metadata) ;; Var-quote (#') (deftest t-Var-quote) ;; Anonymous function literal (#()) (deftest t-Anonymouns-function-literal) ;; Syntax-quote (`, note, the "backquote" character), Unquote (~) and ;; Unquote-splicing (~@) (deftest t-Syntax-quote (are [x y] (= x y) `() () ; was NPE before SVN r1337 )) ;; (read) ;; (read stream) ;; (read stream eof-is-error) ;; (read stream eof-is-error eof-value) ;; (read stream eof-is-error eof-value is-recursive) (deftest t-read) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/refs.clj000066400000000000000000000012501157562347600241320ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka (ns clojure.test-clojure.refs (:use clojure.test)) ; http://clojure.org/refs ; ref ; deref, @-reader-macro ; dosync io! ; ensure ref-set alter commute ; set-validator get-validator clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/repl.clj000066400000000000000000000021551157562347600241420ustar00rootroot00000000000000(ns clojure.test-clojure.repl (:use clojure.test clojure.repl clojure.test-clojure.repl.example)) (deftest test-source (is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo))) (is (= "(defn foo [])\n" (with-out-str (source clojure.test-clojure.repl.example/foo)))) (is (nil? (source-fn 'non-existent-fn)))) (deftest test-dir (is (thrown? Exception (dir-fn 'non-existent-ns))) (is (= '[bar foo] (dir-fn 'clojure.test-clojure.repl.example))) (is (= "bar\nfoo\n" (with-out-str (dir clojure.test-clojure.repl.example))))) (deftest test-apropos (testing "with a regular expression" (is (= '[defmacro] (apropos #"^defmacro$"))) (is (some #{'defmacro} (apropos #"def.acr."))) (is (= [] (apropos #"nothing-has-this-name")))) (testing "with a string" (is (some #{'defmacro} (apropos "defmacro"))) (is (some #{'defmacro} (apropos "efmac"))) (is (= [] (apropos "nothing-has-this-name")))) (testing "with a symbol" (is (some #{'defmacro} (apropos 'defmacro))) (is (some #{'defmacro} (apropos 'efmac))) (is (= [] (apropos 'nothing-has-this-name))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/repl/000077500000000000000000000000001157562347600234455ustar00rootroot00000000000000clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/repl/example.clj000066400000000000000000000002001157562347600255620ustar00rootroot00000000000000(ns clojure.test-clojure.repl.example) ;; sample namespace for repl tests, don't add anything here (defn foo []) (defn bar []) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/rt.clj000066400000000000000000000105471157562347600236310ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stuart Halloway (ns clojure.test-clojure.rt (:use clojure.test clojure.test-clojure.helpers)) (defmacro with-err-print-writer "Evaluate with err pointing to a temporary PrintWriter, and return err contents as a string." [& body] `(let [s# (java.io.StringWriter.) p# (java.io.PrintWriter. s#)] (binding [*err* p#] ~@body (str s#)))) (defmacro with-err-string-writer "Evaluate with err pointing to a temporary StringWriter, and return err contents as a string." [& body] `(let [s# (java.io.StringWriter.)] (binding [*err* s#] ~@body (str s#)))) (defmacro should-print-err-message "Turn on all warning flags, and test that error message prints correctly for all semi-reasonable bindings of *err*." [msg-re form] `(binding [*warn-on-reflection* true] (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form)))) (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form)))))) (defn bare-rt-print "Return string RT would print prior to print-initialize" [x] (with-out-str (try (push-thread-bindings {#'clojure.core/print-initialized false}) (clojure.lang.RT/print x *out*) (finally (pop-thread-bindings))))) (deftest rt-print-prior-to-print-initialize (testing "pattern literals" (is (= "#\"foo\"" (bare-rt-print #"foo"))))) (deftest error-messages (testing "binding a core var that already refers to something" (should-print-err-message #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n" (defn prefers [] (throw (RuntimeException. "rebound!"))))) (testing "reflection cannot resolve field" (should-print-err-message #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n" (defn foo [x] (.blah x)))) (testing "reflection cannot resolve instance method" (should-print-err-message #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n" (defn foo [x] (.zap x 1)))) (testing "reflection cannot resolve static method" (should-print-err-message #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n" (defn foo [] (Integer/valueOf #"boom")))) (testing "reflection cannot resolve constructor" (should-print-err-message #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n" (defn foo [] (String. 1 2 3))))) (def example-var) (deftest binding-root-clears-macro-metadata (alter-meta! #'example-var assoc :macro true) (is (contains? (meta #'example-var) :macro)) (.bindRoot #'example-var 0) (is (not (contains? (meta #'example-var) :macro)))) (deftest last-var-wins-for-core (testing "you can replace a core name, with warning" (let [ns (temp-ns) replacement (gensym)] (with-err-string-writer (intern ns 'prefers replacement)) (is (= replacement @('prefers (ns-publics ns)))))) (testing "you can replace a name you defined before" (let [ns (temp-ns) s (gensym) v1 (intern ns 'foo s) v2 (intern ns 'bar s)] (with-err-string-writer (.refer ns 'flatten v1)) (.refer ns 'flatten v2) (is (= v2 (ns-resolve ns 'flatten))))) (testing "you cannot intern over an existing non-core name" (let [ns (temp-ns 'clojure.set) replacement (gensym)] (is (thrown? IllegalStateException (intern ns 'subset? replacement))) (is (nil? ('subset? (ns-publics ns)))) (is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))) (testing "you cannot refer over an existing non-core name" (let [ns (temp-ns 'clojure.set) replacement (gensym)] (is (thrown? IllegalStateException (.refer ns 'subset? #'clojure.set/intersection))) (is (nil? ('subset? (ns-publics ns)))) (is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/sequences.clj000066400000000000000000000703311157562347600251740ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka ; Contributors: Stuart Halloway (ns clojure.test-clojure.sequences (:use clojure.test)) ;; *** Tests *** ; TODO: ; apply, map, filter, remove ; and more... (deftest test-reduce-from-chunked-into-unchunked (= [1 2 \a \b] (into [] (concat [1 2] "ab")))) (deftest test-reduce (let [int+ (fn [a b] (+ (int a) (int b))) arange (range 100) ;; enough to cross nodes avec (into [] arange) alist (into () arange) obj-array (into-array arange) int-array (into-array Integer/TYPE arange) long-array (into-array Long/TYPE arange) float-array (into-array Float/TYPE arange) char-array (into-array Character/TYPE (map char arange)) double-array (into-array Double/TYPE arange) byte-array (into-array Byte/TYPE (map byte arange)) int-vec (into (vector-of :int) arange) long-vec (into (vector-of :long) arange) float-vec (into (vector-of :float) arange) char-vec (into (vector-of :char) (map char arange)) double-vec (into (vector-of :double) arange) byte-vec (into (vector-of :byte) (map byte arange)) all-true (into-array Boolean/TYPE (repeat 10 true))] (is (= 4950 (reduce + arange) (reduce + avec) (reduce + alist) (reduce + obj-array) (reduce + int-array) (reduce + long-array) (reduce + float-array) (reduce int+ char-array) (reduce + double-array) (reduce int+ byte-array) (reduce + int-vec) (reduce + long-vec) (reduce + float-vec) (reduce int+ char-vec) (reduce + double-vec) (reduce int+ byte-vec))) (is (= 4951 (reduce + 1 arange) (reduce + 1 avec) (reduce + 1 alist) (reduce + 1 obj-array) (reduce + 1 int-array) (reduce + 1 long-array) (reduce + 1 float-array) (reduce int+ 1 char-array) (reduce + 1 double-array) (reduce int+ 1 byte-array) (reduce + 1 int-vec) (reduce + 1 long-vec) (reduce + 1 float-vec) (reduce int+ 1 char-vec) (reduce + 1 double-vec) (reduce int+ 1 byte-vec))) (is (= true (reduce #(and %1 %2) all-true) (reduce #(and %1 %2) true all-true))))) (deftest test-equality ; lazy sequences (are [x y] (= x y) ; fixed SVN 1288 - LazySeq and EmptyList equals/equiv ; http://groups.google.com/group/clojure/browse_frm/thread/286d807be9cae2a5# (map inc nil) () (map inc ()) () (map inc []) () (map inc #{}) () (map inc {}) () )) (deftest test-lazy-seq (are [x] (seq? x) (lazy-seq nil) (lazy-seq []) (lazy-seq [1 2])) (are [x y] (= x y) (lazy-seq nil) () (lazy-seq [nil]) '(nil) (lazy-seq ()) () (lazy-seq []) () (lazy-seq #{}) () (lazy-seq {}) () (lazy-seq "") () (lazy-seq (into-array [])) () (lazy-seq (list 1 2)) '(1 2) (lazy-seq [1 2]) '(1 2) (lazy-seq (sorted-set 1 2)) '(1 2) (lazy-seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2]) (lazy-seq "abc") '(\a \b \c) (lazy-seq (into-array [1 2])) '(1 2) )) (deftest test-seq (is (not (seq? (seq [])))) (is (seq? (seq [1 2]))) (are [x y] (= x y) (seq nil) nil (seq [nil]) '(nil) (seq ()) nil (seq []) nil (seq #{}) nil (seq {}) nil (seq "") nil (seq (into-array [])) nil (seq (list 1 2)) '(1 2) (seq [1 2]) '(1 2) (seq (sorted-set 1 2)) '(1 2) (seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2]) (seq "abc") '(\a \b \c) (seq (into-array [1 2])) '(1 2) )) (deftest test-cons (is (thrown? IllegalArgumentException (cons 1 2))) (are [x y] (= x y) (cons 1 nil) '(1) (cons nil nil) '(nil) (cons \a nil) '(\a) (cons \a "") '(\a) (cons \a "bc") '(\a \b \c) (cons 1 ()) '(1) (cons 1 '(2 3)) '(1 2 3) (cons 1 []) [1] (cons 1 [2 3]) [1 2 3] (cons 1 #{}) '(1) (cons 1 (sorted-set 2 3)) '(1 2 3) (cons 1 (into-array [])) '(1) (cons 1 (into-array [2 3])) '(1 2 3) )) (deftest test-empty (are [x y] (and (= (empty x) y) (= (class (empty x)) (class y))) nil nil () () '(1 2) () [] [] [1 2] [] {} {} {:a 1 :b 2} {} (sorted-map) (sorted-map) (sorted-map :a 1 :b 2) (sorted-map) #{} #{} #{1 2} #{} (sorted-set) (sorted-set) (sorted-set 1 2) (sorted-set) (seq ()) nil ; (seq ()) => nil (seq '(1 2)) () (seq []) nil ; (seq []) => nil (seq [1 2]) () (seq "") nil ; (seq "") => nil (seq "ab") () (lazy-seq ()) () (lazy-seq '(1 2)) () (lazy-seq []) () (lazy-seq [1 2]) () ; non-coll, non-seq => nil 42 nil 1.2 nil "abc" nil )) ;Tests that the comparator is preservered ;The first element should be the same in each set if preserved. (deftest test-empty-sorted (let [inv-compare (comp - compare)] (are [x y] (= (first (into (empty x) x)) (first y)) (sorted-set 1 2 3) (sorted-set 1 2 3) (sorted-set-by inv-compare 1 2 3) (sorted-set-by inv-compare 1 2 3) (sorted-map 1 :a 2 :b 3 :c) (sorted-map 1 :a 2 :b 3 :c) (sorted-map-by inv-compare 1 :a 2 :b 3 :c) (sorted-map-by inv-compare 1 :a 2 :b 3 :c)))) (deftest test-not-empty ; empty coll/seq => nil (are [x] (= (not-empty x) nil) () [] {} #{} (seq ()) (seq []) (lazy-seq ()) (lazy-seq []) ) ; non-empty coll/seq => identity (are [x] (and (= (not-empty x) x) (= (class (not-empty x)) (class x))) '(1 2) [1 2] {:a 1} #{1 2} (seq '(1 2)) (seq [1 2]) (lazy-seq '(1 2)) (lazy-seq [1 2]) )) (deftest test-first (is (thrown? IllegalArgumentException (first))) (is (thrown? IllegalArgumentException (first true))) (is (thrown? IllegalArgumentException (first false))) (is (thrown? IllegalArgumentException (first 1))) (is (thrown? IllegalArgumentException (first 1 2))) (is (thrown? IllegalArgumentException (first \a))) (is (thrown? IllegalArgumentException (first 's))) (is (thrown? IllegalArgumentException (first :k))) (are [x y] (= x y) (first nil) nil ; string (first "") nil (first "a") \a (first "abc") \a ; list (first ()) nil (first '(1)) 1 (first '(1 2 3)) 1 (first '(nil)) nil (first '(1 nil)) 1 (first '(nil 2)) nil (first '(())) () (first '(() nil)) () (first '(() 2 nil)) () ; vector (first []) nil (first [1]) 1 (first [1 2 3]) 1 (first [nil]) nil (first [1 nil]) 1 (first [nil 2]) nil (first [[]]) [] (first [[] nil]) [] (first [[] 2 nil]) [] ; set (first #{}) nil (first #{1}) 1 (first (sorted-set 1 2 3)) 1 (first #{nil}) nil (first (sorted-set 1 nil)) nil (first (sorted-set nil 2)) nil (first #{#{}}) #{} (first (sorted-set #{} nil)) nil ;(first (sorted-set #{} 2 nil)) nil ; map (first {}) nil (first (sorted-map :a 1)) '(:a 1) (first (sorted-map :a 1 :b 2 :c 3)) '(:a 1) ; array (first (into-array [])) nil (first (into-array [1])) 1 (first (into-array [1 2 3])) 1 (first (to-array [nil])) nil (first (to-array [1 nil])) 1 (first (to-array [nil 2])) nil )) (deftest test-next (is (thrown? IllegalArgumentException (next))) (is (thrown? IllegalArgumentException (next true))) (is (thrown? IllegalArgumentException (next false))) (is (thrown? IllegalArgumentException (next 1))) (is (thrown? IllegalArgumentException (next 1 2))) (is (thrown? IllegalArgumentException (next \a))) (is (thrown? IllegalArgumentException (next 's))) (is (thrown? IllegalArgumentException (next :k))) (are [x y] (= x y) (next nil) nil ; string (next "") nil (next "a") nil (next "abc") '(\b \c) ; list (next ()) nil (next '(1)) nil (next '(1 2 3)) '(2 3) (next '(nil)) nil (next '(1 nil)) '(nil) (next '(1 ())) '(()) (next '(nil 2)) '(2) (next '(())) nil (next '(() nil)) '(nil) (next '(() 2 nil)) '(2 nil) ; vector (next []) nil (next [1]) nil (next [1 2 3]) [2 3] (next [nil]) nil (next [1 nil]) [nil] (next [1 []]) [[]] (next [nil 2]) [2] (next [[]]) nil (next [[] nil]) [nil] (next [[] 2 nil]) [2 nil] ; set (next #{}) nil (next #{1}) nil (next (sorted-set 1 2 3)) '(2 3) (next #{nil}) nil (next (sorted-set 1 nil)) '(1) (next (sorted-set nil 2)) '(2) (next #{#{}}) nil (next (sorted-set #{} nil)) '(#{}) ;(next (sorted-set #{} 2 nil)) #{} ; map (next {}) nil (next (sorted-map :a 1)) nil (next (sorted-map :a 1 :b 2 :c 3)) '((:b 2) (:c 3)) ; array (next (into-array [])) nil (next (into-array [1])) nil (next (into-array [1 2 3])) '(2 3) (next (to-array [nil])) nil (next (to-array [1 nil])) '(nil) ;(next (to-array [1 (into-array [])])) (list (into-array [])) (next (to-array [nil 2])) '(2) (next (to-array [(into-array [])])) nil (next (to-array [(into-array []) nil])) '(nil) (next (to-array [(into-array []) 2 nil])) '(2 nil) )) (deftest test-last (are [x y] (= x y) (last nil) nil ; list (last ()) nil (last '(1)) 1 (last '(1 2 3)) 3 (last '(nil)) nil (last '(1 nil)) nil (last '(nil 2)) 2 (last '(())) () (last '(() nil)) nil (last '(() 2 nil)) nil ; vector (last []) nil (last [1]) 1 (last [1 2 3]) 3 (last [nil]) nil (last [1 nil]) nil (last [nil 2]) 2 (last [[]]) [] (last [[] nil]) nil (last [[] 2 nil]) nil ; set (last #{}) nil (last #{1}) 1 (last (sorted-set 1 2 3)) 3 (last #{nil}) nil (last (sorted-set 1 nil)) 1 (last (sorted-set nil 2)) 2 (last #{#{}}) #{} (last (sorted-set #{} nil)) #{} ;(last (sorted-set #{} 2 nil)) nil ; map (last {}) nil (last (sorted-map :a 1)) [:a 1] (last (sorted-map :a 1 :b 2 :c 3)) [:c 3] ; string (last "") nil (last "a") \a (last "abc") \c ; array (last (into-array [])) nil (last (into-array [1])) 1 (last (into-array [1 2 3])) 3 (last (to-array [nil])) nil (last (to-array [1 nil])) nil (last (to-array [nil 2])) 2 )) ;; (ffirst coll) = (first (first coll)) ;; (deftest test-ffirst (is (thrown? IllegalArgumentException (ffirst))) (are [x y] (= x y) (ffirst nil) nil (ffirst ()) nil (ffirst '((1 2) (3 4))) 1 (ffirst []) nil (ffirst [[1 2] [3 4]]) 1 (ffirst {}) nil (ffirst {:a 1}) :a (ffirst #{}) nil (ffirst #{[1 2]}) 1 )) ;; (fnext coll) = (first (next coll)) = (second coll) ;; (deftest test-fnext (is (thrown? IllegalArgumentException (fnext))) (are [x y] (= x y) (fnext nil) nil (fnext ()) nil (fnext '(1)) nil (fnext '(1 2 3 4)) 2 (fnext []) nil (fnext [1]) nil (fnext [1 2 3 4]) 2 (fnext {}) nil (fnext (sorted-map :a 1)) nil (fnext (sorted-map :a 1 :b 2)) [:b 2] (fnext #{}) nil (fnext #{1}) nil (fnext (sorted-set 1 2 3 4)) 2 )) ;; (nfirst coll) = (next (first coll)) ;; (deftest test-nfirst (is (thrown? IllegalArgumentException (nfirst))) (are [x y] (= x y) (nfirst nil) nil (nfirst ()) nil (nfirst '((1 2 3) (4 5 6))) '(2 3) (nfirst []) nil (nfirst [[1 2 3] [4 5 6]]) '(2 3) (nfirst {}) nil (nfirst {:a 1}) '(1) (nfirst #{}) nil (nfirst #{[1 2]}) '(2) )) ;; (nnext coll) = (next (next coll)) ;; (deftest test-nnext (is (thrown? IllegalArgumentException (nnext))) (are [x y] (= x y) (nnext nil) nil (nnext ()) nil (nnext '(1)) nil (nnext '(1 2)) nil (nnext '(1 2 3 4)) '(3 4) (nnext []) nil (nnext [1]) nil (nnext [1 2]) nil (nnext [1 2 3 4]) '(3 4) (nnext {}) nil (nnext (sorted-map :a 1)) nil (nnext (sorted-map :a 1 :b 2)) nil (nnext (sorted-map :a 1 :b 2 :c 3 :d 4)) '([:c 3] [:d 4]) (nnext #{}) nil (nnext #{1}) nil (nnext (sorted-set 1 2)) nil (nnext (sorted-set 1 2 3 4)) '(3 4) )) (deftest test-nth ; maps, sets are not supported (is (thrown? UnsupportedOperationException (nth {} 0))) (is (thrown? UnsupportedOperationException (nth {:a 1 :b 2} 0))) (is (thrown? UnsupportedOperationException (nth #{} 0))) (is (thrown? UnsupportedOperationException (nth #{1 2 3} 0))) ; out of bounds (is (thrown? IndexOutOfBoundsException (nth '() 0))) (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) 5))) (is (thrown? IndexOutOfBoundsException (nth '() -1))) (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) -1))) (is (thrown? IndexOutOfBoundsException (nth [] 0))) (is (thrown? IndexOutOfBoundsException (nth [1 2 3] 5))) (is (thrown? IndexOutOfBoundsException (nth [] -1))) (is (thrown? IndexOutOfBoundsException (nth [1 2 3] -1))) ; ??? (is (thrown? IndexOutOfBoundsException (nth (into-array []) 0))) (is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) 5))) (is (thrown? IndexOutOfBoundsException (nth (into-array []) -1))) (is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) -1))) (is (thrown? StringIndexOutOfBoundsException (nth "" 0))) (is (thrown? StringIndexOutOfBoundsException (nth "abc" 5))) (is (thrown? StringIndexOutOfBoundsException (nth "" -1))) (is (thrown? StringIndexOutOfBoundsException (nth "abc" -1))) (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) 0))) (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) 5))) (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) -1))) ; ??? (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) -1))) ; ??? (are [x y] (= x y) (nth '(1) 0) 1 (nth '(1 2 3) 0) 1 (nth '(1 2 3 4 5) 1) 2 (nth '(1 2 3 4 5) 4) 5 (nth '(1 2 3) 5 :not-found) :not-found (nth [1] 0) 1 (nth [1 2 3] 0) 1 (nth [1 2 3 4 5] 1) 2 (nth [1 2 3 4 5] 4) 5 (nth [1 2 3] 5 :not-found) :not-found (nth (into-array [1]) 0) 1 (nth (into-array [1 2 3]) 0) 1 (nth (into-array [1 2 3 4 5]) 1) 2 (nth (into-array [1 2 3 4 5]) 4) 5 (nth (into-array [1 2 3]) 5 :not-found) :not-found (nth "a" 0) \a (nth "abc" 0) \a (nth "abcde" 1) \b (nth "abcde" 4) \e (nth "abc" 5 :not-found) :not-found (nth (java.util.ArrayList. [1]) 0) 1 (nth (java.util.ArrayList. [1 2 3]) 0) 1 (nth (java.util.ArrayList. [1 2 3 4 5]) 1) 2 (nth (java.util.ArrayList. [1 2 3 4 5]) 4) 5 (nth (java.util.ArrayList. [1 2 3]) 5 :not-found) :not-found ) ; regex Matchers (let [m (re-matcher #"(a)(b)" "ababaa")] (re-find m) ; => ["ab" "a" "b"] (are [x y] (= x y) (nth m 0) "ab" (nth m 1) "a" (nth m 2) "b" (nth m 3 :not-found) :not-found (nth m -1 :not-found) :not-found ) (is (thrown? IndexOutOfBoundsException (nth m 3))) (is (thrown? IndexOutOfBoundsException (nth m -1)))) (let [m (re-matcher #"c" "ababaa")] (re-find m) ; => nil (are [x y] (= x y) (nth m 0 :not-found) :not-found (nth m 2 :not-found) :not-found (nth m -1 :not-found) :not-found ) (is (thrown? IllegalStateException (nth m 0))) (is (thrown? IllegalStateException (nth m 2))) (is (thrown? IllegalStateException (nth m -1))))) ; distinct was broken for nil & false: ; fixed in rev 1278: ; http://code.google.com/p/clojure/source/detail?r=1278 ; (deftest test-distinct (are [x y] (= x y) (distinct ()) () (distinct '(1)) '(1) (distinct '(1 2 3)) '(1 2 3) (distinct '(1 2 3 1 1 1)) '(1 2 3) (distinct '(1 1 1 2)) '(1 2) (distinct '(1 2 1 2)) '(1 2) (distinct []) () (distinct [1]) '(1) (distinct [1 2 3]) '(1 2 3) (distinct [1 2 3 1 2 2 1 1]) '(1 2 3) (distinct [1 1 1 2]) '(1 2) (distinct [1 2 1 2]) '(1 2) (distinct "") () (distinct "a") '(\a) (distinct "abc") '(\a \b \c) (distinct "abcabab") '(\a \b \c) (distinct "aaab") '(\a \b) (distinct "abab") '(\a \b) ) (are [x] (= (distinct [x x]) [x]) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} )) (deftest test-interpose (are [x y] (= x y) (interpose 0 []) () (interpose 0 [1]) '(1) (interpose 0 [1 2]) '(1 0 2) (interpose 0 [1 2 3]) '(1 0 2 0 3) )) (deftest test-interleave (are [x y] (= x y) (interleave [1 2] [3 4]) '(1 3 2 4) (interleave [1] [3 4]) '(1 3) (interleave [1 2] [3]) '(1 3) (interleave [] [3 4]) () (interleave [1 2] []) () (interleave [] []) () )) (deftest test-zipmap (are [x y] (= x y) (zipmap [:a :b] [1 2]) {:a 1 :b 2} (zipmap [:a] [1 2]) {:a 1} (zipmap [:a :b] [1]) {:a 1} (zipmap [] [1 2]) {} (zipmap [:a :b] []) {} (zipmap [] []) {} )) (deftest test-concat (are [x y] (= x y) (concat) () (concat []) () (concat [1 2]) '(1 2) (concat [1 2] [3 4]) '(1 2 3 4) (concat [] [3 4]) '(3 4) (concat [1 2] []) '(1 2) (concat [] []) () (concat [1 2] [3 4] [5 6]) '(1 2 3 4 5 6) )) (deftest test-cycle (are [x y] (= x y) (cycle []) () (take 3 (cycle [1])) '(1 1 1) (take 5 (cycle [1 2 3])) '(1 2 3 1 2) (take 3 (cycle [nil])) '(nil nil nil) )) (deftest test-partition (are [x y] (= x y) (partition 2 [1 2 3]) '((1 2)) (partition 2 [1 2 3 4]) '((1 2) (3 4)) (partition 2 []) () (partition 2 3 [1 2 3 4 5 6 7]) '((1 2) (4 5)) (partition 2 3 [1 2 3 4 5 6 7 8]) '((1 2) (4 5) (7 8)) (partition 2 3 []) () (partition 1 []) () (partition 1 [1 2 3]) '((1) (2) (3)) (partition 5 [1 2 3]) () ; (partition 0 [1 2 3]) (repeat nil) ; infinite sequence of nil (partition -1 [1 2 3]) () (partition -2 [1 2 3]) () )) (deftest test-reverse (are [x y] (= x y) (reverse nil) () ; since SVN 1294 (reverse []) () (reverse [1]) '(1) (reverse [1 2 3]) '(3 2 1) )) (deftest test-take (are [x y] (= x y) (take 1 [1 2 3 4 5]) '(1) (take 3 [1 2 3 4 5]) '(1 2 3) (take 5 [1 2 3 4 5]) '(1 2 3 4 5) (take 9 [1 2 3 4 5]) '(1 2 3 4 5) (take 0 [1 2 3 4 5]) () (take -1 [1 2 3 4 5]) () (take -2 [1 2 3 4 5]) () )) (deftest test-drop (are [x y] (= x y) (drop 1 [1 2 3 4 5]) '(2 3 4 5) (drop 3 [1 2 3 4 5]) '(4 5) (drop 5 [1 2 3 4 5]) () (drop 9 [1 2 3 4 5]) () (drop 0 [1 2 3 4 5]) '(1 2 3 4 5) (drop -1 [1 2 3 4 5]) '(1 2 3 4 5) (drop -2 [1 2 3 4 5]) '(1 2 3 4 5) )) (deftest test-take-nth (are [x y] (= x y) (take-nth 1 [1 2 3 4 5]) '(1 2 3 4 5) (take-nth 2 [1 2 3 4 5]) '(1 3 5) (take-nth 3 [1 2 3 4 5]) '(1 4) (take-nth 4 [1 2 3 4 5]) '(1 5) (take-nth 5 [1 2 3 4 5]) '(1) (take-nth 9 [1 2 3 4 5]) '(1) ; infinite seq of 1s = (repeat 1) ;(take-nth 0 [1 2 3 4 5]) ;(take-nth -1 [1 2 3 4 5]) ;(take-nth -2 [1 2 3 4 5]) )) (deftest test-take-while (are [x y] (= x y) (take-while pos? []) () (take-while pos? [1 2 3 4]) '(1 2 3 4) (take-while pos? [1 2 3 -1]) '(1 2 3) (take-while pos? [1 -1 2 3]) '(1) (take-while pos? [-1 1 2 3]) () (take-while pos? [-1 -2 -3]) () )) (deftest test-drop-while (are [x y] (= x y) (drop-while pos? []) () (drop-while pos? [1 2 3 4]) () (drop-while pos? [1 2 3 -1]) '(-1) (drop-while pos? [1 -1 2 3]) '(-1 2 3) (drop-while pos? [-1 1 2 3]) '(-1 1 2 3) (drop-while pos? [-1 -2 -3]) '(-1 -2 -3) )) (deftest test-butlast (are [x y] (= x y) (butlast []) nil (butlast [1]) nil (butlast [1 2 3]) '(1 2) )) (deftest test-drop-last (are [x y] (= x y) ; as butlast (drop-last []) () (drop-last [1]) () (drop-last [1 2 3]) '(1 2) ; as butlast, but lazy (drop-last 1 []) () (drop-last 1 [1]) () (drop-last 1 [1 2 3]) '(1 2) (drop-last 2 []) () (drop-last 2 [1]) () (drop-last 2 [1 2 3]) '(1) (drop-last 5 []) () (drop-last 5 [1]) () (drop-last 5 [1 2 3]) () (drop-last 0 []) () (drop-last 0 [1]) '(1) (drop-last 0 [1 2 3]) '(1 2 3) (drop-last -1 []) () (drop-last -1 [1]) '(1) (drop-last -1 [1 2 3]) '(1 2 3) (drop-last -2 []) () (drop-last -2 [1]) '(1) (drop-last -2 [1 2 3]) '(1 2 3) )) (deftest test-split-at (is (vector? (split-at 2 []))) (is (vector? (split-at 2 [1 2 3]))) (are [x y] (= x y) (split-at 2 []) [() ()] (split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)] (split-at 5 [1 2 3]) [(list 1 2 3) ()] (split-at 0 [1 2 3]) [() (list 1 2 3)] (split-at -1 [1 2 3]) [() (list 1 2 3)] (split-at -5 [1 2 3]) [() (list 1 2 3)] )) (deftest test-split-with (is (vector? (split-with pos? []))) (is (vector? (split-with pos? [1 2 -1 0 3 4]))) (are [x y] (= x y) (split-with pos? []) [() ()] (split-with pos? [1 2 -1 0 3 4]) [(list 1 2) (list -1 0 3 4)] (split-with pos? [-1 2 3 4 5]) [() (list -1 2 3 4 5)] (split-with number? [1 -2 "abc" \x]) [(list 1 -2) (list "abc" \x)] )) (deftest test-repeat (is (thrown? IllegalArgumentException (repeat))) ; infinite sequence => use take (are [x y] (= x y) (take 0 (repeat 7)) () (take 1 (repeat 7)) '(7) (take 2 (repeat 7)) '(7 7) (take 5 (repeat 7)) '(7 7 7 7 7) ) ; limited sequence (are [x y] (= x y) (repeat 0 7) () (repeat 1 7) '(7) (repeat 2 7) '(7 7) (repeat 5 7) '(7 7 7 7 7) (repeat -1 7) () (repeat -3 7) () ) ; test different data types (are [x] (= (repeat 3 x) (list x x x)) nil false true 0 42 0.0 3.14 2/3 0M 1M \c "" "abc" 'sym :kw () '(1 2) [] [1 2] {} {:a 1 :b 2} #{} #{1 2} )) (deftest test-range (are [x y] (= x y) (range 0) () ; exclusive end! (range 1) '(0) (range 5) '(0 1 2 3 4) (range -1) () (range -3) () (range 2.5) '(0 1 2) (range 7/3) '(0 1 2) (range 0 3) '(0 1 2) (range 0 1) '(0) (range 0 0) () (range 0 -3) () (range 3 6) '(3 4 5) (range 3 4) '(3) (range 3 3) () (range 3 1) () (range 3 0) () (range 3 -2) () (range -2 5) '(-2 -1 0 1 2 3 4) (range -2 0) '(-2 -1) (range -2 -1) '(-2) (range -2 -2) () (range -2 -5) () (range 3 9 0) () (range 3 9 1) '(3 4 5 6 7 8) (range 3 9 2) '(3 5 7) (range 3 9 3) '(3 6) (range 3 9 10) '(3) (range 3 9 -1) () )) (deftest test-empty? (are [x] (empty? x) nil () (lazy-seq nil) ; => () [] {} #{} "" (into-array []) ) (are [x] (not (empty? x)) '(1 2) (lazy-seq [1 2]) [1 2] {:a 1 :b 2} #{1 2} "abc" (into-array [1 2]) )) (deftest test-every? ; always true for nil or empty coll/seq (are [x] (= (every? pos? x) true) nil () [] {} #{} (lazy-seq []) (into-array []) ) (are [x y] (= x y) true (every? pos? [1]) true (every? pos? [1 2]) true (every? pos? [1 2 3 4 5]) false (every? pos? [-1]) false (every? pos? [-1 -2]) false (every? pos? [-1 -2 3]) false (every? pos? [-1 2]) false (every? pos? [1 -2]) false (every? pos? [1 2 -3]) false (every? pos? [1 2 -3 4]) ) (are [x y] (= x y) true (every? #{:a} [:a :a]) ;! false (every? #{:a} [:a :b]) ; Issue 68: every? returns nil instead of false ;! false (every? #{:a} [:b :b]) ; http://code.google.com/p/clojure/issues/detail?id=68 )) (deftest test-not-every? ; always false for nil or empty coll/seq (are [x] (= (not-every? pos? x) false) nil () [] {} #{} (lazy-seq []) (into-array []) ) (are [x y] (= x y) false (not-every? pos? [1]) false (not-every? pos? [1 2]) false (not-every? pos? [1 2 3 4 5]) true (not-every? pos? [-1]) true (not-every? pos? [-1 -2]) true (not-every? pos? [-1 -2 3]) true (not-every? pos? [-1 2]) true (not-every? pos? [1 -2]) true (not-every? pos? [1 2 -3]) true (not-every? pos? [1 2 -3 4]) ) (are [x y] (= x y) false (not-every? #{:a} [:a :a]) true (not-every? #{:a} [:a :b]) true (not-every? #{:a} [:b :b]) )) (deftest test-not-any? ; always true for nil or empty coll/seq (are [x] (= (not-any? pos? x) true) nil () [] {} #{} (lazy-seq []) (into-array []) ) (are [x y] (= x y) false (not-any? pos? [1]) false (not-any? pos? [1 2]) false (not-any? pos? [1 2 3 4 5]) true (not-any? pos? [-1]) true (not-any? pos? [-1 -2]) false (not-any? pos? [-1 -2 3]) false (not-any? pos? [-1 2]) false (not-any? pos? [1 -2]) false (not-any? pos? [1 2 -3]) false (not-any? pos? [1 2 -3 4]) ) (are [x y] (= x y) false (not-any? #{:a} [:a :a]) false (not-any? #{:a} [:a :b]) true (not-any? #{:a} [:b :b]) )) (deftest test-some ;; always nil for nil or empty coll/seq (are [x] (= (some pos? x) nil) nil () [] {} #{} (lazy-seq []) (into-array [])) (are [x y] (= x y) nil (some nil nil) true (some pos? [1]) true (some pos? [1 2]) nil (some pos? [-1]) nil (some pos? [-1 -2]) true (some pos? [-1 2]) true (some pos? [1 -2]) :a (some #{:a} [:a :a]) :a (some #{:a} [:b :a]) nil (some #{:a} [:b :b]) :a (some #{:a} '(:a :b)) :a (some #{:a} #{:a :b}) )) (deftest test-flatten-present (are [expected nested-val] (= (flatten nested-val) expected) ;simple literals [] nil [] 1 [] 'test [] :keyword [] 1/2 [] #"[\r\n]" [] true [] false ;vectors [1 2 3 4 5] [[1 2] [3 4 [5]]] [1 2 3 4 5] [1 2 3 4 5] [#{1 2} 3 4 5] [#{1 2} 3 4 5] ;sets [] #{} [] #{#{1 2} 3 4 5} [] #{1 2 3 4 5} [] #{#{1 2} 3 4 5} ;lists [] '() [1 2 3 4 5] `(1 2 3 4 5) ;maps [] {:a 1 :b 2} [:a 1 :b 2] (seq {:a 1 :b 2}) [] {[:a :b] 1 :c 2} [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2}) [:a 1 2 :b 3] (seq {:a [1 2] :b 3}) ;Strings [] "12345" [\1 \2 \3 \4 \5] (seq "12345") ;fns [] count [count even? odd?] [count even? odd?])) (deftest test-group-by (is (= (group-by even? [1 2 3 4 5]) {false [1 3 5], true [2 4]}))) (deftest test-partition-by (are [test-seq] (= (partition-by (comp even? count) test-seq) [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]]) ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"] '("a" "bb" "cccc" "dd" "eee" "f" "" "hh")) (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm") [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]]))) (deftest test-frequencies (are [expected test-seq] (= (frequencies test-seq) expected) {\p 2, \s 4, \i 4, \m 1} "mississippi" {1 4 2 2 3 1} [1 1 1 1 2 2 3] {1 4 2 2 3 1} '(1 1 1 1 2 2 3))) (deftest test-reductions (is (= (reductions + nil) [0])) (is (= (reductions + [1 2 3 4 5]) [1 3 6 10 15])) (is (= (reductions + 10 [1 2 3 4 5]) [10 11 13 16 20 25]))) (deftest test-rand-nth-invariants (let [elt (rand-nth [:a :b :c :d])] (is (#{:a :b :c :d} elt)))) (deftest test-partition-all (is (= (partition-all 4 [1 2 3 4 5 6 7 8 9]) [[1 2 3 4] [5 6 7 8] [9]])) (is (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9]) [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]]))) (deftest test-shuffle-invariants (is (= (count (shuffle [1 2 3 4])) 4)) (let [shuffled-seq (shuffle [1 2 3 4])] (is (every? #{1 2 3 4} shuffled-seq)))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/serialization.clj000066400000000000000000000102341157562347600260520ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Chas Emerick ;; cemerick@snowtide.com (ns clojure.test-clojure.serialization (:use clojure.test) (:import (java.io ObjectOutputStream ObjectInputStream ByteArrayOutputStream ByteArrayInputStream))) (defn- serialize "Serializes a single object, returning a byte array." [v] (with-open [bout (ByteArrayOutputStream.) oos (ObjectOutputStream. bout)] (.writeObject oos v) (.flush oos) (.toByteArray bout))) (defn- deserialize "Deserializes and returns a single object from the given byte array." [bytes] (with-open [ois (-> bytes ByteArrayInputStream. ObjectInputStream.)] (.readObject ois))) (defrecord SerializationRecord [a b c]) (defstruct SerializationStruct :a :b :c) (defn- build-via-transient [coll] (persistent! (reduce conj! (transient coll) (map vec (partition 2 (range 1000)))))) (defn- roundtrip [v] (let [rt (-> v serialize deserialize) rt-seq (-> v seq serialize deserialize)] (and (= v rt) (= (seq v) (seq rt)) (= (seq v) rt-seq)))) (deftest sequable-serialization (are [val] (roundtrip val) ; lists and related (list) (apply list (range 10)) (cons 0 nil) (clojure.lang.Cons. 0 nil) ; vectors [] (into [] (range 10)) (into [] (range 25)) (into [] (range 100)) (into [] (range 500)) (into [] (range 1000)) ; maps {} {:a 5 :b 0} (apply array-map (range 100)) (apply hash-map (range 100)) ; sets #{} #{'a 'b 'c} (set (range 10)) (set (range 25)) (set (range 100)) (set (range 500)) (set (range 1000)) (sorted-set) (sorted-set 'a 'b 'c) (apply sorted-set (reverse (range 10))) (apply sorted-set (reverse (range 25))) (apply sorted-set (reverse (range 100))) (apply sorted-set (reverse (range 500))) (apply sorted-set (reverse (range 1000))) ; queues clojure.lang.PersistentQueue/EMPTY (into clojure.lang.PersistentQueue/EMPTY (range 50)) ; lazy seqs (lazy-seq nil) (lazy-seq (range 50)) ; transient / persistent! round-trip (build-via-transient []) (build-via-transient {}) (build-via-transient #{}) ; array-seqs (seq (make-array Object 10)) (seq (make-array Boolean/TYPE 10)) (seq (make-array Byte/TYPE 10)) (seq (make-array Character/TYPE 10)) (seq (make-array Double/TYPE 10)) (seq (make-array Float/TYPE 10)) (seq (make-array Integer/TYPE 10)) (seq (make-array Long/TYPE 10)) ; "records" (SerializationRecord. 0 :foo (range 20)) (struct SerializationStruct 0 :foo (range 20)) ; misc seqs (seq "s11n") (range 50) (rseq (apply sorted-set (reverse (range 100)))))) (deftest misc-serialization (are [v] (= v (-> v serialize deserialize)) 25/3 :keyword ::namespaced-keyword 'symbol)) (deftest interned-serializations (are [v] (identical? v (-> v serialize deserialize)) clojure.lang.RT/DEFAULT_COMPARATOR ; namespaces just get deserialized back into the same-named ns in the present runtime ; (they're referred to by defrecord instances) *ns*)) (deftest function-serialization (let [capture 5] (are [f] (= capture ((-> f serialize deserialize))) (constantly 5) (fn [] 5) #(do 5) (constantly capture) (fn [] capture) #(do capture)))) (deftest check-unserializable-objects (are [t] (thrown? java.io.NotSerializableException (serialize t)) ;; transients (transient []) (transient {}) (transient #{}) ;; reference types (atom nil) (ref nil) (agent nil) #'+ ;; stateful seqs (enumeration-seq (java.util.Collections/enumeration (range 50))) (iterator-seq (.iterator (range 50)))))clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/special.clj000066400000000000000000000012361157562347600246170ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka ;; ;; Test special forms, macros and metadata ;; (ns clojure.test-clojure.special (:use clojure.test)) ; http://clojure.org/special_forms ; let, letfn ; quote ; var ; fn clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/string.clj000066400000000000000000000072201157562347600245040ustar00rootroot00000000000000(ns clojure.test-clojure.string (:require [clojure.string :as s]) (:use clojure.test)) (deftest t-split (is (= ["a" "b"] (s/split "a-b" #"-"))) (is (= ["a" "b-c"] (s/split "a-b-c" #"-" 2))) (is (vector? (s/split "abc" #"-")))) (deftest t-reverse (is (= "tab" (s/reverse "bat")))) (deftest t-replace (is (= "faabar" (s/replace "foobar" \o \a))) (is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar"))) (is (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case)))) (deftest t-replace-first (is (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar"))) (is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar"))) (is (= "z.ology" (s/replace-first "zoology" \o \.))) (is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case)))) (deftest t-join (are [x coll] (= x (s/join coll)) "" nil "" [] "1" [1] "12" [1 2]) (are [x sep coll] (= x (s/join sep coll)) "1,2,3" \, [1 2 3] "" \, [] "1" \, [1] "1 and-a 2 and-a 3" " and-a " [1 2 3])) (deftest t-trim-newline (is (= "foo" (s/trim-newline "foo\n"))) (is (= "foo" (s/trim-newline "foo\r\n"))) (is (= "foo" (s/trim-newline "foo"))) (is (= "" (s/trim-newline "")))) (deftest t-capitalize (is (= "Foobar" (s/capitalize "foobar"))) (is (= "Foobar" (s/capitalize "FOOBAR")))) (deftest t-triml (is (= "foo " (s/triml " foo "))) (is (= "" (s/triml " ")))) (deftest t-trimr (is (= " foo" (s/trimr " foo "))) (is (= "" (s/trimr " ")))) (deftest t-trim (is (= "foo" (s/trim " foo \r\n")))) (deftest t-upper-case (is (= "FOOBAR" (s/upper-case "Foobar")))) (deftest t-lower-case (is (= "foobar" (s/lower-case "FooBar")))) (deftest nil-handling (are [f args] (thrown? NullPointerException (apply f args)) s/reverse [nil] s/replace [nil #"foo" "bar"] s/replace-first [nil #"foo" "bar"] s/capitalize [nil] s/upper-case [nil] s/lower-case [nil] s/split [nil #"-"] s/split [nil #"-" 1] s/trim [nil] s/triml [nil] s/trimr [nil] s/trim-newline [nil])) (deftest char-sequence-handling (are [result f args] (let [[^CharSequence s & more] args] (= result (apply f (StringBuffer. s) more))) "paz" s/reverse ["zap"] "foo:bar" s/replace ["foo-bar" \- \:] "ABC" s/replace ["abc" #"\w" s/upper-case] "faa" s/replace ["foo" #"o" (StringBuffer. "a")] "baz::quux" s/replace-first ["baz--quux" #"--" "::"] "baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")] "zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")] "Pow" s/capitalize ["POW"] "BOOM" s/upper-case ["boom"] "whimper" s/lower-case ["whimPER"] ["foo" "bar"] s/split ["foo-bar" #"-"] "calvino" s/trim [" calvino "] "calvino " s/triml [" calvino "] " calvino" s/trimr [" calvino "] "the end" s/trim-newline ["the end\r\n\r\r\n"] true s/blank? [" "] ["a" "b"] s/split-lines ["a\nb"] "fa la la" s/escape ["fo lo lo" {\o \a}])) (deftest t-escape (is (= "<foo&bar>" (s/escape "" {\& "&" \< "<" \> ">"}))) (is (= " \\\"foo\\\" " (s/escape " \"foo\" " {\" "\\\""}))) (is (= "faabor" (s/escape "foobar" {\a \o, \o \a})))) (deftest t-blank (is (s/blank? nil)) (is (s/blank? "")) (is (s/blank? " ")) (is (s/blank? " \t \n \r ")) (is (not (s/blank? " foo ")))) (deftest t-split-lines (let [result (s/split-lines "one\ntwo\r\nthree")] (is (= ["one" "two" "three"] result)) (is (vector? result))) (is (= (list "foo") (s/split-lines "foo")))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/test.clj000066400000000000000000000074771157562347600241730ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; test_clojure/test.clj: unit tests for test.clj ;; by Stuart Sierra ;; January 16, 2009 ;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for ;; contributions and suggestions. (ns clojure.test-clojure.test (:use clojure.test)) (deftest can-test-symbol (let [x true] (is x "Should pass")) (let [x false] (is x "Should fail"))) (deftest can-test-boolean (is true "Should pass") (is false "Should fail")) (deftest can-test-nil (is nil "Should fail")) (deftest can-test-= (is (= 2 (+ 1 1)) "Should pass") (is (= 3 (+ 2 2)) "Should fail")) (deftest can-test-instance (is (instance? Integer (+ 2 2)) "Should pass") (is (instance? Float (+ 1 1)) "Should fail")) (deftest can-test-thrown (is (thrown? ArithmeticException (/ 1 0)) "Should pass") ;; No exception is thrown: (is (thrown? Exception (+ 1 1)) "Should fail") ;; Wrong class of exception is thrown: (is (thrown? ArithmeticException (throw (RuntimeException.))) "Should error")) (deftest can-test-thrown-with-msg (is (thrown-with-msg? ArithmeticException #"Divide by zero" (/ 1 0)) "Should pass") ;; Wrong message string: (is (thrown-with-msg? ArithmeticException #"Something else" (/ 1 0)) "Should fail") ;; No exception is thrown: (is (thrown? Exception (+ 1 1)) "Should fail") ;; Wrong class of exception is thrown: (is (thrown-with-msg? IllegalArgumentException #"Divide by zero" (/ 1 0)) "Should error")) (deftest can-catch-unexpected-exceptions (is (= 1 (throw (Exception.))) "Should error")) (deftest can-test-method-call (is (.startsWith "abc" "a") "Should pass") (is (.startsWith "abc" "d") "Should fail")) (deftest can-test-anonymous-fn (is (#(.startsWith % "a") "abc") "Should pass") (is (#(.startsWith % "d") "abc") "Should fail")) (deftest can-test-regexps (is (re-matches #"^ab.*$" "abbabba") "Should pass") (is (re-matches #"^cd.*$" "abbabba") "Should fail") (is (re-find #"ab" "abbabba") "Should pass") (is (re-find #"cd" "abbabba") "Should fail")) (deftest #^{:has-meta true} can-add-metadata-to-tests (is (:has-meta (meta #'can-add-metadata-to-tests)) "Should pass")) ;; still have to declare the symbol before testing unbound symbols (declare does-not-exist) (deftest can-test-unbound-symbol (is (= nil does-not-exist) "Should error")) (deftest can-test-unbound-function (is (does-not-exist) "Should error")) ;; Here, we create an alternate version of test/report, that ;; compares the event with the message, then calls the original ;; 'report' with modified arguments. (declare original-report) (defn custom-report [data] (let [event (:type data) msg (:message data) expected (:expected data) actual (:actual data) passed (cond (= event :fail) (= msg "Should fail") (= event :pass) (= msg "Should pass") (= event :error) (= msg "Should error") :else true)] (if passed (original-report {:type :pass, :message msg, :expected expected, :actual actual}) (original-report {:type :fail, :message (str msg " but got " event) :expected expected, :actual actual})))) ;; test-ns-hook will be used by test/test-ns to run tests in this ;; namespace. (defn test-ns-hook [] (binding [original-report report report custom-report] (test-all-vars (find-ns 'clojure.test-clojure.test)))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/test_fixtures.clj000066400000000000000000000023361157562347600261110ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; ;;; test_fixtures.clj: unit tests for fixtures in test.clj ;; by Stuart Sierra ;; March 28, 2009 (ns clojure.test-clojure.test-fixtures (:use clojure.test)) (declare *a* *b* *c* *d*) (def *n* 0) (defn fixture-a [f] (binding [*a* 3] (f))) (defn fixture-b [f] (binding [*b* 5] (f))) (defn fixture-c [f] (binding [*c* 7] (f))) (defn fixture-d [f] (binding [*d* 11] (f))) (defn inc-n-fixture [f] (binding [*n* (inc *n*)] (f))) (use-fixtures :once fixture-a fixture-b) (use-fixtures :each fixture-c fixture-d inc-n-fixture) (use-fixtures :each fixture-c fixture-d inc-n-fixture) (deftest can-use-once-fixtures (is (= 3 *a*)) (is (= 5 *b*))) (deftest can-use-each-fixtures (is (= 7 *c*)) (is (= 11 *d*))) (deftest use-fixtures-replaces (is (= *n* 1)))clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/transients.clj000066400000000000000000000006621157562347600253730ustar00rootroot00000000000000(ns clojure.test-clojure.transients (:use clojure.test)) (deftest popping-off (testing "across a node boundary" (are [n] (let [v (-> (range n) vec)] (= (subvec v 0 (- n 2)) (-> v transient pop! pop! persistent!))) 33 (+ 32 (inc (* 32 32))) (+ 32 (inc (* 32 32 32))))) (testing "off the end" (is (thrown-with-msg? IllegalStateException #"Can't pop empty vector" (-> [] transient pop!))))) clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/vars.clj000066400000000000000000000035711157562347600241560ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Frantisek Sodomka, Stephen C. Gilardi (ns clojure.test-clojure.vars (:use clojure.test)) ; http://clojure.org/vars ; def ; defn defn- defonce ; declare intern binding find-var var (def a) (deftest test-binding (are [x y] (= x y) (eval `(binding [a 4] a)) 4 ; regression in Clojure SVN r1370 )) ; with-local-vars var-get var-set alter-var-root [var? (predicates.clj)] ; with-in-str with-out-str ; with-open ; with-precision (deftest test-with-precision (are [x y] (= x y) (with-precision 4 (+ 3.5555555M 1)) 4.556M (with-precision 6 (+ 3.5555555M 1)) 4.55556M (with-precision 6 :rounding CEILING (+ 3.5555555M 1)) 4.55556M (with-precision 6 :rounding FLOOR (+ 3.5555555M 1)) 4.55555M (with-precision 6 :rounding HALF_UP (+ 3.5555555M 1)) 4.55556M (with-precision 6 :rounding HALF_DOWN (+ 3.5555555M 1)) 4.55556M (with-precision 6 :rounding HALF_EVEN (+ 3.5555555M 1)) 4.55556M (with-precision 6 :rounding UP (+ 3.5555555M 1)) 4.55556M (with-precision 6 :rounding DOWN (+ 3.5555555M 1)) 4.55555M (with-precision 6 :rounding UNNECESSARY (+ 3.5555M 1)) 4.5555M)) (deftest test-settable-math-context (is (= (clojure.main/with-bindings (set! *math-context* (java.math.MathContext. 8)) (+ 3.55555555555555M 1)) 4.5555556M))) ; set-validator get-validator ; doc find-doc test clojure1.2_1.2.1+dfsg.orig/test/clojure/test_clojure/vectors.clj000066400000000000000000000264231157562347600246710ustar00rootroot00000000000000; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Author: Stuart Halloway, Daniel Solano Gómez (ns clojure.test-clojure.vectors (:use clojure.test)) (deftest test-reversed-vec (let [r (range 6) v (into (vector-of :int) r) reversed (.rseq v)] (testing "returns the right impl" (is (= clojure.lang.APersistentVector$RSeq (class reversed)))) (testing "RSeq methods" (is (= [5 4 3 2 1 0] reversed)) (is (= 5 (.index reversed))) (is (= 5 (.first reversed))) (is (= [4 3 2 1 0] (.next reversed))) (is (= [3 2 1 0] (.. reversed next next))) (is (= 6 (.count reversed)))) (testing "clojure calling through" (is (= 5 (first reversed))) (is (= 5 (nth reversed 0)))) (testing "empty reverses to nil" (is (nil? (.. v empty rseq)))))) (deftest test-vecseq (let [r (range 100) vs (into (vector-of :int) r) vs-1 (next vs) vs-32 (.chunkedNext (seq vs))] (testing "=" (are [a b] (= a b) vs vs vs-1 vs-1 vs-32 vs-32) (are [a b] (not= a b) vs vs-1 vs-1 vs vs vs-32 vs-32 vs)) (testing "IPersistentCollection.empty" (are [a] (identical? clojure.lang.PersistentList/EMPTY (.empty (seq a))) vs vs-1 vs-32)) (testing "IPersistentCollection.cons" (are [result input] (= result (.cons input :foo)) [:foo 1] (seq (into (vector-of :int) [1])))) (testing "IPersistentCollection.count" (are [ct s] (= ct (.count (seq s))) 100 vs 99 vs-1 68 vs-32) ;; can't manufacture this scenario: ASeq defers to Counted, but ;; LazySeq doesn't, so Counted never gets checked on reified seq below #_(testing "hops to counted when available" (is (= 200 (.count (concat (seq vs) (reify clojure.lang.ISeq (seq [this] this) clojure.lang.Counted (count [_] 100)))))))) (testing "IPersistentCollection.equiv" (are [a b] (true? (.equiv a b)) vs vs vs-1 vs-1 vs-32 vs-32 vs r) (are [a b] (false? (.equiv a b)) vs vs-1 vs-1 vs vs vs-32 vs-32 vs vs nil)))) (deftest test-vec-compare (let [nums (range 1 100) ; randomly replaces a single item with the given value rand-replace (fn[val] (let [r (rand-int 99)] (concat (take r nums) [val] (drop (inc r) nums)))) ; all num sequences in map num-seqs {:standard nums :empty '() ; different lengths :longer (concat nums [100]) :shorter (drop-last nums) ; greater by value :first-greater (concat [100] (next nums)) :last-greater (concat (drop-last nums) [100]) :rand-greater-1 (rand-replace 100) :rand-greater-2 (rand-replace 100) :rand-greater-3 (rand-replace 100) ; lesser by value :first-lesser (concat [0] (next nums)) :last-lesser (concat (drop-last nums) [0]) :rand-lesser-1 (rand-replace 0) :rand-lesser-2 (rand-replace 0) :rand-lesser-3 (rand-replace 0)} ; a way to create compare values based on num-seqs create-vals (fn[base-val] (zipmap (keys num-seqs) (map #(into base-val %1) (vals num-seqs)))) ; Vecs made of int primitives int-vecs (create-vals (vector-of :int)) ; Vecs made of long primitives long-vecs (create-vals (vector-of :long)) ; standard boxing vectors regular-vecs (create-vals []) ; the standard int Vec for comparisons int-vec (:standard int-vecs)] (testing "compare" (testing "identical" (is (= 0 (compare int-vec int-vec)))) (testing "equivalent" (are [x y] (= 0 (compare x y)) ; standard int-vec (:standard long-vecs) (:standard long-vecs) int-vec int-vec (:standard regular-vecs) (:standard regular-vecs) int-vec ; empty (:empty int-vecs) (:empty long-vecs) (:empty long-vecs) (:empty int-vecs))) (testing "lesser" (are [x] (= -1 (compare int-vec x)) (:longer int-vecs) (:longer long-vecs) (:longer regular-vecs) (:first-greater int-vecs) (:first-greater long-vecs) (:first-greater regular-vecs) (:last-greater int-vecs) (:last-greater long-vecs) (:last-greater regular-vecs) (:rand-greater-1 int-vecs) (:rand-greater-1 long-vecs) (:rand-greater-1 regular-vecs) (:rand-greater-2 int-vecs) (:rand-greater-2 long-vecs) (:rand-greater-2 regular-vecs) (:rand-greater-3 int-vecs) (:rand-greater-3 long-vecs) (:rand-greater-3 regular-vecs)) (are [x] (= -1 (compare x int-vec)) nil (:empty int-vecs) (:empty long-vecs) (:empty regular-vecs) (:shorter int-vecs) (:shorter long-vecs) (:shorter regular-vecs) (:first-lesser int-vecs) (:first-lesser long-vecs) (:first-lesser regular-vecs) (:last-lesser int-vecs) (:last-lesser long-vecs) (:last-lesser regular-vecs) (:rand-lesser-1 int-vecs) (:rand-lesser-1 long-vecs) (:rand-lesser-1 regular-vecs) (:rand-lesser-2 int-vecs) (:rand-lesser-2 long-vecs) (:rand-lesser-2 regular-vecs) (:rand-lesser-3 int-vecs) (:rand-lesser-3 long-vecs) (:rand-lesser-3 regular-vecs))) (testing "greater" (are [x] (= 1 (compare int-vec x)) nil (:empty int-vecs) (:empty long-vecs) (:empty regular-vecs) (:shorter int-vecs) (:shorter long-vecs) (:shorter regular-vecs) (:first-lesser int-vecs) (:first-lesser long-vecs) (:first-lesser regular-vecs) (:last-lesser int-vecs) (:last-lesser long-vecs) (:last-lesser regular-vecs) (:rand-lesser-1 int-vecs) (:rand-lesser-1 long-vecs) (:rand-lesser-1 regular-vecs) (:rand-lesser-2 int-vecs) (:rand-lesser-2 long-vecs) (:rand-lesser-2 regular-vecs) (:rand-lesser-3 int-vecs) (:rand-lesser-3 long-vecs) (:rand-lesser-3 regular-vecs)) (are [x] (= 1 (compare x int-vec)) (:longer int-vecs) (:longer long-vecs) (:longer regular-vecs) (:first-greater int-vecs) (:first-greater long-vecs) (:first-greater regular-vecs) (:last-greater int-vecs) (:last-greater long-vecs) (:last-greater regular-vecs) (:rand-greater-1 int-vecs) (:rand-greater-1 long-vecs) (:rand-greater-1 regular-vecs) (:rand-greater-2 int-vecs) (:rand-greater-2 long-vecs) (:rand-greater-2 regular-vecs) (:rand-greater-3 int-vecs) (:rand-greater-3 long-vecs) (:rand-greater-3 regular-vecs)))) (testing "Comparable.compareTo" (testing "incompatible" (is (thrown? NullPointerException (.compareTo int-vec nil))) (are [x] (thrown? ClassCastException (.compareTo int-vec x)) '() {} #{} (sorted-set) (sorted-map) nums 1)) (testing "identical" (is (= 0 (.compareTo int-vec int-vec)))) (testing "equivalent" (are [x] (= 0 (.compareTo int-vec x)) (:standard long-vecs) (:standard regular-vecs))) (testing "lesser" (are [x] (= -1 (.compareTo int-vec x)) (:longer int-vecs) (:longer long-vecs) (:longer regular-vecs) (:first-greater int-vecs) (:first-greater long-vecs) (:first-greater regular-vecs) (:last-greater int-vecs) (:last-greater long-vecs) (:last-greater regular-vecs) (:rand-greater-1 int-vecs) (:rand-greater-1 long-vecs) (:rand-greater-1 regular-vecs) (:rand-greater-2 int-vecs) (:rand-greater-2 long-vecs) (:rand-greater-2 regular-vecs) (:rand-greater-3 int-vecs) (:rand-greater-3 long-vecs) (:rand-greater-3 regular-vecs))) (testing "greater" (are [x] (= 1 (.compareTo int-vec x)) (:empty int-vecs) (:empty long-vecs) (:empty regular-vecs) (:shorter int-vecs) (:shorter long-vecs) (:shorter regular-vecs) (:first-lesser int-vecs) (:first-lesser long-vecs) (:first-lesser regular-vecs) (:last-lesser int-vecs) (:last-lesser long-vecs) (:last-lesser regular-vecs) (:rand-lesser-1 int-vecs) (:rand-lesser-1 long-vecs) (:rand-lesser-1 regular-vecs) (:rand-lesser-2 int-vecs) (:rand-lesser-2 long-vecs) (:rand-lesser-2 regular-vecs) (:rand-lesser-3 int-vecs) (:rand-lesser-3 long-vecs) (:rand-lesser-3 regular-vecs)))))) (deftest test-vec-associative (let [empty-v (vector-of :long) v (into empty-v (range 1 6))] (testing "Associative.containsKey" (are [x] (.containsKey v x) 0 1 2 3 4) (are [x] (not (.containsKey v x)) -1 -100 nil [] "" #"" #{} 5 100) (are [x] (not (.containsKey empty-v x)) 0 1)) (testing "contains?" (are [x] (contains? v x) 0 2 4) (are [x] (not (contains? v x)) -1 -100 nil "" 5 100) (are [x] (not (contains? empty-v x)) 0 1)) (testing "Associative.entryAt" (are [idx val] (= (clojure.lang.MapEntry. idx val) (.entryAt v idx)) 0 1 2 3 4 5) (are [idx] (nil? (.entryAt v idx)) -5 -1 5 10 nil "") (are [idx] (nil? (.entryAt empty-v idx)) 0 1))))