changeset 10:ef7dbbd6452c

added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents 35cf337adfcf
children f952052e37b7
files src/clojure/asm/AnnotationVisitor.java src/clojure/asm/AnnotationWriter.java src/clojure/asm/Attribute.java src/clojure/asm/ByteVector.java src/clojure/asm/ClassAdapter.java src/clojure/asm/ClassReader.java src/clojure/asm/ClassVisitor.java src/clojure/asm/ClassWriter.java src/clojure/asm/Edge.java src/clojure/asm/FieldVisitor.java src/clojure/asm/FieldWriter.java src/clojure/asm/Frame.java src/clojure/asm/Handler.java src/clojure/asm/Item.java src/clojure/asm/Label.java src/clojure/asm/MethodAdapter.java src/clojure/asm/MethodVisitor.java src/clojure/asm/MethodWriter.java src/clojure/asm/Opcodes.java src/clojure/asm/Type.java src/clojure/asm/commons/AdviceAdapter.java src/clojure/asm/commons/AnalyzerAdapter.java src/clojure/asm/commons/CodeSizeEvaluator.java src/clojure/asm/commons/EmptyVisitor.java src/clojure/asm/commons/GeneratorAdapter.java src/clojure/asm/commons/LocalVariablesSorter.java src/clojure/asm/commons/Method.java src/clojure/asm/commons/SerialVersionUIDAdder.java src/clojure/asm/commons/StaticInitMerger.java src/clojure/asm/commons/TableSwitchGenerator.java src/clojure/asm/commons/package.html src/clojure/asm/package.html src/clojure/contrib/accumulators.clj src/clojure/contrib/agent_utils.clj src/clojure/contrib/apply_macro.clj src/clojure/contrib/base64.clj src/clojure/contrib/classpath.clj src/clojure/contrib/combinatorics.clj src/clojure/contrib/command_line.clj src/clojure/contrib/complex_numbers.clj src/clojure/contrib/cond.clj src/clojure/contrib/condition.clj src/clojure/contrib/condition/Condition.clj src/clojure/contrib/core.clj src/clojure/contrib/dataflow.clj src/clojure/contrib/datalog.clj src/clojure/contrib/datalog/database.clj src/clojure/contrib/datalog/literals.clj src/clojure/contrib/datalog/magic.clj src/clojure/contrib/datalog/rules.clj src/clojure/contrib/datalog/softstrat.clj src/clojure/contrib/datalog/util.clj src/clojure/contrib/def.clj src/clojure/contrib/duck_streams.clj src/clojure/contrib/error_kit.clj src/clojure/contrib/except.clj src/clojure/contrib/fcase.clj src/clojure/contrib/find_namespaces.clj src/clojure/contrib/fnmap.clj src/clojure/contrib/fnmap/PersistentFnMap.clj src/clojure/contrib/gen_html_docs.clj src/clojure/contrib/generic.clj src/clojure/contrib/generic/arithmetic.clj src/clojure/contrib/generic/collection.clj src/clojure/contrib/generic/comparison.clj src/clojure/contrib/generic/functor.clj src/clojure/contrib/generic/math_functions.clj src/clojure/contrib/graph.clj src/clojure/contrib/greatest_least.clj src/clojure/contrib/http/agent.clj src/clojure/contrib/http/connection.clj src/clojure/contrib/import_static.clj src/clojure/contrib/io.clj src/clojure/contrib/jar.clj src/clojure/contrib/java_utils.clj src/clojure/contrib/javadoc.clj src/clojure/contrib/javadoc/browse.clj src/clojure/contrib/javadoc/browse_ui.clj src/clojure/contrib/jmx.clj src/clojure/contrib/jmx/Bean.clj src/clojure/contrib/jmx/client.clj src/clojure/contrib/jmx/data.clj src/clojure/contrib/jmx/server.clj src/clojure/contrib/json.clj src/clojure/contrib/lazy_seqs.clj src/clojure/contrib/lazy_xml.clj src/clojure/contrib/lazy_xml/with_pull.clj src/clojure/contrib/logging.clj src/clojure/contrib/macro_utils.clj src/clojure/contrib/macros.clj src/clojure/contrib/map_utils.clj src/clojure/contrib/math.clj src/clojure/contrib/miglayout.clj src/clojure/contrib/miglayout/internal.clj src/clojure/contrib/mmap.clj src/clojure/contrib/mock.clj src/clojure/contrib/mock.clj.rej src/clojure/contrib/mock/test_adapter.clj src/clojure/contrib/monadic_io_streams.clj src/clojure/contrib/monads.clj src/clojure/contrib/ns_utils.clj src/clojure/contrib/pprint.clj src/clojure/contrib/pprint/cl_format.clj src/clojure/contrib/pprint/column_writer.clj src/clojure/contrib/pprint/dispatch.clj src/clojure/contrib/pprint/pprint_base.clj src/clojure/contrib/pprint/pretty_writer.clj src/clojure/contrib/pprint/utilities.clj src/clojure/contrib/probabilities/finite_distributions.clj src/clojure/contrib/probabilities/monte_carlo.clj src/clojure/contrib/probabilities/random_numbers.clj src/clojure/contrib/profile.clj src/clojure/contrib/properties.clj src/clojure/contrib/prxml.clj src/clojure/contrib/reflect.clj src/clojure/contrib/repl_ln.clj src/clojure/contrib/repl_utils.clj src/clojure/contrib/repl_utils/javadoc.clj src/clojure/contrib/seq.clj src/clojure/contrib/seq_utils.clj src/clojure/contrib/server_socket.clj src/clojure/contrib/set.clj src/clojure/contrib/shell.clj src/clojure/contrib/shell_out.clj src/clojure/contrib/singleton.clj src/clojure/contrib/sql.clj src/clojure/contrib/sql/internal.clj src/clojure/contrib/str_utils.clj src/clojure/contrib/str_utils2.clj src/clojure/contrib/stream_utils.clj src/clojure/contrib/string.clj src/clojure/contrib/strint.clj src/clojure/contrib/swing_utils.clj src/clojure/contrib/test_contrib/accumulators/examples.clj src/clojure/contrib/test_contrib/condition/example.clj src/clojure/contrib/test_contrib/datalog/example.clj src/clojure/contrib/test_contrib/datalog/tests/test.clj src/clojure/contrib/test_contrib/datalog/tests/test_database.clj src/clojure/contrib/test_contrib/datalog/tests/test_literals.clj src/clojure/contrib/test_contrib/datalog/tests/test_magic.clj src/clojure/contrib/test_contrib/datalog/tests/test_rules.clj src/clojure/contrib/test_contrib/datalog/tests/test_softstrat.clj src/clojure/contrib/test_contrib/datalog/tests/test_util.clj src/clojure/contrib/test_contrib/miglayout/example.clj src/clojure/contrib/test_contrib/mock/test_adapter.clj src/clojure/contrib/test_contrib/monads/examples.clj src/clojure/contrib/test_contrib/pprint/examples/hexdump.clj src/clojure/contrib/test_contrib/pprint/examples/json.clj src/clojure/contrib/test_contrib/pprint/examples/multiply.clj src/clojure/contrib/test_contrib/pprint/examples/props.clj src/clojure/contrib/test_contrib/pprint/examples/show_doc.clj src/clojure/contrib/test_contrib/pprint/examples/xml.clj src/clojure/contrib/test_contrib/pprint/test_cl_format.clj src/clojure/contrib/test_contrib/pprint/test_helper.clj src/clojure/contrib/test_contrib/pprint/test_pretty.clj src/clojure/contrib/test_contrib/probabilities/examples_finite_distributions.clj src/clojure/contrib/test_contrib/probabilities/examples_monte_carlo.clj src/clojure/contrib/test_contrib/stream_utils/examples.clj src/clojure/contrib/test_contrib/test_complex_numbers.clj src/clojure/contrib/test_contrib/test_core.clj src/clojure/contrib/test_contrib/test_dataflow.clj src/clojure/contrib/test_contrib/test_def.clj src/clojure/contrib/test_contrib/test_fnmap.clj src/clojure/contrib/test_contrib/test_graph.clj src/clojure/contrib/test_contrib/test_greatest_least.clj src/clojure/contrib/test_contrib/test_io.clj src/clojure/contrib/test_contrib/test_jmx.clj src/clojure/contrib/test_contrib/test_json.clj src/clojure/contrib/test_contrib/test_lazy_seqs.clj src/clojure/contrib/test_contrib/test_load_all.clj src/clojure/contrib/test_contrib/test_macro_utils.clj src/clojure/contrib/test_contrib/test_math.clj src/clojure/contrib/test_contrib/test_miglayout.clj src/clojure/contrib/test_contrib/test_mock.clj src/clojure/contrib/test_contrib/test_monads.clj src/clojure/contrib/test_contrib/test_profile.clj src/clojure/contrib/test_contrib/test_properties.clj src/clojure/contrib/test_contrib/test_prxml.clj src/clojure/contrib/test_contrib/test_repl_utils.clj src/clojure/contrib/test_contrib/test_seq.clj src/clojure/contrib/test_contrib/test_shell.clj src/clojure/contrib/test_contrib/test_sql.clj src/clojure/contrib/test_contrib/test_string.clj src/clojure/contrib/test_contrib/test_strint.clj src/clojure/contrib/test_contrib/test_trace.clj src/clojure/contrib/test_contrib/test_with_ns.clj src/clojure/contrib/test_contrib/types/examples.clj src/clojure/contrib/test_is.clj src/clojure/contrib/trace.clj src/clojure/contrib/types.clj src/clojure/contrib/with_ns.clj src/clojure/contrib/zip_filter.clj src/clojure/contrib/zip_filter/xml.clj src/clojure/core.clj src/clojure/core/protocols.clj src/clojure/core_deftype.clj src/clojure/core_print.clj src/clojure/core_proxy.clj src/clojure/genclass.clj src/clojure/gvec.clj src/clojure/inspector.clj src/clojure/java/browse.clj src/clojure/java/browse_ui.clj src/clojure/java/io.clj src/clojure/java/javadoc.clj src/clojure/java/shell.clj src/clojure/lang/AFn.java src/clojure/lang/AFunction.java src/clojure/lang/AMapEntry.java src/clojure/lang/APersistentMap.java src/clojure/lang/APersistentSet.java src/clojure/lang/APersistentVector.java src/clojure/lang/ARef.java src/clojure/lang/AReference.java src/clojure/lang/ASeq.java src/clojure/lang/ATransientMap.java src/clojure/lang/ATransientSet.java src/clojure/lang/Agent.java src/clojure/lang/ArrayChunk.java src/clojure/lang/ArraySeq.java src/clojure/lang/Associative.java src/clojure/lang/Atom.java src/clojure/lang/Binding.java src/clojure/lang/Box.java src/clojure/lang/ChunkBuffer.java src/clojure/lang/ChunkedCons.java src/clojure/lang/Compile.java src/clojure/lang/Compiler.java src/clojure/lang/Cons.java src/clojure/lang/Counted.java src/clojure/lang/Delay.java src/clojure/lang/DynamicClassLoader.java src/clojure/lang/EnumerationSeq.java src/clojure/lang/Fn.java src/clojure/lang/IChunk.java src/clojure/lang/IChunkedSeq.java src/clojure/lang/IDeref.java src/clojure/lang/IEditableCollection.java src/clojure/lang/IFn.java src/clojure/lang/IKeywordLookup.java src/clojure/lang/ILookup.java src/clojure/lang/ILookupHost.java src/clojure/lang/ILookupSite.java src/clojure/lang/ILookupThunk.java src/clojure/lang/IMapEntry.java src/clojure/lang/IMeta.java src/clojure/lang/IObj.java src/clojure/lang/IPersistentCollection.java src/clojure/lang/IPersistentList.java src/clojure/lang/IPersistentMap.java src/clojure/lang/IPersistentSet.java src/clojure/lang/IPersistentStack.java src/clojure/lang/IPersistentVector.java src/clojure/lang/IProxy.java src/clojure/lang/IReduce.java src/clojure/lang/IRef.java src/clojure/lang/IReference.java src/clojure/lang/ISeq.java src/clojure/lang/ITransientAssociative.java src/clojure/lang/ITransientCollection.java src/clojure/lang/ITransientMap.java src/clojure/lang/ITransientSet.java src/clojure/lang/ITransientVector.java src/clojure/lang/Indexed.java src/clojure/lang/IndexedSeq.java src/clojure/lang/IteratorSeq.java src/clojure/lang/Keyword.java src/clojure/lang/KeywordLookupSite.java src/clojure/lang/LazilyPersistentVector.java src/clojure/lang/LazySeq.java src/clojure/lang/LineNumberingPushbackReader.java src/clojure/lang/LispReader.java src/clojure/lang/LockingTransaction.java src/clojure/lang/MapEntry.java src/clojure/lang/MapEquivalence.java src/clojure/lang/MethodImplCache.java src/clojure/lang/MultiFn.java src/clojure/lang/Named.java src/clojure/lang/Namespace.java src/clojure/lang/Numbers.java src/clojure/lang/Obj.java src/clojure/lang/PersistentArrayMap.java src/clojure/lang/PersistentHashMap.java src/clojure/lang/PersistentHashSet.java src/clojure/lang/PersistentList.java src/clojure/lang/PersistentQueue.java src/clojure/lang/PersistentStructMap.java src/clojure/lang/PersistentTreeMap.java src/clojure/lang/PersistentTreeSet.java src/clojure/lang/PersistentVector.java src/clojure/lang/ProxyHandler.java src/clojure/lang/RT.java src/clojure/lang/Range.java src/clojure/lang/Ratio.java src/clojure/lang/Ref.java src/clojure/lang/Reflector.java src/clojure/lang/Repl.java src/clojure/lang/RestFn.java src/clojure/lang/Reversible.java src/clojure/lang/Script.java src/clojure/lang/SeqEnumeration.java src/clojure/lang/SeqIterator.java src/clojure/lang/Seqable.java src/clojure/lang/Sequential.java src/clojure/lang/Settable.java src/clojure/lang/Sorted.java src/clojure/lang/StringSeq.java src/clojure/lang/Symbol.java src/clojure/lang/TransactionalHashMap.java src/clojure/lang/Util.java src/clojure/lang/Var.java src/clojure/lang/XMLHandler.java src/clojure/main.clj src/clojure/main.java src/clojure/parallel.clj src/clojure/pprint.clj src/clojure/pprint/cl_format.clj src/clojure/pprint/column_writer.clj src/clojure/pprint/dispatch.clj src/clojure/pprint/pprint_base.clj src/clojure/pprint/pretty_writer.clj src/clojure/pprint/utilities.clj src/clojure/repl.clj src/clojure/set.clj src/clojure/stacktrace.clj src/clojure/string.clj src/clojure/template.clj src/clojure/test.clj src/clojure/test/junit.clj src/clojure/test/tap.clj src/clojure/test_clojure.clj src/clojure/test_clojure/agents.clj src/clojure/test_clojure/annotations.clj src/clojure/test_clojure/annotations/java_5.clj src/clojure/test_clojure/annotations/java_6_and_later.clj src/clojure/test_clojure/atoms.clj src/clojure/test_clojure/clojure_set.clj src/clojure/test_clojure/clojure_xml.clj src/clojure/test_clojure/clojure_zip.clj src/clojure/test_clojure/compilation.clj src/clojure/test_clojure/control.clj src/clojure/test_clojure/data_structures.clj src/clojure/test_clojure/def.clj src/clojure/test_clojure/evaluation.clj src/clojure/test_clojure/for.clj src/clojure/test_clojure/genclass.clj src/clojure/test_clojure/genclass/examples.clj src/clojure/test_clojure/helpers.clj src/clojure/test_clojure/java/io.clj src/clojure/test_clojure/java/javadoc.clj src/clojure/test_clojure/java/shell.clj src/clojure/test_clojure/java_interop.clj src/clojure/test_clojure/logic.clj src/clojure/test_clojure/macros.clj src/clojure/test_clojure/main.clj src/clojure/test_clojure/metadata.clj src/clojure/test_clojure/multimethods.clj src/clojure/test_clojure/ns_libs.clj src/clojure/test_clojure/numbers.clj src/clojure/test_clojure/other_functions.clj src/clojure/test_clojure/parallel.clj src/clojure/test_clojure/pprint.clj src/clojure/test_clojure/pprint/test_cl_format.clj src/clojure/test_clojure/pprint/test_helper.clj src/clojure/test_clojure/pprint/test_pretty.clj src/clojure/test_clojure/predicates.clj src/clojure/test_clojure/printer.clj src/clojure/test_clojure/protocols.clj src/clojure/test_clojure/protocols/examples.clj src/clojure/test_clojure/protocols/more_examples.clj src/clojure/test_clojure/reader.clj src/clojure/test_clojure/refs.clj src/clojure/test_clojure/repl.clj src/clojure/test_clojure/repl/example.clj src/clojure/test_clojure/rt.clj src/clojure/test_clojure/sequences.clj src/clojure/test_clojure/serialization.clj src/clojure/test_clojure/special.clj src/clojure/test_clojure/string.clj src/clojure/test_clojure/test.clj src/clojure/test_clojure/test_fixtures.clj src/clojure/test_clojure/transients.clj src/clojure/test_clojure/vars.clj src/clojure/test_clojure/vectors.clj src/clojure/walk.clj src/clojure/xml.clj src/clojure/zip.clj swank-laser
diffstat 388 files changed, 96517 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/asm/AnnotationVisitor.java	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,97 @@
     1.4 +/***
     1.5 + * ASM: a very small and fast Java bytecode manipulation framework
     1.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     1.7 + * All rights reserved.
     1.8 + *
     1.9 + * Redistribution and use in source and binary forms, with or without
    1.10 + * modification, are permitted provided that the following conditions
    1.11 + * are met:
    1.12 + * 1. Redistributions of source code must retain the above copyright
    1.13 + *    notice, this list of conditions and the following disclaimer.
    1.14 + * 2. Redistributions in binary form must reproduce the above copyright
    1.15 + *    notice, this list of conditions and the following disclaimer in the
    1.16 + *    documentation and/or other materials provided with the distribution.
    1.17 + * 3. Neither the name of the copyright holders nor the names of its
    1.18 + *    contributors may be used to endorse or promote products derived from
    1.19 + *    this software without specific prior written permission.
    1.20 + *
    1.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    1.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    1.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    1.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    1.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    1.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    1.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    1.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    1.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    1.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    1.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    1.32 + */
    1.33 +package clojure.asm;
    1.34 +
    1.35 +/**
    1.36 + * A visitor to visit a Java annotation. The methods of this interface must be
    1.37 + * called in the following order: (<tt>visit<tt> | <tt>visitEnum<tt> |
    1.38 + * <tt>visitAnnotation<tt> | <tt>visitArray<tt>)* <tt>visitEnd<tt>.
    1.39 + *
    1.40 + * @author Eric Bruneton
    1.41 + * @author Eugene Kuleshov
    1.42 + */
    1.43 +public interface AnnotationVisitor{
    1.44 +
    1.45 +/**
    1.46 + * Visits a primitive value of the annotation.
    1.47 + *
    1.48 + * @param name  the value name.
    1.49 + * @param value the actual value, whose type must be {@link Byte},
    1.50 + *              {@link Boolean}, {@link Character}, {@link Short},
    1.51 + *              {@link Integer}, {@link Long}, {@link Float}, {@link Double},
    1.52 + *              {@link String} or {@link Type}. This value can also be an array
    1.53 + *              of byte, boolean, short, char, int, long, float or double values
    1.54 + *              (this is equivalent to using {@link #visitArray visitArray} and
    1.55 + *              visiting each array element in turn, but is more convenient).
    1.56 + */
    1.57 +void visit(String name, Object value);
    1.58 +
    1.59 +/**
    1.60 + * Visits an enumeration value of the annotation.
    1.61 + *
    1.62 + * @param name  the value name.
    1.63 + * @param desc  the class descriptor of the enumeration class.
    1.64 + * @param value the actual enumeration value.
    1.65 + */
    1.66 +void visitEnum(String name, String desc, String value);
    1.67 +
    1.68 +/**
    1.69 + * Visits a nested annotation value of the annotation.
    1.70 + *
    1.71 + * @param name the value name.
    1.72 + * @param desc the class descriptor of the nested annotation class.
    1.73 + * @return a visitor to visit the actual nested annotation value, or
    1.74 + *         <tt>null</tt> if this visitor is not interested in visiting
    1.75 + *         this nested annotation. <i>The nested annotation value must be
    1.76 + *         fully visited before calling other methods on this annotation
    1.77 + *         visitor</i>.
    1.78 + */
    1.79 +AnnotationVisitor visitAnnotation(String name, String desc);
    1.80 +
    1.81 +/**
    1.82 + * Visits an array value of the annotation. Note that arrays of primitive
    1.83 + * types (such as byte, boolean, short, char, int, long, float or double)
    1.84 + * can be passed as value to {@link #visit visit}. This is what
    1.85 + * {@link ClassReader} does.
    1.86 + *
    1.87 + * @param name the value name.
    1.88 + * @return a visitor to visit the actual array value elements, or
    1.89 + *         <tt>null</tt> if this visitor is not interested in visiting
    1.90 + *         these values. The 'name' parameters passed to the methods of this
    1.91 + *         visitor are ignored. <i>All the array values must be visited
    1.92 + *         before calling other methods on this annotation visitor</i>.
    1.93 + */
    1.94 +AnnotationVisitor visitArray(String name);
    1.95 +
    1.96 +/**
    1.97 + * Visits the end of the annotation.
    1.98 + */
    1.99 +void visitEnd();
   1.100 +}
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/clojure/asm/AnnotationWriter.java	Sat Aug 21 06:25:44 2010 -0400
     2.3 @@ -0,0 +1,357 @@
     2.4 +/***
     2.5 + * ASM: a very small and fast Java bytecode manipulation framework
     2.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     2.7 + * All rights reserved.
     2.8 + *
     2.9 + * Redistribution and use in source and binary forms, with or without
    2.10 + * modification, are permitted provided that the following conditions
    2.11 + * are met:
    2.12 + * 1. Redistributions of source code must retain the above copyright
    2.13 + *    notice, this list of conditions and the following disclaimer.
    2.14 + * 2. Redistributions in binary form must reproduce the above copyright
    2.15 + *    notice, this list of conditions and the following disclaimer in the
    2.16 + *    documentation and/or other materials provided with the distribution.
    2.17 + * 3. Neither the name of the copyright holders nor the names of its
    2.18 + *    contributors may be used to endorse or promote products derived from
    2.19 + *    this software without specific prior written permission.
    2.20 + *
    2.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    2.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    2.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    2.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    2.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    2.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    2.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    2.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    2.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    2.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    2.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    2.32 + */
    2.33 +package clojure.asm;
    2.34 +
    2.35 +/**
    2.36 + * An {@link AnnotationVisitor} that generates annotations in bytecode form.
    2.37 + *
    2.38 + * @author Eric Bruneton
    2.39 + * @author Eugene Kuleshov
    2.40 + */
    2.41 +final class AnnotationWriter implements AnnotationVisitor{
    2.42 +
    2.43 +/**
    2.44 + * The class writer to which this annotation must be added.
    2.45 + */
    2.46 +private final ClassWriter cw;
    2.47 +
    2.48 +/**
    2.49 + * The number of values in this annotation.
    2.50 + */
    2.51 +private int size;
    2.52 +
    2.53 +/**
    2.54 + * <tt>true<tt> if values are named, <tt>false</tt> otherwise. Annotation
    2.55 + * writers used for annotation default and annotation arrays use unnamed
    2.56 + * values.
    2.57 + */
    2.58 +private final boolean named;
    2.59 +
    2.60 +/**
    2.61 + * The annotation values in bytecode form. This byte vector only contains
    2.62 + * the values themselves, i.e. the number of values must be stored as a
    2.63 + * unsigned short just before these bytes.
    2.64 + */
    2.65 +private final ByteVector bv;
    2.66 +
    2.67 +/**
    2.68 + * The byte vector to be used to store the number of values of this
    2.69 + * annotation. See {@link #bv}.
    2.70 + */
    2.71 +private final ByteVector parent;
    2.72 +
    2.73 +/**
    2.74 + * Where the number of values of this annotation must be stored in
    2.75 + * {@link #parent}.
    2.76 + */
    2.77 +private final int offset;
    2.78 +
    2.79 +/**
    2.80 + * Next annotation writer. This field is used to store annotation lists.
    2.81 + */
    2.82 +AnnotationWriter next;
    2.83 +
    2.84 +/**
    2.85 + * Previous annotation writer. This field is used to store annotation lists.
    2.86 + */
    2.87 +AnnotationWriter prev;
    2.88 +
    2.89 +// ------------------------------------------------------------------------
    2.90 +// Constructor
    2.91 +// ------------------------------------------------------------------------
    2.92 +
    2.93 +/**
    2.94 + * Constructs a new {@link AnnotationWriter}.
    2.95 + *
    2.96 + * @param cw     the class writer to which this annotation must be added.
    2.97 + * @param named  <tt>true<tt> if values are named, <tt>false</tt> otherwise.
    2.98 + * @param bv     where the annotation values must be stored.
    2.99 + * @param parent where the number of annotation values must be stored.
   2.100 + * @param offset where in <tt>parent</tt> the number of annotation values must
   2.101 + *               be stored.
   2.102 + */
   2.103 +AnnotationWriter(
   2.104 +		final ClassWriter cw,
   2.105 +		final boolean named,
   2.106 +		final ByteVector bv,
   2.107 +		final ByteVector parent,
   2.108 +		final int offset){
   2.109 +	this.cw = cw;
   2.110 +	this.named = named;
   2.111 +	this.bv = bv;
   2.112 +	this.parent = parent;
   2.113 +	this.offset = offset;
   2.114 +}
   2.115 +
   2.116 +// ------------------------------------------------------------------------
   2.117 +// Implementation of the AnnotationVisitor interface
   2.118 +// ------------------------------------------------------------------------
   2.119 +
   2.120 +public void visit(final String name, final Object value){
   2.121 +	++size;
   2.122 +	if(named)
   2.123 +		{
   2.124 +		bv.putShort(cw.newUTF8(name));
   2.125 +		}
   2.126 +	if(value instanceof String)
   2.127 +		{
   2.128 +		bv.put12('s', cw.newUTF8((String) value));
   2.129 +		}
   2.130 +	else if(value instanceof Byte)
   2.131 +		{
   2.132 +		bv.put12('B', cw.newInteger(((Byte) value).byteValue()).index);
   2.133 +		}
   2.134 +	else if(value instanceof Boolean)
   2.135 +		{
   2.136 +		int v = ((Boolean) value).booleanValue() ? 1 : 0;
   2.137 +		bv.put12('Z', cw.newInteger(v).index);
   2.138 +		}
   2.139 +	else if(value instanceof Character)
   2.140 +		{
   2.141 +		bv.put12('C', cw.newInteger(((Character) value).charValue()).index);
   2.142 +		}
   2.143 +	else if(value instanceof Short)
   2.144 +		{
   2.145 +		bv.put12('S', cw.newInteger(((Short) value).shortValue()).index);
   2.146 +		}
   2.147 +	else if(value instanceof Type)
   2.148 +		{
   2.149 +		bv.put12('c', cw.newUTF8(((Type) value).getDescriptor()));
   2.150 +		}
   2.151 +	else if(value instanceof byte[])
   2.152 +		{
   2.153 +		byte[] v = (byte[]) value;
   2.154 +		bv.put12('[', v.length);
   2.155 +		for(int i = 0; i < v.length; i++)
   2.156 +			{
   2.157 +			bv.put12('B', cw.newInteger(v[i]).index);
   2.158 +			}
   2.159 +		}
   2.160 +	else if(value instanceof boolean[])
   2.161 +		{
   2.162 +		boolean[] v = (boolean[]) value;
   2.163 +		bv.put12('[', v.length);
   2.164 +		for(int i = 0; i < v.length; i++)
   2.165 +			{
   2.166 +			bv.put12('Z', cw.newInteger(v[i] ? 1 : 0).index);
   2.167 +			}
   2.168 +		}
   2.169 +	else if(value instanceof short[])
   2.170 +		{
   2.171 +		short[] v = (short[]) value;
   2.172 +		bv.put12('[', v.length);
   2.173 +		for(int i = 0; i < v.length; i++)
   2.174 +			{
   2.175 +			bv.put12('S', cw.newInteger(v[i]).index);
   2.176 +			}
   2.177 +		}
   2.178 +	else if(value instanceof char[])
   2.179 +		{
   2.180 +		char[] v = (char[]) value;
   2.181 +		bv.put12('[', v.length);
   2.182 +		for(int i = 0; i < v.length; i++)
   2.183 +			{
   2.184 +			bv.put12('C', cw.newInteger(v[i]).index);
   2.185 +			}
   2.186 +		}
   2.187 +	else if(value instanceof int[])
   2.188 +		{
   2.189 +		int[] v = (int[]) value;
   2.190 +		bv.put12('[', v.length);
   2.191 +		for(int i = 0; i < v.length; i++)
   2.192 +			{
   2.193 +			bv.put12('I', cw.newInteger(v[i]).index);
   2.194 +			}
   2.195 +		}
   2.196 +	else if(value instanceof long[])
   2.197 +		{
   2.198 +		long[] v = (long[]) value;
   2.199 +		bv.put12('[', v.length);
   2.200 +		for(int i = 0; i < v.length; i++)
   2.201 +			{
   2.202 +			bv.put12('J', cw.newLong(v[i]).index);
   2.203 +			}
   2.204 +		}
   2.205 +	else if(value instanceof float[])
   2.206 +		{
   2.207 +		float[] v = (float[]) value;
   2.208 +		bv.put12('[', v.length);
   2.209 +		for(int i = 0; i < v.length; i++)
   2.210 +			{
   2.211 +			bv.put12('F', cw.newFloat(v[i]).index);
   2.212 +			}
   2.213 +		}
   2.214 +	else if(value instanceof double[])
   2.215 +		{
   2.216 +		double[] v = (double[]) value;
   2.217 +		bv.put12('[', v.length);
   2.218 +		for(int i = 0; i < v.length; i++)
   2.219 +			{
   2.220 +			bv.put12('D', cw.newDouble(v[i]).index);
   2.221 +			}
   2.222 +		}
   2.223 +	else
   2.224 +		{
   2.225 +		Item i = cw.newConstItem(value);
   2.226 +		bv.put12(".s.IFJDCS".charAt(i.type), i.index);
   2.227 +		}
   2.228 +}
   2.229 +
   2.230 +public void visitEnum(
   2.231 +		final String name,
   2.232 +		final String desc,
   2.233 +		final String value){
   2.234 +	++size;
   2.235 +	if(named)
   2.236 +		{
   2.237 +		bv.putShort(cw.newUTF8(name));
   2.238 +		}
   2.239 +	bv.put12('e', cw.newUTF8(desc)).putShort(cw.newUTF8(value));
   2.240 +}
   2.241 +
   2.242 +public AnnotationVisitor visitAnnotation(
   2.243 +		final String name,
   2.244 +		final String desc){
   2.245 +	++size;
   2.246 +	if(named)
   2.247 +		{
   2.248 +		bv.putShort(cw.newUTF8(name));
   2.249 +		}
   2.250 +	// write tag and type, and reserve space for values count
   2.251 +	bv.put12('@', cw.newUTF8(desc)).putShort(0);
   2.252 +	return new AnnotationWriter(cw, true, bv, bv, bv.length - 2);
   2.253 +}
   2.254 +
   2.255 +public AnnotationVisitor visitArray(final String name){
   2.256 +	++size;
   2.257 +	if(named)
   2.258 +		{
   2.259 +		bv.putShort(cw.newUTF8(name));
   2.260 +		}
   2.261 +	// write tag, and reserve space for array size
   2.262 +	bv.put12('[', 0);
   2.263 +	return new AnnotationWriter(cw, false, bv, bv, bv.length - 2);
   2.264 +}
   2.265 +
   2.266 +public void visitEnd(){
   2.267 +	if(parent != null)
   2.268 +		{
   2.269 +		byte[] data = parent.data;
   2.270 +		data[offset] = (byte) (size >>> 8);
   2.271 +		data[offset + 1] = (byte) size;
   2.272 +		}
   2.273 +}
   2.274 +
   2.275 +// ------------------------------------------------------------------------
   2.276 +// Utility methods
   2.277 +// ------------------------------------------------------------------------
   2.278 +
   2.279 +/**
   2.280 + * Returns the size of this annotation writer list.
   2.281 + *
   2.282 + * @return the size of this annotation writer list.
   2.283 + */
   2.284 +int getSize(){
   2.285 +	int size = 0;
   2.286 +	AnnotationWriter aw = this;
   2.287 +	while(aw != null)
   2.288 +		{
   2.289 +		size += aw.bv.length;
   2.290 +		aw = aw.next;
   2.291 +		}
   2.292 +	return size;
   2.293 +}
   2.294 +
   2.295 +/**
   2.296 + * Puts the annotations of this annotation writer list into the given byte
   2.297 + * vector.
   2.298 + *
   2.299 + * @param out where the annotations must be put.
   2.300 + */
   2.301 +void put(final ByteVector out){
   2.302 +	int n = 0;
   2.303 +	int size = 2;
   2.304 +	AnnotationWriter aw = this;
   2.305 +	AnnotationWriter last = null;
   2.306 +	while(aw != null)
   2.307 +		{
   2.308 +		++n;
   2.309 +		size += aw.bv.length;
   2.310 +		aw.visitEnd(); // in case user forgot to call visitEnd
   2.311 +		aw.prev = last;
   2.312 +		last = aw;
   2.313 +		aw = aw.next;
   2.314 +		}
   2.315 +	out.putInt(size);
   2.316 +	out.putShort(n);
   2.317 +	aw = last;
   2.318 +	while(aw != null)
   2.319 +		{
   2.320 +		out.putByteArray(aw.bv.data, 0, aw.bv.length);
   2.321 +		aw = aw.prev;
   2.322 +		}
   2.323 +}
   2.324 +
   2.325 +/**
   2.326 + * Puts the given annotation lists into the given byte vector.
   2.327 + *
   2.328 + * @param panns an array of annotation writer lists.
   2.329 + * @param out   where the annotations must be put.
   2.330 + */
   2.331 +static void put(final AnnotationWriter[] panns, final ByteVector out){
   2.332 +	int size = 1 + 2 * panns.length;
   2.333 +	for(int i = 0; i < panns.length; ++i)
   2.334 +		{
   2.335 +		size += panns[i] == null ? 0 : panns[i].getSize();
   2.336 +		}
   2.337 +	out.putInt(size).putByte(panns.length);
   2.338 +	for(int i = 0; i < panns.length; ++i)
   2.339 +		{
   2.340 +		AnnotationWriter aw = panns[i];
   2.341 +		AnnotationWriter last = null;
   2.342 +		int n = 0;
   2.343 +		while(aw != null)
   2.344 +			{
   2.345 +			++n;
   2.346 +			aw.visitEnd(); // in case user forgot to call visitEnd
   2.347 +			aw.prev = last;
   2.348 +			last = aw;
   2.349 +			aw = aw.next;
   2.350 +			}
   2.351 +		out.putShort(n);
   2.352 +		aw = last;
   2.353 +		while(aw != null)
   2.354 +			{
   2.355 +			out.putByteArray(aw.bv.data, 0, aw.bv.length);
   2.356 +			aw = aw.prev;
   2.357 +			}
   2.358 +		}
   2.359 +}
   2.360 +}
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/clojure/asm/Attribute.java	Sat Aug 21 06:25:44 2010 -0400
     3.3 @@ -0,0 +1,253 @@
     3.4 +/***
     3.5 + * ASM: a very small and fast Java bytecode manipulation framework
     3.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     3.7 + * All rights reserved.
     3.8 + *
     3.9 + * Redistribution and use in source and binary forms, with or without
    3.10 + * modification, are permitted provided that the following conditions
    3.11 + * are met:
    3.12 + * 1. Redistributions of source code must retain the above copyright
    3.13 + *    notice, this list of conditions and the following disclaimer.
    3.14 + * 2. Redistributions in binary form must reproduce the above copyright
    3.15 + *    notice, this list of conditions and the following disclaimer in the
    3.16 + *    documentation and/or other materials provided with the distribution.
    3.17 + * 3. Neither the name of the copyright holders nor the names of its
    3.18 + *    contributors may be used to endorse or promote products derived from
    3.19 + *    this software without specific prior written permission.
    3.20 + *
    3.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    3.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    3.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    3.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    3.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    3.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    3.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    3.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    3.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    3.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    3.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    3.32 + */
    3.33 +package clojure.asm;
    3.34 +
    3.35 +/**
    3.36 + * A non standard class, field, method or code attribute.
    3.37 + *
    3.38 + * @author Eric Bruneton
    3.39 + * @author Eugene Kuleshov
    3.40 + */
    3.41 +public class Attribute{
    3.42 +
    3.43 +/**
    3.44 + * The type of this attribute.
    3.45 + */
    3.46 +public final String type;
    3.47 +
    3.48 +/**
    3.49 + * The raw value of this attribute, used only for unknown attributes.
    3.50 + */
    3.51 +byte[] value;
    3.52 +
    3.53 +/**
    3.54 + * The next attribute in this attribute list. May be <tt>null</tt>.
    3.55 + */
    3.56 +Attribute next;
    3.57 +
    3.58 +/**
    3.59 + * Constructs a new empty attribute.
    3.60 + *
    3.61 + * @param type the type of the attribute.
    3.62 + */
    3.63 +protected Attribute(final String type){
    3.64 +	this.type = type;
    3.65 +}
    3.66 +
    3.67 +/**
    3.68 + * Returns <tt>true</tt> if this type of attribute is unknown. The default
    3.69 + * implementation of this method always returns <tt>true</tt>.
    3.70 + *
    3.71 + * @return <tt>true</tt> if this type of attribute is unknown.
    3.72 + */
    3.73 +public boolean isUnknown(){
    3.74 +	return true;
    3.75 +}
    3.76 +
    3.77 +/**
    3.78 + * Returns <tt>true</tt> if this type of attribute is a code attribute.
    3.79 + *
    3.80 + * @return <tt>true</tt> if this type of attribute is a code attribute.
    3.81 + */
    3.82 +public boolean isCodeAttribute(){
    3.83 +	return false;
    3.84 +}
    3.85 +
    3.86 +/**
    3.87 + * Returns the labels corresponding to this attribute.
    3.88 + *
    3.89 + * @return the labels corresponding to this attribute, or <tt>null</tt> if
    3.90 + *         this attribute is not a code attribute that contains labels.
    3.91 + */
    3.92 +protected Label[] getLabels(){
    3.93 +	return null;
    3.94 +}
    3.95 +
    3.96 +/**
    3.97 + * Reads a {@link #type type} attribute. This method must return a <i>new</i>
    3.98 + * {@link Attribute} object, of type {@link #type type}, corresponding to
    3.99 + * the <tt>len</tt> bytes starting at the given offset, in the given class
   3.100 + * reader.
   3.101 + *
   3.102 + * @param cr      the class that contains the attribute to be read.
   3.103 + * @param off     index of the first byte of the attribute's content in {@link
   3.104 + *                ClassReader#b cr.b}. The 6 attribute header bytes, containing the
   3.105 + *                type and the length of the attribute, are not taken into account
   3.106 + *                here.
   3.107 + * @param len     the length of the attribute's content.
   3.108 + * @param buf     buffer to be used to call
   3.109 + *                {@link ClassReader#readUTF8 readUTF8},
   3.110 + *                {@link ClassReader#readClass(int,char[]) readClass} or
   3.111 + *                {@link ClassReader#readConst readConst}.
   3.112 + * @param codeOff index of the first byte of code's attribute content in
   3.113 + *                {@link ClassReader#b cr.b}, or -1 if the attribute to be read is
   3.114 + *                not a code attribute. The 6 attribute header bytes, containing the
   3.115 + *                type and the length of the attribute, are not taken into account
   3.116 + *                here.
   3.117 + * @param labels  the labels of the method's code, or <tt>null</tt> if the
   3.118 + *                attribute to be read is not a code attribute.
   3.119 + * @return a <i>new</i> {@link Attribute} object corresponding to the given
   3.120 + *         bytes.
   3.121 + */
   3.122 +protected Attribute read(
   3.123 +		final ClassReader cr,
   3.124 +		final int off,
   3.125 +		final int len,
   3.126 +		final char[] buf,
   3.127 +		final int codeOff,
   3.128 +		final Label[] labels){
   3.129 +	Attribute attr = new Attribute(type);
   3.130 +	attr.value = new byte[len];
   3.131 +	System.arraycopy(cr.b, off, attr.value, 0, len);
   3.132 +	return attr;
   3.133 +}
   3.134 +
   3.135 +/**
   3.136 + * Returns the byte array form of this attribute.
   3.137 + *
   3.138 + * @param cw        the class to which this attribute must be added. This parameter
   3.139 + *                  can be used to add to the constant pool of this class the items
   3.140 + *                  that corresponds to this attribute.
   3.141 + * @param code      the bytecode of the method corresponding to this code
   3.142 + *                  attribute, or <tt>null</tt> if this attribute is not a code
   3.143 + *                  attributes.
   3.144 + * @param len       the length of the bytecode of the method corresponding to this
   3.145 + *                  code attribute, or <tt>null</tt> if this attribute is not a code
   3.146 + *                  attribute.
   3.147 + * @param maxStack  the maximum stack size of the method corresponding to
   3.148 + *                  this code attribute, or -1 if this attribute is not a code
   3.149 + *                  attribute.
   3.150 + * @param maxLocals the maximum number of local variables of the method
   3.151 + *                  corresponding to this code attribute, or -1 if this attribute is
   3.152 + *                  not a code attribute.
   3.153 + * @return the byte array form of this attribute.
   3.154 + */
   3.155 +protected ByteVector write(
   3.156 +		final ClassWriter cw,
   3.157 +		final byte[] code,
   3.158 +		final int len,
   3.159 +		final int maxStack,
   3.160 +		final int maxLocals){
   3.161 +	ByteVector v = new ByteVector();
   3.162 +	v.data = value;
   3.163 +	v.length = value.length;
   3.164 +	return v;
   3.165 +}
   3.166 +
   3.167 +/**
   3.168 + * Returns the length of the attribute list that begins with this attribute.
   3.169 + *
   3.170 + * @return the length of the attribute list that begins with this attribute.
   3.171 + */
   3.172 +final int getCount(){
   3.173 +	int count = 0;
   3.174 +	Attribute attr = this;
   3.175 +	while(attr != null)
   3.176 +		{
   3.177 +		count += 1;
   3.178 +		attr = attr.next;
   3.179 +		}
   3.180 +	return count;
   3.181 +}
   3.182 +
   3.183 +/**
   3.184 + * Returns the size of all the attributes in this attribute list.
   3.185 + *
   3.186 + * @param cw        the class writer to be used to convert the attributes into byte
   3.187 + *                  arrays, with the {@link #write write} method.
   3.188 + * @param code      the bytecode of the method corresponding to these code
   3.189 + *                  attributes, or <tt>null</tt> if these attributes are not code
   3.190 + *                  attributes.
   3.191 + * @param len       the length of the bytecode of the method corresponding to
   3.192 + *                  these code attributes, or <tt>null</tt> if these attributes are
   3.193 + *                  not code attributes.
   3.194 + * @param maxStack  the maximum stack size of the method corresponding to
   3.195 + *                  these code attributes, or -1 if these attributes are not code
   3.196 + *                  attributes.
   3.197 + * @param maxLocals the maximum number of local variables of the method
   3.198 + *                  corresponding to these code attributes, or -1 if these attributes
   3.199 + *                  are not code attributes.
   3.200 + * @return the size of all the attributes in this attribute list. This size
   3.201 + *         includes the size of the attribute headers.
   3.202 + */
   3.203 +final int getSize(
   3.204 +		final ClassWriter cw,
   3.205 +		final byte[] code,
   3.206 +		final int len,
   3.207 +		final int maxStack,
   3.208 +		final int maxLocals){
   3.209 +	Attribute attr = this;
   3.210 +	int size = 0;
   3.211 +	while(attr != null)
   3.212 +		{
   3.213 +		cw.newUTF8(attr.type);
   3.214 +		size += attr.write(cw, code, len, maxStack, maxLocals).length + 6;
   3.215 +		attr = attr.next;
   3.216 +		}
   3.217 +	return size;
   3.218 +}
   3.219 +
   3.220 +/**
   3.221 + * Writes all the attributes of this attribute list in the given byte
   3.222 + * vector.
   3.223 + *
   3.224 + * @param cw        the class writer to be used to convert the attributes into byte
   3.225 + *                  arrays, with the {@link #write write} method.
   3.226 + * @param code      the bytecode of the method corresponding to these code
   3.227 + *                  attributes, or <tt>null</tt> if these attributes are not code
   3.228 + *                  attributes.
   3.229 + * @param len       the length of the bytecode of the method corresponding to
   3.230 + *                  these code attributes, or <tt>null</tt> if these attributes are
   3.231 + *                  not code attributes.
   3.232 + * @param maxStack  the maximum stack size of the method corresponding to
   3.233 + *                  these code attributes, or -1 if these attributes are not code
   3.234 + *                  attributes.
   3.235 + * @param maxLocals the maximum number of local variables of the method
   3.236 + *                  corresponding to these code attributes, or -1 if these attributes
   3.237 + *                  are not code attributes.
   3.238 + * @param out       where the attributes must be written.
   3.239 + */
   3.240 +final void put(
   3.241 +		final ClassWriter cw,
   3.242 +		final byte[] code,
   3.243 +		final int len,
   3.244 +		final int maxStack,
   3.245 +		final int maxLocals,
   3.246 +		final ByteVector out){
   3.247 +	Attribute attr = this;
   3.248 +	while(attr != null)
   3.249 +		{
   3.250 +		ByteVector b = attr.write(cw, code, len, maxStack, maxLocals);
   3.251 +		out.putShort(cw.newUTF8(attr.type)).putInt(b.length);
   3.252 +		out.putByteArray(b.data, 0, b.length);
   3.253 +		attr = attr.next;
   3.254 +		}
   3.255 +}
   3.256 +}
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/clojure/asm/ByteVector.java	Sat Aug 21 06:25:44 2010 -0400
     4.3 @@ -0,0 +1,318 @@
     4.4 +/***
     4.5 + * ASM: a very small and fast Java bytecode manipulation framework
     4.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     4.7 + * All rights reserved.
     4.8 + *
     4.9 + * Redistribution and use in source and binary forms, with or without
    4.10 + * modification, are permitted provided that the following conditions
    4.11 + * are met:
    4.12 + * 1. Redistributions of source code must retain the above copyright
    4.13 + *    notice, this list of conditions and the following disclaimer.
    4.14 + * 2. Redistributions in binary form must reproduce the above copyright
    4.15 + *    notice, this list of conditions and the following disclaimer in the
    4.16 + *    documentation and/or other materials provided with the distribution.
    4.17 + * 3. Neither the name of the copyright holders nor the names of its
    4.18 + *    contributors may be used to endorse or promote products derived from
    4.19 + *    this software without specific prior written permission.
    4.20 + *
    4.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    4.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    4.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    4.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    4.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    4.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    4.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    4.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    4.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    4.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    4.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    4.32 + */
    4.33 +package clojure.asm;
    4.34 +
    4.35 +/**
    4.36 + * A dynamically extensible vector of bytes. This class is roughly equivalent to
    4.37 + * a DataOutputStream on top of a ByteArrayOutputStream, but is more efficient.
    4.38 + *
    4.39 + * @author Eric Bruneton
    4.40 + */
    4.41 +public class ByteVector{
    4.42 +
    4.43 +/**
    4.44 + * The content of this vector.
    4.45 + */
    4.46 +byte[] data;
    4.47 +
    4.48 +/**
    4.49 + * Actual number of bytes in this vector.
    4.50 + */
    4.51 +int length;
    4.52 +
    4.53 +/**
    4.54 + * Constructs a new {@link ByteVector ByteVector} with a default initial
    4.55 + * size.
    4.56 + */
    4.57 +public ByteVector(){
    4.58 +	data = new byte[64];
    4.59 +}
    4.60 +
    4.61 +/**
    4.62 + * Constructs a new {@link ByteVector ByteVector} with the given initial
    4.63 + * size.
    4.64 + *
    4.65 + * @param initialSize the initial size of the byte vector to be constructed.
    4.66 + */
    4.67 +public ByteVector(final int initialSize){
    4.68 +	data = new byte[initialSize];
    4.69 +}
    4.70 +
    4.71 +/**
    4.72 + * Puts a byte into this byte vector. The byte vector is automatically
    4.73 + * enlarged if necessary.
    4.74 + *
    4.75 + * @param b a byte.
    4.76 + * @return this byte vector.
    4.77 + */
    4.78 +public ByteVector putByte(final int b){
    4.79 +	int length = this.length;
    4.80 +	if(length + 1 > data.length)
    4.81 +		{
    4.82 +		enlarge(1);
    4.83 +		}
    4.84 +	data[length++] = (byte) b;
    4.85 +	this.length = length;
    4.86 +	return this;
    4.87 +}
    4.88 +
    4.89 +/**
    4.90 + * Puts two bytes into this byte vector. The byte vector is automatically
    4.91 + * enlarged if necessary.
    4.92 + *
    4.93 + * @param b1 a byte.
    4.94 + * @param b2 another byte.
    4.95 + * @return this byte vector.
    4.96 + */
    4.97 +ByteVector put11(final int b1, final int b2){
    4.98 +	int length = this.length;
    4.99 +	if(length + 2 > data.length)
   4.100 +		{
   4.101 +		enlarge(2);
   4.102 +		}
   4.103 +	byte[] data = this.data;
   4.104 +	data[length++] = (byte) b1;
   4.105 +	data[length++] = (byte) b2;
   4.106 +	this.length = length;
   4.107 +	return this;
   4.108 +}
   4.109 +
   4.110 +/**
   4.111 + * Puts a short into this byte vector. The byte vector is automatically
   4.112 + * enlarged if necessary.
   4.113 + *
   4.114 + * @param s a short.
   4.115 + * @return this byte vector.
   4.116 + */
   4.117 +public ByteVector putShort(final int s){
   4.118 +	int length = this.length;
   4.119 +	if(length + 2 > data.length)
   4.120 +		{
   4.121 +		enlarge(2);
   4.122 +		}
   4.123 +	byte[] data = this.data;
   4.124 +	data[length++] = (byte) (s >>> 8);
   4.125 +	data[length++] = (byte) s;
   4.126 +	this.length = length;
   4.127 +	return this;
   4.128 +}
   4.129 +
   4.130 +/**
   4.131 + * Puts a byte and a short into this byte vector. The byte vector is
   4.132 + * automatically enlarged if necessary.
   4.133 + *
   4.134 + * @param b a byte.
   4.135 + * @param s a short.
   4.136 + * @return this byte vector.
   4.137 + */
   4.138 +ByteVector put12(final int b, final int s){
   4.139 +	int length = this.length;
   4.140 +	if(length + 3 > data.length)
   4.141 +		{
   4.142 +		enlarge(3);
   4.143 +		}
   4.144 +	byte[] data = this.data;
   4.145 +	data[length++] = (byte) b;
   4.146 +	data[length++] = (byte) (s >>> 8);
   4.147 +	data[length++] = (byte) s;
   4.148 +	this.length = length;
   4.149 +	return this;
   4.150 +}
   4.151 +
   4.152 +/**
   4.153 + * Puts an int into this byte vector. The byte vector is automatically
   4.154 + * enlarged if necessary.
   4.155 + *
   4.156 + * @param i an int.
   4.157 + * @return this byte vector.
   4.158 + */
   4.159 +public ByteVector putInt(final int i){
   4.160 +	int length = this.length;
   4.161 +	if(length + 4 > data.length)
   4.162 +		{
   4.163 +		enlarge(4);
   4.164 +		}
   4.165 +	byte[] data = this.data;
   4.166 +	data[length++] = (byte) (i >>> 24);
   4.167 +	data[length++] = (byte) (i >>> 16);
   4.168 +	data[length++] = (byte) (i >>> 8);
   4.169 +	data[length++] = (byte) i;
   4.170 +	this.length = length;
   4.171 +	return this;
   4.172 +}
   4.173 +
   4.174 +/**
   4.175 + * Puts a long into this byte vector. The byte vector is automatically
   4.176 + * enlarged if necessary.
   4.177 + *
   4.178 + * @param l a long.
   4.179 + * @return this byte vector.
   4.180 + */
   4.181 +public ByteVector putLong(final long l){
   4.182 +	int length = this.length;
   4.183 +	if(length + 8 > data.length)
   4.184 +		{
   4.185 +		enlarge(8);
   4.186 +		}
   4.187 +	byte[] data = this.data;
   4.188 +	int i = (int) (l >>> 32);
   4.189 +	data[length++] = (byte) (i >>> 24);
   4.190 +	data[length++] = (byte) (i >>> 16);
   4.191 +	data[length++] = (byte) (i >>> 8);
   4.192 +	data[length++] = (byte) i;
   4.193 +	i = (int) l;
   4.194 +	data[length++] = (byte) (i >>> 24);
   4.195 +	data[length++] = (byte) (i >>> 16);
   4.196 +	data[length++] = (byte) (i >>> 8);
   4.197 +	data[length++] = (byte) i;
   4.198 +	this.length = length;
   4.199 +	return this;
   4.200 +}
   4.201 +
   4.202 +/**
   4.203 + * Puts an UTF8 string into this byte vector. The byte vector is
   4.204 + * automatically enlarged if necessary.
   4.205 + *
   4.206 + * @param s a String.
   4.207 + * @return this byte vector.
   4.208 + */
   4.209 +public ByteVector putUTF8(final String s){
   4.210 +	int charLength = s.length();
   4.211 +	if(length + 2 + charLength > data.length)
   4.212 +		{
   4.213 +		enlarge(2 + charLength);
   4.214 +		}
   4.215 +	int len = length;
   4.216 +	byte[] data = this.data;
   4.217 +	// optimistic algorithm: instead of computing the byte length and then
   4.218 +	// serializing the string (which requires two loops), we assume the byte
   4.219 +	// length is equal to char length (which is the most frequent case), and
   4.220 +	// we start serializing the string right away. During the serialization,
   4.221 +	// if we find that this assumption is wrong, we continue with the
   4.222 +	// general method.
   4.223 +	data[len++] = (byte) (charLength >>> 8);
   4.224 +	data[len++] = (byte) charLength;
   4.225 +	for(int i = 0; i < charLength; ++i)
   4.226 +		{
   4.227 +		char c = s.charAt(i);
   4.228 +		if(c >= '\001' && c <= '\177')
   4.229 +			{
   4.230 +			data[len++] = (byte) c;
   4.231 +			}
   4.232 +		else
   4.233 +			{
   4.234 +			int byteLength = i;
   4.235 +			for(int j = i; j < charLength; ++j)
   4.236 +				{
   4.237 +				c = s.charAt(j);
   4.238 +				if(c >= '\001' && c <= '\177')
   4.239 +					{
   4.240 +					byteLength++;
   4.241 +					}
   4.242 +				else if(c > '\u07FF')
   4.243 +					{
   4.244 +					byteLength += 3;
   4.245 +					}
   4.246 +				else
   4.247 +					{
   4.248 +					byteLength += 2;
   4.249 +					}
   4.250 +				}
   4.251 +			data[length] = (byte) (byteLength >>> 8);
   4.252 +			data[length + 1] = (byte) byteLength;
   4.253 +			if(length + 2 + byteLength > data.length)
   4.254 +				{
   4.255 +				length = len;
   4.256 +				enlarge(2 + byteLength);
   4.257 +				data = this.data;
   4.258 +				}
   4.259 +			for(int j = i; j < charLength; ++j)
   4.260 +				{
   4.261 +				c = s.charAt(j);
   4.262 +				if(c >= '\001' && c <= '\177')
   4.263 +					{
   4.264 +					data[len++] = (byte) c;
   4.265 +					}
   4.266 +				else if(c > '\u07FF')
   4.267 +					{
   4.268 +					data[len++] = (byte) (0xE0 | c >> 12 & 0xF);
   4.269 +					data[len++] = (byte) (0x80 | c >> 6 & 0x3F);
   4.270 +					data[len++] = (byte) (0x80 | c & 0x3F);
   4.271 +					}
   4.272 +				else
   4.273 +					{
   4.274 +					data[len++] = (byte) (0xC0 | c >> 6 & 0x1F);
   4.275 +					data[len++] = (byte) (0x80 | c & 0x3F);
   4.276 +					}
   4.277 +				}
   4.278 +			break;
   4.279 +			}
   4.280 +		}
   4.281 +	length = len;
   4.282 +	return this;
   4.283 +}
   4.284 +
   4.285 +/**
   4.286 + * Puts an array of bytes into this byte vector. The byte vector is
   4.287 + * automatically enlarged if necessary.
   4.288 + *
   4.289 + * @param b   an array of bytes. May be <tt>null</tt> to put <tt>len</tt>
   4.290 + *            null bytes into this byte vector.
   4.291 + * @param off index of the fist byte of b that must be copied.
   4.292 + * @param len number of bytes of b that must be copied.
   4.293 + * @return this byte vector.
   4.294 + */
   4.295 +public ByteVector putByteArray(final byte[] b, final int off, final int len){
   4.296 +	if(length + len > data.length)
   4.297 +		{
   4.298 +		enlarge(len);
   4.299 +		}
   4.300 +	if(b != null)
   4.301 +		{
   4.302 +		System.arraycopy(b, off, data, length, len);
   4.303 +		}
   4.304 +	length += len;
   4.305 +	return this;
   4.306 +}
   4.307 +
   4.308 +/**
   4.309 + * Enlarge this byte vector so that it can receive n more bytes.
   4.310 + *
   4.311 + * @param size number of additional bytes that this byte vector should be
   4.312 + *             able to receive.
   4.313 + */
   4.314 +private void enlarge(final int size){
   4.315 +	int length1 = 2 * data.length;
   4.316 +	int length2 = length + size;
   4.317 +	byte[] newData = new byte[length1 > length2 ? length1 : length2];
   4.318 +	System.arraycopy(data, 0, newData, 0, length);
   4.319 +	data = newData;
   4.320 +}
   4.321 +}
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/clojure/asm/ClassAdapter.java	Sat Aug 21 06:25:44 2010 -0400
     5.3 @@ -0,0 +1,115 @@
     5.4 +/***
     5.5 + * ASM: a very small and fast Java bytecode manipulation framework
     5.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     5.7 + * All rights reserved.
     5.8 + *
     5.9 + * Redistribution and use in source and binary forms, with or without
    5.10 + * modification, are permitted provided that the following conditions
    5.11 + * are met:
    5.12 + * 1. Redistributions of source code must retain the above copyright
    5.13 + *    notice, this list of conditions and the following disclaimer.
    5.14 + * 2. Redistributions in binary form must reproduce the above copyright
    5.15 + *    notice, this list of conditions and the following disclaimer in the
    5.16 + *    documentation and/or other materials provided with the distribution.
    5.17 + * 3. Neither the name of the copyright holders nor the names of its
    5.18 + *    contributors may be used to endorse or promote products derived from
    5.19 + *    this software without specific prior written permission.
    5.20 + *
    5.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    5.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    5.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    5.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    5.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    5.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    5.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    5.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    5.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    5.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    5.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    5.32 + */
    5.33 +package clojure.asm;
    5.34 +
    5.35 +/**
    5.36 + * An empty {@link ClassVisitor} that delegates to another {@link ClassVisitor}.
    5.37 + * This class can be used as a super class to quickly implement usefull class
    5.38 + * adapter classes, just by overriding the necessary methods.
    5.39 + *
    5.40 + * @author Eric Bruneton
    5.41 + */
    5.42 +public class ClassAdapter implements ClassVisitor{
    5.43 +
    5.44 +/**
    5.45 + * The {@link ClassVisitor} to which this adapter delegates calls.
    5.46 + */
    5.47 +protected ClassVisitor cv;
    5.48 +
    5.49 +/**
    5.50 + * Constructs a new {@link ClassAdapter} object.
    5.51 + *
    5.52 + * @param cv the class visitor to which this adapter must delegate calls.
    5.53 + */
    5.54 +public ClassAdapter(final ClassVisitor cv){
    5.55 +	this.cv = cv;
    5.56 +}
    5.57 +
    5.58 +public void visit(
    5.59 +		final int version,
    5.60 +		final int access,
    5.61 +		final String name,
    5.62 +		final String signature,
    5.63 +		final String superName,
    5.64 +		final String[] interfaces){
    5.65 +	cv.visit(version, access, name, signature, superName, interfaces);
    5.66 +}
    5.67 +
    5.68 +public void visitSource(final String source, final String debug){
    5.69 +	cv.visitSource(source, debug);
    5.70 +}
    5.71 +
    5.72 +public void visitOuterClass(
    5.73 +		final String owner,
    5.74 +		final String name,
    5.75 +		final String desc){
    5.76 +	cv.visitOuterClass(owner, name, desc);
    5.77 +}
    5.78 +
    5.79 +public AnnotationVisitor visitAnnotation(
    5.80 +		final String desc,
    5.81 +		final boolean visible){
    5.82 +	return cv.visitAnnotation(desc, visible);
    5.83 +}
    5.84 +
    5.85 +public void visitAttribute(final Attribute attr){
    5.86 +	cv.visitAttribute(attr);
    5.87 +}
    5.88 +
    5.89 +public void visitInnerClass(
    5.90 +		final String name,
    5.91 +		final String outerName,
    5.92 +		final String innerName,
    5.93 +		final int access){
    5.94 +	cv.visitInnerClass(name, outerName, innerName, access);
    5.95 +}
    5.96 +
    5.97 +public FieldVisitor visitField(
    5.98 +		final int access,
    5.99 +		final String name,
   5.100 +		final String desc,
   5.101 +		final String signature,
   5.102 +		final Object value){
   5.103 +	return cv.visitField(access, name, desc, signature, value);
   5.104 +}
   5.105 +
   5.106 +public MethodVisitor visitMethod(
   5.107 +		final int access,
   5.108 +		final String name,
   5.109 +		final String desc,
   5.110 +		final String signature,
   5.111 +		final String[] exceptions){
   5.112 +	return cv.visitMethod(access, name, desc, signature, exceptions);
   5.113 +}
   5.114 +
   5.115 +public void visitEnd(){
   5.116 +	cv.visitEnd();
   5.117 +}
   5.118 +}
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/clojure/asm/ClassReader.java	Sat Aug 21 06:25:44 2010 -0400
     6.3 @@ -0,0 +1,2224 @@
     6.4 +/***
     6.5 + * ASM: a very small and fast Java bytecode manipulation framework
     6.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     6.7 + * All rights reserved.
     6.8 + *
     6.9 + * Redistribution and use in source and binary forms, with or without
    6.10 + * modification, are permitted provided that the following conditions
    6.11 + * are met:
    6.12 + * 1. Redistributions of source code must retain the above copyright
    6.13 + *    notice, this list of conditions and the following disclaimer.
    6.14 + * 2. Redistributions in binary form must reproduce the above copyright
    6.15 + *    notice, this list of conditions and the following disclaimer in the
    6.16 + *    documentation and/or other materials provided with the distribution.
    6.17 + * 3. Neither the name of the copyright holders nor the names of its
    6.18 + *    contributors may be used to endorse or promote products derived from
    6.19 + *    this software without specific prior written permission.
    6.20 + *
    6.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    6.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    6.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    6.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    6.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    6.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    6.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    6.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    6.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    6.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    6.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    6.32 + */
    6.33 +package clojure.asm;
    6.34 +
    6.35 +import java.io.InputStream;
    6.36 +import java.io.IOException;
    6.37 +
    6.38 +/**
    6.39 + * A Java class parser to make a {@link ClassVisitor} visit an existing class.
    6.40 + * This class parses a byte array conforming to the Java class file format and
    6.41 + * calls the appropriate visit methods of a given class visitor for each field,
    6.42 + * method and bytecode instruction encountered.
    6.43 + *
    6.44 + * @author Eric Bruneton
    6.45 + * @author Eugene Kuleshov
    6.46 + */
    6.47 +public class ClassReader{
    6.48 +
    6.49 +/**
    6.50 + * Flag to skip method code. If this class is set <code>CODE</code>
    6.51 + * attribute won't be visited. This can be used, for example, to retrieve
    6.52 + * annotations for methods and method parameters.
    6.53 + */
    6.54 +public final static int SKIP_CODE = 1;
    6.55 +
    6.56 +/**
    6.57 + * Flag to skip the debug information in the class. If this flag is set the
    6.58 + * debug information of the class is not visited, i.e. the
    6.59 + * {@link MethodVisitor#visitLocalVariable visitLocalVariable} and
    6.60 + * {@link MethodVisitor#visitLineNumber visitLineNumber} methods will not be
    6.61 + * called.
    6.62 + */
    6.63 +public final static int SKIP_DEBUG = 2;
    6.64 +
    6.65 +/**
    6.66 + * Flag to skip the stack map frames in the class. If this flag is set the
    6.67 + * stack map frames of the class is not visited, i.e. the
    6.68 + * {@link MethodVisitor#visitFrame visitFrame} method will not be called.
    6.69 + * This flag is useful when the {@link ClassWriter#COMPUTE_FRAMES} option is
    6.70 + * used: it avoids visiting frames that will be ignored and recomputed from
    6.71 + * scratch in the class writer.
    6.72 + */
    6.73 +public final static int SKIP_FRAMES = 4;
    6.74 +
    6.75 +/**
    6.76 + * Flag to expand the stack map frames. By default stack map frames are
    6.77 + * visited in their original format (i.e. "expanded" for classes whose
    6.78 + * version is less than V1_6, and "compressed" for the other classes). If
    6.79 + * this flag is set, stack map frames are always visited in expanded format
    6.80 + * (this option adds a decompression/recompression step in ClassReader and
    6.81 + * ClassWriter which degrades performances quite a lot).
    6.82 + */
    6.83 +public final static int EXPAND_FRAMES = 8;
    6.84 +
    6.85 +/**
    6.86 + * The class to be parsed. <i>The content of this array must not be
    6.87 + * modified. This field is intended for {@link Attribute} sub classes, and
    6.88 + * is normally not needed by class generators or adapters.</i>
    6.89 + */
    6.90 +public final byte[] b;
    6.91 +
    6.92 +/**
    6.93 + * The start index of each constant pool item in {@link #b b}, plus one.
    6.94 + * The one byte offset skips the constant pool item tag that indicates its
    6.95 + * type.
    6.96 + */
    6.97 +private final int[] items;
    6.98 +
    6.99 +/**
   6.100 + * The String objects corresponding to the CONSTANT_Utf8 items. This cache
   6.101 + * avoids multiple parsing of a given CONSTANT_Utf8 constant pool item,
   6.102 + * which GREATLY improves performances (by a factor 2 to 3). This caching
   6.103 + * strategy could be extended to all constant pool items, but its benefit
   6.104 + * would not be so great for these items (because they are much less
   6.105 + * expensive to parse than CONSTANT_Utf8 items).
   6.106 + */
   6.107 +private final String[] strings;
   6.108 +
   6.109 +/**
   6.110 + * Maximum length of the strings contained in the constant pool of the
   6.111 + * class.
   6.112 + */
   6.113 +private final int maxStringLength;
   6.114 +
   6.115 +/**
   6.116 + * Start index of the class header information (access, name...) in
   6.117 + * {@link #b b}.
   6.118 + */
   6.119 +public final int header;
   6.120 +
   6.121 +// ------------------------------------------------------------------------
   6.122 +// Constructors
   6.123 +// ------------------------------------------------------------------------
   6.124 +
   6.125 +/**
   6.126 + * Constructs a new {@link ClassReader} object.
   6.127 + *
   6.128 + * @param b the bytecode of the class to be read.
   6.129 + */
   6.130 +public ClassReader(final byte[] b){
   6.131 +	this(b, 0, b.length);
   6.132 +}
   6.133 +
   6.134 +/**
   6.135 + * Constructs a new {@link ClassReader} object.
   6.136 + *
   6.137 + * @param b   the bytecode of the class to be read.
   6.138 + * @param off the start offset of the class data.
   6.139 + * @param len the length of the class data.
   6.140 + */
   6.141 +public ClassReader(final byte[] b, final int off, final int len){
   6.142 +	this.b = b;
   6.143 +	// parses the constant pool
   6.144 +	items = new int[readUnsignedShort(off + 8)];
   6.145 +	int n = items.length;
   6.146 +	strings = new String[n];
   6.147 +	int max = 0;
   6.148 +	int index = off + 10;
   6.149 +	for(int i = 1; i < n; ++i)
   6.150 +		{
   6.151 +		items[i] = index + 1;
   6.152 +		int size;
   6.153 +		switch(b[index])
   6.154 +			{
   6.155 +			case ClassWriter.FIELD:
   6.156 +			case ClassWriter.METH:
   6.157 +			case ClassWriter.IMETH:
   6.158 +			case ClassWriter.INT:
   6.159 +			case ClassWriter.FLOAT:
   6.160 +			case ClassWriter.NAME_TYPE:
   6.161 +				size = 5;
   6.162 +				break;
   6.163 +			case ClassWriter.LONG:
   6.164 +			case ClassWriter.DOUBLE:
   6.165 +				size = 9;
   6.166 +				++i;
   6.167 +				break;
   6.168 +			case ClassWriter.UTF8:
   6.169 +				size = 3 + readUnsignedShort(index + 1);
   6.170 +				if(size > max)
   6.171 +					{
   6.172 +					max = size;
   6.173 +					}
   6.174 +				break;
   6.175 +				// case ClassWriter.CLASS:
   6.176 +				// case ClassWriter.STR:
   6.177 +			default:
   6.178 +				size = 3;
   6.179 +				break;
   6.180 +			}
   6.181 +		index += size;
   6.182 +		}
   6.183 +	maxStringLength = max;
   6.184 +	// the class header information starts just after the constant pool
   6.185 +	header = index;
   6.186 +}
   6.187 +
   6.188 +/**
   6.189 + * Returns the class's access flags (see {@link Opcodes}). This value may
   6.190 + * not reflect Deprecated and Synthetic flags when bytecode is before 1.5
   6.191 + * and those flags are represented by attributes.
   6.192 + *
   6.193 + * @return the class access flags
   6.194 + * @see ClassVisitor#visit(int,int,String,String,String,String[])
   6.195 + */
   6.196 +public int getAccess(){
   6.197 +	return readUnsignedShort(header);
   6.198 +}
   6.199 +
   6.200 +/**
   6.201 + * Returns the internal name of the class (see
   6.202 + * {@link Type#getInternalName() getInternalName}).
   6.203 + *
   6.204 + * @return the internal class name
   6.205 + * @see ClassVisitor#visit(int,int,String,String,String,String[])
   6.206 + */
   6.207 +public String getClassName(){
   6.208 +	return readClass(header + 2, new char[maxStringLength]);
   6.209 +}
   6.210 +
   6.211 +/**
   6.212 + * Returns the internal of name of the super class (see
   6.213 + * {@link Type#getInternalName() getInternalName}). For interfaces, the
   6.214 + * super class is {@link Object}.
   6.215 + *
   6.216 + * @return the internal name of super class, or <tt>null</tt> for
   6.217 + *         {@link Object} class.
   6.218 + * @see ClassVisitor#visit(int,int,String,String,String,String[])
   6.219 + */
   6.220 +public String getSuperName(){
   6.221 +	int n = items[readUnsignedShort(header + 4)];
   6.222 +	return n == 0 ? null : readUTF8(n, new char[maxStringLength]);
   6.223 +}
   6.224 +
   6.225 +/**
   6.226 + * Returns the internal names of the class's interfaces (see
   6.227 + * {@link Type#getInternalName() getInternalName}).
   6.228 + *
   6.229 + * @return the array of internal names for all implemented interfaces or
   6.230 + *         <tt>null</tt>.
   6.231 + * @see ClassVisitor#visit(int,int,String,String,String,String[])
   6.232 + */
   6.233 +public String[] getInterfaces(){
   6.234 +	int index = header + 6;
   6.235 +	int n = readUnsignedShort(index);
   6.236 +	String[] interfaces = new String[n];
   6.237 +	if(n > 0)
   6.238 +		{
   6.239 +		char[] buf = new char[maxStringLength];
   6.240 +		for(int i = 0; i < n; ++i)
   6.241 +			{
   6.242 +			index += 2;
   6.243 +			interfaces[i] = readClass(index, buf);
   6.244 +			}
   6.245 +		}
   6.246 +	return interfaces;
   6.247 +}
   6.248 +
   6.249 +/**
   6.250 + * Copies the constant pool data into the given {@link ClassWriter}. Should
   6.251 + * be called before the {@link #accept(ClassVisitor,int)} method.
   6.252 + *
   6.253 + * @param classWriter the {@link ClassWriter} to copy constant pool into.
   6.254 + */
   6.255 +void copyPool(final ClassWriter classWriter){
   6.256 +	char[] buf = new char[maxStringLength];
   6.257 +	int ll = items.length;
   6.258 +	Item[] items2 = new Item[ll];
   6.259 +	for(int i = 1; i < ll; i++)
   6.260 +		{
   6.261 +		int index = items[i];
   6.262 +		int tag = b[index - 1];
   6.263 +		Item item = new Item(i);
   6.264 +		int nameType;
   6.265 +		switch(tag)
   6.266 +			{
   6.267 +			case ClassWriter.FIELD:
   6.268 +			case ClassWriter.METH:
   6.269 +			case ClassWriter.IMETH:
   6.270 +				nameType = items[readUnsignedShort(index + 2)];
   6.271 +				item.set(tag,
   6.272 +				         readClass(index, buf),
   6.273 +				         readUTF8(nameType, buf),
   6.274 +				         readUTF8(nameType + 2, buf));
   6.275 +				break;
   6.276 +
   6.277 +			case ClassWriter.INT:
   6.278 +				item.set(readInt(index));
   6.279 +				break;
   6.280 +
   6.281 +			case ClassWriter.FLOAT:
   6.282 +				item.set(Float.intBitsToFloat(readInt(index)));
   6.283 +				break;
   6.284 +
   6.285 +			case ClassWriter.NAME_TYPE:
   6.286 +				item.set(tag,
   6.287 +				         readUTF8(index, buf),
   6.288 +				         readUTF8(index + 2, buf),
   6.289 +				         null);
   6.290 +				break;
   6.291 +
   6.292 +			case ClassWriter.LONG:
   6.293 +				item.set(readLong(index));
   6.294 +				++i;
   6.295 +				break;
   6.296 +
   6.297 +			case ClassWriter.DOUBLE:
   6.298 +				item.set(Double.longBitsToDouble(readLong(index)));
   6.299 +				++i;
   6.300 +				break;
   6.301 +
   6.302 +			case ClassWriter.UTF8:
   6.303 +			{
   6.304 +			String s = strings[i];
   6.305 +			if(s == null)
   6.306 +				{
   6.307 +				index = items[i];
   6.308 +				s = strings[i] = readUTF(index + 2,
   6.309 +				                         readUnsignedShort(index),
   6.310 +				                         buf);
   6.311 +				}
   6.312 +			item.set(tag, s, null, null);
   6.313 +			}
   6.314 +			break;
   6.315 +
   6.316 +			// case ClassWriter.STR:
   6.317 +			// case ClassWriter.CLASS:
   6.318 +			default:
   6.319 +				item.set(tag, readUTF8(index, buf), null, null);
   6.320 +				break;
   6.321 +			}
   6.322 +
   6.323 +		int index2 = item.hashCode % items2.length;
   6.324 +		item.next = items2[index2];
   6.325 +		items2[index2] = item;
   6.326 +		}
   6.327 +
   6.328 +	int off = items[1] - 1;
   6.329 +	classWriter.pool.putByteArray(b, off, header - off);
   6.330 +	classWriter.items = items2;
   6.331 +	classWriter.threshold = (int) (0.75d * ll);
   6.332 +	classWriter.index = ll;
   6.333 +}
   6.334 +
   6.335 +/**
   6.336 + * Constructs a new {@link ClassReader} object.
   6.337 + *
   6.338 + * @param is an input stream from which to read the class.
   6.339 + * @throws IOException if a problem occurs during reading.
   6.340 + */
   6.341 +public ClassReader(final InputStream is) throws IOException{
   6.342 +	this(readClass(is));
   6.343 +}
   6.344 +
   6.345 +/**
   6.346 + * Constructs a new {@link ClassReader} object.
   6.347 + *
   6.348 + * @param name the fully qualified name of the class to be read.
   6.349 + * @throws IOException if an exception occurs during reading.
   6.350 + */
   6.351 +public ClassReader(final String name) throws IOException{
   6.352 +	this(ClassLoader.getSystemResourceAsStream(name.replace('.', '/')
   6.353 +	                                           + ".class"));
   6.354 +}
   6.355 +
   6.356 +/**
   6.357 + * Reads the bytecode of a class.
   6.358 + *
   6.359 + * @param is an input stream from which to read the class.
   6.360 + * @return the bytecode read from the given input stream.
   6.361 + * @throws IOException if a problem occurs during reading.
   6.362 + */
   6.363 +private static byte[] readClass(final InputStream is) throws IOException{
   6.364 +	if(is == null)
   6.365 +		{
   6.366 +		throw new IOException("Class not found");
   6.367 +		}
   6.368 +	byte[] b = new byte[is.available()];
   6.369 +	int len = 0;
   6.370 +	while(true)
   6.371 +		{
   6.372 +		int n = is.read(b, len, b.length - len);
   6.373 +		if(n == -1)
   6.374 +			{
   6.375 +			if(len < b.length)
   6.376 +				{
   6.377 +				byte[] c = new byte[len];
   6.378 +				System.arraycopy(b, 0, c, 0, len);
   6.379 +				b = c;
   6.380 +				}
   6.381 +			return b;
   6.382 +			}
   6.383 +		len += n;
   6.384 +		if(len == b.length)
   6.385 +			{
   6.386 +			byte[] c = new byte[b.length + 1000];
   6.387 +			System.arraycopy(b, 0, c, 0, len);
   6.388 +			b = c;
   6.389 +			}
   6.390 +		}
   6.391 +}
   6.392 +
   6.393 +// ------------------------------------------------------------------------
   6.394 +// Public methods
   6.395 +// ------------------------------------------------------------------------
   6.396 +
   6.397 +/**
   6.398 + * Makes the given visitor visit the Java class of this {@link ClassReader}.
   6.399 + * This class is the one specified in the constructor (see
   6.400 + * {@link #ClassReader(byte[]) ClassReader}).
   6.401 + *
   6.402 + * @param classVisitor the visitor that must visit this class.
   6.403 + * @param flags        option flags that can be used to modify the default behavior
   6.404 + *                     of this class. See {@link #SKIP_DEBUG}, {@link #EXPAND_FRAMES}.
   6.405 + */
   6.406 +public void accept(final ClassVisitor classVisitor, final int flags){
   6.407 +	accept(classVisitor, new Attribute[0], flags);
   6.408 +}
   6.409 +
   6.410 +/**
   6.411 + * Makes the given visitor visit the Java class of this {@link ClassReader}.
   6.412 + * This class is the one specified in the constructor (see
   6.413 + * {@link #ClassReader(byte[]) ClassReader}).
   6.414 + *
   6.415 + * @param classVisitor the visitor that must visit this class.
   6.416 + * @param attrs        prototypes of the attributes that must be parsed during the
   6.417 + *                     visit of the class. Any attribute whose type is not equal to the
   6.418 + *                     type of one the prototypes will not be parsed: its byte array
   6.419 + *                     value will be passed unchanged to the ClassWriter. <i>This may
   6.420 + *                     corrupt it if this value contains references to the constant pool,
   6.421 + *                     or has syntactic or semantic links with a class element that has
   6.422 + *                     been transformed by a class adapter between the reader and the
   6.423 + *                     writer</i>.
   6.424 + * @param flags        option flags that can be used to modify the default behavior
   6.425 + *                     of this class. See {@link #SKIP_DEBUG}, {@link #EXPAND_FRAMES}.
   6.426 + */
   6.427 +public void accept(
   6.428 +		final ClassVisitor classVisitor,
   6.429 +		final Attribute[] attrs,
   6.430 +		final int flags){
   6.431 +	byte[] b = this.b; // the bytecode array
   6.432 +	char[] c = new char[maxStringLength]; // buffer used to read strings
   6.433 +	int i, j, k; // loop variables
   6.434 +	int u, v, w; // indexes in b
   6.435 +	Attribute attr;
   6.436 +
   6.437 +	int access;
   6.438 +	String name;
   6.439 +	String desc;
   6.440 +	String attrName;
   6.441 +	String signature;
   6.442 +	int anns = 0;
   6.443 +	int ianns = 0;
   6.444 +	Attribute cattrs = null;
   6.445 +
   6.446 +	// visits the header
   6.447 +	u = header;
   6.448 +	access = readUnsignedShort(u);
   6.449 +	name = readClass(u + 2, c);
   6.450 +	v = items[readUnsignedShort(u + 4)];
   6.451 +	String superClassName = v == 0 ? null : readUTF8(v, c);
   6.452 +	String[] implementedItfs = new String[readUnsignedShort(u + 6)];
   6.453 +	w = 0;
   6.454 +	u += 8;
   6.455 +	for(i = 0; i < implementedItfs.length; ++i)
   6.456 +		{
   6.457 +		implementedItfs[i] = readClass(u, c);
   6.458 +		u += 2;
   6.459 +		}
   6.460 +
   6.461 +	boolean skipCode = (flags & SKIP_CODE) != 0;
   6.462 +	boolean skipDebug = (flags & SKIP_DEBUG) != 0;
   6.463 +	boolean unzip = (flags & EXPAND_FRAMES) != 0;
   6.464 +
   6.465 +	// skips fields and methods
   6.466 +	v = u;
   6.467 +	i = readUnsignedShort(v);
   6.468 +	v += 2;
   6.469 +	for(; i > 0; --i)
   6.470 +		{
   6.471 +		j = readUnsignedShort(v + 6);
   6.472 +		v += 8;
   6.473 +		for(; j > 0; --j)
   6.474 +			{
   6.475 +			v += 6 + readInt(v + 2);
   6.476 +			}
   6.477 +		}
   6.478 +	i = readUnsignedShort(v);
   6.479 +	v += 2;
   6.480 +	for(; i > 0; --i)
   6.481 +		{
   6.482 +		j = readUnsignedShort(v + 6);
   6.483 +		v += 8;
   6.484 +		for(; j > 0; --j)
   6.485 +			{
   6.486 +			v += 6 + readInt(v + 2);
   6.487 +			}
   6.488 +		}
   6.489 +	// reads the class's attributes
   6.490 +	signature = null;
   6.491 +	String sourceFile = null;
   6.492 +	String sourceDebug = null;
   6.493 +	String enclosingOwner = null;
   6.494 +	String enclosingName = null;
   6.495 +	String enclosingDesc = null;
   6.496 +
   6.497 +	i = readUnsignedShort(v);
   6.498 +	v += 2;
   6.499 +	for(; i > 0; --i)
   6.500 +		{
   6.501 +		attrName = readUTF8(v, c);
   6.502 +		// tests are sorted in decreasing frequency order
   6.503 +		// (based on frequencies observed on typical classes)
   6.504 +		if(attrName.equals("SourceFile"))
   6.505 +			{
   6.506 +			sourceFile = readUTF8(v + 6, c);
   6.507 +			}
   6.508 +		else if(attrName.equals("InnerClasses"))
   6.509 +			{
   6.510 +			w = v + 6;
   6.511 +			}
   6.512 +		else if(attrName.equals("EnclosingMethod"))
   6.513 +			{
   6.514 +			enclosingOwner = readClass(v + 6, c);
   6.515 +			int item = readUnsignedShort(v + 8);
   6.516 +			if(item != 0)
   6.517 +				{
   6.518 +				enclosingName = readUTF8(items[item], c);
   6.519 +				enclosingDesc = readUTF8(items[item] + 2, c);
   6.520 +				}
   6.521 +			}
   6.522 +		else if(attrName.equals("Signature"))
   6.523 +			{
   6.524 +			signature = readUTF8(v + 6, c);
   6.525 +			}
   6.526 +		else if(attrName.equals("RuntimeVisibleAnnotations"))
   6.527 +			{
   6.528 +			anns = v + 6;
   6.529 +			}
   6.530 +		else if(attrName.equals("Deprecated"))
   6.531 +			{
   6.532 +			access |= Opcodes.ACC_DEPRECATED;
   6.533 +			}
   6.534 +		else if(attrName.equals("Synthetic"))
   6.535 +			{
   6.536 +			access |= Opcodes.ACC_SYNTHETIC;
   6.537 +			}
   6.538 +		else if(attrName.equals("SourceDebugExtension"))
   6.539 +			{
   6.540 +			int len = readInt(v + 2);
   6.541 +			sourceDebug = readUTF(v + 6, len, new char[len]);
   6.542 +			}
   6.543 +		else if(attrName.equals("RuntimeInvisibleAnnotations"))
   6.544 +			{
   6.545 +			ianns = v + 6;
   6.546 +			}
   6.547 +		else
   6.548 +			{
   6.549 +			attr = readAttribute(attrs,
   6.550 +			                     attrName,
   6.551 +			                     v + 6,
   6.552 +			                     readInt(v + 2),
   6.553 +			                     c,
   6.554 +			                     -1,
   6.555 +			                     null);
   6.556 +			if(attr != null)
   6.557 +				{
   6.558 +				attr.next = cattrs;
   6.559 +				cattrs = attr;
   6.560 +				}
   6.561 +			}
   6.562 +		v += 6 + readInt(v + 2);
   6.563 +		}
   6.564 +	// calls the visit method
   6.565 +	classVisitor.visit(readInt(4),
   6.566 +	                   access,
   6.567 +	                   name,
   6.568 +	                   signature,
   6.569 +	                   superClassName,
   6.570 +	                   implementedItfs);
   6.571 +
   6.572 +	// calls the visitSource method
   6.573 +	if(!skipDebug && (sourceFile != null || sourceDebug != null))
   6.574 +		{
   6.575 +		classVisitor.visitSource(sourceFile, sourceDebug);
   6.576 +		}
   6.577 +
   6.578 +	// calls the visitOuterClass method
   6.579 +	if(enclosingOwner != null)
   6.580 +		{
   6.581 +		classVisitor.visitOuterClass(enclosingOwner,
   6.582 +		                             enclosingName,
   6.583 +		                             enclosingDesc);
   6.584 +		}
   6.585 +
   6.586 +	// visits the class annotations
   6.587 +	for(i = 1; i >= 0; --i)
   6.588 +		{
   6.589 +		v = i == 0 ? ianns : anns;
   6.590 +		if(v != 0)
   6.591 +			{
   6.592 +			j = readUnsignedShort(v);
   6.593 +			v += 2;
   6.594 +			for(; j > 0; --j)
   6.595 +				{
   6.596 +				v = readAnnotationValues(v + 2,
   6.597 +				                         c,
   6.598 +				                         true,
   6.599 +				                         classVisitor.visitAnnotation(readUTF8(v, c), i != 0));
   6.600 +				}
   6.601 +			}
   6.602 +		}
   6.603 +
   6.604 +	// visits the class attributes
   6.605 +	while(cattrs != null)
   6.606 +		{
   6.607 +		attr = cattrs.next;
   6.608 +		cattrs.next = null;
   6.609 +		classVisitor.visitAttribute(cattrs);
   6.610 +		cattrs = attr;
   6.611 +		}
   6.612 +
   6.613 +	// calls the visitInnerClass method
   6.614 +	if(w != 0)
   6.615 +		{
   6.616 +		i = readUnsignedShort(w);
   6.617 +		w += 2;
   6.618 +		for(; i > 0; --i)
   6.619 +			{
   6.620 +			classVisitor.visitInnerClass(readUnsignedShort(w) == 0
   6.621 +			                             ? null
   6.622 +			                             : readClass(w, c), readUnsignedShort(w + 2) == 0
   6.623 +			                                                ? null
   6.624 +			                                                : readClass(w + 2, c), readUnsignedShort(w + 4) == 0
   6.625 +			                                                                       ? null
   6.626 +			                                                                       : readUTF8(w + 4, c),
   6.627 +			                                                                       readUnsignedShort(w + 6));
   6.628 +			w += 8;
   6.629 +			}
   6.630 +		}
   6.631 +
   6.632 +	// visits the fields
   6.633 +	i = readUnsignedShort(u);
   6.634 +	u += 2;
   6.635 +	for(; i > 0; --i)
   6.636 +		{
   6.637 +		access = readUnsignedShort(u);
   6.638 +		name = readUTF8(u + 2, c);
   6.639 +		desc = readUTF8(u + 4, c);
   6.640 +		// visits the field's attributes and looks for a ConstantValue
   6.641 +		// attribute
   6.642 +		int fieldValueItem = 0;
   6.643 +		signature = null;
   6.644 +		anns = 0;
   6.645 +		ianns = 0;
   6.646 +		cattrs = null;
   6.647 +
   6.648 +		j = readUnsignedShort(u + 6);
   6.649 +		u += 8;
   6.650 +		for(; j > 0; --j)
   6.651 +			{
   6.652 +			attrName = readUTF8(u, c);
   6.653 +			// tests are sorted in decreasing frequency order
   6.654 +			// (based on frequencies observed on typical classes)
   6.655 +			if(attrName.equals("ConstantValue"))
   6.656 +				{
   6.657 +				fieldValueItem = readUnsignedShort(u + 6);
   6.658 +				}
   6.659 +			else if(attrName.equals("Signature"))
   6.660 +				{
   6.661 +				signature = readUTF8(u + 6, c);
   6.662 +				}
   6.663 +			else if(attrName.equals("Deprecated"))
   6.664 +				{
   6.665 +				access |= Opcodes.ACC_DEPRECATED;
   6.666 +				}
   6.667 +			else if(attrName.equals("Synthetic"))
   6.668 +				{
   6.669 +				access |= Opcodes.ACC_SYNTHETIC;
   6.670 +				}
   6.671 +			else if(attrName.equals("RuntimeVisibleAnnotations"))
   6.672 +				{
   6.673 +				anns = u + 6;
   6.674 +				}
   6.675 +			else if(attrName.equals("RuntimeInvisibleAnnotations"))
   6.676 +				{
   6.677 +				ianns = u + 6;
   6.678 +				}
   6.679 +			else
   6.680 +				{
   6.681 +				attr = readAttribute(attrs,
   6.682 +				                     attrName,
   6.683 +				                     u + 6,
   6.684 +				                     readInt(u + 2),
   6.685 +				                     c,
   6.686 +				                     -1,
   6.687 +				                     null);
   6.688 +				if(attr != null)
   6.689 +					{
   6.690 +					attr.next = cattrs;
   6.691 +					cattrs = attr;
   6.692 +					}
   6.693 +				}
   6.694 +			u += 6 + readInt(u + 2);
   6.695 +			}
   6.696 +		// visits the field
   6.697 +		FieldVisitor fv = classVisitor.visitField(access,
   6.698 +		                                          name,
   6.699 +		                                          desc,
   6.700 +		                                          signature,
   6.701 +		                                          fieldValueItem == 0 ? null : readConst(fieldValueItem, c));
   6.702 +		// visits the field annotations and attributes
   6.703 +		if(fv != null)
   6.704 +			{
   6.705 +			for(j = 1; j >= 0; --j)
   6.706 +				{
   6.707 +				v = j == 0 ? ianns : anns;
   6.708 +				if(v != 0)
   6.709 +					{
   6.710 +					k = readUnsignedShort(v);
   6.711 +					v += 2;
   6.712 +					for(; k > 0; --k)
   6.713 +						{
   6.714 +						v = readAnnotationValues(v + 2,
   6.715 +						                         c,
   6.716 +						                         true,
   6.717 +						                         fv.visitAnnotation(readUTF8(v, c), j != 0));
   6.718 +						}
   6.719 +					}
   6.720 +				}
   6.721 +			while(cattrs != null)
   6.722 +				{
   6.723 +				attr = cattrs.next;
   6.724 +				cattrs.next = null;
   6.725 +				fv.visitAttribute(cattrs);
   6.726 +				cattrs = attr;
   6.727 +				}
   6.728 +			fv.visitEnd();
   6.729 +			}
   6.730 +		}
   6.731 +
   6.732 +	// visits the methods
   6.733 +	i = readUnsignedShort(u);
   6.734 +	u += 2;
   6.735 +	for(; i > 0; --i)
   6.736 +		{
   6.737 +		int u0 = u + 6;
   6.738 +		access = readUnsignedShort(u);
   6.739 +		name = readUTF8(u + 2, c);
   6.740 +		desc = readUTF8(u + 4, c);
   6.741 +		signature = null;
   6.742 +		anns = 0;
   6.743 +		ianns = 0;
   6.744 +		int dann = 0;
   6.745 +		int mpanns = 0;
   6.746 +		int impanns = 0;
   6.747 +		cattrs = null;
   6.748 +		v = 0;
   6.749 +		w = 0;
   6.750 +
   6.751 +		// looks for Code and Exceptions attributes
   6.752 +		j = readUnsignedShort(u + 6);
   6.753 +		u += 8;
   6.754 +		for(; j > 0; --j)
   6.755 +			{
   6.756 +			attrName = readUTF8(u, c);
   6.757 +			int attrSize = readInt(u + 2);
   6.758 +			u += 6;
   6.759 +			// tests are sorted in decreasing frequency order
   6.760 +			// (based on frequencies observed on typical classes)
   6.761 +			if(attrName.equals("Code"))
   6.762 +				{
   6.763 +				if(!skipCode)
   6.764 +					{
   6.765 +					v = u;
   6.766 +					}
   6.767 +				}
   6.768 +			else if(attrName.equals("Exceptions"))
   6.769 +				{
   6.770 +				w = u;
   6.771 +				}
   6.772 +			else if(attrName.equals("Signature"))
   6.773 +				{
   6.774 +				signature = readUTF8(u, c);
   6.775 +				}
   6.776 +			else if(attrName.equals("Deprecated"))
   6.777 +				{
   6.778 +				access |= Opcodes.ACC_DEPRECATED;
   6.779 +				}
   6.780 +			else if(attrName.equals("RuntimeVisibleAnnotations"))
   6.781 +				{
   6.782 +				anns = u;
   6.783 +				}
   6.784 +			else if(attrName.equals("AnnotationDefault"))
   6.785 +				{
   6.786 +				dann = u;
   6.787 +				}
   6.788 +			else if(attrName.equals("Synthetic"))
   6.789 +				{
   6.790 +				access |= Opcodes.ACC_SYNTHETIC;
   6.791 +				}
   6.792 +			else if(attrName.equals("RuntimeInvisibleAnnotations"))
   6.793 +				{
   6.794 +				ianns = u;
   6.795 +				}
   6.796 +			else if(attrName.equals("RuntimeVisibleParameterAnnotations"))
   6.797 +				{
   6.798 +				mpanns = u;
   6.799 +				}
   6.800 +			else if(attrName.equals("RuntimeInvisibleParameterAnnotations"))
   6.801 +				{
   6.802 +				impanns = u;
   6.803 +				}
   6.804 +			else
   6.805 +				{
   6.806 +				attr = readAttribute(attrs,
   6.807 +				                     attrName,
   6.808 +				                     u,
   6.809 +				                     attrSize,
   6.810 +				                     c,
   6.811 +				                     -1,
   6.812 +				                     null);
   6.813 +				if(attr != null)
   6.814 +					{
   6.815 +					attr.next = cattrs;
   6.816 +					cattrs = attr;
   6.817 +					}
   6.818 +				}
   6.819 +			u += attrSize;
   6.820 +			}
   6.821 +		// reads declared exceptions
   6.822 +		String[] exceptions;
   6.823 +		if(w == 0)
   6.824 +			{
   6.825 +			exceptions = null;
   6.826 +			}
   6.827 +		else
   6.828 +			{
   6.829 +			exceptions = new String[readUnsignedShort(w)];
   6.830 +			w += 2;
   6.831 +			for(j = 0; j < exceptions.length; ++j)
   6.832 +				{
   6.833 +				exceptions[j] = readClass(w, c);
   6.834 +				w += 2;
   6.835 +				}
   6.836 +			}
   6.837 +
   6.838 +		// visits the method's code, if any
   6.839 +		MethodVisitor mv = classVisitor.visitMethod(access,
   6.840 +		                                            name,
   6.841 +		                                            desc,
   6.842 +		                                            signature,
   6.843 +		                                            exceptions);
   6.844 +
   6.845 +		if(mv != null)
   6.846 +			{
   6.847 +			/*
   6.848 +							 * if the returned MethodVisitor is in fact a MethodWriter, it
   6.849 +							 * means there is no method adapter between the reader and the
   6.850 +							 * writer. If, in addition, the writer's constant pool was
   6.851 +							 * copied from this reader (mw.cw.cr == this), and the signature
   6.852 +							 * and exceptions of the method have not been changed, then it
   6.853 +							 * is possible to skip all visit events and just copy the
   6.854 +							 * original code of the method to the writer (the access, name
   6.855 +							 * and descriptor can have been changed, this is not important
   6.856 +							 * since they are not copied as is from the reader).
   6.857 +							 */
   6.858 +			if(mv instanceof MethodWriter)
   6.859 +				{
   6.860 +				MethodWriter mw = (MethodWriter) mv;
   6.861 +				if(mw.cw.cr == this)
   6.862 +					{
   6.863 +					if(signature == mw.signature)
   6.864 +						{
   6.865 +						boolean sameExceptions = false;
   6.866 +						if(exceptions == null)
   6.867 +							{
   6.868 +							sameExceptions = mw.exceptionCount == 0;
   6.869 +							}
   6.870 +						else
   6.871 +							{
   6.872 +							if(exceptions.length == mw.exceptionCount)
   6.873 +								{
   6.874 +								sameExceptions = true;
   6.875 +								for(j = exceptions.length - 1; j >= 0; --j)
   6.876 +									{
   6.877 +									w -= 2;
   6.878 +									if(mw.exceptions[j] != readUnsignedShort(w))
   6.879 +										{
   6.880 +										sameExceptions = false;
   6.881 +										break;
   6.882 +										}
   6.883 +									}
   6.884 +								}
   6.885 +							}
   6.886 +						if(sameExceptions)
   6.887 +							{
   6.888 +							/*
   6.889 +															 * we do not copy directly the code into
   6.890 +															 * MethodWriter to save a byte array copy
   6.891 +															 * operation. The real copy will be done in
   6.892 +															 * ClassWriter.toByteArray().
   6.893 +															 */
   6.894 +							mw.classReaderOffset = u0;
   6.895 +							mw.classReaderLength = u - u0;
   6.896 +							continue;
   6.897 +							}
   6.898 +						}
   6.899 +					}
   6.900 +				}
   6.901 +
   6.902 +			if(dann != 0)
   6.903 +				{
   6.904 +				AnnotationVisitor dv = mv.visitAnnotationDefault();
   6.905 +				readAnnotationValue(dann, c, null, dv);
   6.906 +				if(dv != null)
   6.907 +					{
   6.908 +					dv.visitEnd();
   6.909 +					}
   6.910 +				}
   6.911 +			for(j = 1; j >= 0; --j)
   6.912 +				{
   6.913 +				w = j == 0 ? ianns : anns;
   6.914 +				if(w != 0)
   6.915 +					{
   6.916 +					k = readUnsignedShort(w);
   6.917 +					w += 2;
   6.918 +					for(; k > 0; --k)
   6.919 +						{
   6.920 +						w = readAnnotationValues(w + 2,
   6.921 +						                         c,
   6.922 +						                         true,
   6.923 +						                         mv.visitAnnotation(readUTF8(w, c), j != 0));
   6.924 +						}
   6.925 +					}
   6.926 +				}
   6.927 +			if(mpanns != 0)
   6.928 +				{
   6.929 +				readParameterAnnotations(mpanns, c, true, mv);
   6.930 +				}
   6.931 +			if(impanns != 0)
   6.932 +				{
   6.933 +				readParameterAnnotations(impanns, c, false, mv);
   6.934 +				}
   6.935 +			while(cattrs != null)
   6.936 +				{
   6.937 +				attr = cattrs.next;
   6.938 +				cattrs.next = null;
   6.939 +				mv.visitAttribute(cattrs);
   6.940 +				cattrs = attr;
   6.941 +				}
   6.942 +			}
   6.943 +
   6.944 +		if(mv != null && v != 0)
   6.945 +			{
   6.946 +			int maxStack = readUnsignedShort(v);
   6.947 +			int maxLocals = readUnsignedShort(v + 2);
   6.948 +			int codeLength = readInt(v + 4);
   6.949 +			v += 8;
   6.950 +
   6.951 +			int codeStart = v;
   6.952 +			int codeEnd = v + codeLength;
   6.953 +
   6.954 +			mv.visitCode();
   6.955 +
   6.956 +			// 1st phase: finds the labels
   6.957 +			int label;
   6.958 +			Label[] labels = new Label[codeLength + 1];
   6.959 +			while(v < codeEnd)
   6.960 +				{
   6.961 +				int opcode = b[v] & 0xFF;
   6.962 +				switch(ClassWriter.TYPE[opcode])
   6.963 +					{
   6.964 +					case ClassWriter.NOARG_INSN:
   6.965 +					case ClassWriter.IMPLVAR_INSN:
   6.966 +						v += 1;
   6.967 +						break;
   6.968 +					case ClassWriter.LABEL_INSN:
   6.969 +						label = v - codeStart + readShort(v + 1);
   6.970 +						if(labels[label] == null)
   6.971 +							{
   6.972 +							labels[label] = new Label();
   6.973 +							}
   6.974 +						v += 3;
   6.975 +						break;
   6.976 +					case ClassWriter.LABELW_INSN:
   6.977 +						label = v - codeStart + readInt(v + 1);
   6.978 +						if(labels[label] == null)
   6.979 +							{
   6.980 +							labels[label] = new Label();
   6.981 +							}
   6.982 +						v += 5;
   6.983 +						break;
   6.984 +					case ClassWriter.WIDE_INSN:
   6.985 +						opcode = b[v + 1] & 0xFF;
   6.986 +						if(opcode == Opcodes.IINC)
   6.987 +							{
   6.988 +							v += 6;
   6.989 +							}
   6.990 +						else
   6.991 +							{
   6.992 +							v += 4;
   6.993 +							}
   6.994 +						break;
   6.995 +					case ClassWriter.TABL_INSN:
   6.996 +						// skips 0 to 3 padding bytes
   6.997 +						w = v - codeStart;
   6.998 +						v = v + 4 - (w & 3);
   6.999 +						// reads instruction
  6.1000 +						label = w + readInt(v);
  6.1001 +						if(labels[label] == null)
  6.1002 +							{
  6.1003 +							labels[label] = new Label();
  6.1004 +							}
  6.1005 +						j = readInt(v + 8) - readInt(v + 4) + 1;
  6.1006 +						v += 12;
  6.1007 +						for(; j > 0; --j)
  6.1008 +							{
  6.1009 +							label = w + readInt(v);
  6.1010 +							v += 4;
  6.1011 +							if(labels[label] == null)
  6.1012 +								{
  6.1013 +								labels[label] = new Label();
  6.1014 +								}
  6.1015 +							}
  6.1016 +						break;
  6.1017 +					case ClassWriter.LOOK_INSN:
  6.1018 +						// skips 0 to 3 padding bytes
  6.1019 +						w = v - codeStart;
  6.1020 +						v = v + 4 - (w & 3);
  6.1021 +						// reads instruction
  6.1022 +						label = w + readInt(v);
  6.1023 +						if(labels[label] == null)
  6.1024 +							{
  6.1025 +							labels[label] = new Label();
  6.1026 +							}
  6.1027 +						j = readInt(v + 4);
  6.1028 +						v += 8;
  6.1029 +						for(; j > 0; --j)
  6.1030 +							{
  6.1031 +							label = w + readInt(v + 4);
  6.1032 +							v += 8;
  6.1033 +							if(labels[label] == null)
  6.1034 +								{
  6.1035 +								labels[label] = new Label();
  6.1036 +								}
  6.1037 +							}
  6.1038 +						break;
  6.1039 +					case ClassWriter.VAR_INSN:
  6.1040 +					case ClassWriter.SBYTE_INSN:
  6.1041 +					case ClassWriter.LDC_INSN:
  6.1042 +						v += 2;
  6.1043 +						break;
  6.1044 +					case ClassWriter.SHORT_INSN:
  6.1045 +					case ClassWriter.LDCW_INSN:
  6.1046 +					case ClassWriter.FIELDORMETH_INSN:
  6.1047 +					case ClassWriter.TYPE_INSN:
  6.1048 +					case ClassWriter.IINC_INSN:
  6.1049 +						v += 3;
  6.1050 +						break;
  6.1051 +					case ClassWriter.ITFMETH_INSN:
  6.1052 +						v += 5;
  6.1053 +						break;
  6.1054 +						// case MANA_INSN:
  6.1055 +					default:
  6.1056 +						v += 4;
  6.1057 +						break;
  6.1058 +					}
  6.1059 +				}
  6.1060 +			// parses the try catch entries
  6.1061 +			j = readUnsignedShort(v);
  6.1062 +			v += 2;
  6.1063 +			for(; j > 0; --j)
  6.1064 +				{
  6.1065 +				label = readUnsignedShort(v);
  6.1066 +				Label start = labels[label];
  6.1067 +				if(start == null)
  6.1068 +					{
  6.1069 +					labels[label] = start = new Label();
  6.1070 +					}
  6.1071 +				label = readUnsignedShort(v + 2);
  6.1072 +				Label end = labels[label];
  6.1073 +				if(end == null)
  6.1074 +					{
  6.1075 +					labels[label] = end = new Label();
  6.1076 +					}
  6.1077 +				label = readUnsignedShort(v + 4);
  6.1078 +				Label handler = labels[label];
  6.1079 +				if(handler == null)
  6.1080 +					{
  6.1081 +					labels[label] = handler = new Label();
  6.1082 +					}
  6.1083 +				int type = readUnsignedShort(v + 6);
  6.1084 +				if(type == 0)
  6.1085 +					{
  6.1086 +					mv.visitTryCatchBlock(start, end, handler, null);
  6.1087 +					}
  6.1088 +				else
  6.1089 +					{
  6.1090 +					mv.visitTryCatchBlock(start,
  6.1091 +					                      end,
  6.1092 +					                      handler,
  6.1093 +					                      readUTF8(items[type], c));
  6.1094 +					}
  6.1095 +				v += 8;
  6.1096 +				}
  6.1097 +			// parses the local variable, line number tables, and code
  6.1098 +			// attributes
  6.1099 +			int varTable = 0;
  6.1100 +			int varTypeTable = 0;
  6.1101 +			int stackMap = 0;
  6.1102 +			int frameCount = 0;
  6.1103 +			int frameMode = 0;
  6.1104 +			int frameOffset = 0;
  6.1105 +			int frameLocalCount = 0;
  6.1106 +			int frameLocalDiff = 0;
  6.1107 +			int frameStackCount = 0;
  6.1108 +			Object[] frameLocal = null;
  6.1109 +			Object[] frameStack = null;
  6.1110 +			boolean zip = true;
  6.1111 +			cattrs = null;
  6.1112 +			j = readUnsignedShort(v);
  6.1113 +			v += 2;
  6.1114 +			for(; j > 0; --j)
  6.1115 +				{
  6.1116 +				attrName = readUTF8(v, c);
  6.1117 +				if(attrName.equals("LocalVariableTable"))
  6.1118 +					{
  6.1119 +					if(!skipDebug)
  6.1120 +						{
  6.1121 +						varTable = v + 6;
  6.1122 +						k = readUnsignedShort(v + 6);
  6.1123 +						w = v + 8;
  6.1124 +						for(; k > 0; --k)
  6.1125 +							{
  6.1126 +							label = readUnsignedShort(w);
  6.1127 +							if(labels[label] == null)
  6.1128 +								{
  6.1129 +								labels[label] = new Label(true);
  6.1130 +								}
  6.1131 +							label += readUnsignedShort(w + 2);
  6.1132 +							if(labels[label] == null)
  6.1133 +								{
  6.1134 +								labels[label] = new Label(true);
  6.1135 +								}
  6.1136 +							w += 10;
  6.1137 +							}
  6.1138 +						}
  6.1139 +					}
  6.1140 +				else if(attrName.equals("LocalVariableTypeTable"))
  6.1141 +					{
  6.1142 +					varTypeTable = v + 6;
  6.1143 +					}
  6.1144 +				else if(attrName.equals("LineNumberTable"))
  6.1145 +					{
  6.1146 +					if(!skipDebug)
  6.1147 +						{
  6.1148 +						k = readUnsignedShort(v + 6);
  6.1149 +						w = v + 8;
  6.1150 +						for(; k > 0; --k)
  6.1151 +							{
  6.1152 +							label = readUnsignedShort(w);
  6.1153 +							if(labels[label] == null)
  6.1154 +								{
  6.1155 +								labels[label] = new Label(true);
  6.1156 +								}
  6.1157 +							labels[label].line = readUnsignedShort(w + 2);
  6.1158 +							w += 4;
  6.1159 +							}
  6.1160 +						}
  6.1161 +					}
  6.1162 +				else if(attrName.equals("StackMapTable"))
  6.1163 +					{
  6.1164 +					if((flags & SKIP_FRAMES) == 0)
  6.1165 +						{
  6.1166 +						stackMap = v + 8;
  6.1167 +						frameCount = readUnsignedShort(v + 6);
  6.1168 +						}
  6.1169 +					/*
  6.1170 +											 * here we do not extract the labels corresponding to
  6.1171 +											 * the attribute content. This would require a full
  6.1172 +											 * parsing of the attribute, which would need to be
  6.1173 +											 * repeated in the second phase (see below). Instead the
  6.1174 +											 * content of the attribute is read one frame at a time
  6.1175 +											 * (i.e. after a frame has been visited, the next frame
  6.1176 +											 * is read), and the labels it contains are also
  6.1177 +											 * extracted one frame at a time. Thanks to the ordering
  6.1178 +											 * of frames, having only a "one frame lookahead" is not
  6.1179 +											 * a problem, i.e. it is not possible to see an offset
  6.1180 +											 * smaller than the offset of the current insn and for
  6.1181 +											 * which no Label exist.
  6.1182 +											 */
  6.1183 +					// TODO true for frame offsets,
  6.1184 +					// but for UNINITIALIZED type offsets?
  6.1185 +					}
  6.1186 +				else if(attrName.equals("StackMap"))
  6.1187 +					{
  6.1188 +					if((flags & SKIP_FRAMES) == 0)
  6.1189 +						{
  6.1190 +						stackMap = v + 8;
  6.1191 +						frameCount = readUnsignedShort(v + 6);
  6.1192 +						zip = false;
  6.1193 +						}
  6.1194 +					/*
  6.1195 +											 * IMPORTANT! here we assume that the frames are
  6.1196 +											 * ordered, as in the StackMapTable attribute, although
  6.1197 +											 * this is not guaranteed by the attribute format.
  6.1198 +											 */
  6.1199 +					}
  6.1200 +				else
  6.1201 +					{
  6.1202 +					for(k = 0; k < attrs.length; ++k)
  6.1203 +						{
  6.1204 +						if(attrs[k].type.equals(attrName))
  6.1205 +							{
  6.1206 +							attr = attrs[k].read(this,
  6.1207 +							                     v + 6,
  6.1208 +							                     readInt(v + 2),
  6.1209 +							                     c,
  6.1210 +							                     codeStart - 8,
  6.1211 +							                     labels);
  6.1212 +							if(attr != null)
  6.1213 +								{
  6.1214 +								attr.next = cattrs;
  6.1215 +								cattrs = attr;
  6.1216 +								}
  6.1217 +							}
  6.1218 +						}
  6.1219 +					}
  6.1220 +				v += 6 + readInt(v + 2);
  6.1221 +				}
  6.1222 +
  6.1223 +			// 2nd phase: visits each instruction
  6.1224 +			if(stackMap != 0)
  6.1225 +				{
  6.1226 +				// creates the very first (implicit) frame from the method
  6.1227 +				// descriptor
  6.1228 +				frameLocal = new Object[maxLocals];
  6.1229 +				frameStack = new Object[maxStack];
  6.1230 +				if(unzip)
  6.1231 +					{
  6.1232 +					int local = 0;
  6.1233 +					if((access & Opcodes.ACC_STATIC) == 0)
  6.1234 +						{
  6.1235 +						if(name.equals("<init>"))
  6.1236 +							{
  6.1237 +							frameLocal[local++] = Opcodes.UNINITIALIZED_THIS;
  6.1238 +							}
  6.1239 +						else
  6.1240 +							{
  6.1241 +							frameLocal[local++] = readClass(header + 2, c);
  6.1242 +							}
  6.1243 +						}
  6.1244 +					j = 1;
  6.1245 +					loop:
  6.1246 +					while(true)
  6.1247 +						{
  6.1248 +						k = j;
  6.1249 +						switch(desc.charAt(j++))
  6.1250 +							{
  6.1251 +							case'Z':
  6.1252 +							case'C':
  6.1253 +							case'B':
  6.1254 +							case'S':
  6.1255 +							case'I':
  6.1256 +								frameLocal[local++] = Opcodes.INTEGER;
  6.1257 +								break;
  6.1258 +							case'F':
  6.1259 +								frameLocal[local++] = Opcodes.FLOAT;
  6.1260 +								break;
  6.1261 +							case'J':
  6.1262 +								frameLocal[local++] = Opcodes.LONG;
  6.1263 +								break;
  6.1264 +							case'D':
  6.1265 +								frameLocal[local++] = Opcodes.DOUBLE;
  6.1266 +								break;
  6.1267 +							case'[':
  6.1268 +								while(desc.charAt(j) == '[')
  6.1269 +									{
  6.1270 +									++j;
  6.1271 +									}
  6.1272 +								if(desc.charAt(j) == 'L')
  6.1273 +									{
  6.1274 +									++j;
  6.1275 +									while(desc.charAt(j) != ';')
  6.1276 +										{
  6.1277 +										++j;
  6.1278 +										}
  6.1279 +									}
  6.1280 +								frameLocal[local++] = desc.substring(k, ++j);
  6.1281 +								break;
  6.1282 +							case'L':
  6.1283 +								while(desc.charAt(j) != ';')
  6.1284 +									{
  6.1285 +									++j;
  6.1286 +									}
  6.1287 +								frameLocal[local++] = desc.substring(k + 1,
  6.1288 +								                                     j++);
  6.1289 +								break;
  6.1290 +							default:
  6.1291 +								break loop;
  6.1292 +							}
  6.1293 +						}
  6.1294 +					frameLocalCount = local;
  6.1295 +					}
  6.1296 +				/*
  6.1297 +									 * for the first explicit frame the offset is not
  6.1298 +									 * offset_delta + 1 but only offset_delta; setting the
  6.1299 +									 * implicit frame offset to -1 allow the use of the
  6.1300 +									 * "offset_delta + 1" rule in all cases
  6.1301 +									 */
  6.1302 +				frameOffset = -1;
  6.1303 +				}
  6.1304 +			v = codeStart;
  6.1305 +			Label l;
  6.1306 +			while(v < codeEnd)
  6.1307 +				{
  6.1308 +				w = v - codeStart;
  6.1309 +
  6.1310 +				l = labels[w];
  6.1311 +				if(l != null)
  6.1312 +					{
  6.1313 +					mv.visitLabel(l);
  6.1314 +					if(!skipDebug && l.line > 0)
  6.1315 +						{
  6.1316 +						mv.visitLineNumber(l.line, l);
  6.1317 +						}
  6.1318 +					}
  6.1319 +
  6.1320 +				while(frameLocal != null
  6.1321 +				      && (frameOffset == w || frameOffset == -1))
  6.1322 +					{
  6.1323 +					// if there is a frame for this offset,
  6.1324 +					// makes the visitor visit it,
  6.1325 +					// and reads the next frame if there is one.
  6.1326 +					if(!zip || unzip)
  6.1327 +						{
  6.1328 +						mv.visitFrame(Opcodes.F_NEW,
  6.1329 +						              frameLocalCount,
  6.1330 +						              frameLocal,
  6.1331 +						              frameStackCount,
  6.1332 +						              frameStack);
  6.1333 +						}
  6.1334 +					else if(frameOffset != -1)
  6.1335 +						{
  6.1336 +						mv.visitFrame(frameMode,
  6.1337 +						              frameLocalDiff,
  6.1338 +						              frameLocal,
  6.1339 +						              frameStackCount,
  6.1340 +						              frameStack);
  6.1341 +						}
  6.1342 +
  6.1343 +					if(frameCount > 0)
  6.1344 +						{
  6.1345 +						int tag, delta, n;
  6.1346 +						if(zip)
  6.1347 +							{
  6.1348 +							tag = b[stackMap++] & 0xFF;
  6.1349 +							}
  6.1350 +						else
  6.1351 +							{
  6.1352 +							tag = MethodWriter.FULL_FRAME;
  6.1353 +							frameOffset = -1;
  6.1354 +							}
  6.1355 +						frameLocalDiff = 0;
  6.1356 +						if(tag < MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME)
  6.1357 +							{
  6.1358 +							delta = tag;
  6.1359 +							frameMode = Opcodes.F_SAME;
  6.1360 +							frameStackCount = 0;
  6.1361 +							}
  6.1362 +						else if(tag < MethodWriter.RESERVED)
  6.1363 +							{
  6.1364 +							delta = tag
  6.1365 +							        - MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME;
  6.1366 +							stackMap = readFrameType(frameStack,
  6.1367 +							                         0,
  6.1368 +							                         stackMap,
  6.1369 +							                         c,
  6.1370 +							                         labels);
  6.1371 +							frameMode = Opcodes.F_SAME1;
  6.1372 +							frameStackCount = 1;
  6.1373 +							}
  6.1374 +						else
  6.1375 +							{
  6.1376 +							delta = readUnsignedShort(stackMap);
  6.1377 +							stackMap += 2;
  6.1378 +							if(tag == MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED)
  6.1379 +								{
  6.1380 +								stackMap = readFrameType(frameStack,
  6.1381 +								                         0,
  6.1382 +								                         stackMap,
  6.1383 +								                         c,
  6.1384 +								                         labels);
  6.1385 +								frameMode = Opcodes.F_SAME1;
  6.1386 +								frameStackCount = 1;
  6.1387 +								}
  6.1388 +							else if(tag >= MethodWriter.CHOP_FRAME
  6.1389 +							        && tag < MethodWriter.SAME_FRAME_EXTENDED)
  6.1390 +								{
  6.1391 +								frameMode = Opcodes.F_CHOP;
  6.1392 +								frameLocalDiff = MethodWriter.SAME_FRAME_EXTENDED
  6.1393 +								                 - tag;
  6.1394 +								frameLocalCount -= frameLocalDiff;
  6.1395 +								frameStackCount = 0;
  6.1396 +								}
  6.1397 +							else if(tag == MethodWriter.SAME_FRAME_EXTENDED)
  6.1398 +								{
  6.1399 +								frameMode = Opcodes.F_SAME;
  6.1400 +								frameStackCount = 0;
  6.1401 +								}
  6.1402 +							else if(tag < MethodWriter.FULL_FRAME)
  6.1403 +								{
  6.1404 +								j = unzip ? frameLocalCount : 0;
  6.1405 +								for(k = tag
  6.1406 +								        - MethodWriter.SAME_FRAME_EXTENDED; k > 0; k--)
  6.1407 +									{
  6.1408 +									stackMap = readFrameType(frameLocal,
  6.1409 +									                         j++,
  6.1410 +									                         stackMap,
  6.1411 +									                         c,
  6.1412 +									                         labels);
  6.1413 +									}
  6.1414 +								frameMode = Opcodes.F_APPEND;
  6.1415 +								frameLocalDiff = tag
  6.1416 +								                 - MethodWriter.SAME_FRAME_EXTENDED;
  6.1417 +								frameLocalCount += frameLocalDiff;
  6.1418 +								frameStackCount = 0;
  6.1419 +								}
  6.1420 +							else
  6.1421 +								{ // if (tag == FULL_FRAME) {
  6.1422 +								frameMode = Opcodes.F_FULL;
  6.1423 +								n = frameLocalDiff = frameLocalCount = readUnsignedShort(stackMap);
  6.1424 +								stackMap += 2;
  6.1425 +								for(j = 0; n > 0; n--)
  6.1426 +									{
  6.1427 +									stackMap = readFrameType(frameLocal,
  6.1428 +									                         j++,
  6.1429 +									                         stackMap,
  6.1430 +									                         c,
  6.1431 +									                         labels);
  6.1432 +									}
  6.1433 +								n = frameStackCount = readUnsignedShort(stackMap);
  6.1434 +								stackMap += 2;
  6.1435 +								for(j = 0; n > 0; n--)
  6.1436 +									{
  6.1437 +									stackMap = readFrameType(frameStack,
  6.1438 +									                         j++,
  6.1439 +									                         stackMap,
  6.1440 +									                         c,
  6.1441 +									                         labels);
  6.1442 +									}
  6.1443 +								}
  6.1444 +							}
  6.1445 +						frameOffset += delta + 1;
  6.1446 +						if(labels[frameOffset] == null)
  6.1447 +							{
  6.1448 +							labels[frameOffset] = new Label();
  6.1449 +							}
  6.1450 +
  6.1451 +						--frameCount;
  6.1452 +						}
  6.1453 +					else
  6.1454 +						{
  6.1455 +						frameLocal = null;
  6.1456 +						}
  6.1457 +					}
  6.1458 +
  6.1459 +				int opcode = b[v] & 0xFF;
  6.1460 +				switch(ClassWriter.TYPE[opcode])
  6.1461 +					{
  6.1462 +					case ClassWriter.NOARG_INSN:
  6.1463 +						mv.visitInsn(opcode);
  6.1464 +						v += 1;
  6.1465 +						break;
  6.1466 +					case ClassWriter.IMPLVAR_INSN:
  6.1467 +						if(opcode > Opcodes.ISTORE)
  6.1468 +							{
  6.1469 +							opcode -= 59; // ISTORE_0
  6.1470 +							mv.visitVarInsn(Opcodes.ISTORE + (opcode >> 2),
  6.1471 +							                opcode & 0x3);
  6.1472 +							}
  6.1473 +						else
  6.1474 +							{
  6.1475 +							opcode -= 26; // ILOAD_0
  6.1476 +							mv.visitVarInsn(Opcodes.ILOAD + (opcode >> 2),
  6.1477 +							                opcode & 0x3);
  6.1478 +							}
  6.1479 +						v += 1;
  6.1480 +						break;
  6.1481 +					case ClassWriter.LABEL_INSN:
  6.1482 +						mv.visitJumpInsn(opcode, labels[w
  6.1483 +						                                + readShort(v + 1)]);
  6.1484 +						v += 3;
  6.1485 +						break;
  6.1486 +					case ClassWriter.LABELW_INSN:
  6.1487 +						mv.visitJumpInsn(opcode - 33, labels[w
  6.1488 +						                                     + readInt(v + 1)]);
  6.1489 +						v += 5;
  6.1490 +						break;
  6.1491 +					case ClassWriter.WIDE_INSN:
  6.1492 +						opcode = b[v + 1] & 0xFF;
  6.1493 +						if(opcode == Opcodes.IINC)
  6.1494 +							{
  6.1495 +							mv.visitIincInsn(readUnsignedShort(v + 2),
  6.1496 +							                 readShort(v + 4));
  6.1497 +							v += 6;
  6.1498 +							}
  6.1499 +						else
  6.1500 +							{
  6.1501 +							mv.visitVarInsn(opcode,
  6.1502 +							                readUnsignedShort(v + 2));
  6.1503 +							v += 4;
  6.1504 +							}
  6.1505 +						break;
  6.1506 +					case ClassWriter.TABL_INSN:
  6.1507 +						// skips 0 to 3 padding bytes
  6.1508 +						v = v + 4 - (w & 3);
  6.1509 +						// reads instruction
  6.1510 +						label = w + readInt(v);
  6.1511 +						int min = readInt(v + 4);
  6.1512 +						int max = readInt(v + 8);
  6.1513 +						v += 12;
  6.1514 +						Label[] table = new Label[max - min + 1];
  6.1515 +						for(j = 0; j < table.length; ++j)
  6.1516 +							{
  6.1517 +							table[j] = labels[w + readInt(v)];
  6.1518 +							v += 4;
  6.1519 +							}
  6.1520 +						mv.visitTableSwitchInsn(min,
  6.1521 +						                        max,
  6.1522 +						                        labels[label],
  6.1523 +						                        table);
  6.1524 +						break;
  6.1525 +					case ClassWriter.LOOK_INSN:
  6.1526 +						// skips 0 to 3 padding bytes
  6.1527 +						v = v + 4 - (w & 3);
  6.1528 +						// reads instruction
  6.1529 +						label = w + readInt(v);
  6.1530 +						j = readInt(v + 4);
  6.1531 +						v += 8;
  6.1532 +						int[] keys = new int[j];
  6.1533 +						Label[] values = new Label[j];
  6.1534 +						for(j = 0; j < keys.length; ++j)
  6.1535 +							{
  6.1536 +							keys[j] = readInt(v);
  6.1537 +							values[j] = labels[w + readInt(v + 4)];
  6.1538 +							v += 8;
  6.1539 +							}
  6.1540 +						mv.visitLookupSwitchInsn(labels[label],
  6.1541 +						                         keys,
  6.1542 +						                         values);
  6.1543 +						break;
  6.1544 +					case ClassWriter.VAR_INSN:
  6.1545 +						mv.visitVarInsn(opcode, b[v + 1] & 0xFF);
  6.1546 +						v += 2;
  6.1547 +						break;
  6.1548 +					case ClassWriter.SBYTE_INSN:
  6.1549 +						mv.visitIntInsn(opcode, b[v + 1]);
  6.1550 +						v += 2;
  6.1551 +						break;
  6.1552 +					case ClassWriter.SHORT_INSN:
  6.1553 +						mv.visitIntInsn(opcode, readShort(v + 1));
  6.1554 +						v += 3;
  6.1555 +						break;
  6.1556 +					case ClassWriter.LDC_INSN:
  6.1557 +						mv.visitLdcInsn(readConst(b[v + 1] & 0xFF, c));
  6.1558 +						v += 2;
  6.1559 +						break;
  6.1560 +					case ClassWriter.LDCW_INSN:
  6.1561 +						mv.visitLdcInsn(readConst(readUnsignedShort(v + 1),
  6.1562 +						                          c));
  6.1563 +						v += 3;
  6.1564 +						break;
  6.1565 +					case ClassWriter.FIELDORMETH_INSN:
  6.1566 +					case ClassWriter.ITFMETH_INSN:
  6.1567 +						int cpIndex = items[readUnsignedShort(v + 1)];
  6.1568 +						String iowner = readClass(cpIndex, c);
  6.1569 +						cpIndex = items[readUnsignedShort(cpIndex + 2)];
  6.1570 +						String iname = readUTF8(cpIndex, c);
  6.1571 +						String idesc = readUTF8(cpIndex + 2, c);
  6.1572 +						if(opcode < Opcodes.INVOKEVIRTUAL)
  6.1573 +							{
  6.1574 +							mv.visitFieldInsn(opcode, iowner, iname, idesc);
  6.1575 +							}
  6.1576 +						else
  6.1577 +							{
  6.1578 +							mv.visitMethodInsn(opcode, iowner, iname, idesc);
  6.1579 +							}
  6.1580 +						if(opcode == Opcodes.INVOKEINTERFACE)
  6.1581 +							{
  6.1582 +							v += 5;
  6.1583 +							}
  6.1584 +						else
  6.1585 +							{
  6.1586 +							v += 3;
  6.1587 +							}
  6.1588 +						break;
  6.1589 +					case ClassWriter.TYPE_INSN:
  6.1590 +						mv.visitTypeInsn(opcode, readClass(v + 1, c));
  6.1591 +						v += 3;
  6.1592 +						break;
  6.1593 +					case ClassWriter.IINC_INSN:
  6.1594 +						mv.visitIincInsn(b[v + 1] & 0xFF, b[v + 2]);
  6.1595 +						v += 3;
  6.1596 +						break;
  6.1597 +						// case MANA_INSN:
  6.1598 +					default:
  6.1599 +						mv.visitMultiANewArrayInsn(readClass(v + 1, c),
  6.1600 +						                           b[v + 3] & 0xFF);
  6.1601 +						v += 4;
  6.1602 +						break;
  6.1603 +					}
  6.1604 +				}
  6.1605 +			l = labels[codeEnd - codeStart];
  6.1606 +			if(l != null)
  6.1607 +				{
  6.1608 +				mv.visitLabel(l);
  6.1609 +				}
  6.1610 +			// visits the local variable tables
  6.1611 +			if(!skipDebug && varTable != 0)
  6.1612 +				{
  6.1613 +				int[] typeTable = null;
  6.1614 +				if(varTypeTable != 0)
  6.1615 +					{
  6.1616 +					k = readUnsignedShort(varTypeTable) * 3;
  6.1617 +					w = varTypeTable + 2;
  6.1618 +					typeTable = new int[k];
  6.1619 +					while(k > 0)
  6.1620 +						{
  6.1621 +						typeTable[--k] = w + 6; // signature
  6.1622 +						typeTable[--k] = readUnsignedShort(w + 8); // index
  6.1623 +						typeTable[--k] = readUnsignedShort(w); // start
  6.1624 +						w += 10;
  6.1625 +						}
  6.1626 +					}
  6.1627 +				k = readUnsignedShort(varTable);
  6.1628 +				w = varTable + 2;
  6.1629 +				for(; k > 0; --k)
  6.1630 +					{
  6.1631 +					int start = readUnsignedShort(w);
  6.1632 +					int length = readUnsignedShort(w + 2);
  6.1633 +					int index = readUnsignedShort(w + 8);
  6.1634 +					String vsignature = null;
  6.1635 +					if(typeTable != null)
  6.1636 +						{
  6.1637 +						for(int a = 0; a < typeTable.length; a += 3)
  6.1638 +							{
  6.1639 +							if(typeTable[a] == start
  6.1640 +							   && typeTable[a + 1] == index)
  6.1641 +								{
  6.1642 +								vsignature = readUTF8(typeTable[a + 2], c);
  6.1643 +								break;
  6.1644 +								}
  6.1645 +							}
  6.1646 +						}
  6.1647 +					mv.visitLocalVariable(readUTF8(w + 4, c),
  6.1648 +					                      readUTF8(w + 6, c),
  6.1649 +					                      vsignature,
  6.1650 +					                      labels[start],
  6.1651 +					                      labels[start + length],
  6.1652 +					                      index);
  6.1653 +					w += 10;
  6.1654 +					}
  6.1655 +				}
  6.1656 +			// visits the other attributes
  6.1657 +			while(cattrs != null)
  6.1658 +				{
  6.1659 +				attr = cattrs.next;
  6.1660 +				cattrs.next = null;
  6.1661 +				mv.visitAttribute(cattrs);
  6.1662 +				cattrs = attr;
  6.1663 +				}
  6.1664 +			// visits the max stack and max locals values
  6.1665 +			mv.visitMaxs(maxStack, maxLocals);
  6.1666 +			}
  6.1667 +
  6.1668 +		if(mv != null)
  6.1669 +			{
  6.1670 +			mv.visitEnd();
  6.1671 +			}
  6.1672 +		}
  6.1673 +
  6.1674 +	// visits the end of the class
  6.1675 +	classVisitor.visitEnd();
  6.1676 +}
  6.1677 +
  6.1678 +/**
  6.1679 + * Reads parameter annotations and makes the given visitor visit them.
  6.1680 + *
  6.1681 + * @param v       start offset in {@link #b b} of the annotations to be read.
  6.1682 + * @param buf     buffer to be used to call {@link #readUTF8 readUTF8},
  6.1683 + *                {@link #readClass(int,char[]) readClass} or
  6.1684 + *                {@link #readConst readConst}.
  6.1685 + * @param visible <tt>true</tt> if the annotations to be read are visible
  6.1686 + *                at runtime.
  6.1687 + * @param mv      the visitor that must visit the annotations.
  6.1688 + */
  6.1689 +private void readParameterAnnotations(
  6.1690 +		int v,
  6.1691 +		final char[] buf,
  6.1692 +		final boolean visible,
  6.1693 +		final MethodVisitor mv){
  6.1694 +	int n = b[v++] & 0xFF;
  6.1695 +	for(int i = 0; i < n; ++i)
  6.1696 +		{
  6.1697 +		int j = readUnsignedShort(v);
  6.1698 +		v += 2;
  6.1699 +		for(; j > 0; --j)
  6.1700 +			{
  6.1701 +			v = readAnnotationValues(v + 2,
  6.1702 +			                         buf,
  6.1703 +			                         true,
  6.1704 +			                         mv.visitParameterAnnotation(i,
  6.1705 +			                                                     readUTF8(v, buf),
  6.1706 +			                                                     visible));
  6.1707 +			}
  6.1708 +		}
  6.1709 +}
  6.1710 +
  6.1711 +/**
  6.1712 + * Reads the values of an annotation and makes the given visitor visit them.
  6.1713 + *
  6.1714 + * @param v     the start offset in {@link #b b} of the values to be read
  6.1715 + *              (including the unsigned short that gives the number of values).
  6.1716 + * @param buf   buffer to be used to call {@link #readUTF8 readUTF8},
  6.1717 + *              {@link #readClass(int,char[]) readClass} or
  6.1718 + *              {@link #readConst readConst}.
  6.1719 + * @param named if the annotation values are named or not.
  6.1720 + * @param av    the visitor that must visit the values.
  6.1721 + * @return the end offset of the annotation values.
  6.1722 + */
  6.1723 +private int readAnnotationValues(
  6.1724 +		int v,
  6.1725 +		final char[] buf,
  6.1726 +		final boolean named,
  6.1727 +		final AnnotationVisitor av){
  6.1728 +	int i = readUnsignedShort(v);
  6.1729 +	v += 2;
  6.1730 +	if(named)
  6.1731 +		{
  6.1732 +		for(; i > 0; --i)
  6.1733 +			{
  6.1734 +			v = readAnnotationValue(v + 2, buf, readUTF8(v, buf), av);
  6.1735 +			}
  6.1736 +		}
  6.1737 +	else
  6.1738 +		{
  6.1739 +		for(; i > 0; --i)
  6.1740 +			{
  6.1741 +			v = readAnnotationValue(v, buf, null, av);
  6.1742 +			}
  6.1743 +		}
  6.1744 +	if(av != null)
  6.1745 +		{
  6.1746 +		av.visitEnd();
  6.1747 +		}
  6.1748 +	return v;
  6.1749 +}
  6.1750 +
  6.1751 +/**
  6.1752 + * Reads a value of an annotation and makes the given visitor visit it.
  6.1753 + *
  6.1754 + * @param v    the start offset in {@link #b b} of the value to be read (<i>not
  6.1755 + *             including the value name constant pool index</i>).
  6.1756 + * @param buf  buffer to be used to call {@link #readUTF8 readUTF8},
  6.1757 + *             {@link #readClass(int,char[]) readClass} or
  6.1758 + *             {@link #readConst readConst}.
  6.1759 + * @param name the name of the value to be read.
  6.1760 + * @param av   the visitor that must visit the value.
  6.1761 + * @return the end offset of the annotation value.
  6.1762 + */
  6.1763 +private int readAnnotationValue(
  6.1764 +		int v,
  6.1765 +		final char[] buf,
  6.1766 +		final String name,
  6.1767 +		final AnnotationVisitor av){
  6.1768 +	int i;
  6.1769 +	if(av == null)
  6.1770 +		{
  6.1771 +		switch(b[v] & 0xFF)
  6.1772 +			{
  6.1773 +			case'e': // enum_const_value
  6.1774 +				return v + 5;
  6.1775 +			case'@': // annotation_value
  6.1776 +				return readAnnotationValues(v + 3, buf, true, null);
  6.1777 +			case'[': // array_value
  6.1778 +				return readAnnotationValues(v + 1, buf, false, null);
  6.1779 +			default:
  6.1780 +				return v + 3;
  6.1781 +			}
  6.1782 +		}
  6.1783 +	switch(b[v++] & 0xFF)
  6.1784 +		{
  6.1785 +		case'I': // pointer to CONSTANT_Integer
  6.1786 +		case'J': // pointer to CONSTANT_Long
  6.1787 +		case'F': // pointer to CONSTANT_Float
  6.1788 +		case'D': // pointer to CONSTANT_Double
  6.1789 +			av.visit(name, readConst(readUnsignedShort(v), buf));
  6.1790 +			v += 2;
  6.1791 +			break;
  6.1792 +		case'B': // pointer to CONSTANT_Byte
  6.1793 +			av.visit(name,
  6.1794 +			         new Byte((byte) readInt(items[readUnsignedShort(v)])));
  6.1795 +			v += 2;
  6.1796 +			break;
  6.1797 +		case'Z': // pointer to CONSTANT_Boolean
  6.1798 +			av.visit(name, readInt(items[readUnsignedShort(v)]) == 0
  6.1799 +			               ? Boolean.FALSE
  6.1800 +			               : Boolean.TRUE);
  6.1801 +			v += 2;
  6.1802 +			break;
  6.1803 +		case'S': // pointer to CONSTANT_Short
  6.1804 +			av.visit(name,
  6.1805 +			         new Short((short) readInt(items[readUnsignedShort(v)])));
  6.1806 +			v += 2;
  6.1807 +			break;
  6.1808 +		case'C': // pointer to CONSTANT_Char
  6.1809 +			av.visit(name,
  6.1810 +			         new Character((char) readInt(items[readUnsignedShort(v)])));
  6.1811 +			v += 2;
  6.1812 +			break;
  6.1813 +		case's': // pointer to CONSTANT_Utf8
  6.1814 +			av.visit(name, readUTF8(v, buf));
  6.1815 +			v += 2;
  6.1816 +			break;
  6.1817 +		case'e': // enum_const_value
  6.1818 +			av.visitEnum(name, readUTF8(v, buf), readUTF8(v + 2, buf));
  6.1819 +			v += 4;
  6.1820 +			break;
  6.1821 +		case'c': // class_info
  6.1822 +			av.visit(name, Type.getType(readUTF8(v, buf)));
  6.1823 +			v += 2;
  6.1824 +			break;
  6.1825 +		case'@': // annotation_value
  6.1826 +			v = readAnnotationValues(v + 2,
  6.1827 +			                         buf,
  6.1828 +			                         true,
  6.1829 +			                         av.visitAnnotation(name, readUTF8(v, buf)));
  6.1830 +			break;
  6.1831 +		case'[': // array_value
  6.1832 +			int size = readUnsignedShort(v);
  6.1833 +			v += 2;
  6.1834 +			if(size == 0)
  6.1835 +				{
  6.1836 +				return readAnnotationValues(v - 2,
  6.1837 +				                            buf,
  6.1838 +				                            false,
  6.1839 +				                            av.visitArray(name));
  6.1840 +				}
  6.1841 +			switch(this.b[v++] & 0xFF)
  6.1842 +				{
  6.1843 +				case'B':
  6.1844 +					byte[] bv = new byte[size];
  6.1845 +					for(i = 0; i < size; i++)
  6.1846 +						{
  6.1847 +						bv[i] = (byte) readInt(items[readUnsignedShort(v)]);
  6.1848 +						v += 3;
  6.1849 +						}
  6.1850 +					av.visit(name, bv);
  6.1851 +					--v;
  6.1852 +					break;
  6.1853 +				case'Z':
  6.1854 +					boolean[] zv = new boolean[size];
  6.1855 +					for(i = 0; i < size; i++)
  6.1856 +						{
  6.1857 +						zv[i] = readInt(items[readUnsignedShort(v)]) != 0;
  6.1858 +						v += 3;
  6.1859 +						}
  6.1860 +					av.visit(name, zv);
  6.1861 +					--v;
  6.1862 +					break;
  6.1863 +				case'S':
  6.1864 +					short[] sv = new short[size];
  6.1865 +					for(i = 0; i < size; i++)
  6.1866 +						{
  6.1867 +						sv[i] = (short) readInt(items[readUnsignedShort(v)]);
  6.1868 +						v += 3;
  6.1869 +						}
  6.1870 +					av.visit(name, sv);
  6.1871 +					--v;
  6.1872 +					break;
  6.1873 +				case'C':
  6.1874 +					char[] cv = new char[size];
  6.1875 +					for(i = 0; i < size; i++)
  6.1876 +						{
  6.1877 +						cv[i] = (char) readInt(items[readUnsignedShort(v)]);
  6.1878 +						v += 3;
  6.1879 +						}
  6.1880 +					av.visit(name, cv);
  6.1881 +					--v;
  6.1882 +					break;
  6.1883 +				case'I':
  6.1884 +					int[] iv = new int[size];
  6.1885 +					for(i = 0; i < size; i++)
  6.1886 +						{
  6.1887 +						iv[i] = readInt(items[readUnsignedShort(v)]);
  6.1888 +						v += 3;
  6.1889 +						}
  6.1890 +					av.visit(name, iv);
  6.1891 +					--v;
  6.1892 +					break;
  6.1893 +				case'J':
  6.1894 +					long[] lv = new long[size];
  6.1895 +					for(i = 0; i < size; i++)
  6.1896 +						{
  6.1897 +						lv[i] = readLong(items[readUnsignedShort(v)]);
  6.1898 +						v += 3;
  6.1899 +						}
  6.1900 +					av.visit(name, lv);
  6.1901 +					--v;
  6.1902 +					break;
  6.1903 +				case'F':
  6.1904 +					float[] fv = new float[size];
  6.1905 +					for(i = 0; i < size; i++)
  6.1906 +						{
  6.1907 +						fv[i] = Float.intBitsToFloat(readInt(items[readUnsignedShort(v)]));
  6.1908 +						v += 3;
  6.1909 +						}
  6.1910 +					av.visit(name, fv);
  6.1911 +					--v;
  6.1912 +					break;
  6.1913 +				case'D':
  6.1914 +					double[] dv = new double[size];
  6.1915 +					for(i = 0; i < size; i++)
  6.1916 +						{
  6.1917 +						dv[i] = Double.longBitsToDouble(readLong(items[readUnsignedShort(v)]));
  6.1918 +						v += 3;
  6.1919 +						}
  6.1920 +					av.visit(name, dv);
  6.1921 +					--v;
  6.1922 +					break;
  6.1923 +				default:
  6.1924 +					v = readAnnotationValues(v - 3,
  6.1925 +					                         buf,
  6.1926 +					                         false,
  6.1927 +					                         av.visitArray(name));
  6.1928 +				}
  6.1929 +		}
  6.1930 +	return v;
  6.1931 +}
  6.1932 +
  6.1933 +private int readFrameType(
  6.1934 +		final Object[] frame,
  6.1935 +		final int index,
  6.1936 +		int v,
  6.1937 +		final char[] buf,
  6.1938 +		final Label[] labels){
  6.1939 +	int type = b[v++] & 0xFF;
  6.1940 +	switch(type)
  6.1941 +		{
  6.1942 +		case 0:
  6.1943 +			frame[index] = Opcodes.TOP;
  6.1944 +			break;
  6.1945 +		case 1:
  6.1946 +			frame[index] = Opcodes.INTEGER;
  6.1947 +			break;
  6.1948 +		case 2:
  6.1949 +			frame[index] = Opcodes.FLOAT;
  6.1950 +			break;
  6.1951 +		case 3:
  6.1952 +			frame[index] = Opcodes.DOUBLE;
  6.1953 +			break;
  6.1954 +		case 4:
  6.1955 +			frame[index] = Opcodes.LONG;
  6.1956 +			break;
  6.1957 +		case 5:
  6.1958 +			frame[index] = Opcodes.NULL;
  6.1959 +			break;
  6.1960 +		case 6:
  6.1961 +			frame[index] = Opcodes.UNINITIALIZED_THIS;
  6.1962 +			break;
  6.1963 +		case 7: // Object
  6.1964 +			frame[index] = readClass(v, buf);
  6.1965 +			v += 2;
  6.1966 +			break;
  6.1967 +		default: // Uninitialized
  6.1968 +			int offset = readUnsignedShort(v);
  6.1969 +			if(labels[offset] == null)
  6.1970 +				{
  6.1971 +				labels[offset] = new Label();
  6.1972 +				}
  6.1973 +			frame[index] = labels[offset];
  6.1974 +			v += 2;
  6.1975 +		}
  6.1976 +	return v;
  6.1977 +}
  6.1978 +
  6.1979 +/**
  6.1980 + * Reads an attribute in {@link #b b}.
  6.1981 + *
  6.1982 + * @param attrs   prototypes of the attributes that must be parsed during the
  6.1983 + *                visit of the class. Any attribute whose type is not equal to the
  6.1984 + *                type of one the prototypes is ignored (i.e. an empty
  6.1985 + *                {@link Attribute} instance is returned).
  6.1986 + * @param type    the type of the attribute.
  6.1987 + * @param off     index of the first byte of the attribute's content in
  6.1988 + *                {@link #b b}. The 6 attribute header bytes, containing the type
  6.1989 + *                and the length of the attribute, are not taken into account here
  6.1990 + *                (they have already been read).
  6.1991 + * @param len     the length of the attribute's content.
  6.1992 + * @param buf     buffer to be used to call {@link #readUTF8 readUTF8},
  6.1993 + *                {@link #readClass(int,char[]) readClass} or
  6.1994 + *                {@link #readConst readConst}.
  6.1995 + * @param codeOff index of the first byte of code's attribute content in
  6.1996 + *                {@link #b b}, or -1 if the attribute to be read is not a code
  6.1997 + *                attribute. The 6 attribute header bytes, containing the type and
  6.1998 + *                the length of the attribute, are not taken into account here.
  6.1999 + * @param labels  the labels of the method's code, or <tt>null</tt> if the
  6.2000 + *                attribute to be read is not a code attribute.
  6.2001 + * @return the attribute that has been read, or <tt>null</tt> to skip this
  6.2002 + *         attribute.
  6.2003 + */
  6.2004 +private Attribute readAttribute(
  6.2005 +		final Attribute[] attrs,
  6.2006 +		final String type,
  6.2007 +		final int off,
  6.2008 +		final int len,
  6.2009 +		final char[] buf,
  6.2010 +		final int codeOff,
  6.2011 +		final Label[] labels){
  6.2012 +	for(int i = 0; i < attrs.length; ++i)
  6.2013 +		{
  6.2014 +		if(attrs[i].type.equals(type))
  6.2015 +			{
  6.2016 +			return attrs[i].read(this, off, len, buf, codeOff, labels);
  6.2017 +			}
  6.2018 +		}
  6.2019 +	return new Attribute(type).read(this, off, len, null, -1, null);
  6.2020 +}
  6.2021 +
  6.2022 +// ------------------------------------------------------------------------
  6.2023 +// Utility methods: low level parsing
  6.2024 +// ------------------------------------------------------------------------
  6.2025 +
  6.2026 +/**
  6.2027 + * Returns the start index of the constant pool item in {@link #b b}, plus
  6.2028 + * one. <i>This method is intended for {@link Attribute} sub classes, and is
  6.2029 + * normally not needed by class generators or adapters.</i>
  6.2030 + *
  6.2031 + * @param item the index a constant pool item.
  6.2032 + * @return the start index of the constant pool item in {@link #b b}, plus
  6.2033 + *         one.
  6.2034 + */
  6.2035 +public int getItem(final int item){
  6.2036 +	return items[item];
  6.2037 +}
  6.2038 +
  6.2039 +/**
  6.2040 + * Reads a byte value in {@link #b b}. <i>This method is intended for
  6.2041 + * {@link Attribute} sub classes, and is normally not needed by class
  6.2042 + * generators or adapters.</i>
  6.2043 + *
  6.2044 + * @param index the start index of the value to be read in {@link #b b}.
  6.2045 + * @return the read value.
  6.2046 + */
  6.2047 +public int readByte(final int index){
  6.2048 +	return b[index] & 0xFF;
  6.2049 +}
  6.2050 +
  6.2051 +/**
  6.2052 + * Reads an unsigned short value in {@link #b b}. <i>This method is
  6.2053 + * intended for {@link Attribute} sub classes, and is normally not needed by
  6.2054 + * class generators or adapters.</i>
  6.2055 + *
  6.2056 + * @param index the start index of the value to be read in {@link #b b}.
  6.2057 + * @return the read value.
  6.2058 + */
  6.2059 +public int readUnsignedShort(final int index){
  6.2060 +	byte[] b = this.b;
  6.2061 +	return ((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF);
  6.2062 +}
  6.2063 +
  6.2064 +/**
  6.2065 + * Reads a signed short value in {@link #b b}. <i>This method is intended
  6.2066 + * for {@link Attribute} sub classes, and is normally not needed by class
  6.2067 + * generators or adapters.</i>
  6.2068 + *
  6.2069 + * @param index the start index of the value to be read in {@link #b b}.
  6.2070 + * @return the read value.
  6.2071 + */
  6.2072 +public short readShort(final int index){
  6.2073 +	byte[] b = this.b;
  6.2074 +	return (short) (((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF));
  6.2075 +}
  6.2076 +
  6.2077 +/**
  6.2078 + * Reads a signed int value in {@link #b b}. <i>This method is intended for
  6.2079 + * {@link Attribute} sub classes, and is normally not needed by class
  6.2080 + * generators or adapters.</i>
  6.2081 + *
  6.2082 + * @param index the start index of the value to be read in {@link #b b}.
  6.2083 + * @return the read value.
  6.2084 + */
  6.2085 +public int readInt(final int index){
  6.2086 +	byte[] b = this.b;
  6.2087 +	return ((b[index] & 0xFF) << 24) | ((b[index + 1] & 0xFF) << 16)
  6.2088 +	       | ((b[index + 2] & 0xFF) << 8) | (b[index + 3] & 0xFF);
  6.2089 +}
  6.2090 +
  6.2091 +/**
  6.2092 + * Reads a signed long value in {@link #b b}. <i>This method is intended
  6.2093 + * for {@link Attribute} sub classes, and is normally not needed by class
  6.2094 + * generators or adapters.</i>
  6.2095 + *
  6.2096 + * @param index the start index of the value to be read in {@link #b b}.
  6.2097 + * @return the read value.
  6.2098 + */
  6.2099 +public long readLong(final int index){
  6.2100 +	long l1 = readInt(index);
  6.2101 +	long l0 = readInt(index + 4) & 0xFFFFFFFFL;
  6.2102 +	return (l1 << 32) | l0;
  6.2103 +}
  6.2104 +
  6.2105 +/**
  6.2106 + * Reads an UTF8 string constant pool item in {@link #b b}. <i>This method
  6.2107 + * is intended for {@link Attribute} sub classes, and is normally not needed
  6.2108 + * by class generators or adapters.</i>
  6.2109 + *
  6.2110 + * @param index the start index of an unsigned short value in {@link #b b},
  6.2111 + *              whose value is the index of an UTF8 constant pool item.
  6.2112 + * @param buf   buffer to be used to read the item. This buffer must be
  6.2113 + *              sufficiently large. It is not automatically resized.
  6.2114 + * @return the String corresponding to the specified UTF8 item.
  6.2115 + */
  6.2116 +public String readUTF8(int index, final char[] buf){
  6.2117 +	int item = readUnsignedShort(index);
  6.2118 +	String s = strings[item];
  6.2119 +	if(s != null)
  6.2120 +		{
  6.2121 +		return s;
  6.2122 +		}
  6.2123 +	index = items[item];
  6.2124 +	return strings[item] = readUTF(index + 2, readUnsignedShort(index), buf);
  6.2125 +}
  6.2126 +
  6.2127 +/**
  6.2128 + * Reads UTF8 string in {@link #b b}.
  6.2129 + *
  6.2130 + * @param index  start offset of the UTF8 string to be read.
  6.2131 + * @param utfLen length of the UTF8 string to be read.
  6.2132 + * @param buf    buffer to be used to read the string. This buffer must be
  6.2133 + *               sufficiently large. It is not automatically resized.
  6.2134 + * @return the String corresponding to the specified UTF8 string.
  6.2135 + */
  6.2136 +private String readUTF(int index, final int utfLen, final char[] buf){
  6.2137 +	int endIndex = index + utfLen;
  6.2138 +	byte[] b = this.b;
  6.2139 +	int strLen = 0;
  6.2140 +	int c, d, e;
  6.2141 +	while(index < endIndex)
  6.2142 +		{
  6.2143 +		c = b[index++] & 0xFF;
  6.2144 +		switch(c >> 4)
  6.2145 +			{
  6.2146 +			case 0:
  6.2147 +			case 1:
  6.2148 +			case 2:
  6.2149 +			case 3:
  6.2150 +			case 4:
  6.2151 +			case 5:
  6.2152 +			case 6:
  6.2153 +			case 7:
  6.2154 +				// 0xxxxxxx
  6.2155 +				buf[strLen++] = (char) c;
  6.2156 +				break;
  6.2157 +			case 12:
  6.2158 +			case 13:
  6.2159 +				// 110x xxxx 10xx xxxx
  6.2160 +				d = b[index++];
  6.2161 +				buf[strLen++] = (char) (((c & 0x1F) << 6) | (d & 0x3F));
  6.2162 +				break;
  6.2163 +			default:
  6.2164 +				// 1110 xxxx 10xx xxxx 10xx xxxx
  6.2165 +				d = b[index++];
  6.2166 +				e = b[index++];
  6.2167 +				buf[strLen++] = (char) (((c & 0x0F) << 12)
  6.2168 +				                        | ((d & 0x3F) << 6) | (e & 0x3F));
  6.2169 +				break;
  6.2170 +			}
  6.2171 +		}
  6.2172 +	return new String(buf, 0, strLen);
  6.2173 +}
  6.2174 +
  6.2175 +/**
  6.2176 + * Reads a class constant pool item in {@link #b b}. <i>This method is
  6.2177 + * intended for {@link Attribute} sub classes, and is normally not needed by
  6.2178 + * class generators or adapters.</i>
  6.2179 + *
  6.2180 + * @param index the start index of an unsigned short value in {@link #b b},
  6.2181 + *              whose value is the index of a class constant pool item.
  6.2182 + * @param buf   buffer to be used to read the item. This buffer must be
  6.2183 + *              sufficiently large. It is not automatically resized.
  6.2184 + * @return the String corresponding to the specified class item.
  6.2185 + */
  6.2186 +public String readClass(final int index, final char[] buf){
  6.2187 +	// computes the start index of the CONSTANT_Class item in b
  6.2188 +	// and reads the CONSTANT_Utf8 item designated by
  6.2189 +	// the first two bytes of this CONSTANT_Class item
  6.2190 +	return readUTF8(items[readUnsignedShort(index)], buf);
  6.2191 +}
  6.2192 +
  6.2193 +/**
  6.2194 + * Reads a numeric or string constant pool item in {@link #b b}. <i>This
  6.2195 + * method is intended for {@link Attribute} sub classes, and is normally not
  6.2196 + * needed by class generators or adapters.</i>
  6.2197 + *
  6.2198 + * @param item the index of a constant pool item.
  6.2199 + * @param buf  buffer to be used to read the item. This buffer must be
  6.2200 + *             sufficiently large. It is not automatically resized.
  6.2201 + * @return the {@link Integer}, {@link Float}, {@link Long},
  6.2202 + *         {@link Double}, {@link String} or {@link Type} corresponding to
  6.2203 + *         the given constant pool item.
  6.2204 + */
  6.2205 +public Object readConst(final int item, final char[] buf){
  6.2206 +	int index = items[item];
  6.2207 +	switch(b[index - 1])
  6.2208 +		{
  6.2209 +		case ClassWriter.INT:
  6.2210 +			return new Integer(readInt(index));
  6.2211 +		case ClassWriter.FLOAT:
  6.2212 +			return new Float(Float.intBitsToFloat(readInt(index)));
  6.2213 +		case ClassWriter.LONG:
  6.2214 +			return new Long(readLong(index));
  6.2215 +		case ClassWriter.DOUBLE:
  6.2216 +			return new Double(Double.longBitsToDouble(readLong(index)));
  6.2217 +		case ClassWriter.CLASS:
  6.2218 +			String s = readUTF8(index, buf);
  6.2219 +			return s.charAt(0) == '['
  6.2220 +			       ? Type.getType(s)
  6.2221 +			       : Type.getObjectType(s);
  6.2222 +			// case ClassWriter.STR:
  6.2223 +		default:
  6.2224 +			return readUTF8(index, buf);
  6.2225 +		}
  6.2226 +}
  6.2227 +}
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/clojure/asm/ClassVisitor.java	Sat Aug 21 06:25:44 2010 -0400
     7.3 @@ -0,0 +1,196 @@
     7.4 +/***
     7.5 + * ASM: a very small and fast Java bytecode manipulation framework
     7.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     7.7 + * All rights reserved.
     7.8 + *
     7.9 + * Redistribution and use in source and binary forms, with or without
    7.10 + * modification, are permitted provided that the following conditions
    7.11 + * are met:
    7.12 + * 1. Redistributions of source code must retain the above copyright
    7.13 + *    notice, this list of conditions and the following disclaimer.
    7.14 + * 2. Redistributions in binary form must reproduce the above copyright
    7.15 + *    notice, this list of conditions and the following disclaimer in the
    7.16 + *    documentation and/or other materials provided with the distribution.
    7.17 + * 3. Neither the name of the copyright holders nor the names of its
    7.18 + *    contributors may be used to endorse or promote products derived from
    7.19 + *    this software without specific prior written permission.
    7.20 + *
    7.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    7.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    7.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    7.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    7.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    7.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    7.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    7.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    7.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    7.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    7.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    7.32 + */
    7.33 +package clojure.asm;
    7.34 +
    7.35 +/**
    7.36 + * A visitor to visit a Java class. The methods of this interface must be called
    7.37 + * in the following order: <tt>visit</tt> [ <tt>visitSource</tt> ] [
    7.38 + * <tt>visitOuterClass</tt> ] ( <tt>visitAnnotation</tt> |
    7.39 + * <tt>visitAttribute</tt> )* (<tt>visitInnerClass</tt> |
    7.40 + * <tt>visitField</tt> | <tt>visitMethod</tt> )* <tt>visitEnd</tt>.
    7.41 + *
    7.42 + * @author Eric Bruneton
    7.43 + */
    7.44 +public interface ClassVisitor{
    7.45 +
    7.46 +/**
    7.47 + * Visits the header of the class.
    7.48 + *
    7.49 + * @param version    the class version.
    7.50 + * @param access     the class's access flags (see {@link Opcodes}). This
    7.51 + *                   parameter also indicates if the class is deprecated.
    7.52 + * @param name       the internal name of the class (see
    7.53 + *                   {@link Type#getInternalName() getInternalName}).
    7.54 + * @param signature  the signature of this class. May be <tt>null</tt> if
    7.55 + *                   the class is not a generic one, and does not extend or implement
    7.56 + *                   generic classes or interfaces.
    7.57 + * @param superName  the internal of name of the super class (see
    7.58 + *                   {@link Type#getInternalName() getInternalName}). For interfaces,
    7.59 + *                   the super class is {@link Object}. May be <tt>null</tt>, but
    7.60 + *                   only for the {@link Object} class.
    7.61 + * @param interfaces the internal names of the class's interfaces (see
    7.62 + *                   {@link Type#getInternalName() getInternalName}). May be
    7.63 + *                   <tt>null</tt>.
    7.64 + */
    7.65 +void visit(
    7.66 +		int version,
    7.67 +		int access,
    7.68 +		String name,
    7.69 +		String signature,
    7.70 +		String superName,
    7.71 +		String[] interfaces);
    7.72 +
    7.73 +/**
    7.74 + * Visits the source of the class.
    7.75 + *
    7.76 + * @param source the name of the source file from which the class was
    7.77 + *               compiled. May be <tt>null</tt>.
    7.78 + * @param debug  additional debug information to compute the correspondance
    7.79 + *               between source and compiled elements of the class. May be
    7.80 + *               <tt>null</tt>.
    7.81 + */
    7.82 +void visitSource(String source, String debug);
    7.83 +
    7.84 +/**
    7.85 + * Visits the enclosing class of the class. This method must be called only
    7.86 + * if the class has an enclosing class.
    7.87 + *
    7.88 + * @param owner internal name of the enclosing class of the class.
    7.89 + * @param name  the name of the method that contains the class, or
    7.90 + *              <tt>null</tt> if the class is not enclosed in a method of its
    7.91 + *              enclosing class.
    7.92 + * @param desc  the descriptor of the method that contains the class, or
    7.93 + *              <tt>null</tt> if the class is not enclosed in a method of its
    7.94 + *              enclosing class.
    7.95 + */
    7.96 +void visitOuterClass(String owner, String name, String desc);
    7.97 +
    7.98 +/**
    7.99 + * Visits an annotation of the class.
   7.100 + *
   7.101 + * @param desc    the class descriptor of the annotation class.
   7.102 + * @param visible <tt>true</tt> if the annotation is visible at runtime.
   7.103 + * @return a visitor to visit the annotation values, or <tt>null</tt> if
   7.104 + *         this visitor is not interested in visiting this annotation.
   7.105 + */
   7.106 +AnnotationVisitor visitAnnotation(String desc, boolean visible);
   7.107 +
   7.108 +/**
   7.109 + * Visits a non standard attribute of the class.
   7.110 + *
   7.111 + * @param attr an attribute.
   7.112 + */
   7.113 +void visitAttribute(Attribute attr);
   7.114 +
   7.115 +/**
   7.116 + * Visits information about an inner class. This inner class is not
   7.117 + * necessarily a member of the class being visited.
   7.118 + *
   7.119 + * @param name      the internal name of an inner class (see
   7.120 + *                  {@link Type#getInternalName() getInternalName}).
   7.121 + * @param outerName the internal name of the class to which the inner class
   7.122 + *                  belongs (see {@link Type#getInternalName() getInternalName}). May
   7.123 + *                  be <tt>null</tt> for not member classes.
   7.124 + * @param innerName the (simple) name of the inner class inside its
   7.125 + *                  enclosing class. May be <tt>null</tt> for anonymous inner
   7.126 + *                  classes.
   7.127 + * @param access    the access flags of the inner class as originally declared
   7.128 + *                  in the enclosing class.
   7.129 + */
   7.130 +void visitInnerClass(
   7.131 +		String name,
   7.132 +		String outerName,
   7.133 +		String innerName,
   7.134 +		int access);
   7.135 +
   7.136 +/**
   7.137 + * Visits a field of the class.
   7.138 + *
   7.139 + * @param access    the field's access flags (see {@link Opcodes}). This
   7.140 + *                  parameter also indicates if the field is synthetic and/or
   7.141 + *                  deprecated.
   7.142 + * @param name      the field's name.
   7.143 + * @param desc      the field's descriptor (see {@link Type Type}).
   7.144 + * @param signature the field's signature. May be <tt>null</tt> if the
   7.145 + *                  field's type does not use generic types.
   7.146 + * @param value     the field's initial value. This parameter, which may be
   7.147 + *                  <tt>null</tt> if the field does not have an initial value, must
   7.148 + *                  be an {@link Integer}, a {@link Float}, a {@link Long}, a
   7.149 + *                  {@link Double} or a {@link String} (for <tt>int</tt>,
   7.150 + *                  <tt>float</tt>, <tt>long</tt> or <tt>String</tt> fields
   7.151 + *                  respectively). <i>This parameter is only used for static fields</i>.
   7.152 + *                  Its value is ignored for non static fields, which must be
   7.153 + *                  initialized through bytecode instructions in constructors or
   7.154 + *                  methods.
   7.155 + * @return a visitor to visit field annotations and attributes, or
   7.156 + *         <tt>null</tt> if this class visitor is not interested in
   7.157 + *         visiting these annotations and attributes.
   7.158 + */
   7.159 +FieldVisitor visitField(
   7.160 +		int access,
   7.161 +		String name,
   7.162 +		String desc,
   7.163 +		String signature,
   7.164 +		Object value);
   7.165 +
   7.166 +/**
   7.167 + * Visits a method of the class. This method <i>must</i> return a new
   7.168 + * {@link MethodVisitor} instance (or <tt>null</tt>) each time it is
   7.169 + * called, i.e., it should not return a previously returned visitor.
   7.170 + *
   7.171 + * @param access     the method's access flags (see {@link Opcodes}). This
   7.172 + *                   parameter also indicates if the method is synthetic and/or
   7.173 + *                   deprecated.
   7.174 + * @param name       the method's name.
   7.175 + * @param desc       the method's descriptor (see {@link Type Type}).
   7.176 + * @param signature  the method's signature. May be <tt>null</tt> if the
   7.177 + *                   method parameters, return type and exceptions do not use generic
   7.178 + *                   types.
   7.179 + * @param exceptions the internal names of the method's exception classes
   7.180 + *                   (see {@link Type#getInternalName() getInternalName}). May be
   7.181 + *                   <tt>null</tt>.
   7.182 + * @return an object to visit the byte code of the method, or <tt>null</tt>
   7.183 + *         if this class visitor is not interested in visiting the code of
   7.184 + *         this method.
   7.185 + */
   7.186 +MethodVisitor visitMethod(
   7.187 +		int access,
   7.188 +		String name,
   7.189 +		String desc,
   7.190 +		String signature,
   7.191 +		String[] exceptions);
   7.192 +
   7.193 +/**
   7.194 + * Visits the end of the class. This method, which is the last one to be
   7.195 + * called, is used to inform the visitor that all the fields and methods of
   7.196 + * the class have been visited.
   7.197 + */
   7.198 +void visitEnd();
   7.199 +}
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/clojure/asm/ClassWriter.java	Sat Aug 21 06:25:44 2010 -0400
     8.3 @@ -0,0 +1,1415 @@
     8.4 +/***
     8.5 + * ASM: a very small and fast Java bytecode manipulation framework
     8.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     8.7 + * All rights reserved.
     8.8 + *
     8.9 + * Redistribution and use in source and binary forms, with or without
    8.10 + * modification, are permitted provided that the following conditions
    8.11 + * are met:
    8.12 + * 1. Redistributions of source code must retain the above copyright
    8.13 + *    notice, this list of conditions and the following disclaimer.
    8.14 + * 2. Redistributions in binary form must reproduce the above copyright
    8.15 + *    notice, this list of conditions and the following disclaimer in the
    8.16 + *    documentation and/or other materials provided with the distribution.
    8.17 + * 3. Neither the name of the copyright holders nor the names of its
    8.18 + *    contributors may be used to endorse or promote products derived from
    8.19 + *    this software without specific prior written permission.
    8.20 + *
    8.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    8.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    8.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    8.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    8.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    8.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    8.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    8.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    8.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    8.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    8.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    8.32 + */
    8.33 +package clojure.asm;
    8.34 +
    8.35 +/**
    8.36 + * A {@link ClassVisitor} that generates classes in bytecode form. More
    8.37 + * precisely this visitor generates a byte array conforming to the Java class
    8.38 + * file format. It can be used alone, to generate a Java class "from scratch",
    8.39 + * or with one or more {@link ClassReader ClassReader} and adapter class visitor
    8.40 + * to generate a modified class from one or more existing Java classes.
    8.41 + *
    8.42 + * @author Eric Bruneton
    8.43 + */
    8.44 +public class ClassWriter implements ClassVisitor{
    8.45 +
    8.46 +/**
    8.47 + * Flag to automatically compute the maximum stack size and the maximum
    8.48 + * number of local variables of methods. If this flag is set, then the
    8.49 + * arguments of the {@link MethodVisitor#visitMaxs visitMaxs} method of the
    8.50 + * {@link MethodVisitor} returned by the {@link #visitMethod visitMethod}
    8.51 + * method will be ignored, and computed automatically from the signature and
    8.52 + * the bytecode of each method.
    8.53 + *
    8.54 + * @see #ClassWriter(int)
    8.55 + */
    8.56 +public final static int COMPUTE_MAXS = 1;
    8.57 +
    8.58 +/**
    8.59 + * Flag to automatically compute the stack map frames of methods from
    8.60 + * scratch. If this flag is set, then the calls to the
    8.61 + * {@link MethodVisitor#visitFrame} method are ignored, and the stack map
    8.62 + * frames are recomputed from the methods bytecode. The arguments of the
    8.63 + * {@link MethodVisitor#visitMaxs visitMaxs} method are also ignored and
    8.64 + * recomputed from the bytecode. In other words, computeFrames implies
    8.65 + * computeMaxs.
    8.66 + *
    8.67 + * @see #ClassWriter(int)
    8.68 + */
    8.69 +public final static int COMPUTE_FRAMES = 2;
    8.70 +
    8.71 +/**
    8.72 + * The type of instructions without any argument.
    8.73 + */
    8.74 +final static int NOARG_INSN = 0;
    8.75 +
    8.76 +/**
    8.77 + * The type of instructions with an signed byte argument.
    8.78 + */
    8.79 +final static int SBYTE_INSN = 1;
    8.80 +
    8.81 +/**
    8.82 + * The type of instructions with an signed short argument.
    8.83 + */
    8.84 +final static int SHORT_INSN = 2;
    8.85 +
    8.86 +/**
    8.87 + * The type of instructions with a local variable index argument.
    8.88 + */
    8.89 +final static int VAR_INSN = 3;
    8.90 +
    8.91 +/**
    8.92 + * The type of instructions with an implicit local variable index argument.
    8.93 + */
    8.94 +final static int IMPLVAR_INSN = 4;
    8.95 +
    8.96 +/**
    8.97 + * The type of instructions with a type descriptor argument.
    8.98 + */
    8.99 +final static int TYPE_INSN = 5;
   8.100 +
   8.101 +/**
   8.102 + * The type of field and method invocations instructions.
   8.103 + */
   8.104 +final static int FIELDORMETH_INSN = 6;
   8.105 +
   8.106 +/**
   8.107 + * The type of the INVOKEINTERFACE instruction.
   8.108 + */
   8.109 +final static int ITFMETH_INSN = 7;
   8.110 +
   8.111 +/**
   8.112 + * The type of instructions with a 2 bytes bytecode offset label.
   8.113 + */
   8.114 +final static int LABEL_INSN = 8;
   8.115 +
   8.116 +/**
   8.117 + * The type of instructions with a 4 bytes bytecode offset label.
   8.118 + */
   8.119 +final static int LABELW_INSN = 9;
   8.120 +
   8.121 +/**
   8.122 + * The type of the LDC instruction.
   8.123 + */
   8.124 +final static int LDC_INSN = 10;
   8.125 +
   8.126 +/**
   8.127 + * The type of the LDC_W and LDC2_W instructions.
   8.128 + */
   8.129 +final static int LDCW_INSN = 11;
   8.130 +
   8.131 +/**
   8.132 + * The type of the IINC instruction.
   8.133 + */
   8.134 +final static int IINC_INSN = 12;
   8.135 +
   8.136 +/**
   8.137 + * The type of the TABLESWITCH instruction.
   8.138 + */
   8.139 +final static int TABL_INSN = 13;
   8.140 +
   8.141 +/**
   8.142 + * The type of the LOOKUPSWITCH instruction.
   8.143 + */
   8.144 +final static int LOOK_INSN = 14;
   8.145 +
   8.146 +/**
   8.147 + * The type of the MULTIANEWARRAY instruction.
   8.148 + */
   8.149 +final static int MANA_INSN = 15;
   8.150 +
   8.151 +/**
   8.152 + * The type of the WIDE instruction.
   8.153 + */
   8.154 +final static int WIDE_INSN = 16;
   8.155 +
   8.156 +/**
   8.157 + * The instruction types of all JVM opcodes.
   8.158 + */
   8.159 +static byte[] TYPE;
   8.160 +
   8.161 +/**
   8.162 + * The type of CONSTANT_Class constant pool items.
   8.163 + */
   8.164 +final static int CLASS = 7;
   8.165 +
   8.166 +/**
   8.167 + * The type of CONSTANT_Fieldref constant pool items.
   8.168 + */
   8.169 +final static int FIELD = 9;
   8.170 +
   8.171 +/**
   8.172 + * The type of CONSTANT_Methodref constant pool items.
   8.173 + */
   8.174 +final static int METH = 10;
   8.175 +
   8.176 +/**
   8.177 + * The type of CONSTANT_InterfaceMethodref constant pool items.
   8.178 + */
   8.179 +final static int IMETH = 11;
   8.180 +
   8.181 +/**
   8.182 + * The type of CONSTANT_String constant pool items.
   8.183 + */
   8.184 +final static int STR = 8;
   8.185 +
   8.186 +/**
   8.187 + * The type of CONSTANT_Integer constant pool items.
   8.188 + */
   8.189 +final static int INT = 3;
   8.190 +
   8.191 +/**
   8.192 + * The type of CONSTANT_Float constant pool items.
   8.193 + */
   8.194 +final static int FLOAT = 4;
   8.195 +
   8.196 +/**
   8.197 + * The type of CONSTANT_Long constant pool items.
   8.198 + */
   8.199 +final static int LONG = 5;
   8.200 +
   8.201 +/**
   8.202 + * The type of CONSTANT_Double constant pool items.
   8.203 + */
   8.204 +final static int DOUBLE = 6;
   8.205 +
   8.206 +/**
   8.207 + * The type of CONSTANT_NameAndType constant pool items.
   8.208 + */
   8.209 +final static int NAME_TYPE = 12;
   8.210 +
   8.211 +/**
   8.212 + * The type of CONSTANT_Utf8 constant pool items.
   8.213 + */
   8.214 +final static int UTF8 = 1;
   8.215 +
   8.216 +/**
   8.217 + * Normal type Item stored in the ClassWriter {@link ClassWriter#typeTable},
   8.218 + * instead of the constant pool, in order to avoid clashes with normal
   8.219 + * constant pool items in the ClassWriter constant pool's hash table.
   8.220 + */
   8.221 +final static int TYPE_NORMAL = 13;
   8.222 +
   8.223 +/**
   8.224 + * Uninitialized type Item stored in the ClassWriter
   8.225 + * {@link ClassWriter#typeTable}, instead of the constant pool, in order to
   8.226 + * avoid clashes with normal constant pool items in the ClassWriter constant
   8.227 + * pool's hash table.
   8.228 + */
   8.229 +final static int TYPE_UNINIT = 14;
   8.230 +
   8.231 +/**
   8.232 + * Merged type Item stored in the ClassWriter {@link ClassWriter#typeTable},
   8.233 + * instead of the constant pool, in order to avoid clashes with normal
   8.234 + * constant pool items in the ClassWriter constant pool's hash table.
   8.235 + */
   8.236 +final static int TYPE_MERGED = 15;
   8.237 +
   8.238 +/**
   8.239 + * The class reader from which this class writer was constructed, if any.
   8.240 + */
   8.241 +ClassReader cr;
   8.242 +
   8.243 +/**
   8.244 + * Minor and major version numbers of the class to be generated.
   8.245 + */
   8.246 +int version;
   8.247 +
   8.248 +/**
   8.249 + * Index of the next item to be added in the constant pool.
   8.250 + */
   8.251 +int index;
   8.252 +
   8.253 +/**
   8.254 + * The constant pool of this class.
   8.255 + */
   8.256 +ByteVector pool;
   8.257 +
   8.258 +/**
   8.259 + * The constant pool's hash table data.
   8.260 + */
   8.261 +Item[] items;
   8.262 +
   8.263 +/**
   8.264 + * The threshold of the constant pool's hash table.
   8.265 + */
   8.266 +int threshold;
   8.267 +
   8.268 +/**
   8.269 + * A reusable key used to look for items in the {@link #items} hash table.
   8.270 + */
   8.271 +Item key;
   8.272 +
   8.273 +/**
   8.274 + * A reusable key used to look for items in the {@link #items} hash table.
   8.275 + */
   8.276 +Item key2;
   8.277 +
   8.278 +/**
   8.279 + * A reusable key used to look for items in the {@link #items} hash table.
   8.280 + */
   8.281 +Item key3;
   8.282 +
   8.283 +/**
   8.284 + * A type table used to temporarily store internal names that will not
   8.285 + * necessarily be stored in the constant pool. This type table is used by
   8.286 + * the control flow and data flow analysis algorithm used to compute stack
   8.287 + * map frames from scratch. This array associates to each index <tt>i</tt>
   8.288 + * the Item whose index is <tt>i</tt>. All Item objects stored in this
   8.289 + * array are also stored in the {@link #items} hash table. These two arrays
   8.290 + * allow to retrieve an Item from its index or, conversly, to get the index
   8.291 + * of an Item from its value. Each Item stores an internal name in its
   8.292 + * {@link Item#strVal1} field.
   8.293 + */
   8.294 +Item[] typeTable;
   8.295 +
   8.296 +/**
   8.297 + * Number of elements in the {@link #typeTable} array.
   8.298 + */
   8.299 +private short typeCount; // TODO int?
   8.300 +
   8.301 +/**
   8.302 + * The access flags of this class.
   8.303 + */
   8.304 +private int access;
   8.305 +
   8.306 +/**
   8.307 + * The constant pool item that contains the internal name of this class.
   8.308 + */
   8.309 +private int name;
   8.310 +
   8.311 +/**
   8.312 + * The internal name of this class.
   8.313 + */
   8.314 +String thisName;
   8.315 +
   8.316 +/**
   8.317 + * The constant pool item that contains the signature of this class.
   8.318 + */
   8.319 +private int signature;
   8.320 +
   8.321 +/**
   8.322 + * The constant pool item that contains the internal name of the super class
   8.323 + * of this class.
   8.324 + */
   8.325 +private int superName;
   8.326 +
   8.327 +/**
   8.328 + * Number of interfaces implemented or extended by this class or interface.
   8.329 + */
   8.330 +private int interfaceCount;
   8.331 +
   8.332 +/**
   8.333 + * The interfaces implemented or extended by this class or interface. More
   8.334 + * precisely, this array contains the indexes of the constant pool items
   8.335 + * that contain the internal names of these interfaces.
   8.336 + */
   8.337 +private int[] interfaces;
   8.338 +
   8.339 +/**
   8.340 + * The index of the constant pool item that contains the name of the source
   8.341 + * file from which this class was compiled.
   8.342 + */
   8.343 +private int sourceFile;
   8.344 +
   8.345 +/**
   8.346 + * The SourceDebug attribute of this class.
   8.347 + */
   8.348 +private ByteVector sourceDebug;
   8.349 +
   8.350 +/**
   8.351 + * The constant pool item that contains the name of the enclosing class of
   8.352 + * this class.
   8.353 + */
   8.354 +private int enclosingMethodOwner;
   8.355 +
   8.356 +/**
   8.357 + * The constant pool item that contains the name and descriptor of the
   8.358 + * enclosing method of this class.
   8.359 + */
   8.360 +private int enclosingMethod;
   8.361 +
   8.362 +/**
   8.363 + * The runtime visible annotations of this class.
   8.364 + */
   8.365 +private AnnotationWriter anns;
   8.366 +
   8.367 +/**
   8.368 + * The runtime invisible annotations of this class.
   8.369 + */
   8.370 +private AnnotationWriter ianns;
   8.371 +
   8.372 +/**
   8.373 + * The non standard attributes of this class.
   8.374 + */
   8.375 +private Attribute attrs;
   8.376 +
   8.377 +/**
   8.378 + * The number of entries in the InnerClasses attribute.
   8.379 + */
   8.380 +private int innerClassesCount;
   8.381 +
   8.382 +/**
   8.383 + * The InnerClasses attribute.
   8.384 + */
   8.385 +private ByteVector innerClasses;
   8.386 +
   8.387 +/**
   8.388 + * The fields of this class. These fields are stored in a linked list of
   8.389 + * {@link FieldWriter} objects, linked to each other by their
   8.390 + * {@link FieldWriter#next} field. This field stores the first element of
   8.391 + * this list.
   8.392 + */
   8.393 +FieldWriter firstField;
   8.394 +
   8.395 +/**
   8.396 + * The fields of this class. These fields are stored in a linked list of
   8.397 + * {@link FieldWriter} objects, linked to each other by their
   8.398 + * {@link FieldWriter#next} field. This field stores the last element of
   8.399 + * this list.
   8.400 + */
   8.401 +FieldWriter lastField;
   8.402 +
   8.403 +/**
   8.404 + * The methods of this class. These methods are stored in a linked list of
   8.405 + * {@link MethodWriter} objects, linked to each other by their
   8.406 + * {@link MethodWriter#next} field. This field stores the first element of
   8.407 + * this list.
   8.408 + */
   8.409 +MethodWriter firstMethod;
   8.410 +
   8.411 +/**
   8.412 + * The methods of this class. These methods are stored in a linked list of
   8.413 + * {@link MethodWriter} objects, linked to each other by their
   8.414 + * {@link MethodWriter#next} field. This field stores the last element of
   8.415 + * this list.
   8.416 + */
   8.417 +MethodWriter lastMethod;
   8.418 +
   8.419 +/**
   8.420 + * <tt>true</tt> if the maximum stack size and number of local variables
   8.421 + * must be automatically computed.
   8.422 + */
   8.423 +private boolean computeMaxs;
   8.424 +
   8.425 +/**
   8.426 + * <tt>true</tt> if the stack map frames must be recomputed from scratch.
   8.427 + */
   8.428 +private boolean computeFrames;
   8.429 +
   8.430 +/**
   8.431 + * <tt>true</tt> if the stack map tables of this class are invalid. The
   8.432 + * {@link MethodWriter#resizeInstructions} method cannot transform existing
   8.433 + * stack map tables, and so produces potentially invalid classes when it is
   8.434 + * executed. In this case the class is reread and rewritten with the
   8.435 + * {@link #COMPUTE_FRAMES} option (the resizeInstructions method can resize
   8.436 + * stack map tables when this option is used).
   8.437 + */
   8.438 +boolean invalidFrames;
   8.439 +
   8.440 +// ------------------------------------------------------------------------
   8.441 +// Static initializer
   8.442 +// ------------------------------------------------------------------------
   8.443 +
   8.444 +/**
   8.445 + * Computes the instruction types of JVM opcodes.
   8.446 + */
   8.447 +static
   8.448 +	{
   8.449 +	int i;
   8.450 +	byte[] b = new byte[220];
   8.451 +	String s = "AAAAAAAAAAAAAAAABCKLLDDDDDEEEEEEEEEEEEEEEEEEEEAAAAAAAADD"
   8.452 +	           + "DDDEEEEEEEEEEEEEEEEEEEEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
   8.453 +	           + "AAAAAAAAAAAAAAAAAMAAAAAAAAAAAAAAAAAAAAIIIIIIIIIIIIIIIIDNOAA"
   8.454 +	           + "AAAAGGGGGGGHAFBFAAFFAAQPIIJJIIIIIIIIIIIIIIIIII";
   8.455 +	for(i = 0; i < b.length; ++i)
   8.456 +		{
   8.457 +		b[i] = (byte) (s.charAt(i) - 'A');
   8.458 +		}
   8.459 +	TYPE = b;
   8.460 +
   8.461 +	// code to generate the above string
   8.462 +	//
   8.463 +	// // SBYTE_INSN instructions
   8.464 +	// b[Constants.NEWARRAY] = SBYTE_INSN;
   8.465 +	// b[Constants.BIPUSH] = SBYTE_INSN;
   8.466 +	//
   8.467 +	// // SHORT_INSN instructions
   8.468 +	// b[Constants.SIPUSH] = SHORT_INSN;
   8.469 +	//
   8.470 +	// // (IMPL)VAR_INSN instructions
   8.471 +	// b[Constants.RET] = VAR_INSN;
   8.472 +	// for (i = Constants.ILOAD; i <= Constants.ALOAD; ++i) {
   8.473 +	// b[i] = VAR_INSN;
   8.474 +	// }
   8.475 +	// for (i = Constants.ISTORE; i <= Constants.ASTORE; ++i) {
   8.476 +	// b[i] = VAR_INSN;
   8.477 +	// }
   8.478 +	// for (i = 26; i <= 45; ++i) { // ILOAD_0 to ALOAD_3
   8.479 +	// b[i] = IMPLVAR_INSN;
   8.480 +	// }
   8.481 +	// for (i = 59; i <= 78; ++i) { // ISTORE_0 to ASTORE_3
   8.482 +	// b[i] = IMPLVAR_INSN;
   8.483 +	// }
   8.484 +	//
   8.485 +	// // TYPE_INSN instructions
   8.486 +	// b[Constants.NEW] = TYPE_INSN;
   8.487 +	// b[Constants.ANEWARRAY] = TYPE_INSN;
   8.488 +	// b[Constants.CHECKCAST] = TYPE_INSN;
   8.489 +	// b[Constants.INSTANCEOF] = TYPE_INSN;
   8.490 +	//
   8.491 +	// // (Set)FIELDORMETH_INSN instructions
   8.492 +	// for (i = Constants.GETSTATIC; i <= Constants.INVOKESTATIC; ++i) {
   8.493 +	// b[i] = FIELDORMETH_INSN;
   8.494 +	// }
   8.495 +	// b[Constants.INVOKEINTERFACE] = ITFMETH_INSN;
   8.496 +	//
   8.497 +	// // LABEL(W)_INSN instructions
   8.498 +	// for (i = Constants.IFEQ; i <= Constants.JSR; ++i) {
   8.499 +	// b[i] = LABEL_INSN;
   8.500 +	// }
   8.501 +	// b[Constants.IFNULL] = LABEL_INSN;
   8.502 +	// b[Constants.IFNONNULL] = LABEL_INSN;
   8.503 +	// b[200] = LABELW_INSN; // GOTO_W
   8.504 +	// b[201] = LABELW_INSN; // JSR_W
   8.505 +	// // temporary opcodes used internally by ASM - see Label and
   8.506 +	// MethodWriter
   8.507 +	// for (i = 202; i < 220; ++i) {
   8.508 +	// b[i] = LABEL_INSN;
   8.509 +	// }
   8.510 +	//
   8.511 +	// // LDC(_W) instructions
   8.512 +	// b[Constants.LDC] = LDC_INSN;
   8.513 +	// b[19] = LDCW_INSN; // LDC_W
   8.514 +	// b[20] = LDCW_INSN; // LDC2_W
   8.515 +	//
   8.516 +	// // special instructions
   8.517 +	// b[Constants.IINC] = IINC_INSN;
   8.518 +	// b[Constants.TABLESWITCH] = TABL_INSN;
   8.519 +	// b[Constants.LOOKUPSWITCH] = LOOK_INSN;
   8.520 +	// b[Constants.MULTIANEWARRAY] = MANA_INSN;
   8.521 +	// b[196] = WIDE_INSN; // WIDE
   8.522 +	//
   8.523 +	// for (i = 0; i < b.length; ++i) {
   8.524 +	// System.err.print((char)('A' + b[i]));
   8.525 +	// }
   8.526 +	// System.err.println();
   8.527 +	}
   8.528 +
   8.529 +// ------------------------------------------------------------------------
   8.530 +// Constructor
   8.531 +// ------------------------------------------------------------------------
   8.532 +
   8.533 +/**
   8.534 + * Constructs a new {@link ClassWriter} object.
   8.535 + *
   8.536 + * @param flags option flags that can be used to modify the default behavior
   8.537 + *              of this class. See {@link #COMPUTE_MAXS}, {@link #COMPUTE_FRAMES}.
   8.538 + */
   8.539 +public ClassWriter(final int flags){
   8.540 +	index = 1;
   8.541 +	pool = new ByteVector();
   8.542 +	items = new Item[256];
   8.543 +	threshold = (int) (0.75d * items.length);
   8.544 +	key = new Item();
   8.545 +	key2 = new Item();
   8.546 +	key3 = new Item();
   8.547 +	this.computeMaxs = (flags & COMPUTE_MAXS) != 0;
   8.548 +	this.computeFrames = (flags & COMPUTE_FRAMES) != 0;
   8.549 +}
   8.550 +
   8.551 +/**
   8.552 + * Constructs a new {@link ClassWriter} object and enables optimizations for
   8.553 + * "mostly add" bytecode transformations. These optimizations are the
   8.554 + * following:
   8.555 + * <p/>
   8.556 + * <ul> <li>The constant pool from the original class is copied as is in
   8.557 + * the new class, which saves time. New constant pool entries will be added
   8.558 + * at the end if necessary, but unused constant pool entries <i>won't be
   8.559 + * removed</i>.</li> <li>Methods that are not transformed are copied as
   8.560 + * is in the new class, directly from the original class bytecode (i.e.
   8.561 + * without emitting visit events for all the method instructions), which
   8.562 + * saves a <i>lot</i> of time. Untransformed methods are detected by the
   8.563 + * fact that the {@link ClassReader} receives {@link MethodVisitor} objects
   8.564 + * that come from a {@link ClassWriter} (and not from a custom
   8.565 + * {@link ClassAdapter} or any other {@link ClassVisitor} instance).</li>
   8.566 + * </ul>
   8.567 + *
   8.568 + * @param classReader the {@link ClassReader} used to read the original
   8.569 + *                    class. It will be used to copy the entire constant pool from the
   8.570 + *                    original class and also to copy other fragments of original
   8.571 + *                    bytecode where applicable.
   8.572 + * @param flags       option flags that can be used to modify the default behavior
   8.573 + *                    of this class. See {@link #COMPUTE_MAXS}, {@link #COMPUTE_FRAMES}.
   8.574 + */
   8.575 +public ClassWriter(final ClassReader classReader, final int flags){
   8.576 +	this(flags);
   8.577 +	classReader.copyPool(this);
   8.578 +	this.cr = classReader;
   8.579 +}
   8.580 +
   8.581 +// ------------------------------------------------------------------------
   8.582 +// Implementation of the ClassVisitor interface
   8.583 +// ------------------------------------------------------------------------
   8.584 +
   8.585 +public void visit(
   8.586 +		final int version,
   8.587 +		final int access,
   8.588 +		final String name,
   8.589 +		final String signature,
   8.590 +		final String superName,
   8.591 +		final String[] interfaces){
   8.592 +	this.version = version;
   8.593 +	this.access = access;
   8.594 +	this.name = newClass(name);
   8.595 +	thisName = name;
   8.596 +	if(signature != null)
   8.597 +		{
   8.598 +		this.signature = newUTF8(signature);
   8.599 +		}
   8.600 +	this.superName = superName == null ? 0 : newClass(superName);
   8.601 +	if(interfaces != null && interfaces.length > 0)
   8.602 +		{
   8.603 +		interfaceCount = interfaces.length;
   8.604 +		this.interfaces = new int[interfaceCount];
   8.605 +		for(int i = 0; i < interfaceCount; ++i)
   8.606 +			{
   8.607 +			this.interfaces[i] = newClass(interfaces[i]);
   8.608 +			}
   8.609 +		}
   8.610 +}
   8.611 +
   8.612 +public void visitSource(final String file, final String debug){
   8.613 +	if(file != null)
   8.614 +		{
   8.615 +		sourceFile = newUTF8(file);
   8.616 +		}
   8.617 +	if(debug != null)
   8.618 +		{
   8.619 +		sourceDebug = new ByteVector().putUTF8(debug);
   8.620 +		}
   8.621 +}
   8.622 +
   8.623 +public void visitOuterClass(
   8.624 +		final String owner,
   8.625 +		final String name,
   8.626 +		final String desc){
   8.627 +	enclosingMethodOwner = newClass(owner);
   8.628 +	if(name != null && desc != null)
   8.629 +		{
   8.630 +		enclosingMethod = newNameType(name, desc);
   8.631 +		}
   8.632 +}
   8.633 +
   8.634 +public AnnotationVisitor visitAnnotation(
   8.635 +		final String desc,
   8.636 +		final boolean visible){
   8.637 +	ByteVector bv = new ByteVector();
   8.638 +	// write type, and reserve space for values count
   8.639 +	bv.putShort(newUTF8(desc)).putShort(0);
   8.640 +	AnnotationWriter aw = new AnnotationWriter(this, true, bv, bv, 2);
   8.641 +	if(visible)
   8.642 +		{
   8.643 +		aw.next = anns;
   8.644 +		anns = aw;
   8.645 +		}
   8.646 +	else
   8.647 +		{
   8.648 +		aw.next = ianns;
   8.649 +		ianns = aw;
   8.650 +		}
   8.651 +	return aw;
   8.652 +}
   8.653 +
   8.654 +public void visitAttribute(final Attribute attr){
   8.655 +	attr.next = attrs;
   8.656 +	attrs = attr;
   8.657 +}
   8.658 +
   8.659 +public void visitInnerClass(
   8.660 +		final String name,
   8.661 +		final String outerName,
   8.662 +		final String innerName,
   8.663 +		final int access){
   8.664 +	if(innerClasses == null)
   8.665 +		{
   8.666 +		innerClasses = new ByteVector();
   8.667 +		}
   8.668 +	++innerClassesCount;
   8.669 +	innerClasses.putShort(name == null ? 0 : newClass(name));
   8.670 +	innerClasses.putShort(outerName == null ? 0 : newClass(outerName));
   8.671 +	innerClasses.putShort(innerName == null ? 0 : newUTF8(innerName));
   8.672 +	innerClasses.putShort(access);
   8.673 +}
   8.674 +
   8.675 +public FieldVisitor visitField(
   8.676 +		final int access,
   8.677 +		final String name,
   8.678 +		final String desc,
   8.679 +		final String signature,
   8.680 +		final Object value){
   8.681 +	return new FieldWriter(this, access, name, desc, signature, value);
   8.682 +}
   8.683 +
   8.684 +public MethodVisitor visitMethod(
   8.685 +		final int access,
   8.686 +		final String name,
   8.687 +		final String desc,
   8.688 +		final String signature,
   8.689 +		final String[] exceptions){
   8.690 +	return new MethodWriter(this,
   8.691 +	                        access,
   8.692 +	                        name,
   8.693 +	                        desc,
   8.694 +	                        signature,
   8.695 +	                        exceptions,
   8.696 +	                        computeMaxs,
   8.697 +	                        computeFrames);
   8.698 +}
   8.699 +
   8.700 +public void visitEnd(){
   8.701 +}
   8.702 +
   8.703 +// ------------------------------------------------------------------------
   8.704 +// Other public methods
   8.705 +// ------------------------------------------------------------------------
   8.706 +
   8.707 +/**
   8.708 + * Returns the bytecode of the class that was build with this class writer.
   8.709 + *
   8.710 + * @return the bytecode of the class that was build with this class writer.
   8.711 + */
   8.712 +public byte[] toByteArray(){
   8.713 +	// computes the real size of the bytecode of this class
   8.714 +	int size = 24 + 2 * interfaceCount;
   8.715 +	int nbFields = 0;
   8.716 +	FieldWriter fb = firstField;
   8.717 +	while(fb != null)
   8.718 +		{
   8.719 +		++nbFields;
   8.720 +		size += fb.getSize();
   8.721 +		fb = fb.next;
   8.722 +		}
   8.723 +	int nbMethods = 0;
   8.724 +	MethodWriter mb = firstMethod;
   8.725 +	while(mb != null)
   8.726 +		{
   8.727 +		++nbMethods;
   8.728 +		size += mb.getSize();
   8.729 +		mb = mb.next;
   8.730 +		}
   8.731 +	int attributeCount = 0;
   8.732 +	if(signature != 0)
   8.733 +		{
   8.734 +		++attributeCount;
   8.735 +		size += 8;
   8.736 +		newUTF8("Signature");
   8.737 +		}
   8.738 +	if(sourceFile != 0)
   8.739 +		{
   8.740 +		++attributeCount;
   8.741 +		size += 8;
   8.742 +		newUTF8("SourceFile");
   8.743 +		}
   8.744 +	if(sourceDebug != null)
   8.745 +		{
   8.746 +		++attributeCount;
   8.747 +		size += sourceDebug.length + 4;
   8.748 +		newUTF8("SourceDebugExtension");
   8.749 +		}
   8.750 +	if(enclosingMethodOwner != 0)
   8.751 +		{
   8.752 +		++attributeCount;
   8.753 +		size += 10;
   8.754 +		newUTF8("EnclosingMethod");
   8.755 +		}
   8.756 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
   8.757 +		{
   8.758 +		++attributeCount;
   8.759 +		size += 6;
   8.760 +		newUTF8("Deprecated");
   8.761 +		}
   8.762 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
   8.763 +	   && (version & 0xffff) < Opcodes.V1_5)
   8.764 +		{
   8.765 +		++attributeCount;
   8.766 +		size += 6;
   8.767 +		newUTF8("Synthetic");
   8.768 +		}
   8.769 +	if(innerClasses != null)
   8.770 +		{
   8.771 +		++attributeCount;
   8.772 +		size += 8 + innerClasses.length;
   8.773 +		newUTF8("InnerClasses");
   8.774 +		}
   8.775 +	if(anns != null)
   8.776 +		{
   8.777 +		++attributeCount;
   8.778 +		size += 8 + anns.getSize();
   8.779 +		newUTF8("RuntimeVisibleAnnotations");
   8.780 +		}
   8.781 +	if(ianns != null)
   8.782 +		{
   8.783 +		++attributeCount;
   8.784 +		size += 8 + ianns.getSize();
   8.785 +		newUTF8("RuntimeInvisibleAnnotations");
   8.786 +		}
   8.787 +	if(attrs != null)
   8.788 +		{
   8.789 +		attributeCount += attrs.getCount();
   8.790 +		size += attrs.getSize(this, null, 0, -1, -1);
   8.791 +		}
   8.792 +	size += pool.length;
   8.793 +	// allocates a byte vector of this size, in order to avoid unnecessary
   8.794 +	// arraycopy operations in the ByteVector.enlarge() method
   8.795 +	ByteVector out = new ByteVector(size);
   8.796 +	out.putInt(0xCAFEBABE).putInt(version);
   8.797 +	out.putShort(index).putByteArray(pool.data, 0, pool.length);
   8.798 +	out.putShort(access).putShort(name).putShort(superName);
   8.799 +	out.putShort(interfaceCount);
   8.800 +	for(int i = 0; i < interfaceCount; ++i)
   8.801 +		{
   8.802 +		out.putShort(interfaces[i]);
   8.803 +		}
   8.804 +	out.putShort(nbFields);
   8.805 +	fb = firstField;
   8.806 +	while(fb != null)
   8.807 +		{
   8.808 +		fb.put(out);
   8.809 +		fb = fb.next;
   8.810 +		}
   8.811 +	out.putShort(nbMethods);
   8.812 +	mb = firstMethod;
   8.813 +	while(mb != null)
   8.814 +		{
   8.815 +		mb.put(out);
   8.816 +		mb = mb.next;
   8.817 +		}
   8.818 +	out.putShort(attributeCount);
   8.819 +	if(signature != 0)
   8.820 +		{
   8.821 +		out.putShort(newUTF8("Signature")).putInt(2).putShort(signature);
   8.822 +		}
   8.823 +	if(sourceFile != 0)
   8.824 +		{
   8.825 +		out.putShort(newUTF8("SourceFile")).putInt(2).putShort(sourceFile);
   8.826 +		}
   8.827 +	if(sourceDebug != null)
   8.828 +		{
   8.829 +		int len = sourceDebug.length - 2;
   8.830 +		out.putShort(newUTF8("SourceDebugExtension")).putInt(len);
   8.831 +		out.putByteArray(sourceDebug.data, 2, len);
   8.832 +		}
   8.833 +	if(enclosingMethodOwner != 0)
   8.834 +		{
   8.835 +		out.putShort(newUTF8("EnclosingMethod")).putInt(4);
   8.836 +		out.putShort(enclosingMethodOwner).putShort(enclosingMethod);
   8.837 +		}
   8.838 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
   8.839 +		{
   8.840 +		out.putShort(newUTF8("Deprecated")).putInt(0);
   8.841 +		}
   8.842 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
   8.843 +	   && (version & 0xffff) < Opcodes.V1_5)
   8.844 +		{
   8.845 +		out.putShort(newUTF8("Synthetic")).putInt(0);
   8.846 +		}
   8.847 +	if(innerClasses != null)
   8.848 +		{
   8.849 +		out.putShort(newUTF8("InnerClasses"));
   8.850 +		out.putInt(innerClasses.length + 2).putShort(innerClassesCount);
   8.851 +		out.putByteArray(innerClasses.data, 0, innerClasses.length);
   8.852 +		}
   8.853 +	if(anns != null)
   8.854 +		{
   8.855 +		out.putShort(newUTF8("RuntimeVisibleAnnotations"));
   8.856 +		anns.put(out);
   8.857 +		}
   8.858 +	if(ianns != null)
   8.859 +		{
   8.860 +		out.putShort(newUTF8("RuntimeInvisibleAnnotations"));
   8.861 +		ianns.put(out);
   8.862 +		}
   8.863 +	if(attrs != null)
   8.864 +		{
   8.865 +		attrs.put(this, null, 0, -1, -1, out);
   8.866 +		}
   8.867 +	if(invalidFrames)
   8.868 +		{
   8.869 +		ClassWriter cw = new ClassWriter(COMPUTE_FRAMES);
   8.870 +		new ClassReader(out.data).accept(cw, ClassReader.SKIP_FRAMES);
   8.871 +		return cw.toByteArray();
   8.872 +		}
   8.873 +	return out.data;
   8.874 +}
   8.875 +
   8.876 +// ------------------------------------------------------------------------
   8.877 +// Utility methods: constant pool management
   8.878 +// ------------------------------------------------------------------------
   8.879 +
   8.880 +/**
   8.881 + * Adds a number or string constant to the constant pool of the class being
   8.882 + * build. Does nothing if the constant pool already contains a similar item.
   8.883 + *
   8.884 + * @param cst the value of the constant to be added to the constant pool.
   8.885 + *            This parameter must be an {@link Integer}, a {@link Float}, a
   8.886 + *            {@link Long}, a {@link Double}, a {@link String} or a
   8.887 + *            {@link Type}.
   8.888 + * @return a new or already existing constant item with the given value.
   8.889 + */
   8.890 +Item newConstItem(final Object cst){
   8.891 +	if(cst instanceof Integer)
   8.892 +		{
   8.893 +		int val = ((Integer) cst).intValue();
   8.894 +		return newInteger(val);
   8.895 +		}
   8.896 +	else if(cst instanceof Byte)
   8.897 +		{
   8.898 +		int val = ((Byte) cst).intValue();
   8.899 +		return newInteger(val);
   8.900 +		}
   8.901 +	else if(cst instanceof Character)
   8.902 +		{
   8.903 +		int val = ((Character) cst).charValue();
   8.904 +		return newInteger(val);
   8.905 +		}
   8.906 +	else if(cst instanceof Short)
   8.907 +		{
   8.908 +		int val = ((Short) cst).intValue();
   8.909 +		return newInteger(val);
   8.910 +		}
   8.911 +	else if(cst instanceof Boolean)
   8.912 +		{
   8.913 +		int val = ((Boolean) cst).booleanValue() ? 1 : 0;
   8.914 +		return newInteger(val);
   8.915 +		}
   8.916 +	else if(cst instanceof Float)
   8.917 +		{
   8.918 +		float val = ((Float) cst).floatValue();
   8.919 +		return newFloat(val);
   8.920 +		}
   8.921 +	else if(cst instanceof Long)
   8.922 +		{
   8.923 +		long val = ((Long) cst).longValue();
   8.924 +		return newLong(val);
   8.925 +		}
   8.926 +	else if(cst instanceof Double)
   8.927 +		{
   8.928 +		double val = ((Double) cst).doubleValue();
   8.929 +		return newDouble(val);
   8.930 +		}
   8.931 +	else if(cst instanceof String)
   8.932 +		{
   8.933 +		return newString((String) cst);
   8.934 +		}
   8.935 +	else if(cst instanceof Type)
   8.936 +		{
   8.937 +		Type t = (Type) cst;
   8.938 +		return newClassItem(t.getSort() == Type.OBJECT
   8.939 +		                    ? t.getInternalName()
   8.940 +		                    : t.getDescriptor());
   8.941 +		}
   8.942 +	else
   8.943 +		{
   8.944 +		throw new IllegalArgumentException("value " + cst);
   8.945 +		}
   8.946 +}
   8.947 +
   8.948 +/**
   8.949 + * Adds a number or string constant to the constant pool of the class being
   8.950 + * build. Does nothing if the constant pool already contains a similar item.
   8.951 + * <i>This method is intended for {@link Attribute} sub classes, and is
   8.952 + * normally not needed by class generators or adapters.</i>
   8.953 + *
   8.954 + * @param cst the value of the constant to be added to the constant pool.
   8.955 + *            This parameter must be an {@link Integer}, a {@link Float}, a
   8.956 + *            {@link Long}, a {@link Double} or a {@link String}.
   8.957 + * @return the index of a new or already existing constant item with the
   8.958 + *         given value.
   8.959 + */
   8.960 +public int newConst(final Object cst){
   8.961 +	return newConstItem(cst).index;
   8.962 +}
   8.963 +
   8.964 +/**
   8.965 + * Adds an UTF8 string to the constant pool of the class being build. Does
   8.966 + * nothing if the constant pool already contains a similar item. <i>This
   8.967 + * method is intended for {@link Attribute} sub classes, and is normally not
   8.968 + * needed by class generators or adapters.</i>
   8.969 + *
   8.970 + * @param value the String value.
   8.971 + * @return the index of a new or already existing UTF8 item.
   8.972 + */
   8.973 +public int newUTF8(final String value){
   8.974 +	key.set(UTF8, value, null, null);
   8.975 +	Item result = get(key);
   8.976 +	if(result == null)
   8.977 +		{
   8.978 +		pool.putByte(UTF8).putUTF8(value);
   8.979 +		result = new Item(index++, key);
   8.980 +		put(result);
   8.981 +		}
   8.982 +	return result.index;
   8.983 +}
   8.984 +
   8.985 +/**
   8.986 + * Adds a class reference to the constant pool of the class being build.
   8.987 + * Does nothing if the constant pool already contains a similar item.
   8.988 + * <i>This method is intended for {@link Attribute} sub classes, and is
   8.989 + * normally not needed by class generators or adapters.</i>
   8.990 + *
   8.991 + * @param value the internal name of the class.
   8.992 + * @return a new or already existing class reference item.
   8.993 + */
   8.994 +Item newClassItem(final String value){
   8.995 +	key2.set(CLASS, value, null, null);
   8.996 +	Item result = get(key2);
   8.997 +	if(result == null)
   8.998 +		{
   8.999 +		pool.put12(CLASS, newUTF8(value));
  8.1000 +		result = new Item(index++, key2);
  8.1001 +		put(result);
  8.1002 +		}
  8.1003 +	return result;
  8.1004 +}
  8.1005 +
  8.1006 +/**
  8.1007 + * Adds a class reference to the constant pool of the class being build.
  8.1008 + * Does nothing if the constant pool already contains a similar item.
  8.1009 + * <i>This method is intended for {@link Attribute} sub classes, and is
  8.1010 + * normally not needed by class generators or adapters.</i>
  8.1011 + *
  8.1012 + * @param value the internal name of the class.
  8.1013 + * @return the index of a new or already existing class reference item.
  8.1014 + */
  8.1015 +public int newClass(final String value){
  8.1016 +	return newClassItem(value).index;
  8.1017 +}
  8.1018 +
  8.1019 +/**
  8.1020 + * Adds a field reference to the constant pool of the class being build.
  8.1021 + * Does nothing if the constant pool already contains a similar item.
  8.1022 + *
  8.1023 + * @param owner the internal name of the field's owner class.
  8.1024 + * @param name  the field's name.
  8.1025 + * @param desc  the field's descriptor.
  8.1026 + * @return a new or already existing field reference item.
  8.1027 + */
  8.1028 +Item newFieldItem(final String owner, final String name, final String desc){
  8.1029 +	key3.set(FIELD, owner, name, desc);
  8.1030 +	Item result = get(key3);
  8.1031 +	if(result == null)
  8.1032 +		{
  8.1033 +		put122(FIELD, newClass(owner), newNameType(name, desc));
  8.1034 +		result = new Item(index++, key3);
  8.1035 +		put(result);
  8.1036 +		}
  8.1037 +	return result;
  8.1038 +}
  8.1039 +
  8.1040 +/**
  8.1041 + * Adds a field reference to the constant pool of the class being build.
  8.1042 + * Does nothing if the constant pool already contains a similar item.
  8.1043 + * <i>This method is intended for {@link Attribute} sub classes, and is
  8.1044 + * normally not needed by class generators or adapters.</i>
  8.1045 + *
  8.1046 + * @param owner the internal name of the field's owner class.
  8.1047 + * @param name  the field's name.
  8.1048 + * @param desc  the field's descriptor.
  8.1049 + * @return the index of a new or already existing field reference item.
  8.1050 + */
  8.1051 +public int newField(final String owner, final String name, final String desc){
  8.1052 +	return newFieldItem(owner, name, desc).index;
  8.1053 +}
  8.1054 +
  8.1055 +/**
  8.1056 + * Adds a method reference to the constant pool of the class being build.
  8.1057 + * Does nothing if the constant pool already contains a similar item.
  8.1058 + *
  8.1059 + * @param owner the internal name of the method's owner class.
  8.1060 + * @param name  the method's name.
  8.1061 + * @param desc  the method's descriptor.
  8.1062 + * @param itf   <tt>true</tt> if <tt>owner</tt> is an interface.
  8.1063 + * @return a new or already existing method reference item.
  8.1064 + */
  8.1065 +Item newMethodItem(
  8.1066 +		final String owner,
  8.1067 +		final String name,
  8.1068 +		final String desc,
  8.1069 +		final boolean itf){
  8.1070 +	int type = itf ? IMETH : METH;
  8.1071 +	key3.set(type, owner, name, desc);
  8.1072 +	Item result = get(key3);
  8.1073 +	if(result == null)
  8.1074 +		{
  8.1075 +		put122(type, newClass(owner), newNameType(name, desc));
  8.1076 +		result = new Item(index++, key3);
  8.1077 +		put(result);
  8.1078 +		}
  8.1079 +	return result;
  8.1080 +}
  8.1081 +
  8.1082 +/**
  8.1083 + * Adds a method reference to the constant pool of the class being build.
  8.1084 + * Does nothing if the constant pool already contains a similar item.
  8.1085 + * <i>This method is intended for {@link Attribute} sub classes, and is
  8.1086 + * normally not needed by class generators or adapters.</i>
  8.1087 + *
  8.1088 + * @param owner the internal name of the method's owner class.
  8.1089 + * @param name  the method's name.
  8.1090 + * @param desc  the method's descriptor.
  8.1091 + * @param itf   <tt>true</tt> if <tt>owner</tt> is an interface.
  8.1092 + * @return the index of a new or already existing method reference item.
  8.1093 + */
  8.1094 +public int newMethod(
  8.1095 +		final String owner,
  8.1096 +		final String name,
  8.1097 +		final String desc,
  8.1098 +		final boolean itf){
  8.1099 +	return newMethodItem(owner, name, desc, itf).index;
  8.1100 +}
  8.1101 +
  8.1102 +/**
  8.1103 + * Adds an integer to the constant pool of the class being build. Does
  8.1104 + * nothing if the constant pool already contains a similar item.
  8.1105 + *
  8.1106 + * @param value the int value.
  8.1107 + * @return a new or already existing int item.
  8.1108 + */
  8.1109 +Item newInteger(final int value){
  8.1110 +	key.set(value);
  8.1111 +	Item result = get(key);
  8.1112 +	if(result == null)
  8.1113 +		{
  8.1114 +		pool.putByte(INT).putInt(value);
  8.1115 +		result = new Item(index++, key);
  8.1116 +		put(result);
  8.1117 +		}
  8.1118 +	return result;
  8.1119 +}
  8.1120 +
  8.1121 +/**
  8.1122 + * Adds a float to the constant pool of the class being build. Does nothing
  8.1123 + * if the constant pool already contains a similar item.
  8.1124 + *
  8.1125 + * @param value the float value.
  8.1126 + * @return a new or already existing float item.
  8.1127 + */
  8.1128 +Item newFloat(final float value){
  8.1129 +	key.set(value);
  8.1130 +	Item result = get(key);
  8.1131 +	if(result == null)
  8.1132 +		{
  8.1133 +		pool.putByte(FLOAT).putInt(key.intVal);
  8.1134 +		result = new Item(index++, key);
  8.1135 +		put(result);
  8.1136 +		}
  8.1137 +	return result;
  8.1138 +}
  8.1139 +
  8.1140 +/**
  8.1141 + * Adds a long to the constant pool of the class being build. Does nothing
  8.1142 + * if the constant pool already contains a similar item.
  8.1143 + *
  8.1144 + * @param value the long value.
  8.1145 + * @return a new or already existing long item.
  8.1146 + */
  8.1147 +Item newLong(final long value){
  8.1148 +	key.set(value);
  8.1149 +	Item result = get(key);
  8.1150 +	if(result == null)
  8.1151 +		{
  8.1152 +		pool.putByte(LONG).putLong(value);
  8.1153 +		result = new Item(index, key);
  8.1154 +		put(result);
  8.1155 +		index += 2;
  8.1156 +		}
  8.1157 +	return result;
  8.1158 +}
  8.1159 +
  8.1160 +/**
  8.1161 + * Adds a double to the constant pool of the class being build. Does nothing
  8.1162 + * if the constant pool already contains a similar item.
  8.1163 + *
  8.1164 + * @param value the double value.
  8.1165 + * @return a new or already existing double item.
  8.1166 + */
  8.1167 +Item newDouble(final double value){
  8.1168 +	key.set(value);
  8.1169 +	Item result = get(key);
  8.1170 +	if(result == null)
  8.1171 +		{
  8.1172 +		pool.putByte(DOUBLE).putLong(key.longVal);
  8.1173 +		result = new Item(index, key);
  8.1174 +		put(result);
  8.1175 +		index += 2;
  8.1176 +		}
  8.1177 +	return result;
  8.1178 +}
  8.1179 +
  8.1180 +/**
  8.1181 + * Adds a string to the constant pool of the class being build. Does nothing
  8.1182 + * if the constant pool already contains a similar item.
  8.1183 + *
  8.1184 + * @param value the String value.
  8.1185 + * @return a new or already existing string item.
  8.1186 + */
  8.1187 +private Item newString(final String value){
  8.1188 +	key2.set(STR, value, null, null);
  8.1189 +	Item result = get(key2);
  8.1190 +	if(result == null)
  8.1191 +		{
  8.1192 +		pool.put12(STR, newUTF8(value));
  8.1193 +		result = new Item(index++, key2);
  8.1194 +		put(result);
  8.1195 +		}
  8.1196 +	return result;
  8.1197 +}
  8.1198 +
  8.1199 +/**
  8.1200 + * Adds a name and type to the constant pool of the class being build. Does
  8.1201 + * nothing if the constant pool already contains a similar item. <i>This
  8.1202 + * method is intended for {@link Attribute} sub classes, and is normally not
  8.1203 + * needed by class generators or adapters.</i>
  8.1204 + *
  8.1205 + * @param name a name.
  8.1206 + * @param desc a type descriptor.
  8.1207 + * @return the index of a new or already existing name and type item.
  8.1208 + */
  8.1209 +public int newNameType(final String name, final String desc){
  8.1210 +	key2.set(NAME_TYPE, name, desc, null);
  8.1211 +	Item result = get(key2);
  8.1212 +	if(result == null)
  8.1213 +		{
  8.1214 +		put122(NAME_TYPE, newUTF8(name), newUTF8(desc));
  8.1215 +		result = new Item(index++, key2);
  8.1216 +		put(result);
  8.1217 +		}
  8.1218 +	return result.index;
  8.1219 +}
  8.1220 +
  8.1221 +/**
  8.1222 + * Adds the given internal name to {@link #typeTable} and returns its index.
  8.1223 + * Does nothing if the type table already contains this internal name.
  8.1224 + *
  8.1225 + * @param type the internal name to be added to the type table.
  8.1226 + * @return the index of this internal name in the type table.
  8.1227 + */
  8.1228 +int addType(final String type){
  8.1229 +	key.set(TYPE_NORMAL, type, null, null);
  8.1230 +	Item result = get(key);
  8.1231 +	if(result == null)
  8.1232 +		{
  8.1233 +		result = addType(key);
  8.1234 +		}
  8.1235 +	return result.index;
  8.1236 +}
  8.1237 +
  8.1238 +/**
  8.1239 + * Adds the given "uninitialized" type to {@link #typeTable} and returns its
  8.1240 + * index. This method is used for UNINITIALIZED types, made of an internal
  8.1241 + * name and a bytecode offset.
  8.1242 + *
  8.1243 + * @param type   the internal name to be added to the type table.
  8.1244 + * @param offset the bytecode offset of the NEW instruction that created
  8.1245 + *               this UNINITIALIZED type value.
  8.1246 + * @return the index of this internal name in the type table.
  8.1247 + */
  8.1248 +int addUninitializedType(final String type, final int offset){
  8.1249 +	key.type = TYPE_UNINIT;
  8.1250 +	key.intVal = offset;
  8.1251 +	key.strVal1 = type;
  8.1252 +	key.hashCode = 0x7FFFFFFF & (TYPE_UNINIT + type.hashCode() + offset);
  8.1253 +	Item result = get(key);
  8.1254 +	if(result == null)
  8.1255 +		{
  8.1256 +		result = addType(key);
  8.1257 +		}
  8.1258 +	return result.index;
  8.1259 +}
  8.1260 +
  8.1261 +/**
  8.1262 + * Adds the given Item to {@link #typeTable}.
  8.1263 + *
  8.1264 + * @param item the value to be added to the type table.
  8.1265 + * @return the added Item, which a new Item instance with the same value as
  8.1266 + *         the given Item.
  8.1267 + */
  8.1268 +private Item addType(final Item item){
  8.1269 +	++typeCount;
  8.1270 +	Item result = new Item(typeCount, key);
  8.1271 +	put(result);
  8.1272 +	if(typeTable == null)
  8.1273 +		{
  8.1274 +		typeTable = new Item[16];
  8.1275 +		}
  8.1276 +	if(typeCount == typeTable.length)
  8.1277 +		{
  8.1278 +		Item[] newTable = new Item[2 * typeTable.length];
  8.1279 +		System.arraycopy(typeTable, 0, newTable, 0, typeTable.length);
  8.1280 +		typeTable = newTable;
  8.1281 +		}
  8.1282 +	typeTable[typeCount] = result;
  8.1283 +	return result;
  8.1284 +}
  8.1285 +
  8.1286 +/**
  8.1287 + * Returns the index of the common super type of the two given types. This
  8.1288 + * method calls {@link #getCommonSuperClass} and caches the result in the
  8.1289 + * {@link #items} hash table to speedup future calls with the same
  8.1290 + * parameters.
  8.1291 + *
  8.1292 + * @param type1 index of an internal name in {@link #typeTable}.
  8.1293 + * @param type2 index of an internal name in {@link #typeTable}.
  8.1294 + * @return the index of the common super type of the two given types.
  8.1295 + */
  8.1296 +int getMergedType(final int type1, final int type2){
  8.1297 +	key2.type = TYPE_MERGED;
  8.1298 +	key2.longVal = type1 | (((long) type2) << 32);
  8.1299 +	key2.hashCode = 0x7FFFFFFF & (TYPE_MERGED + type1 + type2);
  8.1300 +	Item result = get(key2);
  8.1301 +	if(result == null)
  8.1302 +		{
  8.1303 +		String t = typeTable[type1].strVal1;
  8.1304 +		String u = typeTable[type2].strVal1;
  8.1305 +		key2.intVal = addType(getCommonSuperClass(t, u));
  8.1306 +		result = new Item((short) 0, key2);
  8.1307 +		put(result);
  8.1308 +		}
  8.1309 +	return result.intVal;
  8.1310 +}
  8.1311 +
  8.1312 +/**
  8.1313 + * Returns the common super type of the two given types. The default
  8.1314 + * implementation of this method <i>loads<i> the two given classes and uses
  8.1315 + * the java.lang.Class methods to find the common super class. It can be
  8.1316 + * overriden to compute this common super type in other ways, in particular
  8.1317 + * without actually loading any class, or to take into account the class
  8.1318 + * that is currently being generated by this ClassWriter, which can of
  8.1319 + * course not be loaded since it is under construction.
  8.1320 + *
  8.1321 + * @param type1 the internal name of a class.
  8.1322 + * @param type2 the internal name of another class.
  8.1323 + * @return the internal name of the common super class of the two given
  8.1324 + *         classes.
  8.1325 + */
  8.1326 +protected String getCommonSuperClass(final String type1, final String type2){
  8.1327 +	Class c, d;
  8.1328 +	try
  8.1329 +		{
  8.1330 +		c = Class.forName(type1.replace('/', '.'));
  8.1331 +		d = Class.forName(type2.replace('/', '.'));
  8.1332 +		}
  8.1333 +	catch(ClassNotFoundException e)
  8.1334 +		{
  8.1335 +		throw new RuntimeException(e);
  8.1336 +		}
  8.1337 +	if(c.isAssignableFrom(d))
  8.1338 +		{
  8.1339 +		return type1;
  8.1340 +		}
  8.1341 +	if(d.isAssignableFrom(c))
  8.1342 +		{
  8.1343 +		return type2;
  8.1344 +		}
  8.1345 +	if(c.isInterface() || d.isInterface())
  8.1346 +		{
  8.1347 +		return "java/lang/Object";
  8.1348 +		}
  8.1349 +	else
  8.1350 +		{
  8.1351 +		do
  8.1352 +			{
  8.1353 +			c = c.getSuperclass();
  8.1354 +			} while(!c.isAssignableFrom(d));
  8.1355 +		return c.getName().replace('.', '/');
  8.1356 +		}
  8.1357 +}
  8.1358 +
  8.1359 +/**
  8.1360 + * Returns the constant pool's hash table item which is equal to the given
  8.1361 + * item.
  8.1362 + *
  8.1363 + * @param key a constant pool item.
  8.1364 + * @return the constant pool's hash table item which is equal to the given
  8.1365 + *         item, or <tt>null</tt> if there is no such item.
  8.1366 + */
  8.1367 +private Item get(final Item key){
  8.1368 +	Item i = items[key.hashCode % items.length];
  8.1369 +	while(i != null && !key.isEqualTo(i))
  8.1370 +		{
  8.1371 +		i = i.next;
  8.1372 +		}
  8.1373 +	return i;
  8.1374 +}
  8.1375 +
  8.1376 +/**
  8.1377 + * Puts the given item in the constant pool's hash table. The hash table
  8.1378 + * <i>must</i> not already contains this item.
  8.1379 + *
  8.1380 + * @param i the item to be added to the constant pool's hash table.
  8.1381 + */
  8.1382 +private void put(final Item i){
  8.1383 +	if(index > threshold)
  8.1384 +		{
  8.1385 +		int ll = items.length;
  8.1386 +		int nl = ll * 2 + 1;
  8.1387 +		Item[] newItems = new Item[nl];
  8.1388 +		for(int l = ll - 1; l >= 0; --l)
  8.1389 +			{
  8.1390 +			Item j = items[l];
  8.1391 +			while(j != null)
  8.1392 +				{
  8.1393 +				int index = j.hashCode % newItems.length;
  8.1394 +				Item k = j.next;
  8.1395 +				j.next = newItems[index];
  8.1396 +				newItems[index] = j;
  8.1397 +				j = k;
  8.1398 +				}
  8.1399 +			}
  8.1400 +		items = newItems;
  8.1401 +		threshold = (int) (nl * 0.75);
  8.1402 +		}
  8.1403 +	int index = i.hashCode % items.length;
  8.1404 +	i.next = items[index];
  8.1405 +	items[index] = i;
  8.1406 +}
  8.1407 +
  8.1408 +/**
  8.1409 + * Puts one byte and two shorts into the constant pool.
  8.1410 + *
  8.1411 + * @param b  a byte.
  8.1412 + * @param s1 a short.
  8.1413 + * @param s2 another short.
  8.1414 + */
  8.1415 +private void put122(final int b, final int s1, final int s2){
  8.1416 +	pool.put12(b, s1).putShort(s2);
  8.1417 +}
  8.1418 +}
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/clojure/asm/Edge.java	Sat Aug 21 06:25:44 2010 -0400
     9.3 @@ -0,0 +1,75 @@
     9.4 +/***
     9.5 + * ASM: a very small and fast Java bytecode manipulation framework
     9.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
     9.7 + * All rights reserved.
     9.8 + *
     9.9 + * Redistribution and use in source and binary forms, with or without
    9.10 + * modification, are permitted provided that the following conditions
    9.11 + * are met:
    9.12 + * 1. Redistributions of source code must retain the above copyright
    9.13 + *    notice, this list of conditions and the following disclaimer.
    9.14 + * 2. Redistributions in binary form must reproduce the above copyright
    9.15 + *    notice, this list of conditions and the following disclaimer in the
    9.16 + *    documentation and/or other materials provided with the distribution.
    9.17 + * 3. Neither the name of the copyright holders nor the names of its
    9.18 + *    contributors may be used to endorse or promote products derived from
    9.19 + *    this software without specific prior written permission.
    9.20 + *
    9.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
    9.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
    9.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
    9.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
    9.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    9.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
    9.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
    9.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
    9.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
    9.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    9.31 + * THE POSSIBILITY OF SUCH DAMAGE.
    9.32 + */
    9.33 +package clojure.asm;
    9.34 +
    9.35 +/**
    9.36 + * An edge in the control flow graph of a method body. See {@link Label Label}.
    9.37 + *
    9.38 + * @author Eric Bruneton
    9.39 + */
    9.40 +class Edge{
    9.41 +
    9.42 +/**
    9.43 + * Denotes a normal control flow graph edge.
    9.44 + */
    9.45 +final static int NORMAL = 0;
    9.46 +
    9.47 +/**
    9.48 + * Denotes a control flow graph edge corresponding to an exception handler.
    9.49 + * More precisely any {@link Edge} whose {@link #info} is strictly positive
    9.50 + * corresponds to an exception handler. The actual value of {@link #info} is
    9.51 + * the index, in the {@link ClassWriter} type table, of the exception that
    9.52 + * is catched.
    9.53 + */
    9.54 +final static int EXCEPTION = 0x7FFFFFFF;
    9.55 +
    9.56 +/**
    9.57 + * Information about this control flow graph edge. If
    9.58 + * {@link ClassWriter#COMPUTE_MAXS} is used this field is the (relative)
    9.59 + * stack size in the basic block from which this edge originates. This size
    9.60 + * is equal to the stack size at the "jump" instruction to which this edge
    9.61 + * corresponds, relatively to the stack size at the beginning of the
    9.62 + * originating basic block. If {@link ClassWriter#COMPUTE_FRAMES} is used,
    9.63 + * this field is the kind of this control flow graph edge (i.e. NORMAL or
    9.64 + * EXCEPTION).
    9.65 + */
    9.66 +int info;
    9.67 +
    9.68 +/**
    9.69 + * The successor block of the basic block from which this edge originates.
    9.70 + */
    9.71 +Label successor;
    9.72 +
    9.73 +/**
    9.74 + * The next edge in the list of successors of the originating basic block.
    9.75 + * See {@link Label#successors successors}.
    9.76 + */
    9.77 +Edge next;
    9.78 +}
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/clojure/asm/FieldVisitor.java	Sat Aug 21 06:25:44 2010 -0400
    10.3 @@ -0,0 +1,64 @@
    10.4 +/***
    10.5 + * ASM: a very small and fast Java bytecode manipulation framework
    10.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    10.7 + * All rights reserved.
    10.8 + *
    10.9 + * Redistribution and use in source and binary forms, with or without
   10.10 + * modification, are permitted provided that the following conditions
   10.11 + * are met:
   10.12 + * 1. Redistributions of source code must retain the above copyright
   10.13 + *    notice, this list of conditions and the following disclaimer.
   10.14 + * 2. Redistributions in binary form must reproduce the above copyright
   10.15 + *    notice, this list of conditions and the following disclaimer in the
   10.16 + *    documentation and/or other materials provided with the distribution.
   10.17 + * 3. Neither the name of the copyright holders nor the names of its
   10.18 + *    contributors may be used to endorse or promote products derived from
   10.19 + *    this software without specific prior written permission.
   10.20 + *
   10.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   10.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   10.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   10.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   10.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   10.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   10.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   10.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   10.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   10.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   10.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   10.32 + */
   10.33 +package clojure.asm;
   10.34 +
   10.35 +/**
   10.36 + * A visitor to visit a Java field. The methods of this interface must be called
   10.37 + * in the following order: ( <tt>visitAnnotation</tt> |
   10.38 + * <tt>visitAttribute</tt> )* <tt>visitEnd</tt>.
   10.39 + *
   10.40 + * @author Eric Bruneton
   10.41 + */
   10.42 +public interface FieldVisitor{
   10.43 +
   10.44 +/**
   10.45 + * Visits an annotation of the field.
   10.46 + *
   10.47 + * @param desc    the class descriptor of the annotation class.
   10.48 + * @param visible <tt>true</tt> if the annotation is visible at runtime.
   10.49 + * @return a visitor to visit the annotation values, or <tt>null</tt> if
   10.50 + *         this visitor is not interested in visiting this annotation.
   10.51 + */
   10.52 +AnnotationVisitor visitAnnotation(String desc, boolean visible);
   10.53 +
   10.54 +/**
   10.55 + * Visits a non standard attribute of the field.
   10.56 + *
   10.57 + * @param attr an attribute.
   10.58 + */
   10.59 +void visitAttribute(Attribute attr);
   10.60 +
   10.61 +/**
   10.62 + * Visits the end of the field. This method, which is the last one to be
   10.63 + * called, is used to inform the visitor that all the annotations and
   10.64 + * attributes of the field have been visited.
   10.65 + */
   10.66 +void visitEnd();
   10.67 +}
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/clojure/asm/FieldWriter.java	Sat Aug 21 06:25:44 2010 -0400
    11.3 @@ -0,0 +1,290 @@
    11.4 +/***
    11.5 + * ASM: a very small and fast Java bytecode manipulation framework
    11.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    11.7 + * All rights reserved.
    11.8 + *
    11.9 + * Redistribution and use in source and binary forms, with or without
   11.10 + * modification, are permitted provided that the following conditions
   11.11 + * are met:
   11.12 + * 1. Redistributions of source code must retain the above copyright
   11.13 + *    notice, this list of conditions and the following disclaimer.
   11.14 + * 2. Redistributions in binary form must reproduce the above copyright
   11.15 + *    notice, this list of conditions and the following disclaimer in the
   11.16 + *    documentation and/or other materials provided with the distribution.
   11.17 + * 3. Neither the name of the copyright holders nor the names of its
   11.18 + *    contributors may be used to endorse or promote products derived from
   11.19 + *    this software without specific prior written permission.
   11.20 + *
   11.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   11.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   11.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   11.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   11.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   11.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   11.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   11.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   11.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   11.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   11.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   11.32 + */
   11.33 +package clojure.asm;
   11.34 +
   11.35 +/**
   11.36 + * An {@link FieldVisitor} that generates Java fields in bytecode form.
   11.37 + *
   11.38 + * @author Eric Bruneton
   11.39 + */
   11.40 +final class FieldWriter implements FieldVisitor{
   11.41 +
   11.42 +/**
   11.43 + * Next field writer (see {@link ClassWriter#firstField firstField}).
   11.44 + */
   11.45 +FieldWriter next;
   11.46 +
   11.47 +/**
   11.48 + * The class writer to which this field must be added.
   11.49 + */
   11.50 +private ClassWriter cw;
   11.51 +
   11.52 +/**
   11.53 + * Access flags of this field.
   11.54 + */
   11.55 +private int access;
   11.56 +
   11.57 +/**
   11.58 + * The index of the constant pool item that contains the name of this
   11.59 + * method.
   11.60 + */
   11.61 +private int name;
   11.62 +
   11.63 +/**
   11.64 + * The index of the constant pool item that contains the descriptor of this
   11.65 + * field.
   11.66 + */
   11.67 +private int desc;
   11.68 +
   11.69 +/**
   11.70 + * The index of the constant pool item that contains the signature of this
   11.71 + * field.
   11.72 + */
   11.73 +private int signature;
   11.74 +
   11.75 +/**
   11.76 + * The index of the constant pool item that contains the constant value of
   11.77 + * this field.
   11.78 + */
   11.79 +private int value;
   11.80 +
   11.81 +/**
   11.82 + * The runtime visible annotations of this field. May be <tt>null</tt>.
   11.83 + */
   11.84 +private AnnotationWriter anns;
   11.85 +
   11.86 +/**
   11.87 + * The runtime invisible annotations of this field. May be <tt>null</tt>.
   11.88 + */
   11.89 +private AnnotationWriter ianns;
   11.90 +
   11.91 +/**
   11.92 + * The non standard attributes of this field. May be <tt>null</tt>.
   11.93 + */
   11.94 +private Attribute attrs;
   11.95 +
   11.96 +// ------------------------------------------------------------------------
   11.97 +// Constructor
   11.98 +// ------------------------------------------------------------------------
   11.99 +
  11.100 +/**
  11.101 + * Constructs a new {@link FieldWriter}.
  11.102 + *
  11.103 + * @param cw        the class writer to which this field must be added.
  11.104 + * @param access    the field's access flags (see {@link Opcodes}).
  11.105 + * @param name      the field's name.
  11.106 + * @param desc      the field's descriptor (see {@link Type}).
  11.107 + * @param signature the field's signature. May be <tt>null</tt>.
  11.108 + * @param value     the field's constant value. May be <tt>null</tt>.
  11.109 + */
  11.110 +protected FieldWriter(
  11.111 +		final ClassWriter cw,
  11.112 +		final int access,
  11.113 +		final String name,
  11.114 +		final String desc,
  11.115 +		final String signature,
  11.116 +		final Object value){
  11.117 +	if(cw.firstField == null)
  11.118 +		{
  11.119 +		cw.firstField = this;
  11.120 +		}
  11.121 +	else
  11.122 +		{
  11.123 +		cw.lastField.next = this;
  11.124 +		}
  11.125 +	cw.lastField = this;
  11.126 +	this.cw = cw;
  11.127 +	this.access = access;
  11.128 +	this.name = cw.newUTF8(name);
  11.129 +	this.desc = cw.newUTF8(desc);
  11.130 +	if(signature != null)
  11.131 +		{
  11.132 +		this.signature = cw.newUTF8(signature);
  11.133 +		}
  11.134 +	if(value != null)
  11.135 +		{
  11.136 +		this.value = cw.newConstItem(value).index;
  11.137 +		}
  11.138 +}
  11.139 +
  11.140 +// ------------------------------------------------------------------------
  11.141 +// Implementation of the FieldVisitor interface
  11.142 +// ------------------------------------------------------------------------
  11.143 +
  11.144 +public AnnotationVisitor visitAnnotation(
  11.145 +		final String desc,
  11.146 +		final boolean visible){
  11.147 +	ByteVector bv = new ByteVector();
  11.148 +	// write type, and reserve space for values count
  11.149 +	bv.putShort(cw.newUTF8(desc)).putShort(0);
  11.150 +	AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2);
  11.151 +	if(visible)
  11.152 +		{
  11.153 +		aw.next = anns;
  11.154 +		anns = aw;
  11.155 +		}
  11.156 +	else
  11.157 +		{
  11.158 +		aw.next = ianns;
  11.159 +		ianns = aw;
  11.160 +		}
  11.161 +	return aw;
  11.162 +}
  11.163 +
  11.164 +public void visitAttribute(final Attribute attr){
  11.165 +	attr.next = attrs;
  11.166 +	attrs = attr;
  11.167 +}
  11.168 +
  11.169 +public void visitEnd(){
  11.170 +}
  11.171 +
  11.172 +// ------------------------------------------------------------------------
  11.173 +// Utility methods
  11.174 +// ------------------------------------------------------------------------
  11.175 +
  11.176 +/**
  11.177 + * Returns the size of this field.
  11.178 + *
  11.179 + * @return the size of this field.
  11.180 + */
  11.181 +int getSize(){
  11.182 +	int size = 8;
  11.183 +	if(value != 0)
  11.184 +		{
  11.185 +		cw.newUTF8("ConstantValue");
  11.186 +		size += 8;
  11.187 +		}
  11.188 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
  11.189 +	   && (cw.version & 0xffff) < Opcodes.V1_5)
  11.190 +		{
  11.191 +		cw.newUTF8("Synthetic");
  11.192 +		size += 6;
  11.193 +		}
  11.194 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
  11.195 +		{
  11.196 +		cw.newUTF8("Deprecated");
  11.197 +		size += 6;
  11.198 +		}
  11.199 +	if(signature != 0)
  11.200 +		{
  11.201 +		cw.newUTF8("Signature");
  11.202 +		size += 8;
  11.203 +		}
  11.204 +	if(anns != null)
  11.205 +		{
  11.206 +		cw.newUTF8("RuntimeVisibleAnnotations");
  11.207 +		size += 8 + anns.getSize();
  11.208 +		}
  11.209 +	if(ianns != null)
  11.210 +		{
  11.211 +		cw.newUTF8("RuntimeInvisibleAnnotations");
  11.212 +		size += 8 + ianns.getSize();
  11.213 +		}
  11.214 +	if(attrs != null)
  11.215 +		{
  11.216 +		size += attrs.getSize(cw, null, 0, -1, -1);
  11.217 +		}
  11.218 +	return size;
  11.219 +}
  11.220 +
  11.221 +/**
  11.222 + * Puts the content of this field into the given byte vector.
  11.223 + *
  11.224 + * @param out where the content of this field must be put.
  11.225 + */
  11.226 +void put(final ByteVector out){
  11.227 +	out.putShort(access).putShort(name).putShort(desc);
  11.228 +	int attributeCount = 0;
  11.229 +	if(value != 0)
  11.230 +		{
  11.231 +		++attributeCount;
  11.232 +		}
  11.233 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
  11.234 +	   && (cw.version & 0xffff) < Opcodes.V1_5)
  11.235 +		{
  11.236 +		++attributeCount;
  11.237 +		}
  11.238 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
  11.239 +		{
  11.240 +		++attributeCount;
  11.241 +		}
  11.242 +	if(signature != 0)
  11.243 +		{
  11.244 +		++attributeCount;
  11.245 +		}
  11.246 +	if(anns != null)
  11.247 +		{
  11.248 +		++attributeCount;
  11.249 +		}
  11.250 +	if(ianns != null)
  11.251 +		{
  11.252 +		++attributeCount;
  11.253 +		}
  11.254 +	if(attrs != null)
  11.255 +		{
  11.256 +		attributeCount += attrs.getCount();
  11.257 +		}
  11.258 +	out.putShort(attributeCount);
  11.259 +	if(value != 0)
  11.260 +		{
  11.261 +		out.putShort(cw.newUTF8("ConstantValue"));
  11.262 +		out.putInt(2).putShort(value);
  11.263 +		}
  11.264 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
  11.265 +	   && (cw.version & 0xffff) < Opcodes.V1_5)
  11.266 +		{
  11.267 +		out.putShort(cw.newUTF8("Synthetic")).putInt(0);
  11.268 +		}
  11.269 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
  11.270 +		{
  11.271 +		out.putShort(cw.newUTF8("Deprecated")).putInt(0);
  11.272 +		}
  11.273 +	if(signature != 0)
  11.274 +		{
  11.275 +		out.putShort(cw.newUTF8("Signature"));
  11.276 +		out.putInt(2).putShort(signature);
  11.277 +		}
  11.278 +	if(anns != null)
  11.279 +		{
  11.280 +		out.putShort(cw.newUTF8("RuntimeVisibleAnnotations"));
  11.281 +		anns.put(out);
  11.282 +		}
  11.283 +	if(ianns != null)
  11.284 +		{
  11.285 +		out.putShort(cw.newUTF8("RuntimeInvisibleAnnotations"));
  11.286 +		ianns.put(out);
  11.287 +		}
  11.288 +	if(attrs != null)
  11.289 +		{
  11.290 +		attrs.put(cw, null, 0, -1, -1, out);
  11.291 +		}
  11.292 +}
  11.293 +}
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/clojure/asm/Frame.java	Sat Aug 21 06:25:44 2010 -0400
    12.3 @@ -0,0 +1,1506 @@
    12.4 +/***
    12.5 + * ASM: a very small and fast Java bytecode manipulation framework
    12.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    12.7 + * All rights reserved.
    12.8 + *
    12.9 + * Redistribution and use in source and binary forms, with or without
   12.10 + * modification, are permitted provided that the following conditions
   12.11 + * are met:
   12.12 + * 1. Redistributions of source code must retain the above copyright
   12.13 + *    notice, this list of conditions and the following disclaimer.
   12.14 + * 2. Redistributions in binary form must reproduce the above copyright
   12.15 + *    notice, this list of conditions and the following disclaimer in the
   12.16 + *    documentation and/or other materials provided with the distribution.
   12.17 + * 3. Neither the name of the copyright holders nor the names of its
   12.18 + *    contributors may be used to endorse or promote products derived from
   12.19 + *    this software without specific prior written permission.
   12.20 + *
   12.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   12.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   12.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   12.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   12.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   12.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   12.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   12.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   12.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   12.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   12.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   12.32 + */
   12.33 +package clojure.asm;
   12.34 +
   12.35 +/**
   12.36 + * Information about the input and output stack map frames of a basic block.
   12.37 + *
   12.38 + * @author Eric Bruneton
   12.39 + */
   12.40 +final class Frame{
   12.41 +
   12.42 +/*
   12.43 +	 * Frames are computed in a two steps process: during the visit of each
   12.44 +	 * instruction, the state of the frame at the end of current basic block is
   12.45 +	 * updated by simulating the action of the instruction on the previous state
   12.46 +	 * of this so called "output frame". In visitMaxs, a fix point algorithm is
   12.47 +	 * used to compute the "input frame" of each basic block, i.e. the stack map
   12.48 +	 * frame at the begining of the basic block, starting from the input frame
   12.49 +	 * of the first basic block (which is computed from the method descriptor),
   12.50 +	 * and by using the previously computed output frames to compute the input
   12.51 +	 * state of the other blocks.
   12.52 +	 *
   12.53 +	 * All output and input frames are stored as arrays of integers. Reference
   12.54 +	 * and array types are represented by an index into a type table (which is
   12.55 +	 * not the same as the constant pool of the class, in order to avoid adding
   12.56 +	 * unnecessary constants in the pool - not all computed frames will end up
   12.57 +	 * being stored in the stack map table). This allows very fast type
   12.58 +	 * comparisons.
   12.59 +	 *
   12.60 +	 * Output stack map frames are computed relatively to the input frame of the
   12.61 +	 * basic block, which is not yet known when output frames are computed. It
   12.62 +	 * is therefore necessary to be able to represent abstract types such as
   12.63 +	 * "the type at position x in the input frame locals" or "the type at
   12.64 +	 * position x from the top of the input frame stack" or even "the type at
   12.65 +	 * position x in the input frame, with y more (or less) array dimensions".
   12.66 +	 * This explains the rather complicated type format used in output frames.
   12.67 +	 *
   12.68 +	 * This format is the following: DIM KIND VALUE (4, 4 and 24 bits). DIM is a
   12.69 +	 * signed number of array dimensions (from -8 to 7). KIND is either BASE,
   12.70 +	 * LOCAL or STACK. BASE is used for types that are not relative to the input
   12.71 +	 * frame. LOCAL is used for types that are relative to the input local
   12.72 +	 * variable types. STACK is used for types that are relative to the input
   12.73 +	 * stack types. VALUE depends on KIND. For LOCAL types, it is an index in
   12.74 +	 * the input local variable types. For STACK types, it is a position
   12.75 +	 * relatively to the top of input frame stack. For BASE types, it is either
   12.76 +	 * one of the constants defined in FrameVisitor, or for OBJECT and
   12.77 +	 * UNINITIALIZED types, a tag and an index in the type table.
   12.78 +	 *
   12.79 +	 * Output frames can contain types of any kind and with a positive or
   12.80 +	 * negative dimension (and even unassigned types, represented by 0 - which
   12.81 +	 * does not correspond to any valid type value). Input frames can only
   12.82 +	 * contain BASE types of positive or null dimension. In all cases the type
   12.83 +	 * table contains only internal type names (array type descriptors are
   12.84 +	 * forbidden - dimensions must be represented through the DIM field).
   12.85 +	 *
   12.86 +	 * The LONG and DOUBLE types are always represented by using two slots (LONG +
   12.87 +	 * TOP or DOUBLE + TOP), for local variable types as well as in the operand
   12.88 +	 * stack. This is necessary to be able to simulate DUPx_y instructions,
   12.89 +	 * whose effect would be dependent on the actual type values if types were
   12.90 +	 * always represented by a single slot in the stack (and this is not
   12.91 +	 * possible, since actual type values are not always known - cf LOCAL and
   12.92 +	 * STACK type kinds).
   12.93 +	 */
   12.94 +
   12.95 +/**
   12.96 + * Mask to get the dimension of a frame type. This dimension is a signed
   12.97 + * integer between -8 and 7.
   12.98 + */
   12.99 +final static int DIM = 0xF0000000;
  12.100 +
  12.101 +/**
  12.102 + * Constant to be added to a type to get a type with one more dimension.
  12.103 + */
  12.104 +final static int ARRAY_OF = 0x10000000;
  12.105 +
  12.106 +/**
  12.107 + * Constant to be added to a type to get a type with one less dimension.
  12.108 + */
  12.109 +final static int ELEMENT_OF = 0xF0000000;
  12.110 +
  12.111 +/**
  12.112 + * Mask to get the kind of a frame type.
  12.113 + *
  12.114 + * @see #BASE
  12.115 + * @see #LOCAL
  12.116 + * @see #STACK
  12.117 + */
  12.118 +final static int KIND = 0xF000000;
  12.119 +
  12.120 +/**
  12.121 + * Mask to get the value of a frame type.
  12.122 + */
  12.123 +final static int VALUE = 0xFFFFFF;
  12.124 +
  12.125 +/**
  12.126 + * Mask to get the kind of base types.
  12.127 + */
  12.128 +final static int BASE_KIND = 0xFF00000;
  12.129 +
  12.130 +/**
  12.131 + * Mask to get the value of base types.
  12.132 + */
  12.133 +final static int BASE_VALUE = 0xFFFFF;
  12.134 +
  12.135 +/**
  12.136 + * Kind of the types that are not relative to an input stack map frame.
  12.137 + */
  12.138 +final static int BASE = 0x1000000;
  12.139 +
  12.140 +/**
  12.141 + * Base kind of the base reference types. The BASE_VALUE of such types is an
  12.142 + * index into the type table.
  12.143 + */
  12.144 +final static int OBJECT = BASE | 0x700000;
  12.145 +
  12.146 +/**
  12.147 + * Base kind of the uninitialized base types. The BASE_VALUE of such types
  12.148 + * in an index into the type table (the Item at that index contains both an
  12.149 + * instruction offset and an internal class name).
  12.150 + */
  12.151 +final static int UNINITIALIZED = BASE | 0x800000;
  12.152 +
  12.153 +/**
  12.154 + * Kind of the types that are relative to the local variable types of an
  12.155 + * input stack map frame. The value of such types is a local variable index.
  12.156 + */
  12.157 +private final static int LOCAL = 0x2000000;
  12.158 +
  12.159 +/**
  12.160 + * Kind of the the types that are relative to the stack of an input stack
  12.161 + * map frame. The value of such types is a position relatively to the top of
  12.162 + * this stack.
  12.163 + */
  12.164 +private final static int STACK = 0x3000000;
  12.165 +
  12.166 +/**
  12.167 + * The TOP type. This is a BASE type.
  12.168 + */
  12.169 +final static int TOP = BASE | 0;
  12.170 +
  12.171 +/**
  12.172 + * The BOOLEAN type. This is a BASE type mainly used for array types.
  12.173 + */
  12.174 +final static int BOOLEAN = BASE | 9;
  12.175 +
  12.176 +/**
  12.177 + * The BYTE type. This is a BASE type mainly used for array types.
  12.178 + */
  12.179 +final static int BYTE = BASE | 10;
  12.180 +
  12.181 +/**
  12.182 + * The CHAR type. This is a BASE type mainly used for array types.
  12.183 + */
  12.184 +final static int CHAR = BASE | 11;
  12.185 +
  12.186 +/**
  12.187 + * The SHORT type. This is a BASE type mainly used for array types.
  12.188 + */
  12.189 +final static int SHORT = BASE | 12;
  12.190 +
  12.191 +/**
  12.192 + * The INTEGER type. This is a BASE type.
  12.193 + */
  12.194 +final static int INTEGER = BASE | 1;
  12.195 +
  12.196 +/**
  12.197 + * The FLOAT type. This is a BASE type.
  12.198 + */
  12.199 +final static int FLOAT = BASE | 2;
  12.200 +
  12.201 +/**
  12.202 + * The DOUBLE type. This is a BASE type.
  12.203 + */
  12.204 +final static int DOUBLE = BASE | 3;
  12.205 +
  12.206 +/**
  12.207 + * The LONG type. This is a BASE type.
  12.208 + */
  12.209 +final static int LONG = BASE | 4;
  12.210 +
  12.211 +/**
  12.212 + * The NULL type. This is a BASE type.
  12.213 + */
  12.214 +final static int NULL = BASE | 5;
  12.215 +
  12.216 +/**
  12.217 + * The UNINITIALIZED_THIS type. This is a BASE type.
  12.218 + */
  12.219 +final static int UNINITIALIZED_THIS = BASE | 6;
  12.220 +
  12.221 +/**
  12.222 + * The stack size variation corresponding to each JVM instruction. This
  12.223 + * stack variation is equal to the size of the values produced by an
  12.224 + * instruction, minus the size of the values consumed by this instruction.
  12.225 + */
  12.226 +final static int[] SIZE;
  12.227 +
  12.228 +/**
  12.229 + * Computes the stack size variation corresponding to each JVM instruction.
  12.230 + */
  12.231 +static
  12.232 +	{
  12.233 +	int i;
  12.234 +	int[] b = new int[202];
  12.235 +	String s = "EFFFFFFFFGGFFFGGFFFEEFGFGFEEEEEEEEEEEEEEEEEEEEDEDEDDDDD"
  12.236 +	           + "CDCDEEEEEEEEEEEEEEEEEEEEBABABBBBDCFFFGGGEDCDCDCDCDCDCDCDCD"
  12.237 +	           + "CDCEEEEDDDDDDDCDCDCEFEFDDEEFFDEDEEEBDDBBDDDDDDCCCCCCCCEFED"
  12.238 +	           + "DDCDCDEEEEEEEEEEFEEEEEEDDEEDDEE";
  12.239 +	for(i = 0; i < b.length; ++i)
  12.240 +		{
  12.241 +		b[i] = s.charAt(i) - 'E';
  12.242 +		}
  12.243 +	SIZE = b;
  12.244 +
  12.245 +	// code to generate the above string
  12.246 +	//
  12.247 +	// int NA = 0; // not applicable (unused opcode or variable size opcode)
  12.248 +	//
  12.249 +	// b = new int[] {
  12.250 +	// 0, //NOP, // visitInsn
  12.251 +	// 1, //ACONST_NULL, // -
  12.252 +	// 1, //ICONST_M1, // -
  12.253 +	// 1, //ICONST_0, // -
  12.254 +	// 1, //ICONST_1, // -
  12.255 +	// 1, //ICONST_2, // -
  12.256 +	// 1, //ICONST_3, // -
  12.257 +	// 1, //ICONST_4, // -
  12.258 +	// 1, //ICONST_5, // -
  12.259 +	// 2, //LCONST_0, // -
  12.260 +	// 2, //LCONST_1, // -
  12.261 +	// 1, //FCONST_0, // -
  12.262 +	// 1, //FCONST_1, // -
  12.263 +	// 1, //FCONST_2, // -
  12.264 +	// 2, //DCONST_0, // -
  12.265 +	// 2, //DCONST_1, // -
  12.266 +	// 1, //BIPUSH, // visitIntInsn
  12.267 +	// 1, //SIPUSH, // -
  12.268 +	// 1, //LDC, // visitLdcInsn
  12.269 +	// NA, //LDC_W, // -
  12.270 +	// NA, //LDC2_W, // -
  12.271 +	// 1, //ILOAD, // visitVarInsn
  12.272 +	// 2, //LLOAD, // -
  12.273 +	// 1, //FLOAD, // -
  12.274 +	// 2, //DLOAD, // -
  12.275 +	// 1, //ALOAD, // -
  12.276 +	// NA, //ILOAD_0, // -
  12.277 +	// NA, //ILOAD_1, // -
  12.278 +	// NA, //ILOAD_2, // -
  12.279 +	// NA, //ILOAD_3, // -
  12.280 +	// NA, //LLOAD_0, // -
  12.281 +	// NA, //LLOAD_1, // -
  12.282 +	// NA, //LLOAD_2, // -
  12.283 +	// NA, //LLOAD_3, // -
  12.284 +	// NA, //FLOAD_0, // -
  12.285 +	// NA, //FLOAD_1, // -
  12.286 +	// NA, //FLOAD_2, // -
  12.287 +	// NA, //FLOAD_3, // -
  12.288 +	// NA, //DLOAD_0, // -
  12.289 +	// NA, //DLOAD_1, // -
  12.290 +	// NA, //DLOAD_2, // -
  12.291 +	// NA, //DLOAD_3, // -
  12.292 +	// NA, //ALOAD_0, // -
  12.293 +	// NA, //ALOAD_1, // -
  12.294 +	// NA, //ALOAD_2, // -
  12.295 +	// NA, //ALOAD_3, // -
  12.296 +	// -1, //IALOAD, // visitInsn
  12.297 +	// 0, //LALOAD, // -
  12.298 +	// -1, //FALOAD, // -
  12.299 +	// 0, //DALOAD, // -
  12.300 +	// -1, //AALOAD, // -
  12.301 +	// -1, //BALOAD, // -
  12.302 +	// -1, //CALOAD, // -
  12.303 +	// -1, //SALOAD, // -
  12.304 +	// -1, //ISTORE, // visitVarInsn
  12.305 +	// -2, //LSTORE, // -
  12.306 +	// -1, //FSTORE, // -
  12.307 +	// -2, //DSTORE, // -
  12.308 +	// -1, //ASTORE, // -
  12.309 +	// NA, //ISTORE_0, // -
  12.310 +	// NA, //ISTORE_1, // -
  12.311 +	// NA, //ISTORE_2, // -
  12.312 +	// NA, //ISTORE_3, // -
  12.313 +	// NA, //LSTORE_0, // -
  12.314 +	// NA, //LSTORE_1, // -
  12.315 +	// NA, //LSTORE_2, // -
  12.316 +	// NA, //LSTORE_3, // -
  12.317 +	// NA, //FSTORE_0, // -
  12.318 +	// NA, //FSTORE_1, // -
  12.319 +	// NA, //FSTORE_2, // -
  12.320 +	// NA, //FSTORE_3, // -
  12.321 +	// NA, //DSTORE_0, // -
  12.322 +	// NA, //DSTORE_1, // -
  12.323 +	// NA, //DSTORE_2, // -
  12.324 +	// NA, //DSTORE_3, // -
  12.325 +	// NA, //ASTORE_0, // -
  12.326 +	// NA, //ASTORE_1, // -
  12.327 +	// NA, //ASTORE_2, // -
  12.328 +	// NA, //ASTORE_3, // -
  12.329 +	// -3, //IASTORE, // visitInsn
  12.330 +	// -4, //LASTORE, // -
  12.331 +	// -3, //FASTORE, // -
  12.332 +	// -4, //DASTORE, // -
  12.333 +	// -3, //AASTORE, // -
  12.334 +	// -3, //BASTORE, // -
  12.335 +	// -3, //CASTORE, // -
  12.336 +	// -3, //SASTORE, // -
  12.337 +	// -1, //POP, // -
  12.338 +	// -2, //POP2, // -
  12.339 +	// 1, //DUP, // -
  12.340 +	// 1, //DUP_X1, // -
  12.341 +	// 1, //DUP_X2, // -
  12.342 +	// 2, //DUP2, // -
  12.343 +	// 2, //DUP2_X1, // -
  12.344 +	// 2, //DUP2_X2, // -
  12.345 +	// 0, //SWAP, // -
  12.346 +	// -1, //IADD, // -
  12.347 +	// -2, //LADD, // -
  12.348 +	// -1, //FADD, // -
  12.349 +	// -2, //DADD, // -
  12.350 +	// -1, //ISUB, // -
  12.351 +	// -2, //LSUB, // -
  12.352 +	// -1, //FSUB, // -
  12.353 +	// -2, //DSUB, // -
  12.354 +	// -1, //IMUL, // -
  12.355 +	// -2, //LMUL, // -
  12.356 +	// -1, //FMUL, // -
  12.357 +	// -2, //DMUL, // -
  12.358 +	// -1, //IDIV, // -
  12.359 +	// -2, //LDIV, // -
  12.360 +	// -1, //FDIV, // -
  12.361 +	// -2, //DDIV, // -
  12.362 +	// -1, //IREM, // -
  12.363 +	// -2, //LREM, // -
  12.364 +	// -1, //FREM, // -
  12.365 +	// -2, //DREM, // -
  12.366 +	// 0, //INEG, // -
  12.367 +	// 0, //LNEG, // -
  12.368 +	// 0, //FNEG, // -
  12.369 +	// 0, //DNEG, // -
  12.370 +	// -1, //ISHL, // -
  12.371 +	// -1, //LSHL, // -
  12.372 +	// -1, //ISHR, // -
  12.373 +	// -1, //LSHR, // -
  12.374 +	// -1, //IUSHR, // -
  12.375 +	// -1, //LUSHR, // -
  12.376 +	// -1, //IAND, // -
  12.377 +	// -2, //LAND, // -
  12.378 +	// -1, //IOR, // -
  12.379 +	// -2, //LOR, // -
  12.380 +	// -1, //IXOR, // -
  12.381 +	// -2, //LXOR, // -
  12.382 +	// 0, //IINC, // visitIincInsn
  12.383 +	// 1, //I2L, // visitInsn
  12.384 +	// 0, //I2F, // -
  12.385 +	// 1, //I2D, // -
  12.386 +	// -1, //L2I, // -
  12.387 +	// -1, //L2F, // -
  12.388 +	// 0, //L2D, // -
  12.389 +	// 0, //F2I, // -
  12.390 +	// 1, //F2L, // -
  12.391 +	// 1, //F2D, // -
  12.392 +	// -1, //D2I, // -
  12.393 +	// 0, //D2L, // -
  12.394 +	// -1, //D2F, // -
  12.395 +	// 0, //I2B, // -
  12.396 +	// 0, //I2C, // -
  12.397 +	// 0, //I2S, // -
  12.398 +	// -3, //LCMP, // -
  12.399 +	// -1, //FCMPL, // -
  12.400 +	// -1, //FCMPG, // -
  12.401 +	// -3, //DCMPL, // -
  12.402 +	// -3, //DCMPG, // -
  12.403 +	// -1, //IFEQ, // visitJumpInsn
  12.404 +	// -1, //IFNE, // -
  12.405 +	// -1, //IFLT, // -
  12.406 +	// -1, //IFGE, // -
  12.407 +	// -1, //IFGT, // -
  12.408 +	// -1, //IFLE, // -
  12.409 +	// -2, //IF_ICMPEQ, // -
  12.410 +	// -2, //IF_ICMPNE, // -
  12.411 +	// -2, //IF_ICMPLT, // -
  12.412 +	// -2, //IF_ICMPGE, // -
  12.413 +	// -2, //IF_ICMPGT, // -
  12.414 +	// -2, //IF_ICMPLE, // -
  12.415 +	// -2, //IF_ACMPEQ, // -
  12.416 +	// -2, //IF_ACMPNE, // -
  12.417 +	// 0, //GOTO, // -
  12.418 +	// 1, //JSR, // -
  12.419 +	// 0, //RET, // visitVarInsn
  12.420 +	// -1, //TABLESWITCH, // visiTableSwitchInsn
  12.421 +	// -1, //LOOKUPSWITCH, // visitLookupSwitch
  12.422 +	// -1, //IRETURN, // visitInsn
  12.423 +	// -2, //LRETURN, // -
  12.424 +	// -1, //FRETURN, // -
  12.425 +	// -2, //DRETURN, // -
  12.426 +	// -1, //ARETURN, // -
  12.427 +	// 0, //RETURN, // -
  12.428 +	// NA, //GETSTATIC, // visitFieldInsn
  12.429 +	// NA, //PUTSTATIC, // -
  12.430 +	// NA, //GETFIELD, // -
  12.431 +	// NA, //PUTFIELD, // -
  12.432 +	// NA, //INVOKEVIRTUAL, // visitMethodInsn
  12.433 +	// NA, //INVOKESPECIAL, // -
  12.434 +	// NA, //INVOKESTATIC, // -
  12.435 +	// NA, //INVOKEINTERFACE, // -
  12.436 +	// NA, //UNUSED, // NOT VISITED
  12.437 +	// 1, //NEW, // visitTypeInsn
  12.438 +	// 0, //NEWARRAY, // visitIntInsn
  12.439 +	// 0, //ANEWARRAY, // visitTypeInsn
  12.440 +	// 0, //ARRAYLENGTH, // visitInsn
  12.441 +	// NA, //ATHROW, // -
  12.442 +	// 0, //CHECKCAST, // visitTypeInsn
  12.443 +	// 0, //INSTANCEOF, // -
  12.444 +	// -1, //MONITORENTER, // visitInsn
  12.445 +	// -1, //MONITOREXIT, // -
  12.446 +	// NA, //WIDE, // NOT VISITED
  12.447 +	// NA, //MULTIANEWARRAY, // visitMultiANewArrayInsn
  12.448 +	// -1, //IFNULL, // visitJumpInsn
  12.449 +	// -1, //IFNONNULL, // -
  12.450 +	// NA, //GOTO_W, // -
  12.451 +	// NA, //JSR_W, // -
  12.452 +	// };
  12.453 +	// for (i = 0; i < b.length; ++i) {
  12.454 +	// System.err.print((char)('E' + b[i]));
  12.455 +	// }
  12.456 +	// System.err.println();
  12.457 +	}
  12.458 +
  12.459 +/**
  12.460 + * The label (i.e. basic block) to which these input and output stack map
  12.461 + * frames correspond.
  12.462 + */
  12.463 +Label owner;
  12.464 +
  12.465 +/**
  12.466 + * The input stack map frame locals.
  12.467 + */
  12.468 +int[] inputLocals;
  12.469 +
  12.470 +/**
  12.471 + * The input stack map frame stack.
  12.472 + */
  12.473 +int[] inputStack;
  12.474 +
  12.475 +/**
  12.476 + * The output stack map frame locals.
  12.477 + */
  12.478 +private int[] outputLocals;
  12.479 +
  12.480 +/**
  12.481 + * The output stack map frame stack.
  12.482 + */
  12.483 +private int[] outputStack;
  12.484 +
  12.485 +/**
  12.486 + * Relative size of the output stack. The exact semantics of this field
  12.487 + * depends on the algorithm that is used.
  12.488 + * <p/>
  12.489 + * When only the maximum stack size is computed, this field is the size of
  12.490 + * the output stack relatively to the top of the input stack.
  12.491 + * <p/>
  12.492 + * When the stack map frames are completely computed, this field is the
  12.493 + * actual number of types in {@link #outputStack}.
  12.494 + */
  12.495 +private int outputStackTop;
  12.496 +
  12.497 +/**
  12.498 + * Number of types that are initialized in the basic block.
  12.499 + *
  12.500 + * @see #initializations
  12.501 + */
  12.502 +private int initializationCount;
  12.503 +
  12.504 +/**
  12.505 + * The types that are initialized in the basic block. A constructor
  12.506 + * invocation on an UNINITIALIZED or UNINITIALIZED_THIS type must replace
  12.507 + * <i>every occurence</i> of this type in the local variables and in the
  12.508 + * operand stack. This cannot be done during the first phase of the
  12.509 + * algorithm since, during this phase, the local variables and the operand
  12.510 + * stack are not completely computed. It is therefore necessary to store the
  12.511 + * types on which constructors are invoked in the basic block, in order to
  12.512 + * do this replacement during the second phase of the algorithm, where the
  12.513 + * frames are fully computed. Note that this array can contain types that
  12.514 + * are relative to input locals or to the input stack (see below for the
  12.515 + * description of the algorithm).
  12.516 + */
  12.517 +private int[] initializations;
  12.518 +
  12.519 +/**
  12.520 + * Returns the output frame local variable type at the given index.
  12.521 + *
  12.522 + * @param local the index of the local that must be returned.
  12.523 + * @return the output frame local variable type at the given index.
  12.524 + */
  12.525 +private int get(final int local){
  12.526 +	if(outputLocals == null || local >= outputLocals.length)
  12.527 +		{
  12.528 +		// this local has never been assigned in this basic block,
  12.529 +		// so it is still equal to its value in the input frame
  12.530 +		return LOCAL | local;
  12.531 +		}
  12.532 +	else
  12.533 +		{
  12.534 +		int type = outputLocals[local];
  12.535 +		if(type == 0)
  12.536 +			{
  12.537 +			// this local has never been assigned in this basic block,
  12.538 +			// so it is still equal to its value in the input frame
  12.539 +			type = outputLocals[local] = LOCAL | local;
  12.540 +			}
  12.541 +		return type;
  12.542 +		}
  12.543 +}
  12.544 +
  12.545 +/**
  12.546 + * Sets the output frame local variable type at the given index.
  12.547 + *
  12.548 + * @param local the index of the local that must be set.
  12.549 + * @param type  the value of the local that must be set.
  12.550 + */
  12.551 +private void set(final int local, final int type){
  12.552 +	// creates and/or resizes the output local variables array if necessary
  12.553 +	if(outputLocals == null)
  12.554 +		{
  12.555 +		outputLocals = new int[10];
  12.556 +		}
  12.557 +	int n = outputLocals.length;
  12.558 +	if(local >= n)
  12.559 +		{
  12.560 +		int[] t = new int[Math.max(local + 1, 2 * n)];
  12.561 +		System.arraycopy(outputLocals, 0, t, 0, n);
  12.562 +		outputLocals = t;
  12.563 +		}
  12.564 +	// sets the local variable
  12.565 +	outputLocals[local] = type;
  12.566 +}
  12.567 +
  12.568 +/**
  12.569 + * Pushes a new type onto the output frame stack.
  12.570 + *
  12.571 + * @param type the type that must be pushed.
  12.572 + */
  12.573 +private void push(final int type){
  12.574 +	// creates and/or resizes the output stack array if necessary
  12.575 +	if(outputStack == null)
  12.576 +		{
  12.577 +		outputStack = new int[10];
  12.578 +		}
  12.579 +	int n = outputStack.length;
  12.580 +	if(outputStackTop >= n)
  12.581 +		{
  12.582 +		int[] t = new int[Math.max(outputStackTop + 1, 2 * n)];
  12.583 +		System.arraycopy(outputStack, 0, t, 0, n);
  12.584 +		outputStack = t;
  12.585 +		}
  12.586 +	// pushes the type on the output stack
  12.587 +	outputStack[outputStackTop++] = type;
  12.588 +	// updates the maximun height reached by the output stack, if needed
  12.589 +	int top = owner.inputStackTop + outputStackTop;
  12.590 +	if(top > owner.outputStackMax)
  12.591 +		{
  12.592 +		owner.outputStackMax = top;
  12.593 +		}
  12.594 +}
  12.595 +
  12.596 +/**
  12.597 + * Pushes a new type onto the output frame stack.
  12.598 + *
  12.599 + * @param cw   the ClassWriter to which this label belongs.
  12.600 + * @param desc the descriptor of the type to be pushed. Can also be a method
  12.601 + *             descriptor (in this case this method pushes its return type onto
  12.602 + *             the output frame stack).
  12.603 + */
  12.604 +private void push(final ClassWriter cw, final String desc){
  12.605 +	int type = type(cw, desc);
  12.606 +	if(type != 0)
  12.607 +		{
  12.608 +		push(type);
  12.609 +		if(type == LONG || type == DOUBLE)
  12.610 +			{
  12.611 +			push(TOP);
  12.612 +			}
  12.613 +		}
  12.614 +}
  12.615 +
  12.616 +/**
  12.617 + * Returns the int encoding of the given type.
  12.618 + *
  12.619 + * @param cw   the ClassWriter to which this label belongs.
  12.620 + * @param desc a type descriptor.
  12.621 + * @return the int encoding of the given type.
  12.622 + */
  12.623 +private int type(final ClassWriter cw, final String desc){
  12.624 +	String t;
  12.625 +	int index = desc.charAt(0) == '(' ? desc.indexOf(')') + 1 : 0;
  12.626 +	switch(desc.charAt(index))
  12.627 +		{
  12.628 +		case'V':
  12.629 +			return 0;
  12.630 +		case'Z':
  12.631 +		case'C':
  12.632 +		case'B':
  12.633 +		case'S':
  12.634 +		case'I':
  12.635 +			return INTEGER;
  12.636 +		case'F':
  12.637 +			return FLOAT;
  12.638 +		case'J':
  12.639 +			return LONG;
  12.640 +		case'D':
  12.641 +			return DOUBLE;
  12.642 +		case'L':
  12.643 +			// stores the internal name, not the descriptor!
  12.644 +			t = desc.substring(index + 1, desc.length() - 1);
  12.645 +			return OBJECT | cw.addType(t);
  12.646 +			// case '[':
  12.647 +		default:
  12.648 +			// extracts the dimensions and the element type
  12.649 +			int data;
  12.650 +			int dims = index + 1;
  12.651 +			while(desc.charAt(dims) == '[')
  12.652 +				{
  12.653 +				++dims;
  12.654 +				}
  12.655 +			switch(desc.charAt(dims))
  12.656 +				{
  12.657 +				case'Z':
  12.658 +					data = BOOLEAN;
  12.659 +					break;
  12.660 +				case'C':
  12.661 +					data = CHAR;
  12.662 +					break;
  12.663 +				case'B':
  12.664 +					data = BYTE;
  12.665 +					break;
  12.666 +				case'S':
  12.667 +					data = SHORT;
  12.668 +					break;
  12.669 +				case'I':
  12.670 +					data = INTEGER;
  12.671 +					break;
  12.672 +				case'F':
  12.673 +					data = FLOAT;
  12.674 +					break;
  12.675 +				case'J':
  12.676 +					data = LONG;
  12.677 +					break;
  12.678 +				case'D':
  12.679 +					data = DOUBLE;
  12.680 +					break;
  12.681 +					// case 'L':
  12.682 +				default:
  12.683 +					// stores the internal name, not the descriptor
  12.684 +					t = desc.substring(dims + 1, desc.length() - 1);
  12.685 +					data = OBJECT | cw.addType(t);
  12.686 +				}
  12.687 +			return (dims - index) << 28 | data;
  12.688 +		}
  12.689 +}
  12.690 +
  12.691 +/**
  12.692 + * Pops a type from the output frame stack and returns its value.
  12.693 + *
  12.694 + * @return the type that has been popped from the output frame stack.
  12.695 + */
  12.696 +private int pop(){
  12.697 +	if(outputStackTop > 0)
  12.698 +		{
  12.699 +		return outputStack[--outputStackTop];
  12.700 +		}
  12.701 +	else
  12.702 +		{
  12.703 +		// if the output frame stack is empty, pops from the input stack
  12.704 +		return STACK | -(--owner.inputStackTop);
  12.705 +		}
  12.706 +}
  12.707 +
  12.708 +/**
  12.709 + * Pops the given number of types from the output frame stack.
  12.710 + *
  12.711 + * @param elements the number of types that must be popped.
  12.712 + */
  12.713 +private void pop(final int elements){
  12.714 +	if(outputStackTop >= elements)
  12.715 +		{
  12.716 +		outputStackTop -= elements;
  12.717 +		}
  12.718 +	else
  12.719 +		{
  12.720 +		// if the number of elements to be popped is greater than the number
  12.721 +		// of elements in the output stack, clear it, and pops the remaining
  12.722 +		// elements from the input stack.
  12.723 +		owner.inputStackTop -= elements - outputStackTop;
  12.724 +		outputStackTop = 0;
  12.725 +		}
  12.726 +}
  12.727 +
  12.728 +/**
  12.729 + * Pops a type from the output frame stack.
  12.730 + *
  12.731 + * @param desc the descriptor of the type to be popped. Can also be a method
  12.732 + *             descriptor (in this case this method pops the types corresponding
  12.733 + *             to the method arguments).
  12.734 + */
  12.735 +private void pop(final String desc){
  12.736 +	char c = desc.charAt(0);
  12.737 +	if(c == '(')
  12.738 +		{
  12.739 +		pop((MethodWriter.getArgumentsAndReturnSizes(desc) >> 2) - 1);
  12.740 +		}
  12.741 +	else if(c == 'J' || c == 'D')
  12.742 +		{
  12.743 +		pop(2);
  12.744 +		}
  12.745 +	else
  12.746 +		{
  12.747 +		pop(1);
  12.748 +		}
  12.749 +}
  12.750 +
  12.751 +/**
  12.752 + * Adds a new type to the list of types on which a constructor is invoked in
  12.753 + * the basic block.
  12.754 + *
  12.755 + * @param var a type on a which a constructor is invoked.
  12.756 + */
  12.757 +private void init(final int var){
  12.758 +	// creates and/or resizes the initializations array if necessary
  12.759 +	if(initializations == null)
  12.760 +		{
  12.761 +		initializations = new int[2];
  12.762 +		}
  12.763 +	int n = initializations.length;
  12.764 +	if(initializationCount >= n)
  12.765 +		{
  12.766 +		int[] t = new int[Math.max(initializationCount + 1, 2 * n)];
  12.767 +		System.arraycopy(initializations, 0, t, 0, n);
  12.768 +		initializations = t;
  12.769 +		}
  12.770 +	// stores the type to be initialized
  12.771 +	initializations[initializationCount++] = var;
  12.772 +}
  12.773 +
  12.774 +/**
  12.775 + * Replaces the given type with the appropriate type if it is one of the
  12.776 + * types on which a constructor is invoked in the basic block.
  12.777 + *
  12.778 + * @param cw the ClassWriter to which this label belongs.
  12.779 + * @param t  a type
  12.780 + * @return t or, if t is one of the types on which a constructor is invoked
  12.781 + *         in the basic block, the type corresponding to this constructor.
  12.782 + */
  12.783 +private int init(final ClassWriter cw, final int t){
  12.784 +	int s;
  12.785 +	if(t == UNINITIALIZED_THIS)
  12.786 +		{
  12.787 +		s = OBJECT | cw.addType(cw.thisName);
  12.788 +		}
  12.789 +	else if((t & (DIM | BASE_KIND)) == UNINITIALIZED)
  12.790 +		{
  12.791 +		String type = cw.typeTable[t & BASE_VALUE].strVal1;
  12.792 +		s = OBJECT | cw.addType(type);
  12.793 +		}
  12.794 +	else
  12.795 +		{
  12.796 +		return t;
  12.797 +		}
  12.798 +	for(int j = 0; j < initializationCount; ++j)
  12.799 +		{
  12.800 +		int u = initializations[j];
  12.801 +		int dim = u & DIM;
  12.802 +		int kind = u & KIND;
  12.803 +		if(kind == LOCAL)
  12.804 +			{
  12.805 +			u = dim + inputLocals[u & VALUE];
  12.806 +			}
  12.807 +		else if(kind == STACK)
  12.808 +			{
  12.809 +			u = dim + inputStack[inputStack.length - (u & VALUE)];
  12.810 +			}
  12.811 +		if(t == u)
  12.812 +			{
  12.813 +			return s;
  12.814 +			}
  12.815 +		}
  12.816 +	return t;
  12.817 +}
  12.818 +
  12.819 +/**
  12.820 + * Initializes the input frame of the first basic block from the method
  12.821 + * descriptor.
  12.822 + *
  12.823 + * @param cw        the ClassWriter to which this label belongs.
  12.824 + * @param access    the access flags of the method to which this label belongs.
  12.825 + * @param args      the formal parameter types of this method.
  12.826 + * @param maxLocals the maximum number of local variables of this method.
  12.827 + */
  12.828 +void initInputFrame(
  12.829 +		final ClassWriter cw,
  12.830 +		final int access,
  12.831 +		final Type[] args,
  12.832 +		final int maxLocals){
  12.833 +	inputLocals = new int[maxLocals];
  12.834 +	inputStack = new int[0];
  12.835 +	int i = 0;
  12.836 +	if((access & Opcodes.ACC_STATIC) == 0)
  12.837 +		{
  12.838 +		if((access & MethodWriter.ACC_CONSTRUCTOR) == 0)
  12.839 +			{
  12.840 +			inputLocals[i++] = OBJECT | cw.addType(cw.thisName);
  12.841 +			}
  12.842 +		else
  12.843 +			{
  12.844 +			inputLocals[i++] = UNINITIALIZED_THIS;
  12.845 +			}
  12.846 +		}
  12.847 +	for(int j = 0; j < args.length; ++j)
  12.848 +		{
  12.849 +		int t = type(cw, args[j].getDescriptor());
  12.850 +		inputLocals[i++] = t;
  12.851 +		if(t == LONG || t == DOUBLE)
  12.852 +			{
  12.853 +			inputLocals[i++] = TOP;
  12.854 +			}
  12.855 +		}
  12.856 +	while(i < maxLocals)
  12.857 +		{
  12.858 +		inputLocals[i++] = TOP;
  12.859 +		}
  12.860 +}
  12.861 +
  12.862 +/**
  12.863 + * Simulates the action of the given instruction on the output stack frame.
  12.864 + *
  12.865 + * @param opcode the opcode of the instruction.
  12.866 + * @param arg    the operand of the instruction, if any.
  12.867 + * @param cw     the class writer to which this label belongs.
  12.868 + * @param item   the operand of the instructions, if any.
  12.869 + */
  12.870 +void execute(
  12.871 +		final int opcode,
  12.872 +		final int arg,
  12.873 +		final ClassWriter cw,
  12.874 +		final Item item){
  12.875 +	int t1, t2, t3, t4;
  12.876 +	switch(opcode)
  12.877 +		{
  12.878 +		case Opcodes.NOP:
  12.879 +		case Opcodes.INEG:
  12.880 +		case Opcodes.LNEG:
  12.881 +		case Opcodes.FNEG:
  12.882 +		case Opcodes.DNEG:
  12.883 +		case Opcodes.I2B:
  12.884 +		case Opcodes.I2C:
  12.885 +		case Opcodes.I2S:
  12.886 +		case Opcodes.GOTO:
  12.887 +		case Opcodes.RETURN:
  12.888 +			break;
  12.889 +		case Opcodes.ACONST_NULL:
  12.890 +			push(NULL);
  12.891 +			break;
  12.892 +		case Opcodes.ICONST_M1:
  12.893 +		case Opcodes.ICONST_0:
  12.894 +		case Opcodes.ICONST_1:
  12.895 +		case Opcodes.ICONST_2:
  12.896 +		case Opcodes.ICONST_3:
  12.897 +		case Opcodes.ICONST_4:
  12.898 +		case Opcodes.ICONST_5:
  12.899 +		case Opcodes.BIPUSH:
  12.900 +		case Opcodes.SIPUSH:
  12.901 +		case Opcodes.ILOAD:
  12.902 +			push(INTEGER);
  12.903 +			break;
  12.904 +		case Opcodes.LCONST_0:
  12.905 +		case Opcodes.LCONST_1:
  12.906 +		case Opcodes.LLOAD:
  12.907 +			push(LONG);
  12.908 +			push(TOP);
  12.909 +			break;
  12.910 +		case Opcodes.FCONST_0:
  12.911 +		case Opcodes.FCONST_1:
  12.912 +		case Opcodes.FCONST_2:
  12.913 +		case Opcodes.FLOAD:
  12.914 +			push(FLOAT);
  12.915 +			break;
  12.916 +		case Opcodes.DCONST_0:
  12.917 +		case Opcodes.DCONST_1:
  12.918 +		case Opcodes.DLOAD:
  12.919 +			push(DOUBLE);
  12.920 +			push(TOP);
  12.921 +			break;
  12.922 +		case Opcodes.LDC:
  12.923 +			switch(item.type)
  12.924 +				{
  12.925 +				case ClassWriter.INT:
  12.926 +					push(INTEGER);
  12.927 +					break;
  12.928 +				case ClassWriter.LONG:
  12.929 +					push(LONG);
  12.930 +					push(TOP);
  12.931 +					break;
  12.932 +				case ClassWriter.FLOAT:
  12.933 +					push(FLOAT);
  12.934 +					break;
  12.935 +				case ClassWriter.DOUBLE:
  12.936 +					push(DOUBLE);
  12.937 +					push(TOP);
  12.938 +					break;
  12.939 +				case ClassWriter.CLASS:
  12.940 +					push(OBJECT | cw.addType("java/lang/Class"));
  12.941 +					break;
  12.942 +					// case ClassWriter.STR:
  12.943 +				default:
  12.944 +					push(OBJECT | cw.addType("java/lang/String"));
  12.945 +				}
  12.946 +			break;
  12.947 +		case Opcodes.ALOAD:
  12.948 +			push(get(arg));
  12.949 +			break;
  12.950 +		case Opcodes.IALOAD:
  12.951 +		case Opcodes.BALOAD:
  12.952 +		case Opcodes.CALOAD:
  12.953 +		case Opcodes.SALOAD:
  12.954 +			pop(2);
  12.955 +			push(INTEGER);
  12.956 +			break;
  12.957 +		case Opcodes.LALOAD:
  12.958 +		case Opcodes.D2L:
  12.959 +			pop(2);
  12.960 +			push(LONG);
  12.961 +			push(TOP);
  12.962 +			break;
  12.963 +		case Opcodes.FALOAD:
  12.964 +			pop(2);
  12.965 +			push(FLOAT);
  12.966 +			break;
  12.967 +		case Opcodes.DALOAD:
  12.968 +		case Opcodes.L2D:
  12.969 +			pop(2);
  12.970 +			push(DOUBLE);
  12.971 +			push(TOP);
  12.972 +			break;
  12.973 +		case Opcodes.AALOAD:
  12.974 +			pop(1);
  12.975 +			t1 = pop();
  12.976 +			push(ELEMENT_OF + t1);
  12.977 +			break;
  12.978 +		case Opcodes.ISTORE:
  12.979 +		case Opcodes.FSTORE:
  12.980 +		case Opcodes.ASTORE:
  12.981 +			t1 = pop();
  12.982 +			set(arg, t1);
  12.983 +			if(arg > 0)
  12.984 +				{
  12.985 +				t2 = get(arg - 1);
  12.986 +				// if t2 is of kind STACK or LOCAL we cannot know its size!
  12.987 +				if(t2 == LONG || t2 == DOUBLE)
  12.988 +					{
  12.989 +					set(arg - 1, TOP);
  12.990 +					}
  12.991 +				}
  12.992 +			break;
  12.993 +		case Opcodes.LSTORE:
  12.994 +		case Opcodes.DSTORE:
  12.995 +			pop(1);
  12.996 +			t1 = pop();
  12.997 +			set(arg, t1);
  12.998 +			set(arg + 1, TOP);
  12.999 +			if(arg > 0)
 12.1000 +				{
 12.1001 +				t2 = get(arg - 1);
 12.1002 +				// if t2 is of kind STACK or LOCAL we cannot know its size!
 12.1003 +				if(t2 == LONG || t2 == DOUBLE)
 12.1004 +					{
 12.1005 +					set(arg - 1, TOP);
 12.1006 +					}
 12.1007 +				}
 12.1008 +			break;
 12.1009 +		case Opcodes.IASTORE:
 12.1010 +		case Opcodes.BASTORE:
 12.1011 +		case Opcodes.CASTORE:
 12.1012 +		case Opcodes.SASTORE:
 12.1013 +		case Opcodes.FASTORE:
 12.1014 +		case Opcodes.AASTORE:
 12.1015 +			pop(3);
 12.1016 +			break;
 12.1017 +		case Opcodes.LASTORE:
 12.1018 +		case Opcodes.DASTORE:
 12.1019 +			pop(4);
 12.1020 +			break;
 12.1021 +		case Opcodes.POP:
 12.1022 +		case Opcodes.IFEQ:
 12.1023 +		case Opcodes.IFNE:
 12.1024 +		case Opcodes.IFLT:
 12.1025 +		case Opcodes.IFGE:
 12.1026 +		case Opcodes.IFGT:
 12.1027 +		case Opcodes.IFLE:
 12.1028 +		case Opcodes.IRETURN:
 12.1029 +		case Opcodes.FRETURN:
 12.1030 +		case Opcodes.ARETURN:
 12.1031 +		case Opcodes.TABLESWITCH:
 12.1032 +		case Opcodes.LOOKUPSWITCH:
 12.1033 +		case Opcodes.ATHROW:
 12.1034 +		case Opcodes.MONITORENTER:
 12.1035 +		case Opcodes.MONITOREXIT:
 12.1036 +		case Opcodes.IFNULL:
 12.1037 +		case Opcodes.IFNONNULL:
 12.1038 +			pop(1);
 12.1039 +			break;
 12.1040 +		case Opcodes.POP2:
 12.1041 +		case Opcodes.IF_ICMPEQ:
 12.1042 +		case Opcodes.IF_ICMPNE:
 12.1043 +		case Opcodes.IF_ICMPLT:
 12.1044 +		case Opcodes.IF_ICMPGE:
 12.1045 +		case Opcodes.IF_ICMPGT:
 12.1046 +		case Opcodes.IF_ICMPLE:
 12.1047 +		case Opcodes.IF_ACMPEQ:
 12.1048 +		case Opcodes.IF_ACMPNE:
 12.1049 +		case Opcodes.LRETURN:
 12.1050 +		case Opcodes.DRETURN:
 12.1051 +			pop(2);
 12.1052 +			break;
 12.1053 +		case Opcodes.DUP:
 12.1054 +			t1 = pop();
 12.1055 +			push(t1);
 12.1056 +			push(t1);
 12.1057 +			break;
 12.1058 +		case Opcodes.DUP_X1:
 12.1059 +			t1 = pop();
 12.1060 +			t2 = pop();
 12.1061 +			push(t1);
 12.1062 +			push(t2);
 12.1063 +			push(t1);
 12.1064 +			break;
 12.1065 +		case Opcodes.DUP_X2:
 12.1066 +			t1 = pop();
 12.1067 +			t2 = pop();
 12.1068 +			t3 = pop();
 12.1069 +			push(t1);
 12.1070 +			push(t3);
 12.1071 +			push(t2);
 12.1072 +			push(t1);
 12.1073 +			break;
 12.1074 +		case Opcodes.DUP2:
 12.1075 +			t1 = pop();
 12.1076 +			t2 = pop();
 12.1077 +			push(t2);
 12.1078 +			push(t1);
 12.1079 +			push(t2);
 12.1080 +			push(t1);
 12.1081 +			break;
 12.1082 +		case Opcodes.DUP2_X1:
 12.1083 +			t1 = pop();
 12.1084 +			t2 = pop();
 12.1085 +			t3 = pop();
 12.1086 +			push(t2);
 12.1087 +			push(t1);
 12.1088 +			push(t3);
 12.1089 +			push(t2);
 12.1090 +			push(t1);
 12.1091 +			break;
 12.1092 +		case Opcodes.DUP2_X2:
 12.1093 +			t1 = pop();
 12.1094 +			t2 = pop();
 12.1095 +			t3 = pop();
 12.1096 +			t4 = pop();
 12.1097 +			push(t2);
 12.1098 +			push(t1);
 12.1099 +			push(t4);
 12.1100 +			push(t3);
 12.1101 +			push(t2);
 12.1102 +			push(t1);
 12.1103 +			break;
 12.1104 +		case Opcodes.SWAP:
 12.1105 +			t1 = pop();
 12.1106 +			t2 = pop();
 12.1107 +			push(t1);
 12.1108 +			push(t2);
 12.1109 +			break;
 12.1110 +		case Opcodes.IADD:
 12.1111 +		case Opcodes.ISUB:
 12.1112 +		case Opcodes.IMUL:
 12.1113 +		case Opcodes.IDIV:
 12.1114 +		case Opcodes.IREM:
 12.1115 +		case Opcodes.IAND:
 12.1116 +		case Opcodes.IOR:
 12.1117 +		case Opcodes.IXOR:
 12.1118 +		case Opcodes.ISHL:
 12.1119 +		case Opcodes.ISHR:
 12.1120 +		case Opcodes.IUSHR:
 12.1121 +		case Opcodes.L2I:
 12.1122 +		case Opcodes.D2I:
 12.1123 +		case Opcodes.FCMPL:
 12.1124 +		case Opcodes.FCMPG:
 12.1125 +			pop(2);
 12.1126 +			push(INTEGER);
 12.1127 +			break;
 12.1128 +		case Opcodes.LADD:
 12.1129 +		case Opcodes.LSUB:
 12.1130 +		case Opcodes.LMUL:
 12.1131 +		case Opcodes.LDIV:
 12.1132 +		case Opcodes.LREM:
 12.1133 +		case Opcodes.LAND:
 12.1134 +		case Opcodes.LOR:
 12.1135 +		case Opcodes.LXOR:
 12.1136 +			pop(4);
 12.1137 +			push(LONG);
 12.1138 +			push(TOP);
 12.1139 +			break;
 12.1140 +		case Opcodes.FADD:
 12.1141 +		case Opcodes.FSUB:
 12.1142 +		case Opcodes.FMUL:
 12.1143 +		case Opcodes.FDIV:
 12.1144 +		case Opcodes.FREM:
 12.1145 +		case Opcodes.L2F:
 12.1146 +		case Opcodes.D2F:
 12.1147 +			pop(2);
 12.1148 +			push(FLOAT);
 12.1149 +			break;
 12.1150 +		case Opcodes.DADD:
 12.1151 +		case Opcodes.DSUB:
 12.1152 +		case Opcodes.DMUL:
 12.1153 +		case Opcodes.DDIV:
 12.1154 +		case Opcodes.DREM:
 12.1155 +			pop(4);
 12.1156 +			push(DOUBLE);
 12.1157 +			push(TOP);
 12.1158 +			break;
 12.1159 +		case Opcodes.LSHL:
 12.1160 +		case Opcodes.LSHR:
 12.1161 +		case Opcodes.LUSHR:
 12.1162 +			pop(3);
 12.1163 +			push(LONG);
 12.1164 +			push(TOP);
 12.1165 +			break;
 12.1166 +		case Opcodes.IINC:
 12.1167 +			set(arg, INTEGER);
 12.1168 +			break;
 12.1169 +		case Opcodes.I2L:
 12.1170 +		case Opcodes.F2L:
 12.1171 +			pop(1);
 12.1172 +			push(LONG);
 12.1173 +			push(TOP);
 12.1174 +			break;
 12.1175 +		case Opcodes.I2F:
 12.1176 +			pop(1);
 12.1177 +			push(FLOAT);
 12.1178 +			break;
 12.1179 +		case Opcodes.I2D:
 12.1180 +		case Opcodes.F2D:
 12.1181 +			pop(1);
 12.1182 +			push(DOUBLE);
 12.1183 +			push(TOP);
 12.1184 +			break;
 12.1185 +		case Opcodes.F2I:
 12.1186 +		case Opcodes.ARRAYLENGTH:
 12.1187 +		case Opcodes.INSTANCEOF:
 12.1188 +			pop(1);
 12.1189 +			push(INTEGER);
 12.1190 +			break;
 12.1191 +		case Opcodes.LCMP:
 12.1192 +		case Opcodes.DCMPL:
 12.1193 +		case Opcodes.DCMPG:
 12.1194 +			pop(4);
 12.1195 +			push(INTEGER);
 12.1196 +			break;
 12.1197 +		case Opcodes.JSR:
 12.1198 +		case Opcodes.RET:
 12.1199 +			throw new RuntimeException("JSR/RET are not supported with computeFrames option");
 12.1200 +		case Opcodes.GETSTATIC:
 12.1201 +			push(cw, item.strVal3);
 12.1202 +			break;
 12.1203 +		case Opcodes.PUTSTATIC:
 12.1204 +			pop(item.strVal3);
 12.1205 +			break;
 12.1206 +		case Opcodes.GETFIELD:
 12.1207 +			pop(1);
 12.1208 +			push(cw, item.strVal3);
 12.1209 +			break;
 12.1210 +		case Opcodes.PUTFIELD:
 12.1211 +			pop(item.strVal3);
 12.1212 +			pop();
 12.1213 +			break;
 12.1214 +		case Opcodes.INVOKEVIRTUAL:
 12.1215 +		case Opcodes.INVOKESPECIAL:
 12.1216 +		case Opcodes.INVOKESTATIC:
 12.1217 +		case Opcodes.INVOKEINTERFACE:
 12.1218 +			pop(item.strVal3);
 12.1219 +			if(opcode != Opcodes.INVOKESTATIC)
 12.1220 +				{
 12.1221 +				t1 = pop();
 12.1222 +				if(opcode == Opcodes.INVOKESPECIAL
 12.1223 +				   && item.strVal2.charAt(0) == '<')
 12.1224 +					{
 12.1225 +					init(t1);
 12.1226 +					}
 12.1227 +				}
 12.1228 +			push(cw, item.strVal3);
 12.1229 +			break;
 12.1230 +		case Opcodes.NEW:
 12.1231 +			push(UNINITIALIZED | cw.addUninitializedType(item.strVal1, arg));
 12.1232 +			break;
 12.1233 +		case Opcodes.NEWARRAY:
 12.1234 +			pop();
 12.1235 +			switch(arg)
 12.1236 +				{
 12.1237 +				case Opcodes.T_BOOLEAN:
 12.1238 +					push(ARRAY_OF | BOOLEAN);
 12.1239 +					break;
 12.1240 +				case Opcodes.T_CHAR:
 12.1241 +					push(ARRAY_OF | CHAR);
 12.1242 +					break;
 12.1243 +				case Opcodes.T_BYTE:
 12.1244 +					push(ARRAY_OF | BYTE);
 12.1245 +					break;
 12.1246 +				case Opcodes.T_SHORT:
 12.1247 +					push(ARRAY_OF | SHORT);
 12.1248 +					break;
 12.1249 +				case Opcodes.T_INT:
 12.1250 +					push(ARRAY_OF | INTEGER);
 12.1251 +					break;
 12.1252 +				case Opcodes.T_FLOAT:
 12.1253 +					push(ARRAY_OF | FLOAT);
 12.1254 +					break;
 12.1255 +				case Opcodes.T_DOUBLE:
 12.1256 +					push(ARRAY_OF | DOUBLE);
 12.1257 +					break;
 12.1258 +					// case Opcodes.T_LONG:
 12.1259 +				default:
 12.1260 +					push(ARRAY_OF | LONG);
 12.1261 +					break;
 12.1262 +				}
 12.1263 +			break;
 12.1264 +		case Opcodes.ANEWARRAY:
 12.1265 +			String s = item.strVal1;
 12.1266 +			pop();
 12.1267 +			if(s.charAt(0) == '[')
 12.1268 +				{
 12.1269 +				push(cw, "[" + s);
 12.1270 +				}
 12.1271 +			else
 12.1272 +				{
 12.1273 +				push(ARRAY_OF | OBJECT | cw.addType(s));
 12.1274 +				}
 12.1275 +			break;
 12.1276 +		case Opcodes.CHECKCAST:
 12.1277 +			s = item.strVal1;
 12.1278 +			pop();
 12.1279 +			if(s.charAt(0) == '[')
 12.1280 +				{
 12.1281 +				push(cw, s);
 12.1282 +				}
 12.1283 +			else
 12.1284 +				{
 12.1285 +				push(OBJECT | cw.addType(s));
 12.1286 +				}
 12.1287 +			break;
 12.1288 +			// case Opcodes.MULTIANEWARRAY:
 12.1289 +		default:
 12.1290 +			pop(arg);
 12.1291 +			push(cw, item.strVal1);
 12.1292 +			break;
 12.1293 +		}
 12.1294 +}
 12.1295 +
 12.1296 +/**
 12.1297 + * Merges the input frame of the given basic block with the input and output
 12.1298 + * frames of this basic block. Returns <tt>true</tt> if the input frame of
 12.1299 + * the given label has been changed by this operation.
 12.1300 + *
 12.1301 + * @param cw    the ClassWriter to which this label belongs.
 12.1302 + * @param frame the basic block whose input frame must be updated.
 12.1303 + * @param edge  the kind of the {@link Edge} between this label and 'label'.
 12.1304 + *              See {@link Edge#info}.
 12.1305 + * @return <tt>true</tt> if the input frame of the given label has been
 12.1306 + *         changed by this operation.
 12.1307 + */
 12.1308 +boolean merge(final ClassWriter cw, final Frame frame, final int edge){
 12.1309 +	boolean changed = false;
 12.1310 +	int i, s, dim, kind, t;
 12.1311 +
 12.1312 +	int nLocal = inputLocals.length;
 12.1313 +	int nStack = inputStack.length;
 12.1314 +	if(frame.inputLocals == null)
 12.1315 +		{
 12.1316 +		frame.inputLocals = new int[nLocal];
 12.1317 +		changed = true;
 12.1318 +		}
 12.1319 +
 12.1320 +	for(i = 0; i < nLocal; ++i)
 12.1321 +		{
 12.1322 +		if(outputLocals != null && i < outputLocals.length)
 12.1323 +			{
 12.1324 +			s = outputLocals[i];
 12.1325 +			if(s == 0)
 12.1326 +				{
 12.1327 +				t = inputLocals[i];
 12.1328 +				}
 12.1329 +			else
 12.1330 +				{
 12.1331 +				dim = s & DIM;
 12.1332 +				kind = s & KIND;
 12.1333 +				if(kind == LOCAL)
 12.1334 +					{
 12.1335 +					t = dim + inputLocals[s & VALUE];
 12.1336 +					}
 12.1337 +				else if(kind == STACK)
 12.1338 +					{
 12.1339 +					t = dim + inputStack[nStack - (s & VALUE)];
 12.1340 +					}
 12.1341 +				else
 12.1342 +					{
 12.1343 +					t = s;
 12.1344 +					}
 12.1345 +				}
 12.1346 +			}
 12.1347 +		else
 12.1348 +			{
 12.1349 +			t = inputLocals[i];
 12.1350 +			}
 12.1351 +		if(initializations != null)
 12.1352 +			{
 12.1353 +			t = init(cw, t);
 12.1354 +			}
 12.1355 +		changed |= merge(cw, t, frame.inputLocals, i);
 12.1356 +		}
 12.1357 +
 12.1358 +	if(edge > 0)
 12.1359 +		{
 12.1360 +		for(i = 0; i < nLocal; ++i)
 12.1361 +			{
 12.1362 +			t = inputLocals[i];
 12.1363 +			changed |= merge(cw, t, frame.inputLocals, i);
 12.1364 +			}
 12.1365 +		if(frame.inputStack == null)
 12.1366 +			{
 12.1367 +			frame.inputStack = new int[1];
 12.1368 +			changed = true;
 12.1369 +			}
 12.1370 +		changed |= merge(cw, edge, frame.inputStack, 0);
 12.1371 +		return changed;
 12.1372 +		}
 12.1373 +
 12.1374 +	int nInputStack = inputStack.length + owner.inputStackTop;
 12.1375 +	if(frame.inputStack == null)
 12.1376 +		{
 12.1377 +		frame.inputStack = new int[nInputStack + outputStackTop];
 12.1378 +		changed = true;
 12.1379 +		}
 12.1380 +
 12.1381 +	for(i = 0; i < nInputStack; ++i)
 12.1382 +		{
 12.1383 +		t = inputStack[i];
 12.1384 +		if(initializations != null)
 12.1385 +			{
 12.1386 +			t = init(cw, t);
 12.1387 +			}
 12.1388 +		changed |= merge(cw, t, frame.inputStack, i);
 12.1389 +		}
 12.1390 +	for(i = 0; i < outputStackTop; ++i)
 12.1391 +		{
 12.1392 +		s = outputStack[i];
 12.1393 +		dim = s & DIM;
 12.1394 +		kind = s & KIND;
 12.1395 +		if(kind == LOCAL)
 12.1396 +			{
 12.1397 +			t = dim + inputLocals[s & VALUE];
 12.1398 +			}
 12.1399 +		else if(kind == STACK)
 12.1400 +			{
 12.1401 +			t = dim + inputStack[nStack - (s & VALUE)];
 12.1402 +			}
 12.1403 +		else
 12.1404 +			{
 12.1405 +			t = s;
 12.1406 +			}
 12.1407 +		if(initializations != null)
 12.1408 +			{
 12.1409 +			t = init(cw, t);
 12.1410 +			}
 12.1411 +		changed |= merge(cw, t, frame.inputStack, nInputStack + i);
 12.1412 +		}
 12.1413 +	return changed;
 12.1414 +}
 12.1415 +
 12.1416 +/**
 12.1417 + * Merges the type at the given index in the given type array with the given
 12.1418 + * type. Returns <tt>true</tt> if the type array has been modified by this
 12.1419 + * operation.
 12.1420 + *
 12.1421 + * @param cw    the ClassWriter to which this label belongs.
 12.1422 + * @param t     the type with which the type array element must be merged.
 12.1423 + * @param types an array of types.
 12.1424 + * @param index the index of the type that must be merged in 'types'.
 12.1425 + * @return <tt>true</tt> if the type array has been modified by this
 12.1426 + *         operation.
 12.1427 + */
 12.1428 +private boolean merge(
 12.1429 +		final ClassWriter cw,
 12.1430 +		int t,
 12.1431 +		final int[] types,
 12.1432 +		final int index){
 12.1433 +	int u = types[index];
 12.1434 +	if(u == t)
 12.1435 +		{
 12.1436 +		// if the types are equal, merge(u,t)=u, so there is no change
 12.1437 +		return false;
 12.1438 +		}
 12.1439 +	if((t & ~DIM) == NULL)
 12.1440 +		{
 12.1441 +		if(u == NULL)
 12.1442 +			{
 12.1443 +			return false;
 12.1444 +			}
 12.1445 +		t = NULL;
 12.1446 +		}
 12.1447 +	if(u == 0)
 12.1448 +		{
 12.1449 +		// if types[index] has never been assigned, merge(u,t)=t
 12.1450 +		types[index] = t;
 12.1451 +		return true;
 12.1452 +		}
 12.1453 +	int v;
 12.1454 +	if((u & BASE_KIND) == OBJECT || (u & DIM) != 0)
 12.1455 +		{
 12.1456 +		// if u is a reference type of any dimension
 12.1457 +		if(t == NULL)
 12.1458 +			{
 12.1459 +			// if t is the NULL type, merge(u,t)=u, so there is no change
 12.1460 +			return false;
 12.1461 +			}
 12.1462 +		else if((t & (DIM | BASE_KIND)) == (u & (DIM | BASE_KIND)))
 12.1463 +			{
 12.1464 +			if((u & BASE_KIND) == OBJECT)
 12.1465 +				{
 12.1466 +				// if t is also a reference type, and if u and t have the
 12.1467 +				// same dimension merge(u,t) = dim(t) | common parent of the
 12.1468 +				// element types of u and t
 12.1469 +				v = (t & DIM) | OBJECT
 12.1470 +				    | cw.getMergedType(t & BASE_VALUE, u & BASE_VALUE);
 12.1471 +				}
 12.1472 +			else
 12.1473 +				{
 12.1474 +				// if u and t are array types, but not with the same element
 12.1475 +				// type, merge(u,t)=java/lang/Object
 12.1476 +				v = OBJECT | cw.addType("java/lang/Object");
 12.1477 +				}
 12.1478 +			}
 12.1479 +		else if((t & BASE_KIND) == OBJECT || (t & DIM) != 0)
 12.1480 +			{
 12.1481 +			// if t is any other reference or array type,
 12.1482 +			// merge(u,t)=java/lang/Object
 12.1483 +			v = OBJECT | cw.addType("java/lang/Object");
 12.1484 +			}
 12.1485 +		else
 12.1486 +			{
 12.1487 +			// if t is any other type, merge(u,t)=TOP
 12.1488 +			v = TOP;
 12.1489 +			}
 12.1490 +		}
 12.1491 +	else if(u == NULL)
 12.1492 +		{
 12.1493 +		// if u is the NULL type, merge(u,t)=t,
 12.1494 +		// or TOP if t is not a reference type
 12.1495 +		v = (t & BASE_KIND) == OBJECT || (t & DIM) != 0 ? t : TOP;
 12.1496 +		}
 12.1497 +	else
 12.1498 +		{
 12.1499 +		// if u is any other type, merge(u,t)=TOP whatever t
 12.1500 +		v = TOP;
 12.1501 +		}
 12.1502 +	if(u != v)
 12.1503 +		{
 12.1504 +		types[index] = v;
 12.1505 +		return true;
 12.1506 +		}
 12.1507 +	return false;
 12.1508 +}
 12.1509 +}
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/clojure/asm/Handler.java	Sat Aug 21 06:25:44 2010 -0400
    13.3 @@ -0,0 +1,70 @@
    13.4 +/***
    13.5 + * ASM: a very small and fast Java bytecode manipulation framework
    13.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    13.7 + * All rights reserved.
    13.8 + *
    13.9 + * Redistribution and use in source and binary forms, with or without
   13.10 + * modification, are permitted provided that the following conditions
   13.11 + * are met:
   13.12 + * 1. Redistributions of source code must retain the above copyright
   13.13 + *    notice, this list of conditions and the following disclaimer.
   13.14 + * 2. Redistributions in binary form must reproduce the above copyright
   13.15 + *    notice, this list of conditions and the following disclaimer in the
   13.16 + *    documentation and/or other materials provided with the distribution.
   13.17 + * 3. Neither the name of the copyright holders nor the names of its
   13.18 + *    contributors may be used to endorse or promote products derived from
   13.19 + *    this software without specific prior written permission.
   13.20 + *
   13.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   13.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   13.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   13.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   13.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   13.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   13.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   13.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   13.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   13.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   13.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   13.32 + */
   13.33 +package clojure.asm;
   13.34 +
   13.35 +/**
   13.36 + * Information about an exception handler block.
   13.37 + *
   13.38 + * @author Eric Bruneton
   13.39 + */
   13.40 +class Handler{
   13.41 +
   13.42 +/**
   13.43 + * Beginning of the exception handler's scope (inclusive).
   13.44 + */
   13.45 +Label start;
   13.46 +
   13.47 +/**
   13.48 + * End of the exception handler's scope (exclusive).
   13.49 + */
   13.50 +Label end;
   13.51 +
   13.52 +/**
   13.53 + * Beginning of the exception handler's code.
   13.54 + */
   13.55 +Label handler;
   13.56 +
   13.57 +/**
   13.58 + * Internal name of the type of exceptions handled by this handler, or
   13.59 + * <tt>null</tt> to catch any exceptions.
   13.60 + */
   13.61 +String desc;
   13.62 +
   13.63 +/**
   13.64 + * Constant pool index of the internal name of the type of exceptions
   13.65 + * handled by this handler, or 0 to catch any exceptions.
   13.66 + */
   13.67 +int type;
   13.68 +
   13.69 +/**
   13.70 + * Next exception handler block info.
   13.71 + */
   13.72 +Handler next;
   13.73 +}
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/clojure/asm/Item.java	Sat Aug 21 06:25:44 2010 -0400
    14.3 @@ -0,0 +1,258 @@
    14.4 +/***
    14.5 + * ASM: a very small and fast Java bytecode manipulation framework
    14.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    14.7 + * All rights reserved.
    14.8 + *
    14.9 + * Redistribution and use in source and binary forms, with or without
   14.10 + * modification, are permitted provided that the following conditions
   14.11 + * are met:
   14.12 + * 1. Redistributions of source code must retain the above copyright
   14.13 + *    notice, this list of conditions and the following disclaimer.
   14.14 + * 2. Redistributions in binary form must reproduce the above copyright
   14.15 + *    notice, this list of conditions and the following disclaimer in the
   14.16 + *    documentation and/or other materials provided with the distribution.
   14.17 + * 3. Neither the name of the copyright holders nor the names of its
   14.18 + *    contributors may be used to endorse or promote products derived from
   14.19 + *    this software without specific prior written permission.
   14.20 + *
   14.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   14.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   14.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   14.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   14.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   14.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   14.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   14.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   14.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   14.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   14.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   14.32 + */
   14.33 +package clojure.asm;
   14.34 +
   14.35 +/**
   14.36 + * A constant pool item. Constant pool items can be created with the 'newXXX'
   14.37 + * methods in the {@link ClassWriter} class.
   14.38 + *
   14.39 + * @author Eric Bruneton
   14.40 + */
   14.41 +final class Item{
   14.42 +
   14.43 +/**
   14.44 + * Index of this item in the constant pool.
   14.45 + */
   14.46 +int index;
   14.47 +
   14.48 +/**
   14.49 + * Type of this constant pool item. A single class is used to represent all
   14.50 + * constant pool item types, in order to minimize the bytecode size of this
   14.51 + * package. The value of this field is one of {@link ClassWriter#INT},
   14.52 + * {@link ClassWriter#LONG}, {@link ClassWriter#FLOAT},
   14.53 + * {@link ClassWriter#DOUBLE}, {@link ClassWriter#UTF8},
   14.54 + * {@link ClassWriter#STR}, {@link ClassWriter#CLASS},
   14.55 + * {@link ClassWriter#NAME_TYPE}, {@link ClassWriter#FIELD},
   14.56 + * {@link ClassWriter#METH}, {@link ClassWriter#IMETH}.
   14.57 + * <p/>
   14.58 + * Special Item types are used for Items that are stored in the ClassWriter
   14.59 + * {@link ClassWriter#typeTable}, instead of the constant pool, in order to
   14.60 + * avoid clashes with normal constant pool items in the ClassWriter constant
   14.61 + * pool's hash table. These special item types are
   14.62 + * {@link ClassWriter#TYPE_NORMAL}, {@link ClassWriter#TYPE_UNINIT} and
   14.63 + * {@link ClassWriter#TYPE_MERGED}.
   14.64 + */
   14.65 +int type;
   14.66 +
   14.67 +/**
   14.68 + * Value of this item, for an integer item.
   14.69 + */
   14.70 +int intVal;
   14.71 +
   14.72 +/**
   14.73 + * Value of this item, for a long item.
   14.74 + */
   14.75 +long longVal;
   14.76 +
   14.77 +/**
   14.78 + * First part of the value of this item, for items that do not hold a
   14.79 + * primitive value.
   14.80 + */
   14.81 +String strVal1;
   14.82 +
   14.83 +/**
   14.84 + * Second part of the value of this item, for items that do not hold a
   14.85 + * primitive value.
   14.86 + */
   14.87 +String strVal2;
   14.88 +
   14.89 +/**
   14.90 + * Third part of the value of this item, for items that do not hold a
   14.91 + * primitive value.
   14.92 + */
   14.93 +String strVal3;
   14.94 +
   14.95 +/**
   14.96 + * The hash code value of this constant pool item.
   14.97 + */
   14.98 +int hashCode;
   14.99 +
  14.100 +/**
  14.101 + * Link to another constant pool item, used for collision lists in the
  14.102 + * constant pool's hash table.
  14.103 + */
  14.104 +Item next;
  14.105 +
  14.106 +/**
  14.107 + * Constructs an uninitialized {@link Item}.
  14.108 + */
  14.109 +Item(){
  14.110 +}
  14.111 +
  14.112 +/**
  14.113 + * Constructs an uninitialized {@link Item} for constant pool element at
  14.114 + * given position.
  14.115 + *
  14.116 + * @param index index of the item to be constructed.
  14.117 + */
  14.118 +Item(final int index){
  14.119 +	this.index = index;
  14.120 +}
  14.121 +
  14.122 +/**
  14.123 + * Constructs a copy of the given item.
  14.124 + *
  14.125 + * @param index index of the item to be constructed.
  14.126 + * @param i     the item that must be copied into the item to be constructed.
  14.127 + */
  14.128 +Item(final int index, final Item i){
  14.129 +	this.index = index;
  14.130 +	type = i.type;
  14.131 +	intVal = i.intVal;
  14.132 +	longVal = i.longVal;
  14.133 +	strVal1 = i.strVal1;
  14.134 +	strVal2 = i.strVal2;
  14.135 +	strVal3 = i.strVal3;
  14.136 +	hashCode = i.hashCode;
  14.137 +}
  14.138 +
  14.139 +/**
  14.140 + * Sets this item to an integer item.
  14.141 + *
  14.142 + * @param intVal the value of this item.
  14.143 + */
  14.144 +void set(final int intVal){
  14.145 +	this.type = ClassWriter.INT;
  14.146 +	this.intVal = intVal;
  14.147 +	this.hashCode = 0x7FFFFFFF & (type + intVal);
  14.148 +}
  14.149 +
  14.150 +/**
  14.151 + * Sets this item to a long item.
  14.152 + *
  14.153 + * @param longVal the value of this item.
  14.154 + */
  14.155 +void set(final long longVal){
  14.156 +	this.type = ClassWriter.LONG;
  14.157 +	this.longVal = longVal;
  14.158 +	this.hashCode = 0x7FFFFFFF & (type + (int) longVal);
  14.159 +}
  14.160 +
  14.161 +/**
  14.162 + * Sets this item to a float item.
  14.163 + *
  14.164 + * @param floatVal the value of this item.
  14.165 + */
  14.166 +void set(final float floatVal){
  14.167 +	this.type = ClassWriter.FLOAT;
  14.168 +	this.intVal = Float.floatToRawIntBits(floatVal);
  14.169 +	this.hashCode = 0x7FFFFFFF & (type + (int) floatVal);
  14.170 +}
  14.171 +
  14.172 +/**
  14.173 + * Sets this item to a double item.
  14.174 + *
  14.175 + * @param doubleVal the value of this item.
  14.176 + */
  14.177 +void set(final double doubleVal){
  14.178 +	this.type = ClassWriter.DOUBLE;
  14.179 +	this.longVal = Double.doubleToRawLongBits(doubleVal);
  14.180 +	this.hashCode = 0x7FFFFFFF & (type + (int) doubleVal);
  14.181 +}
  14.182 +
  14.183 +/**
  14.184 + * Sets this item to an item that do not hold a primitive value.
  14.185 + *
  14.186 + * @param type    the type of this item.
  14.187 + * @param strVal1 first part of the value of this item.
  14.188 + * @param strVal2 second part of the value of this item.
  14.189 + * @param strVal3 third part of the value of this item.
  14.190 + */
  14.191 +void set(
  14.192 +		final int type,
  14.193 +		final String strVal1,
  14.194 +		final String strVal2,
  14.195 +		final String strVal3){
  14.196 +	this.type = type;
  14.197 +	this.strVal1 = strVal1;
  14.198 +	this.strVal2 = strVal2;
  14.199 +	this.strVal3 = strVal3;
  14.200 +	switch(type)
  14.201 +		{
  14.202 +		case ClassWriter.UTF8:
  14.203 +		case ClassWriter.STR:
  14.204 +		case ClassWriter.CLASS:
  14.205 +		case ClassWriter.TYPE_NORMAL:
  14.206 +			hashCode = 0x7FFFFFFF & (type + strVal1.hashCode());
  14.207 +			return;
  14.208 +		case ClassWriter.NAME_TYPE:
  14.209 +			hashCode = 0x7FFFFFFF & (type + strVal1.hashCode()
  14.210 +			                                * strVal2.hashCode());
  14.211 +			return;
  14.212 +			// ClassWriter.FIELD:
  14.213 +			// ClassWriter.METH:
  14.214 +			// ClassWriter.IMETH:
  14.215 +		default:
  14.216 +			hashCode = 0x7FFFFFFF & (type + strVal1.hashCode()
  14.217 +			                                * strVal2.hashCode() * strVal3.hashCode());
  14.218 +		}
  14.219 +}
  14.220 +
  14.221 +/**
  14.222 + * Indicates if the given item is equal to this one.
  14.223 + *
  14.224 + * @param i the item to be compared to this one.
  14.225 + * @return <tt>true</tt> if the given item if equal to this one,
  14.226 + *         <tt>false</tt> otherwise.
  14.227 + */
  14.228 +boolean isEqualTo(final Item i){
  14.229 +	if(i.type == type)
  14.230 +		{
  14.231 +		switch(type)
  14.232 +			{
  14.233 +			case ClassWriter.INT:
  14.234 +			case ClassWriter.FLOAT:
  14.235 +				return i.intVal == intVal;
  14.236 +			case ClassWriter.TYPE_MERGED:
  14.237 +			case ClassWriter.LONG:
  14.238 +			case ClassWriter.DOUBLE:
  14.239 +				return i.longVal == longVal;
  14.240 +			case ClassWriter.UTF8:
  14.241 +			case ClassWriter.STR:
  14.242 +			case ClassWriter.CLASS:
  14.243 +			case ClassWriter.TYPE_NORMAL:
  14.244 +				return i.strVal1.equals(strVal1);
  14.245 +			case ClassWriter.TYPE_UNINIT:
  14.246 +				return i.intVal == intVal && i.strVal1.equals(strVal1);
  14.247 +			case ClassWriter.NAME_TYPE:
  14.248 +				return i.strVal1.equals(strVal1)
  14.249 +				       && i.strVal2.equals(strVal2);
  14.250 +				// ClassWriter.FIELD:
  14.251 +				// ClassWriter.METH:
  14.252 +				// ClassWriter.IMETH:
  14.253 +			default:
  14.254 +				return i.strVal1.equals(strVal1)
  14.255 +				       && i.strVal2.equals(strVal2)
  14.256 +				       && i.strVal3.equals(strVal3);
  14.257 +			}
  14.258 +		}
  14.259 +	return false;
  14.260 +}
  14.261 +}
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/clojure/asm/Label.java	Sat Aug 21 06:25:44 2010 -0400
    15.3 @@ -0,0 +1,437 @@
    15.4 +/***
    15.5 + * ASM: a very small and fast Java bytecode manipulation framework
    15.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    15.7 + * All rights reserved.
    15.8 + *
    15.9 + * Redistribution and use in source and binary forms, with or without
   15.10 + * modification, are permitted provided that the following conditions
   15.11 + * are met:
   15.12 + * 1. Redistributions of source code must retain the above copyright
   15.13 + *    notice, this list of conditions and the following disclaimer.
   15.14 + * 2. Redistributions in binary form must reproduce the above copyright
   15.15 + *    notice, this list of conditions and the following disclaimer in the
   15.16 + *    documentation and/or other materials provided with the distribution.
   15.17 + * 3. Neither the name of the copyright holders nor the names of its
   15.18 + *    contributors may be used to endorse or promote products derived from
   15.19 + *    this software without specific prior written permission.
   15.20 + *
   15.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   15.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   15.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   15.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   15.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   15.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   15.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   15.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   15.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   15.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   15.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   15.32 + */
   15.33 +package clojure.asm;
   15.34 +
   15.35 +/**
   15.36 + * A label represents a position in the bytecode of a method. Labels are used
   15.37 + * for jump, goto, and switch instructions, and for try catch blocks.
   15.38 + *
   15.39 + * @author Eric Bruneton
   15.40 + */
   15.41 +public class Label{
   15.42 +
   15.43 +/**
   15.44 + * Indicates if this label is only used for debug attributes. Such a label
   15.45 + * is not the start of a basic block, the target of a jump instruction, or
   15.46 + * an exception handler. It can be safely ignored in control flow graph
   15.47 + * analysis algorithms (for optimization purposes).
   15.48 + */
   15.49 +final static int DEBUG = 1;
   15.50 +
   15.51 +/**
   15.52 + * Indicates if the position of this label is known.
   15.53 + */
   15.54 +final static int RESOLVED = 2;
   15.55 +
   15.56 +/**
   15.57 + * Indicates if this label has been updated, after instruction resizing.
   15.58 + */
   15.59 +final static int RESIZED = 4;
   15.60 +
   15.61 +/**
   15.62 + * Indicates if this basic block has been pushed in the basic block stack.
   15.63 + * See {@link MethodWriter#visitMaxs visitMaxs}.
   15.64 + */
   15.65 +final static int PUSHED = 8;
   15.66 +
   15.67 +/**
   15.68 + * Indicates if this label is the target of a jump instruction, or the start
   15.69 + * of an exception handler.
   15.70 + */
   15.71 +final static int TARGET = 16;
   15.72 +
   15.73 +/**
   15.74 + * Indicates if a stack map frame must be stored for this label.
   15.75 + */
   15.76 +final static int STORE = 32;
   15.77 +
   15.78 +/**
   15.79 + * Indicates if this label corresponds to a reachable basic block.
   15.80 + */
   15.81 +final static int REACHABLE = 64;
   15.82 +
   15.83 +/**
   15.84 + * Indicates if this basic block ends with a JSR instruction.
   15.85 + */
   15.86 +final static int JSR = 128;
   15.87 +
   15.88 +/**
   15.89 + * Indicates if this basic block ends with a RET instruction.
   15.90 + */
   15.91 +final static int RET = 256;
   15.92 +
   15.93 +/**
   15.94 + * Field used to associate user information to a label.
   15.95 + */
   15.96 +public Object info;
   15.97 +
   15.98 +/**
   15.99 + * Flags that indicate the status of this label.
  15.100 + *
  15.101 + * @see #DEBUG
  15.102 + * @see #RESOLVED
  15.103 + * @see #RESIZED
  15.104 + * @see #PUSHED
  15.105 + * @see #TARGET
  15.106 + * @see #STORE
  15.107 + * @see #REACHABLE
  15.108 + * @see #JSR
  15.109 + * @see #RET
  15.110 + */
  15.111 +int status;
  15.112 +
  15.113 +/**
  15.114 + * The line number corresponding to this label, if known.
  15.115 + */
  15.116 +int line;
  15.117 +
  15.118 +/**
  15.119 + * The position of this label in the code, if known.
  15.120 + */
  15.121 +int position;
  15.122 +
  15.123 +/**
  15.124 + * Number of forward references to this label, times two.
  15.125 + */
  15.126 +private int referenceCount;
  15.127 +
  15.128 +/**
  15.129 + * Informations about forward references. Each forward reference is
  15.130 + * described by two consecutive integers in this array: the first one is the
  15.131 + * position of the first byte of the bytecode instruction that contains the
  15.132 + * forward reference, while the second is the position of the first byte of
  15.133 + * the forward reference itself. In fact the sign of the first integer
  15.134 + * indicates if this reference uses 2 or 4 bytes, and its absolute value
  15.135 + * gives the position of the bytecode instruction.
  15.136 + */
  15.137 +private int[] srcAndRefPositions;
  15.138 +
  15.139 +// ------------------------------------------------------------------------
  15.140 +
  15.141 +/*
  15.142 +	 * Fields for the control flow and data flow graph analysis algorithms (used
  15.143 +	 * to compute the maximum stack size or the stack map frames). A control
  15.144 +	 * flow graph contains one node per "basic block", and one edge per "jump"
  15.145 +	 * from one basic block to another. Each node (i.e., each basic block) is
  15.146 +	 * represented by the Label object that corresponds to the first instruction
  15.147 +	 * of this basic block. Each node also stores the list of its successors in
  15.148 +	 * the graph, as a linked list of Edge objects.
  15.149 +	 *
  15.150 +	 * The control flow analysis algorithms used to compute the maximum stack
  15.151 +	 * size or the stack map frames are similar and use two steps. The first
  15.152 +	 * step, during the visit of each instruction, builds information about the
  15.153 +	 * state of the local variables and the operand stack at the end of each
  15.154 +	 * basic block, called the "output frame", <i>relatively</i> to the frame
  15.155 +	 * state at the beginning of the basic block, which is called the "input
  15.156 +	 * frame", and which is <i>unknown</i> during this step. The second step,
  15.157 +	 * in {@link MethodWriter#visitMaxs}, is a fix point algorithm that
  15.158 +	 * computes information about the input frame of each basic block, from the
  15.159 +	 * input state of the first basic block (known from the method signature),
  15.160 +	 * and by the using the previously computed relative output frames.
  15.161 +	 *
  15.162 +	 * The algorithm used to compute the maximum stack size only computes the
  15.163 +	 * relative output and absolute input stack heights, while the algorithm
  15.164 +	 * used to compute stack map frames computes relative output frames and
  15.165 +	 * absolute input frames.
  15.166 +	 */
  15.167 +
  15.168 +/**
  15.169 + * Start of the output stack relatively to the input stack. The exact
  15.170 + * semantics of this field depends on the algorithm that is used.
  15.171 + * <p/>
  15.172 + * When only the maximum stack size is computed, this field is the number of
  15.173 + * elements in the input stack.
  15.174 + * <p/>
  15.175 + * When the stack map frames are completely computed, this field is the
  15.176 + * offset of the first output stack element relatively to the top of the
  15.177 + * input stack. This offset is always negative or null. A null offset means
  15.178 + * that the output stack must be appended to the input stack. A -n offset
  15.179 + * means that the first n output stack elements must replace the top n input
  15.180 + * stack elements, and that the other elements must be appended to the input
  15.181 + * stack.
  15.182 + */
  15.183 +int inputStackTop;
  15.184 +
  15.185 +/**
  15.186 + * Maximum height reached by the output stack, relatively to the top of the
  15.187 + * input stack. This maximum is always positive or null.
  15.188 + */
  15.189 +int outputStackMax;
  15.190 +
  15.191 +/**
  15.192 + * Information about the input and output stack map frames of this basic
  15.193 + * block. This field is only used when {@link ClassWriter#COMPUTE_FRAMES}
  15.194 + * option is used.
  15.195 + */
  15.196 +Frame frame;
  15.197 +
  15.198 +/**
  15.199 + * The successor of this label, in the order they are visited. This linked
  15.200 + * list does not include labels used for debug info only. If
  15.201 + * {@link ClassWriter#COMPUTE_FRAMES} option is used then, in addition, it
  15.202 + * does not contain successive labels that denote the same bytecode position
  15.203 + * (in this case only the first label appears in this list).
  15.204 + */
  15.205 +Label successor;
  15.206 +
  15.207 +/**
  15.208 + * The successors of this node in the control flow graph. These successors
  15.209 + * are stored in a linked list of {@link Edge Edge} objects, linked to each
  15.210 + * other by their {@link Edge#next} field.
  15.211 + */
  15.212 +Edge successors;
  15.213 +
  15.214 +/**
  15.215 + * The next basic block in the basic block stack. This stack is used in the
  15.216 + * main loop of the fix point algorithm used in the second step of the
  15.217 + * control flow analysis algorithms.
  15.218 + *
  15.219 + * @see MethodWriter#visitMaxs
  15.220 + */
  15.221 +Label next;
  15.222 +
  15.223 +// ------------------------------------------------------------------------
  15.224 +// Constructor
  15.225 +// ------------------------------------------------------------------------
  15.226 +
  15.227 +/**
  15.228 + * Constructs a new label.
  15.229 + */
  15.230 +public Label(){
  15.231 +}
  15.232 +
  15.233 +/**
  15.234 + * Constructs a new label.
  15.235 + *
  15.236 + * @param debug if this label is only used for debug attributes.
  15.237 + */
  15.238 +Label(final boolean debug){
  15.239 +	this.status = debug ? DEBUG : 0;
  15.240 +}
  15.241 +
  15.242 +// ------------------------------------------------------------------------
  15.243 +// Methods to compute offsets and to manage forward references
  15.244 +// ------------------------------------------------------------------------
  15.245 +
  15.246 +/**
  15.247 + * Returns the offset corresponding to this label. This offset is computed
  15.248 + * from the start of the method's bytecode. <i>This method is intended for
  15.249 + * {@link Attribute} sub classes, and is normally not needed by class
  15.250 + * generators or adapters.</i>
  15.251 + *
  15.252 + * @return the offset corresponding to this label.
  15.253 + * @throws IllegalStateException if this label is not resolved yet.
  15.254 + */
  15.255 +public int getOffset(){
  15.256 +	if((status & RESOLVED) == 0)
  15.257 +		{
  15.258 +		throw new IllegalStateException("Label offset position has not been resolved yet");
  15.259 +		}
  15.260 +	return position;
  15.261 +}
  15.262 +
  15.263 +/**
  15.264 + * Puts a reference to this label in the bytecode of a method. If the
  15.265 + * position of the label is known, the offset is computed and written
  15.266 + * directly. Otherwise, a null offset is written and a new forward reference
  15.267 + * is declared for this label.
  15.268 + *
  15.269 + * @param owner      the code writer that calls this method.
  15.270 + * @param out        the bytecode of the method.
  15.271 + * @param source     the position of first byte of the bytecode instruction that
  15.272 + *                   contains this label.
  15.273 + * @param wideOffset <tt>true</tt> if the reference must be stored in 4
  15.274 + *                   bytes, or <tt>false</tt> if it must be stored with 2 bytes.
  15.275 + * @throws IllegalArgumentException if this label has not been created by
  15.276 + *                                  the given code writer.
  15.277 + */
  15.278 +void put(
  15.279 +		final MethodWriter owner,
  15.280 +		final ByteVector out,
  15.281 +		final int source,
  15.282 +		final boolean wideOffset){
  15.283 +	if((status & RESOLVED) != 0)
  15.284 +		{
  15.285 +		if(wideOffset)
  15.286 +			{
  15.287 +			out.putInt(position - source);
  15.288 +			}
  15.289 +		else
  15.290 +			{
  15.291 +			out.putShort(position - source);
  15.292 +			}
  15.293 +		}
  15.294 +	else
  15.295 +		{
  15.296 +		if(wideOffset)
  15.297 +			{
  15.298 +			addReference(-1 - source, out.length);
  15.299 +			out.putInt(-1);
  15.300 +			}
  15.301 +		else
  15.302 +			{
  15.303 +			addReference(source, out.length);
  15.304 +			out.putShort(-1);
  15.305 +			}
  15.306 +		}
  15.307 +}
  15.308 +
  15.309 +/**
  15.310 + * Adds a forward reference to this label. This method must be called only
  15.311 + * for a true forward reference, i.e. only if this label is not resolved
  15.312 + * yet. For backward references, the offset of the reference can be, and
  15.313 + * must be, computed and stored directly.
  15.314 + *
  15.315 + * @param sourcePosition    the position of the referencing instruction. This
  15.316 + *                          position will be used to compute the offset of this forward
  15.317 + *                          reference.
  15.318 + * @param referencePosition the position where the offset for this forward
  15.319 + *                          reference must be stored.
  15.320 + */
  15.321 +private void addReference(
  15.322 +		final int sourcePosition,
  15.323 +		final int referencePosition){
  15.324 +	if(srcAndRefPositions == null)
  15.325 +		{
  15.326 +		srcAndRefPositions = new int[6];
  15.327 +		}
  15.328 +	if(referenceCount >= srcAndRefPositions.length)
  15.329 +		{
  15.330 +		int[] a = new int[srcAndRefPositions.length + 6];
  15.331 +		System.arraycopy(srcAndRefPositions,
  15.332 +		                 0,
  15.333 +		                 a,
  15.334 +		                 0,
  15.335 +		                 srcAndRefPositions.length);
  15.336 +		srcAndRefPositions = a;
  15.337 +		}
  15.338 +	srcAndRefPositions[referenceCount++] = sourcePosition;
  15.339 +	srcAndRefPositions[referenceCount++] = referencePosition;
  15.340 +}
  15.341 +
  15.342 +/**
  15.343 + * Resolves all forward references to this label. This method must be called
  15.344 + * when this label is added to the bytecode of the method, i.e. when its
  15.345 + * position becomes known. This method fills in the blanks that where left
  15.346 + * in the bytecode by each forward reference previously added to this label.
  15.347 + *
  15.348 + * @param owner    the code writer that calls this method.
  15.349 + * @param position the position of this label in the bytecode.
  15.350 + * @param data     the bytecode of the method.
  15.351 + * @return <tt>true</tt> if a blank that was left for this label was to
  15.352 + *         small to store the offset. In such a case the corresponding jump
  15.353 + *         instruction is replaced with a pseudo instruction (using unused
  15.354 + *         opcodes) using an unsigned two bytes offset. These pseudo
  15.355 + *         instructions will need to be replaced with true instructions with
  15.356 + *         wider offsets (4 bytes instead of 2). This is done in
  15.357 + *         {@link MethodWriter#resizeInstructions}.
  15.358 + * @throws IllegalArgumentException if this label has already been resolved,
  15.359 + *                                  or if it has not been created by the given code writer.
  15.360 + */
  15.361 +boolean resolve(
  15.362 +		final MethodWriter owner,
  15.363 +		final int position,
  15.364 +		final byte[] data){
  15.365 +	boolean needUpdate = false;
  15.366 +	this.status |= RESOLVED;
  15.367 +	this.position = position;
  15.368 +	int i = 0;
  15.369 +	while(i < referenceCount)
  15.370 +		{
  15.371 +		int source = srcAndRefPositions[i++];
  15.372 +		int reference = srcAndRefPositions[i++];
  15.373 +		int offset;
  15.374 +		if(source >= 0)
  15.375 +			{
  15.376 +			offset = position - source;
  15.377 +			if(offset < Short.MIN_VALUE || offset > Short.MAX_VALUE)
  15.378 +				{
  15.379 +				/*
  15.380 +									 * changes the opcode of the jump instruction, in order to
  15.381 +									 * be able to find it later (see resizeInstructions in
  15.382 +									 * MethodWriter). These temporary opcodes are similar to
  15.383 +									 * jump instruction opcodes, except that the 2 bytes offset
  15.384 +									 * is unsigned (and can therefore represent values from 0 to
  15.385 +									 * 65535, which is sufficient since the size of a method is
  15.386 +									 * limited to 65535 bytes).
  15.387 +									 */
  15.388 +				int opcode = data[reference - 1] & 0xFF;
  15.389 +				if(opcode <= Opcodes.JSR)
  15.390 +					{
  15.391 +					// changes IFEQ ... JSR to opcodes 202 to 217
  15.392 +					data[reference - 1] = (byte) (opcode + 49);
  15.393 +					}
  15.394 +				else
  15.395 +					{
  15.396 +					// changes IFNULL and IFNONNULL to opcodes 218 and 219
  15.397 +					data[reference - 1] = (byte) (opcode + 20);
  15.398 +					}
  15.399 +				needUpdate = true;
  15.400 +				}
  15.401 +			data[reference++] = (byte) (offset >>> 8);
  15.402 +			data[reference] = (byte) offset;
  15.403 +			}
  15.404 +		else
  15.405 +			{
  15.406 +			offset = position + source + 1;
  15.407 +			data[reference++] = (byte) (offset >>> 24);
  15.408 +			data[reference++] = (byte) (offset >>> 16);
  15.409 +			data[reference++] = (byte) (offset >>> 8);
  15.410 +			data[reference] = (byte) offset;
  15.411 +			}
  15.412 +		}
  15.413 +	return needUpdate;
  15.414 +}
  15.415 +
  15.416 +/**
  15.417 + * Returns the first label of the series to which this label belongs. For an
  15.418 + * isolated label or for the first label in a series of successive labels,
  15.419 + * this method returns the label itself. For other labels it returns the
  15.420 + * first label of the series.
  15.421 + *
  15.422 + * @return the first label of the series to which this label belongs.
  15.423 + */
  15.424 +Label getFirst(){
  15.425 +	return frame == null ? this : frame.owner;
  15.426 +}
  15.427 +
  15.428 +// ------------------------------------------------------------------------
  15.429 +// Overriden Object methods
  15.430 +// ------------------------------------------------------------------------
  15.431 +
  15.432 +/**
  15.433 + * Returns a string representation of this label.
  15.434 + *
  15.435 + * @return a string representation of this label.
  15.436 + */
  15.437 +public String toString(){
  15.438 +	return "L" + System.identityHashCode(this);
  15.439 +}
  15.440 +}
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/clojure/asm/MethodAdapter.java	Sat Aug 21 06:25:44 2010 -0400
    16.3 @@ -0,0 +1,186 @@
    16.4 +/***
    16.5 + * ASM: a very small and fast Java bytecode manipulation framework
    16.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    16.7 + * All rights reserved.
    16.8 + *
    16.9 + * Redistribution and use in source and binary forms, with or without
   16.10 + * modification, are permitted provided that the following conditions
   16.11 + * are met:
   16.12 + * 1. Redistributions of source code must retain the above copyright
   16.13 + *    notice, this list of conditions and the following disclaimer.
   16.14 + * 2. Redistributions in binary form must reproduce the above copyright
   16.15 + *    notice, this list of conditions and the following disclaimer in the
   16.16 + *    documentation and/or other materials provided with the distribution.
   16.17 + * 3. Neither the name of the copyright holders nor the names of its
   16.18 + *    contributors may be used to endorse or promote products derived from
   16.19 + *    this software without specific prior written permission.
   16.20 + *
   16.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   16.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   16.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   16.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   16.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   16.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   16.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   16.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   16.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   16.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   16.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   16.32 + */
   16.33 +package clojure.asm;
   16.34 +
   16.35 +/**
   16.36 + * An empty {@link MethodVisitor} that delegates to another
   16.37 + * {@link MethodVisitor}. This class can be used as a super class to quickly
   16.38 + * implement usefull method adapter classes, just by overriding the necessary
   16.39 + * methods.
   16.40 + *
   16.41 + * @author Eric Bruneton
   16.42 + */
   16.43 +public class MethodAdapter implements MethodVisitor{
   16.44 +
   16.45 +/**
   16.46 + * The {@link MethodVisitor} to which this adapter delegates calls.
   16.47 + */
   16.48 +protected MethodVisitor mv;
   16.49 +
   16.50 +/**
   16.51 + * Constructs a new {@link MethodAdapter} object.
   16.52 + *
   16.53 + * @param mv the code visitor to which this adapter must delegate calls.
   16.54 + */
   16.55 +public MethodAdapter(final MethodVisitor mv){
   16.56 +	this.mv = mv;
   16.57 +}
   16.58 +
   16.59 +public AnnotationVisitor visitAnnotationDefault(){
   16.60 +	return mv.visitAnnotationDefault();
   16.61 +}
   16.62 +
   16.63 +public AnnotationVisitor visitAnnotation(
   16.64 +		final String desc,
   16.65 +		final boolean visible){
   16.66 +	return mv.visitAnnotation(desc, visible);
   16.67 +}
   16.68 +
   16.69 +public AnnotationVisitor visitParameterAnnotation(
   16.70 +		final int parameter,
   16.71 +		final String desc,
   16.72 +		final boolean visible){
   16.73 +	return mv.visitParameterAnnotation(parameter, desc, visible);
   16.74 +}
   16.75 +
   16.76 +public void visitAttribute(final Attribute attr){
   16.77 +	mv.visitAttribute(attr);
   16.78 +}
   16.79 +
   16.80 +public void visitCode(){
   16.81 +	mv.visitCode();
   16.82 +}
   16.83 +
   16.84 +public void visitFrame(
   16.85 +		final int type,
   16.86 +		final int nLocal,
   16.87 +		final Object[] local,
   16.88 +		final int nStack,
   16.89 +		final Object[] stack){
   16.90 +	mv.visitFrame(type, nLocal, local, nStack, stack);
   16.91 +}
   16.92 +
   16.93 +public void visitInsn(final int opcode){
   16.94 +	mv.visitInsn(opcode);
   16.95 +}
   16.96 +
   16.97 +public void visitIntInsn(final int opcode, final int operand){
   16.98 +	mv.visitIntInsn(opcode, operand);
   16.99 +}
  16.100 +
  16.101 +public void visitVarInsn(final int opcode, final int var){
  16.102 +	mv.visitVarInsn(opcode, var);
  16.103 +}
  16.104 +
  16.105 +public void visitTypeInsn(final int opcode, final String desc){
  16.106 +	mv.visitTypeInsn(opcode, desc);
  16.107 +}
  16.108 +
  16.109 +public void visitFieldInsn(
  16.110 +		final int opcode,
  16.111 +		final String owner,
  16.112 +		final String name,
  16.113 +		final String desc){
  16.114 +	mv.visitFieldInsn(opcode, owner, name, desc);
  16.115 +}
  16.116 +
  16.117 +public void visitMethodInsn(
  16.118 +		final int opcode,
  16.119 +		final String owner,
  16.120 +		final String name,
  16.121 +		final String desc){
  16.122 +	mv.visitMethodInsn(opcode, owner, name, desc);
  16.123 +}
  16.124 +
  16.125 +public void visitJumpInsn(final int opcode, final Label label){
  16.126 +	mv.visitJumpInsn(opcode, label);
  16.127 +}
  16.128 +
  16.129 +public void visitLabel(final Label label){
  16.130 +	mv.visitLabel(label);
  16.131 +}
  16.132 +
  16.133 +public void visitLdcInsn(final Object cst){
  16.134 +	mv.visitLdcInsn(cst);
  16.135 +}
  16.136 +
  16.137 +public void visitIincInsn(final int var, final int increment){
  16.138 +	mv.visitIincInsn(var, increment);
  16.139 +}
  16.140 +
  16.141 +public void visitTableSwitchInsn(
  16.142 +		final int min,
  16.143 +		final int max,
  16.144 +		final Label dflt,
  16.145 +		final Label labels[]){
  16.146 +	mv.visitTableSwitchInsn(min, max, dflt, labels);
  16.147 +}
  16.148 +
  16.149 +public void visitLookupSwitchInsn(
  16.150 +		final Label dflt,
  16.151 +		final int keys[],
  16.152 +		final Label labels[]){
  16.153 +	mv.visitLookupSwitchInsn(dflt, keys, labels);
  16.154 +}
  16.155 +
  16.156 +public void visitMultiANewArrayInsn(final String desc, final int dims){
  16.157 +	mv.visitMultiANewArrayInsn(desc, dims);
  16.158 +}
  16.159 +
  16.160 +public void visitTryCatchBlock(
  16.161 +		final Label start,
  16.162 +		final Label end,
  16.163 +		final Label handler,
  16.164 +		final String type){
  16.165 +	mv.visitTryCatchBlock(start, end, handler, type);
  16.166 +}
  16.167 +
  16.168 +public void visitLocalVariable(
  16.169 +		final String name,
  16.170 +		final String desc,
  16.171 +		final String signature,
  16.172 +		final Label start,
  16.173 +		final Label end,
  16.174 +		final int index){
  16.175 +	mv.visitLocalVariable(name, desc, signature, start, end, index);
  16.176 +}
  16.177 +
  16.178 +public void visitLineNumber(final int line, final Label start){
  16.179 +	mv.visitLineNumber(line, start);
  16.180 +}
  16.181 +
  16.182 +public void visitMaxs(final int maxStack, final int maxLocals){
  16.183 +	mv.visitMaxs(maxStack, maxLocals);
  16.184 +}
  16.185 +
  16.186 +public void visitEnd(){
  16.187 +	mv.visitEnd();
  16.188 +}
  16.189 +}
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/clojure/asm/MethodVisitor.java	Sat Aug 21 06:25:44 2010 -0400
    17.3 @@ -0,0 +1,396 @@
    17.4 +/***
    17.5 + * ASM: a very small and fast Java bytecode manipulation framework
    17.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    17.7 + * All rights reserved.
    17.8 + *
    17.9 + * Redistribution and use in source and binary forms, with or without
   17.10 + * modification, are permitted provided that the following conditions
   17.11 + * are met:
   17.12 + * 1. Redistributions of source code must retain the above copyright
   17.13 + *    notice, this list of conditions and the following disclaimer.
   17.14 + * 2. Redistributions in binary form must reproduce the above copyright
   17.15 + *    notice, this list of conditions and the following disclaimer in the
   17.16 + *    documentation and/or other materials provided with the distribution.
   17.17 + * 3. Neither the name of the copyright holders nor the names of its
   17.18 + *    contributors may be used to endorse or promote products derived from
   17.19 + *    this software without specific prior written permission.
   17.20 + *
   17.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   17.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   17.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   17.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   17.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   17.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   17.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   17.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   17.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   17.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   17.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   17.32 + */
   17.33 +package clojure.asm;
   17.34 +
   17.35 +/**
   17.36 + * A visitor to visit a Java method. The methods of this interface must be
   17.37 + * called in the following order: [ <tt>visitAnnotationDefault</tt> ] (
   17.38 + * <tt>visitAnnotation</tt> | <tt>visitParameterAnnotation</tt> |
   17.39 + * <tt>visitAttribute</tt> )* [ <tt>visitCode</tt> ( <tt>visitFrame</tt> |
   17.40 + * <tt>visit</tt><i>X</i>Insn</tt> | <tt>visitLabel</tt> | <tt>visitTryCatchBlock</tt> |
   17.41 + * <tt>visitLocalVariable</tt> | <tt>visitLineNumber</tt>)* <tt>visitMaxs</tt> ]
   17.42 + * <tt>visitEnd</tt>. In addition, the <tt>visit</tt><i>X</i>Insn</tt>
   17.43 + * and <tt>visitLabel</tt> methods must be called in the sequential order of
   17.44 + * the bytecode instructions of the visited code, <tt>visitTryCatchBlock</tt>
   17.45 + * must be called <i>before</i> the labels passed as arguments have been
   17.46 + * visited, and the <tt>visitLocalVariable</tt> and <tt>visitLineNumber</tt>
   17.47 + * methods must be called <i>after</i> the labels passed as arguments have been
   17.48 + * visited.
   17.49 + *
   17.50 + * @author Eric Bruneton
   17.51 + */
   17.52 +public interface MethodVisitor{
   17.53 +
   17.54 +// -------------------------------------------------------------------------
   17.55 +// Annotations and non standard attributes
   17.56 +// -------------------------------------------------------------------------
   17.57 +
   17.58 +/**
   17.59 + * Visits the default value of this annotation interface method.
   17.60 + *
   17.61 + * @return a visitor to the visit the actual default value of this
   17.62 + *         annotation interface method, or <tt>null</tt> if this visitor
   17.63 + *         is not interested in visiting this default value. The 'name'
   17.64 + *         parameters passed to the methods of this annotation visitor are
   17.65 + *         ignored. Moreover, exacly one visit method must be called on this
   17.66 + *         annotation visitor, followed by visitEnd.
   17.67 + */
   17.68 +AnnotationVisitor visitAnnotationDefault();
   17.69 +
   17.70 +/**
   17.71 + * Visits an annotation of this method.
   17.72 + *
   17.73 + * @param desc    the class descriptor of the annotation class.
   17.74 + * @param visible <tt>true</tt> if the annotation is visible at runtime.
   17.75 + * @return a visitor to visit the annotation values, or <tt>null</tt> if
   17.76 + *         this visitor is not interested in visiting this annotation.
   17.77 + */
   17.78 +AnnotationVisitor visitAnnotation(String desc, boolean visible);
   17.79 +
   17.80 +/**
   17.81 + * Visits an annotation of a parameter this method.
   17.82 + *
   17.83 + * @param parameter the parameter index.
   17.84 + * @param desc      the class descriptor of the annotation class.
   17.85 + * @param visible   <tt>true</tt> if the annotation is visible at runtime.
   17.86 + * @return a visitor to visit the annotation values, or <tt>null</tt> if
   17.87 + *         this visitor is not interested in visiting this annotation.
   17.88 + */
   17.89 +AnnotationVisitor visitParameterAnnotation(
   17.90 +		int parameter,
   17.91 +		String desc,
   17.92 +		boolean visible);
   17.93 +
   17.94 +/**
   17.95 + * Visits a non standard attribute of this method.
   17.96 + *
   17.97 + * @param attr an attribute.
   17.98 + */
   17.99 +void visitAttribute(Attribute attr);
  17.100 +
  17.101 +/**
  17.102 + * Starts the visit of the method's code, if any (i.e. non abstract method).
  17.103 + */
  17.104 +void visitCode();
  17.105 +
  17.106 +/**
  17.107 + * Visits the current state of the local variables and operand stack
  17.108 + * elements. This method must(*) be called <i>just before</i> any
  17.109 + * instruction <b>i</b> that follows an unconditionnal branch instruction
  17.110 + * such as GOTO or THROW, that is the target of a jump instruction, or that
  17.111 + * starts an exception handler block. The visited types must describe the
  17.112 + * values of the local variables and of the operand stack elements <i>just
  17.113 + * before</i> <b>i</b> is executed. <br> <br> (*) this is mandatory only
  17.114 + * for classes whose version is greater than or equal to
  17.115 + * {@link Opcodes#V1_6 V1_6}. <br> <br> Packed frames are basically
  17.116 + * "deltas" from the state of the previous frame (very first frame is
  17.117 + * implicitly defined by the method's parameters and access flags): <ul>
  17.118 + * <li>{@link Opcodes#F_SAME} representing frame with exactly the same
  17.119 + * locals as the previous frame and with the empty stack.</li> <li>{@link Opcodes#F_SAME1}
  17.120 + * representing frame with exactly the same locals as the previous frame and
  17.121 + * with single value on the stack (<code>nStack</code> is 1 and
  17.122 + * <code>stack[0]</code> contains value for the type of the stack item).</li>
  17.123 + * <li>{@link Opcodes#F_APPEND} representing frame with current locals are
  17.124 + * the same as the locals in the previous frame, except that additional
  17.125 + * locals are defined (<code>nLocal</code> is 1, 2 or 3 and
  17.126 + * <code>local</code> elements contains values representing added types).</li>
  17.127 + * <li>{@link Opcodes#F_CHOP} representing frame with current locals are
  17.128 + * the same as the locals in the previous frame, except that the last 1-3
  17.129 + * locals are absent and with the empty stack (<code>nLocals</code> is 1,
  17.130 + * 2 or 3). </li> <li>{@link Opcodes#F_FULL} representing complete frame
  17.131 + * data.</li> </li> </ul>
  17.132 + *
  17.133 + * @param type   the type of this stack map frame. Must be
  17.134 + *               {@link Opcodes#F_NEW} for expanded frames, or
  17.135 + *               {@link Opcodes#F_FULL}, {@link Opcodes#F_APPEND},
  17.136 + *               {@link Opcodes#F_CHOP}, {@link Opcodes#F_SAME} or
  17.137 + *               {@link Opcodes#F_APPEND}, {@link Opcodes#F_SAME1} for compressed
  17.138 + *               frames.
  17.139 + * @param nLocal the number of local variables in the visited frame.
  17.140 + * @param local  the local variable types in this frame. This array must not
  17.141 + *               be modified. Primitive types are represented by
  17.142 + *               {@link Opcodes#TOP}, {@link Opcodes#INTEGER},
  17.143 + *               {@link Opcodes#FLOAT}, {@link Opcodes#LONG},
  17.144 + *               {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or
  17.145 + *               {@link Opcodes#UNINITIALIZED_THIS} (long and double are
  17.146 + *               represented by a single element). Reference types are represented
  17.147 + *               by String objects (representing internal names, or type
  17.148 + *               descriptors for array types), and uninitialized types by Label
  17.149 + *               objects (this label designates the NEW instruction that created
  17.150 + *               this uninitialized value).
  17.151 + * @param nStack the number of operand stack elements in the visited frame.
  17.152 + * @param stack  the operand stack types in this frame. This array must not
  17.153 + *               be modified. Its content has the same format as the "local" array.
  17.154 + */
  17.155 +void visitFrame(
  17.156 +		int type,
  17.157 +		int nLocal,
  17.158 +		Object[] local,
  17.159 +		int nStack,
  17.160 +		Object[] stack);
  17.161 +
  17.162 +// -------------------------------------------------------------------------
  17.163 +// Normal instructions
  17.164 +// -------------------------------------------------------------------------
  17.165 +
  17.166 +/**
  17.167 + * Visits a zero operand instruction.
  17.168 + *
  17.169 + * @param opcode the opcode of the instruction to be visited. This opcode is
  17.170 + *               either NOP, ACONST_NULL, ICONST_M1, ICONST_0, ICONST_1, ICONST_2,
  17.171 + *               ICONST_3, ICONST_4, ICONST_5, LCONST_0, LCONST_1, FCONST_0,
  17.172 + *               FCONST_1, FCONST_2, DCONST_0, DCONST_1, IALOAD, LALOAD, FALOAD,
  17.173 + *               DALOAD, AALOAD, BALOAD, CALOAD, SALOAD, IASTORE, LASTORE, FASTORE,
  17.174 + *               DASTORE, AASTORE, BASTORE, CASTORE, SASTORE, POP, POP2, DUP,
  17.175 + *               DUP_X1, DUP_X2, DUP2, DUP2_X1, DUP2_X2, SWAP, IADD, LADD, FADD,
  17.176 + *               DADD, ISUB, LSUB, FSUB, DSUB, IMUL, LMUL, FMUL, DMUL, IDIV, LDIV,
  17.177 + *               FDIV, DDIV, IREM, LREM, FREM, DREM, INEG, LNEG, FNEG, DNEG, ISHL,
  17.178 + *               LSHL, ISHR, LSHR, IUSHR, LUSHR, IAND, LAND, IOR, LOR, IXOR, LXOR,
  17.179 + *               I2L, I2F, I2D, L2I, L2F, L2D, F2I, F2L, F2D, D2I, D2L, D2F, I2B,
  17.180 + *               I2C, I2S, LCMP, FCMPL, FCMPG, DCMPL, DCMPG, IRETURN, LRETURN,
  17.181 + *               FRETURN, DRETURN, ARETURN, RETURN, ARRAYLENGTH, ATHROW,
  17.182 + *               MONITORENTER, or MONITOREXIT.
  17.183 + */
  17.184 +void visitInsn(int opcode);
  17.185 +
  17.186 +/**
  17.187 + * Visits an instruction with a single int operand.
  17.188 + *
  17.189 + * @param opcode  the opcode of the instruction to be visited. This opcode is
  17.190 + *                either BIPUSH, SIPUSH or NEWARRAY.
  17.191 + * @param operand the operand of the instruction to be visited.<br> When
  17.192 + *                opcode is BIPUSH, operand value should be between Byte.MIN_VALUE
  17.193 + *                and Byte.MAX_VALUE.<br> When opcode is SIPUSH, operand value
  17.194 + *                should be between Short.MIN_VALUE and Short.MAX_VALUE.<br> When
  17.195 + *                opcode is NEWARRAY, operand value should be one of
  17.196 + *                {@link Opcodes#T_BOOLEAN}, {@link Opcodes#T_CHAR},
  17.197 + *                {@link Opcodes#T_FLOAT}, {@link Opcodes#T_DOUBLE},
  17.198 + *                {@link Opcodes#T_BYTE}, {@link Opcodes#T_SHORT},
  17.199 + *                {@link Opcodes#T_INT} or {@link Opcodes#T_LONG}.
  17.200 + */
  17.201 +void visitIntInsn(int opcode, int operand);
  17.202 +
  17.203 +/**
  17.204 + * Visits a local variable instruction. A local variable instruction is an
  17.205 + * instruction that loads or stores the value of a local variable.
  17.206 + *
  17.207 + * @param opcode the opcode of the local variable instruction to be visited.
  17.208 + *               This opcode is either ILOAD, LLOAD, FLOAD, DLOAD, ALOAD, ISTORE,
  17.209 + *               LSTORE, FSTORE, DSTORE, ASTORE or RET.
  17.210 + * @param var    the operand of the instruction to be visited. This operand is
  17.211 + *               the index of a local variable.
  17.212 + */
  17.213 +void visitVarInsn(int opcode, int var);
  17.214 +
  17.215 +/**
  17.216 + * Visits a type instruction. A type instruction is an instruction that
  17.217 + * takes a type descriptor as parameter.
  17.218 + *
  17.219 + * @param opcode the opcode of the type instruction to be visited. This
  17.220 + *               opcode is either NEW, ANEWARRAY, CHECKCAST or INSTANCEOF.
  17.221 + * @param desc   the operand of the instruction to be visited. This operand is
  17.222 + *               must be a fully qualified class name in internal form, or the type
  17.223 + *               descriptor of an array type (see {@link Type Type}).
  17.224 + */
  17.225 +void visitTypeInsn(int opcode, String desc);
  17.226 +
  17.227 +/**
  17.228 + * Visits a field instruction. A field instruction is an instruction that
  17.229 + * loads or stores the value of a field of an object.
  17.230 + *
  17.231 + * @param opcode the opcode of the type instruction to be visited. This
  17.232 + *               opcode is either GETSTATIC, PUTSTATIC, GETFIELD or PUTFIELD.
  17.233 + * @param owner  the internal name of the field's owner class (see {@link
  17.234 + *               Type#getInternalName() getInternalName}).
  17.235 + * @param name   the field's name.
  17.236 + * @param desc   the field's descriptor (see {@link Type Type}).
  17.237 + */
  17.238 +void visitFieldInsn(int opcode, String owner, String name, String desc);
  17.239 +
  17.240 +/**
  17.241 + * Visits a method instruction. A method instruction is an instruction that
  17.242 + * invokes a method.
  17.243 + *
  17.244 + * @param opcode the opcode of the type instruction to be visited. This
  17.245 + *               opcode is either INVOKEVIRTUAL, INVOKESPECIAL, INVOKESTATIC or
  17.246 + *               INVOKEINTERFACE.
  17.247 + * @param owner  the internal name of the method's owner class (see {@link
  17.248 + *               Type#getInternalName() getInternalName}).
  17.249 + * @param name   the method's name.
  17.250 + * @param desc   the method's descriptor (see {@link Type Type}).
  17.251 + */
  17.252 +void visitMethodInsn(int opcode, String owner, String name, String desc);
  17.253 +
  17.254 +/**
  17.255 + * Visits a jump instruction. A jump instruction is an instruction that may
  17.256 + * jump to another instruction.
  17.257 + *
  17.258 + * @param opcode the opcode of the type instruction to be visited. This
  17.259 + *               opcode is either IFEQ, IFNE, IFLT, IFGE, IFGT, IFLE, IF_ICMPEQ,
  17.260 + *               IF_ICMPNE, IF_ICMPLT, IF_ICMPGE, IF_ICMPGT, IF_ICMPLE, IF_ACMPEQ,
  17.261 + *               IF_ACMPNE, GOTO, JSR, IFNULL or IFNONNULL.
  17.262 + * @param label  the operand of the instruction to be visited. This operand
  17.263 + *               is a label that designates the instruction to which the jump
  17.264 + *               instruction may jump.
  17.265 + */
  17.266 +void visitJumpInsn(int opcode, Label label);
  17.267 +
  17.268 +/**
  17.269 + * Visits a label. A label designates the instruction that will be visited
  17.270 + * just after it.
  17.271 + *
  17.272 + * @param label a {@link Label Label} object.
  17.273 + */
  17.274 +void visitLabel(Label label);
  17.275 +
  17.276 +// -------------------------------------------------------------------------
  17.277 +// Special instructions
  17.278 +// -------------------------------------------------------------------------
  17.279 +
  17.280 +/**
  17.281 + * Visits a LDC instruction.
  17.282 + *
  17.283 + * @param cst the constant to be loaded on the stack. This parameter must be
  17.284 + *            a non null {@link Integer}, a {@link Float}, a {@link Long}, a
  17.285 + *            {@link Double} a {@link String} (or a {@link Type} for
  17.286 + *            <tt>.class</tt> constants, for classes whose version is 49.0 or
  17.287 + *            more).
  17.288 + */
  17.289 +void visitLdcInsn(Object cst);
  17.290 +
  17.291 +/**
  17.292 + * Visits an IINC instruction.
  17.293 + *
  17.294 + * @param var       index of the local variable to be incremented.
  17.295 + * @param increment amount to increment the local variable by.
  17.296 + */
  17.297 +void visitIincInsn(int var, int increment);
  17.298 +
  17.299 +/**
  17.300 + * Visits a TABLESWITCH instruction.
  17.301 + *
  17.302 + * @param min    the minimum key value.
  17.303 + * @param max    the maximum key value.
  17.304 + * @param dflt   beginning of the default handler block.
  17.305 + * @param labels beginnings of the handler blocks. <tt>labels[i]</tt> is
  17.306 + *               the beginning of the handler block for the <tt>min + i</tt> key.
  17.307 + */
  17.308 +void visitTableSwitchInsn(int min, int max, Label dflt, Label labels[]);
  17.309 +
  17.310 +/**
  17.311 + * Visits a LOOKUPSWITCH instruction.
  17.312 + *
  17.313 + * @param dflt   beginning of the default handler block.
  17.314 + * @param keys   the values of the keys.
  17.315 + * @param labels beginnings of the handler blocks. <tt>labels[i]</tt> is
  17.316 + *               the beginning of the handler block for the <tt>keys[i]</tt> key.
  17.317 + */
  17.318 +void visitLookupSwitchInsn(Label dflt, int keys[], Label labels[]);
  17.319 +
  17.320 +/**
  17.321 + * Visits a MULTIANEWARRAY instruction.
  17.322 + *
  17.323 + * @param desc an array type descriptor (see {@link Type Type}).
  17.324 + * @param dims number of dimensions of the array to allocate.
  17.325 + */
  17.326 +void visitMultiANewArrayInsn(String desc, int dims);
  17.327 +
  17.328 +// -------------------------------------------------------------------------
  17.329 +// Exceptions table entries, debug information, max stack and max locals
  17.330 +// -------------------------------------------------------------------------
  17.331 +
  17.332 +/**
  17.333 + * Visits a try catch block.
  17.334 + *
  17.335 + * @param start   beginning of the exception handler's scope (inclusive).
  17.336 + * @param end     end of the exception handler's scope (exclusive).
  17.337 + * @param handler beginning of the exception handler's code.
  17.338 + * @param type    internal name of the type of exceptions handled by the
  17.339 + *                handler, or <tt>null</tt> to catch any exceptions (for "finally"
  17.340 + *                blocks).
  17.341 + * @throws IllegalArgumentException if one of the labels has already been
  17.342 + *                                  visited by this visitor (by the {@link #visitLabel visitLabel}
  17.343 + *                                  method).
  17.344 + */
  17.345 +void visitTryCatchBlock(Label start, Label end, Label handler, String type);
  17.346 +
  17.347 +/**
  17.348 + * Visits a local variable declaration.
  17.349 + *
  17.350 + * @param name      the name of a local variable.
  17.351 + * @param desc      the type descriptor of this local variable.
  17.352 + * @param signature the type signature of this local variable. May be
  17.353 + *                  <tt>null</tt> if the local variable type does not use generic
  17.354 + *                  types.
  17.355 + * @param start     the first instruction corresponding to the scope of this
  17.356 + *                  local variable (inclusive).
  17.357 + * @param end       the last instruction corresponding to the scope of this local
  17.358 + *                  variable (exclusive).
  17.359 + * @param index     the local variable's index.
  17.360 + * @throws IllegalArgumentException if one of the labels has not already
  17.361 + *                                  been visited by this visitor (by the
  17.362 + *                                  {@link #visitLabel visitLabel} method).
  17.363 + */
  17.364 +void visitLocalVariable(
  17.365 +		String name,
  17.366 +		String desc,
  17.367 +		String signature,
  17.368 +		Label start,
  17.369 +		Label end,
  17.370 +		int index);
  17.371 +
  17.372 +/**
  17.373 + * Visits a line number declaration.
  17.374 + *
  17.375 + * @param line  a line number. This number refers to the source file from
  17.376 + *              which the class was compiled.
  17.377 + * @param start the first instruction corresponding to this line number.
  17.378 + * @throws IllegalArgumentException if <tt>start</tt> has not already been
  17.379 + *                                  visited by this visitor (by the {@link #visitLabel visitLabel}
  17.380 + *                                  method).
  17.381 + */
  17.382 +void visitLineNumber(int line, Label start);
  17.383 +
  17.384 +/**
  17.385 + * Visits the maximum stack size and the maximum number of local variables
  17.386 + * of the method.
  17.387 + *
  17.388 + * @param maxStack  maximum stack size of the method.
  17.389 + * @param maxLocals maximum number of local variables for the method.
  17.390 + */
  17.391 +void visitMaxs(int maxStack, int maxLocals);
  17.392 +
  17.393 +/**
  17.394 + * Visits the end of the method. This method, which is the last one to be
  17.395 + * called, is used to inform the visitor that all the annotations and
  17.396 + * attributes of the method have been visited.
  17.397 + */
  17.398 +void visitEnd();
  17.399 +}
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/clojure/asm/MethodWriter.java	Sat Aug 21 06:25:44 2010 -0400
    18.3 @@ -0,0 +1,3029 @@
    18.4 +/***
    18.5 + * ASM: a very small and fast Java bytecode manipulation framework
    18.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    18.7 + * All rights reserved.
    18.8 + *
    18.9 + * Redistribution and use in source and binary forms, with or without
   18.10 + * modification, are permitted provided that the following conditions
   18.11 + * are met:
   18.12 + * 1. Redistributions of source code must retain the above copyright
   18.13 + *    notice, this list of conditions and the following disclaimer.
   18.14 + * 2. Redistributions in binary form must reproduce the above copyright
   18.15 + *    notice, this list of conditions and the following disclaimer in the
   18.16 + *    documentation and/or other materials provided with the distribution.
   18.17 + * 3. Neither the name of the copyright holders nor the names of its
   18.18 + *    contributors may be used to endorse or promote products derived from
   18.19 + *    this software without specific prior written permission.
   18.20 + *
   18.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   18.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   18.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   18.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   18.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   18.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   18.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   18.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   18.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   18.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   18.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   18.32 + */
   18.33 +package clojure.asm;
   18.34 +
   18.35 +/**
   18.36 + * A {@link MethodVisitor} that generates methods in bytecode form. Each visit
   18.37 + * method of this class appends the bytecode corresponding to the visited
   18.38 + * instruction to a byte vector, in the order these methods are called.
   18.39 + *
   18.40 + * @author Eric Bruneton
   18.41 + * @author Eugene Kuleshov
   18.42 + */
   18.43 +class MethodWriter implements MethodVisitor{
   18.44 +
   18.45 +/**
   18.46 + * Pseudo access flag used to denote constructors.
   18.47 + */
   18.48 +final static int ACC_CONSTRUCTOR = 262144;
   18.49 +
   18.50 +/**
   18.51 + * Frame has exactly the same locals as the previous stack map frame and
   18.52 + * number of stack items is zero.
   18.53 + */
   18.54 +final static int SAME_FRAME = 0; // to 63 (0-3f)
   18.55 +
   18.56 +/**
   18.57 + * Frame has exactly the same locals as the previous stack map frame and
   18.58 + * number of stack items is 1
   18.59 + */
   18.60 +final static int SAME_LOCALS_1_STACK_ITEM_FRAME = 64; // to 127 (40-7f)
   18.61 +
   18.62 +/**
   18.63 + * Reserved for future use
   18.64 + */
   18.65 +final static int RESERVED = 128;
   18.66 +
   18.67 +/**
   18.68 + * Frame has exactly the same locals as the previous stack map frame and
   18.69 + * number of stack items is 1. Offset is bigger then 63;
   18.70 + */
   18.71 +final static int SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED = 247; // f7
   18.72 +
   18.73 +/**
   18.74 + * Frame where current locals are the same as the locals in the previous
   18.75 + * frame, except that the k last locals are absent. The value of k is given
   18.76 + * by the formula 251-frame_type.
   18.77 + */
   18.78 +final static int CHOP_FRAME = 248; // to 250 (f8-fA)
   18.79 +
   18.80 +/**
   18.81 + * Frame has exactly the same locals as the previous stack map frame and
   18.82 + * number of stack items is zero. Offset is bigger then 63;
   18.83 + */
   18.84 +final static int SAME_FRAME_EXTENDED = 251; // fb
   18.85 +
   18.86 +/**
   18.87 + * Frame where current locals are the same as the locals in the previous
   18.88 + * frame, except that k additional locals are defined. The value of k is
   18.89 + * given by the formula frame_type-251.
   18.90 + */
   18.91 +final static int APPEND_FRAME = 252; // to 254 // fc-fe
   18.92 +
   18.93 +/**
   18.94 + * Full frame
   18.95 + */
   18.96 +final static int FULL_FRAME = 255; // ff
   18.97 +
   18.98 +/**
   18.99 + * Indicates that the stack map frames must be recomputed from scratch. In
  18.100 + * this case the maximum stack size and number of local variables is also
  18.101 + * recomputed from scratch.
  18.102 + *
  18.103 + * @see #compute
  18.104 + */
  18.105 +private final static int FRAMES = 0;
  18.106 +
  18.107 +/**
  18.108 + * Indicates that the maximum stack size and number of local variables must
  18.109 + * be automatically computed.
  18.110 + *
  18.111 + * @see #compute
  18.112 + */
  18.113 +private final static int MAXS = 1;
  18.114 +
  18.115 +/**
  18.116 + * Indicates that nothing must be automatically computed.
  18.117 + *
  18.118 + * @see #compute
  18.119 + */
  18.120 +private final static int NOTHING = 2;
  18.121 +
  18.122 +/**
  18.123 + * Next method writer (see {@link ClassWriter#firstMethod firstMethod}).
  18.124 + */
  18.125 +MethodWriter next;
  18.126 +
  18.127 +/**
  18.128 + * The class writer to which this method must be added.
  18.129 + */
  18.130 +ClassWriter cw;
  18.131 +
  18.132 +/**
  18.133 + * Access flags of this method.
  18.134 + */
  18.135 +private int access;
  18.136 +
  18.137 +/**
  18.138 + * The index of the constant pool item that contains the name of this
  18.139 + * method.
  18.140 + */
  18.141 +private int name;
  18.142 +
  18.143 +/**
  18.144 + * The index of the constant pool item that contains the descriptor of this
  18.145 + * method.
  18.146 + */
  18.147 +private int desc;
  18.148 +
  18.149 +/**
  18.150 + * The descriptor of this method.
  18.151 + */
  18.152 +private String descriptor;
  18.153 +
  18.154 +/**
  18.155 + * The signature of this method.
  18.156 + */
  18.157 +String signature;
  18.158 +
  18.159 +/**
  18.160 + * If not zero, indicates that the code of this method must be copied from
  18.161 + * the ClassReader associated to this writer in <code>cw.cr</code>. More
  18.162 + * precisely, this field gives the index of the first byte to copied from
  18.163 + * <code>cw.cr.b</code>.
  18.164 + */
  18.165 +int classReaderOffset;
  18.166 +
  18.167 +/**
  18.168 + * If not zero, indicates that the code of this method must be copied from
  18.169 + * the ClassReader associated to this writer in <code>cw.cr</code>. More
  18.170 + * precisely, this field gives the number of bytes to copied from
  18.171 + * <code>cw.cr.b</code>.
  18.172 + */
  18.173 +int classReaderLength;
  18.174 +
  18.175 +/**
  18.176 + * Number of exceptions that can be thrown by this method.
  18.177 + */
  18.178 +int exceptionCount;
  18.179 +
  18.180 +/**
  18.181 + * The exceptions that can be thrown by this method. More precisely, this
  18.182 + * array contains the indexes of the constant pool items that contain the
  18.183 + * internal names of these exception classes.
  18.184 + */
  18.185 +int[] exceptions;
  18.186 +
  18.187 +/**
  18.188 + * The annotation default attribute of this method. May be <tt>null</tt>.
  18.189 + */
  18.190 +private ByteVector annd;
  18.191 +
  18.192 +/**
  18.193 + * The runtime visible annotations of this method. May be <tt>null</tt>.
  18.194 + */
  18.195 +private AnnotationWriter anns;
  18.196 +
  18.197 +/**
  18.198 + * The runtime invisible annotations of this method. May be <tt>null</tt>.
  18.199 + */
  18.200 +private AnnotationWriter ianns;
  18.201 +
  18.202 +/**
  18.203 + * The runtime visible parameter annotations of this method. May be
  18.204 + * <tt>null</tt>.
  18.205 + */
  18.206 +private AnnotationWriter[] panns;
  18.207 +
  18.208 +/**
  18.209 + * The runtime invisible parameter annotations of this method. May be
  18.210 + * <tt>null</tt>.
  18.211 + */
  18.212 +private AnnotationWriter[] ipanns;
  18.213 +
  18.214 +/**
  18.215 + * The non standard attributes of the method.
  18.216 + */
  18.217 +private Attribute attrs;
  18.218 +
  18.219 +/**
  18.220 + * The bytecode of this method.
  18.221 + */
  18.222 +private ByteVector code = new ByteVector();
  18.223 +
  18.224 +/**
  18.225 + * Maximum stack size of this method.
  18.226 + */
  18.227 +private int maxStack;
  18.228 +
  18.229 +/**
  18.230 + * Maximum number of local variables for this method.
  18.231 + */
  18.232 +private int maxLocals;
  18.233 +
  18.234 +/**
  18.235 + * Number of stack map frames in the StackMapTable attribute.
  18.236 + */
  18.237 +private int frameCount;
  18.238 +
  18.239 +/**
  18.240 + * The StackMapTable attribute.
  18.241 + */
  18.242 +private ByteVector stackMap;
  18.243 +
  18.244 +/**
  18.245 + * The offset of the last frame that was written in the StackMapTable
  18.246 + * attribute.
  18.247 + */
  18.248 +private int previousFrameOffset;
  18.249 +
  18.250 +/**
  18.251 + * The last frame that was written in the StackMapTable attribute.
  18.252 + *
  18.253 + * @see #frame
  18.254 + */
  18.255 +private int[] previousFrame;
  18.256 +
  18.257 +/**
  18.258 + * Index of the next element to be added in {@link #frame}.
  18.259 + */
  18.260 +private int frameIndex;
  18.261 +
  18.262 +/**
  18.263 + * The current stack map frame. The first element contains the offset of the
  18.264 + * instruction to which the frame corresponds, the second element is the
  18.265 + * number of locals and the third one is the number of stack elements. The
  18.266 + * local variables start at index 3 and are followed by the operand stack
  18.267 + * values. In summary frame[0] = offset, frame[1] = nLocal, frame[2] =
  18.268 + * nStack, frame[3] = nLocal. All types are encoded as integers, with the
  18.269 + * same format as the one used in {@link Label}, but limited to BASE types.
  18.270 + */
  18.271 +private int[] frame;
  18.272 +
  18.273 +/**
  18.274 + * Number of elements in the exception handler list.
  18.275 + */
  18.276 +private int handlerCount;
  18.277 +
  18.278 +/**
  18.279 + * The first element in the exception handler list.
  18.280 + */
  18.281 +private Handler firstHandler;
  18.282 +
  18.283 +/**
  18.284 + * The last element in the exception handler list.
  18.285 + */
  18.286 +private Handler lastHandler;
  18.287 +
  18.288 +/**
  18.289 + * Number of entries in the LocalVariableTable attribute.
  18.290 + */
  18.291 +private int localVarCount;
  18.292 +
  18.293 +/**
  18.294 + * The LocalVariableTable attribute.
  18.295 + */
  18.296 +private ByteVector localVar;
  18.297 +
  18.298 +/**
  18.299 + * Number of entries in the LocalVariableTypeTable attribute.
  18.300 + */
  18.301 +private int localVarTypeCount;
  18.302 +
  18.303 +/**
  18.304 + * The LocalVariableTypeTable attribute.
  18.305 + */
  18.306 +private ByteVector localVarType;
  18.307 +
  18.308 +/**
  18.309 + * Number of entries in the LineNumberTable attribute.
  18.310 + */
  18.311 +private int lineNumberCount;
  18.312 +
  18.313 +/**
  18.314 + * The LineNumberTable attribute.
  18.315 + */
  18.316 +private ByteVector lineNumber;
  18.317 +
  18.318 +/**
  18.319 + * The non standard attributes of the method's code.
  18.320 + */
  18.321 +private Attribute cattrs;
  18.322 +
  18.323 +/**
  18.324 + * Indicates if some jump instructions are too small and need to be resized.
  18.325 + */
  18.326 +private boolean resize;
  18.327 +
  18.328 +/**
  18.329 + * Indicates if the instructions contain at least one JSR instruction.
  18.330 + */
  18.331 +private boolean jsr;
  18.332 +
  18.333 +// ------------------------------------------------------------------------
  18.334 +
  18.335 +/*
  18.336 +	 * Fields for the control flow graph analysis algorithm (used to compute the
  18.337 +	 * maximum stack size). A control flow graph contains one node per "basic
  18.338 +	 * block", and one edge per "jump" from one basic block to another. Each
  18.339 +	 * node (i.e., each basic block) is represented by the Label object that
  18.340 +	 * corresponds to the first instruction of this basic block. Each node also
  18.341 +	 * stores the list of its successors in the graph, as a linked list of Edge
  18.342 +	 * objects.
  18.343 +	 */
  18.344 +
  18.345 +/**
  18.346 + * Indicates what must be automatically computed.
  18.347 + *
  18.348 + * @see FRAMES
  18.349 + * @see MAXS
  18.350 + * @see NOTHING
  18.351 + */
  18.352 +private int compute;
  18.353 +
  18.354 +/**
  18.355 + * A list of labels. This list is the list of basic blocks in the method,
  18.356 + * i.e. a list of Label objects linked to each other by their
  18.357 + * {@link Label#successor} field, in the order they are visited by
  18.358 + * {@link visitLabel}, and starting with the first basic block.
  18.359 + */
  18.360 +private Label labels;
  18.361 +
  18.362 +/**
  18.363 + * The previous basic block.
  18.364 + */
  18.365 +private Label previousBlock;
  18.366 +
  18.367 +/**
  18.368 + * The current basic block.
  18.369 + */
  18.370 +private Label currentBlock;
  18.371 +
  18.372 +/**
  18.373 + * The (relative) stack size after the last visited instruction. This size
  18.374 + * is relative to the beginning of the current basic block, i.e., the true
  18.375 + * stack size after the last visited instruction is equal to the
  18.376 + * {@link Label#inputStackTop beginStackSize} of the current basic block
  18.377 + * plus <tt>stackSize</tt>.
  18.378 + */
  18.379 +private int stackSize;
  18.380 +
  18.381 +/**
  18.382 + * The (relative) maximum stack size after the last visited instruction.
  18.383 + * This size is relative to the beginning of the current basic block, i.e.,
  18.384 + * the true maximum stack size after the last visited instruction is equal
  18.385 + * to the {@link Label#inputStackTop beginStackSize} of the current basic
  18.386 + * block plus <tt>stackSize</tt>.
  18.387 + */
  18.388 +private int maxStackSize;
  18.389 +
  18.390 +// ------------------------------------------------------------------------
  18.391 +// Constructor
  18.392 +// ------------------------------------------------------------------------
  18.393 +
  18.394 +/**
  18.395 + * Constructs a new {@link MethodWriter}.
  18.396 + *
  18.397 + * @param cw            the class writer in which the method must be added.
  18.398 + * @param access        the method's access flags (see {@link Opcodes}).
  18.399 + * @param name          the method's name.
  18.400 + * @param desc          the method's descriptor (see {@link Type}).
  18.401 + * @param signature     the method's signature. May be <tt>null</tt>.
  18.402 + * @param exceptions    the internal names of the method's exceptions. May be
  18.403 + *                      <tt>null</tt>.
  18.404 + * @param computeMaxs   <tt>true</tt> if the maximum stack size and number
  18.405 + *                      of local variables must be automatically computed.
  18.406 + * @param computeFrames <tt>true</tt> if the stack map tables must be
  18.407 + *                      recomputed from scratch.
  18.408 + */
  18.409 +MethodWriter(
  18.410 +		final ClassWriter cw,
  18.411 +		final int access,
  18.412 +		final String name,
  18.413 +		final String desc,
  18.414 +		final String signature,
  18.415 +		final String[] exceptions,
  18.416 +		final boolean computeMaxs,
  18.417 +		final boolean computeFrames){
  18.418 +	if(cw.firstMethod == null)
  18.419 +		{
  18.420 +		cw.firstMethod = this;
  18.421 +		}
  18.422 +	else
  18.423 +		{
  18.424 +		cw.lastMethod.next = this;
  18.425 +		}
  18.426 +	cw.lastMethod = this;
  18.427 +	this.cw = cw;
  18.428 +	this.access = access;
  18.429 +	this.name = cw.newUTF8(name);
  18.430 +	this.desc = cw.newUTF8(desc);
  18.431 +	this.descriptor = desc;
  18.432 +	this.signature = signature;
  18.433 +	if(exceptions != null && exceptions.length > 0)
  18.434 +		{
  18.435 +		exceptionCount = exceptions.length;
  18.436 +		this.exceptions = new int[exceptionCount];
  18.437 +		for(int i = 0; i < exceptionCount; ++i)
  18.438 +			{
  18.439 +			this.exceptions[i] = cw.newClass(exceptions[i]);
  18.440 +			}
  18.441 +		}
  18.442 +	this.compute = computeFrames ? FRAMES : (computeMaxs ? MAXS : NOTHING);
  18.443 +	if(computeMaxs || computeFrames)
  18.444 +		{
  18.445 +		if(computeFrames && name.equals("<init>"))
  18.446 +			{
  18.447 +			this.access |= ACC_CONSTRUCTOR;
  18.448 +			}
  18.449 +		// updates maxLocals
  18.450 +		int size = getArgumentsAndReturnSizes(descriptor) >> 2;
  18.451 +		if((access & Opcodes.ACC_STATIC) != 0)
  18.452 +			{
  18.453 +			--size;
  18.454 +			}
  18.455 +		maxLocals = size;
  18.456 +		// creates and visits the label for the first basic block
  18.457 +		labels = new Label();
  18.458 +		labels.status |= Label.PUSHED;
  18.459 +		visitLabel(labels);
  18.460 +		}
  18.461 +}
  18.462 +
  18.463 +// ------------------------------------------------------------------------
  18.464 +// Implementation of the MethodVisitor interface
  18.465 +// ------------------------------------------------------------------------
  18.466 +
  18.467 +public AnnotationVisitor visitAnnotationDefault(){
  18.468 +	annd = new ByteVector();
  18.469 +	return new AnnotationWriter(cw, false, annd, null, 0);
  18.470 +}
  18.471 +
  18.472 +public AnnotationVisitor visitAnnotation(
  18.473 +		final String desc,
  18.474 +		final boolean visible){
  18.475 +	ByteVector bv = new ByteVector();
  18.476 +	// write type, and reserve space for values count
  18.477 +	bv.putShort(cw.newUTF8(desc)).putShort(0);
  18.478 +	AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2);
  18.479 +	if(visible)
  18.480 +		{
  18.481 +		aw.next = anns;
  18.482 +		anns = aw;
  18.483 +		}
  18.484 +	else
  18.485 +		{
  18.486 +		aw.next = ianns;
  18.487 +		ianns = aw;
  18.488 +		}
  18.489 +	return aw;
  18.490 +}
  18.491 +
  18.492 +public AnnotationVisitor visitParameterAnnotation(
  18.493 +		final int parameter,
  18.494 +		final String desc,
  18.495 +		final boolean visible){
  18.496 +	ByteVector bv = new ByteVector();
  18.497 +	// write type, and reserve space for values count
  18.498 +	bv.putShort(cw.newUTF8(desc)).putShort(0);
  18.499 +	AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2);
  18.500 +	if(visible)
  18.501 +		{
  18.502 +		if(panns == null)
  18.503 +			{
  18.504 +			panns = new AnnotationWriter[Type.getArgumentTypes(descriptor).length];
  18.505 +			}
  18.506 +		aw.next = panns[parameter];
  18.507 +		panns[parameter] = aw;
  18.508 +		}
  18.509 +	else
  18.510 +		{
  18.511 +		if(ipanns == null)
  18.512 +			{
  18.513 +			ipanns = new AnnotationWriter[Type.getArgumentTypes(descriptor).length];
  18.514 +			}
  18.515 +		aw.next = ipanns[parameter];
  18.516 +		ipanns[parameter] = aw;
  18.517 +		}
  18.518 +	return aw;
  18.519 +}
  18.520 +
  18.521 +public void visitAttribute(final Attribute attr){
  18.522 +	if(attr.isCodeAttribute())
  18.523 +		{
  18.524 +		attr.next = cattrs;
  18.525 +		cattrs = attr;
  18.526 +		}
  18.527 +	else
  18.528 +		{
  18.529 +		attr.next = attrs;
  18.530 +		attrs = attr;
  18.531 +		}
  18.532 +}
  18.533 +
  18.534 +public void visitCode(){
  18.535 +}
  18.536 +
  18.537 +public void visitFrame(
  18.538 +		final int type,
  18.539 +		final int nLocal,
  18.540 +		final Object[] local,
  18.541 +		final int nStack,
  18.542 +		final Object[] stack){
  18.543 +	if(compute == FRAMES)
  18.544 +		{
  18.545 +		return;
  18.546 +		}
  18.547 +
  18.548 +	if(type == Opcodes.F_NEW)
  18.549 +		{
  18.550 +		startFrame(code.length, nLocal, nStack);
  18.551 +		for(int i = 0; i < nLocal; ++i)
  18.552 +			{
  18.553 +			if(local[i] instanceof String)
  18.554 +				{
  18.555 +				frame[frameIndex++] = Frame.OBJECT
  18.556 +				                      | cw.addType((String) local[i]);
  18.557 +				}
  18.558 +			else if(local[i] instanceof Integer)
  18.559 +				{
  18.560 +				frame[frameIndex++] = ((Integer) local[i]).intValue();
  18.561 +				}
  18.562 +			else
  18.563 +				{
  18.564 +				frame[frameIndex++] = Frame.UNINITIALIZED
  18.565 +				                      | cw.addUninitializedType("",
  18.566 +				                                                ((Label) local[i]).position);
  18.567 +				}
  18.568 +			}
  18.569 +		for(int i = 0; i < nStack; ++i)
  18.570 +			{
  18.571 +			if(stack[i] instanceof String)
  18.572 +				{
  18.573 +				frame[frameIndex++] = Frame.OBJECT
  18.574 +				                      | cw.addType((String) stack[i]);
  18.575 +				}
  18.576 +			else if(stack[i] instanceof Integer)
  18.577 +				{
  18.578 +				frame[frameIndex++] = ((Integer) stack[i]).intValue();
  18.579 +				}
  18.580 +			else
  18.581 +				{
  18.582 +				frame[frameIndex++] = Frame.UNINITIALIZED
  18.583 +				                      | cw.addUninitializedType("",
  18.584 +				                                                ((Label) stack[i]).position);
  18.585 +				}
  18.586 +			}
  18.587 +		endFrame();
  18.588 +		}
  18.589 +	else
  18.590 +		{
  18.591 +		int delta;
  18.592 +		if(stackMap == null)
  18.593 +			{
  18.594 +			stackMap = new ByteVector();
  18.595 +			delta = code.length;
  18.596 +			}
  18.597 +		else
  18.598 +			{
  18.599 +			delta = code.length - previousFrameOffset - 1;
  18.600 +			}
  18.601 +
  18.602 +		switch(type)
  18.603 +			{
  18.604 +			case Opcodes.F_FULL:
  18.605 +				stackMap.putByte(FULL_FRAME)
  18.606 +						.putShort(delta)
  18.607 +						.putShort(nLocal);
  18.608 +				for(int i = 0; i < nLocal; ++i)
  18.609 +					{
  18.610 +					writeFrameType(local[i]);
  18.611 +					}
  18.612 +				stackMap.putShort(nStack);
  18.613 +				for(int i = 0; i < nStack; ++i)
  18.614 +					{
  18.615 +					writeFrameType(stack[i]);
  18.616 +					}
  18.617 +				break;
  18.618 +			case Opcodes.F_APPEND:
  18.619 +				stackMap.putByte(SAME_FRAME_EXTENDED + nLocal)
  18.620 +						.putShort(delta);
  18.621 +				for(int i = 0; i < nLocal; ++i)
  18.622 +					{
  18.623 +					writeFrameType(local[i]);
  18.624 +					}
  18.625 +				break;
  18.626 +			case Opcodes.F_CHOP:
  18.627 +				stackMap.putByte(SAME_FRAME_EXTENDED - nLocal)
  18.628 +						.putShort(delta);
  18.629 +				break;
  18.630 +			case Opcodes.F_SAME:
  18.631 +				if(delta < 64)
  18.632 +					{
  18.633 +					stackMap.putByte(delta);
  18.634 +					}
  18.635 +				else
  18.636 +					{
  18.637 +					stackMap.putByte(SAME_FRAME_EXTENDED).putShort(delta);
  18.638 +					}
  18.639 +				break;
  18.640 +			case Opcodes.F_SAME1:
  18.641 +				if(delta < 64)
  18.642 +					{
  18.643 +					stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME + delta);
  18.644 +					}
  18.645 +				else
  18.646 +					{
  18.647 +					stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED)
  18.648 +							.putShort(delta);
  18.649 +					}
  18.650 +				writeFrameType(stack[0]);
  18.651 +				break;
  18.652 +			}
  18.653 +
  18.654 +		previousFrameOffset = code.length;
  18.655 +		++frameCount;
  18.656 +		}
  18.657 +}
  18.658 +
  18.659 +public void visitInsn(final int opcode){
  18.660 +	// adds the instruction to the bytecode of the method
  18.661 +	code.putByte(opcode);
  18.662 +	// update currentBlock
  18.663 +	// Label currentBlock = this.currentBlock;
  18.664 +	if(currentBlock != null)
  18.665 +		{
  18.666 +		if(compute == FRAMES)
  18.667 +			{
  18.668 +			currentBlock.frame.execute(opcode, 0, null, null);
  18.669 +			}
  18.670 +		else
  18.671 +			{
  18.672 +			// updates current and max stack sizes
  18.673 +			int size = stackSize + Frame.SIZE[opcode];
  18.674 +			if(size > maxStackSize)
  18.675 +				{
  18.676 +				maxStackSize = size;
  18.677 +				}
  18.678 +			stackSize = size;
  18.679 +			}
  18.680 +		// if opcode == ATHROW or xRETURN, ends current block (no successor)
  18.681 +		if((opcode >= Opcodes.IRETURN && opcode <= Opcodes.RETURN)
  18.682 +		   || opcode == Opcodes.ATHROW)
  18.683 +			{
  18.684 +			noSuccessor();
  18.685 +			}
  18.686 +		}
  18.687 +}
  18.688 +
  18.689 +public void visitIntInsn(final int opcode, final int operand){
  18.690 +	// Label currentBlock = this.currentBlock;
  18.691 +	if(currentBlock != null)
  18.692 +		{
  18.693 +		if(compute == FRAMES)
  18.694 +			{
  18.695 +			currentBlock.frame.execute(opcode, operand, null, null);
  18.696 +			}
  18.697 +		else if(opcode != Opcodes.NEWARRAY)
  18.698 +			{
  18.699 +			// updates current and max stack sizes only for NEWARRAY
  18.700 +			// (stack size variation = 0 for BIPUSH or SIPUSH)
  18.701 +			int size = stackSize + 1;
  18.702 +			if(size > maxStackSize)
  18.703 +				{
  18.704 +				maxStackSize = size;
  18.705 +				}
  18.706 +			stackSize = size;
  18.707 +			}
  18.708 +		}
  18.709 +	// adds the instruction to the bytecode of the method
  18.710 +	if(opcode == Opcodes.SIPUSH)
  18.711 +		{
  18.712 +		code.put12(opcode, operand);
  18.713 +		}
  18.714 +	else
  18.715 +		{ // BIPUSH or NEWARRAY
  18.716 +		code.put11(opcode, operand);
  18.717 +		}
  18.718 +}
  18.719 +
  18.720 +public void visitVarInsn(final int opcode, final int var){
  18.721 +	// Label currentBlock = this.currentBlock;
  18.722 +	if(currentBlock != null)
  18.723 +		{
  18.724 +		if(compute == FRAMES)
  18.725 +			{
  18.726 +			currentBlock.frame.execute(opcode, var, null, null);
  18.727 +			}
  18.728 +		else
  18.729 +			{
  18.730 +			// updates current and max stack sizes
  18.731 +			if(opcode == Opcodes.RET)
  18.732 +				{
  18.733 +				// no stack change, but end of current block (no successor)
  18.734 +				currentBlock.status |= Label.RET;
  18.735 +				// save 'stackSize' here for future use
  18.736 +				// (see {@link #findSubroutineSuccessors})
  18.737 +				currentBlock.inputStackTop = stackSize;
  18.738 +				noSuccessor();
  18.739 +				}
  18.740 +			else
  18.741 +				{ // xLOAD or xSTORE
  18.742 +				int size = stackSize + Frame.SIZE[opcode];
  18.743 +				if(size > maxStackSize)
  18.744 +					{
  18.745 +					maxStackSize = size;
  18.746 +					}
  18.747 +				stackSize = size;
  18.748 +				}
  18.749 +			}
  18.750 +		}
  18.751 +	if(compute != NOTHING)
  18.752 +		{
  18.753 +		// updates max locals
  18.754 +		int n;
  18.755 +		if(opcode == Opcodes.LLOAD || opcode == Opcodes.DLOAD
  18.756 +		   || opcode == Opcodes.LSTORE || opcode == Opcodes.DSTORE)
  18.757 +			{
  18.758 +			n = var + 2;
  18.759 +			}
  18.760 +		else
  18.761 +			{
  18.762 +			n = var + 1;
  18.763 +			}
  18.764 +		if(n > maxLocals)
  18.765 +			{
  18.766 +			maxLocals = n;
  18.767 +			}
  18.768 +		}
  18.769 +	// adds the instruction to the bytecode of the method
  18.770 +	if(var < 4 && opcode != Opcodes.RET)
  18.771 +		{
  18.772 +		int opt;
  18.773 +		if(opcode < Opcodes.ISTORE)
  18.774 +			{
  18.775 +			/* ILOAD_0 */
  18.776 +			opt = 26 + ((opcode - Opcodes.ILOAD) << 2) + var;
  18.777 +			}
  18.778 +		else
  18.779 +			{
  18.780 +			/* ISTORE_0 */
  18.781 +			opt = 59 + ((opcode - Opcodes.ISTORE) << 2) + var;
  18.782 +			}
  18.783 +		code.putByte(opt);
  18.784 +		}
  18.785 +	else if(var >= 256)
  18.786 +		{
  18.787 +		code.putByte(196 /* WIDE */).put12(opcode, var);
  18.788 +		}
  18.789 +	else
  18.790 +		{
  18.791 +		code.put11(opcode, var);
  18.792 +		}
  18.793 +	if(opcode >= Opcodes.ISTORE && compute == FRAMES && handlerCount > 0)
  18.794 +		{
  18.795 +		visitLabel(new Label());
  18.796 +		}
  18.797 +}
  18.798 +
  18.799 +public void visitTypeInsn(final int opcode, final String desc){
  18.800 +	Item i = cw.newClassItem(desc);
  18.801 +	// Label currentBlock = this.currentBlock;
  18.802 +	if(currentBlock != null)
  18.803 +		{
  18.804 +		if(compute == FRAMES)
  18.805 +			{
  18.806 +			currentBlock.frame.execute(opcode, code.length, cw, i);
  18.807 +			}
  18.808 +		else if(opcode == Opcodes.NEW)
  18.809 +			{
  18.810 +			// updates current and max stack sizes only if opcode == NEW
  18.811 +			// (no stack change for ANEWARRAY, CHECKCAST, INSTANCEOF)
  18.812 +			int size = stackSize + 1;
  18.813 +			if(size > maxStackSize)
  18.814 +				{
  18.815 +				maxStackSize = size;
  18.816 +				}
  18.817 +			stackSize = size;
  18.818 +			}
  18.819 +		}
  18.820 +	// adds the instruction to the bytecode of the method
  18.821 +	code.put12(opcode, i.index);
  18.822 +}
  18.823 +
  18.824 +public void visitFieldInsn(
  18.825 +		final int opcode,
  18.826 +		final String owner,
  18.827 +		final String name,
  18.828 +		final String desc){
  18.829 +	Item i = cw.newFieldItem(owner, name, desc);
  18.830 +	// Label currentBlock = this.currentBlock;
  18.831 +	if(currentBlock != null)
  18.832 +		{
  18.833 +		if(compute == FRAMES)
  18.834 +			{
  18.835 +			currentBlock.frame.execute(opcode, 0, cw, i);
  18.836 +			}
  18.837 +		else
  18.838 +			{
  18.839 +			int size;
  18.840 +			// computes the stack size variation
  18.841 +			char c = desc.charAt(0);
  18.842 +			switch(opcode)
  18.843 +				{
  18.844 +				case Opcodes.GETSTATIC:
  18.845 +					size = stackSize + (c == 'D' || c == 'J' ? 2 : 1);
  18.846 +					break;
  18.847 +				case Opcodes.PUTSTATIC:
  18.848 +					size = stackSize + (c == 'D' || c == 'J' ? -2 : -1);
  18.849 +					break;
  18.850 +				case Opcodes.GETFIELD:
  18.851 +					size = stackSize + (c == 'D' || c == 'J' ? 1 : 0);
  18.852 +					break;
  18.853 +					// case Constants.PUTFIELD:
  18.854 +				default:
  18.855 +					size = stackSize + (c == 'D' || c == 'J' ? -3 : -2);
  18.856 +					break;
  18.857 +				}
  18.858 +			// updates current and max stack sizes
  18.859 +			if(size > maxStackSize)
  18.860 +				{
  18.861 +				maxStackSize = size;
  18.862 +				}
  18.863 +			stackSize = size;
  18.864 +			}
  18.865 +		}
  18.866 +	// adds the instruction to the bytecode of the method
  18.867 +	code.put12(opcode, i.index);
  18.868 +}
  18.869 +
  18.870 +public void visitMethodInsn(
  18.871 +		final int opcode,
  18.872 +		final String owner,
  18.873 +		final String name,
  18.874 +		final String desc){
  18.875 +	boolean itf = opcode == Opcodes.INVOKEINTERFACE;
  18.876 +	Item i = cw.newMethodItem(owner, name, desc, itf);
  18.877 +	int argSize = i.intVal;
  18.878 +	// Label currentBlock = this.currentBlock;
  18.879 +	if(currentBlock != null)
  18.880 +		{
  18.881 +		if(compute == FRAMES)
  18.882 +			{
  18.883 +			currentBlock.frame.execute(opcode, 0, cw, i);
  18.884 +			}
  18.885 +		else
  18.886 +			{
  18.887 +			/*
  18.888 +							 * computes the stack size variation. In order not to recompute
  18.889 +							 * several times this variation for the same Item, we use the
  18.890 +							 * intVal field of this item to store this variation, once it
  18.891 +							 * has been computed. More precisely this intVal field stores
  18.892 +							 * the sizes of the arguments and of the return value
  18.893 +							 * corresponding to desc.
  18.894 +							 */
  18.895 +			if(argSize == 0)
  18.896 +				{
  18.897 +				// the above sizes have not been computed yet,
  18.898 +				// so we compute them...
  18.899 +				argSize = getArgumentsAndReturnSizes(desc);
  18.900 +				// ... and we save them in order
  18.901 +				// not to recompute them in the future
  18.902 +				i.intVal = argSize;
  18.903 +				}
  18.904 +			int size;
  18.905 +			if(opcode == Opcodes.INVOKESTATIC)
  18.906 +				{
  18.907 +				size = stackSize - (argSize >> 2) + (argSize & 0x03) + 1;
  18.908 +				}
  18.909 +			else
  18.910 +				{
  18.911 +				size = stackSize - (argSize >> 2) + (argSize & 0x03);
  18.912 +				}
  18.913 +			// updates current and max stack sizes
  18.914 +			if(size > maxStackSize)
  18.915 +				{
  18.916 +				maxStackSize = size;
  18.917 +				}
  18.918 +			stackSize = size;
  18.919 +			}
  18.920 +		}
  18.921 +	// adds the instruction to the bytecode of the method
  18.922 +	if(itf)
  18.923 +		{
  18.924 +		if(argSize == 0)
  18.925 +			{
  18.926 +			argSize = getArgumentsAndReturnSizes(desc);
  18.927 +			i.intVal = argSize;
  18.928 +			}
  18.929 +		code.put12(Opcodes.INVOKEINTERFACE, i.index).put11(argSize >> 2, 0);
  18.930 +		}
  18.931 +	else
  18.932 +		{
  18.933 +		code.put12(opcode, i.index);
  18.934 +		}
  18.935 +}
  18.936 +
  18.937 +public void visitJumpInsn(final int opcode, final Label label){
  18.938 +	Label nextInsn = null;
  18.939 +	// Label currentBlock = this.currentBlock;
  18.940 +	if(currentBlock != null)
  18.941 +		{
  18.942 +		if(compute == FRAMES)
  18.943 +			{
  18.944 +			currentBlock.frame.execute(opcode, 0, null, null);
  18.945 +			// 'label' is the target of a jump instruction
  18.946 +			label.getFirst().status |= Label.TARGET;
  18.947 +			// adds 'label' as a successor of this basic block
  18.948 +			addSuccessor(Edge.NORMAL, label);
  18.949 +			if(opcode != Opcodes.GOTO)
  18.950 +				{
  18.951 +				// creates a Label for the next basic block
  18.952 +				nextInsn = new Label();
  18.953 +				}
  18.954 +			}
  18.955 +		else
  18.956 +			{
  18.957 +			if(opcode == Opcodes.JSR)
  18.958 +				{
  18.959 +				jsr = true;
  18.960 +				currentBlock.status |= Label.JSR;
  18.961 +				addSuccessor(stackSize + 1, label);
  18.962 +				// creates a Label for the next basic block
  18.963 +				nextInsn = new Label();
  18.964 +				/*
  18.965 +									 * note that, by construction in this method, a JSR block
  18.966 +									 * has at least two successors in the control flow graph:
  18.967 +									 * the first one leads the next instruction after the JSR,
  18.968 +									 * while the second one leads to the JSR target.
  18.969 +									 */
  18.970 +				}
  18.971 +			else
  18.972 +				{
  18.973 +				// updates current stack size (max stack size unchanged
  18.974 +				// because stack size variation always negative in this
  18.975 +				// case)
  18.976 +				stackSize += Frame.SIZE[opcode];
  18.977 +				addSuccessor(stackSize, label);
  18.978 +				}
  18.979 +			}
  18.980 +		}
  18.981 +	// adds the instruction to the bytecode of the method
  18.982 +	if((label.status & Label.RESOLVED) != 0
  18.983 +	   && label.position - code.length < Short.MIN_VALUE)
  18.984 +		{
  18.985 +		/*
  18.986 +					 * case of a backward jump with an offset < -32768. In this case we
  18.987 +					 * automatically replace GOTO with GOTO_W, JSR with JSR_W and IFxxx
  18.988 +					 * <l> with IFNOTxxx <l'> GOTO_W <l>, where IFNOTxxx is the
  18.989 +					 * "opposite" opcode of IFxxx (i.e., IFNE for IFEQ) and where <l'>
  18.990 +					 * designates the instruction just after the GOTO_W.
  18.991 +					 */
  18.992 +		if(opcode == Opcodes.GOTO)
  18.993 +			{
  18.994 +			code.putByte(200); // GOTO_W
  18.995 +			}
  18.996 +		else if(opcode == Opcodes.JSR)
  18.997 +			{
  18.998 +			code.putByte(201); // JSR_W
  18.999 +			}
 18.1000 +		else
 18.1001 +			{
 18.1002 +			// if the IF instruction is transformed into IFNOT GOTO_W the
 18.1003 +			// next instruction becomes the target of the IFNOT instruction
 18.1004 +			if(nextInsn != null)
 18.1005 +				{
 18.1006 +				nextInsn.status |= Label.TARGET;
 18.1007 +				}
 18.1008 +			code.putByte(opcode <= 166
 18.1009 +			             ? ((opcode + 1) ^ 1) - 1
 18.1010 +			             : opcode ^ 1);
 18.1011 +			code.putShort(8); // jump offset
 18.1012 +			code.putByte(200); // GOTO_W
 18.1013 +			}
 18.1014 +		label.put(this, code, code.length - 1, true);
 18.1015 +		}
 18.1016 +	else
 18.1017 +		{
 18.1018 +		/*
 18.1019 +					 * case of a backward jump with an offset >= -32768, or of a forward
 18.1020 +					 * jump with, of course, an unknown offset. In these cases we store
 18.1021 +					 * the offset in 2 bytes (which will be increased in
 18.1022 +					 * resizeInstructions, if needed).
 18.1023 +					 */
 18.1024 +		code.putByte(opcode);
 18.1025 +		label.put(this, code, code.length - 1, false);
 18.1026 +		}
 18.1027 +	if(currentBlock != null)
 18.1028 +		{
 18.1029 +		if(nextInsn != null)
 18.1030 +			{
 18.1031 +			// if the jump instruction is not a GOTO, the next instruction
 18.1032 +			// is also a successor of this instruction. Calling visitLabel
 18.1033 +			// adds the label of this next instruction as a successor of the
 18.1034 +			// current block, and starts a new basic block
 18.1035 +			visitLabel(nextInsn);
 18.1036 +			}
 18.1037 +		if(opcode == Opcodes.GOTO)
 18.1038 +			{
 18.1039 +			noSuccessor();
 18.1040 +			}
 18.1041 +		}
 18.1042 +}
 18.1043 +
 18.1044 +public void visitLabel(final Label label){
 18.1045 +	// resolves previous forward references to label, if any
 18.1046 +	resize |= label.resolve(this, code.length, code.data);
 18.1047 +	// updates currentBlock
 18.1048 +	if((label.status & Label.DEBUG) != 0)
 18.1049 +		{
 18.1050 +		return;
 18.1051 +		}
 18.1052 +	if(compute == FRAMES)
 18.1053 +		{
 18.1054 +		if(currentBlock != null)
 18.1055 +			{
 18.1056 +			if(label.position == currentBlock.position)
 18.1057 +				{
 18.1058 +				// successive labels, do not start a new basic block
 18.1059 +				currentBlock.status |= (label.status & Label.TARGET);
 18.1060 +				label.frame = currentBlock.frame;
 18.1061 +				return;
 18.1062 +				}
 18.1063 +			// ends current block (with one new successor)
 18.1064 +			addSuccessor(Edge.NORMAL, label);
 18.1065 +			}
 18.1066 +		// begins a new current block
 18.1067 +		currentBlock = label;
 18.1068 +		if(label.frame == null)
 18.1069 +			{
 18.1070 +			label.frame = new Frame();
 18.1071 +			label.frame.owner = label;
 18.1072 +			}
 18.1073 +		// updates the basic block list
 18.1074 +		if(previousBlock != null)
 18.1075 +			{
 18.1076 +			if(label.position == previousBlock.position)
 18.1077 +				{
 18.1078 +				previousBlock.status |= (label.status & Label.TARGET);
 18.1079 +				label.frame = previousBlock.frame;
 18.1080 +				currentBlock = previousBlock;
 18.1081 +				return;
 18.1082 +				}
 18.1083 +			previousBlock.successor = label;
 18.1084 +			}
 18.1085 +		previousBlock = label;
 18.1086 +		}
 18.1087 +	else if(compute == MAXS)
 18.1088 +		{
 18.1089 +		if(currentBlock != null)
 18.1090 +			{
 18.1091 +			// ends current block (with one new successor)
 18.1092 +			currentBlock.outputStackMax = maxStackSize;
 18.1093 +			addSuccessor(stackSize, label);
 18.1094 +			}
 18.1095 +		// begins a new current block
 18.1096 +		currentBlock = label;
 18.1097 +		// resets the relative current and max stack sizes
 18.1098 +		stackSize = 0;
 18.1099 +		maxStackSize = 0;
 18.1100 +		// updates the basic block list
 18.1101 +		if(previousBlock != null)
 18.1102 +			{
 18.1103 +			previousBlock.successor = label;
 18.1104 +			}
 18.1105 +		previousBlock = label;
 18.1106 +		}
 18.1107 +}
 18.1108 +
 18.1109 +public void visitLdcInsn(final Object cst){
 18.1110 +	Item i = cw.newConstItem(cst);
 18.1111 +	// Label currentBlock = this.currentBlock;
 18.1112 +	if(currentBlock != null)
 18.1113 +		{
 18.1114 +		if(compute == FRAMES)
 18.1115 +			{
 18.1116 +			currentBlock.frame.execute(Opcodes.LDC, 0, cw, i);
 18.1117 +			}
 18.1118 +		else
 18.1119 +			{
 18.1120 +			int size;
 18.1121 +			// computes the stack size variation
 18.1122 +			if(i.type == ClassWriter.LONG || i.type == ClassWriter.DOUBLE)
 18.1123 +				{
 18.1124 +				size = stackSize + 2;
 18.1125 +				}
 18.1126 +			else
 18.1127 +				{
 18.1128 +				size = stackSize + 1;
 18.1129 +				}
 18.1130 +			// updates current and max stack sizes
 18.1131 +			if(size > maxStackSize)
 18.1132 +				{
 18.1133 +				maxStackSize = size;
 18.1134 +				}
 18.1135 +			stackSize = size;
 18.1136 +			}
 18.1137 +		}
 18.1138 +	// adds the instruction to the bytecode of the method
 18.1139 +	int index = i.index;
 18.1140 +	if(i.type == ClassWriter.LONG || i.type == ClassWriter.DOUBLE)
 18.1141 +		{
 18.1142 +		code.put12(20 /* LDC2_W */, index);
 18.1143 +		}
 18.1144 +	else if(index >= 256)
 18.1145 +		{
 18.1146 +		code.put12(19 /* LDC_W */, index);
 18.1147 +		}
 18.1148 +	else
 18.1149 +		{
 18.1150 +		code.put11(Opcodes.LDC, index);
 18.1151 +		}
 18.1152 +}
 18.1153 +
 18.1154 +public void visitIincInsn(final int var, final int increment){
 18.1155 +	if(currentBlock != null)
 18.1156 +		{
 18.1157 +		if(compute == FRAMES)
 18.1158 +			{
 18.1159 +			currentBlock.frame.execute(Opcodes.IINC, var, null, null);
 18.1160 +			}
 18.1161 +		}
 18.1162 +	if(compute != NOTHING)
 18.1163 +		{
 18.1164 +		// updates max locals
 18.1165 +		int n = var + 1;
 18.1166 +		if(n > maxLocals)
 18.1167 +			{
 18.1168 +			maxLocals = n;
 18.1169 +			}
 18.1170 +		}
 18.1171 +	// adds the instruction to the bytecode of the method
 18.1172 +	if((var > 255) || (increment > 127) || (increment < -128))
 18.1173 +		{
 18.1174 +		code.putByte(196 /* WIDE */)
 18.1175 +				.put12(Opcodes.IINC, var)
 18.1176 +				.putShort(increment);
 18.1177 +		}
 18.1178 +	else
 18.1179 +		{
 18.1180 +		code.putByte(Opcodes.IINC).put11(var, increment);
 18.1181 +		}
 18.1182 +}
 18.1183 +
 18.1184 +public void visitTableSwitchInsn(
 18.1185 +		final int min,
 18.1186 +		final int max,
 18.1187 +		final Label dflt,
 18.1188 +		final Label labels[]){
 18.1189 +	// adds the instruction to the bytecode of the method
 18.1190 +	int source = code.length;
 18.1191 +	code.putByte(Opcodes.TABLESWITCH);
 18.1192 +	code.length += (4 - code.length % 4) % 4;
 18.1193 +	dflt.put(this, code, source, true);
 18.1194 +	code.putInt(min).putInt(max);
 18.1195 +	for(int i = 0; i < labels.length; ++i)
 18.1196 +		{
 18.1197 +		labels[i].put(this, code, source, true);
 18.1198 +		}
 18.1199 +	// updates currentBlock
 18.1200 +	visitSwitchInsn(dflt, labels);
 18.1201 +}
 18.1202 +
 18.1203 +public void visitLookupSwitchInsn(
 18.1204 +		final Label dflt,
 18.1205 +		final int keys[],
 18.1206 +		final Label labels[]){
 18.1207 +	// adds the instruction to the bytecode of the method
 18.1208 +	int source = code.length;
 18.1209 +	code.putByte(Opcodes.LOOKUPSWITCH);
 18.1210 +	code.length += (4 - code.length % 4) % 4;
 18.1211 +	dflt.put(this, code, source, true);
 18.1212 +	code.putInt(labels.length);
 18.1213 +	for(int i = 0; i < labels.length; ++i)
 18.1214 +		{
 18.1215 +		code.putInt(keys[i]);
 18.1216 +		labels[i].put(this, code, source, true);
 18.1217 +		}
 18.1218 +	// updates currentBlock
 18.1219 +	visitSwitchInsn(dflt, labels);
 18.1220 +}
 18.1221 +
 18.1222 +private void visitSwitchInsn(final Label dflt, final Label[] labels){
 18.1223 +	// Label currentBlock = this.currentBlock;
 18.1224 +	if(currentBlock != null)
 18.1225 +		{
 18.1226 +		if(compute == FRAMES)
 18.1227 +			{
 18.1228 +			currentBlock.frame.execute(Opcodes.LOOKUPSWITCH, 0, null, null);
 18.1229 +			// adds current block successors
 18.1230 +			addSuccessor(Edge.NORMAL, dflt);
 18.1231 +			dflt.getFirst().status |= Label.TARGET;
 18.1232 +			for(int i = 0; i < labels.length; ++i)
 18.1233 +				{
 18.1234 +				addSuccessor(Edge.NORMAL, labels[i]);
 18.1235 +				labels[i].getFirst().status |= Label.TARGET;
 18.1236 +				}
 18.1237 +			}
 18.1238 +		else
 18.1239 +			{
 18.1240 +			// updates current stack size (max stack size unchanged)
 18.1241 +			--stackSize;
 18.1242 +			// adds current block successors
 18.1243 +			addSuccessor(stackSize, dflt);
 18.1244 +			for(int i = 0; i < labels.length; ++i)
 18.1245 +				{
 18.1246 +				addSuccessor(stackSize, labels[i]);
 18.1247 +				}
 18.1248 +			}
 18.1249 +		// ends current block
 18.1250 +		noSuccessor();
 18.1251 +		}
 18.1252 +}
 18.1253 +
 18.1254 +public void visitMultiANewArrayInsn(final String desc, final int dims){
 18.1255 +	Item i = cw.newClassItem(desc);
 18.1256 +	// Label currentBlock = this.currentBlock;
 18.1257 +	if(currentBlock != null)
 18.1258 +		{
 18.1259 +		if(compute == FRAMES)
 18.1260 +			{
 18.1261 +			currentBlock.frame.execute(Opcodes.MULTIANEWARRAY, dims, cw, i);
 18.1262 +			}
 18.1263 +		else
 18.1264 +			{
 18.1265 +			// updates current stack size (max stack size unchanged because
 18.1266 +			// stack size variation always negative or null)
 18.1267 +			stackSize += 1 - dims;
 18.1268 +			}
 18.1269 +		}
 18.1270 +	// adds the instruction to the bytecode of the method
 18.1271 +	code.put12(Opcodes.MULTIANEWARRAY, i.index).putByte(dims);
 18.1272 +}
 18.1273 +
 18.1274 +public void visitTryCatchBlock(
 18.1275 +		final Label start,
 18.1276 +		final Label end,
 18.1277 +		final Label handler,
 18.1278 +		final String type){
 18.1279 +	++handlerCount;
 18.1280 +	Handler h = new Handler();
 18.1281 +	h.start = start;
 18.1282 +	h.end = end;
 18.1283 +	h.handler = handler;
 18.1284 +	h.desc = type;
 18.1285 +	h.type = type != null ? cw.newClass(type) : 0;
 18.1286 +	if(lastHandler == null)
 18.1287 +		{
 18.1288 +		firstHandler = h;
 18.1289 +		}
 18.1290 +	else
 18.1291 +		{
 18.1292 +		lastHandler.next = h;
 18.1293 +		}
 18.1294 +	lastHandler = h;
 18.1295 +}
 18.1296 +
 18.1297 +public void visitLocalVariable(
 18.1298 +		final String name,
 18.1299 +		final String desc,
 18.1300 +		final String signature,
 18.1301 +		final Label start,
 18.1302 +		final Label end,
 18.1303 +		final int index){
 18.1304 +	if(signature != null)
 18.1305 +		{
 18.1306 +		if(localVarType == null)
 18.1307 +			{
 18.1308 +			localVarType = new ByteVector();
 18.1309 +			}
 18.1310 +		++localVarTypeCount;
 18.1311 +		localVarType.putShort(start.position)
 18.1312 +				.putShort(end.position - start.position)
 18.1313 +				.putShort(cw.newUTF8(name))
 18.1314 +				.putShort(cw.newUTF8(signature))
 18.1315 +				.putShort(index);
 18.1316 +		}
 18.1317 +	if(localVar == null)
 18.1318 +		{
 18.1319 +		localVar = new ByteVector();
 18.1320 +		}
 18.1321 +	++localVarCount;
 18.1322 +	localVar.putShort(start.position)
 18.1323 +			.putShort(end.position - start.position)
 18.1324 +			.putShort(cw.newUTF8(name))
 18.1325 +			.putShort(cw.newUTF8(desc))
 18.1326 +			.putShort(index);
 18.1327 +	if(compute != NOTHING)
 18.1328 +		{
 18.1329 +		// updates max locals
 18.1330 +		char c = desc.charAt(0);
 18.1331 +		int n = index + (c == 'J' || c == 'D' ? 2 : 1);
 18.1332 +		if(n > maxLocals)
 18.1333 +			{
 18.1334 +			maxLocals = n;
 18.1335 +			}
 18.1336 +		}
 18.1337 +}
 18.1338 +
 18.1339 +public void visitLineNumber(final int line, final Label start){
 18.1340 +	if(lineNumber == null)
 18.1341 +		{
 18.1342 +		lineNumber = new ByteVector();
 18.1343 +		}
 18.1344 +	++lineNumberCount;
 18.1345 +	lineNumber.putShort(start.position);
 18.1346 +	lineNumber.putShort(line);
 18.1347 +}
 18.1348 +
 18.1349 +public void visitMaxs(final int maxStack, final int maxLocals){
 18.1350 +	if(compute == FRAMES)
 18.1351 +		{
 18.1352 +		// completes the control flow graph with exception handler blocks
 18.1353 +		Handler handler = firstHandler;
 18.1354 +		while(handler != null)
 18.1355 +			{
 18.1356 +			Label l = handler.start.getFirst();
 18.1357 +			Label h = handler.handler.getFirst();
 18.1358 +			Label e = handler.end.getFirst();
 18.1359 +			// computes the kind of the edges to 'h'
 18.1360 +			String t = handler.desc == null
 18.1361 +			           ? "java/lang/Throwable"
 18.1362 +			           : handler.desc;
 18.1363 +			int kind = Frame.OBJECT | cw.addType(t);
 18.1364 +			// h is an exception handler
 18.1365 +			h.status |= Label.TARGET;
 18.1366 +			// adds 'h' as a successor of labels between 'start' and 'end'
 18.1367 +			while(l != e)
 18.1368 +				{
 18.1369 +				// creates an edge to 'h'
 18.1370 +				Edge b = new Edge();
 18.1371 +				b.info = kind;
 18.1372 +				b.successor = h;
 18.1373 +				// adds it to the successors of 'l'
 18.1374 +				b.next = l.successors;
 18.1375 +				l.successors = b;
 18.1376 +				// goes to the next label
 18.1377 +				l = l.successor;
 18.1378 +				}
 18.1379 +			handler = handler.next;
 18.1380 +			}
 18.1381 +
 18.1382 +		// creates and visits the first (implicit) frame
 18.1383 +		Frame f = labels.frame;
 18.1384 +		Type[] args = Type.getArgumentTypes(descriptor);
 18.1385 +		f.initInputFrame(cw, access, args, this.maxLocals);
 18.1386 +		visitFrame(f);
 18.1387 +
 18.1388 +		/*
 18.1389 +					 * fix point algorithm: mark the first basic block as 'changed'
 18.1390 +					 * (i.e. put it in the 'changed' list) and, while there are changed
 18.1391 +					 * basic blocks, choose one, mark it as unchanged, and update its
 18.1392 +					 * successors (which can be changed in the process).
 18.1393 +					 */
 18.1394 +		int max = 0;
 18.1395 +		Label changed = labels;
 18.1396 +		while(changed != null)
 18.1397 +			{
 18.1398 +			// removes a basic block from the list of changed basic blocks
 18.1399 +			Label l = changed;
 18.1400 +			changed = changed.next;
 18.1401 +			l.next = null;
 18.1402 +			f = l.frame;
 18.1403 +			// a reacheable jump target must be stored in the stack map
 18.1404 +			if((l.status & Label.TARGET) != 0)
 18.1405 +				{
 18.1406 +				l.status |= Label.STORE;
 18.1407 +				}
 18.1408 +			// all visited labels are reacheable, by definition
 18.1409 +			l.status |= Label.REACHABLE;
 18.1410 +			// updates the (absolute) maximum stack size
 18.1411 +			int blockMax = f.inputStack.length + l.outputStackMax;
 18.1412 +			if(blockMax > max)
 18.1413 +				{
 18.1414 +				max = blockMax;
 18.1415 +				}
 18.1416 +			// updates the successors of the current basic block
 18.1417 +			Edge e = l.successors;
 18.1418 +			while(e != null)
 18.1419 +				{
 18.1420 +				Label n = e.successor.getFirst();
 18.1421 +				boolean change = f.merge(cw, n.frame, e.info);
 18.1422 +				if(change && n.next == null)
 18.1423 +					{
 18.1424 +					// if n has changed and is not already in the 'changed'
 18.1425 +					// list, adds it to this list
 18.1426 +					n.next = changed;
 18.1427 +					changed = n;
 18.1428 +					}
 18.1429 +				e = e.next;
 18.1430 +				}
 18.1431 +			}
 18.1432 +		this.maxStack = max;
 18.1433 +
 18.1434 +		// visits all the frames that must be stored in the stack map
 18.1435 +		Label l = labels;
 18.1436 +		while(l != null)
 18.1437 +			{
 18.1438 +			f = l.frame;
 18.1439 +			if((l.status & Label.STORE) != 0)
 18.1440 +				{
 18.1441 +				visitFrame(f);
 18.1442 +				}
 18.1443 +			if((l.status & Label.REACHABLE) == 0)
 18.1444 +				{
 18.1445 +				// finds start and end of dead basic block
 18.1446 +				Label k = l.successor;
 18.1447 +				int start = l.position;
 18.1448 +				int end = (k == null ? code.length : k.position) - 1;
 18.1449 +				// if non empty basic block
 18.1450 +				if(end >= start)
 18.1451 +					{
 18.1452 +					// replaces instructions with NOP ... NOP ATHROW
 18.1453 +					for(int i = start; i < end; ++i)
 18.1454 +						{
 18.1455 +						code.data[i] = Opcodes.NOP;
 18.1456 +						}
 18.1457 +					code.data[end] = (byte) Opcodes.ATHROW;
 18.1458 +					// emits a frame for this unreachable block
 18.1459 +					startFrame(start, 0, 1);
 18.1460 +					frame[frameIndex++] = Frame.OBJECT
 18.1461 +					                      | cw.addType("java/lang/Throwable");
 18.1462 +					endFrame();
 18.1463 +					}
 18.1464 +				}
 18.1465 +			l = l.successor;
 18.1466 +			}
 18.1467 +		}
 18.1468 +	else if(compute == MAXS)
 18.1469 +		{
 18.1470 +		// completes the control flow graph with exception handler blocks
 18.1471 +		Handler handler = firstHandler;
 18.1472 +		while(handler != null)
 18.1473 +			{
 18.1474 +			Label l = handler.start;
 18.1475 +			Label h = handler.handler;
 18.1476 +			Label e = handler.end;
 18.1477 +			// adds 'h' as a successor of labels between 'start' and 'end'
 18.1478 +			while(l != e)
 18.1479 +				{
 18.1480 +				// creates an edge to 'h'
 18.1481 +				Edge b = new Edge();
 18.1482 +				b.info = Edge.EXCEPTION;
 18.1483 +				b.successor = h;
 18.1484 +				// adds it to the successors of 'l'
 18.1485 +				if((l.status & Label.JSR) != 0)
 18.1486 +					{
 18.1487 +					// if l is a JSR block, adds b after the first two edges
 18.1488 +					// to preserve the hypothesis about JSR block successors
 18.1489 +					// order (see {@link #visitJumpInsn})
 18.1490 +					b.next = l.successors.next.next;
 18.1491 +					l.successors.next.next = b;
 18.1492 +					}
 18.1493 +				else
 18.1494 +					{
 18.1495 +					b.next = l.successors;
 18.1496 +					l.successors = b;
 18.1497 +					}
 18.1498 +				// goes to the next label
 18.1499 +				l = l.successor;
 18.1500 +				}
 18.1501 +			handler = handler.next;
 18.1502 +			}
 18.1503 +
 18.1504 +		if(jsr)
 18.1505 +			{
 18.1506 +			// completes the control flow graph with the RET successors
 18.1507 +			/*
 18.1508 +							 * first step: finds the subroutines. This step determines, for
 18.1509 +							 * each basic block, to which subroutine(s) it belongs, and
 18.1510 +							 * stores this set as a bit set in the {@link Label#status}
 18.1511 +							 * field. Subroutines are numbered with powers of two, from
 18.1512 +							 * 0x1000 to 0x80000000 (so there must be at most 20 subroutines
 18.1513 +							 * in a method).
 18.1514 +							 */
 18.1515 +			// finds the basic blocks that belong to the "main" subroutine
 18.1516 +			int id = 0x1000;
 18.1517 +			findSubroutine(labels, id);
 18.1518 +			// finds the basic blocks that belong to the real subroutines
 18.1519 +			Label l = labels;
 18.1520 +			while(l != null)
 18.1521 +				{
 18.1522 +				if((l.status & Label.JSR) != 0)
 18.1523 +					{
 18.1524 +					// the subroutine is defined by l's TARGET, not by l
 18.1525 +					Label subroutine = l.successors.next.successor;
 18.1526 +					// if this subroutine does not have an id yet...
 18.1527 +					if((subroutine.status & ~0xFFF) == 0)
 18.1528 +						{
 18.1529 +						// ...assigns it a new id and finds its basic blocks
 18.1530 +						id = id << 1;
 18.1531 +						findSubroutine(subroutine, id);
 18.1532 +						}
 18.1533 +					}
 18.1534 +				l = l.successor;
 18.1535 +				}
 18.1536 +			// second step: finds the successors of RET blocks
 18.1537 +			findSubroutineSuccessors(0x1000, new Label[10], 0);
 18.1538 +			}
 18.1539 +
 18.1540 +		/*
 18.1541 +					 * control flow analysis algorithm: while the block stack is not
 18.1542 +					 * empty, pop a block from this stack, update the max stack size,
 18.1543 +					 * compute the true (non relative) begin stack size of the
 18.1544 +					 * successors of this block, and push these successors onto the
 18.1545 +					 * stack (unless they have already been pushed onto the stack).
 18.1546 +					 * Note: by hypothesis, the {@link Label#inputStackTop} of the
 18.1547 +					 * blocks in the block stack are the true (non relative) beginning
 18.1548 +					 * stack sizes of these blocks.
 18.1549 +					 */
 18.1550 +		int max = 0;
 18.1551 +		Label stack = labels;
 18.1552 +		while(stack != null)
 18.1553 +			{
 18.1554 +			// pops a block from the stack
 18.1555 +			Label l = stack;
 18.1556 +			stack = stack.next;
 18.1557 +			// computes the true (non relative) max stack size of this block
 18.1558 +			int start = l.inputStackTop;
 18.1559 +			int blockMax = start + l.outputStackMax;
 18.1560 +			// updates the global max stack size
 18.1561 +			if(blockMax > max)
 18.1562 +				{
 18.1563 +				max = blockMax;
 18.1564 +				}
 18.1565 +			// analyses the successors of the block
 18.1566 +			Edge b = l.successors;
 18.1567 +			if((l.status & Label.JSR) != 0)
 18.1568 +				{
 18.1569 +				// ignores the first edge of JSR blocks (virtual successor)
 18.1570 +				b = b.next;
 18.1571 +				}
 18.1572 +			while(b != null)
 18.1573 +				{
 18.1574 +				l = b.successor;
 18.1575 +				// if this successor has not already been pushed...
 18.1576 +				if((l.status & Label.PUSHED) == 0)
 18.1577 +					{
 18.1578 +					// computes its true beginning stack size...
 18.1579 +					l.inputStackTop = b.info == Edge.EXCEPTION ? 1 : start
 18.1580 +					                                                 + b.info;
 18.1581 +					// ...and pushes it onto the stack
 18.1582 +					l.status |= Label.PUSHED;
 18.1583 +					l.next = stack;
 18.1584 +					stack = l;
 18.1585 +					}
 18.1586 +				b = b.next;
 18.1587 +				}
 18.1588 +			}
 18.1589 +		this.maxStack = max;
 18.1590 +		}
 18.1591 +	else
 18.1592 +		{
 18.1593 +		this.maxStack = maxStack;
 18.1594 +		this.maxLocals = maxLocals;
 18.1595 +		}
 18.1596 +}
 18.1597 +
 18.1598 +public void visitEnd(){
 18.1599 +}
 18.1600 +
 18.1601 +// ------------------------------------------------------------------------
 18.1602 +// Utility methods: control flow analysis algorithm
 18.1603 +// ------------------------------------------------------------------------
 18.1604 +
 18.1605 +/**
 18.1606 + * Computes the size of the arguments and of the return value of a method.
 18.1607 + *
 18.1608 + * @param desc the descriptor of a method.
 18.1609 + * @return the size of the arguments of the method (plus one for the
 18.1610 + *         implicit this argument), argSize, and the size of its return
 18.1611 + *         value, retSize, packed into a single int i =
 18.1612 + *         <tt>(argSize << 2) | retSize</tt> (argSize is therefore equal
 18.1613 + *         to <tt>i >> 2</tt>, and retSize to <tt>i & 0x03</tt>).
 18.1614 + */
 18.1615 +static int getArgumentsAndReturnSizes(final String desc){
 18.1616 +	int n = 1;
 18.1617 +	int c = 1;
 18.1618 +	while(true)
 18.1619 +		{
 18.1620 +		char car = desc.charAt(c++);
 18.1621 +		if(car == ')')
 18.1622 +			{
 18.1623 +			car = desc.charAt(c);
 18.1624 +			return n << 2
 18.1625 +			       | (car == 'V' ? 0 : (car == 'D' || car == 'J' ? 2 : 1));
 18.1626 +			}
 18.1627 +		else if(car == 'L')
 18.1628 +			{
 18.1629 +			while(desc.charAt(c++) != ';')
 18.1630 +				{
 18.1631 +				}
 18.1632 +			n += 1;
 18.1633 +			}
 18.1634 +		else if(car == '[')
 18.1635 +			{
 18.1636 +			while((car = desc.charAt(c)) == '[')
 18.1637 +				{
 18.1638 +				++c;
 18.1639 +				}
 18.1640 +			if(car == 'D' || car == 'J')
 18.1641 +				{
 18.1642 +				n -= 1;
 18.1643 +				}
 18.1644 +			}
 18.1645 +		else if(car == 'D' || car == 'J')
 18.1646 +			{
 18.1647 +			n += 2;
 18.1648 +			}
 18.1649 +		else
 18.1650 +			{
 18.1651 +			n += 1;
 18.1652 +			}
 18.1653 +		}
 18.1654 +}
 18.1655 +
 18.1656 +/**
 18.1657 + * Adds a successor to the {@link #currentBlock currentBlock} block.
 18.1658 + *
 18.1659 + * @param info      information about the control flow edge to be added.
 18.1660 + * @param successor the successor block to be added to the current block.
 18.1661 + */
 18.1662 +private void addSuccessor(final int info, final Label successor){
 18.1663 +	// creates and initializes an Edge object...
 18.1664 +	Edge b = new Edge();
 18.1665 +	b.info = info;
 18.1666 +	b.successor = successor;
 18.1667 +	// ...and adds it to the successor list of the currentBlock block
 18.1668 +	b.next = currentBlock.successors;
 18.1669 +	currentBlock.successors = b;
 18.1670 +}
 18.1671 +
 18.1672 +/**
 18.1673 + * Ends the current basic block. This method must be used in the case where
 18.1674 + * the current basic block does not have any successor.
 18.1675 + */
 18.1676 +private void noSuccessor(){
 18.1677 +	if(compute == FRAMES)
 18.1678 +		{
 18.1679 +		Label l = new Label();
 18.1680 +		l.frame = new Frame();
 18.1681 +		l.frame.owner = l;
 18.1682 +		l.resolve(this, code.length, code.data);
 18.1683 +		previousBlock.successor = l;
 18.1684 +		previousBlock = l;
 18.1685 +		}
 18.1686 +	else
 18.1687 +		{
 18.1688 +		currentBlock.outputStackMax = maxStackSize;
 18.1689 +		}
 18.1690 +	currentBlock = null;
 18.1691 +}
 18.1692 +
 18.1693 +/**
 18.1694 + * Finds the basic blocks that belong to a given subroutine, and marks these
 18.1695 + * blocks as belonging to this subroutine (by using {@link Label#status} as
 18.1696 + * a bit set (see {@link #visitMaxs}). This recursive method follows the
 18.1697 + * control flow graph to find all the blocks that are reachable from the
 18.1698 + * given block WITHOUT following any JSR target.
 18.1699 + *
 18.1700 + * @param block a block that belongs to the subroutine
 18.1701 + * @param id    the id of this subroutine
 18.1702 + */
 18.1703 +private void findSubroutine(final Label block, final int id){
 18.1704 +	// if 'block' is already marked as belonging to subroutine 'id', returns
 18.1705 +	if((block.status & id) != 0)
 18.1706 +		{
 18.1707 +		return;
 18.1708 +		}
 18.1709 +	// marks 'block' as belonging to subroutine 'id'
 18.1710 +	block.status |= id;
 18.1711 +	// calls this method recursively on each successor, except JSR targets
 18.1712 +	Edge e = block.successors;
 18.1713 +	while(e != null)
 18.1714 +		{
 18.1715 +		// if 'block' is a JSR block, then 'block.successors.next' leads
 18.1716 +		// to the JSR target (see {@link #visitJumpInsn}) and must therefore
 18.1717 +		// not be followed
 18.1718 +		if((block.status & Label.JSR) == 0 || e != block.successors.next)
 18.1719 +			{
 18.1720 +			findSubroutine(e.successor, id);
 18.1721 +			}
 18.1722 +		e = e.next;
 18.1723 +		}
 18.1724 +}
 18.1725 +
 18.1726 +/**
 18.1727 + * Finds the successors of the RET blocks of the specified subroutine, and
 18.1728 + * of any nested subroutine it calls.
 18.1729 + *
 18.1730 + * @param id    id of the subroutine whose RET block successors must be found.
 18.1731 + * @param JSRs  the JSR blocks that were followed to reach this subroutine.
 18.1732 + * @param nJSRs number of JSR blocks in the JSRs array.
 18.1733 + */
 18.1734 +private void findSubroutineSuccessors(
 18.1735 +		final int id,
 18.1736 +		final Label[] JSRs,
 18.1737 +		final int nJSRs){
 18.1738 +	// iterates over all the basic blocks...
 18.1739 +	Label l = labels;
 18.1740 +	while(l != null)
 18.1741 +		{
 18.1742 +		// for those that belong to subroutine 'id'...
 18.1743 +		if((l.status & id) != 0)
 18.1744 +			{
 18.1745 +			if((l.status & Label.JSR) != 0)
 18.1746 +				{
 18.1747 +				// finds the subroutine to which 'l' leads by following the
 18.1748 +				// second edge of l.successors (see {@link #visitJumpInsn})
 18.1749 +				int nId = l.successors.next.successor.status & ~0xFFF;
 18.1750 +				if(nId != id)
 18.1751 +					{
 18.1752 +					// calls this method recursively with l pushed onto the
 18.1753 +					// JSRs stack to find the successors of the RET blocks
 18.1754 +					// of this nested subroutine 'nId'
 18.1755 +					JSRs[nJSRs] = l;
 18.1756 +					findSubroutineSuccessors(nId, JSRs, nJSRs + 1);
 18.1757 +					}
 18.1758 +				}
 18.1759 +			else if((l.status & Label.RET) != 0)
 18.1760 +				{
 18.1761 +				/*
 18.1762 +									 * finds the JSR block in the JSRs stack that corresponds to
 18.1763 +									 * this RET block, and updates the successors of this RET
 18.1764 +									 * block accordingly. This corresponding JSR is the one that
 18.1765 +									 * leads to the subroutine to which the RET block belongs.
 18.1766 +									 * But the RET block can belong to several subroutines (if a
 18.1767 +									 * nested subroutine returns to its parent subroutine
 18.1768 +									 * implicitely, without a RET). So, in fact, the JSR that
 18.1769 +									 * corresponds to this RET is the first block in the JSRs
 18.1770 +									 * stack, starting from the bottom of the stack, that leads
 18.1771 +									 * to a subroutine to which the RET block belongs.
 18.1772 +									 */
 18.1773 +				for(int i = 0; i < nJSRs; ++i)
 18.1774 +					{
 18.1775 +					int JSRstatus = JSRs[i].successors.next.successor.status;
 18.1776 +					if(((JSRstatus & ~0xFFF) & (l.status & ~0xFFF)) != 0)
 18.1777 +						{
 18.1778 +						Edge e = new Edge();
 18.1779 +						e.info = l.inputStackTop;
 18.1780 +						e.successor = JSRs[i].successors.successor;
 18.1781 +						e.next = l.successors;
 18.1782 +						l.successors = e;
 18.1783 +						break;
 18.1784 +						}
 18.1785 +					}
 18.1786 +				}
 18.1787 +			}
 18.1788 +		l = l.successor;
 18.1789 +		}
 18.1790 +}
 18.1791 +
 18.1792 +// ------------------------------------------------------------------------
 18.1793 +// Utility methods: stack map frames
 18.1794 +// ------------------------------------------------------------------------
 18.1795 +
 18.1796 +/**
 18.1797 + * Visits a frame that has been computed from scratch.
 18.1798 + *
 18.1799 + * @param f the frame that must be visited.
 18.1800 + */
 18.1801 +private void visitFrame(final Frame f){
 18.1802 +	int i, t;
 18.1803 +	int nTop = 0;
 18.1804 +	int nLocal = 0;
 18.1805 +	int nStack = 0;
 18.1806 +	int[] locals = f.inputLocals;
 18.1807 +	int[] stacks = f.inputStack;
 18.1808 +	// computes the number of locals (ignores TOP types that are just after
 18.1809 +	// a LONG or a DOUBLE, and all trailing TOP types)
 18.1810 +	for(i = 0; i < locals.length; ++i)
 18.1811 +		{
 18.1812 +		t = locals[i];
 18.1813 +		if(t == Frame.TOP)
 18.1814 +			{
 18.1815 +			++nTop;
 18.1816 +			}
 18.1817 +		else
 18.1818 +			{
 18.1819 +			nLocal += nTop + 1;
 18.1820 +			nTop = 0;
 18.1821 +			}
 18.1822 +		if(t == Frame.LONG || t == Frame.DOUBLE)
 18.1823 +			{
 18.1824 +			++i;
 18.1825 +			}
 18.1826 +		}
 18.1827 +	// computes the stack size (ignores TOP types that are just after
 18.1828 +	// a LONG or a DOUBLE)
 18.1829 +	for(i = 0; i < stacks.length; ++i)
 18.1830 +		{
 18.1831 +		t = stacks[i];
 18.1832 +		++nStack;
 18.1833 +		if(t == Frame.LONG || t == Frame.DOUBLE)
 18.1834 +			{
 18.1835 +			++i;
 18.1836 +			}
 18.1837 +		}
 18.1838 +	// visits the frame and its content
 18.1839 +	startFrame(f.owner.position, nLocal, nStack);
 18.1840 +	for(i = 0; nLocal > 0; ++i, --nLocal)
 18.1841 +		{
 18.1842 +		t = locals[i];
 18.1843 +		frame[frameIndex++] = t;
 18.1844 +		if(t == Frame.LONG || t == Frame.DOUBLE)
 18.1845 +			{
 18.1846 +			++i;
 18.1847 +			}
 18.1848 +		}
 18.1849 +	for(i = 0; i < stacks.length; ++i)
 18.1850 +		{
 18.1851 +		t = stacks[i];
 18.1852 +		frame[frameIndex++] = t;
 18.1853 +		if(t == Frame.LONG || t == Frame.DOUBLE)
 18.1854 +			{
 18.1855 +			++i;
 18.1856 +			}
 18.1857 +		}
 18.1858 +	endFrame();
 18.1859 +}
 18.1860 +
 18.1861 +/**
 18.1862 + * Starts the visit of a stack map frame.
 18.1863 + *
 18.1864 + * @param offset the offset of the instruction to which the frame
 18.1865 + *               corresponds.
 18.1866 + * @param nLocal the number of local variables in the frame.
 18.1867 + * @param nStack the number of stack elements in the frame.
 18.1868 + */
 18.1869 +private void startFrame(final int offset, final int nLocal, final int nStack){
 18.1870 +	int n = 3 + nLocal + nStack;
 18.1871 +	if(frame == null || frame.length < n)
 18.1872 +		{
 18.1873 +		frame = new int[n];
 18.1874 +		}
 18.1875 +	frame[0] = offset;
 18.1876 +	frame[1] = nLocal;
 18.1877 +	frame[2] = nStack;
 18.1878 +	frameIndex = 3;
 18.1879 +}
 18.1880 +
 18.1881 +/**
 18.1882 + * Checks if the visit of the current frame {@link #frame} is finished, and
 18.1883 + * if yes, write it in the StackMapTable attribute.
 18.1884 + */
 18.1885 +private void endFrame(){
 18.1886 +	if(previousFrame != null)
 18.1887 +		{ // do not write the first frame
 18.1888 +		if(stackMap == null)
 18.1889 +			{
 18.1890 +			stackMap = new ByteVector();
 18.1891 +			}
 18.1892 +		writeFrame();
 18.1893 +		++frameCount;
 18.1894 +		}
 18.1895 +	previousFrame = frame;
 18.1896 +	frame = null;
 18.1897 +}
 18.1898 +
 18.1899 +/**
 18.1900 + * Compress and writes the current frame {@link #frame} in the StackMapTable
 18.1901 + * attribute.
 18.1902 + */
 18.1903 +private void writeFrame(){
 18.1904 +	int clocalsSize = frame[1];
 18.1905 +	int cstackSize = frame[2];
 18.1906 +	if((cw.version & 0xFFFF) < Opcodes.V1_6)
 18.1907 +		{
 18.1908 +		stackMap.putShort(frame[0]).putShort(clocalsSize);
 18.1909 +		writeFrameTypes(3, 3 + clocalsSize);
 18.1910 +		stackMap.putShort(cstackSize);
 18.1911 +		writeFrameTypes(3 + clocalsSize, 3 + clocalsSize + cstackSize);
 18.1912 +		return;
 18.1913 +		}
 18.1914 +	int localsSize = previousFrame[1];
 18.1915 +	int type = FULL_FRAME;
 18.1916 +	int k = 0;
 18.1917 +	int delta;
 18.1918 +	if(frameCount == 0)
 18.1919 +		{
 18.1920 +		delta = frame[0];
 18.1921 +		}
 18.1922 +	else
 18.1923 +		{
 18.1924 +		delta = frame[0] - previousFrame[0] - 1;
 18.1925 +		}
 18.1926 +	if(cstackSize == 0)
 18.1927 +		{
 18.1928 +		k = clocalsSize - localsSize;
 18.1929 +		switch(k)
 18.1930 +			{
 18.1931 +			case-3:
 18.1932 +			case-2:
 18.1933 +			case-1:
 18.1934 +				type = CHOP_FRAME;
 18.1935 +				localsSize = clocalsSize;
 18.1936 +				break;
 18.1937 +			case 0:
 18.1938 +				type = delta < 64 ? SAME_FRAME : SAME_FRAME_EXTENDED;
 18.1939 +				break;
 18.1940 +			case 1:
 18.1941 +			case 2:
 18.1942 +			case 3:
 18.1943 +				type = APPEND_FRAME;
 18.1944 +				break;
 18.1945 +			}
 18.1946 +		}
 18.1947 +	else if(clocalsSize == localsSize && cstackSize == 1)
 18.1948 +		{
 18.1949 +		type = delta < 63
 18.1950 +		       ? SAME_LOCALS_1_STACK_ITEM_FRAME
 18.1951 +		       : SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED;
 18.1952 +		}
 18.1953 +	if(type != FULL_FRAME)
 18.1954 +		{
 18.1955 +		// verify if locals are the same
 18.1956 +		int l = 3;
 18.1957 +		for(int j = 0; j < localsSize; j++)
 18.1958 +			{
 18.1959 +			if(frame[l] != previousFrame[l])
 18.1960 +				{
 18.1961 +				type = FULL_FRAME;
 18.1962 +				break;
 18.1963 +				}
 18.1964 +			l++;
 18.1965 +			}
 18.1966 +		}
 18.1967 +	switch(type)
 18.1968 +		{
 18.1969 +		case SAME_FRAME:
 18.1970 +			stackMap.putByte(delta);
 18.1971 +			break;
 18.1972 +		case SAME_LOCALS_1_STACK_ITEM_FRAME:
 18.1973 +			stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME + delta);
 18.1974 +			writeFrameTypes(3 + clocalsSize, 4 + clocalsSize);
 18.1975 +			break;
 18.1976 +		case SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED:
 18.1977 +			stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED)
 18.1978 +					.putShort(delta);
 18.1979 +			writeFrameTypes(3 + clocalsSize, 4 + clocalsSize);
 18.1980 +			break;
 18.1981 +		case SAME_FRAME_EXTENDED:
 18.1982 +			stackMap.putByte(SAME_FRAME_EXTENDED).putShort(delta);
 18.1983 +			break;
 18.1984 +		case CHOP_FRAME:
 18.1985 +			stackMap.putByte(SAME_FRAME_EXTENDED + k).putShort(delta);
 18.1986 +			break;
 18.1987 +		case APPEND_FRAME:
 18.1988 +			stackMap.putByte(SAME_FRAME_EXTENDED + k).putShort(delta);
 18.1989 +			writeFrameTypes(3 + localsSize, 3 + clocalsSize);
 18.1990 +			break;
 18.1991 +			// case FULL_FRAME:
 18.1992 +		default:
 18.1993 +			stackMap.putByte(FULL_FRAME)
 18.1994 +					.putShort(delta)
 18.1995 +					.putShort(clocalsSize);
 18.1996 +			writeFrameTypes(3, 3 + clocalsSize);
 18.1997 +			stackMap.putShort(cstackSize);
 18.1998 +			writeFrameTypes(3 + clocalsSize, 3 + clocalsSize + cstackSize);
 18.1999 +		}
 18.2000 +}
 18.2001 +
 18.2002 +/**
 18.2003 + * Writes some types of the current frame {@link #frame} into the
 18.2004 + * StackMapTableAttribute. This method converts types from the format used
 18.2005 + * in {@link Label} to the format used in StackMapTable attributes. In
 18.2006 + * particular, it converts type table indexes to constant pool indexes.
 18.2007 + *
 18.2008 + * @param start index of the first type in {@link #frame} to write.
 18.2009 + * @param end   index of last type in {@link #frame} to write (exclusive).
 18.2010 + */
 18.2011 +private void writeFrameTypes(final int start, final int end){
 18.2012 +	for(int i = start; i < end; ++i)
 18.2013 +		{
 18.2014 +		int t = frame[i];
 18.2015 +		int d = t & Frame.DIM;
 18.2016 +		if(d == 0)
 18.2017 +			{
 18.2018 +			int v = t & Frame.BASE_VALUE;
 18.2019 +			switch(t & Frame.BASE_KIND)
 18.2020 +				{
 18.2021 +				case Frame.OBJECT:
 18.2022 +					stackMap.putByte(7)
 18.2023 +							.putShort(cw.newClass(cw.typeTable[v].strVal1));
 18.2024 +					break;
 18.2025 +				case Frame.UNINITIALIZED:
 18.2026 +					stackMap.putByte(8).putShort(cw.typeTable[v].intVal);
 18.2027 +					break;
 18.2028 +				default:
 18.2029 +					stackMap.putByte(v);
 18.2030 +				}
 18.2031 +			}
 18.2032 +		else
 18.2033 +			{
 18.2034 +			StringBuffer buf = new StringBuffer();
 18.2035 +			d >>= 28;
 18.2036 +			while(d-- > 0)
 18.2037 +				{
 18.2038 +				buf.append('[');
 18.2039 +				}
 18.2040 +			if((t & Frame.BASE_KIND) == Frame.OBJECT)
 18.2041 +				{
 18.2042 +				buf.append('L');
 18.2043 +				buf.append(cw.typeTable[t & Frame.BASE_VALUE].strVal1);
 18.2044 +				buf.append(';');
 18.2045 +				}
 18.2046 +			else
 18.2047 +				{
 18.2048 +				switch(t & 0xF)
 18.2049 +					{
 18.2050 +					case 1:
 18.2051 +						buf.append('I');
 18.2052 +						break;
 18.2053 +					case 2:
 18.2054 +						buf.append('F');
 18.2055 +						break;
 18.2056 +					case 3:
 18.2057 +						buf.append('D');
 18.2058 +						break;
 18.2059 +					case 9:
 18.2060 +						buf.append('Z');
 18.2061 +						break;
 18.2062 +					case 10:
 18.2063 +						buf.append('B');
 18.2064 +						break;
 18.2065 +					case 11:
 18.2066 +						buf.append('C');
 18.2067 +						break;
 18.2068 +					case 12:
 18.2069 +						buf.append('S');
 18.2070 +						break;
 18.2071 +					default:
 18.2072 +						buf.append('J');
 18.2073 +					}
 18.2074 +				}
 18.2075 +			stackMap.putByte(7).putShort(cw.newClass(buf.toString()));
 18.2076 +			}
 18.2077 +		}
 18.2078 +}
 18.2079 +
 18.2080 +private void writeFrameType(final Object type){
 18.2081 +	if(type instanceof String)
 18.2082 +		{
 18.2083 +		stackMap.putByte(7).putShort(cw.newClass((String) type));
 18.2084 +		}
 18.2085 +	else if(type instanceof Integer)
 18.2086 +		{
 18.2087 +		stackMap.putByte(((Integer) type).intValue());
 18.2088 +		}
 18.2089 +	else
 18.2090 +		{
 18.2091 +		stackMap.putByte(8).putShort(((Label) type).position);
 18.2092 +		}
 18.2093 +}
 18.2094 +
 18.2095 +// ------------------------------------------------------------------------
 18.2096 +// Utility methods: dump bytecode array
 18.2097 +// ------------------------------------------------------------------------
 18.2098 +
 18.2099 +/**
 18.2100 + * Returns the size of the bytecode of this method.
 18.2101 + *
 18.2102 + * @return the size of the bytecode of this method.
 18.2103 + */
 18.2104 +final int getSize(){
 18.2105 +	if(classReaderOffset != 0)
 18.2106 +		{
 18.2107 +		return 6 + classReaderLength;
 18.2108 +		}
 18.2109 +	if(resize)
 18.2110 +		{
 18.2111 +		// replaces the temporary jump opcodes introduced by Label.resolve.
 18.2112 +		resizeInstructions();
 18.2113 +		}
 18.2114 +	int size = 8;
 18.2115 +	if(code.length > 0)
 18.2116 +		{
 18.2117 +		cw.newUTF8("Code");
 18.2118 +		size += 18 + code.length + 8 * handlerCount;
 18.2119 +		if(localVar != null)
 18.2120 +			{
 18.2121 +			cw.newUTF8("LocalVariableTable");
 18.2122 +			size += 8 + localVar.length;
 18.2123 +			}
 18.2124 +		if(localVarType != null)
 18.2125 +			{
 18.2126 +			cw.newUTF8("LocalVariableTypeTable");
 18.2127 +			size += 8 + localVarType.length;
 18.2128 +			}
 18.2129 +		if(lineNumber != null)
 18.2130 +			{
 18.2131 +			cw.newUTF8("LineNumberTable");
 18.2132 +			size += 8 + lineNumber.length;
 18.2133 +			}
 18.2134 +		if(stackMap != null)
 18.2135 +			{
 18.2136 +			boolean zip = (cw.version & 0xFFFF) >= Opcodes.V1_6;
 18.2137 +			cw.newUTF8(zip ? "StackMapTable" : "StackMap");
 18.2138 +			size += 8 + stackMap.length;
 18.2139 +			}
 18.2140 +		if(cattrs != null)
 18.2141 +			{
 18.2142 +			size += cattrs.getSize(cw,
 18.2143 +			                       code.data,
 18.2144 +			                       code.length,
 18.2145 +			                       maxStack,
 18.2146 +			                       maxLocals);
 18.2147 +			}
 18.2148 +		}
 18.2149 +	if(exceptionCount > 0)
 18.2150 +		{
 18.2151 +		cw.newUTF8("Exceptions");
 18.2152 +		size += 8 + 2 * exceptionCount;
 18.2153 +		}
 18.2154 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
 18.2155 +	   && (cw.version & 0xffff) < Opcodes.V1_5)
 18.2156 +		{
 18.2157 +		cw.newUTF8("Synthetic");
 18.2158 +		size += 6;
 18.2159 +		}
 18.2160 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
 18.2161 +		{
 18.2162 +		cw.newUTF8("Deprecated");
 18.2163 +		size += 6;
 18.2164 +		}
 18.2165 +	if(signature != null)
 18.2166 +		{
 18.2167 +		cw.newUTF8("Signature");
 18.2168 +		cw.newUTF8(signature);
 18.2169 +		size += 8;
 18.2170 +		}
 18.2171 +	if(annd != null)
 18.2172 +		{
 18.2173 +		cw.newUTF8("AnnotationDefault");
 18.2174 +		size += 6 + annd.length;
 18.2175 +		}
 18.2176 +	if(anns != null)
 18.2177 +		{
 18.2178 +		cw.newUTF8("RuntimeVisibleAnnotations");
 18.2179 +		size += 8 + anns.getSize();
 18.2180 +		}
 18.2181 +	if(ianns != null)
 18.2182 +		{
 18.2183 +		cw.newUTF8("RuntimeInvisibleAnnotations");
 18.2184 +		size += 8 + ianns.getSize();
 18.2185 +		}
 18.2186 +	if(panns != null)
 18.2187 +		{
 18.2188 +		cw.newUTF8("RuntimeVisibleParameterAnnotations");
 18.2189 +		size += 7 + 2 * panns.length;
 18.2190 +		for(int i = panns.length - 1; i >= 0; --i)
 18.2191 +			{
 18.2192 +			size += panns[i] == null ? 0 : panns[i].getSize();
 18.2193 +			}
 18.2194 +		}
 18.2195 +	if(ipanns != null)
 18.2196 +		{
 18.2197 +		cw.newUTF8("RuntimeInvisibleParameterAnnotations");
 18.2198 +		size += 7 + 2 * ipanns.length;
 18.2199 +		for(int i = ipanns.length - 1; i >= 0; --i)
 18.2200 +			{
 18.2201 +			size += ipanns[i] == null ? 0 : ipanns[i].getSize();
 18.2202 +			}
 18.2203 +		}
 18.2204 +	if(attrs != null)
 18.2205 +		{
 18.2206 +		size += attrs.getSize(cw, null, 0, -1, -1);
 18.2207 +		}
 18.2208 +	return size;
 18.2209 +}
 18.2210 +
 18.2211 +/**
 18.2212 + * Puts the bytecode of this method in the given byte vector.
 18.2213 + *
 18.2214 + * @param out the byte vector into which the bytecode of this method must be
 18.2215 + *            copied.
 18.2216 + */
 18.2217 +final void put(final ByteVector out){
 18.2218 +	out.putShort(access).putShort(name).putShort(desc);
 18.2219 +	if(classReaderOffset != 0)
 18.2220 +		{
 18.2221 +		out.putByteArray(cw.cr.b, classReaderOffset, classReaderLength);
 18.2222 +		return;
 18.2223 +		}
 18.2224 +	int attributeCount = 0;
 18.2225 +	if(code.length > 0)
 18.2226 +		{
 18.2227 +		++attributeCount;
 18.2228 +		}
 18.2229 +	if(exceptionCount > 0)
 18.2230 +		{
 18.2231 +		++attributeCount;
 18.2232 +		}
 18.2233 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
 18.2234 +	   && (cw.version & 0xffff) < Opcodes.V1_5)
 18.2235 +		{
 18.2236 +		++attributeCount;
 18.2237 +		}
 18.2238 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
 18.2239 +		{
 18.2240 +		++attributeCount;
 18.2241 +		}
 18.2242 +	if(signature != null)
 18.2243 +		{
 18.2244 +		++attributeCount;
 18.2245 +		}
 18.2246 +	if(annd != null)
 18.2247 +		{
 18.2248 +		++attributeCount;
 18.2249 +		}
 18.2250 +	if(anns != null)
 18.2251 +		{
 18.2252 +		++attributeCount;
 18.2253 +		}
 18.2254 +	if(ianns != null)
 18.2255 +		{
 18.2256 +		++attributeCount;
 18.2257 +		}
 18.2258 +	if(panns != null)
 18.2259 +		{
 18.2260 +		++attributeCount;
 18.2261 +		}
 18.2262 +	if(ipanns != null)
 18.2263 +		{
 18.2264 +		++attributeCount;
 18.2265 +		}
 18.2266 +	if(attrs != null)
 18.2267 +		{
 18.2268 +		attributeCount += attrs.getCount();
 18.2269 +		}
 18.2270 +	out.putShort(attributeCount);
 18.2271 +	if(code.length > 0)
 18.2272 +		{
 18.2273 +		int size = 12 + code.length + 8 * handlerCount;
 18.2274 +		if(localVar != null)
 18.2275 +			{
 18.2276 +			size += 8 + localVar.length;
 18.2277 +			}
 18.2278 +		if(localVarType != null)
 18.2279 +			{
 18.2280 +			size += 8 + localVarType.length;
 18.2281 +			}
 18.2282 +		if(lineNumber != null)
 18.2283 +			{
 18.2284 +			size += 8 + lineNumber.length;
 18.2285 +			}
 18.2286 +		if(stackMap != null)
 18.2287 +			{
 18.2288 +			size += 8 + stackMap.length;
 18.2289 +			}
 18.2290 +		if(cattrs != null)
 18.2291 +			{
 18.2292 +			size += cattrs.getSize(cw,
 18.2293 +			                       code.data,
 18.2294 +			                       code.length,
 18.2295 +			                       maxStack,
 18.2296 +			                       maxLocals);
 18.2297 +			}
 18.2298 +		out.putShort(cw.newUTF8("Code")).putInt(size);
 18.2299 +		out.putShort(maxStack).putShort(maxLocals);
 18.2300 +		out.putInt(code.length).putByteArray(code.data, 0, code.length);
 18.2301 +		out.putShort(handlerCount);
 18.2302 +		if(handlerCount > 0)
 18.2303 +			{
 18.2304 +			Handler h = firstHandler;
 18.2305 +			while(h != null)
 18.2306 +				{
 18.2307 +				out.putShort(h.start.position)
 18.2308 +						.putShort(h.end.position)
 18.2309 +						.putShort(h.handler.position)
 18.2310 +						.putShort(h.type);
 18.2311 +				h = h.next;
 18.2312 +				}
 18.2313 +			}
 18.2314 +		attributeCount = 0;
 18.2315 +		if(localVar != null)
 18.2316 +			{
 18.2317 +			++attributeCount;
 18.2318 +			}
 18.2319 +		if(localVarType != null)
 18.2320 +			{
 18.2321 +			++attributeCount;
 18.2322 +			}
 18.2323 +		if(lineNumber != null)
 18.2324 +			{
 18.2325 +			++attributeCount;
 18.2326 +			}
 18.2327 +		if(stackMap != null)
 18.2328 +			{
 18.2329 +			++attributeCount;
 18.2330 +			}
 18.2331 +		if(cattrs != null)
 18.2332 +			{
 18.2333 +			attributeCount += cattrs.getCount();
 18.2334 +			}
 18.2335 +		out.putShort(attributeCount);
 18.2336 +		if(localVar != null)
 18.2337 +			{
 18.2338 +			out.putShort(cw.newUTF8("LocalVariableTable"));
 18.2339 +			out.putInt(localVar.length + 2).putShort(localVarCount);
 18.2340 +			out.putByteArray(localVar.data, 0, localVar.length);
 18.2341 +			}
 18.2342 +		if(localVarType != null)
 18.2343 +			{
 18.2344 +			out.putShort(cw.newUTF8("LocalVariableTypeTable"));
 18.2345 +			out.putInt(localVarType.length + 2).putShort(localVarTypeCount);
 18.2346 +			out.putByteArray(localVarType.data, 0, localVarType.length);
 18.2347 +			}
 18.2348 +		if(lineNumber != null)
 18.2349 +			{
 18.2350 +			out.putShort(cw.newUTF8("LineNumberTable"));
 18.2351 +			out.putInt(lineNumber.length + 2).putShort(lineNumberCount);
 18.2352 +			out.putByteArray(lineNumber.data, 0, lineNumber.length);
 18.2353 +			}
 18.2354 +		if(stackMap != null)
 18.2355 +			{
 18.2356 +			boolean zip = (cw.version & 0xFFFF) >= Opcodes.V1_6;
 18.2357 +			out.putShort(cw.newUTF8(zip ? "StackMapTable" : "StackMap"));
 18.2358 +			out.putInt(stackMap.length + 2).putShort(frameCount);
 18.2359 +			out.putByteArray(stackMap.data, 0, stackMap.length);
 18.2360 +			}
 18.2361 +		if(cattrs != null)
 18.2362 +			{
 18.2363 +			cattrs.put(cw, code.data, code.length, maxLocals, maxStack, out);
 18.2364 +			}
 18.2365 +		}
 18.2366 +	if(exceptionCount > 0)
 18.2367 +		{
 18.2368 +		out.putShort(cw.newUTF8("Exceptions"))
 18.2369 +				.putInt(2 * exceptionCount + 2);
 18.2370 +		out.putShort(exceptionCount);
 18.2371 +		for(int i = 0; i < exceptionCount; ++i)
 18.2372 +			{
 18.2373 +			out.putShort(exceptions[i]);
 18.2374 +			}
 18.2375 +		}
 18.2376 +	if((access & Opcodes.ACC_SYNTHETIC) != 0
 18.2377 +	   && (cw.version & 0xffff) < Opcodes.V1_5)
 18.2378 +		{
 18.2379 +		out.putShort(cw.newUTF8("Synthetic")).putInt(0);
 18.2380 +		}
 18.2381 +	if((access & Opcodes.ACC_DEPRECATED) != 0)
 18.2382 +		{
 18.2383 +		out.putShort(cw.newUTF8("Deprecated")).putInt(0);
 18.2384 +		}
 18.2385 +	if(signature != null)
 18.2386 +		{
 18.2387 +		out.putShort(cw.newUTF8("Signature"))
 18.2388 +				.putInt(2)
 18.2389 +				.putShort(cw.newUTF8(signature));
 18.2390 +		}
 18.2391 +	if(annd != null)
 18.2392 +		{
 18.2393 +		out.putShort(cw.newUTF8("AnnotationDefault"));
 18.2394 +		out.putInt(annd.length);
 18.2395 +		out.putByteArray(annd.data, 0, annd.length);
 18.2396 +		}
 18.2397 +	if(anns != null)
 18.2398 +		{
 18.2399 +		out.putShort(cw.newUTF8("RuntimeVisibleAnnotations"));
 18.2400 +		anns.put(out);
 18.2401 +		}
 18.2402 +	if(ianns != null)
 18.2403 +		{
 18.2404 +		out.putShort(cw.newUTF8("RuntimeInvisibleAnnotations"));
 18.2405 +		ianns.put(out);
 18.2406 +		}
 18.2407 +	if(panns != null)
 18.2408 +		{
 18.2409 +		out.putShort(cw.newUTF8("RuntimeVisibleParameterAnnotations"));
 18.2410 +		AnnotationWriter.put(panns, out);
 18.2411 +		}
 18.2412 +	if(ipanns != null)
 18.2413 +		{
 18.2414 +		out.putShort(cw.newUTF8("RuntimeInvisibleParameterAnnotations"));
 18.2415 +		AnnotationWriter.put(ipanns, out);
 18.2416 +		}
 18.2417 +	if(attrs != null)
 18.2418 +		{
 18.2419 +		attrs.put(cw, null, 0, -1, -1, out);
 18.2420 +		}
 18.2421 +}
 18.2422 +
 18.2423 +// ------------------------------------------------------------------------
 18.2424 +// Utility methods: instruction resizing (used to handle GOTO_W and JSR_W)
 18.2425 +// ------------------------------------------------------------------------
 18.2426 +
 18.2427 +/**
 18.2428 + * Resizes and replaces the temporary instructions inserted by
 18.2429 + * {@link Label#resolve} for wide forward jumps, while keeping jump offsets
 18.2430 + * and instruction addresses consistent. This may require to resize other
 18.2431 + * existing instructions, or even to introduce new instructions: for
 18.2432 + * example, increasing the size of an instruction by 2 at the middle of a
 18.2433 + * method can increases the offset of an IFEQ instruction from 32766 to
 18.2434 + * 32768, in which case IFEQ 32766 must be replaced with IFNEQ 8 GOTO_W
 18.2435 + * 32765. This, in turn, may require to increase the size of another jump
 18.2436 + * instruction, and so on... All these operations are handled automatically
 18.2437 + * by this method. <p> <i>This method must be called after all the method
 18.2438 + * that is being built has been visited</i>. In particular, the
 18.2439 + * {@link Label Label} objects used to construct the method are no longer
 18.2440 + * valid after this method has been called.
 18.2441 + */
 18.2442 +private void resizeInstructions(){
 18.2443 +	byte[] b = code.data; // bytecode of the method
 18.2444 +	int u, v, label; // indexes in b
 18.2445 +	int i, j; // loop indexes
 18.2446 +	/*
 18.2447 +			 * 1st step: As explained above, resizing an instruction may require to
 18.2448 +			 * resize another one, which may require to resize yet another one, and
 18.2449 +			 * so on. The first step of the algorithm consists in finding all the
 18.2450 +			 * instructions that need to be resized, without modifying the code.
 18.2451 +			 * This is done by the following "fix point" algorithm:
 18.2452 +			 *
 18.2453 +			 * Parse the code to find the jump instructions whose offset will need
 18.2454 +			 * more than 2 bytes to be stored (the future offset is computed from
 18.2455 +			 * the current offset and from the number of bytes that will be inserted
 18.2456 +			 * or removed between the source and target instructions). For each such
 18.2457 +			 * instruction, adds an entry in (a copy of) the indexes and sizes
 18.2458 +			 * arrays (if this has not already been done in a previous iteration!).
 18.2459 +			 *
 18.2460 +			 * If at least one entry has been added during the previous step, go
 18.2461 +			 * back to the beginning, otherwise stop.
 18.2462 +			 *
 18.2463 +			 * In fact the real algorithm is complicated by the fact that the size
 18.2464 +			 * of TABLESWITCH and LOOKUPSWITCH instructions depends on their
 18.2465 +			 * position in the bytecode (because of padding). In order to ensure the
 18.2466 +			 * convergence of the algorithm, the number of bytes to be added or
 18.2467 +			 * removed from these instructions is over estimated during the previous
 18.2468 +			 * loop, and computed exactly only after the loop is finished (this
 18.2469 +			 * requires another pass to parse the bytecode of the method).
 18.2470 +			 */
 18.2471 +	int[] allIndexes = new int[0]; // copy of indexes
 18.2472 +	int[] allSizes = new int[0]; // copy of sizes
 18.2473 +	boolean[] resize; // instructions to be resized
 18.2474 +	int newOffset; // future offset of a jump instruction
 18.2475 +
 18.2476 +	resize = new boolean[code.length];
 18.2477 +
 18.2478 +	// 3 = loop again, 2 = loop ended, 1 = last pass, 0 = done
 18.2479 +	int state = 3;
 18.2480 +	do
 18.2481 +		{
 18.2482 +		if(state == 3)
 18.2483 +			{
 18.2484 +			state = 2;
 18.2485 +			}
 18.2486 +		u = 0;
 18.2487 +		while(u < b.length)
 18.2488 +			{
 18.2489 +			int opcode = b[u] & 0xFF; // opcode of current instruction
 18.2490 +			int insert = 0; // bytes to be added after this instruction
 18.2491 +
 18.2492 +			switch(ClassWriter.TYPE[opcode])
 18.2493 +				{
 18.2494 +				case ClassWriter.NOARG_INSN:
 18.2495 +				case ClassWriter.IMPLVAR_INSN:
 18.2496 +					u += 1;
 18.2497 +					break;
 18.2498 +				case ClassWriter.LABEL_INSN:
 18.2499 +					if(opcode > 201)
 18.2500 +						{
 18.2501 +						// converts temporary opcodes 202 to 217, 218 and
 18.2502 +						// 219 to IFEQ ... JSR (inclusive), IFNULL and
 18.2503 +						// IFNONNULL
 18.2504 +						opcode = opcode < 218 ? opcode - 49 : opcode - 20;
 18.2505 +						label = u + readUnsignedShort(b, u + 1);
 18.2506 +						}
 18.2507 +					else
 18.2508 +						{
 18.2509 +						label = u + readShort(b, u + 1);
 18.2510 +						}
 18.2511 +					newOffset = getNewOffset(allIndexes, allSizes, u, label);
 18.2512 +					if(newOffset < Short.MIN_VALUE
 18.2513 +					   || newOffset > Short.MAX_VALUE)
 18.2514 +						{
 18.2515 +						if(!resize[u])
 18.2516 +							{
 18.2517 +							if(opcode == Opcodes.GOTO
 18.2518 +							   || opcode == Opcodes.JSR)
 18.2519 +								{
 18.2520 +								// two additional bytes will be required to
 18.2521 +								// replace this GOTO or JSR instruction with
 18.2522 +								// a GOTO_W or a JSR_W
 18.2523 +								insert = 2;
 18.2524 +								}
 18.2525 +							else
 18.2526 +								{
 18.2527 +								// five additional bytes will be required to
 18.2528 +								// replace this IFxxx <l> instruction with
 18.2529 +								// IFNOTxxx <l'> GOTO_W <l>, where IFNOTxxx
 18.2530 +								// is the "opposite" opcode of IFxxx (i.e.,
 18.2531 +								// IFNE for IFEQ) and where <l'> designates
 18.2532 +								// the instruction just after the GOTO_W.
 18.2533 +								insert = 5;
 18.2534 +								}
 18.2535 +							resize[u] = true;
 18.2536 +							}
 18.2537 +						}
 18.2538 +					u += 3;
 18.2539 +					break;
 18.2540 +				case ClassWriter.LABELW_INSN:
 18.2541 +					u += 5;
 18.2542 +					break;
 18.2543 +				case ClassWriter.TABL_INSN:
 18.2544 +					if(state == 1)
 18.2545 +						{
 18.2546 +						// true number of bytes to be added (or removed)
 18.2547 +						// from this instruction = (future number of padding
 18.2548 +						// bytes - current number of padding byte) -
 18.2549 +						// previously over estimated variation =
 18.2550 +						// = ((3 - newOffset%4) - (3 - u%4)) - u%4
 18.2551 +						// = (-newOffset%4 + u%4) - u%4
 18.2552 +						// = -(newOffset & 3)
 18.2553 +						newOffset = getNewOffset(allIndexes, allSizes, 0, u);
 18.2554 +						insert = -(newOffset & 3);
 18.2555 +						}
 18.2556 +					else if(!resize[u])
 18.2557 +						{
 18.2558 +						// over estimation of the number of bytes to be
 18.2559 +						// added to this instruction = 3 - current number
 18.2560 +						// of padding bytes = 3 - (3 - u%4) = u%4 = u & 3
 18.2561 +						insert = u & 3;
 18.2562 +						resize[u] = true;
 18.2563 +						}
 18.2564 +					// skips instruction
 18.2565 +					u = u + 4 - (u & 3);
 18.2566 +					u += 4 * (readInt(b, u + 8) - readInt(b, u + 4) + 1) + 12;
 18.2567 +					break;
 18.2568 +				case ClassWriter.LOOK_INSN:
 18.2569 +					if(state == 1)
 18.2570 +						{
 18.2571 +						// like TABL_INSN
 18.2572 +						newOffset = getNewOffset(allIndexes, allSizes, 0, u);
 18.2573 +						insert = -(newOffset & 3);
 18.2574 +						}
 18.2575 +					else if(!resize[u])
 18.2576 +						{
 18.2577 +						// like TABL_INSN
 18.2578 +						insert = u & 3;
 18.2579 +						resize[u] = true;
 18.2580 +						}
 18.2581 +					// skips instruction
 18.2582 +					u = u + 4 - (u & 3);
 18.2583 +					u += 8 * readInt(b, u + 4) + 8;
 18.2584 +					break;
 18.2585 +				case ClassWriter.WIDE_INSN:
 18.2586 +					opcode = b[u + 1] & 0xFF;
 18.2587 +					if(opcode == Opcodes.IINC)
 18.2588 +						{
 18.2589 +						u += 6;
 18.2590 +						}
 18.2591 +					else
 18.2592 +						{
 18.2593 +						u += 4;
 18.2594 +						}
 18.2595 +					break;
 18.2596 +				case ClassWriter.VAR_INSN:
 18.2597 +				case ClassWriter.SBYTE_INSN:
 18.2598 +				case ClassWriter.LDC_INSN:
 18.2599 +					u += 2;
 18.2600 +					break;
 18.2601 +				case ClassWriter.SHORT_INSN:
 18.2602 +				case ClassWriter.LDCW_INSN:
 18.2603 +				case ClassWriter.FIELDORMETH_INSN:
 18.2604 +				case ClassWriter.TYPE_INSN:
 18.2605 +				case ClassWriter.IINC_INSN:
 18.2606 +					u += 3;
 18.2607 +					break;
 18.2608 +				case ClassWriter.ITFMETH_INSN:
 18.2609 +					u += 5;
 18.2610 +					break;
 18.2611 +					// case ClassWriter.MANA_INSN:
 18.2612 +				default:
 18.2613 +					u += 4;
 18.2614 +					break;
 18.2615 +				}
 18.2616 +			if(insert != 0)
 18.2617 +				{
 18.2618 +				// adds a new (u, insert) entry in the allIndexes and
 18.2619 +				// allSizes arrays
 18.2620 +				int[] newIndexes = new int[allIndexes.length + 1];
 18.2621 +				int[] newSizes = new int[allSizes.length + 1];
 18.2622 +				System.arraycopy(allIndexes,
 18.2623 +				                 0,
 18.2624 +				                 newIndexes,
 18.2625 +				                 0,
 18.2626 +				                 allIndexes.length);
 18.2627 +				System.arraycopy(allSizes, 0, newSizes, 0, allSizes.length);
 18.2628 +				newIndexes[allIndexes.length] = u;
 18.2629 +				newSizes[allSizes.length] = insert;
 18.2630 +				allIndexes = newIndexes;
 18.2631 +				allSizes = newSizes;
 18.2632 +				if(insert > 0)
 18.2633 +					{
 18.2634 +					state = 3;
 18.2635 +					}
 18.2636 +				}
 18.2637 +			}
 18.2638 +		if(state < 3)
 18.2639 +			{
 18.2640 +			--state;
 18.2641 +			}
 18.2642 +		} while(state != 0);
 18.2643 +
 18.2644 +	// 2nd step:
 18.2645 +	// copies the bytecode of the method into a new bytevector, updates the
 18.2646 +	// offsets, and inserts (or removes) bytes as requested.
 18.2647 +
 18.2648 +	ByteVector newCode = new ByteVector(code.length);
 18.2649 +
 18.2650 +	u = 0;
 18.2651 +	while(u < code.length)
 18.2652 +		{
 18.2653 +		int opcode = b[u] & 0xFF;
 18.2654 +		switch(ClassWriter.TYPE[opcode])
 18.2655 +			{
 18.2656 +			case ClassWriter.NOARG_INSN:
 18.2657 +			case ClassWriter.IMPLVAR_INSN:
 18.2658 +				newCode.putByte(opcode);
 18.2659 +				u += 1;
 18.2660 +				break;
 18.2661 +			case ClassWriter.LABEL_INSN:
 18.2662 +				if(opcode > 201)
 18.2663 +					{
 18.2664 +					// changes temporary opcodes 202 to 217 (inclusive), 218
 18.2665 +					// and 219 to IFEQ ... JSR (inclusive), IFNULL and
 18.2666 +					// IFNONNULL
 18.2667 +					opcode = opcode < 218 ? opcode - 49 : opcode - 20;
 18.2668 +					label = u + readUnsignedShort(b, u + 1);
 18.2669 +					}
 18.2670 +				else
 18.2671 +					{
 18.2672 +					label = u + readShort(b, u + 1);
 18.2673 +					}
 18.2674 +				newOffset = getNewOffset(allIndexes, allSizes, u, label);
 18.2675 +				if(resize[u])
 18.2676 +					{
 18.2677 +					// replaces GOTO with GOTO_W, JSR with JSR_W and IFxxx
 18.2678 +					// <l> with IFNOTxxx <l'> GOTO_W <l>, where IFNOTxxx is
 18.2679 +					// the "opposite" opcode of IFxxx (i.e., IFNE for IFEQ)
 18.2680 +					// and where <l'> designates the instruction just after
 18.2681 +					// the GOTO_W.
 18.2682 +					if(opcode == Opcodes.GOTO)
 18.2683 +						{
 18.2684 +						newCode.putByte(200); // GOTO_W
 18.2685 +						}
 18.2686 +					else if(opcode == Opcodes.JSR)
 18.2687 +						{
 18.2688 +						newCode.putByte(201); // JSR_W
 18.2689 +						}
 18.2690 +					else
 18.2691 +						{
 18.2692 +						newCode.putByte(opcode <= 166
 18.2693 +						                ? ((opcode + 1) ^ 1) - 1
 18.2694 +						                : opcode ^ 1);
 18.2695 +						newCode.putShort(8); // jump offset
 18.2696 +						newCode.putByte(200); // GOTO_W
 18.2697 +						// newOffset now computed from start of GOTO_W
 18.2698 +						newOffset -= 3;
 18.2699 +						}
 18.2700 +					newCode.putInt(newOffset);
 18.2701 +					}
 18.2702 +				else
 18.2703 +					{
 18.2704 +					newCode.putByte(opcode);
 18.2705 +					newCode.putShort(newOffset);
 18.2706 +					}
 18.2707 +				u += 3;
 18.2708 +				break;
 18.2709 +			case ClassWriter.LABELW_INSN:
 18.2710 +				label = u + readInt(b, u + 1);
 18.2711 +				newOffset = getNewOffset(allIndexes, allSizes, u, label);
 18.2712 +				newCode.putByte(opcode);
 18.2713 +				newCode.putInt(newOffset);
 18.2714 +				u += 5;
 18.2715 +				break;
 18.2716 +			case ClassWriter.TABL_INSN:
 18.2717 +				// skips 0 to 3 padding bytes
 18.2718 +				v = u;
 18.2719 +				u = u + 4 - (v & 3);
 18.2720 +				// reads and copies instruction
 18.2721 +				newCode.putByte(Opcodes.TABLESWITCH);
 18.2722 +				newCode.length += (4 - newCode.length % 4) % 4;
 18.2723 +				label = v + readInt(b, u);
 18.2724 +				u += 4;
 18.2725 +				newOffset = getNewOffset(allIndexes, allSizes, v, label);
 18.2726 +				newCode.putInt(newOffset);
 18.2727 +				j = readInt(b, u);
 18.2728 +				u += 4;
 18.2729 +				newCode.putInt(j);
 18.2730 +				j = readInt(b, u) - j + 1;
 18.2731 +				u += 4;
 18.2732 +				newCode.putInt(readInt(b, u - 4));
 18.2733 +				for(; j > 0; --j)
 18.2734 +					{
 18.2735 +					label = v + readInt(b, u);
 18.2736 +					u += 4;
 18.2737 +					newOffset = getNewOffset(allIndexes, allSizes, v, label);
 18.2738 +					newCode.putInt(newOffset);
 18.2739 +					}
 18.2740 +				break;
 18.2741 +			case ClassWriter.LOOK_INSN:
 18.2742 +				// skips 0 to 3 padding bytes
 18.2743 +				v = u;
 18.2744 +				u = u + 4 - (v & 3);
 18.2745 +				// reads and copies instruction
 18.2746 +				newCode.putByte(Opcodes.LOOKUPSWITCH);
 18.2747 +				newCode.length += (4 - newCode.length % 4) % 4;
 18.2748 +				label = v + readInt(b, u);
 18.2749 +				u += 4;
 18.2750 +				newOffset = getNewOffset(allIndexes, allSizes, v, label);
 18.2751 +				newCode.putInt(newOffset);
 18.2752 +				j = readInt(b, u);
 18.2753 +				u += 4;
 18.2754 +				newCode.putInt(j);
 18.2755 +				for(; j > 0; --j)
 18.2756 +					{
 18.2757 +					newCode.putInt(readInt(b, u));
 18.2758 +					u += 4;
 18.2759 +					label = v + readInt(b, u);
 18.2760 +					u += 4;
 18.2761 +					newOffset = getNewOffset(allIndexes, allSizes, v, label);
 18.2762 +					newCode.putInt(newOffset);
 18.2763 +					}
 18.2764 +				break;
 18.2765 +			case ClassWriter.WIDE_INSN:
 18.2766 +				opcode = b[u + 1] & 0xFF;
 18.2767 +				if(opcode == Opcodes.IINC)
 18.2768 +					{
 18.2769 +					newCode.putByteArray(b, u, 6);
 18.2770 +					u += 6;
 18.2771 +					}
 18.2772 +				else
 18.2773 +					{
 18.2774 +					newCode.putByteArray(b, u, 4);
 18.2775 +					u += 4;
 18.2776 +					}
 18.2777 +				break;
 18.2778 +			case ClassWriter.VAR_INSN:
 18.2779 +			case ClassWriter.SBYTE_INSN:
 18.2780 +			case ClassWriter.LDC_INSN:
 18.2781 +				newCode.putByteArray(b, u, 2);
 18.2782 +				u += 2;
 18.2783 +				break;
 18.2784 +			case ClassWriter.SHORT_INSN:
 18.2785 +			case ClassWriter.LDCW_INSN:
 18.2786 +			case ClassWriter.FIELDORMETH_INSN:
 18.2787 +			case ClassWriter.TYPE_INSN:
 18.2788 +			case ClassWriter.IINC_INSN:
 18.2789 +				newCode.putByteArray(b, u, 3);
 18.2790 +				u += 3;
 18.2791 +				break;
 18.2792 +			case ClassWriter.ITFMETH_INSN:
 18.2793 +				newCode.putByteArray(b, u, 5);
 18.2794 +				u += 5;
 18.2795 +				break;
 18.2796 +				// case MANA_INSN:
 18.2797 +			default:
 18.2798 +				newCode.putByteArray(b, u, 4);
 18.2799 +				u += 4;
 18.2800 +				break;
 18.2801 +			}
 18.2802 +		}
 18.2803 +
 18.2804 +	// recomputes the stack map frames
 18.2805 +	if(frameCount > 0)
 18.2806 +		{
 18.2807 +		if(compute == FRAMES)
 18.2808 +			{
 18.2809 +			frameCount = 0;
 18.2810 +			stackMap = null;
 18.2811 +			previousFrame = null;
 18.2812 +			frame = null;
 18.2813 +			Frame f = new Frame();
 18.2814 +			f.owner = labels;
 18.2815 +			Type[] args = Type.getArgumentTypes(descriptor);
 18.2816 +			f.initInputFrame(cw, access, args, maxLocals);
 18.2817 +			visitFrame(f);
 18.2818 +			Label l = labels;
 18.2819 +			while(l != null)
 18.2820 +				{
 18.2821 +				/*
 18.2822 +									 * here we need the original label position. getNewOffset
 18.2823 +									 * must therefore never have been called for this label.
 18.2824 +									 */
 18.2825 +				u = l.position - 3;
 18.2826 +				if((l.status & Label.STORE) != 0 || (u >= 0 && resize[u]))
 18.2827 +					{
 18.2828 +					getNewOffset(allIndexes, allSizes, l);
 18.2829 +					// TODO update offsets in UNINITIALIZED values
 18.2830 +					visitFrame(l.frame);
 18.2831 +					}
 18.2832 +				l = l.successor;
 18.2833 +				}
 18.2834 +			}
 18.2835 +		else
 18.2836 +			{
 18.2837 +			/*
 18.2838 +							 * Resizing an existing stack map frame table is really hard.
 18.2839 +							 * Not only the table must be parsed to update the offets, but
 18.2840 +							 * new frames may be needed for jump instructions that were
 18.2841 +							 * inserted by this method. And updating the offsets or
 18.2842 +							 * inserting frames can change the format of the following
 18.2843 +							 * frames, in case of packed frames. In practice the whole table
 18.2844 +							 * must be recomputed. For this the frames are marked as
 18.2845 +							 * potentially invalid. This will cause the whole class to be
 18.2846 +							 * reread and rewritten with the COMPUTE_FRAMES option (see the
 18.2847 +							 * ClassWriter.toByteArray method). This is not very efficient
 18.2848 +							 * but is much easier and requires much less code than any other
 18.2849 +							 * method I can think of.
 18.2850 +							 */
 18.2851 +			cw.invalidFrames = true;
 18.2852 +			}
 18.2853 +		}
 18.2854 +	// updates the exception handler block labels
 18.2855 +	Handler h = firstHandler;
 18.2856 +	while(h != null)
 18.2857 +		{
 18.2858 +		getNewOffset(allIndexes, allSizes, h.start);
 18.2859 +		getNewOffset(allIndexes, allSizes, h.end);
 18.2860 +		getNewOffset(allIndexes, allSizes, h.handler);
 18.2861 +		h = h.next;
 18.2862 +		}
 18.2863 +	// updates the instructions addresses in the
 18.2864 +	// local var and line number tables
 18.2865 +	for(i = 0; i < 2; ++i)
 18.2866 +		{
 18.2867 +		ByteVector bv = i == 0 ? localVar : localVarType;
 18.2868 +		if(bv != null)
 18.2869 +			{
 18.2870 +			b = bv.data;
 18.2871 +			u = 0;
 18.2872 +			while(u < bv.length)
 18.2873 +				{
 18.2874 +				label = readUnsignedShort(b, u);
 18.2875 +				newOffset = getNewOffset(allIndexes, allSizes, 0, label);
 18.2876 +				writeShort(b, u, newOffset);
 18.2877 +				label += readUnsignedShort(b, u + 2);
 18.2878 +				newOffset = getNewOffset(allIndexes, allSizes, 0, label)
 18.2879 +				            - newOffset;
 18.2880 +				writeShort(b, u + 2, newOffset);
 18.2881 +				u += 10;
 18.2882 +				}
 18.2883 +			}
 18.2884 +		}
 18.2885 +	if(lineNumber != null)
 18.2886 +		{
 18.2887 +		b = lineNumber.data;
 18.2888 +		u = 0;
 18.2889 +		while(u < lineNumber.length)
 18.2890 +			{
 18.2891 +			writeShort(b, u, getNewOffset(allIndexes,
 18.2892 +			                              allSizes,
 18.2893 +			                              0,
 18.2894 +			                              readUnsignedShort(b, u)));
 18.2895 +			u += 4;
 18.2896 +			}
 18.2897 +		}
 18.2898 +	// updates the labels of the other attributes
 18.2899 +	Attribute attr = cattrs;
 18.2900 +	while(attr != null)
 18.2901 +		{
 18.2902 +		Label[] labels = attr.getLabels();
 18.2903 +		if(labels != null)
 18.2904 +			{
 18.2905 +			for(i = labels.length - 1; i >= 0; --i)
 18.2906 +				{
 18.2907 +				getNewOffset(allIndexes, allSizes, labels[i]);
 18.2908 +				}
 18.2909 +			}
 18.2910 +		attr = attr.next;
 18.2911 +		}
 18.2912 +
 18.2913 +	// replaces old bytecodes with new ones
 18.2914 +	code = newCode;
 18.2915 +}
 18.2916 +
 18.2917 +/**
 18.2918 + * Reads an unsigned short value in the given byte array.
 18.2919 + *
 18.2920 + * @param b     a byte array.
 18.2921 + * @param index the start index of the value to be read.
 18.2922 + * @return the read value.
 18.2923 + */
 18.2924 +static int readUnsignedShort(final byte[] b, final int index){
 18.2925 +	return ((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF);
 18.2926 +}
 18.2927 +
 18.2928 +/**
 18.2929 + * Reads a signed short value in the given byte array.
 18.2930 + *
 18.2931 + * @param b     a byte array.
 18.2932 + * @param index the start index of the value to be read.
 18.2933 + * @return the read value.
 18.2934 + */
 18.2935 +static short readShort(final byte[] b, final int index){
 18.2936 +	return (short) (((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF));
 18.2937 +}
 18.2938 +
 18.2939 +/**
 18.2940 + * Reads a signed int value in the given byte array.
 18.2941 + *
 18.2942 + * @param b     a byte array.
 18.2943 + * @param index the start index of the value to be read.
 18.2944 + * @return the read value.
 18.2945 + */
 18.2946 +static int readInt(final byte[] b, final int index){
 18.2947 +	return ((b[index] & 0xFF) << 24) | ((b[index + 1] & 0xFF) << 16)
 18.2948 +	       | ((b[index + 2] & 0xFF) << 8) | (b[index + 3] & 0xFF);
 18.2949 +}
 18.2950 +
 18.2951 +/**
 18.2952 + * Writes a short value in the given byte array.
 18.2953 + *
 18.2954 + * @param b     a byte array.
 18.2955 + * @param index where the first byte of the short value must be written.
 18.2956 + * @param s     the value to be written in the given byte array.
 18.2957 + */
 18.2958 +static void writeShort(final byte[] b, final int index, final int s){
 18.2959 +	b[index] = (byte) (s >>> 8);
 18.2960 +	b[index + 1] = (byte) s;
 18.2961 +}
 18.2962 +
 18.2963 +/**
 18.2964 + * Computes the future value of a bytecode offset. <p> Note: it is possible
 18.2965 + * to have several entries for the same instruction in the <tt>indexes</tt>
 18.2966 + * and <tt>sizes</tt>: two entries (index=a,size=b) and (index=a,size=b')
 18.2967 + * are equivalent to a single entry (index=a,size=b+b').
 18.2968 + *
 18.2969 + * @param indexes current positions of the instructions to be resized. Each
 18.2970 + *                instruction must be designated by the index of its <i>last</i>
 18.2971 + *                byte, plus one (or, in other words, by the index of the <i>first</i>
 18.2972 + *                byte of the <i>next</i> instruction).
 18.2973 + * @param sizes   the number of bytes to be <i>added</i> to the above
 18.2974 + *                instructions. More precisely, for each i < <tt>len</tt>,
 18.2975 + *                <tt>sizes</tt>[i] bytes will be added at the end of the
 18.2976 + *                instruction designated by <tt>indexes</tt>[i] or, if
 18.2977 + *                <tt>sizes</tt>[i] is negative, the <i>last</i> |<tt>sizes[i]</tt>|
 18.2978 + *                bytes of the instruction will be removed (the instruction size
 18.2979 + *                <i>must not</i> become negative or null).
 18.2980 + * @param begin   index of the first byte of the source instruction.
 18.2981 + * @param end     index of the first byte of the target instruction.
 18.2982 + * @return the future value of the given bytecode offset.
 18.2983 + */
 18.2984 +static int getNewOffset(
 18.2985 +		final int[] indexes,
 18.2986 +		final int[] sizes,
 18.2987 +		final int begin,
 18.2988 +		final int end){
 18.2989 +	int offset = end - begin;
 18.2990 +	for(int i = 0; i < indexes.length; ++i)
 18.2991 +		{
 18.2992 +		if(begin < indexes[i] && indexes[i] <= end)
 18.2993 +			{
 18.2994 +			// forward jump
 18.2995 +			offset += sizes[i];
 18.2996 +			}
 18.2997 +		else if(end < indexes[i] && indexes[i] <= begin)
 18.2998 +			{
 18.2999 +			// backward jump
 18.3000 +			offset -= sizes[i];
 18.3001 +			}
 18.3002 +		}
 18.3003 +	return offset;
 18.3004 +}
 18.3005 +
 18.3006 +/**
 18.3007 + * Updates the offset of the given label.
 18.3008 + *
 18.3009 + * @param indexes current positions of the instructions to be resized. Each
 18.3010 + *                instruction must be designated by the index of its <i>last</i>
 18.3011 + *                byte, plus one (or, in other words, by the index of the <i>first</i>
 18.3012 + *                byte of the <i>next</i> instruction).
 18.3013 + * @param sizes   the number of bytes to be <i>added</i> to the above
 18.3014 + *                instructions. More precisely, for each i < <tt>len</tt>,
 18.3015 + *                <tt>sizes</tt>[i] bytes will be added at the end of the
 18.3016 + *                instruction designated by <tt>indexes</tt>[i] or, if
 18.3017 + *                <tt>sizes</tt>[i] is negative, the <i>last</i> |<tt>sizes[i]</tt>|
 18.3018 + *                bytes of the instruction will be removed (the instruction size
 18.3019 + *                <i>must not</i> become negative or null).
 18.3020 + * @param label   the label whose offset must be updated.
 18.3021 + */
 18.3022 +static void getNewOffset(
 18.3023 +		final int[] indexes,
 18.3024 +		final int[] sizes,
 18.3025 +		final Label label){
 18.3026 +	if((label.status & Label.RESIZED) == 0)
 18.3027 +		{
 18.3028 +		label.position = getNewOffset(indexes, sizes, 0, label.position);
 18.3029 +		label.status |= Label.RESIZED;
 18.3030 +		}
 18.3031 +}
 18.3032 +}
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/clojure/asm/Opcodes.java	Sat Aug 21 06:25:44 2010 -0400
    19.3 @@ -0,0 +1,341 @@
    19.4 +/***
    19.5 + * ASM: a very small and fast Java bytecode manipulation framework
    19.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    19.7 + * All rights reserved.
    19.8 + *
    19.9 + * Redistribution and use in source and binary forms, with or without
   19.10 + * modification, are permitted provided that the following conditions
   19.11 + * are met:
   19.12 + * 1. Redistributions of source code must retain the above copyright
   19.13 + *    notice, this list of conditions and the following disclaimer.
   19.14 + * 2. Redistributions in binary form must reproduce the above copyright
   19.15 + *    notice, this list of conditions and the following disclaimer in the
   19.16 + *    documentation and/or other materials provided with the distribution.
   19.17 + * 3. Neither the name of the copyright holders nor the names of its
   19.18 + *    contributors may be used to endorse or promote products derived from
   19.19 + *    this software without specific prior written permission.
   19.20 + *
   19.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   19.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   19.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   19.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   19.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   19.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   19.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   19.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   19.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   19.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   19.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   19.32 + */
   19.33 +package clojure.asm;
   19.34 +
   19.35 +/**
   19.36 + * Defines the JVM opcodes, access flags and array type codes. This interface
   19.37 + * does not define all the JVM opcodes because some opcodes are automatically
   19.38 + * handled. For example, the xLOAD and xSTORE opcodes are automatically replaced
   19.39 + * by xLOAD_n and xSTORE_n opcodes when possible. The xLOAD_n and xSTORE_n
   19.40 + * opcodes are therefore not defined in this interface. Likewise for LDC,
   19.41 + * automatically replaced by LDC_W or LDC2_W when necessary, WIDE, GOTO_W and
   19.42 + * JSR_W.
   19.43 + *
   19.44 + * @author Eric Bruneton
   19.45 + * @author Eugene Kuleshov
   19.46 + */
   19.47 +public interface Opcodes{
   19.48 +
   19.49 +// versions
   19.50 +
   19.51 +int V1_1 = 3 << 16 | 45;
   19.52 +int V1_2 = 0 << 16 | 46;
   19.53 +int V1_3 = 0 << 16 | 47;
   19.54 +int V1_4 = 0 << 16 | 48;
   19.55 +int V1_5 = 0 << 16 | 49;
   19.56 +int V1_6 = 0 << 16 | 50;
   19.57 +
   19.58 +// access flags
   19.59 +
   19.60 +int ACC_PUBLIC = 0x0001; // class, field, method
   19.61 +int ACC_PRIVATE = 0x0002; // class, field, method
   19.62 +int ACC_PROTECTED = 0x0004; // class, field, method
   19.63 +int ACC_STATIC = 0x0008; // field, method
   19.64 +int ACC_FINAL = 0x0010; // class, field, method
   19.65 +int ACC_SUPER = 0x0020; // class
   19.66 +int ACC_SYNCHRONIZED = 0x0020; // method
   19.67 +int ACC_VOLATILE = 0x0040; // field
   19.68 +int ACC_BRIDGE = 0x0040; // method
   19.69 +int ACC_VARARGS = 0x0080; // method
   19.70 +int ACC_TRANSIENT = 0x0080; // field
   19.71 +int ACC_NATIVE = 0x0100; // method
   19.72 +int ACC_INTERFACE = 0x0200; // class
   19.73 +int ACC_ABSTRACT = 0x0400; // class, method
   19.74 +int ACC_STRICT = 0x0800; // method
   19.75 +int ACC_SYNTHETIC = 0x1000; // class, field, method
   19.76 +int ACC_ANNOTATION = 0x2000; // class
   19.77 +int ACC_ENUM = 0x4000; // class(?) field inner
   19.78 +
   19.79 +// ASM specific pseudo access flags
   19.80 +
   19.81 +int ACC_DEPRECATED = 131072; // class, field, method
   19.82 +
   19.83 +// types for NEWARRAY
   19.84 +
   19.85 +int T_BOOLEAN = 4;
   19.86 +int T_CHAR = 5;
   19.87 +int T_FLOAT = 6;
   19.88 +int T_DOUBLE = 7;
   19.89 +int T_BYTE = 8;
   19.90 +int T_SHORT = 9;
   19.91 +int T_INT = 10;
   19.92 +int T_LONG = 11;
   19.93 +
   19.94 +// stack map frame types
   19.95 +
   19.96 +/**
   19.97 + * Represents an expanded frame. See {@link ClassReader#EXPAND_FRAMES}.
   19.98 + */
   19.99 +int F_NEW = -1;
  19.100 +
  19.101 +/**
  19.102 + * Represents a compressed frame with complete frame data.
  19.103 + */
  19.104 +int F_FULL = 0;
  19.105 +
  19.106 +/**
  19.107 + * Represents a compressed frame where locals are the same as the locals in
  19.108 + * the previous frame, except that additional 1-3 locals are defined, and
  19.109 + * with an empty stack.
  19.110 + */
  19.111 +int F_APPEND = 1;
  19.112 +
  19.113 +/**
  19.114 + * Represents a compressed frame where locals are the same as the locals in
  19.115 + * the previous frame, except that the last 1-3 locals are absent and with
  19.116 + * an empty stack.
  19.117 + */
  19.118 +int F_CHOP = 2;
  19.119 +
  19.120 +/**
  19.121 + * Represents a compressed frame with exactly the same locals as the
  19.122 + * previous frame and with an empty stack.
  19.123 + */
  19.124 +int F_SAME = 3;
  19.125 +
  19.126 +/**
  19.127 + * Represents a compressed frame with exactly the same locals as the
  19.128 + * previous frame and with a single value on the stack.
  19.129 + */
  19.130 +int F_SAME1 = 4;
  19.131 +
  19.132 +Integer TOP = new Integer(0);
  19.133 +Integer INTEGER = new Integer(1);
  19.134 +Integer FLOAT = new Integer(2);
  19.135 +Integer DOUBLE = new Integer(3);
  19.136 +Integer LONG = new Integer(4);
  19.137 +Integer NULL = new Integer(5);
  19.138 +Integer UNINITIALIZED_THIS = new Integer(6);
  19.139 +
  19.140 +// opcodes // visit method (- = idem)
  19.141 +
  19.142 +int NOP = 0; // visitInsn
  19.143 +int ACONST_NULL = 1; // -
  19.144 +int ICONST_M1 = 2; // -
  19.145 +int ICONST_0 = 3; // -
  19.146 +int ICONST_1 = 4; // -
  19.147 +int ICONST_2 = 5; // -
  19.148 +int ICONST_3 = 6; // -
  19.149 +int ICONST_4 = 7; // -
  19.150 +int ICONST_5 = 8; // -
  19.151 +int LCONST_0 = 9; // -
  19.152 +int LCONST_1 = 10; // -
  19.153 +int FCONST_0 = 11; // -
  19.154 +int FCONST_1 = 12; // -
  19.155 +int FCONST_2 = 13; // -
  19.156 +int DCONST_0 = 14; // -
  19.157 +int DCONST_1 = 15; // -
  19.158 +int BIPUSH = 16; // visitIntInsn
  19.159 +int SIPUSH = 17; // -
  19.160 +int LDC = 18; // visitLdcInsn
  19.161 +// int LDC_W = 19; // -
  19.162 +// int LDC2_W = 20; // -
  19.163 +int ILOAD = 21; // visitVarInsn
  19.164 +int LLOAD = 22; // -
  19.165 +int FLOAD = 23; // -
  19.166 +int DLOAD = 24; // -
  19.167 +int ALOAD = 25; // -
  19.168 +// int ILOAD_0 = 26; // -
  19.169 +// int ILOAD_1 = 27; // -
  19.170 +// int ILOAD_2 = 28; // -
  19.171 +// int ILOAD_3 = 29; // -
  19.172 +// int LLOAD_0 = 30; // -
  19.173 +// int LLOAD_1 = 31; // -
  19.174 +// int LLOAD_2 = 32; // -
  19.175 +// int LLOAD_3 = 33; // -
  19.176 +// int FLOAD_0 = 34; // -
  19.177 +// int FLOAD_1 = 35; // -
  19.178 +// int FLOAD_2 = 36; // -
  19.179 +// int FLOAD_3 = 37; // -
  19.180 +// int DLOAD_0 = 38; // -
  19.181 +// int DLOAD_1 = 39; // -
  19.182 +// int DLOAD_2 = 40; // -
  19.183 +// int DLOAD_3 = 41; // -
  19.184 +// int ALOAD_0 = 42; // -
  19.185 +// int ALOAD_1 = 43; // -
  19.186 +// int ALOAD_2 = 44; // -
  19.187 +// int ALOAD_3 = 45; // -
  19.188 +int IALOAD = 46; // visitInsn
  19.189 +int LALOAD = 47; // -
  19.190 +int FALOAD = 48; // -
  19.191 +int DALOAD = 49; // -
  19.192 +int AALOAD = 50; // -
  19.193 +int BALOAD = 51; // -
  19.194 +int CALOAD = 52; // -
  19.195 +int SALOAD = 53; // -
  19.196 +int ISTORE = 54; // visitVarInsn
  19.197 +int LSTORE = 55; // -
  19.198 +int FSTORE = 56; // -
  19.199 +int DSTORE = 57; // -
  19.200 +int ASTORE = 58; // -
  19.201 +// int ISTORE_0 = 59; // -
  19.202 +// int ISTORE_1 = 60; // -
  19.203 +// int ISTORE_2 = 61; // -
  19.204 +// int ISTORE_3 = 62; // -
  19.205 +// int LSTORE_0 = 63; // -
  19.206 +// int LSTORE_1 = 64; // -
  19.207 +// int LSTORE_2 = 65; // -
  19.208 +// int LSTORE_3 = 66; // -
  19.209 +// int FSTORE_0 = 67; // -
  19.210 +// int FSTORE_1 = 68; // -
  19.211 +// int FSTORE_2 = 69; // -
  19.212 +// int FSTORE_3 = 70; // -
  19.213 +// int DSTORE_0 = 71; // -
  19.214 +// int DSTORE_1 = 72; // -
  19.215 +// int DSTORE_2 = 73; // -
  19.216 +// int DSTORE_3 = 74; // -
  19.217 +// int ASTORE_0 = 75; // -
  19.218 +// int ASTORE_1 = 76; // -
  19.219 +// int ASTORE_2 = 77; // -
  19.220 +// int ASTORE_3 = 78; // -
  19.221 +int IASTORE = 79; // visitInsn
  19.222 +int LASTORE = 80; // -
  19.223 +int FASTORE = 81; // -
  19.224 +int DASTORE = 82; // -
  19.225 +int AASTORE = 83; // -
  19.226 +int BASTORE = 84; // -
  19.227 +int CASTORE = 85; // -
  19.228 +int SASTORE = 86; // -
  19.229 +int POP = 87; // -
  19.230 +int POP2 = 88; // -
  19.231 +int DUP = 89; // -
  19.232 +int DUP_X1 = 90; // -
  19.233 +int DUP_X2 = 91; // -
  19.234 +int DUP2 = 92; // -
  19.235 +int DUP2_X1 = 93; // -
  19.236 +int DUP2_X2 = 94; // -
  19.237 +int SWAP = 95; // -
  19.238 +int IADD = 96; // -
  19.239 +int LADD = 97; // -
  19.240 +int FADD = 98; // -
  19.241 +int DADD = 99; // -
  19.242 +int ISUB = 100; // -
  19.243 +int LSUB = 101; // -
  19.244 +int FSUB = 102; // -
  19.245 +int DSUB = 103; // -
  19.246 +int IMUL = 104; // -
  19.247 +int LMUL = 105; // -
  19.248 +int FMUL = 106; // -
  19.249 +int DMUL = 107; // -
  19.250 +int IDIV = 108; // -
  19.251 +int LDIV = 109; // -
  19.252 +int FDIV = 110; // -
  19.253 +int DDIV = 111; // -
  19.254 +int IREM = 112; // -
  19.255 +int LREM = 113; // -
  19.256 +int FREM = 114; // -
  19.257 +int DREM = 115; // -
  19.258 +int INEG = 116; // -
  19.259 +int LNEG = 117; // -
  19.260 +int FNEG = 118; // -
  19.261 +int DNEG = 119; // -
  19.262 +int ISHL = 120; // -
  19.263 +int LSHL = 121; // -
  19.264 +int ISHR = 122; // -
  19.265 +int LSHR = 123; // -
  19.266 +int IUSHR = 124; // -
  19.267 +int LUSHR = 125; // -
  19.268 +int IAND = 126; // -
  19.269 +int LAND = 127; // -
  19.270 +int IOR = 128; // -
  19.271 +int LOR = 129; // -
  19.272 +int IXOR = 130; // -
  19.273 +int LXOR = 131; // -
  19.274 +int IINC = 132; // visitIincInsn
  19.275 +int I2L = 133; // visitInsn
  19.276 +int I2F = 134; // -
  19.277 +int I2D = 135; // -
  19.278 +int L2I = 136; // -
  19.279 +int L2F = 137; // -
  19.280 +int L2D = 138; // -
  19.281 +int F2I = 139; // -
  19.282 +int F2L = 140; // -
  19.283 +int F2D = 141; // -
  19.284 +int D2I = 142; // -
  19.285 +int D2L = 143; // -
  19.286 +int D2F = 144; // -
  19.287 +int I2B = 145; // -
  19.288 +int I2C = 146; // -
  19.289 +int I2S = 147; // -
  19.290 +int LCMP = 148; // -
  19.291 +int FCMPL = 149; // -
  19.292 +int FCMPG = 150; // -
  19.293 +int DCMPL = 151; // -
  19.294 +int DCMPG = 152; // -
  19.295 +int IFEQ = 153; // visitJumpInsn
  19.296 +int IFNE = 154; // -
  19.297 +int IFLT = 155; // -
  19.298 +int IFGE = 156; // -
  19.299 +int IFGT = 157; // -
  19.300 +int IFLE = 158; // -
  19.301 +int IF_ICMPEQ = 159; // -
  19.302 +int IF_ICMPNE = 160; // -
  19.303 +int IF_ICMPLT = 161; // -
  19.304 +int IF_ICMPGE = 162; // -
  19.305 +int IF_ICMPGT = 163; // -
  19.306 +int IF_ICMPLE = 164; // -
  19.307 +int IF_ACMPEQ = 165; // -
  19.308 +int IF_ACMPNE = 166; // -
  19.309 +int GOTO = 167; // -
  19.310 +int JSR = 168; // -
  19.311 +int RET = 169; // visitVarInsn
  19.312 +int TABLESWITCH = 170; // visiTableSwitchInsn
  19.313 +int LOOKUPSWITCH = 171; // visitLookupSwitch
  19.314 +int IRETURN = 172; // visitInsn
  19.315 +int LRETURN = 173; // -
  19.316 +int FRETURN = 174; // -
  19.317 +int DRETURN = 175; // -
  19.318 +int ARETURN = 176; // -
  19.319 +int RETURN = 177; // -
  19.320 +int GETSTATIC = 178; // visitFieldInsn
  19.321 +int PUTSTATIC = 179; // -
  19.322 +int GETFIELD = 180; // -
  19.323 +int PUTFIELD = 181; // -
  19.324 +int INVOKEVIRTUAL = 182; // visitMethodInsn
  19.325 +int INVOKESPECIAL = 183; // -
  19.326 +int INVOKESTATIC = 184; // -
  19.327 +int INVOKEINTERFACE = 185; // -
  19.328 +// int UNUSED = 186; // NOT VISITED
  19.329 +int NEW = 187; // visitTypeInsn
  19.330 +int NEWARRAY = 188; // visitIntInsn
  19.331 +int ANEWARRAY = 189; // visitTypeInsn
  19.332 +int ARRAYLENGTH = 190; // visitInsn
  19.333 +int ATHROW = 191; // -
  19.334 +int CHECKCAST = 192; // visitTypeInsn
  19.335 +int INSTANCEOF = 193; // -
  19.336 +int MONITORENTER = 194; // visitInsn
  19.337 +int MONITOREXIT = 195; // -
  19.338 +// int WIDE = 196; // NOT VISITED
  19.339 +int MULTIANEWARRAY = 197; // visitMultiANewArrayInsn
  19.340 +int IFNULL = 198; // visitJumpInsn
  19.341 +int IFNONNULL = 199; // -
  19.342 +// int GOTO_W = 200; // -
  19.343 +// int JSR_W = 201; // -
  19.344 +}
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/clojure/asm/Type.java	Sat Aug 21 06:25:44 2010 -0400
    20.3 @@ -0,0 +1,872 @@
    20.4 +/***
    20.5 + * ASM: a very small and fast Java bytecode manipulation framework
    20.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    20.7 + * All rights reserved.
    20.8 + *
    20.9 + * Redistribution and use in source and binary forms, with or without
   20.10 + * modification, are permitted provided that the following conditions
   20.11 + * are met:
   20.12 + * 1. Redistributions of source code must retain the above copyright
   20.13 + *    notice, this list of conditions and the following disclaimer.
   20.14 + * 2. Redistributions in binary form must reproduce the above copyright
   20.15 + *    notice, this list of conditions and the following disclaimer in the
   20.16 + *    documentation and/or other materials provided with the distribution.
   20.17 + * 3. Neither the name of the copyright holders nor the names of its
   20.18 + *    contributors may be used to endorse or promote products derived from
   20.19 + *    this software without specific prior written permission.
   20.20 + *
   20.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   20.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   20.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   20.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   20.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   20.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   20.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   20.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   20.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   20.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   20.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   20.32 + */
   20.33 +package clojure.asm;
   20.34 +
   20.35 +import java.lang.reflect.Constructor;
   20.36 +import java.lang.reflect.Method;
   20.37 +
   20.38 +/**
   20.39 + * A Java type. This class can be used to make it easier to manipulate type and
   20.40 + * method descriptors.
   20.41 + *
   20.42 + * @author Eric Bruneton
   20.43 + * @author Chris Nokleberg
   20.44 + */
   20.45 +public class Type{
   20.46 +
   20.47 +/**
   20.48 + * The sort of the <tt>void</tt> type. See {@link #getSort getSort}.
   20.49 + */
   20.50 +public final static int VOID = 0;
   20.51 +
   20.52 +/**
   20.53 + * The sort of the <tt>boolean</tt> type. See {@link #getSort getSort}.
   20.54 + */
   20.55 +public final static int BOOLEAN = 1;
   20.56 +
   20.57 +/**
   20.58 + * The sort of the <tt>char</tt> type. See {@link #getSort getSort}.
   20.59 + */
   20.60 +public final static int CHAR = 2;
   20.61 +
   20.62 +/**
   20.63 + * The sort of the <tt>byte</tt> type. See {@link #getSort getSort}.
   20.64 + */
   20.65 +public final static int BYTE = 3;
   20.66 +
   20.67 +/**
   20.68 + * The sort of the <tt>short</tt> type. See {@link #getSort getSort}.
   20.69 + */
   20.70 +public final static int SHORT = 4;
   20.71 +
   20.72 +/**
   20.73 + * The sort of the <tt>int</tt> type. See {@link #getSort getSort}.
   20.74 + */
   20.75 +public final static int INT = 5;
   20.76 +
   20.77 +/**
   20.78 + * The sort of the <tt>float</tt> type. See {@link #getSort getSort}.
   20.79 + */
   20.80 +public final static int FLOAT = 6;
   20.81 +
   20.82 +/**
   20.83 + * The sort of the <tt>long</tt> type. See {@link #getSort getSort}.
   20.84 + */
   20.85 +public final static int LONG = 7;
   20.86 +
   20.87 +/**
   20.88 + * The sort of the <tt>double</tt> type. See {@link #getSort getSort}.
   20.89 + */
   20.90 +public final static int DOUBLE = 8;
   20.91 +
   20.92 +/**
   20.93 + * The sort of array reference types. See {@link #getSort getSort}.
   20.94 + */
   20.95 +public final static int ARRAY = 9;
   20.96 +
   20.97 +/**
   20.98 + * The sort of object reference type. See {@link #getSort getSort}.
   20.99 + */
  20.100 +public final static int OBJECT = 10;
  20.101 +
  20.102 +/**
  20.103 + * The <tt>void</tt> type.
  20.104 + */
  20.105 +public final static Type VOID_TYPE = new Type(VOID);
  20.106 +
  20.107 +/**
  20.108 + * The <tt>boolean</tt> type.
  20.109 + */
  20.110 +public final static Type BOOLEAN_TYPE = new Type(BOOLEAN);
  20.111 +
  20.112 +/**
  20.113 + * The <tt>char</tt> type.
  20.114 + */
  20.115 +public final static Type CHAR_TYPE = new Type(CHAR);
  20.116 +
  20.117 +/**
  20.118 + * The <tt>byte</tt> type.
  20.119 + */
  20.120 +public final static Type BYTE_TYPE = new Type(BYTE);
  20.121 +
  20.122 +/**
  20.123 + * The <tt>short</tt> type.
  20.124 + */
  20.125 +public final static Type SHORT_TYPE = new Type(SHORT);
  20.126 +
  20.127 +/**
  20.128 + * The <tt>int</tt> type.
  20.129 + */
  20.130 +public final static Type INT_TYPE = new Type(INT);
  20.131 +
  20.132 +/**
  20.133 + * The <tt>float</tt> type.
  20.134 + */
  20.135 +public final static Type FLOAT_TYPE = new Type(FLOAT);
  20.136 +
  20.137 +/**
  20.138 + * The <tt>long</tt> type.
  20.139 + */
  20.140 +public final static Type LONG_TYPE = new Type(LONG);
  20.141 +
  20.142 +/**
  20.143 + * The <tt>double</tt> type.
  20.144 + */
  20.145 +public final static Type DOUBLE_TYPE = new Type(DOUBLE);
  20.146 +
  20.147 +// ------------------------------------------------------------------------
  20.148 +// Fields
  20.149 +// ------------------------------------------------------------------------
  20.150 +
  20.151 +/**
  20.152 + * The sort of this Java type.
  20.153 + */
  20.154 +private final int sort;
  20.155 +
  20.156 +/**
  20.157 + * A buffer containing the descriptor of this Java type. This field is only
  20.158 + * used for reference types.
  20.159 + */
  20.160 +private char[] buf;
  20.161 +
  20.162 +/**
  20.163 + * The offset of the descriptor of this Java type in {@link #buf buf}. This
  20.164 + * field is only used for reference types.
  20.165 + */
  20.166 +private int off;
  20.167 +
  20.168 +/**
  20.169 + * The length of the descriptor of this Java type.
  20.170 + */
  20.171 +private int len;
  20.172 +
  20.173 +// ------------------------------------------------------------------------
  20.174 +// Constructors
  20.175 +// ------------------------------------------------------------------------
  20.176 +
  20.177 +/**
  20.178 + * Constructs a primitive type.
  20.179 + *
  20.180 + * @param sort the sort of the primitive type to be constructed.
  20.181 + */
  20.182 +private Type(final int sort){
  20.183 +	this.sort = sort;
  20.184 +	this.len = 1;
  20.185 +}
  20.186 +
  20.187 +/**
  20.188 + * Constructs a reference type.
  20.189 + *
  20.190 + * @param sort the sort of the reference type to be constructed.
  20.191 + * @param buf  a buffer containing the descriptor of the previous type.
  20.192 + * @param off  the offset of this descriptor in the previous buffer.
  20.193 + * @param len  the length of this descriptor.
  20.194 + */
  20.195 +private Type(final int sort, final char[] buf, final int off, final int len){
  20.196 +	this.sort = sort;
  20.197 +	this.buf = buf;
  20.198 +	this.off = off;
  20.199 +	this.len = len;
  20.200 +}
  20.201 +
  20.202 +/**
  20.203 + * Returns the Java type corresponding to the given type descriptor.
  20.204 + *
  20.205 + * @param typeDescriptor a type descriptor.
  20.206 + * @return the Java type corresponding to the given type descriptor.
  20.207 + */
  20.208 +public static Type getType(final String typeDescriptor){
  20.209 +	return getType(typeDescriptor.toCharArray(), 0);
  20.210 +}
  20.211 +
  20.212 +/**
  20.213 + * Returns the Java type corresponding to the given class.
  20.214 + *
  20.215 + * @param c a class.
  20.216 + * @return the Java type corresponding to the given class.
  20.217 + */
  20.218 +public static Type getType(final Class c){
  20.219 +	if(c.isPrimitive())
  20.220 +		{
  20.221 +		if(c == Integer.TYPE)
  20.222 +			{
  20.223 +			return INT_TYPE;
  20.224 +			}
  20.225 +		else if(c == Void.TYPE)
  20.226 +			{
  20.227 +			return VOID_TYPE;
  20.228 +			}
  20.229 +		else if(c == Boolean.TYPE)
  20.230 +			{
  20.231 +			return BOOLEAN_TYPE;
  20.232 +			}
  20.233 +		else if(c == Byte.TYPE)
  20.234 +			{
  20.235 +			return BYTE_TYPE;
  20.236 +			}
  20.237 +		else if(c == Character.TYPE)
  20.238 +			{
  20.239 +			return CHAR_TYPE;
  20.240 +			}
  20.241 +		else if(c == Short.TYPE)
  20.242 +			{
  20.243 +			return SHORT_TYPE;
  20.244 +			}
  20.245 +		else if(c == Double.TYPE)
  20.246 +			{
  20.247 +			return DOUBLE_TYPE;
  20.248 +			}
  20.249 +		else if(c == Float.TYPE)
  20.250 +			{
  20.251 +			return FLOAT_TYPE;
  20.252 +			}
  20.253 +		else /* if (c == Long.TYPE) */
  20.254 +			{
  20.255 +			return LONG_TYPE;
  20.256 +			}
  20.257 +		}
  20.258 +	else
  20.259 +		{
  20.260 +		return getType(getDescriptor(c));
  20.261 +		}
  20.262 +}
  20.263 +
  20.264 +/**
  20.265 + * Returns the {@link Type#OBJECT} type for the given internal class name.
  20.266 + * This is a shortcut method for <code>Type.getType("L"+name+";")</code>.
  20.267 + * <i>Note that opposed to {@link Type#getType(String)}, this method takes
  20.268 + * internal class names and not class descriptor.</i>
  20.269 + *
  20.270 + * @param name an internal class name.
  20.271 + * @return the the {@link Type#OBJECT} type for the given class name.
  20.272 + */
  20.273 +public static Type getObjectType(String name){
  20.274 +	int l = name.length();
  20.275 +	char[] buf = new char[l + 2];
  20.276 +	buf[0] = 'L';
  20.277 +	buf[l + 1] = ';';
  20.278 +	name.getChars(0, l, buf, 1);
  20.279 +	return new Type(OBJECT, buf, 0, l + 2);
  20.280 +}
  20.281 +
  20.282 +/**
  20.283 + * Returns the Java types corresponding to the argument types of the given
  20.284 + * method descriptor.
  20.285 + *
  20.286 + * @param methodDescriptor a method descriptor.
  20.287 + * @return the Java types corresponding to the argument types of the given
  20.288 + *         method descriptor.
  20.289 + */
  20.290 +public static Type[] getArgumentTypes(final String methodDescriptor){
  20.291 +	char[] buf = methodDescriptor.toCharArray();
  20.292 +	int off = 1;
  20.293 +	int size = 0;
  20.294 +	while(true)
  20.295 +		{
  20.296 +		char car = buf[off++];
  20.297 +		if(car == ')')
  20.298 +			{
  20.299 +			break;
  20.300 +			}
  20.301 +		else if(car == 'L')
  20.302 +			{
  20.303 +			while(buf[off++] != ';')
  20.304 +				{
  20.305 +				}
  20.306 +			++size;
  20.307 +			}
  20.308 +		else if(car != '[')
  20.309 +			{
  20.310 +			++size;
  20.311 +			}
  20.312 +		}
  20.313 +	Type[] args = new Type[size];
  20.314 +	off = 1;
  20.315 +	size = 0;
  20.316 +	while(buf[off] != ')')
  20.317 +		{
  20.318 +		args[size] = getType(buf, off);
  20.319 +		off += args[size].len;
  20.320 +		size += 1;
  20.321 +		}
  20.322 +	return args;
  20.323 +}
  20.324 +
  20.325 +/**
  20.326 + * Returns the Java types corresponding to the argument types of the given
  20.327 + * method.
  20.328 + *
  20.329 + * @param method a method.
  20.330 + * @return the Java types corresponding to the argument types of the given
  20.331 + *         method.
  20.332 + */
  20.333 +public static Type[] getArgumentTypes(final Method method){
  20.334 +	Class[] classes = method.getParameterTypes();
  20.335 +	Type[] types = new Type[classes.length];
  20.336 +	for(int i = classes.length - 1; i >= 0; --i)
  20.337 +		{
  20.338 +		types[i] = getType(classes[i]);
  20.339 +		}
  20.340 +	return types;
  20.341 +}
  20.342 +
  20.343 +/**
  20.344 + * Returns the Java type corresponding to the return type of the given
  20.345 + * method descriptor.
  20.346 + *
  20.347 + * @param methodDescriptor a method descriptor.
  20.348 + * @return the Java type corresponding to the return type of the given
  20.349 + *         method descriptor.
  20.350 + */
  20.351 +public static Type getReturnType(final String methodDescriptor){
  20.352 +	char[] buf = methodDescriptor.toCharArray();
  20.353 +	return getType(buf, methodDescriptor.indexOf(')') + 1);
  20.354 +}
  20.355 +
  20.356 +/**
  20.357 + * Returns the Java type corresponding to the return type of the given
  20.358 + * method.
  20.359 + *
  20.360 + * @param method a method.
  20.361 + * @return the Java type corresponding to the return type of the given
  20.362 + *         method.
  20.363 + */
  20.364 +public static Type getReturnType(final Method method){
  20.365 +	return getType(method.getReturnType());
  20.366 +}
  20.367 +
  20.368 +/**
  20.369 + * Returns the Java type corresponding to the given type descriptor.
  20.370 + *
  20.371 + * @param buf a buffer containing a type descriptor.
  20.372 + * @param off the offset of this descriptor in the previous buffer.
  20.373 + * @return the Java type corresponding to the given type descriptor.
  20.374 + */
  20.375 +private static Type getType(final char[] buf, final int off){
  20.376 +	int len;
  20.377 +	switch(buf[off])
  20.378 +		{
  20.379 +		case'V':
  20.380 +			return VOID_TYPE;
  20.381 +		case'Z':
  20.382 +			return BOOLEAN_TYPE;
  20.383 +		case'C':
  20.384 +			return CHAR_TYPE;
  20.385 +		case'B':
  20.386 +			return BYTE_TYPE;
  20.387 +		case'S':
  20.388 +			return SHORT_TYPE;
  20.389 +		case'I':
  20.390 +			return INT_TYPE;
  20.391 +		case'F':
  20.392 +			return FLOAT_TYPE;
  20.393 +		case'J':
  20.394 +			return LONG_TYPE;
  20.395 +		case'D':
  20.396 +			return DOUBLE_TYPE;
  20.397 +		case'[':
  20.398 +			len = 1;
  20.399 +			while(buf[off + len] == '[')
  20.400 +				{
  20.401 +				++len;
  20.402 +				}
  20.403 +			if(buf[off + len] == 'L')
  20.404 +				{
  20.405 +				++len;
  20.406 +				while(buf[off + len] != ';')
  20.407 +					{
  20.408 +					++len;
  20.409 +					}
  20.410 +				}
  20.411 +			return new Type(ARRAY, buf, off, len + 1);
  20.412 +			// case 'L':
  20.413 +		default:
  20.414 +			len = 1;
  20.415 +			while(buf[off + len] != ';')
  20.416 +				{
  20.417 +				++len;
  20.418 +				}
  20.419 +			return new Type(OBJECT, buf, off, len + 1);
  20.420 +		}
  20.421 +}
  20.422 +
  20.423 +// ------------------------------------------------------------------------
  20.424 +// Accessors
  20.425 +// ------------------------------------------------------------------------
  20.426 +
  20.427 +/**
  20.428 + * Returns the sort of this Java type.
  20.429 + *
  20.430 + * @return {@link #VOID VOID}, {@link #BOOLEAN BOOLEAN},
  20.431 + *         {@link #CHAR CHAR}, {@link #BYTE BYTE}, {@link #SHORT SHORT},
  20.432 + *         {@link #INT INT}, {@link #FLOAT FLOAT}, {@link #LONG LONG},
  20.433 + *         {@link #DOUBLE DOUBLE}, {@link #ARRAY ARRAY} or
  20.434 + *         {@link #OBJECT OBJECT}.
  20.435 + */
  20.436 +public int getSort(){
  20.437 +	return sort;
  20.438 +}
  20.439 +
  20.440 +/**
  20.441 + * Returns the number of dimensions of this array type. This method should
  20.442 + * only be used for an array type.
  20.443 + *
  20.444 + * @return the number of dimensions of this array type.
  20.445 + */
  20.446 +public int getDimensions(){
  20.447 +	int i = 1;
  20.448 +	while(buf[off + i] == '[')
  20.449 +		{
  20.450 +		++i;
  20.451 +		}
  20.452 +	return i;
  20.453 +}
  20.454 +
  20.455 +/**
  20.456 + * Returns the type of the elements of this array type. This method should
  20.457 + * only be used for an array type.
  20.458 + *
  20.459 + * @return Returns the type of the elements of this array type.
  20.460 + */
  20.461 +public Type getElementType(){
  20.462 +	return getType(buf, off + getDimensions());
  20.463 +}
  20.464 +
  20.465 +/**
  20.466 + * Returns the name of the class corresponding to this type.
  20.467 + *
  20.468 + * @return the fully qualified name of the class corresponding to this type.
  20.469 + */
  20.470 +public String getClassName(){
  20.471 +	switch(sort)
  20.472 +		{
  20.473 +		case VOID:
  20.474 +			return "void";
  20.475 +		case BOOLEAN:
  20.476 +			return "boolean";
  20.477 +		case CHAR:
  20.478 +			return "char";
  20.479 +		case BYTE:
  20.480 +			return "byte";
  20.481 +		case SHORT:
  20.482 +			return "short";
  20.483 +		case INT:
  20.484 +			return "int";
  20.485 +		case FLOAT:
  20.486 +			return "float";
  20.487 +		case LONG:
  20.488 +			return "long";
  20.489 +		case DOUBLE:
  20.490 +			return "double";
  20.491 +		case ARRAY:
  20.492 +			StringBuffer b = new StringBuffer(getElementType().getClassName());
  20.493 +			for(int i = getDimensions(); i > 0; --i)
  20.494 +				{
  20.495 +				b.append("[]");
  20.496 +				}
  20.497 +			return b.toString();
  20.498 +			// case OBJECT:
  20.499 +		default:
  20.500 +			return new String(buf, off + 1, len - 2).replace('/', '.');
  20.501 +		}
  20.502 +}
  20.503 +
  20.504 +/**
  20.505 + * Returns the internal name of the class corresponding to this object type.
  20.506 + * The internal name of a class is its fully qualified name, where '.' are
  20.507 + * replaced by '/'. This method should only be used for an object type.
  20.508 + *
  20.509 + * @return the internal name of the class corresponding to this object type.
  20.510 + */
  20.511 +public String getInternalName(){
  20.512 +	return new String(buf, off + 1, len - 2);
  20.513 +}
  20.514 +
  20.515 +// ------------------------------------------------------------------------
  20.516 +// Conversion to type descriptors
  20.517 +// ------------------------------------------------------------------------
  20.518 +
  20.519 +/**
  20.520 + * Returns the descriptor corresponding to this Java type.
  20.521 + *
  20.522 + * @return the descriptor corresponding to this Java type.
  20.523 + */
  20.524 +public String getDescriptor(){
  20.525 +	StringBuffer buf = new StringBuffer();
  20.526 +	getDescriptor(buf);
  20.527 +	return buf.toString();
  20.528 +}
  20.529 +
  20.530 +/**
  20.531 + * Returns the descriptor corresponding to the given argument and return
  20.532 + * types.
  20.533 + *
  20.534 + * @param returnType    the return type of the method.
  20.535 + * @param argumentTypes the argument types of the method.
  20.536 + * @return the descriptor corresponding to the given argument and return
  20.537 + *         types.
  20.538 + */
  20.539 +public static String getMethodDescriptor(
  20.540 +		final Type returnType,
  20.541 +		final Type[] argumentTypes){
  20.542 +	StringBuffer buf = new StringBuffer();
  20.543 +	buf.append('(');
  20.544 +	for(int i = 0; i < argumentTypes.length; ++i)
  20.545 +		{
  20.546 +		argumentTypes[i].getDescriptor(buf);
  20.547 +		}
  20.548 +	buf.append(')');
  20.549 +	returnType.getDescriptor(buf);
  20.550 +	return buf.toString();
  20.551 +}
  20.552 +
  20.553 +/**
  20.554 + * Appends the descriptor corresponding to this Java type to the given
  20.555 + * string buffer.
  20.556 + *
  20.557 + * @param buf the string buffer to which the descriptor must be appended.
  20.558 + */
  20.559 +private void getDescriptor(final StringBuffer buf){
  20.560 +	switch(sort)
  20.561 +		{
  20.562 +		case VOID:
  20.563 +			buf.append('V');
  20.564 +			return;
  20.565 +		case BOOLEAN:
  20.566 +			buf.append('Z');
  20.567 +			return;
  20.568 +		case CHAR:
  20.569 +			buf.append('C');
  20.570 +			return;
  20.571 +		case BYTE:
  20.572 +			buf.append('B');
  20.573 +			return;
  20.574 +		case SHORT:
  20.575 +			buf.append('S');
  20.576 +			return;
  20.577 +		case INT:
  20.578 +			buf.append('I');
  20.579 +			return;
  20.580 +		case FLOAT:
  20.581 +			buf.append('F');
  20.582 +			return;
  20.583 +		case LONG:
  20.584 +			buf.append('J');
  20.585 +			return;
  20.586 +		case DOUBLE:
  20.587 +			buf.append('D');
  20.588 +			return;
  20.589 +			// case ARRAY:
  20.590 +			// case OBJECT:
  20.591 +		default:
  20.592 +			buf.append(this.buf, off, len);
  20.593 +		}
  20.594 +}
  20.595 +
  20.596 +// ------------------------------------------------------------------------
  20.597 +// Direct conversion from classes to type descriptors,
  20.598 +// without intermediate Type objects
  20.599 +// ------------------------------------------------------------------------
  20.600 +
  20.601 +/**
  20.602 + * Returns the internal name of the given class. The internal name of a
  20.603 + * class is its fully qualified name, where '.' are replaced by '/'.
  20.604 + *
  20.605 + * @param c an object class.
  20.606 + * @return the internal name of the given class.
  20.607 + */
  20.608 +public static String getInternalName(final Class c){
  20.609 +	return c.getName().replace('.', '/');
  20.610 +}
  20.611 +
  20.612 +/**
  20.613 + * Returns the descriptor corresponding to the given Java type.
  20.614 + *
  20.615 + * @param c an object class, a primitive class or an array class.
  20.616 + * @return the descriptor corresponding to the given class.
  20.617 + */
  20.618 +public static String getDescriptor(final Class c){
  20.619 +	StringBuffer buf = new StringBuffer();
  20.620 +	getDescriptor(buf, c);
  20.621 +	return buf.toString();
  20.622 +}
  20.623 +
  20.624 +/**
  20.625 + * Returns the descriptor corresponding to the given constructor.
  20.626 + *
  20.627 + * @param c a {@link Constructor Constructor} object.
  20.628 + * @return the descriptor of the given constructor.
  20.629 + */
  20.630 +public static String getConstructorDescriptor(final Constructor c){
  20.631 +	Class[] parameters = c.getParameterTypes();
  20.632 +	StringBuffer buf = new StringBuffer();
  20.633 +	buf.append('(');
  20.634 +	for(int i = 0; i < parameters.length; ++i)
  20.635 +		{
  20.636 +		getDescriptor(buf, parameters[i]);
  20.637 +		}
  20.638 +	return buf.append(")V").toString();
  20.639 +}
  20.640 +
  20.641 +/**
  20.642 + * Returns the descriptor corresponding to the given method.
  20.643 + *
  20.644 + * @param m a {@link Method Method} object.
  20.645 + * @return the descriptor of the given method.
  20.646 + */
  20.647 +public static String getMethodDescriptor(final Method m){
  20.648 +	Class[] parameters = m.getParameterTypes();
  20.649 +	StringBuffer buf = new StringBuffer();
  20.650 +	buf.append('(');
  20.651 +	for(int i = 0; i < parameters.length; ++i)
  20.652 +		{
  20.653 +		getDescriptor(buf, parameters[i]);
  20.654 +		}
  20.655 +	buf.append(')');
  20.656 +	getDescriptor(buf, m.getReturnType());
  20.657 +	return buf.toString();
  20.658 +}
  20.659 +
  20.660 +/**
  20.661 + * Appends the descriptor of the given class to the given string buffer.
  20.662 + *
  20.663 + * @param buf the string buffer to which the descriptor must be appended.
  20.664 + * @param c   the class whose descriptor must be computed.
  20.665 + */
  20.666 +private static void getDescriptor(final StringBuffer buf, final Class c){
  20.667 +	Class d = c;
  20.668 +	while(true)
  20.669 +		{
  20.670 +		if(d.isPrimitive())
  20.671 +			{
  20.672 +			char car;
  20.673 +			if(d == Integer.TYPE)
  20.674 +				{
  20.675 +				car = 'I';
  20.676 +				}
  20.677 +			else if(d == Void.TYPE)
  20.678 +				{
  20.679 +				car = 'V';
  20.680 +				}
  20.681 +			else if(d == Boolean.TYPE)
  20.682 +				{
  20.683 +				car = 'Z';
  20.684 +				}
  20.685 +			else if(d == Byte.TYPE)
  20.686 +				{
  20.687 +				car = 'B';
  20.688 +				}
  20.689 +			else if(d == Character.TYPE)
  20.690 +				{
  20.691 +				car = 'C';
  20.692 +				}
  20.693 +			else if(d == Short.TYPE)
  20.694 +				{
  20.695 +				car = 'S';
  20.696 +				}
  20.697 +			else if(d == Double.TYPE)
  20.698 +				{
  20.699 +				car = 'D';
  20.700 +				}
  20.701 +			else if(d == Float.TYPE)
  20.702 +				{
  20.703 +				car = 'F';
  20.704 +				}
  20.705 +			else /* if (d == Long.TYPE) */
  20.706 +				{
  20.707 +				car = 'J';
  20.708 +				}
  20.709 +			buf.append(car);
  20.710 +			return;
  20.711 +			}
  20.712 +		else if(d.isArray())
  20.713 +			{
  20.714 +			buf.append('[');
  20.715 +			d = d.getComponentType();
  20.716 +			}
  20.717 +		else
  20.718 +			{
  20.719 +			buf.append('L');
  20.720 +			String name = d.getName();
  20.721 +			int len = name.length();
  20.722 +			for(int i = 0; i < len; ++i)
  20.723 +				{
  20.724 +				char car = name.charAt(i);
  20.725 +				buf.append(car == '.' ? '/' : car);
  20.726 +				}
  20.727 +			buf.append(';');
  20.728 +			return;
  20.729 +			}
  20.730 +		}
  20.731 +}
  20.732 +
  20.733 +// ------------------------------------------------------------------------
  20.734 +// Corresponding size and opcodes
  20.735 +// ------------------------------------------------------------------------
  20.736 +
  20.737 +/**
  20.738 + * Returns the size of values of this type.
  20.739 + *
  20.740 + * @return the size of values of this type, i.e., 2 for <tt>long</tt> and
  20.741 + *         <tt>double</tt>, and 1 otherwise.
  20.742 + */
  20.743 +public int getSize(){
  20.744 +	return sort == LONG || sort == DOUBLE ? 2 : 1;
  20.745 +}
  20.746 +
  20.747 +/**
  20.748 + * Returns a JVM instruction opcode adapted to this Java type.
  20.749 + *
  20.750 + * @param opcode a JVM instruction opcode. This opcode must be one of ILOAD,
  20.751 + *               ISTORE, IALOAD, IASTORE, IADD, ISUB, IMUL, IDIV, IREM, INEG, ISHL,
  20.752 + *               ISHR, IUSHR, IAND, IOR, IXOR and IRETURN.
  20.753 + * @return an opcode that is similar to the given opcode, but adapted to
  20.754 + *         this Java type. For example, if this type is <tt>float</tt> and
  20.755 + *         <tt>opcode</tt> is IRETURN, this method returns FRETURN.
  20.756 + */
  20.757 +public int getOpcode(final int opcode){
  20.758 +	if(opcode == Opcodes.IALOAD || opcode == Opcodes.IASTORE)
  20.759 +		{
  20.760 +		switch(sort)
  20.761 +			{
  20.762 +			case BOOLEAN:
  20.763 +			case BYTE:
  20.764 +				return opcode + 5;
  20.765 +			case CHAR:
  20.766 +				return opcode + 6;
  20.767 +			case SHORT:
  20.768 +				return opcode + 7;
  20.769 +			case INT:
  20.770 +				return opcode;
  20.771 +			case FLOAT:
  20.772 +				return opcode + 2;
  20.773 +			case LONG:
  20.774 +				return opcode + 1;
  20.775 +			case DOUBLE:
  20.776 +				return opcode + 3;
  20.777 +				// case ARRAY:
  20.778 +				// case OBJECT:
  20.779 +			default:
  20.780 +				return opcode + 4;
  20.781 +			}
  20.782 +		}
  20.783 +	else
  20.784 +		{
  20.785 +		switch(sort)
  20.786 +			{
  20.787 +			case VOID:
  20.788 +				return opcode + 5;
  20.789 +			case BOOLEAN:
  20.790 +			case CHAR:
  20.791 +			case BYTE:
  20.792 +			case SHORT:
  20.793 +			case INT:
  20.794 +				return opcode;
  20.795 +			case FLOAT:
  20.796 +				return opcode + 2;
  20.797 +			case LONG:
  20.798 +				return opcode + 1;
  20.799 +			case DOUBLE:
  20.800 +				return opcode + 3;
  20.801 +				// case ARRAY:
  20.802 +				// case OBJECT:
  20.803 +			default:
  20.804 +				return opcode + 4;
  20.805 +			}
  20.806 +		}
  20.807 +}
  20.808 +
  20.809 +// ------------------------------------------------------------------------
  20.810 +// Equals, hashCode and toString
  20.811 +// ------------------------------------------------------------------------
  20.812 +
  20.813 +/**
  20.814 + * Tests if the given object is equal to this type.
  20.815 + *
  20.816 + * @param o the object to be compared to this type.
  20.817 + * @return <tt>true</tt> if the given object is equal to this type.
  20.818 + */
  20.819 +public boolean equals(final Object o){
  20.820 +	if(this == o)
  20.821 +		{
  20.822 +		return true;
  20.823 +		}
  20.824 +	if(!(o instanceof Type))
  20.825 +		{
  20.826 +		return false;
  20.827 +		}
  20.828 +	Type t = (Type) o;
  20.829 +	if(sort != t.sort)
  20.830 +		{
  20.831 +		return false;
  20.832 +		}
  20.833 +	if(sort == Type.OBJECT || sort == Type.ARRAY)
  20.834 +		{
  20.835 +		if(len != t.len)
  20.836 +			{
  20.837 +			return false;
  20.838 +			}
  20.839 +		for(int i = off, j = t.off, end = i + len; i < end; i++, j++)
  20.840 +			{
  20.841 +			if(buf[i] != t.buf[j])
  20.842 +				{
  20.843 +				return false;
  20.844 +				}
  20.845 +			}
  20.846 +		}
  20.847 +	return true;
  20.848 +}
  20.849 +
  20.850 +/**
  20.851 + * Returns a hash code value for this type.
  20.852 + *
  20.853 + * @return a hash code value for this type.
  20.854 + */
  20.855 +public int hashCode(){
  20.856 +	int hc = 13 * sort;
  20.857 +	if(sort == Type.OBJECT || sort == Type.ARRAY)
  20.858 +		{
  20.859 +		for(int i = off, end = i + len; i < end; i++)
  20.860 +			{
  20.861 +			hc = 17 * (hc + buf[i]);
  20.862 +			}
  20.863 +		}
  20.864 +	return hc;
  20.865 +}
  20.866 +
  20.867 +/**
  20.868 + * Returns a string representation of this type.
  20.869 + *
  20.870 + * @return the descriptor of this type.
  20.871 + */
  20.872 +public String toString(){
  20.873 +	return getDescriptor();
  20.874 +}
  20.875 +}
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/clojure/asm/commons/AdviceAdapter.java	Sat Aug 21 06:25:44 2010 -0400
    21.3 @@ -0,0 +1,681 @@
    21.4 +/***
    21.5 + * ASM: a very small and fast Java bytecode manipulation framework
    21.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    21.7 + * All rights reserved.
    21.8 + *
    21.9 + * Redistribution and use in source and binary forms, with or without
   21.10 + * modification, are permitted provided that the following conditions
   21.11 + * are met:
   21.12 + * 1. Redistributions of source code must retain the above copyright
   21.13 + *    notice, this list of conditions and the following disclaimer.
   21.14 + * 2. Redistributions in binary form must reproduce the above copyright
   21.15 + *    notice, this list of conditions and the following disclaimer in the
   21.16 + *    documentation and/or other materials provided with the distribution.
   21.17 + * 3. Neither the name of the copyright holders nor the names of its
   21.18 + *    contributors may be used to endorse or promote products derived from
   21.19 + *    this software without specific prior written permission.
   21.20 + *
   21.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   21.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   21.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   21.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   21.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   21.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   21.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   21.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   21.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   21.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   21.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   21.32 + */
   21.33 +package clojure.asm.commons;
   21.34 +
   21.35 +import java.util.ArrayList;
   21.36 +import java.util.HashMap;
   21.37 +
   21.38 +import clojure.asm.Label;
   21.39 +import clojure.asm.MethodVisitor;
   21.40 +import clojure.asm.Opcodes;
   21.41 +import clojure.asm.Type;
   21.42 +
   21.43 +/**
   21.44 + * A {@link clojure.asm.MethodAdapter} to insert before, after and around
   21.45 + * advices in methods and constructors. <p> The behavior for constructors is
   21.46 + * like this: <ol>
   21.47 + * <p/>
   21.48 + * <li>as long as the INVOKESPECIAL for the object initialization has not been
   21.49 + * reached, every bytecode instruction is dispatched in the ctor code visitor</li>
   21.50 + * <p/>
   21.51 + * <li>when this one is reached, it is only added in the ctor code visitor and
   21.52 + * a JP invoke is added</li>
   21.53 + * <p/>
   21.54 + * <li>after that, only the other code visitor receives the instructions</li>
   21.55 + * <p/>
   21.56 + * </ol>
   21.57 + *
   21.58 + * @author Eugene Kuleshov
   21.59 + * @author Eric Bruneton
   21.60 + */
   21.61 +public abstract class AdviceAdapter extends GeneratorAdapter implements Opcodes{
   21.62 +private static final Object THIS = new Object();
   21.63 +private static final Object OTHER = new Object();
   21.64 +
   21.65 +protected int methodAccess;
   21.66 +protected String methodDesc;
   21.67 +
   21.68 +private boolean constructor;
   21.69 +private boolean superInitialized;
   21.70 +private ArrayList stackFrame;
   21.71 +private HashMap branches;
   21.72 +
   21.73 +/**
   21.74 + * Creates a new {@link AdviceAdapter}.
   21.75 + *
   21.76 + * @param mv     the method visitor to which this adapter delegates calls.
   21.77 + * @param access the method's access flags (see {@link Opcodes}).
   21.78 + * @param name   the method's name.
   21.79 + * @param desc   the method's descriptor (see {@link Type Type}).
   21.80 + */
   21.81 +public AdviceAdapter(
   21.82 +		final MethodVisitor mv,
   21.83 +		final int access,
   21.84 +		final String name,
   21.85 +		final String desc){
   21.86 +	super(mv, access, name, desc);
   21.87 +	methodAccess = access;
   21.88 +	methodDesc = desc;
   21.89 +
   21.90 +	constructor = "<init>".equals(name);
   21.91 +}
   21.92 +
   21.93 +public void visitCode(){
   21.94 +	mv.visitCode();
   21.95 +	if(!constructor)
   21.96 +		{
   21.97 +		superInitialized = true;
   21.98 +		onMethodEnter();
   21.99 +		}
  21.100 +	else
  21.101 +		{
  21.102 +		stackFrame = new ArrayList();
  21.103 +		branches = new HashMap();
  21.104 +		}
  21.105 +}
  21.106 +
  21.107 +public void visitLabel(final Label label){
  21.108 +	mv.visitLabel(label);
  21.109 +
  21.110 +	if(constructor && branches != null)
  21.111 +		{
  21.112 +		ArrayList frame = (ArrayList) branches.get(label);
  21.113 +		if(frame != null)
  21.114 +			{
  21.115 +			stackFrame = frame;
  21.116 +			branches.remove(label);
  21.117 +			}
  21.118 +		}
  21.119 +}
  21.120 +
  21.121 +public void visitInsn(final int opcode){
  21.122 +	if(constructor)
  21.123 +		{
  21.124 +		switch(opcode)
  21.125 +			{
  21.126 +			case RETURN: // empty stack
  21.127 +				onMethodExit(opcode);
  21.128 +				break;
  21.129 +
  21.130 +			case IRETURN: // 1 before n/a after
  21.131 +			case FRETURN: // 1 before n/a after
  21.132 +			case ARETURN: // 1 before n/a after
  21.133 +			case ATHROW: // 1 before n/a after
  21.134 +				popValue();
  21.135 +				popValue();
  21.136 +				onMethodExit(opcode);
  21.137 +				break;
  21.138 +
  21.139 +			case LRETURN: // 2 before n/a after
  21.140 +			case DRETURN: // 2 before n/a after
  21.141 +				popValue();
  21.142 +				popValue();
  21.143 +				onMethodExit(opcode);
  21.144 +				break;
  21.145 +
  21.146 +			case NOP:
  21.147 +			case LALOAD: // remove 2 add 2
  21.148 +			case DALOAD: // remove 2 add 2
  21.149 +			case LNEG:
  21.150 +			case DNEG:
  21.151 +			case FNEG:
  21.152 +			case INEG:
  21.153 +			case L2D:
  21.154 +			case D2L:
  21.155 +			case F2I:
  21.156 +			case I2B:
  21.157 +			case I2C:
  21.158 +			case I2S:
  21.159 +			case I2F:
  21.160 +			case Opcodes.ARRAYLENGTH:
  21.161 +				break;
  21.162 +
  21.163 +			case ACONST_NULL:
  21.164 +			case ICONST_M1:
  21.165 +			case ICONST_0:
  21.166 +			case ICONST_1:
  21.167 +			case ICONST_2:
  21.168 +			case ICONST_3:
  21.169 +			case ICONST_4:
  21.170 +			case ICONST_5:
  21.171 +			case FCONST_0:
  21.172 +			case FCONST_1:
  21.173 +			case FCONST_2:
  21.174 +			case F2L: // 1 before 2 after
  21.175 +			case F2D:
  21.176 +			case I2L:
  21.177 +			case I2D:
  21.178 +				pushValue(OTHER);
  21.179 +				break;
  21.180 +
  21.181 +			case LCONST_0:
  21.182 +			case LCONST_1:
  21.183 +			case DCONST_0:
  21.184 +			case DCONST_1:
  21.185 +				pushValue(OTHER);
  21.186 +				pushValue(OTHER);
  21.187 +				break;
  21.188 +
  21.189 +			case IALOAD: // remove 2 add 1
  21.190 +			case FALOAD: // remove 2 add 1
  21.191 +			case AALOAD: // remove 2 add 1
  21.192 +			case BALOAD: // remove 2 add 1
  21.193 +			case CALOAD: // remove 2 add 1
  21.194 +			case SALOAD: // remove 2 add 1
  21.195 +			case POP:
  21.196 +			case IADD:
  21.197 +			case FADD:
  21.198 +			case ISUB:
  21.199 +			case LSHL: // 3 before 2 after
  21.200 +			case LSHR: // 3 before 2 after
  21.201 +			case LUSHR: // 3 before 2 after
  21.202 +			case L2I: // 2 before 1 after
  21.203 +			case L2F: // 2 before 1 after
  21.204 +			case D2I: // 2 before 1 after
  21.205 +			case D2F: // 2 before 1 after
  21.206 +			case FSUB:
  21.207 +			case FMUL:
  21.208 +			case FDIV:
  21.209 +			case FREM:
  21.210 +			case FCMPL: // 2 before 1 after
  21.211 +			case FCMPG: // 2 before 1 after
  21.212 +			case IMUL:
  21.213 +			case IDIV:
  21.214 +			case IREM:
  21.215 +			case ISHL:
  21.216 +			case ISHR:
  21.217 +			case IUSHR:
  21.218 +			case IAND:
  21.219 +			case IOR:
  21.220 +			case IXOR:
  21.221 +			case MONITORENTER:
  21.222 +			case MONITOREXIT:
  21.223 +				popValue();
  21.224 +				break;
  21.225 +
  21.226 +			case POP2:
  21.227 +			case LSUB:
  21.228 +			case LMUL:
  21.229 +			case LDIV:
  21.230 +			case LREM:
  21.231 +			case LADD:
  21.232 +			case LAND:
  21.233 +			case LOR:
  21.234 +			case LXOR:
  21.235 +			case DADD:
  21.236 +			case DMUL:
  21.237 +			case DSUB:
  21.238 +			case DDIV:
  21.239 +			case DREM:
  21.240 +				popValue();
  21.241 +				popValue();
  21.242 +				break;
  21.243 +
  21.244 +			case IASTORE:
  21.245 +			case FASTORE:
  21.246 +			case AASTORE:
  21.247 +			case BASTORE:
  21.248 +			case CASTORE:
  21.249 +			case SASTORE:
  21.250 +			case LCMP: // 4 before 1 after
  21.251 +			case DCMPL:
  21.252 +			case DCMPG:
  21.253 +				popValue();
  21.254 +				popValue();
  21.255 +				popValue();
  21.256 +				break;
  21.257 +
  21.258 +			case LASTORE:
  21.259 +			case DASTORE:
  21.260 +				popValue();
  21.261 +				popValue();
  21.262 +				popValue();
  21.263 +				popValue();
  21.264 +				break;
  21.265 +
  21.266 +			case DUP:
  21.267 +				pushValue(peekValue());
  21.268 +				break;
  21.269 +
  21.270 +			case DUP_X1:
  21.271 +				// TODO optimize this
  21.272 +			{
  21.273 +			Object o1 = popValue();
  21.274 +			Object o2 = popValue();
  21.275 +			pushValue(o1);
  21.276 +			pushValue(o2);
  21.277 +			pushValue(o1);
  21.278 +			}
  21.279 +			break;
  21.280 +
  21.281 +			case DUP_X2:
  21.282 +				// TODO optimize this
  21.283 +			{
  21.284 +			Object o1 = popValue();
  21.285 +			Object o2 = popValue();
  21.286 +			Object o3 = popValue();
  21.287 +			pushValue(o1);
  21.288 +			pushValue(o3);
  21.289 +			pushValue(o2);
  21.290 +			pushValue(o1);
  21.291 +			}
  21.292 +			break;
  21.293 +
  21.294 +			case DUP2:
  21.295 +				// TODO optimize this
  21.296 +			{
  21.297 +			Object o1 = popValue();
  21.298 +			Object o2 = popValue();
  21.299 +			pushValue(o2);
  21.300 +			pushValue(o1);
  21.301 +			pushValue(o2);
  21.302 +			pushValue(o1);
  21.303 +			}
  21.304 +			break;
  21.305 +
  21.306 +			case DUP2_X1:
  21.307 +				// TODO optimize this
  21.308 +			{
  21.309 +			Object o1 = popValue();
  21.310 +			Object o2 = popValue();
  21.311 +			Object o3 = popValue();
  21.312 +			pushValue(o2);
  21.313 +			pushValue(o1);
  21.314 +			pushValue(o3);
  21.315 +			pushValue(o2);
  21.316 +			pushValue(o1);
  21.317 +			}
  21.318 +			break;
  21.319 +
  21.320 +			case DUP2_X2:
  21.321 +				// TODO optimize this
  21.322 +			{
  21.323 +			Object o1 = popValue();
  21.324 +			Object o2 = popValue();
  21.325 +			Object o3 = popValue();
  21.326 +			Object o4 = popValue();
  21.327 +			pushValue(o2);
  21.328 +			pushValue(o1);
  21.329 +			pushValue(o4);
  21.330 +			pushValue(o3);
  21.331 +			pushValue(o2);
  21.332 +			pushValue(o1);
  21.333 +			}
  21.334 +			break;
  21.335 +
  21.336 +			case SWAP:
  21.337 +			{
  21.338 +			Object o1 = popValue();
  21.339 +			Object o2 = popValue();
  21.340 +			pushValue(o1);
  21.341 +			pushValue(o2);
  21.342 +			}
  21.343 +			break;
  21.344 +			}
  21.345 +		}
  21.346 +	else
  21.347 +		{
  21.348 +		switch(opcode)
  21.349 +			{
  21.350 +			case RETURN:
  21.351 +			case IRETURN:
  21.352 +			case FRETURN:
  21.353 +			case ARETURN:
  21.354 +			case LRETURN:
  21.355 +			case DRETURN:
  21.356 +			case ATHROW:
  21.357 +				onMethodExit(opcode);
  21.358 +				break;
  21.359 +			}
  21.360 +		}
  21.361 +	mv.visitInsn(opcode);
  21.362 +}
  21.363 +
  21.364 +public void visitVarInsn(final int opcode, final int var){
  21.365 +	super.visitVarInsn(opcode, var);
  21.366 +
  21.367 +	if(constructor)
  21.368 +		{
  21.369 +		switch(opcode)
  21.370 +			{
  21.371 +			case ILOAD:
  21.372 +			case FLOAD:
  21.373 +				pushValue(OTHER);
  21.374 +				break;
  21.375 +			case LLOAD:
  21.376 +			case DLOAD:
  21.377 +				pushValue(OTHER);
  21.378 +				pushValue(OTHER);
  21.379 +				break;
  21.380 +			case ALOAD:
  21.381 +				pushValue(var == 0 ? THIS : OTHER);
  21.382 +				break;
  21.383 +			case ASTORE:
  21.384 +			case ISTORE:
  21.385 +			case FSTORE:
  21.386 +				popValue();
  21.387 +				break;
  21.388 +			case LSTORE:
  21.389 +			case DSTORE:
  21.390 +				popValue();
  21.391 +				popValue();
  21.392 +				break;
  21.393 +			}
  21.394 +		}
  21.395 +}
  21.396 +
  21.397 +public void visitFieldInsn(
  21.398 +		final int opcode,
  21.399 +		final String owner,
  21.400 +		final String name,
  21.401 +		final String desc){
  21.402 +	mv.visitFieldInsn(opcode, owner, name, desc);
  21.403 +
  21.404 +	if(constructor)
  21.405 +		{
  21.406 +		char c = desc.charAt(0);
  21.407 +		boolean longOrDouble = c == 'J' || c == 'D';
  21.408 +		switch(opcode)
  21.409 +			{
  21.410 +			case GETSTATIC:
  21.411 +				pushValue(OTHER);
  21.412 +				if(longOrDouble)
  21.413 +					{
  21.414 +					pushValue(OTHER);
  21.415 +					}
  21.416 +				break;
  21.417 +			case PUTSTATIC:
  21.418 +				popValue();
  21.419 +				if(longOrDouble)
  21.420 +					{
  21.421 +					popValue();
  21.422 +					}
  21.423 +				break;
  21.424 +			case PUTFIELD:
  21.425 +				popValue();
  21.426 +				if(longOrDouble)
  21.427 +					{
  21.428 +					popValue();
  21.429 +					popValue();
  21.430 +					}
  21.431 +				break;
  21.432 +				// case GETFIELD:
  21.433 +			default:
  21.434 +				if(longOrDouble)
  21.435 +					{
  21.436 +					pushValue(OTHER);
  21.437 +					}
  21.438 +			}
  21.439 +		}
  21.440 +}
  21.441 +
  21.442 +public void visitIntInsn(final int opcode, final int operand){
  21.443 +	mv.visitIntInsn(opcode, operand);
  21.444 +
  21.445 +	if(constructor && opcode != NEWARRAY)
  21.446 +		{
  21.447 +		pushValue(OTHER);
  21.448 +		}
  21.449 +}
  21.450 +
  21.451 +public void visitLdcInsn(final Object cst){
  21.452 +	mv.visitLdcInsn(cst);
  21.453 +
  21.454 +	if(constructor)
  21.455 +		{
  21.456 +		pushValue(OTHER);
  21.457 +		if(cst instanceof Double || cst instanceof Long)
  21.458 +			{
  21.459 +			pushValue(OTHER);
  21.460 +			}
  21.461 +		}
  21.462 +}
  21.463 +
  21.464 +public void visitMultiANewArrayInsn(final String desc, final int dims){
  21.465 +	mv.visitMultiANewArrayInsn(desc, dims);
  21.466 +
  21.467 +	if(constructor)
  21.468 +		{
  21.469 +		for(int i = 0; i < dims; i++)
  21.470 +			{
  21.471 +			popValue();
  21.472 +			}
  21.473 +		pushValue(OTHER);
  21.474 +		}
  21.475 +}
  21.476 +
  21.477 +public void visitTypeInsn(final int opcode, final String name){
  21.478 +	mv.visitTypeInsn(opcode, name);
  21.479 +
  21.480 +	// ANEWARRAY, CHECKCAST or INSTANCEOF don't change stack
  21.481 +	if(constructor && opcode == NEW)
  21.482 +		{
  21.483 +		pushValue(OTHER);
  21.484 +		}
  21.485 +}
  21.486 +
  21.487 +public void visitMethodInsn(
  21.488 +		final int opcode,
  21.489 +		final String owner,
  21.490 +		final String name,
  21.491 +		final String desc){
  21.492 +	mv.visitMethodInsn(opcode, owner, name, desc);
  21.493 +
  21.494 +	if(constructor)
  21.495 +		{
  21.496 +		Type[] types = Type.getArgumentTypes(desc);
  21.497 +		for(int i = 0; i < types.length; i++)
  21.498 +			{
  21.499 +			popValue();
  21.500 +			if(types[i].getSize() == 2)
  21.501 +				{
  21.502 +				popValue();
  21.503 +				}
  21.504 +			}
  21.505 +		switch(opcode)
  21.506 +			{
  21.507 +			// case INVOKESTATIC:
  21.508 +			// break;
  21.509 +
  21.510 +			case INVOKEINTERFACE:
  21.511 +			case INVOKEVIRTUAL:
  21.512 +				popValue(); // objectref
  21.513 +				break;
  21.514 +
  21.515 +			case INVOKESPECIAL:
  21.516 +				Object type = popValue(); // objectref
  21.517 +				if(type == THIS && !superInitialized)
  21.518 +					{
  21.519 +					onMethodEnter();
  21.520 +					superInitialized = true;
  21.521 +					// once super has been initialized it is no longer
  21.522 +					// necessary to keep track of stack state
  21.523 +					constructor = false;
  21.524 +					}
  21.525 +				break;
  21.526 +			}
  21.527 +
  21.528 +		Type returnType = Type.getReturnType(desc);
  21.529 +		if(returnType != Type.VOID_TYPE)
  21.530 +			{
  21.531 +			pushValue(OTHER);
  21.532 +			if(returnType.getSize() == 2)
  21.533 +				{
  21.534 +				pushValue(OTHER);
  21.535 +				}
  21.536 +			}
  21.537 +		}
  21.538 +}
  21.539 +
  21.540 +public void visitJumpInsn(final int opcode, final Label label){
  21.541 +	mv.visitJumpInsn(opcode, label);
  21.542 +
  21.543 +	if(constructor)
  21.544 +		{
  21.545 +		switch(opcode)
  21.546 +			{
  21.547 +			case IFEQ:
  21.548 +			case IFNE:
  21.549 +			case IFLT:
  21.550 +			case IFGE:
  21.551 +			case IFGT:
  21.552 +			case IFLE:
  21.553 +			case IFNULL:
  21.554 +			case IFNONNULL:
  21.555 +				popValue();
  21.556 +				break;
  21.557 +
  21.558 +			case IF_ICMPEQ:
  21.559 +			case IF_ICMPNE:
  21.560 +			case IF_ICMPLT:
  21.561 +			case IF_ICMPGE:
  21.562 +			case IF_ICMPGT:
  21.563 +			case IF_ICMPLE:
  21.564 +			case IF_ACMPEQ:
  21.565 +			case IF_ACMPNE:
  21.566 +				popValue();
  21.567 +				popValue();
  21.568 +				break;
  21.569 +
  21.570 +			case JSR:
  21.571 +				pushValue(OTHER);
  21.572 +				break;
  21.573 +			}
  21.574 +		addBranch(label);
  21.575 +		}
  21.576 +}
  21.577 +
  21.578 +public void visitLookupSwitchInsn(
  21.579 +		final Label dflt,
  21.580 +		final int[] keys,
  21.581 +		final Label[] labels){
  21.582 +	mv.visitLookupSwitchInsn(dflt, keys, labels);
  21.583 +
  21.584 +	if(constructor)
  21.585 +		{
  21.586 +		popValue();
  21.587 +		addBranches(dflt, labels);
  21.588 +		}
  21.589 +}
  21.590 +
  21.591 +public void visitTableSwitchInsn(
  21.592 +		final int min,
  21.593 +		final int max,
  21.594 +		final Label dflt,
  21.595 +		final Label[] labels){
  21.596 +	mv.visitTableSwitchInsn(min, max, dflt, labels);
  21.597 +
  21.598 +	if(constructor)
  21.599 +		{
  21.600 +		popValue();
  21.601 +		addBranches(dflt, labels);
  21.602 +		}
  21.603 +}
  21.604 +
  21.605 +private void addBranches(final Label dflt, final Label[] labels){
  21.606 +	addBranch(dflt);
  21.607 +	for(int i = 0; i < labels.length; i++)
  21.608 +		{
  21.609 +		addBranch(labels[i]);
  21.610 +		}
  21.611 +}
  21.612 +
  21.613 +private void addBranch(final Label label){
  21.614 +	if(branches.containsKey(label))
  21.615 +		{
  21.616 +		return;
  21.617 +		}
  21.618 +	ArrayList frame = new ArrayList();
  21.619 +	frame.addAll(stackFrame);
  21.620 +	branches.put(label, frame);
  21.621 +}
  21.622 +
  21.623 +private Object popValue(){
  21.624 +	return stackFrame.remove(stackFrame.size() - 1);
  21.625 +}
  21.626 +
  21.627 +private Object peekValue(){
  21.628 +	return stackFrame.get(stackFrame.size() - 1);
  21.629 +}
  21.630 +
  21.631 +private void pushValue(final Object o){
  21.632 +	stackFrame.add(o);
  21.633 +}
  21.634 +
  21.635 +/**
  21.636 + * Called at the beginning of the method or after super class class call in
  21.637 + * the constructor. <br><br>
  21.638 + * <p/>
  21.639 + * <i>Custom code can use or change all the local variables, but should not
  21.640 + * change state of the stack.</i>
  21.641 + */
  21.642 +protected abstract void onMethodEnter();
  21.643 +
  21.644 +/**
  21.645 + * Called before explicit exit from the method using either return or throw.
  21.646 + * Top element on the stack contains the return value or exception instance.
  21.647 + * For example:
  21.648 + * <p/>
  21.649 + * <pre>
  21.650 + *   public void onMethodExit(int opcode) {
  21.651 + *     if(opcode==RETURN) {
  21.652 + *         visitInsn(ACONST_NULL);
  21.653 + *     } else if(opcode==ARETURN || opcode==ATHROW) {
  21.654 + *         dup();
  21.655 + *     } else {
  21.656 + *         if(opcode==LRETURN || opcode==DRETURN) {
  21.657 + *             dup2();
  21.658 + *         } else {
  21.659 + *             dup();
  21.660 + *         }
  21.661 + *         box(Type.getReturnType(this.methodDesc));
  21.662 + *     }
  21.663 + *     visitIntInsn(SIPUSH, opcode);
  21.664 + *     visitMethodInsn(INVOKESTATIC, owner, "onExit", "(Ljava/lang/Object;I)V");
  21.665 + *   }
  21.666 + * <p/>
  21.667 + *   // an actual call back method
  21.668 + *   public static void onExit(int opcode, Object param) {
  21.669 + *     ...
  21.670 + * </pre>
  21.671 + * <p/>
  21.672 + * <br><br>
  21.673 + * <p/>
  21.674 + * <i>Custom code can use or change all the local variables, but should not
  21.675 + * change state of the stack.</i>
  21.676 + *
  21.677 + * @param opcode one of the RETURN, IRETURN, FRETURN, ARETURN, LRETURN,
  21.678 + *               DRETURN or ATHROW
  21.679 + */
  21.680 +protected abstract void onMethodExit(int opcode);
  21.681 +
  21.682 +// TODO onException, onMethodCall
  21.683 +
  21.684 +}
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/clojure/asm/commons/AnalyzerAdapter.java	Sat Aug 21 06:25:44 2010 -0400
    22.3 @@ -0,0 +1,938 @@
    22.4 +/***
    22.5 + * ASM: a very small and fast Java bytecode manipulation framework
    22.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    22.7 + * All rights reserved.
    22.8 + *
    22.9 + * Redistribution and use in source and binary forms, with or without
   22.10 + * modification, are permitted provided that the following conditions
   22.11 + * are met:
   22.12 + * 1. Redistributions of source code must retain the above copyright
   22.13 + *    notice, this list of conditions and the following disclaimer.
   22.14 + * 2. Redistributions in binary form must reproduce the above copyright
   22.15 + *    notice, this list of conditions and the following disclaimer in the
   22.16 + *    documentation and/or other materials provided with the distribution.
   22.17 + * 3. Neither the name of the copyright holders nor the names of its
   22.18 + *    contributors may be used to endorse or promote products derived from
   22.19 + *    this software without specific prior written permission.
   22.20 + *
   22.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   22.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   22.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   22.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   22.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   22.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   22.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   22.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   22.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   22.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   22.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   22.32 + */
   22.33 +package clojure.asm.commons;
   22.34 +
   22.35 +import java.util.ArrayList;
   22.36 +import java.util.HashMap;
   22.37 +import java.util.List;
   22.38 +import java.util.Map;
   22.39 +
   22.40 +import clojure.asm.Label;
   22.41 +import clojure.asm.MethodAdapter;
   22.42 +import clojure.asm.MethodVisitor;
   22.43 +import clojure.asm.Opcodes;
   22.44 +import clojure.asm.Type;
   22.45 +
   22.46 +/**
   22.47 + * A {@link MethodAdapter} that keeps track of stack map frame changes between
   22.48 + * {@link #visitFrame(int,int,Object[],int,Object[]) visitFrame} calls. This
   22.49 + * adapter must be used with the
   22.50 + * {@link clojure.asm.ClassReader#EXPAND_FRAMES} option. Each visit<i>XXX</i>
   22.51 + * instruction delegates to the next visitor in the chain, if any, and then
   22.52 + * simulates the effect of this instruction on the stack map frame, represented
   22.53 + * by {@link #locals} and {@link #stack}. The next visitor in the chain can get
   22.54 + * the state of the stack map frame <i>before</i> each instruction by reading
   22.55 + * the value of these fields in its visit<i>XXX</i> methods (this requires a
   22.56 + * reference to the AnalyzerAdapter that is before it in the chain).
   22.57 + *
   22.58 + * @author Eric Bruneton
   22.59 + */
   22.60 +public class AnalyzerAdapter extends MethodAdapter{
   22.61 +
   22.62 +/**
   22.63 + * <code>List</code> of the local variable slots for current execution
   22.64 + * frame. Primitive types are represented by {@link Opcodes#TOP},
   22.65 + * {@link Opcodes#INTEGER}, {@link Opcodes#FLOAT}, {@link Opcodes#LONG},
   22.66 + * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or
   22.67 + * {@link Opcodes#UNINITIALIZED_THIS} (long and double are represented by a
   22.68 + * two elements, the second one being TOP). Reference types are represented
   22.69 + * by String objects (representing internal names, or type descriptors for
   22.70 + * array types), and uninitialized types by Label objects (this label
   22.71 + * designates the NEW instruction that created this uninitialized value).
   22.72 + * This field is <tt>null</tt> for unreacheable instructions.
   22.73 + */
   22.74 +public List locals;
   22.75 +
   22.76 +/**
   22.77 + * <code>List</code> of the operand stack slots for current execution
   22.78 + * frame. Primitive types are represented by {@link Opcodes#TOP},
   22.79 + * {@link Opcodes#INTEGER}, {@link Opcodes#FLOAT}, {@link Opcodes#LONG},
   22.80 + * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or
   22.81 + * {@link Opcodes#UNINITIALIZED_THIS} (long and double are represented by a
   22.82 + * two elements, the second one being TOP). Reference types are represented
   22.83 + * by String objects (representing internal names, or type descriptors for
   22.84 + * array types), and uninitialized types by Label objects (this label
   22.85 + * designates the NEW instruction that created this uninitialized value).
   22.86 + * This field is <tt>null</tt> for unreacheable instructions.
   22.87 + */
   22.88 +public List stack;
   22.89 +
   22.90 +/**
   22.91 + * The labels that designate the next instruction to be visited. May be
   22.92 + * <tt>null</tt>.
   22.93 + */
   22.94 +private List labels;
   22.95 +
   22.96 +/**
   22.97 + * Information about uninitialized types in the current execution frame.
   22.98 + * This map associates internal names to Label objects. Each label
   22.99 + * designates a NEW instruction that created the currently uninitialized
  22.100 + * types, and the associated internal name represents the NEW operand, i.e.
  22.101 + * the final, initialized type value.
  22.102 + */
  22.103 +private Map uninitializedTypes;
  22.104 +
  22.105 +/**
  22.106 + * The maximum stack size of this method.
  22.107 + */
  22.108 +private int maxStack;
  22.109 +
  22.110 +/**
  22.111 + * The maximum number of local variables of this method.
  22.112 + */
  22.113 +private int maxLocals;
  22.114 +
  22.115 +/**
  22.116 + * Creates a new {@link AnalyzerAdapter}.
  22.117 + *
  22.118 + * @param owner  the owner's class name.
  22.119 + * @param access the method's access flags (see {@link Opcodes}).
  22.120 + * @param name   the method's name.
  22.121 + * @param desc   the method's descriptor (see {@link Type Type}).
  22.122 + * @param mv     the method visitor to which this adapter delegates calls. May
  22.123 + *               be <tt>null</tt>.
  22.124 + */
  22.125 +public AnalyzerAdapter(
  22.126 +		final String owner,
  22.127 +		final int access,
  22.128 +		final String name,
  22.129 +		final String desc,
  22.130 +		final MethodVisitor mv){
  22.131 +	super(mv);
  22.132 +	locals = new ArrayList();
  22.133 +	stack = new ArrayList();
  22.134 +	uninitializedTypes = new HashMap();
  22.135 +
  22.136 +	if((access & Opcodes.ACC_STATIC) == 0)
  22.137 +		{
  22.138 +		if(name.equals("<init>"))
  22.139 +			{
  22.140 +			locals.add(Opcodes.UNINITIALIZED_THIS);
  22.141 +			}
  22.142 +		else
  22.143 +			{
  22.144 +			locals.add(owner);
  22.145 +			}
  22.146 +		}
  22.147 +	Type[] types = Type.getArgumentTypes(desc);
  22.148 +	for(int i = 0; i < types.length; ++i)
  22.149 +		{
  22.150 +		Type type = types[i];
  22.151 +		switch(type.getSort())
  22.152 +			{
  22.153 +			case Type.BOOLEAN:
  22.154 +			case Type.CHAR:
  22.155 +			case Type.BYTE:
  22.156 +			case Type.SHORT:
  22.157 +			case Type.INT:
  22.158 +				locals.add(Opcodes.INTEGER);
  22.159 +				break;
  22.160 +			case Type.FLOAT:
  22.161 +				locals.add(Opcodes.FLOAT);
  22.162 +				break;
  22.163 +			case Type.LONG:
  22.164 +				locals.add(Opcodes.LONG);
  22.165 +				locals.add(Opcodes.TOP);
  22.166 +				break;
  22.167 +			case Type.DOUBLE:
  22.168 +				locals.add(Opcodes.DOUBLE);
  22.169 +				locals.add(Opcodes.TOP);
  22.170 +				break;
  22.171 +			case Type.ARRAY:
  22.172 +				locals.add(types[i].getDescriptor());
  22.173 +				break;
  22.174 +				// case Type.OBJECT:
  22.175 +			default:
  22.176 +				locals.add(types[i].getInternalName());
  22.177 +			}
  22.178 +		}
  22.179 +}
  22.180 +
  22.181 +public void visitFrame(
  22.182 +		final int type,
  22.183 +		final int nLocal,
  22.184 +		final Object[] local,
  22.185 +		final int nStack,
  22.186 +		final Object[] stack){
  22.187 +	if(type != Opcodes.F_NEW)
  22.188 +		{ // uncompressed frame
  22.189 +		throw new IllegalStateException("ClassReader.accept() should be called with EXPAND_FRAMES flag");
  22.190 +		}
  22.191 +
  22.192 +	if(mv != null)
  22.193 +		{
  22.194 +		mv.visitFrame(type, nLocal, local, nStack, stack);
  22.195 +		}
  22.196 +
  22.197 +	if(this.locals != null)
  22.198 +		{
  22.199 +		this.locals.clear();
  22.200 +		this.stack.clear();
  22.201 +		}
  22.202 +	else
  22.203 +		{
  22.204 +		this.locals = new ArrayList();
  22.205 +		this.stack = new ArrayList();
  22.206 +		}
  22.207 +	visitFrameTypes(nLocal, local, this.locals);
  22.208 +	visitFrameTypes(nStack, stack, this.stack);
  22.209 +	maxStack = Math.max(maxStack, this.stack.size());
  22.210 +}
  22.211 +
  22.212 +private void visitFrameTypes(
  22.213 +		final int n,
  22.214 +		final Object[] types,
  22.215 +		final List result){
  22.216 +	for(int i = 0; i < n; ++i)
  22.217 +		{
  22.218 +		Object type = types[i];
  22.219 +		result.add(type);
  22.220 +		if(type == Opcodes.LONG || type == Opcodes.DOUBLE)
  22.221 +			{
  22.222 +			result.add(Opcodes.TOP);
  22.223 +			}
  22.224 +		}
  22.225 +}
  22.226 +
  22.227 +public void visitInsn(final int opcode){
  22.228 +	if(mv != null)
  22.229 +		{
  22.230 +		mv.visitInsn(opcode);
  22.231 +		}
  22.232 +	execute(opcode, 0, null);
  22.233 +	if((opcode >= Opcodes.IRETURN && opcode <= Opcodes.RETURN)
  22.234 +	   || opcode == Opcodes.ATHROW)
  22.235 +		{
  22.236 +		this.locals = null;
  22.237 +		this.stack = null;
  22.238 +		}
  22.239 +}
  22.240 +
  22.241 +public void visitIntInsn(final int opcode, final int operand){
  22.242 +	if(mv != null)
  22.243 +		{
  22.244 +		mv.visitIntInsn(opcode, operand);
  22.245 +		}
  22.246 +	execute(opcode, operand, null);
  22.247 +}
  22.248 +
  22.249 +public void visitVarInsn(final int opcode, final int var){
  22.250 +	if(mv != null)
  22.251 +		{
  22.252 +		mv.visitVarInsn(opcode, var);
  22.253 +		}
  22.254 +	execute(opcode, var, null);
  22.255 +}
  22.256 +
  22.257 +public void visitTypeInsn(final int opcode, final String desc){
  22.258 +	if(opcode == Opcodes.NEW)
  22.259 +		{
  22.260 +		if(labels == null)
  22.261 +			{
  22.262 +			Label l = new Label();
  22.263 +			labels = new ArrayList(3);
  22.264 +			labels.add(l);
  22.265 +			if(mv != null)
  22.266 +				{
  22.267 +				mv.visitLabel(l);
  22.268 +				}
  22.269 +			}
  22.270 +		for(int i = 0; i < labels.size(); ++i)
  22.271 +			{
  22.272 +			uninitializedTypes.put(labels.get(i), desc);
  22.273 +			}
  22.274 +		}
  22.275 +	if(mv != null)
  22.276 +		{
  22.277 +		mv.visitTypeInsn(opcode, desc);
  22.278 +		}
  22.279 +	execute(opcode, 0, desc);
  22.280 +}
  22.281 +
  22.282 +public void visitFieldInsn(
  22.283 +		final int opcode,
  22.284 +		final String owner,
  22.285 +		final String name,
  22.286 +		final String desc){
  22.287 +	if(mv != null)
  22.288 +		{
  22.289 +		mv.visitFieldInsn(opcode, owner, name, desc);
  22.290 +		}
  22.291 +	execute(opcode, 0, desc);
  22.292 +}
  22.293 +
  22.294 +public void visitMethodInsn(
  22.295 +		final int opcode,
  22.296 +		final String owner,
  22.297 +		final String name,
  22.298 +		final String desc){
  22.299 +	if(mv != null)
  22.300 +		{
  22.301 +		mv.visitMethodInsn(opcode, owner, name, desc);
  22.302 +		}
  22.303 +	pop(desc);
  22.304 +	if(opcode != Opcodes.INVOKESTATIC)
  22.305 +		{
  22.306 +		Object t = pop();
  22.307 +		if(opcode == Opcodes.INVOKESPECIAL && name.charAt(0) == '<')
  22.308 +			{
  22.309 +			Object u;
  22.310 +			if(t == Opcodes.UNINITIALIZED_THIS)
  22.311 +				{
  22.312 +				u = owner;
  22.313 +				}
  22.314 +			else
  22.315 +				{
  22.316 +				u = uninitializedTypes.get(t);
  22.317 +				}
  22.318 +			for(int i = 0; i < locals.size(); ++i)
  22.319 +				{
  22.320 +				if(locals.get(i) == t)
  22.321 +					{
  22.322 +					locals.set(i, u);
  22.323 +					}
  22.324 +				}
  22.325 +			for(int i = 0; i < stack.size(); ++i)
  22.326 +				{
  22.327 +				if(stack.get(i) == t)
  22.328 +					{
  22.329 +					stack.set(i, u);
  22.330 +					}
  22.331 +				}
  22.332 +			}
  22.333 +		}
  22.334 +	pushDesc(desc);
  22.335 +	labels = null;
  22.336 +}
  22.337 +
  22.338 +public void visitJumpInsn(final int opcode, final Label label){
  22.339 +	if(mv != null)
  22.340 +		{
  22.341 +		mv.visitJumpInsn(opcode, label);
  22.342 +		}
  22.343 +	execute(opcode, 0, null);
  22.344 +	if(opcode == Opcodes.GOTO)
  22.345 +		{
  22.346 +		this.locals = null;
  22.347 +		this.stack = null;
  22.348 +		}
  22.349 +}
  22.350 +
  22.351 +public void visitLabel(final Label label){
  22.352 +	if(mv != null)
  22.353 +		{
  22.354 +		mv.visitLabel(label);
  22.355 +		}
  22.356 +	if(labels == null)
  22.357 +		{
  22.358 +		labels = new ArrayList(3);
  22.359 +		}
  22.360 +	labels.add(label);
  22.361 +}
  22.362 +
  22.363 +public void visitLdcInsn(final Object cst){
  22.364 +	if(mv != null)
  22.365 +		{
  22.366 +		mv.visitLdcInsn(cst);
  22.367 +		}
  22.368 +	if(cst instanceof Integer)
  22.369 +		{
  22.370 +		push(Opcodes.INTEGER);
  22.371 +		}
  22.372 +	else if(cst instanceof Long)
  22.373 +		{
  22.374 +		push(Opcodes.LONG);
  22.375 +		push(Opcodes.TOP);
  22.376 +		}
  22.377 +	else if(cst instanceof Float)
  22.378 +		{
  22.379 +		push(Opcodes.FLOAT);
  22.380 +		}
  22.381 +	else if(cst instanceof Double)
  22.382 +		{
  22.383 +		push(Opcodes.DOUBLE);
  22.384 +		push(Opcodes.TOP);
  22.385 +		}
  22.386 +	else if(cst instanceof String)
  22.387 +		{
  22.388 +		push("java/lang/String");
  22.389 +		}
  22.390 +	else if(cst instanceof Type)
  22.391 +		{
  22.392 +		push("java/lang/Class");
  22.393 +		}
  22.394 +	else
  22.395 +		{
  22.396 +		throw new IllegalArgumentException();
  22.397 +		}
  22.398 +	labels = null;
  22.399 +}
  22.400 +
  22.401 +public void visitIincInsn(final int var, final int increment){
  22.402 +	if(mv != null)
  22.403 +		{
  22.404 +		mv.visitIincInsn(var, increment);
  22.405 +		}
  22.406 +	execute(Opcodes.IINC, var, null);
  22.407 +}
  22.408 +
  22.409 +public void visitTableSwitchInsn(
  22.410 +		final int min,
  22.411 +		final int max,
  22.412 +		final Label dflt,
  22.413 +		final Label labels[]){
  22.414 +	if(mv != null)
  22.415 +		{
  22.416 +		mv.visitTableSwitchInsn(min, max, dflt, labels);
  22.417 +		}
  22.418 +	execute(Opcodes.TABLESWITCH, 0, null);
  22.419 +	this.locals = null;
  22.420 +	this.stack = null;
  22.421 +}
  22.422 +
  22.423 +public void visitLookupSwitchInsn(
  22.424 +		final Label dflt,
  22.425 +		final int keys[],
  22.426 +		final Label labels[]){
  22.427 +	if(mv != null)
  22.428 +		{
  22.429 +		mv.visitLookupSwitchInsn(dflt, keys, labels);
  22.430 +		}
  22.431 +	execute(Opcodes.LOOKUPSWITCH, 0, null);
  22.432 +	this.locals = null;
  22.433 +	this.stack = null;
  22.434 +}
  22.435 +
  22.436 +public void visitMultiANewArrayInsn(final String desc, final int dims){
  22.437 +	if(mv != null)
  22.438 +		{
  22.439 +		mv.visitMultiANewArrayInsn(desc, dims);
  22.440 +		}
  22.441 +	execute(Opcodes.MULTIANEWARRAY, dims, desc);
  22.442 +}
  22.443 +
  22.444 +public void visitMaxs(final int maxStack, final int maxLocals){
  22.445 +	if(mv != null)
  22.446 +		{
  22.447 +		this.maxStack = Math.max(this.maxStack, maxStack);
  22.448 +		this.maxLocals = Math.max(this.maxLocals, maxLocals);
  22.449 +		mv.visitMaxs(this.maxStack, this.maxLocals);
  22.450 +		}
  22.451 +}
  22.452 +
  22.453 +// ------------------------------------------------------------------------
  22.454 +
  22.455 +private Object get(final int local){
  22.456 +	maxLocals = Math.max(maxLocals, local);
  22.457 +	return local < locals.size() ? locals.get(local) : Opcodes.TOP;
  22.458 +}
  22.459 +
  22.460 +private void set(final int local, final Object type){
  22.461 +	maxLocals = Math.max(maxLocals, local);
  22.462 +	while(local >= locals.size())
  22.463 +		{
  22.464 +		locals.add(Opcodes.TOP);
  22.465 +		}
  22.466 +	locals.set(local, type);
  22.467 +}
  22.468 +
  22.469 +private void push(final Object type){
  22.470 +	stack.add(type);
  22.471 +	maxStack = Math.max(maxStack, stack.size());
  22.472 +}
  22.473 +
  22.474 +private void pushDesc(final String desc){
  22.475 +	int index = desc.charAt(0) == '(' ? desc.indexOf(')') + 1 : 0;
  22.476 +	switch(desc.charAt(index))
  22.477 +		{
  22.478 +		case'V':
  22.479 +			return;
  22.480 +		case'Z':
  22.481 +		case'C':
  22.482 +		case'B':
  22.483 +		case'S':
  22.484 +		case'I':
  22.485 +			push(Opcodes.INTEGER);
  22.486 +			return;
  22.487 +		case'F':
  22.488 +			push(Opcodes.FLOAT);
  22.489 +			return;
  22.490 +		case'J':
  22.491 +			push(Opcodes.LONG);
  22.492 +			push(Opcodes.TOP);
  22.493 +			return;
  22.494 +		case'D':
  22.495 +			push(Opcodes.DOUBLE);
  22.496 +			push(Opcodes.TOP);
  22.497 +			return;
  22.498 +		case'[':
  22.499 +			if(index == 0)
  22.500 +				{
  22.501 +				push(desc);
  22.502 +				}
  22.503 +			else
  22.504 +				{
  22.505 +				push(desc.substring(index, desc.length()));
  22.506 +				}
  22.507 +			break;
  22.508 +			// case 'L':
  22.509 +		default:
  22.510 +			if(index == 0)
  22.511 +				{
  22.512 +				push(desc.substring(1, desc.length() - 1));
  22.513 +				}
  22.514 +			else
  22.515 +				{
  22.516 +				push(desc.substring(index + 1, desc.length() - 1));
  22.517 +				}
  22.518 +			return;
  22.519 +		}
  22.520 +}
  22.521 +
  22.522 +private Object pop(){
  22.523 +	return stack.remove(stack.size() - 1);
  22.524 +}
  22.525 +
  22.526 +private void pop(final int n){
  22.527 +	int size = stack.size();
  22.528 +	int end = size - n;
  22.529 +	for(int i = size - 1; i >= end; --i)
  22.530 +		{
  22.531 +		stack.remove(i);
  22.532 +		}
  22.533 +}
  22.534 +
  22.535 +private void pop(final String desc){
  22.536 +	char c = desc.charAt(0);
  22.537 +	if(c == '(')
  22.538 +		{
  22.539 +		int n = 0;
  22.540 +		Type[] types = Type.getArgumentTypes(desc);
  22.541 +		for(int i = 0; i < types.length; ++i)
  22.542 +			{
  22.543 +			n += types[i].getSize();
  22.544 +			}
  22.545 +		pop(n);
  22.546 +		}
  22.547 +	else if(c == 'J' || c == 'D')
  22.548 +		{
  22.549 +		pop(2);
  22.550 +		}
  22.551 +	else
  22.552 +		{
  22.553 +		pop(1);
  22.554 +		}
  22.555 +}
  22.556 +
  22.557 +private void execute(final int opcode, final int iarg, final String sarg){
  22.558 +	if(this.locals == null)
  22.559 +		{
  22.560 +		return;
  22.561 +		}
  22.562 +	Object t1, t2, t3, t4;
  22.563 +	switch(opcode)
  22.564 +		{
  22.565 +		case Opcodes.NOP:
  22.566 +		case Opcodes.INEG:
  22.567 +		case Opcodes.LNEG:
  22.568 +		case Opcodes.FNEG:
  22.569 +		case Opcodes.DNEG:
  22.570 +		case Opcodes.I2B:
  22.571 +		case Opcodes.I2C:
  22.572 +		case Opcodes.I2S:
  22.573 +		case Opcodes.GOTO:
  22.574 +		case Opcodes.RETURN:
  22.575 +			break;
  22.576 +		case Opcodes.ACONST_NULL:
  22.577 +			push(Opcodes.NULL);
  22.578 +			break;
  22.579 +		case Opcodes.ICONST_M1:
  22.580 +		case Opcodes.ICONST_0:
  22.581 +		case Opcodes.ICONST_1:
  22.582 +		case Opcodes.ICONST_2:
  22.583 +		case Opcodes.ICONST_3:
  22.584 +		case Opcodes.ICONST_4:
  22.585 +		case Opcodes.ICONST_5:
  22.586 +		case Opcodes.BIPUSH:
  22.587 +		case Opcodes.SIPUSH:
  22.588 +			push(Opcodes.INTEGER);
  22.589 +			break;
  22.590 +		case Opcodes.LCONST_0:
  22.591 +		case Opcodes.LCONST_1:
  22.592 +			push(Opcodes.LONG);
  22.593 +			push(Opcodes.TOP);
  22.594 +			break;
  22.595 +		case Opcodes.FCONST_0:
  22.596 +		case Opcodes.FCONST_1:
  22.597 +		case Opcodes.FCONST_2:
  22.598 +			push(Opcodes.FLOAT);
  22.599 +			break;
  22.600 +		case Opcodes.DCONST_0:
  22.601 +		case Opcodes.DCONST_1:
  22.602 +			push(Opcodes.DOUBLE);
  22.603 +			push(Opcodes.TOP);
  22.604 +			break;
  22.605 +		case Opcodes.ILOAD:
  22.606 +		case Opcodes.FLOAD:
  22.607 +		case Opcodes.ALOAD:
  22.608 +			push(get(iarg));
  22.609 +			break;
  22.610 +		case Opcodes.LLOAD:
  22.611 +		case Opcodes.DLOAD:
  22.612 +			push(get(iarg));
  22.613 +			push(Opcodes.TOP);
  22.614 +			break;
  22.615 +		case Opcodes.IALOAD:
  22.616 +		case Opcodes.BALOAD:
  22.617 +		case Opcodes.CALOAD:
  22.618 +		case Opcodes.SALOAD:
  22.619 +			pop(2);
  22.620 +			push(Opcodes.INTEGER);
  22.621 +			break;
  22.622 +		case Opcodes.LALOAD:
  22.623 +		case Opcodes.D2L:
  22.624 +			pop(2);
  22.625 +			push(Opcodes.LONG);
  22.626 +			push(Opcodes.TOP);
  22.627 +			break;
  22.628 +		case Opcodes.FALOAD:
  22.629 +			pop(2);
  22.630 +			push(Opcodes.FLOAT);
  22.631 +			break;
  22.632 +		case Opcodes.DALOAD:
  22.633 +		case Opcodes.L2D:
  22.634 +			pop(2);
  22.635 +			push(Opcodes.DOUBLE);
  22.636 +			push(Opcodes.TOP);
  22.637 +			break;
  22.638 +		case Opcodes.AALOAD:
  22.639 +			pop(1);
  22.640 +			t1 = pop();
  22.641 +			pushDesc(((String) t1).substring(1));
  22.642 +			break;
  22.643 +		case Opcodes.ISTORE:
  22.644 +		case Opcodes.FSTORE:
  22.645 +		case Opcodes.ASTORE:
  22.646 +			t1 = pop();
  22.647 +			set(iarg, t1);
  22.648 +			if(iarg > 0)
  22.649 +				{
  22.650 +				t2 = get(iarg - 1);
  22.651 +				if(t2 == Opcodes.LONG || t2 == Opcodes.DOUBLE)
  22.652 +					{
  22.653 +					set(iarg - 1, Opcodes.TOP);
  22.654 +					}
  22.655 +				}
  22.656 +			break;
  22.657 +		case Opcodes.LSTORE:
  22.658 +		case Opcodes.DSTORE:
  22.659 +			pop(1);
  22.660 +			t1 = pop();
  22.661 +			set(iarg, t1);
  22.662 +			set(iarg + 1, Opcodes.TOP);
  22.663 +			if(iarg > 0)
  22.664 +				{
  22.665 +				t2 = get(iarg - 1);
  22.666 +				if(t2 == Opcodes.LONG || t2 == Opcodes.DOUBLE)
  22.667 +					{
  22.668 +					set(iarg - 1, Opcodes.TOP);
  22.669 +					}
  22.670 +				}
  22.671 +			break;
  22.672 +		case Opcodes.IASTORE:
  22.673 +		case Opcodes.BASTORE:
  22.674 +		case Opcodes.CASTORE:
  22.675 +		case Opcodes.SASTORE:
  22.676 +		case Opcodes.FASTORE:
  22.677 +		case Opcodes.AASTORE:
  22.678 +			pop(3);
  22.679 +			break;
  22.680 +		case Opcodes.LASTORE:
  22.681 +		case Opcodes.DASTORE:
  22.682 +			pop(4);
  22.683 +			break;
  22.684 +		case Opcodes.POP:
  22.685 +		case Opcodes.IFEQ:
  22.686 +		case Opcodes.IFNE:
  22.687 +		case Opcodes.IFLT:
  22.688 +		case Opcodes.IFGE:
  22.689 +		case Opcodes.IFGT:
  22.690 +		case Opcodes.IFLE:
  22.691 +		case Opcodes.IRETURN:
  22.692 +		case Opcodes.FRETURN:
  22.693 +		case Opcodes.ARETURN:
  22.694 +		case Opcodes.TABLESWITCH:
  22.695 +		case Opcodes.LOOKUPSWITCH:
  22.696 +		case Opcodes.ATHROW:
  22.697 +		case Opcodes.MONITORENTER:
  22.698 +		case Opcodes.MONITOREXIT:
  22.699 +		case Opcodes.IFNULL:
  22.700 +		case Opcodes.IFNONNULL:
  22.701 +			pop(1);
  22.702 +			break;
  22.703 +		case Opcodes.POP2:
  22.704 +		case Opcodes.IF_ICMPEQ:
  22.705 +		case Opcodes.IF_ICMPNE:
  22.706 +		case Opcodes.IF_ICMPLT:
  22.707 +		case Opcodes.IF_ICMPGE:
  22.708 +		case Opcodes.IF_ICMPGT:
  22.709 +		case Opcodes.IF_ICMPLE:
  22.710 +		case Opcodes.IF_ACMPEQ:
  22.711 +		case Opcodes.IF_ACMPNE:
  22.712 +		case Opcodes.LRETURN:
  22.713 +		case Opcodes.DRETURN:
  22.714 +			pop(2);
  22.715 +			break;
  22.716 +		case Opcodes.DUP:
  22.717 +			t1 = pop();
  22.718 +			push(t1);
  22.719 +			push(t1);
  22.720 +			break;
  22.721 +		case Opcodes.DUP_X1:
  22.722 +			t1 = pop();
  22.723 +			t2 = pop();
  22.724 +			push(t1);
  22.725 +			push(t2);
  22.726 +			push(t1);
  22.727 +			break;
  22.728 +		case Opcodes.DUP_X2:
  22.729 +			t1 = pop();
  22.730 +			t2 = pop();
  22.731 +			t3 = pop();
  22.732 +			push(t1);
  22.733 +			push(t3);
  22.734 +			push(t2);
  22.735 +			push(t1);
  22.736 +			break;
  22.737 +		case Opcodes.DUP2:
  22.738 +			t1 = pop();
  22.739 +			t2 = pop();
  22.740 +			push(t2);
  22.741 +			push(t1);
  22.742 +			push(t2);
  22.743 +			push(t1);
  22.744 +			break;
  22.745 +		case Opcodes.DUP2_X1:
  22.746 +			t1 = pop();
  22.747 +			t2 = pop();
  22.748 +			t3 = pop();
  22.749 +			push(t2);
  22.750 +			push(t1);
  22.751 +			push(t3);
  22.752 +			push(t2);
  22.753 +			push(t1);
  22.754 +			break;
  22.755 +		case Opcodes.DUP2_X2:
  22.756 +			t1 = pop();
  22.757 +			t2 = pop();
  22.758 +			t3 = pop();
  22.759 +			t4 = pop();
  22.760 +			push(t2);
  22.761 +			push(t1);
  22.762 +			push(t4);
  22.763 +			push(t3);
  22.764 +			push(t2);
  22.765 +			push(t1);
  22.766 +			break;
  22.767 +		case Opcodes.SWAP:
  22.768 +			t1 = pop();
  22.769 +			t2 = pop();
  22.770 +			push(t1);
  22.771 +			push(t2);
  22.772 +			break;
  22.773 +		case Opcodes.IADD:
  22.774 +		case Opcodes.ISUB:
  22.775 +		case Opcodes.IMUL:
  22.776 +		case Opcodes.IDIV:
  22.777 +		case Opcodes.IREM:
  22.778 +		case Opcodes.IAND:
  22.779 +		case Opcodes.IOR:
  22.780 +		case Opcodes.IXOR:
  22.781 +		case Opcodes.ISHL:
  22.782 +		case Opcodes.ISHR:
  22.783 +		case Opcodes.IUSHR:
  22.784 +		case Opcodes.L2I:
  22.785 +		case Opcodes.D2I:
  22.786 +		case Opcodes.FCMPL:
  22.787 +		case Opcodes.FCMPG:
  22.788 +			pop(2);
  22.789 +			push(Opcodes.INTEGER);
  22.790 +			break;
  22.791 +		case Opcodes.LADD:
  22.792 +		case Opcodes.LSUB:
  22.793 +		case Opcodes.LMUL:
  22.794 +		case Opcodes.LDIV:
  22.795 +		case Opcodes.LREM:
  22.796 +		case Opcodes.LAND:
  22.797 +		case Opcodes.LOR:
  22.798 +		case Opcodes.LXOR:
  22.799 +			pop(4);
  22.800 +			push(Opcodes.LONG);
  22.801 +			push(Opcodes.TOP);
  22.802 +			break;
  22.803 +		case Opcodes.FADD:
  22.804 +		case Opcodes.FSUB:
  22.805 +		case Opcodes.FMUL:
  22.806 +		case Opcodes.FDIV:
  22.807 +		case Opcodes.FREM:
  22.808 +		case Opcodes.L2F:
  22.809 +		case Opcodes.D2F:
  22.810 +			pop(2);
  22.811 +			push(Opcodes.FLOAT);
  22.812 +			break;
  22.813 +		case Opcodes.DADD:
  22.814 +		case Opcodes.DSUB:
  22.815 +		case Opcodes.DMUL:
  22.816 +		case Opcodes.DDIV:
  22.817 +		case Opcodes.DREM:
  22.818 +			pop(4);
  22.819 +			push(Opcodes.DOUBLE);
  22.820 +			push(Opcodes.TOP);
  22.821 +			break;
  22.822 +		case Opcodes.LSHL:
  22.823 +		case Opcodes.LSHR:
  22.824 +		case Opcodes.LUSHR:
  22.825 +			pop(3);
  22.826 +			push(Opcodes.LONG);
  22.827 +			push(Opcodes.TOP);
  22.828 +			break;
  22.829 +		case Opcodes.IINC:
  22.830 +			set(iarg, Opcodes.INTEGER);
  22.831 +			break;
  22.832 +		case Opcodes.I2L:
  22.833 +		case Opcodes.F2L:
  22.834 +			pop(1);
  22.835 +			push(Opcodes.LONG);
  22.836 +			push(Opcodes.TOP);
  22.837 +			break;
  22.838 +		case Opcodes.I2F:
  22.839 +			pop(1);
  22.840 +			push(Opcodes.FLOAT);
  22.841 +			break;
  22.842 +		case Opcodes.I2D:
  22.843 +		case Opcodes.F2D:
  22.844 +			pop(1);
  22.845 +			push(Opcodes.DOUBLE);
  22.846 +			push(Opcodes.TOP);
  22.847 +			break;
  22.848 +		case Opcodes.F2I:
  22.849 +		case Opcodes.ARRAYLENGTH:
  22.850 +		case Opcodes.INSTANCEOF:
  22.851 +			pop(1);
  22.852 +			push(Opcodes.INTEGER);
  22.853 +			break;
  22.854 +		case Opcodes.LCMP:
  22.855 +		case Opcodes.DCMPL:
  22.856 +		case Opcodes.DCMPG:
  22.857 +			pop(4);
  22.858 +			push(Opcodes.INTEGER);
  22.859 +			break;
  22.860 +		case Opcodes.JSR:
  22.861 +		case Opcodes.RET:
  22.862 +			throw new RuntimeException("JSR/RET are not supported");
  22.863 +		case Opcodes.GETSTATIC:
  22.864 +			pushDesc(sarg);
  22.865 +			break;
  22.866 +		case Opcodes.PUTSTATIC:
  22.867 +			pop(sarg);
  22.868 +			break;
  22.869 +		case Opcodes.GETFIELD:
  22.870 +			pop(1);
  22.871 +			pushDesc(sarg);
  22.872 +			break;
  22.873 +		case Opcodes.PUTFIELD:
  22.874 +			pop(sarg);
  22.875 +			pop();
  22.876 +			break;
  22.877 +		case Opcodes.NEW:
  22.878 +			push(labels.get(0));
  22.879 +			break;
  22.880 +		case Opcodes.NEWARRAY:
  22.881 +			pop();
  22.882 +			switch(iarg)
  22.883 +				{
  22.884 +				case Opcodes.T_BOOLEAN:
  22.885 +					pushDesc("[Z");
  22.886 +					break;
  22.887 +				case Opcodes.T_CHAR:
  22.888 +					pushDesc("[C");
  22.889 +					break;
  22.890 +				case Opcodes.T_BYTE:
  22.891 +					pushDesc("[B");
  22.892 +					break;
  22.893 +				case Opcodes.T_SHORT:
  22.894 +					pushDesc("[S");
  22.895 +					break;
  22.896 +				case Opcodes.T_INT:
  22.897 +					pushDesc("[I");
  22.898 +					break;
  22.899 +				case Opcodes.T_FLOAT:
  22.900 +					pushDesc("[F");
  22.901 +					break;
  22.902 +				case Opcodes.T_DOUBLE:
  22.903 +					pushDesc("[D");
  22.904 +					break;
  22.905 +					// case Opcodes.T_LONG:
  22.906 +				default:
  22.907 +					pushDesc("[J");
  22.908 +					break;
  22.909 +				}
  22.910 +			break;
  22.911 +		case Opcodes.ANEWARRAY:
  22.912 +			pop();
  22.913 +			if(sarg.charAt(0) == '[')
  22.914 +				{
  22.915 +				pushDesc("[" + sarg);
  22.916 +				}
  22.917 +			else
  22.918 +				{
  22.919 +				pushDesc("[L" + sarg + ";");
  22.920 +				}
  22.921 +			break;
  22.922 +		case Opcodes.CHECKCAST:
  22.923 +			pop();
  22.924 +			if(sarg.charAt(0) == '[')
  22.925 +				{
  22.926 +				pushDesc(sarg);
  22.927 +				}
  22.928 +			else
  22.929 +				{
  22.930 +				push(sarg);
  22.931 +				}
  22.932 +			break;
  22.933 +			// case Opcodes.MULTIANEWARRAY:
  22.934 +		default:
  22.935 +			pop(iarg);
  22.936 +			pushDesc(sarg);
  22.937 +			break;
  22.938 +		}
  22.939 +	labels = null;
  22.940 +}
  22.941 +}
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/clojure/asm/commons/CodeSizeEvaluator.java	Sat Aug 21 06:25:44 2010 -0400
    23.3 @@ -0,0 +1,234 @@
    23.4 +/***
    23.5 + * ASM: a very small and fast Java bytecode manipulation framework
    23.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    23.7 + * All rights reserved.
    23.8 + *
    23.9 + * Redistribution and use in source and binary forms, with or without
   23.10 + * modification, are permitted provided that the following conditions
   23.11 + * are met:
   23.12 + * 1. Redistributions of source code must retain the above copyright
   23.13 + *    notice, this list of conditions and the following disclaimer.
   23.14 + * 2. Redistributions in binary form must reproduce the above copyright
   23.15 + *    notice, this list of conditions and the following disclaimer in the
   23.16 + *    documentation and/or other materials provided with the distribution.
   23.17 + * 3. Neither the name of the copyright holders nor the names of its
   23.18 + *    contributors may be used to endorse or promote products derived from
   23.19 + *    this software without specific prior written permission.
   23.20 + *
   23.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   23.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   23.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   23.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   23.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   23.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   23.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   23.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   23.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   23.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   23.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   23.32 + */
   23.33 +package clojure.asm.commons;
   23.34 +
   23.35 +import clojure.asm.Label;
   23.36 +import clojure.asm.MethodAdapter;
   23.37 +import clojure.asm.MethodVisitor;
   23.38 +import clojure.asm.Opcodes;
   23.39 +
   23.40 +/**
   23.41 + * A {@link MethodAdapter} that can be used to approximate method size.
   23.42 + *
   23.43 + * @author Eugene Kuleshov
   23.44 + */
   23.45 +public class CodeSizeEvaluator extends MethodAdapter implements Opcodes{
   23.46 +
   23.47 +private int minSize;
   23.48 +
   23.49 +private int maxSize;
   23.50 +
   23.51 +public CodeSizeEvaluator(final MethodVisitor mv){
   23.52 +	super(mv);
   23.53 +}
   23.54 +
   23.55 +public int getMinSize(){
   23.56 +	return this.minSize;
   23.57 +}
   23.58 +
   23.59 +public int getMaxSize(){
   23.60 +	return this.maxSize;
   23.61 +}
   23.62 +
   23.63 +public void visitInsn(final int opcode){
   23.64 +	minSize += 1;
   23.65 +	maxSize += 1;
   23.66 +	if(mv != null)
   23.67 +		{
   23.68 +		mv.visitInsn(opcode);
   23.69 +		}
   23.70 +}
   23.71 +
   23.72 +public void visitIntInsn(final int opcode, final int operand){
   23.73 +	if(opcode == SIPUSH)
   23.74 +		{
   23.75 +		minSize += 3;
   23.76 +		maxSize += 3;
   23.77 +		}
   23.78 +	else
   23.79 +		{
   23.80 +		minSize += 2;
   23.81 +		maxSize += 2;
   23.82 +		}
   23.83 +	if(mv != null)
   23.84 +		{
   23.85 +		mv.visitIntInsn(opcode, operand);
   23.86 +		}
   23.87 +}
   23.88 +
   23.89 +public void visitVarInsn(final int opcode, final int var){
   23.90 +	if(var < 4 && opcode != Opcodes.RET)
   23.91 +		{
   23.92 +		minSize += 1;
   23.93 +		maxSize += 1;
   23.94 +		}
   23.95 +	else if(var >= 256)
   23.96 +		{
   23.97 +		minSize += 4;
   23.98 +		maxSize += 4;
   23.99 +		}
  23.100 +	else
  23.101 +		{
  23.102 +		minSize += 2;
  23.103 +		maxSize += 2;
  23.104 +		}
  23.105 +	if(mv != null)
  23.106 +		{
  23.107 +		mv.visitVarInsn(opcode, var);
  23.108 +		}
  23.109 +}
  23.110 +
  23.111 +public void visitTypeInsn(final int opcode, final String desc){
  23.112 +	minSize += 3;
  23.113 +	maxSize += 3;
  23.114 +	if(mv != null)
  23.115 +		{
  23.116 +		mv.visitTypeInsn(opcode, desc);
  23.117 +		}
  23.118 +}
  23.119 +
  23.120 +public void visitFieldInsn(
  23.121 +		final int opcode,
  23.122 +		final String owner,
  23.123 +		final String name,
  23.124 +		final String desc){
  23.125 +	minSize += 3;
  23.126 +	maxSize += 3;
  23.127 +	if(mv != null)
  23.128 +		{
  23.129 +		mv.visitFieldInsn(opcode, owner, name, desc);
  23.130 +		}
  23.131 +}
  23.132 +
  23.133 +public void visitMethodInsn(
  23.134 +		final int opcode,
  23.135 +		final String owner,
  23.136 +		final String name,
  23.137 +		final String desc){
  23.138 +	if(opcode == INVOKEINTERFACE)
  23.139 +		{
  23.140 +		minSize += 5;
  23.141 +		maxSize += 5;
  23.142 +		}
  23.143 +	else
  23.144 +		{
  23.145 +		minSize += 3;
  23.146 +		maxSize += 3;
  23.147 +		}
  23.148 +	if(mv != null)
  23.149 +		{
  23.150 +		mv.visitMethodInsn(opcode, owner, name, desc);
  23.151 +		}
  23.152 +}
  23.153 +
  23.154 +public void visitJumpInsn(final int opcode, final Label label){
  23.155 +	minSize += 3;
  23.156 +	if(opcode == GOTO || opcode == JSR)
  23.157 +		{
  23.158 +		maxSize += 5;
  23.159 +		}
  23.160 +	else
  23.161 +		{
  23.162 +		maxSize += 8;
  23.163 +		}
  23.164 +	if(mv != null)
  23.165 +		{
  23.166 +		mv.visitJumpInsn(opcode, label);
  23.167 +		}
  23.168 +}
  23.169 +
  23.170 +public void visitLdcInsn(final Object cst){
  23.171 +	if(cst instanceof Long || cst instanceof Double)
  23.172 +		{
  23.173 +		minSize += 3;
  23.174 +		maxSize += 3;
  23.175 +		}
  23.176 +	else
  23.177 +		{
  23.178 +		minSize += 2;
  23.179 +		maxSize += 3;
  23.180 +		}
  23.181 +	if(mv != null)
  23.182 +		{
  23.183 +		mv.visitLdcInsn(cst);
  23.184 +		}
  23.185 +}
  23.186 +
  23.187 +public void visitIincInsn(final int var, final int increment){
  23.188 +	if(var > 255 || increment > 127 || increment < -128)
  23.189 +		{
  23.190 +		minSize += 6;
  23.191 +		maxSize += 6;
  23.192 +		}
  23.193 +	else
  23.194 +		{
  23.195 +		minSize += 3;
  23.196 +		maxSize += 3;
  23.197 +		}
  23.198 +	if(mv != null)
  23.199 +		{
  23.200 +		mv.visitIincInsn(var, increment);
  23.201 +		}
  23.202 +}
  23.203 +
  23.204 +public void visitTableSwitchInsn(
  23.205 +		final int min,
  23.206 +		final int max,
  23.207 +		final Label dflt,
  23.208 +		final Label[] labels){
  23.209 +	minSize += 13 + labels.length * 4;
  23.210 +	maxSize += 16 + labels.length * 4;
  23.211 +	if(mv != null)
  23.212 +		{
  23.213 +		mv.visitTableSwitchInsn(min, max, dflt, labels);
  23.214 +		}
  23.215 +}
  23.216 +
  23.217 +public void visitLookupSwitchInsn(
  23.218 +		final Label dflt,
  23.219 +		final int[] keys,
  23.220 +		final Label[] labels){
  23.221 +	minSize += 9 + keys.length * 8;
  23.222 +	maxSize += 12 + keys.length * 8;
  23.223 +	if(mv != null)
  23.224 +		{
  23.225 +		mv.visitLookupSwitchInsn(dflt, keys, labels);
  23.226 +		}
  23.227 +}
  23.228 +
  23.229 +public void visitMultiANewArrayInsn(final String desc, final int dims){
  23.230 +	minSize += 4;
  23.231 +	maxSize += 4;
  23.232 +	if(mv != null)
  23.233 +		{
  23.234 +		mv.visitMultiANewArrayInsn(desc, dims);
  23.235 +		}
  23.236 +}
  23.237 +}
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/clojure/asm/commons/EmptyVisitor.java	Sat Aug 21 06:25:44 2010 -0400
    24.3 @@ -0,0 +1,221 @@
    24.4 +/***
    24.5 + * ASM: a very small and fast Java bytecode manipulation framework
    24.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    24.7 + * All rights reserved.
    24.8 + *
    24.9 + * Redistribution and use in source and binary forms, with or without
   24.10 + * modification, are permitted provided that the following conditions
   24.11 + * are met:
   24.12 + * 1. Redistributions of source code must retain the above copyright
   24.13 + *    notice, this list of conditions and the following disclaimer.
   24.14 + * 2. Redistributions in binary form must reproduce the above copyright
   24.15 + *    notice, this list of conditions and the following disclaimer in the
   24.16 + *    documentation and/or other materials provided with the distribution.
   24.17 + * 3. Neither the name of the copyright holders nor the names of its
   24.18 + *    contributors may be used to endorse or promote products derived from
   24.19 + *    this software without specific prior written permission.
   24.20 + *
   24.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   24.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   24.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   24.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   24.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   24.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   24.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   24.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   24.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   24.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   24.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   24.32 + */
   24.33 +package clojure.asm.commons;
   24.34 +
   24.35 +import clojure.asm.AnnotationVisitor;
   24.36 +import clojure.asm.Attribute;
   24.37 +import clojure.asm.ClassVisitor;
   24.38 +import clojure.asm.FieldVisitor;
   24.39 +import clojure.asm.Label;
   24.40 +import clojure.asm.MethodVisitor;
   24.41 +
   24.42 +/**
   24.43 + * An empty implementation of the ASM visitor interfaces.
   24.44 + *
   24.45 + * @author Eric Bruneton
   24.46 + */
   24.47 +public class EmptyVisitor implements
   24.48 +                          ClassVisitor,
   24.49 +                          FieldVisitor,
   24.50 +                          MethodVisitor,
   24.51 +                          AnnotationVisitor{
   24.52 +
   24.53 +public void visit(
   24.54 +		final int version,
   24.55 +		final int access,
   24.56 +		final String name,
   24.57 +		final String signature,
   24.58 +		final String superName,
   24.59 +		final String[] interfaces){
   24.60 +}
   24.61 +
   24.62 +public void visitSource(final String source, final String debug){
   24.63 +}
   24.64 +
   24.65 +public void visitOuterClass(
   24.66 +		final String owner,
   24.67 +		final String name,
   24.68 +		final String desc){
   24.69 +}
   24.70 +
   24.71 +public AnnotationVisitor visitAnnotation(
   24.72 +		final String desc,
   24.73 +		final boolean visible){
   24.74 +	return this;
   24.75 +}
   24.76 +
   24.77 +public void visitAttribute(final Attribute attr){
   24.78 +}
   24.79 +
   24.80 +public void visitInnerClass(
   24.81 +		final String name,
   24.82 +		final String outerName,
   24.83 +		final String innerName,
   24.84 +		final int access){
   24.85 +}
   24.86 +
   24.87 +public FieldVisitor visitField(
   24.88 +		final int access,
   24.89 +		final String name,
   24.90 +		final String desc,
   24.91 +		final String signature,
   24.92 +		final Object value){
   24.93 +	return this;
   24.94 +}
   24.95 +
   24.96 +public MethodVisitor visitMethod(
   24.97 +		final int access,
   24.98 +		final String name,
   24.99 +		final String desc,
  24.100 +		final String signature,
  24.101 +		final String[] exceptions){
  24.102 +	return this;
  24.103 +}
  24.104 +
  24.105 +public void visitEnd(){
  24.106 +}
  24.107 +
  24.108 +public AnnotationVisitor visitAnnotationDefault(){
  24.109 +	return this;
  24.110 +}
  24.111 +
  24.112 +public AnnotationVisitor visitParameterAnnotation(
  24.113 +		final int parameter,
  24.114 +		final String desc,
  24.115 +		final boolean visible){
  24.116 +	return this;
  24.117 +}
  24.118 +
  24.119 +public void visitCode(){
  24.120 +}
  24.121 +
  24.122 +public void visitFrame(
  24.123 +		final int type,
  24.124 +		final int nLocal,
  24.125 +		final Object[] local,
  24.126 +		final int nStack,
  24.127 +		final Object[] stack){
  24.128 +}
  24.129 +
  24.130 +public void visitInsn(final int opcode){
  24.131 +}
  24.132 +
  24.133 +public void visitIntInsn(final int opcode, final int operand){
  24.134 +}
  24.135 +
  24.136 +public void visitVarInsn(final int opcode, final int var){
  24.137 +}
  24.138 +
  24.139 +public void visitTypeInsn(final int opcode, final String desc){
  24.140 +}
  24.141 +
  24.142 +public void visitFieldInsn(
  24.143 +		final int opcode,
  24.144 +		final String owner,
  24.145 +		final String name,
  24.146 +		final String desc){
  24.147 +}
  24.148 +
  24.149 +public void visitMethodInsn(
  24.150 +		final int opcode,
  24.151 +		final String owner,
  24.152 +		final String name,
  24.153 +		final String desc){
  24.154 +}
  24.155 +
  24.156 +public void visitJumpInsn(final int opcode, final Label label){
  24.157 +}
  24.158 +
  24.159 +public void visitLabel(final Label label){
  24.160 +}
  24.161 +
  24.162 +public void visitLdcInsn(final Object cst){
  24.163 +}
  24.164 +
  24.165 +public void visitIincInsn(final int var, final int increment){
  24.166 +}
  24.167 +
  24.168 +public void visitTableSwitchInsn(
  24.169 +		final int min,
  24.170 +		final int max,
  24.171 +		final Label dflt,
  24.172 +		final Label labels[]){
  24.173 +}
  24.174 +
  24.175 +public void visitLookupSwitchInsn(
  24.176 +		final Label dflt,
  24.177 +		final int keys[],
  24.178 +		final Label labels[]){
  24.179 +}
  24.180 +
  24.181 +public void visitMultiANewArrayInsn(final String desc, final int dims){
  24.182 +}
  24.183 +
  24.184 +public void visitTryCatchBlock(
  24.185 +		final Label start,
  24.186 +		final Label end,
  24.187 +		final Label handler,
  24.188 +		final String type){
  24.189 +}
  24.190 +
  24.191 +public void visitLocalVariable(
  24.192 +		final String name,
  24.193 +		final String desc,
  24.194 +		final String signature,
  24.195 +		final Label start,
  24.196 +		final Label end,
  24.197 +		final int index){
  24.198 +}
  24.199 +
  24.200 +public void visitLineNumber(final int line, final Label start){
  24.201 +}
  24.202 +
  24.203 +public void visitMaxs(final int maxStack, final int maxLocals){
  24.204 +}
  24.205 +
  24.206 +public void visit(final String name, final Object value){
  24.207 +}
  24.208 +
  24.209 +public void visitEnum(
  24.210 +		final String name,
  24.211 +		final String desc,
  24.212 +		final String value){
  24.213 +}
  24.214 +
  24.215 +public AnnotationVisitor visitAnnotation(
  24.216 +		final String name,
  24.217 +		final String desc){
  24.218 +	return this;
  24.219 +}
  24.220 +
  24.221 +public AnnotationVisitor visitArray(final String name){
  24.222 +	return this;
  24.223 +}
  24.224 +}
    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/clojure/asm/commons/GeneratorAdapter.java	Sat Aug 21 06:25:44 2010 -0400
    25.3 @@ -0,0 +1,1533 @@
    25.4 +/***
    25.5 + * ASM: a very small and fast Java bytecode manipulation framework
    25.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    25.7 + * All rights reserved.
    25.8 + *
    25.9 + * Redistribution and use in source and binary forms, with or without
   25.10 + * modification, are permitted provided that the following conditions
   25.11 + * are met:
   25.12 + * 1. Redistributions of source code must retain the above copyright
   25.13 + *    notice, this list of conditions and the following disclaimer.
   25.14 + * 2. Redistributions in binary form must reproduce the above copyright
   25.15 + *    notice, this list of conditions and the following disclaimer in the
   25.16 + *    documentation and/or other materials provided with the distribution.
   25.17 + * 3. Neither the name of the copyright holders nor the names of its
   25.18 + *    contributors may be used to endorse or promote products derived from
   25.19 + *    this software without specific prior written permission.
   25.20 + *
   25.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   25.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   25.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   25.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   25.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   25.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   25.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   25.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   25.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   25.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   25.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   25.32 + */
   25.33 +package clojure.asm.commons;
   25.34 +
   25.35 +import java.util.ArrayList;
   25.36 +import java.util.Arrays;
   25.37 +import java.util.List;
   25.38 +
   25.39 +import clojure.asm.ClassVisitor;
   25.40 +import clojure.asm.Label;
   25.41 +import clojure.asm.MethodVisitor;
   25.42 +import clojure.asm.Opcodes;
   25.43 +import clojure.asm.Type;
   25.44 +
   25.45 +/**
   25.46 + * A {@link clojure.asm.MethodAdapter} with convenient methods to generate
   25.47 + * code. For example, using this adapter, the class below
   25.48 + * <p/>
   25.49 + * <pre>
   25.50 + * public class Example {
   25.51 + *     public static void main(String[] args) {
   25.52 + *         System.out.println(&quot;Hello world!&quot;);
   25.53 + *     }
   25.54 + * }
   25.55 + * </pre>
   25.56 + * <p/>
   25.57 + * can be generated as follows:
   25.58 + * <p/>
   25.59 + * <pre>
   25.60 + * ClassWriter cw = new ClassWriter(true);
   25.61 + * cw.visit(V1_1, ACC_PUBLIC, &quot;Example&quot;, null, &quot;java/lang/Object&quot;, null);
   25.62 + * <p/>
   25.63 + * Method m = Method.getMethod(&quot;void &lt;init&gt; ()&quot;);
   25.64 + * GeneratorAdapter mg = new GeneratorAdapter(ACC_PUBLIC, m, null, null, cw);
   25.65 + * mg.loadThis();
   25.66 + * mg.invokeConstructor(Type.getType(Object.class), m);
   25.67 + * mg.returnValue();
   25.68 + * mg.endMethod();
   25.69 + * <p/>
   25.70 + * m = Method.getMethod(&quot;void main (String[])&quot;);
   25.71 + * mg = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, m, null, null, cw);
   25.72 + * mg.getStatic(Type.getType(System.class), &quot;out&quot;, Type.getType(PrintStream.class));
   25.73 + * mg.push(&quot;Hello world!&quot;);
   25.74 + * mg.invokeVirtual(Type.getType(PrintStream.class), Method.getMethod(&quot;void println (String)&quot;));
   25.75 + * mg.returnValue();
   25.76 + * mg.endMethod();
   25.77 + * <p/>
   25.78 + * cw.visitEnd();
   25.79 + * </pre>
   25.80 + *
   25.81 + * @author Juozas Baliuka
   25.82 + * @author Chris Nokleberg
   25.83 + * @author Eric Bruneton
   25.84 + */
   25.85 +public class GeneratorAdapter extends LocalVariablesSorter{
   25.86 +
   25.87 +private final static Type BYTE_TYPE = Type.getObjectType("java/lang/Byte");
   25.88 +
   25.89 +private final static Type BOOLEAN_TYPE = Type.getObjectType("java/lang/Boolean");
   25.90 +
   25.91 +private final static Type SHORT_TYPE = Type.getObjectType("java/lang/Short");
   25.92 +
   25.93 +private final static Type CHARACTER_TYPE = Type.getObjectType("java/lang/Character");
   25.94 +
   25.95 +private final static Type INTEGER_TYPE = Type.getObjectType("java/lang/Integer");
   25.96 +
   25.97 +private final static Type FLOAT_TYPE = Type.getObjectType("java/lang/Float");
   25.98 +
   25.99 +private final static Type LONG_TYPE = Type.getObjectType("java/lang/Long");
  25.100 +
  25.101 +private final static Type DOUBLE_TYPE = Type.getObjectType("java/lang/Double");
  25.102 +
  25.103 +private final static Type NUMBER_TYPE = Type.getObjectType("java/lang/Number");
  25.104 +
  25.105 +private final static Type OBJECT_TYPE = Type.getObjectType("java/lang/Object");
  25.106 +
  25.107 +private final static Method BOOLEAN_VALUE = Method.getMethod("boolean booleanValue()");
  25.108 +
  25.109 +private final static Method CHAR_VALUE = Method.getMethod("char charValue()");
  25.110 +
  25.111 +private final static Method INT_VALUE = Method.getMethod("int intValue()");
  25.112 +
  25.113 +private final static Method FLOAT_VALUE = Method.getMethod("float floatValue()");
  25.114 +
  25.115 +private final static Method LONG_VALUE = Method.getMethod("long longValue()");
  25.116 +
  25.117 +private final static Method DOUBLE_VALUE = Method.getMethod("double doubleValue()");
  25.118 +
  25.119 +/**
  25.120 + * Constant for the {@link #math math} method.
  25.121 + */
  25.122 +public final static int ADD = Opcodes.IADD;
  25.123 +
  25.124 +/**
  25.125 + * Constant for the {@link #math math} method.
  25.126 + */
  25.127 +public final static int SUB = Opcodes.ISUB;
  25.128 +
  25.129 +/**
  25.130 + * Constant for the {@link #math math} method.
  25.131 + */
  25.132 +public final static int MUL = Opcodes.IMUL;
  25.133 +
  25.134 +/**
  25.135 + * Constant for the {@link #math math} method.
  25.136 + */
  25.137 +public final static int DIV = Opcodes.IDIV;
  25.138 +
  25.139 +/**
  25.140 + * Constant for the {@link #math math} method.
  25.141 + */
  25.142 +public final static int REM = Opcodes.IREM;
  25.143 +
  25.144 +/**
  25.145 + * Constant for the {@link #math math} method.
  25.146 + */
  25.147 +public final static int NEG = Opcodes.INEG;
  25.148 +
  25.149 +/**
  25.150 + * Constant for the {@link #math math} method.
  25.151 + */
  25.152 +public final static int SHL = Opcodes.ISHL;
  25.153 +
  25.154 +/**
  25.155 + * Constant for the {@link #math math} method.
  25.156 + */
  25.157 +public final static int SHR = Opcodes.ISHR;
  25.158 +
  25.159 +/**
  25.160 + * Constant for the {@link #math math} method.
  25.161 + */
  25.162 +public final static int USHR = Opcodes.IUSHR;
  25.163 +
  25.164 +/**
  25.165 + * Constant for the {@link #math math} method.
  25.166 + */
  25.167 +public final static int AND = Opcodes.IAND;
  25.168 +
  25.169 +/**
  25.170 + * Constant for the {@link #math math} method.
  25.171 + */
  25.172 +public final static int OR = Opcodes.IOR;
  25.173 +
  25.174 +/**
  25.175 + * Constant for the {@link #math math} method.
  25.176 + */
  25.177 +public final static int XOR = Opcodes.IXOR;
  25.178 +
  25.179 +/**
  25.180 + * Constant for the {@link #ifCmp ifCmp} method.
  25.181 + */
  25.182 +public final static int EQ = Opcodes.IFEQ;
  25.183 +
  25.184 +/**
  25.185 + * Constant for the {@link #ifCmp ifCmp} method.
  25.186 + */
  25.187 +public final static int NE = Opcodes.IFNE;
  25.188 +
  25.189 +/**
  25.190 + * Constant for the {@link #ifCmp ifCmp} method.
  25.191 + */
  25.192 +public final static int LT = Opcodes.IFLT;
  25.193 +
  25.194 +/**
  25.195 + * Constant for the {@link #ifCmp ifCmp} method.
  25.196 + */
  25.197 +public final static int GE = Opcodes.IFGE;
  25.198 +
  25.199 +/**
  25.200 + * Constant for the {@link #ifCmp ifCmp} method.
  25.201 + */
  25.202 +public final static int GT = Opcodes.IFGT;
  25.203 +
  25.204 +/**
  25.205 + * Constant for the {@link #ifCmp ifCmp} method.
  25.206 + */
  25.207 +public final static int LE = Opcodes.IFLE;
  25.208 +
  25.209 +/**
  25.210 + * Access flags of the method visited by this adapter.
  25.211 + */
  25.212 +private final int access;
  25.213 +
  25.214 +/**
  25.215 + * Return type of the method visited by this adapter.
  25.216 + */
  25.217 +private final Type returnType;
  25.218 +
  25.219 +/**
  25.220 + * Argument types of the method visited by this adapter.
  25.221 + */
  25.222 +private final Type[] argumentTypes;
  25.223 +
  25.224 +/**
  25.225 + * Types of the local variables of the method visited by this adapter.
  25.226 + */
  25.227 +private final List localTypes = new ArrayList();
  25.228 +
  25.229 +/**
  25.230 + * Creates a new {@link GeneratorAdapter}.
  25.231 + *
  25.232 + * @param mv     the method visitor to which this adapter delegates calls.
  25.233 + * @param access the method's access flags (see {@link Opcodes}).
  25.234 + * @param name   the method's name.
  25.235 + * @param desc   the method's descriptor (see {@link Type Type}).
  25.236 + */
  25.237 +public GeneratorAdapter(
  25.238 +		final MethodVisitor mv,
  25.239 +		final int access,
  25.240 +		final String name,
  25.241 +		final String desc){
  25.242 +	super(access, desc, mv);
  25.243 +	this.access = access;
  25.244 +	this.returnType = Type.getReturnType(desc);
  25.245 +	this.argumentTypes = Type.getArgumentTypes(desc);
  25.246 +}
  25.247 +
  25.248 +/**
  25.249 + * Creates a new {@link GeneratorAdapter}.
  25.250 + *
  25.251 + * @param access access flags of the adapted method.
  25.252 + * @param method the adapted method.
  25.253 + * @param mv     the method visitor to which this adapter delegates calls.
  25.254 + */
  25.255 +public GeneratorAdapter(
  25.256 +		final int access,
  25.257 +		final Method method,
  25.258 +		final MethodVisitor mv){
  25.259 +	super(access, method.getDescriptor(), mv);
  25.260 +	this.access = access;
  25.261 +	this.returnType = method.getReturnType();
  25.262 +	this.argumentTypes = method.getArgumentTypes();
  25.263 +}
  25.264 +
  25.265 +/**
  25.266 + * Creates a new {@link GeneratorAdapter}.
  25.267 + *
  25.268 + * @param access     access flags of the adapted method.
  25.269 + * @param method     the adapted method.
  25.270 + * @param signature  the signature of the adapted method (may be
  25.271 + *                   <tt>null</tt>).
  25.272 + * @param exceptions the exceptions thrown by the adapted method (may be
  25.273 + *                   <tt>null</tt>).
  25.274 + * @param cv         the class visitor to which this adapter delegates calls.
  25.275 + */
  25.276 +public GeneratorAdapter(
  25.277 +		final int access,
  25.278 +		final Method method,
  25.279 +		final String signature,
  25.280 +		final Type[] exceptions,
  25.281 +		final ClassVisitor cv){
  25.282 +	this(access, method, cv.visitMethod(access,
  25.283 +	                                    method.getName(),
  25.284 +	                                    method.getDescriptor(),
  25.285 +	                                    signature,
  25.286 +	                                    getInternalNames(exceptions)));
  25.287 +}
  25.288 +
  25.289 +/**
  25.290 + * Returns the internal names of the given types.
  25.291 + *
  25.292 + * @param types a set of types.
  25.293 + * @return the internal names of the given types.
  25.294 + */
  25.295 +private static String[] getInternalNames(final Type[] types){
  25.296 +	if(types == null)
  25.297 +		{
  25.298 +		return null;
  25.299 +		}
  25.300 +	String[] names = new String[types.length];
  25.301 +	for(int i = 0; i < names.length; ++i)
  25.302 +		{
  25.303 +		names[i] = types[i].getInternalName();
  25.304 +		}
  25.305 +	return names;
  25.306 +}
  25.307 +
  25.308 +// ------------------------------------------------------------------------
  25.309 +// Instructions to push constants on the stack
  25.310 +// ------------------------------------------------------------------------
  25.311 +
  25.312 +/**
  25.313 + * Generates the instruction to push the given value on the stack.
  25.314 + *
  25.315 + * @param value the value to be pushed on the stack.
  25.316 + */
  25.317 +public void push(final boolean value){
  25.318 +	push(value ? 1 : 0);
  25.319 +}
  25.320 +
  25.321 +/**
  25.322 + * Generates the instruction to push the given value on the stack.
  25.323 + *
  25.324 + * @param value the value to be pushed on the stack.
  25.325 + */
  25.326 +public void push(final int value){
  25.327 +	if(value >= -1 && value <= 5)
  25.328 +		{
  25.329 +		mv.visitInsn(Opcodes.ICONST_0 + value);
  25.330 +		}
  25.331 +	else if(value >= Byte.MIN_VALUE && value <= Byte.MAX_VALUE)
  25.332 +		{
  25.333 +		mv.visitIntInsn(Opcodes.BIPUSH, value);
  25.334 +		}
  25.335 +	else if(value >= Short.MIN_VALUE && value <= Short.MAX_VALUE)
  25.336 +		{
  25.337 +		mv.visitIntInsn(Opcodes.SIPUSH, value);
  25.338 +		}
  25.339 +	else
  25.340 +		{
  25.341 +		mv.visitLdcInsn(new Integer(value));
  25.342 +		}
  25.343 +}
  25.344 +
  25.345 +/**
  25.346 + * Generates the instruction to push the given value on the stack.
  25.347 + *
  25.348 + * @param value the value to be pushed on the stack.
  25.349 + */
  25.350 +public void push(final long value){
  25.351 +	if(value == 0L || value == 1L)
  25.352 +		{
  25.353 +		mv.visitInsn(Opcodes.LCONST_0 + (int) value);
  25.354 +		}
  25.355 +	else
  25.356 +		{
  25.357 +		mv.visitLdcInsn(new Long(value));
  25.358 +		}
  25.359 +}
  25.360 +
  25.361 +/**
  25.362 + * Generates the instruction to push the given value on the stack.
  25.363 + *
  25.364 + * @param value the value to be pushed on the stack.
  25.365 + */
  25.366 +public void push(final float value){
  25.367 +	int bits = Float.floatToIntBits(value);
  25.368 +	if(bits == 0L || bits == 0x3f800000 || bits == 0x40000000)
  25.369 +		{ // 0..2
  25.370 +		mv.visitInsn(Opcodes.FCONST_0 + (int) value);
  25.371 +		}
  25.372 +	else
  25.373 +		{
  25.374 +		mv.visitLdcInsn(new Float(value));
  25.375 +		}
  25.376 +}
  25.377 +
  25.378 +/**
  25.379 + * Generates the instruction to push the given value on the stack.
  25.380 + *
  25.381 + * @param value the value to be pushed on the stack.
  25.382 + */
  25.383 +public void push(final double value){
  25.384 +	long bits = Double.doubleToLongBits(value);
  25.385 +	if(bits == 0L || bits == 0x3ff0000000000000L)
  25.386 +		{ // +0.0d and 1.0d
  25.387 +		mv.visitInsn(Opcodes.DCONST_0 + (int) value);
  25.388 +		}
  25.389 +	else
  25.390 +		{
  25.391 +		mv.visitLdcInsn(new Double(value));
  25.392 +		}
  25.393 +}
  25.394 +
  25.395 +/**
  25.396 + * Generates the instruction to push the given value on the stack.
  25.397 + *
  25.398 + * @param value the value to be pushed on the stack. May be <tt>null</tt>.
  25.399 + */
  25.400 +public void push(final String value){
  25.401 +	if(value == null)
  25.402 +		{
  25.403 +		mv.visitInsn(Opcodes.ACONST_NULL);
  25.404 +		}
  25.405 +	else
  25.406 +		{
  25.407 +		mv.visitLdcInsn(value);
  25.408 +		}
  25.409 +}
  25.410 +
  25.411 +/**
  25.412 + * Generates the instruction to push the given value on the stack.
  25.413 + *
  25.414 + * @param value the value to be pushed on the stack.
  25.415 + */
  25.416 +public void push(final Type value){
  25.417 +	if(value == null)
  25.418 +		{
  25.419 +		mv.visitInsn(Opcodes.ACONST_NULL);
  25.420 +		}
  25.421 +	else
  25.422 +		{
  25.423 +		mv.visitLdcInsn(value);
  25.424 +		}
  25.425 +}
  25.426 +
  25.427 +// ------------------------------------------------------------------------
  25.428 +// Instructions to load and store method arguments
  25.429 +// ------------------------------------------------------------------------
  25.430 +
  25.431 +/**
  25.432 + * Returns the index of the given method argument in the frame's local
  25.433 + * variables array.
  25.434 + *
  25.435 + * @param arg the index of a method argument.
  25.436 + * @return the index of the given method argument in the frame's local
  25.437 + *         variables array.
  25.438 + */
  25.439 +private int getArgIndex(final int arg){
  25.440 +	int index = (access & Opcodes.ACC_STATIC) == 0 ? 1 : 0;
  25.441 +	for(int i = 0; i < arg; i++)
  25.442 +		{
  25.443 +		index += argumentTypes[i].getSize();
  25.444 +		}
  25.445 +	return index;
  25.446 +}
  25.447 +
  25.448 +/**
  25.449 + * Generates the instruction to push a local variable on the stack.
  25.450 + *
  25.451 + * @param type  the type of the local variable to be loaded.
  25.452 + * @param index an index in the frame's local variables array.
  25.453 + */
  25.454 +private void loadInsn(final Type type, final int index){
  25.455 +	mv.visitVarInsn(type.getOpcode(Opcodes.ILOAD), index);
  25.456 +}
  25.457 +
  25.458 +/**
  25.459 + * Generates the instruction to store the top stack value in a local
  25.460 + * variable.
  25.461 + *
  25.462 + * @param type  the type of the local variable to be stored.
  25.463 + * @param index an index in the frame's local variables array.
  25.464 + */
  25.465 +private void storeInsn(final Type type, final int index){
  25.466 +	mv.visitVarInsn(type.getOpcode(Opcodes.ISTORE), index);
  25.467 +}
  25.468 +
  25.469 +/**
  25.470 + * Generates the instruction to load 'this' on the stack.
  25.471 + */
  25.472 +public void loadThis(){
  25.473 +	if((access & Opcodes.ACC_STATIC) != 0)
  25.474 +		{
  25.475 +		throw new IllegalStateException("no 'this' pointer within static method");
  25.476 +		}
  25.477 +	mv.visitVarInsn(Opcodes.ALOAD, 0);
  25.478 +}
  25.479 +
  25.480 +/**
  25.481 + * Generates the instruction to load the given method argument on the stack.
  25.482 + *
  25.483 + * @param arg the index of a method argument.
  25.484 + */
  25.485 +public void loadArg(final int arg){
  25.486 +	loadInsn(argumentTypes[arg], getArgIndex(arg));
  25.487 +}
  25.488 +
  25.489 +/**
  25.490 + * Generates the instructions to load the given method arguments on the
  25.491 + * stack.
  25.492 + *
  25.493 + * @param arg   the index of the first method argument to be loaded.
  25.494 + * @param count the number of method arguments to be loaded.
  25.495 + */
  25.496 +public void loadArgs(final int arg, final int count){
  25.497 +	int index = getArgIndex(arg);
  25.498 +	for(int i = 0; i < count; ++i)
  25.499 +		{
  25.500 +		Type t = argumentTypes[arg + i];
  25.501 +		loadInsn(t, index);
  25.502 +		index += t.getSize();
  25.503 +		}
  25.504 +}
  25.505 +
  25.506 +/**
  25.507 + * Generates the instructions to load all the method arguments on the stack.
  25.508 + */
  25.509 +public void loadArgs(){
  25.510 +	loadArgs(0, argumentTypes.length);
  25.511 +}
  25.512 +
  25.513 +/**
  25.514 + * Generates the instructions to load all the method arguments on the stack,
  25.515 + * as a single object array.
  25.516 + */
  25.517 +public void loadArgArray(){
  25.518 +	push(argumentTypes.length);
  25.519 +	newArray(OBJECT_TYPE);
  25.520 +	for(int i = 0; i < argumentTypes.length; i++)
  25.521 +		{
  25.522 +		dup();
  25.523 +		push(i);
  25.524 +		loadArg(i);
  25.525 +		box(argumentTypes[i]);
  25.526 +		arrayStore(OBJECT_TYPE);
  25.527 +		}
  25.528 +}
  25.529 +
  25.530 +/**
  25.531 + * Generates the instruction to store the top stack value in the given
  25.532 + * method argument.
  25.533 + *
  25.534 + * @param arg the index of a method argument.
  25.535 + */
  25.536 +public void storeArg(final int arg){
  25.537 +	storeInsn(argumentTypes[arg], getArgIndex(arg));
  25.538 +}
  25.539 +
  25.540 +// ------------------------------------------------------------------------
  25.541 +// Instructions to load and store local variables
  25.542 +// ------------------------------------------------------------------------
  25.543 +
  25.544 +/**
  25.545 + * Returns the type of the given local variable.
  25.546 + *
  25.547 + * @param local a local variable identifier, as returned by
  25.548 + *              {@link LocalVariablesSorter#newLocal(Type) newLocal()}.
  25.549 + * @return the type of the given local variable.
  25.550 + */
  25.551 +public Type getLocalType(final int local){
  25.552 +	return (Type) localTypes.get(local - firstLocal);
  25.553 +}
  25.554 +
  25.555 +protected void setLocalType(final int local, final Type type){
  25.556 +	int index = local - firstLocal;
  25.557 +	while(localTypes.size() < index + 1)
  25.558 +		{
  25.559 +		localTypes.add(null);
  25.560 +		}
  25.561 +	localTypes.set(index, type);
  25.562 +}
  25.563 +
  25.564 +/**
  25.565 + * Generates the instruction to load the given local variable on the stack.
  25.566 + *
  25.567 + * @param local a local variable identifier, as returned by
  25.568 + *              {@link LocalVariablesSorter#newLocal(Type) newLocal()}.
  25.569 + */
  25.570 +public void loadLocal(final int local){
  25.571 +	loadInsn(getLocalType(local), local);
  25.572 +}
  25.573 +
  25.574 +/**
  25.575 + * Generates the instruction to load the given local variable on the stack.
  25.576 + *
  25.577 + * @param local a local variable identifier, as returned by
  25.578 + *              {@link LocalVariablesSorter#newLocal(Type) newLocal()}.
  25.579 + * @param type  the type of this local variable.
  25.580 + */
  25.581 +public void loadLocal(final int local, final Type type){
  25.582 +	setLocalType(local, type);
  25.583 +	loadInsn(type, local);
  25.584 +}
  25.585 +
  25.586 +/**
  25.587 + * Generates the instruction to store the top stack value in the given local
  25.588 + * variable.
  25.589 + *
  25.590 + * @param local a local variable identifier, as returned by
  25.591 + *              {@link LocalVariablesSorter#newLocal(Type) newLocal()}.
  25.592 + */
  25.593 +public void storeLocal(final int local){
  25.594 +	storeInsn(getLocalType(local), local);
  25.595 +}
  25.596 +
  25.597 +/**
  25.598 + * Generates the instruction to store the top stack value in the given local
  25.599 + * variable.
  25.600 + *
  25.601 + * @param local a local variable identifier, as returned by
  25.602 + *              {@link LocalVariablesSorter#newLocal(Type) newLocal()}.
  25.603 + * @param type  the type of this local variable.
  25.604 + */
  25.605 +public void storeLocal(final int local, final Type type){
  25.606 +	setLocalType(local, type);
  25.607 +	storeInsn(type, local);
  25.608 +}
  25.609 +
  25.610 +/**
  25.611 + * Generates the instruction to load an element from an array.
  25.612 + *
  25.613 + * @param type the type of the array element to be loaded.
  25.614 + */
  25.615 +public void arrayLoad(final Type type){
  25.616 +	mv.visitInsn(type.getOpcode(Opcodes.IALOAD));
  25.617 +}
  25.618 +
  25.619 +/**
  25.620 + * Generates the instruction to store an element in an array.
  25.621 + *
  25.622 + * @param type the type of the array element to be stored.
  25.623 + */
  25.624 +public void arrayStore(final Type type){
  25.625 +	mv.visitInsn(type.getOpcode(Opcodes.IASTORE));
  25.626 +}
  25.627 +
  25.628 +// ------------------------------------------------------------------------
  25.629 +// Instructions to manage the stack
  25.630 +// ------------------------------------------------------------------------
  25.631 +
  25.632 +/**
  25.633 + * Generates a POP instruction.
  25.634 + */
  25.635 +public void pop(){
  25.636 +	mv.visitInsn(Opcodes.POP);
  25.637 +}
  25.638 +
  25.639 +/**
  25.640 + * Generates a POP2 instruction.
  25.641 + */
  25.642 +public void pop2(){
  25.643 +	mv.visitInsn(Opcodes.POP2);
  25.644 +}
  25.645 +
  25.646 +/**
  25.647 + * Generates a DUP instruction.
  25.648 + */
  25.649 +public void dup(){
  25.650 +	mv.visitInsn(Opcodes.DUP);
  25.651 +}
  25.652 +
  25.653 +/**
  25.654 + * Generates a DUP2 instruction.
  25.655 + */
  25.656 +public void dup2(){
  25.657 +	mv.visitInsn(Opcodes.DUP2);
  25.658 +}
  25.659 +
  25.660 +/**
  25.661 + * Generates a DUP_X1 instruction.
  25.662 + */
  25.663 +public void dupX1(){
  25.664 +	mv.visitInsn(Opcodes.DUP_X1);
  25.665 +}
  25.666 +
  25.667 +/**
  25.668 + * Generates a DUP_X2 instruction.
  25.669 + */
  25.670 +public void dupX2(){
  25.671 +	mv.visitInsn(Opcodes.DUP_X2);
  25.672 +}
  25.673 +
  25.674 +/**
  25.675 + * Generates a DUP2_X1 instruction.
  25.676 + */
  25.677 +public void dup2X1(){
  25.678 +	mv.visitInsn(Opcodes.DUP2_X1);
  25.679 +}
  25.680 +
  25.681 +/**
  25.682 + * Generates a DUP2_X2 instruction.
  25.683 + */
  25.684 +public void dup2X2(){
  25.685 +	mv.visitInsn(Opcodes.DUP2_X2);
  25.686 +}
  25.687 +
  25.688 +/**
  25.689 + * Generates a SWAP instruction.
  25.690 + */
  25.691 +public void swap(){
  25.692 +	mv.visitInsn(Opcodes.SWAP);
  25.693 +}
  25.694 +
  25.695 +/**
  25.696 + * Generates the instructions to swap the top two stack values.
  25.697 + *
  25.698 + * @param prev type of the top - 1 stack value.
  25.699 + * @param type type of the top stack value.
  25.700 + */
  25.701 +public void swap(final Type prev, final Type type){
  25.702 +	if(type.getSize() == 1)
  25.703 +		{
  25.704 +		if(prev.getSize() == 1)
  25.705 +			{
  25.706 +			swap(); // same as dupX1(), pop();
  25.707 +			}
  25.708 +		else
  25.709 +			{
  25.710 +			dupX2();
  25.711 +			pop();
  25.712 +			}
  25.713 +		}
  25.714 +	else
  25.715 +		{
  25.716 +		if(prev.getSize() == 1)
  25.717 +			{
  25.718 +			dup2X1();
  25.719 +			pop2();
  25.720 +			}
  25.721 +		else
  25.722 +			{
  25.723 +			dup2X2();
  25.724 +			pop2();
  25.725 +			}
  25.726 +		}
  25.727 +}
  25.728 +
  25.729 +// ------------------------------------------------------------------------
  25.730 +// Instructions to do mathematical and logical operations
  25.731 +// ------------------------------------------------------------------------
  25.732 +
  25.733 +/**
  25.734 + * Generates the instruction to do the specified mathematical or logical
  25.735 + * operation.
  25.736 + *
  25.737 + * @param op   a mathematical or logical operation. Must be one of ADD, SUB,
  25.738 + *             MUL, DIV, REM, NEG, SHL, SHR, USHR, AND, OR, XOR.
  25.739 + * @param type the type of the operand(s) for this operation.
  25.740 + */
  25.741 +public void math(final int op, final Type type){
  25.742 +	mv.visitInsn(type.getOpcode(op));
  25.743 +}
  25.744 +
  25.745 +/**
  25.746 + * Generates the instructions to compute the bitwise negation of the top
  25.747 + * stack value.
  25.748 + */
  25.749 +public void not(){
  25.750 +	mv.visitInsn(Opcodes.ICONST_1);
  25.751 +	mv.visitInsn(Opcodes.IXOR);
  25.752 +}
  25.753 +
  25.754 +/**
  25.755 + * Generates the instruction to increment the given local variable.
  25.756 + *
  25.757 + * @param local  the local variable to be incremented.
  25.758 + * @param amount the amount by which the local variable must be incremented.
  25.759 + */
  25.760 +public void iinc(final int local, final int amount){
  25.761 +	mv.visitIincInsn(local, amount);
  25.762 +}
  25.763 +
  25.764 +/**
  25.765 + * Generates the instructions to cast a numerical value from one type to
  25.766 + * another.
  25.767 + *
  25.768 + * @param from the type of the top stack value
  25.769 + * @param to   the type into which this value must be cast.
  25.770 + */
  25.771 +public void cast(final Type from, final Type to){
  25.772 +	if(from != to)
  25.773 +		{
  25.774 +		if(from == Type.DOUBLE_TYPE)
  25.775 +			{
  25.776 +			if(to == Type.FLOAT_TYPE)
  25.777 +				{
  25.778 +				mv.visitInsn(Opcodes.D2F);
  25.779 +				}
  25.780 +			else if(to == Type.LONG_TYPE)
  25.781 +				{
  25.782 +				mv.visitInsn(Opcodes.D2L);
  25.783 +				}
  25.784 +			else
  25.785 +				{
  25.786 +				mv.visitInsn(Opcodes.D2I);
  25.787 +				cast(Type.INT_TYPE, to);
  25.788 +				}
  25.789 +			}
  25.790 +		else if(from == Type.FLOAT_TYPE)
  25.791 +			{
  25.792 +			if(to == Type.DOUBLE_TYPE)
  25.793 +				{
  25.794 +				mv.visitInsn(Opcodes.F2D);
  25.795 +				}
  25.796 +			else if(to == Type.LONG_TYPE)
  25.797 +				{
  25.798 +				mv.visitInsn(Opcodes.F2L);
  25.799 +				}
  25.800 +			else
  25.801 +				{
  25.802 +				mv.visitInsn(Opcodes.F2I);
  25.803 +				cast(Type.INT_TYPE, to);
  25.804 +				}
  25.805 +			}
  25.806 +		else if(from == Type.LONG_TYPE)
  25.807 +			{
  25.808 +			if(to == Type.DOUBLE_TYPE)
  25.809 +				{
  25.810 +				mv.visitInsn(Opcodes.L2D);
  25.811 +				}
  25.812 +			else if(to == Type.FLOAT_TYPE)
  25.813 +				{
  25.814 +				mv.visitInsn(Opcodes.L2F);
  25.815 +				}
  25.816 +			else
  25.817 +				{
  25.818 +				mv.visitInsn(Opcodes.L2I);
  25.819 +				cast(Type.INT_TYPE, to);
  25.820 +				}
  25.821 +			}
  25.822 +		else
  25.823 +			{
  25.824 +			if(to == Type.BYTE_TYPE)
  25.825 +				{
  25.826 +				mv.visitInsn(Opcodes.I2B);
  25.827 +				}
  25.828 +			else if(to == Type.CHAR_TYPE)
  25.829 +				{
  25.830 +				mv.visitInsn(Opcodes.I2C);
  25.831 +				}
  25.832 +			else if(to == Type.DOUBLE_TYPE)
  25.833 +				{
  25.834 +				mv.visitInsn(Opcodes.I2D);
  25.835 +				}
  25.836 +			else if(to == Type.FLOAT_TYPE)
  25.837 +				{
  25.838 +				mv.visitInsn(Opcodes.I2F);
  25.839 +				}
  25.840 +			else if(to == Type.LONG_TYPE)
  25.841 +				{
  25.842 +				mv.visitInsn(Opcodes.I2L);
  25.843 +				}
  25.844 +			else if(to == Type.SHORT_TYPE)
  25.845 +				{
  25.846 +				mv.visitInsn(Opcodes.I2S);
  25.847 +				}
  25.848 +			}
  25.849 +		}
  25.850 +}
  25.851 +
  25.852 +// ------------------------------------------------------------------------
  25.853 +// Instructions to do boxing and unboxing operations
  25.854 +// ------------------------------------------------------------------------
  25.855 +
  25.856 +/**
  25.857 + * Generates the instructions to box the top stack value. This value is
  25.858 + * replaced by its boxed equivalent on top of the stack.
  25.859 + *
  25.860 + * @param type the type of the top stack value.
  25.861 + */
  25.862 +public void box(final Type type){
  25.863 +	if(type.getSort() == Type.OBJECT || type.getSort() == Type.ARRAY)
  25.864 +		{
  25.865 +		return;
  25.866 +		}
  25.867 +	if(type == Type.VOID_TYPE)
  25.868 +		{
  25.869 +		push((String) null);
  25.870 +		}
  25.871 +	else
  25.872 +		{
  25.873 +		Type boxed = type;
  25.874 +		switch(type.getSort())
  25.875 +			{
  25.876 +			case Type.BYTE:
  25.877 +				boxed = BYTE_TYPE;
  25.878 +				break;
  25.879 +			case Type.BOOLEAN:
  25.880 +				boxed = BOOLEAN_TYPE;
  25.881 +				break;
  25.882 +			case Type.SHORT:
  25.883 +				boxed = SHORT_TYPE;
  25.884 +				break;
  25.885 +			case Type.CHAR:
  25.886 +				boxed = CHARACTER_TYPE;
  25.887 +				break;
  25.888 +			case Type.INT:
  25.889 +				boxed = INTEGER_TYPE;
  25.890 +				break;
  25.891 +			case Type.FLOAT:
  25.892 +				boxed = FLOAT_TYPE;
  25.893 +				break;
  25.894 +			case Type.LONG:
  25.895 +				boxed = LONG_TYPE;
  25.896 +				break;
  25.897 +			case Type.DOUBLE:
  25.898 +				boxed = DOUBLE_TYPE;
  25.899 +				break;
  25.900 +			}
  25.901 +		newInstance(boxed);
  25.902 +		if(type.getSize() == 2)
  25.903 +			{
  25.904 +			// Pp -> Ppo -> oPpo -> ooPpo -> ooPp -> o
  25.905 +			dupX2();
  25.906 +			dupX2();
  25.907 +			pop();
  25.908 +			}
  25.909 +		else
  25.910 +			{
  25.911 +			// p -> po -> opo -> oop -> o
  25.912 +			dupX1();
  25.913 +			swap();
  25.914 +			}
  25.915 +		invokeConstructor(boxed, new Method("<init>",
  25.916 +		                                    Type.VOID_TYPE,
  25.917 +		                                    new Type[]{type}));
  25.918 +		}
  25.919 +}
  25.920 +
  25.921 +/**
  25.922 + * Generates the instructions to unbox the top stack value. This value is
  25.923 + * replaced by its unboxed equivalent on top of the stack.
  25.924 + *
  25.925 + * @param type the type of the top stack value.
  25.926 + */
  25.927 +public void unbox(final Type type){
  25.928 +	Type t = NUMBER_TYPE;
  25.929 +	Method sig = null;
  25.930 +	switch(type.getSort())
  25.931 +		{
  25.932 +		case Type.VOID:
  25.933 +			return;
  25.934 +		case Type.CHAR:
  25.935 +			t = CHARACTER_TYPE;
  25.936 +			sig = CHAR_VALUE;
  25.937 +			break;
  25.938 +		case Type.BOOLEAN:
  25.939 +			t = BOOLEAN_TYPE;
  25.940 +			sig = BOOLEAN_VALUE;
  25.941 +			break;
  25.942 +		case Type.DOUBLE:
  25.943 +			sig = DOUBLE_VALUE;
  25.944 +			break;
  25.945 +		case Type.FLOAT:
  25.946 +			sig = FLOAT_VALUE;
  25.947 +			break;
  25.948 +		case Type.LONG:
  25.949 +			sig = LONG_VALUE;
  25.950 +			break;
  25.951 +		case Type.INT:
  25.952 +		case Type.SHORT:
  25.953 +		case Type.BYTE:
  25.954 +			sig = INT_VALUE;
  25.955 +		}
  25.956 +	if(sig == null)
  25.957 +		{
  25.958 +		checkCast(type);
  25.959 +		}
  25.960 +	else
  25.961 +		{
  25.962 +		checkCast(t);
  25.963 +		invokeVirtual(t, sig);
  25.964 +		}
  25.965 +}
  25.966 +
  25.967 +// ------------------------------------------------------------------------
  25.968 +// Instructions to jump to other instructions
  25.969 +// ------------------------------------------------------------------------
  25.970 +
  25.971 +/**
  25.972 + * Creates a new {@link Label}.
  25.973 + *
  25.974 + * @return a new {@link Label}.
  25.975 + */
  25.976 +public Label newLabel(){
  25.977 +	return new Label();
  25.978 +}
  25.979 +
  25.980 +/**
  25.981 + * Marks the current code position with the given label.
  25.982 + *
  25.983 + * @param label a label.
  25.984 + */
  25.985 +public void mark(final Label label){
  25.986 +	mv.visitLabel(label);
  25.987 +}
  25.988 +
  25.989 +/**
  25.990 + * Marks the current code position with a new label.
  25.991 + *
  25.992 + * @return the label that was created to mark the current code position.
  25.993 + */
  25.994 +public Label mark(){
  25.995 +	Label label = new Label();
  25.996 +	mv.visitLabel(label);
  25.997 +	return label;
  25.998 +}
  25.999 +
 25.1000 +/**
 25.1001 + * Generates the instructions to jump to a label based on the comparison of
 25.1002 + * the top two stack values.
 25.1003 + *
 25.1004 + * @param type  the type of the top two stack values.
 25.1005 + * @param mode  how these values must be compared. One of EQ, NE, LT, GE, GT,
 25.1006 + *              LE.
 25.1007 + * @param label where to jump if the comparison result is <tt>true</tt>.
 25.1008 + */
 25.1009 +public void ifCmp(final Type type, final int mode, final Label label){
 25.1010 +	int intOp = -1;
 25.1011 +	switch(type.getSort())
 25.1012 +		{
 25.1013 +		case Type.LONG:
 25.1014 +			mv.visitInsn(Opcodes.LCMP);
 25.1015 +			break;
 25.1016 +		case Type.DOUBLE:
 25.1017 +			mv.visitInsn(Opcodes.DCMPG);
 25.1018 +			break;
 25.1019 +		case Type.FLOAT:
 25.1020 +			mv.visitInsn(Opcodes.FCMPG);
 25.1021 +			break;
 25.1022 +		case Type.ARRAY:
 25.1023 +		case Type.OBJECT:
 25.1024 +			switch(mode)
 25.1025 +				{
 25.1026 +				case EQ:
 25.1027 +					mv.visitJumpInsn(Opcodes.IF_ACMPEQ, label);
 25.1028 +					return;
 25.1029 +				case NE:
 25.1030 +					mv.visitJumpInsn(Opcodes.IF_ACMPNE, label);
 25.1031 +					return;
 25.1032 +				}
 25.1033 +			throw new IllegalArgumentException("Bad comparison for type "
 25.1034 +			                                   + type);
 25.1035 +		default:
 25.1036 +			switch(mode)
 25.1037 +				{
 25.1038 +				case EQ:
 25.1039 +					intOp = Opcodes.IF_ICMPEQ;
 25.1040 +					break;
 25.1041 +				case NE:
 25.1042 +					intOp = Opcodes.IF_ICMPNE;
 25.1043 +					break;
 25.1044 +				case GE:
 25.1045 +					intOp = Opcodes.IF_ICMPGE;
 25.1046 +					break;
 25.1047 +				case LT:
 25.1048 +					intOp = Opcodes.IF_ICMPLT;
 25.1049 +					break;
 25.1050 +				case LE:
 25.1051 +					intOp = Opcodes.IF_ICMPLE;
 25.1052 +					break;
 25.1053 +				case GT:
 25.1054 +					intOp = Opcodes.IF_ICMPGT;
 25.1055 +					break;
 25.1056 +				}
 25.1057 +			mv.visitJumpInsn(intOp, label);
 25.1058 +			return;
 25.1059 +		}
 25.1060 +	int jumpMode = mode;
 25.1061 +	switch(mode)
 25.1062 +		{
 25.1063 +		case GE:
 25.1064 +			jumpMode = LT;
 25.1065 +			break;
 25.1066 +		case LE:
 25.1067 +			jumpMode = GT;
 25.1068 +			break;
 25.1069 +		}
 25.1070 +	mv.visitJumpInsn(jumpMode, label);
 25.1071 +}
 25.1072 +
 25.1073 +/**
 25.1074 + * Generates the instructions to jump to a label based on the comparison of
 25.1075 + * the top two integer stack values.
 25.1076 + *
 25.1077 + * @param mode  how these values must be compared. One of EQ, NE, LT, GE, GT,
 25.1078 + *              LE.
 25.1079 + * @param label where to jump if the comparison result is <tt>true</tt>.
 25.1080 + */
 25.1081 +public void ifICmp(final int mode, final Label label){
 25.1082 +	ifCmp(Type.INT_TYPE, mode, label);
 25.1083 +}
 25.1084 +
 25.1085 +/**
 25.1086 + * Generates the instructions to jump to a label based on the comparison of
 25.1087 + * the top integer stack value with zero.
 25.1088 + *
 25.1089 + * @param mode  how these values must be compared. One of EQ, NE, LT, GE, GT,
 25.1090 + *              LE.
 25.1091 + * @param label where to jump if the comparison result is <tt>true</tt>.
 25.1092 + */
 25.1093 +public void ifZCmp(final int mode, final Label label){
 25.1094 +	mv.visitJumpInsn(mode, label);
 25.1095 +}
 25.1096 +
 25.1097 +/**
 25.1098 + * Generates the instruction to jump to the given label if the top stack
 25.1099 + * value is null.
 25.1100 + *
 25.1101 + * @param label where to jump if the condition is <tt>true</tt>.
 25.1102 + */
 25.1103 +public void ifNull(final Label label){
 25.1104 +	mv.visitJumpInsn(Opcodes.IFNULL, label);
 25.1105 +}
 25.1106 +
 25.1107 +/**
 25.1108 + * Generates the instruction to jump to the given label if the top stack
 25.1109 + * value is not null.
 25.1110 + *
 25.1111 + * @param label where to jump if the condition is <tt>true</tt>.
 25.1112 + */
 25.1113 +public void ifNonNull(final Label label){
 25.1114 +	mv.visitJumpInsn(Opcodes.IFNONNULL, label);
 25.1115 +}
 25.1116 +
 25.1117 +/**
 25.1118 + * Generates the instruction to jump to the given label.
 25.1119 + *
 25.1120 + * @param label where to jump if the condition is <tt>true</tt>.
 25.1121 + */
 25.1122 +public void goTo(final Label label){
 25.1123 +	mv.visitJumpInsn(Opcodes.GOTO, label);
 25.1124 +}
 25.1125 +
 25.1126 +/**
 25.1127 + * Generates a RET instruction.
 25.1128 + *
 25.1129 + * @param local a local variable identifier, as returned by
 25.1130 + *              {@link LocalVariablesSorter#newLocal(Type) newLocal()}.
 25.1131 + */
 25.1132 +public void ret(final int local){
 25.1133 +	mv.visitVarInsn(Opcodes.RET, local);
 25.1134 +}
 25.1135 +
 25.1136 +/**
 25.1137 + * Generates the instructions for a switch statement.
 25.1138 + *
 25.1139 + * @param keys      the switch case keys.
 25.1140 + * @param generator a generator to generate the code for the switch cases.
 25.1141 + */
 25.1142 +public void tableSwitch(
 25.1143 +		final int[] keys,
 25.1144 +		final TableSwitchGenerator generator){
 25.1145 +	float density;
 25.1146 +	if(keys.length == 0)
 25.1147 +		{
 25.1148 +		density = 0;
 25.1149 +		}
 25.1150 +	else
 25.1151 +		{
 25.1152 +		density = (float) keys.length
 25.1153 +		          / (keys[keys.length - 1] - keys[0] + 1);
 25.1154 +		}
 25.1155 +	tableSwitch(keys, generator, density >= 0.5f);
 25.1156 +}
 25.1157 +
 25.1158 +/**
 25.1159 + * Generates the instructions for a switch statement.
 25.1160 + *
 25.1161 + * @param keys      the switch case keys.
 25.1162 + * @param generator a generator to generate the code for the switch cases.
 25.1163 + * @param useTable  <tt>true</tt> to use a TABLESWITCH instruction, or
 25.1164 + *                  <tt>false</tt> to use a LOOKUPSWITCH instruction.
 25.1165 + */
 25.1166 +public void tableSwitch(
 25.1167 +		final int[] keys,
 25.1168 +		final TableSwitchGenerator generator,
 25.1169 +		final boolean useTable){
 25.1170 +	for(int i = 1; i < keys.length; ++i)
 25.1171 +		{
 25.1172 +		if(keys[i] < keys[i - 1])
 25.1173 +			{
 25.1174 +			throw new IllegalArgumentException("keys must be sorted ascending");
 25.1175 +			}
 25.1176 +		}
 25.1177 +	Label def = newLabel();
 25.1178 +	Label end = newLabel();
 25.1179 +	if(keys.length > 0)
 25.1180 +		{
 25.1181 +		int len = keys.length;
 25.1182 +		int min = keys[0];
 25.1183 +		int max = keys[len - 1];
 25.1184 +		int range = max - min + 1;
 25.1185 +		if(useTable)
 25.1186 +			{
 25.1187 +			Label[] labels = new Label[range];
 25.1188 +			Arrays.fill(labels, def);
 25.1189 +			for(int i = 0; i < len; ++i)
 25.1190 +				{
 25.1191 +				labels[keys[i] - min] = newLabel();
 25.1192 +				}
 25.1193 +			mv.visitTableSwitchInsn(min, max, def, labels);
 25.1194 +			for(int i = 0; i < range; ++i)
 25.1195 +				{
 25.1196 +				Label label = labels[i];
 25.1197 +				if(label != def)
 25.1198 +					{
 25.1199 +					mark(label);
 25.1200 +					generator.generateCase(i + min, end);
 25.1201 +					}
 25.1202 +				}
 25.1203 +			}
 25.1204 +		else
 25.1205 +			{
 25.1206 +			Label[] labels = new Label[len];
 25.1207 +			for(int i = 0; i < len; ++i)
 25.1208 +				{
 25.1209 +				labels[i] = newLabel();
 25.1210 +				}
 25.1211 +			mv.visitLookupSwitchInsn(def, keys, labels);
 25.1212 +			for(int i = 0; i < len; ++i)
 25.1213 +				{
 25.1214 +				mark(labels[i]);
 25.1215 +				generator.generateCase(keys[i], end);
 25.1216 +				}
 25.1217 +			}
 25.1218 +		}
 25.1219 +	mark(def);
 25.1220 +	generator.generateDefault();
 25.1221 +	mark(end);
 25.1222 +}
 25.1223 +
 25.1224 +/**
 25.1225 + * Generates the instruction to return the top stack value to the caller.
 25.1226 + */
 25.1227 +public void returnValue(){
 25.1228 +	mv.visitInsn(returnType.getOpcode(Opcodes.IRETURN));
 25.1229 +}
 25.1230 +
 25.1231 +// ------------------------------------------------------------------------
 25.1232 +// Instructions to load and store fields
 25.1233 +// ------------------------------------------------------------------------
 25.1234 +
 25.1235 +/**
 25.1236 + * Generates a get field or set field instruction.
 25.1237 + *
 25.1238 + * @param opcode    the instruction's opcode.
 25.1239 + * @param ownerType the class in which the field is defined.
 25.1240 + * @param name      the name of the field.
 25.1241 + * @param fieldType the type of the field.
 25.1242 + */
 25.1243 +private void fieldInsn(
 25.1244 +		final int opcode,
 25.1245 +		final Type ownerType,
 25.1246 +		final String name,
 25.1247 +		final Type fieldType){
 25.1248 +	mv.visitFieldInsn(opcode,
 25.1249 +	                  ownerType.getInternalName(),
 25.1250 +	                  name,
 25.1251 +	                  fieldType.getDescriptor());
 25.1252 +}
 25.1253 +
 25.1254 +/**
 25.1255 + * Generates the instruction to push the value of a static field on the
 25.1256 + * stack.
 25.1257 + *
 25.1258 + * @param owner the class in which the field is defined.
 25.1259 + * @param name  the name of the field.
 25.1260 + * @param type  the type of the field.
 25.1261 + */
 25.1262 +public void getStatic(final Type owner, final String name, final Type type){
 25.1263 +	fieldInsn(Opcodes.GETSTATIC, owner, name, type);
 25.1264 +}
 25.1265 +
 25.1266 +/**
 25.1267 + * Generates the instruction to store the top stack value in a static field.
 25.1268 + *
 25.1269 + * @param owner the class in which the field is defined.
 25.1270 + * @param name  the name of the field.
 25.1271 + * @param type  the type of the field.
 25.1272 + */
 25.1273 +public void putStatic(final Type owner, final String name, final Type type){
 25.1274 +	fieldInsn(Opcodes.PUTSTATIC, owner, name, type);
 25.1275 +}
 25.1276 +
 25.1277 +/**
 25.1278 + * Generates the instruction to push the value of a non static field on the
 25.1279 + * stack.
 25.1280 + *
 25.1281 + * @param owner the class in which the field is defined.
 25.1282 + * @param name  the name of the field.
 25.1283 + * @param type  the type of the field.
 25.1284 + */
 25.1285 +public void getField(final Type owner, final String name, final Type type){
 25.1286 +	fieldInsn(Opcodes.GETFIELD, owner, name, type);
 25.1287 +}
 25.1288 +
 25.1289 +/**
 25.1290 + * Generates the instruction to store the top stack value in a non static
 25.1291 + * field.
 25.1292 + *
 25.1293 + * @param owner the class in which the field is defined.
 25.1294 + * @param name  the name of the field.
 25.1295 + * @param type  the type of the field.
 25.1296 + */
 25.1297 +public void putField(final Type owner, final String name, final Type type){
 25.1298 +	fieldInsn(Opcodes.PUTFIELD, owner, name, type);
 25.1299 +}
 25.1300 +
 25.1301 +// ------------------------------------------------------------------------
 25.1302 +// Instructions to invoke methods
 25.1303 +// ------------------------------------------------------------------------
 25.1304 +
 25.1305 +/**
 25.1306 + * Generates an invoke method instruction.
 25.1307 + *
 25.1308 + * @param opcode the instruction's opcode.
 25.1309 + * @param type   the class in which the method is defined.
 25.1310 + * @param method the method to be invoked.
 25.1311 + */
 25.1312 +private void invokeInsn(
 25.1313 +		final int opcode,
 25.1314 +		final Type type,
 25.1315 +		final Method method){
 25.1316 +	String owner = type.getSort() == Type.ARRAY
 25.1317 +	               ? type.getDescriptor()
 25.1318 +	               : type.getInternalName();
 25.1319 +	mv.visitMethodInsn(opcode,
 25.1320 +	                   owner,
 25.1321 +	                   method.getName(),
 25.1322 +	                   method.getDescriptor());
 25.1323 +}
 25.1324 +
 25.1325 +/**
 25.1326 + * Generates the instruction to invoke a normal method.
 25.1327 + *
 25.1328 + * @param owner  the class in which the method is defined.
 25.1329 + * @param method the method to be invoked.
 25.1330 + */
 25.1331 +public void invokeVirtual(final Type owner, final Method method){
 25.1332 +	invokeInsn(Opcodes.INVOKEVIRTUAL, owner, method);
 25.1333 +}
 25.1334 +
 25.1335 +/**
 25.1336 + * Generates the instruction to invoke a constructor.
 25.1337 + *
 25.1338 + * @param type   the class in which the constructor is defined.
 25.1339 + * @param method the constructor to be invoked.
 25.1340 + */
 25.1341 +public void invokeConstructor(final Type type, final Method method){
 25.1342 +	invokeInsn(Opcodes.INVOKESPECIAL, type, method);
 25.1343 +}
 25.1344 +
 25.1345 +/**
 25.1346 + * Generates the instruction to invoke a static method.
 25.1347 + *
 25.1348 + * @param owner  the class in which the method is defined.
 25.1349 + * @param method the method to be invoked.
 25.1350 + */
 25.1351 +public void invokeStatic(final Type owner, final Method method){
 25.1352 +	invokeInsn(Opcodes.INVOKESTATIC, owner, method);
 25.1353 +}
 25.1354 +
 25.1355 +/**
 25.1356 + * Generates the instruction to invoke an interface method.
 25.1357 + *
 25.1358 + * @param owner  the class in which the method is defined.
 25.1359 + * @param method the method to be invoked.
 25.1360 + */
 25.1361 +public void invokeInterface(final Type owner, final Method method){
 25.1362 +	invokeInsn(Opcodes.INVOKEINTERFACE, owner, method);
 25.1363 +}
 25.1364 +
 25.1365 +// ------------------------------------------------------------------------
 25.1366 +// Instructions to create objects and arrays
 25.1367 +// ------------------------------------------------------------------------
 25.1368 +
 25.1369 +/**
 25.1370 + * Generates a type dependent instruction.
 25.1371 + *
 25.1372 + * @param opcode the instruction's opcode.
 25.1373 + * @param type   the instruction's operand.
 25.1374 + */
 25.1375 +private void typeInsn(final int opcode, final Type type){
 25.1376 +	String desc;
 25.1377 +	if(type.getSort() == Type.ARRAY)
 25.1378 +		{
 25.1379 +		desc = type.getDescriptor();
 25.1380 +		}
 25.1381 +	else
 25.1382 +		{
 25.1383 +		desc = type.getInternalName();
 25.1384 +		}
 25.1385 +	mv.visitTypeInsn(opcode, desc);
 25.1386 +}
 25.1387 +
 25.1388 +/**
 25.1389 + * Generates the instruction to create a new object.
 25.1390 + *
 25.1391 + * @param type the class of the object to be created.
 25.1392 + */
 25.1393 +public void newInstance(final Type type){
 25.1394 +	typeInsn(Opcodes.NEW, type);
 25.1395 +}
 25.1396 +
 25.1397 +/**
 25.1398 + * Generates the instruction to create a new array.
 25.1399 + *
 25.1400 + * @param type the type of the array elements.
 25.1401 + */
 25.1402 +public void newArray(final Type type){
 25.1403 +	int typ;
 25.1404 +	switch(type.getSort())
 25.1405 +		{
 25.1406 +		case Type.BOOLEAN:
 25.1407 +			typ = Opcodes.T_BOOLEAN;
 25.1408 +			break;
 25.1409 +		case Type.CHAR:
 25.1410 +			typ = Opcodes.T_CHAR;
 25.1411 +			break;
 25.1412 +		case Type.BYTE:
 25.1413 +			typ = Opcodes.T_BYTE;
 25.1414 +			break;
 25.1415 +		case Type.SHORT:
 25.1416 +			typ = Opcodes.T_SHORT;
 25.1417 +			break;
 25.1418 +		case Type.INT:
 25.1419 +			typ = Opcodes.T_INT;
 25.1420 +			break;
 25.1421 +		case Type.FLOAT:
 25.1422 +			typ = Opcodes.T_FLOAT;
 25.1423 +			break;
 25.1424 +		case Type.LONG:
 25.1425 +			typ = Opcodes.T_LONG;
 25.1426 +			break;
 25.1427 +		case Type.DOUBLE:
 25.1428 +			typ = Opcodes.T_DOUBLE;
 25.1429 +			break;
 25.1430 +		default:
 25.1431 +			typeInsn(Opcodes.ANEWARRAY, type);
 25.1432 +			return;
 25.1433 +		}
 25.1434 +	mv.visitIntInsn(Opcodes.NEWARRAY, typ);
 25.1435 +}
 25.1436 +
 25.1437 +// ------------------------------------------------------------------------
 25.1438 +// Miscelaneous instructions
 25.1439 +// ------------------------------------------------------------------------
 25.1440 +
 25.1441 +/**
 25.1442 + * Generates the instruction to compute the length of an array.
 25.1443 + */
 25.1444 +public void arrayLength(){
 25.1445 +	mv.visitInsn(Opcodes.ARRAYLENGTH);
 25.1446 +}
 25.1447 +
 25.1448 +/**
 25.1449 + * Generates the instruction to throw an exception.
 25.1450 + */
 25.1451 +public void throwException(){
 25.1452 +	mv.visitInsn(Opcodes.ATHROW);
 25.1453 +}
 25.1454 +
 25.1455 +/**
 25.1456 + * Generates the instructions to create and throw an exception. The
 25.1457 + * exception class must have a constructor with a single String argument.
 25.1458 + *
 25.1459 + * @param type the class of the exception to be thrown.
 25.1460 + * @param msg  the detailed message of the exception.
 25.1461 + */
 25.1462 +public void throwException(final Type type, final String msg){
 25.1463 +	newInstance(type);
 25.1464 +	dup();
 25.1465 +	push(msg);
 25.1466 +	invokeConstructor(type, Method.getMethod("void <init> (String)"));
 25.1467 +	throwException();
 25.1468 +}
 25.1469 +
 25.1470 +/**
 25.1471 + * Generates the instruction to check that the top stack value is of the
 25.1472 + * given type.
 25.1473 + *
 25.1474 + * @param type a class or interface type.
 25.1475 + */
 25.1476 +public void checkCast(final Type type){
 25.1477 +	if(!type.equals(OBJECT_TYPE))
 25.1478 +		{
 25.1479 +		typeInsn(Opcodes.CHECKCAST, type);
 25.1480 +		}
 25.1481 +}
 25.1482 +
 25.1483 +/**
 25.1484 + * Generates the instruction to test if the top stack value is of the given
 25.1485 + * type.
 25.1486 + *
 25.1487 + * @param type a class or interface type.
 25.1488 + */
 25.1489 +public void instanceOf(final Type type){
 25.1490 +	typeInsn(Opcodes.INSTANCEOF, type);
 25.1491 +}
 25.1492 +
 25.1493 +/**
 25.1494 + * Generates the instruction to get the monitor of the top stack value.
 25.1495 + */
 25.1496 +public void monitorEnter(){
 25.1497 +	mv.visitInsn(Opcodes.MONITORENTER);
 25.1498 +}
 25.1499 +
 25.1500 +/**
 25.1501 + * Generates the instruction to release the monitor of the top stack value.
 25.1502 + */
 25.1503 +public void monitorExit(){
 25.1504 +	mv.visitInsn(Opcodes.MONITOREXIT);
 25.1505 +}
 25.1506 +
 25.1507 +// ------------------------------------------------------------------------
 25.1508 +// Non instructions
 25.1509 +// ------------------------------------------------------------------------
 25.1510 +
 25.1511 +/**
 25.1512 + * Marks the end of the visited method.
 25.1513 + */
 25.1514 +public void endMethod(){
 25.1515 +	if((access & Opcodes.ACC_ABSTRACT) == 0)
 25.1516 +		{
 25.1517 +		mv.visitMaxs(0, 0);
 25.1518 +		}
 25.1519 +	mv.visitEnd();
 25.1520 +}
 25.1521 +
 25.1522 +/**
 25.1523 + * Marks the start of an exception handler.
 25.1524 + *
 25.1525 + * @param start     beginning of the exception handler's scope (inclusive).
 25.1526 + * @param end       end of the exception handler's scope (exclusive).
 25.1527 + * @param exception internal name of the type of exceptions handled by the
 25.1528 + *                  handler.
 25.1529 + */
 25.1530 +public void catchException(
 25.1531 +		final Label start,
 25.1532 +		final Label end,
 25.1533 +		final Type exception){
 25.1534 +	mv.visitTryCatchBlock(start, end, mark(), exception.getInternalName());
 25.1535 +}
 25.1536 +}
    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/clojure/asm/commons/LocalVariablesSorter.java	Sat Aug 21 06:25:44 2010 -0400
    26.3 @@ -0,0 +1,330 @@
    26.4 +/***
    26.5 + * ASM: a very small and fast Java bytecode manipulation framework
    26.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    26.7 + * All rights reserved.
    26.8 + *
    26.9 + * Redistribution and use in source and binary forms, with or without
   26.10 + * modification, are permitted provided that the following conditions
   26.11 + * are met:
   26.12 + * 1. Redistributions of source code must retain the above copyright
   26.13 + *    notice, this list of conditions and the following disclaimer.
   26.14 + * 2. Redistributions in binary form must reproduce the above copyright
   26.15 + *    notice, this list of conditions and the following disclaimer in the
   26.16 + *    documentation and/or other materials provided with the distribution.
   26.17 + * 3. Neither the name of the copyright holders nor the names of its
   26.18 + *    contributors may be used to endorse or promote products derived from
   26.19 + *    this software without specific prior written permission.
   26.20 + *
   26.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   26.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   26.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   26.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   26.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   26.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   26.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   26.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   26.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   26.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   26.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   26.32 + */
   26.33 +package clojure.asm.commons;
   26.34 +
   26.35 +import clojure.asm.Label;
   26.36 +import clojure.asm.MethodAdapter;
   26.37 +import clojure.asm.MethodVisitor;
   26.38 +import clojure.asm.Opcodes;
   26.39 +import clojure.asm.Type;
   26.40 +
   26.41 +/**
   26.42 + * A {@link MethodAdapter} that renumbers local variables in their order of
   26.43 + * appearance. This adapter allows one to easily add new local variables to a
   26.44 + * method. It may be used by inheriting from this class, but the preferred way
   26.45 + * of using it is via delegation: the next visitor in the chain can indeed add
   26.46 + * new locals when needed by calling {@link #newLocal} on this adapter (this
   26.47 + * requires a reference back to this {@link LocalVariablesSorter}).
   26.48 + *
   26.49 + * @author Chris Nokleberg
   26.50 + * @author Eugene Kuleshov
   26.51 + * @author Eric Bruneton
   26.52 + */
   26.53 +public class LocalVariablesSorter extends MethodAdapter{
   26.54 +
   26.55 +private final static Type OBJECT_TYPE = Type.getObjectType("java/lang/Object");
   26.56 +
   26.57 +/**
   26.58 + * Mapping from old to new local variable indexes. A local variable at index
   26.59 + * i of size 1 is remapped to 'mapping[2*i]', while a local variable at
   26.60 + * index i of size 2 is remapped to 'mapping[2*i+1]'.
   26.61 + */
   26.62 +private int[] mapping = new int[40];
   26.63 +
   26.64 +/**
   26.65 + * Array used to store stack map local variable types after remapping.
   26.66 + */
   26.67 +private Object[] newLocals = new Object[20];
   26.68 +
   26.69 +/**
   26.70 + * Index of the first local variable, after formal parameters.
   26.71 + */
   26.72 +protected final int firstLocal;
   26.73 +
   26.74 +/**
   26.75 + * Index of the next local variable to be created by {@link #newLocal}.
   26.76 + */
   26.77 +protected int nextLocal;
   26.78 +
   26.79 +/**
   26.80 + * Indicates if at least one local variable has moved due to remapping.
   26.81 + */
   26.82 +private boolean changed;
   26.83 +
   26.84 +/**
   26.85 + * Creates a new {@link LocalVariablesSorter}.
   26.86 + *
   26.87 + * @param access access flags of the adapted method.
   26.88 + * @param desc   the method's descriptor (see {@link Type Type}).
   26.89 + * @param mv     the method visitor to which this adapter delegates calls.
   26.90 + */
   26.91 +public LocalVariablesSorter(
   26.92 +		final int access,
   26.93 +		final String desc,
   26.94 +		final MethodVisitor mv){
   26.95 +	super(mv);
   26.96 +	Type[] args = Type.getArgumentTypes(desc);
   26.97 +	nextLocal = (Opcodes.ACC_STATIC & access) != 0 ? 0 : 1;
   26.98 +	for(int i = 0; i < args.length; i++)
   26.99 +		{
  26.100 +		nextLocal += args[i].getSize();
  26.101 +		}
  26.102 +	firstLocal = nextLocal;
  26.103 +}
  26.104 +
  26.105 +public void visitVarInsn(final int opcode, final int var){
  26.106 +	Type type;
  26.107 +	switch(opcode)
  26.108 +		{
  26.109 +		case Opcodes.LLOAD:
  26.110 +		case Opcodes.LSTORE:
  26.111 +			type = Type.LONG_TYPE;
  26.112 +			break;
  26.113 +
  26.114 +		case Opcodes.DLOAD:
  26.115 +		case Opcodes.DSTORE:
  26.116 +			type = Type.DOUBLE_TYPE;
  26.117 +			break;
  26.118 +
  26.119 +		case Opcodes.FLOAD:
  26.120 +		case Opcodes.FSTORE:
  26.121 +			type = Type.FLOAT_TYPE;
  26.122 +			break;
  26.123 +
  26.124 +		case Opcodes.ILOAD:
  26.125 +		case Opcodes.ISTORE:
  26.126 +			type = Type.INT_TYPE;
  26.127 +			break;
  26.128 +
  26.129 +		case Opcodes.ALOAD:
  26.130 +		case Opcodes.ASTORE:
  26.131 +			type = OBJECT_TYPE;
  26.132 +			break;
  26.133 +
  26.134 +			// case RET:
  26.135 +		default:
  26.136 +			type = Type.VOID_TYPE;
  26.137 +		}
  26.138 +	mv.visitVarInsn(opcode, remap(var, type));
  26.139 +}
  26.140 +
  26.141 +public void visitIincInsn(final int var, final int increment){
  26.142 +	mv.visitIincInsn(remap(var, Type.INT_TYPE), increment);
  26.143 +}
  26.144 +
  26.145 +public void visitMaxs(final int maxStack, final int maxLocals){
  26.146 +	mv.visitMaxs(maxStack, nextLocal);
  26.147 +}
  26.148 +
  26.149 +public void visitLocalVariable(
  26.150 +		final String name,
  26.151 +		final String desc,
  26.152 +		final String signature,
  26.153 +		final Label start,
  26.154 +		final Label end,
  26.155 +		final int index){
  26.156 +	int size = "J".equals(desc) || "D".equals(desc) ? 2 : 1;
  26.157 +	int newIndex = remap(index, size);
  26.158 +	mv.visitLocalVariable(name, desc, signature, start, end, newIndex);
  26.159 +}
  26.160 +
  26.161 +public void visitFrame(
  26.162 +		final int type,
  26.163 +		final int nLocal,
  26.164 +		final Object[] local,
  26.165 +		final int nStack,
  26.166 +		final Object[] stack){
  26.167 +	if(type != Opcodes.F_NEW)
  26.168 +		{ // uncompressed frame
  26.169 +		throw new IllegalStateException("ClassReader.accept() should be called with EXPAND_FRAMES flag");
  26.170 +		}
  26.171 +
  26.172 +	if(!changed)
  26.173 +		{ // optimization for the case where mapping = identity
  26.174 +		mv.visitFrame(type, nLocal, local, nStack, stack);
  26.175 +		return;
  26.176 +		}
  26.177 +
  26.178 +	// creates a copy of newLocals
  26.179 +	Object[] oldLocals = new Object[newLocals.length];
  26.180 +	System.arraycopy(newLocals, 0, oldLocals, 0, oldLocals.length);
  26.181 +
  26.182 +	// copies types from 'local' to 'newLocals'
  26.183 +	// 'newLocals' already contains the variables added with 'newLocal'
  26.184 +
  26.185 +	int index = 0; // old local variable index
  26.186 +	int number = 0; // old local variable number
  26.187 +	for(; number < nLocal; ++number)
  26.188 +		{
  26.189 +		Object t = local[number];
  26.190 +		int size = t == Opcodes.LONG || t == Opcodes.DOUBLE ? 2 : 1;
  26.191 +		if(t != Opcodes.TOP)
  26.192 +			{
  26.193 +			setFrameLocal(remap(index, size), t);
  26.194 +			}
  26.195 +		index += size;
  26.196 +		}
  26.197 +
  26.198 +	// removes TOP after long and double types as well as trailing TOPs
  26.199 +
  26.200 +	index = 0;
  26.201 +	number = 0;
  26.202 +	for(int i = 0; index < newLocals.length; ++i)
  26.203 +		{
  26.204 +		Object t = newLocals[index++];
  26.205 +		if(t != null && t != Opcodes.TOP)
  26.206 +			{
  26.207 +			newLocals[i] = t;
  26.208 +			number = i + 1;
  26.209 +			if(t == Opcodes.LONG || t == Opcodes.DOUBLE)
  26.210 +				{
  26.211 +				index += 1;
  26.212 +				}
  26.213 +			}
  26.214 +		else
  26.215 +			{
  26.216 +			newLocals[i] = Opcodes.TOP;
  26.217 +			}
  26.218 +		}
  26.219 +
  26.220 +	// visits remapped frame
  26.221 +	mv.visitFrame(type, number, newLocals, nStack, stack);
  26.222 +
  26.223 +	// restores original value of 'newLocals'
  26.224 +	newLocals = oldLocals;
  26.225 +}
  26.226 +
  26.227 +// -------------
  26.228 +
  26.229 +/**
  26.230 + * Creates a new local variable of the given type.
  26.231 + *
  26.232 + * @param type the type of the local variable to be created.
  26.233 + * @return the identifier of the newly created local variable.
  26.234 + */
  26.235 +public int newLocal(final Type type){
  26.236 +	Object t;
  26.237 +	switch(type.getSort())
  26.238 +		{
  26.239 +		case Type.BOOLEAN:
  26.240 +		case Type.CHAR:
  26.241 +		case Type.BYTE:
  26.242 +		case Type.SHORT:
  26.243 +		case Type.INT:
  26.244 +			t = Opcodes.INTEGER;
  26.245 +			break;
  26.246 +		case Type.FLOAT:
  26.247 +			t = Opcodes.FLOAT;
  26.248 +			break;
  26.249 +		case Type.LONG:
  26.250 +			t = Opcodes.LONG;
  26.251 +			break;
  26.252 +		case Type.DOUBLE:
  26.253 +			t = Opcodes.DOUBLE;
  26.254 +			break;
  26.255 +		case Type.ARRAY:
  26.256 +			t = type.getDescriptor();
  26.257 +			break;
  26.258 +			// case Type.OBJECT:
  26.259 +		default:
  26.260 +			t = type.getInternalName();
  26.261 +			break;
  26.262 +		}
  26.263 +	int local = nextLocal;
  26.264 +	setLocalType(local, type);
  26.265 +	setFrameLocal(local, t);
  26.266 +	nextLocal += type.getSize();
  26.267 +	return local;
  26.268 +}
  26.269 +
  26.270 +/**
  26.271 + * Sets the current type of the given local variable. The default
  26.272 + * implementation of this method does nothing.
  26.273 + *
  26.274 + * @param local a local variable identifier, as returned by {@link #newLocal
  26.275 + *              newLocal()}.
  26.276 + * @param type  the type of the value being stored in the local variable
  26.277 + */
  26.278 +protected void setLocalType(final int local, final Type type){
  26.279 +}
  26.280 +
  26.281 +private void setFrameLocal(final int local, final Object type){
  26.282 +	int l = newLocals.length;
  26.283 +	if(local >= l)
  26.284 +		{
  26.285 +		Object[] a = new Object[Math.max(2 * l, local + 1)];
  26.286 +		System.arraycopy(newLocals, 0, a, 0, l);
  26.287 +		newLocals = a;
  26.288 +		}
  26.289 +	newLocals[local] = type;
  26.290 +}
  26.291 +
  26.292 +private int remap(final int var, final Type type){
  26.293 +	if(var < firstLocal)
  26.294 +		{
  26.295 +		return var;
  26.296 +		}
  26.297 +	int key = 2 * var + type.getSize() - 1;
  26.298 +	int size = mapping.length;
  26.299 +	if(key >= size)
  26.300 +		{
  26.301 +		int[] newMapping = new int[Math.max(2 * size, key + 1)];
  26.302 +		System.arraycopy(mapping, 0, newMapping, 0, size);
  26.303 +		mapping = newMapping;
  26.304 +		}
  26.305 +	int value = mapping[key];
  26.306 +	if(value == 0)
  26.307 +		{
  26.308 +		value = nextLocal + 1;
  26.309 +		mapping[key] = value;
  26.310 +		setLocalType(nextLocal, type);
  26.311 +		nextLocal += type.getSize();
  26.312 +		}
  26.313 +	if(value - 1 != var)
  26.314 +		{
  26.315 +		changed = true;
  26.316 +		}
  26.317 +	return value - 1;
  26.318 +}
  26.319 +
  26.320 +private int remap(final int var, final int size){
  26.321 +	if(var < firstLocal || !changed)
  26.322 +		{
  26.323 +		return var;
  26.324 +		}
  26.325 +	int key = 2 * var + size - 1;
  26.326 +	int value = key < mapping.length ? mapping[key] : 0;
  26.327 +	if(value == 0)
  26.328 +		{
  26.329 +		throw new IllegalStateException("Unknown local variable " + var);
  26.330 +		}
  26.331 +	return value - 1;
  26.332 +}
  26.333 +}
    27.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.2 +++ b/src/clojure/asm/commons/Method.java	Sat Aug 21 06:25:44 2010 -0400
    27.3 @@ -0,0 +1,267 @@
    27.4 +/***
    27.5 + * ASM: a very small and fast Java bytecode manipulation framework
    27.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    27.7 + * All rights reserved.
    27.8 + *
    27.9 + * Redistribution and use in source and binary forms, with or without
   27.10 + * modification, are permitted provided that the following conditions
   27.11 + * are met:
   27.12 + * 1. Redistributions of source code must retain the above copyright
   27.13 + *    notice, this list of conditions and the following disclaimer.
   27.14 + * 2. Redistributions in binary form must reproduce the above copyright
   27.15 + *    notice, this list of conditions and the following disclaimer in the
   27.16 + *    documentation and/or other materials provided with the distribution.
   27.17 + * 3. Neither the name of the copyright holders nor the names of its
   27.18 + *    contributors may be used to endorse or promote products derived from
   27.19 + *    this software without specific prior written permission.
   27.20 + *
   27.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   27.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   27.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   27.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   27.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   27.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   27.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   27.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   27.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   27.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   27.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   27.32 + */
   27.33 +package clojure.asm.commons;
   27.34 +
   27.35 +import java.util.HashMap;
   27.36 +import java.util.Map;
   27.37 +
   27.38 +import clojure.asm.Type;
   27.39 +
   27.40 +/**
   27.41 + * A named method descriptor.
   27.42 + *
   27.43 + * @author Juozas Baliuka
   27.44 + * @author Chris Nokleberg
   27.45 + * @author Eric Bruneton
   27.46 + */
   27.47 +public class Method{
   27.48 +
   27.49 +/**
   27.50 + * The method name.
   27.51 + */
   27.52 +private final String name;
   27.53 +
   27.54 +/**
   27.55 + * The method descriptor.
   27.56 + */
   27.57 +private final String desc;
   27.58 +
   27.59 +/**
   27.60 + * Maps primitive Java type names to their descriptors.
   27.61 + */
   27.62 +private final static Map DESCRIPTORS;
   27.63 +
   27.64 +static
   27.65 +	{
   27.66 +	DESCRIPTORS = new HashMap();
   27.67 +	DESCRIPTORS.put("void", "V");
   27.68 +	DESCRIPTORS.put("byte", "B");
   27.69 +	DESCRIPTORS.put("char", "C");
   27.70 +	DESCRIPTORS.put("double", "D");
   27.71 +	DESCRIPTORS.put("float", "F");
   27.72 +	DESCRIPTORS.put("int", "I");
   27.73 +	DESCRIPTORS.put("long", "J");
   27.74 +	DESCRIPTORS.put("short", "S");
   27.75 +	DESCRIPTORS.put("boolean", "Z");
   27.76 +	}
   27.77 +
   27.78 +/**
   27.79 + * Creates a new {@link Method}.
   27.80 + *
   27.81 + * @param name the method's name.
   27.82 + * @param desc the method's descriptor.
   27.83 + */
   27.84 +public Method(final String name, final String desc){
   27.85 +	this.name = name;
   27.86 +	this.desc = desc;
   27.87 +}
   27.88 +
   27.89 +/**
   27.90 + * Creates a new {@link Method}.
   27.91 + *
   27.92 + * @param name          the method's name.
   27.93 + * @param returnType    the method's return type.
   27.94 + * @param argumentTypes the method's argument types.
   27.95 + */
   27.96 +public Method(
   27.97 +		final String name,
   27.98 +		final Type returnType,
   27.99 +		final Type[] argumentTypes){
  27.100 +	this(name, Type.getMethodDescriptor(returnType, argumentTypes));
  27.101 +}
  27.102 +
  27.103 +/**
  27.104 + * Returns a {@link Method} corresponding to the given Java method
  27.105 + * declaration.
  27.106 + *
  27.107 + * @param method a Java method declaration, without argument names, of the
  27.108 + *               form "returnType name (argumentType1, ... argumentTypeN)", where
  27.109 + *               the types are in plain Java (e.g. "int", "float",
  27.110 + *               "java.util.List", ...). Classes of the java.lang package can be
  27.111 + *               specified by their unqualified name; all other classes names must
  27.112 + *               be fully qualified.
  27.113 + * @return a {@link Method} corresponding to the given Java method
  27.114 + *         declaration.
  27.115 + * @throws IllegalArgumentException if <code>method</code> could not get
  27.116 + *                                  parsed.
  27.117 + */
  27.118 +public static Method getMethod(final String method)
  27.119 +		throws IllegalArgumentException{
  27.120 +	return getMethod(method, false);
  27.121 +}
  27.122 +
  27.123 +/**
  27.124 + * Returns a {@link Method} corresponding to the given Java method
  27.125 + * declaration.
  27.126 + *
  27.127 + * @param method         a Java method declaration, without argument names, of the
  27.128 + *                       form "returnType name (argumentType1, ... argumentTypeN)", where
  27.129 + *                       the types are in plain Java (e.g. "int", "float",
  27.130 + *                       "java.util.List", ...). Classes of the java.lang package may be
  27.131 + *                       specified by their unqualified name, depending on the
  27.132 + *                       defaultPackage argument; all other classes names must be fully
  27.133 + *                       qualified.
  27.134 + * @param defaultPackage true if unqualified class names belong to the
  27.135 + *                       default package, or false if they correspond to java.lang classes.
  27.136 + *                       For instance "Object" means "Object" if this option is true, or
  27.137 + *                       "java.lang.Object" otherwise.
  27.138 + * @return a {@link Method} corresponding to the given Java method
  27.139 + *         declaration.
  27.140 + * @throws IllegalArgumentException if <code>method</code> could not get
  27.141 + *                                  parsed.
  27.142 + */
  27.143 +public static Method getMethod(
  27.144 +		final String method,
  27.145 +		final boolean defaultPackage) throws IllegalArgumentException{
  27.146 +	int space = method.indexOf(' ');
  27.147 +	int start = method.indexOf('(', space) + 1;
  27.148 +	int end = method.indexOf(')', start);
  27.149 +	if(space == -1 || start == -1 || end == -1)
  27.150 +		{
  27.151 +		throw new IllegalArgumentException();
  27.152 +		}
  27.153 +	// TODO: Check validity of returnType, methodName and arguments.
  27.154 +	String returnType = method.substring(0, space);
  27.155 +	String methodName = method.substring(space + 1, start - 1).trim();
  27.156 +	StringBuffer sb = new StringBuffer();
  27.157 +	sb.append('(');
  27.158 +	int p;
  27.159 +	do
  27.160 +		{
  27.161 +		String s;
  27.162 +		p = method.indexOf(',', start);
  27.163 +		if(p == -1)
  27.164 +			{
  27.165 +			s = map(method.substring(start, end).trim(), defaultPackage);
  27.166 +			}
  27.167 +		else
  27.168 +			{
  27.169 +			s = map(method.substring(start, p).trim(), defaultPackage);
  27.170 +			start = p + 1;
  27.171 +			}
  27.172 +		sb.append(s);
  27.173 +		} while(p != -1);
  27.174 +	sb.append(')');
  27.175 +	sb.append(map(returnType, defaultPackage));
  27.176 +	return new Method(methodName, sb.toString());
  27.177 +}
  27.178 +
  27.179 +private static String map(final String type, final boolean defaultPackage){
  27.180 +	if(type.equals(""))
  27.181 +		{
  27.182 +		return type;
  27.183 +		}
  27.184 +
  27.185 +	StringBuffer sb = new StringBuffer();
  27.186 +	int index = 0;
  27.187 +	while((index = type.indexOf("[]", index) + 1) > 0)
  27.188 +		{
  27.189 +		sb.append('[');
  27.190 +		}
  27.191 +
  27.192 +	String t = type.substring(0, type.length() - sb.length() * 2);
  27.193 +	String desc = (String) DESCRIPTORS.get(t);
  27.194 +	if(desc != null)
  27.195 +		{
  27.196 +		sb.append(desc);
  27.197 +		}
  27.198 +	else
  27.199 +		{
  27.200 +		sb.append('L');
  27.201 +		if(t.indexOf('.') < 0)
  27.202 +			{
  27.203 +			if(!defaultPackage)
  27.204 +				{
  27.205 +				sb.append("java/lang/");
  27.206 +				}
  27.207 +			sb.append(t);
  27.208 +			}
  27.209 +		else
  27.210 +			{
  27.211 +			sb.append(t.replace('.', '/'));
  27.212 +			}
  27.213 +		sb.append(';');
  27.214 +		}
  27.215 +	return sb.toString();
  27.216 +}
  27.217 +
  27.218 +/**
  27.219 + * Returns the name of the method described by this object.
  27.220 + *
  27.221 + * @return the name of the method described by this object.
  27.222 + */
  27.223 +public String getName(){
  27.224 +	return name;
  27.225 +}
  27.226 +
  27.227 +/**
  27.228 + * Returns the descriptor of the method described by this object.
  27.229 + *
  27.230 + * @return the descriptor of the method described by this object.
  27.231 + */
  27.232 +public String getDescriptor(){
  27.233 +	return desc;
  27.234 +}
  27.235 +
  27.236 +/**
  27.237 + * Returns the return type of the method described by this object.
  27.238 + *
  27.239 + * @return the return type of the method described by this object.
  27.240 + */
  27.241 +public Type getReturnType(){
  27.242 +	return Type.getReturnType(desc);
  27.243 +}
  27.244 +
  27.245 +/**
  27.246 + * Returns the argument types of the method described by this object.
  27.247 + *
  27.248 + * @return the argument types of the method described by this object.
  27.249 + */
  27.250 +public Type[] getArgumentTypes(){
  27.251 +	return Type.getArgumentTypes(desc);
  27.252 +}
  27.253 +
  27.254 +public String toString(){
  27.255 +	return name + desc;
  27.256 +}
  27.257 +
  27.258 +public boolean equals(final Object o){
  27.259 +	if(!(o instanceof Method))
  27.260 +		{
  27.261 +		return false;
  27.262 +		}
  27.263 +	Method other = (Method) o;
  27.264 +	return name.equals(other.name) && desc.equals(other.desc);
  27.265 +}
  27.266 +
  27.267 +public int hashCode(){
  27.268 +	return name.hashCode() ^ desc.hashCode();
  27.269 +}
  27.270 +}
  27.271 \ No newline at end of file
    28.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.2 +++ b/src/clojure/asm/commons/SerialVersionUIDAdder.java	Sat Aug 21 06:25:44 2010 -0400
    28.3 @@ -0,0 +1,508 @@
    28.4 +/***
    28.5 + * ASM: a very small and fast Java bytecode manipulation framework
    28.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    28.7 + * All rights reserved.
    28.8 + *
    28.9 + * Redistribution and use in source and binary forms, with or without
   28.10 + * modification, are permitted provided that the following conditions
   28.11 + * are met:
   28.12 + * 1. Redistributions of source code must retain the above copyright
   28.13 + *    notice, this list of conditions and the following disclaimer.
   28.14 + * 2. Redistributions in binary form must reproduce the above copyright
   28.15 + *    notice, this list of conditions and the following disclaimer in the
   28.16 + *    documentation and/or other materials provided with the distribution.
   28.17 + * 3. Neither the name of the copyright holders nor the names of its
   28.18 + *    contributors may be used to endorse or promote products derived from
   28.19 + *    this software without specific prior written permission.
   28.20 + *
   28.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   28.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   28.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   28.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   28.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   28.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   28.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   28.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   28.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   28.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   28.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   28.32 + */
   28.33 +package clojure.asm.commons;
   28.34 +
   28.35 +import java.io.ByteArrayOutputStream;
   28.36 +import java.io.DataOutputStream;
   28.37 +import java.io.IOException;
   28.38 +import java.security.MessageDigest;
   28.39 +import java.util.ArrayList;
   28.40 +import java.util.Arrays;
   28.41 +import java.util.Collection;
   28.42 +
   28.43 +import clojure.asm.ClassAdapter;
   28.44 +import clojure.asm.ClassVisitor;
   28.45 +import clojure.asm.FieldVisitor;
   28.46 +import clojure.asm.MethodVisitor;
   28.47 +import clojure.asm.Opcodes;
   28.48 +
   28.49 +/**
   28.50 + * A {@link ClassAdapter} that adds a serial version unique identifier to a
   28.51 + * class if missing. Here is typical usage of this class:
   28.52 + * <p/>
   28.53 + * <pre>
   28.54 + *   ClassWriter cw = new ClassWriter(...);
   28.55 + *   ClassVisitor sv = new SerialVersionUIDAdder(cw);
   28.56 + *   ClassVisitor ca = new MyClassAdapter(sv);
   28.57 + *   new ClassReader(orginalClass).accept(ca, false);
   28.58 + * </pre>
   28.59 + * <p/>
   28.60 + * The SVUID algorithm can be found <a href=
   28.61 + * "http://java.sun.com/j2se/1.4.2/docs/guide/serialization/spec/class.html"
   28.62 + * >http://java.sun.com/j2se/1.4.2/docs/guide/serialization/spec/class.html</a>:
   28.63 + * <p/>
   28.64 + * <pre>
   28.65 + * The serialVersionUID is computed using the signature of a stream of bytes
   28.66 + * that reflect the class definition. The National Institute of Standards and
   28.67 + * Technology (NIST) Secure Hash Algorithm (SHA-1) is used to compute a
   28.68 + * signature for the stream. The first two 32-bit quantities are used to form a
   28.69 + * 64-bit hash. A java.lang.DataOutputStream is used to convert primitive data
   28.70 + * types to a sequence of bytes. The values input to the stream are defined by
   28.71 + * the Java Virtual Machine (VM) specification for classes.
   28.72 + * <p/>
   28.73 + * The sequence of items in the stream is as follows:
   28.74 + * <p/>
   28.75 + * 1. The class name written using UTF encoding.
   28.76 + * 2. The class modifiers written as a 32-bit integer.
   28.77 + * 3. The name of each interface sorted by name written using UTF encoding.
   28.78 + * 4. For each field of the class sorted by field name (except private static
   28.79 + * and private transient fields):
   28.80 + * 1. The name of the field in UTF encoding.
   28.81 + * 2. The modifiers of the field written as a 32-bit integer.
   28.82 + * 3. The descriptor of the field in UTF encoding
   28.83 + * 5. If a class initializer exists, write out the following:
   28.84 + * 1. The name of the method, &lt;clinit&gt;, in UTF encoding.
   28.85 + * 2. The modifier of the method, java.lang.reflect.Modifier.STATIC,
   28.86 + * written as a 32-bit integer.
   28.87 + * 3. The descriptor of the method, ()V, in UTF encoding.
   28.88 + * 6. For each non-private constructor sorted by method name and signature:
   28.89 + * 1. The name of the method, &lt;init&gt;, in UTF encoding.
   28.90 + * 2. The modifiers of the method written as a 32-bit integer.
   28.91 + * 3. The descriptor of the method in UTF encoding.
   28.92 + * 7. For each non-private method sorted by method name and signature:
   28.93 + * 1. The name of the method in UTF encoding.
   28.94 + * 2. The modifiers of the method written as a 32-bit integer.
   28.95 + * 3. The descriptor of the method in UTF encoding.
   28.96 + * 8. The SHA-1 algorithm is executed on the stream of bytes produced by
   28.97 + * DataOutputStream and produces five 32-bit values sha[0..4].
   28.98 + * <p/>
   28.99 + * 9. The hash value is assembled from the first and second 32-bit values of
  28.100 + * the SHA-1 message digest. If the result of the message digest, the five
  28.101 + * 32-bit words H0 H1 H2 H3 H4, is in an array of five int values named
  28.102 + * sha, the hash value would be computed as follows:
  28.103 + * <p/>
  28.104 + * long hash = ((sha[0] &gt;&gt;&gt; 24) &amp; 0xFF) |
  28.105 + * ((sha[0] &gt;&gt;&gt; 16) &amp; 0xFF) &lt;&lt; 8 |
  28.106 + * ((sha[0] &gt;&gt;&gt; 8) &amp; 0xFF) &lt;&lt; 16 |
  28.107 + * ((sha[0] &gt;&gt;&gt; 0) &amp; 0xFF) &lt;&lt; 24 |
  28.108 + * ((sha[1] &gt;&gt;&gt; 24) &amp; 0xFF) &lt;&lt; 32 |
  28.109 + * ((sha[1] &gt;&gt;&gt; 16) &amp; 0xFF) &lt;&lt; 40 |
  28.110 + * ((sha[1] &gt;&gt;&gt; 8) &amp; 0xFF) &lt;&lt; 48 |
  28.111 + * ((sha[1] &gt;&gt;&gt; 0) &amp; 0xFF) &lt;&lt; 56;
  28.112 + * </pre>
  28.113 + *
  28.114 + * @author Rajendra Inamdar, Vishal Vishnoi
  28.115 + */
  28.116 +public class SerialVersionUIDAdder extends ClassAdapter{
  28.117 +
  28.118 +/**
  28.119 + * Flag that indicates if we need to compute SVUID.
  28.120 + */
  28.121 +protected boolean computeSVUID;
  28.122 +
  28.123 +/**
  28.124 + * Set to true if the class already has SVUID.
  28.125 + */
  28.126 +protected boolean hasSVUID;
  28.127 +
  28.128 +/**
  28.129 + * Classes access flags.
  28.130 + */
  28.131 +protected int access;
  28.132 +
  28.133 +/**
  28.134 + * Internal name of the class
  28.135 + */
  28.136 +protected String name;
  28.137 +
  28.138 +/**
  28.139 + * Interfaces implemented by the class.
  28.140 + */
  28.141 +protected String[] interfaces;
  28.142 +
  28.143 +/**
  28.144 + * Collection of fields. (except private static and private transient
  28.145 + * fields)
  28.146 + */
  28.147 +protected Collection svuidFields;
  28.148 +
  28.149 +/**
  28.150 + * Set to true if the class has static initializer.
  28.151 + */
  28.152 +protected boolean hasStaticInitializer;
  28.153 +
  28.154 +/**
  28.155 + * Collection of non-private constructors.
  28.156 + */
  28.157 +protected Collection svuidConstructors;
  28.158 +
  28.159 +/**
  28.160 + * Collection of non-private methods.
  28.161 + */
  28.162 +protected Collection svuidMethods;
  28.163 +
  28.164 +/**
  28.165 + * Creates a new {@link SerialVersionUIDAdder}.
  28.166 + *
  28.167 + * @param cv a {@link ClassVisitor} to which this visitor will delegate
  28.168 + *           calls.
  28.169 + */
  28.170 +public SerialVersionUIDAdder(final ClassVisitor cv){
  28.171 +	super(cv);
  28.172 +	svuidFields = new ArrayList();
  28.173 +	svuidConstructors = new ArrayList();
  28.174 +	svuidMethods = new ArrayList();
  28.175 +}
  28.176 +
  28.177 +// ------------------------------------------------------------------------
  28.178 +// Overriden methods
  28.179 +// ------------------------------------------------------------------------
  28.180 +
  28.181 +/*
  28.182 +	 * Visit class header and get class name, access , and intefraces
  28.183 +	 * informatoin (step 1,2, and 3) for SVUID computation.
  28.184 +	 */
  28.185 +
  28.186 +public void visit(
  28.187 +		final int version,
  28.188 +		final int access,
  28.189 +		final String name,
  28.190 +		final String signature,
  28.191 +		final String superName,
  28.192 +		final String[] interfaces){
  28.193 +	computeSVUID = (access & Opcodes.ACC_INTERFACE) == 0;
  28.194 +
  28.195 +	if(computeSVUID)
  28.196 +		{
  28.197 +		this.name = name;
  28.198 +		this.access = access;
  28.199 +		this.interfaces = interfaces;
  28.200 +		}
  28.201 +
  28.202 +	super.visit(version, access, name, signature, superName, interfaces);
  28.203 +}
  28.204 +
  28.205 +/*
  28.206 +	 * Visit the methods and get constructor and method information (step 5 and
  28.207 +	 * 7). Also determince if there is a class initializer (step 6).
  28.208 +	 */
  28.209 +public MethodVisitor visitMethod(
  28.210 +		final int access,
  28.211 +		final String name,
  28.212 +		final String desc,
  28.213 +		final String signature,
  28.214 +		final String[] exceptions){
  28.215 +	if(computeSVUID)
  28.216 +		{
  28.217 +		if(name.equals("<clinit>"))
  28.218 +			{
  28.219 +			hasStaticInitializer = true;
  28.220 +			}
  28.221 +		/*
  28.222 +					 * Remembers non private constructors and methods for SVUID
  28.223 +					 * computation For constructor and method modifiers, only the
  28.224 +					 * ACC_PUBLIC, ACC_PRIVATE, ACC_PROTECTED, ACC_STATIC, ACC_FINAL,
  28.225 +					 * ACC_SYNCHRONIZED, ACC_NATIVE, ACC_ABSTRACT and ACC_STRICT flags
  28.226 +					 * are used.
  28.227 +					 */
  28.228 +		int mods = access
  28.229 +		           & (Opcodes.ACC_PUBLIC | Opcodes.ACC_PRIVATE
  28.230 +		              | Opcodes.ACC_PROTECTED | Opcodes.ACC_STATIC
  28.231 +		              | Opcodes.ACC_FINAL | Opcodes.ACC_SYNCHRONIZED
  28.232 +		              | Opcodes.ACC_NATIVE | Opcodes.ACC_ABSTRACT | Opcodes.ACC_STRICT);
  28.233 +
  28.234 +		// all non private methods
  28.235 +		if((access & Opcodes.ACC_PRIVATE) == 0)
  28.236 +			{
  28.237 +			if(name.equals("<init>"))
  28.238 +				{
  28.239 +				svuidConstructors.add(new Item(name, mods, desc));
  28.240 +				}
  28.241 +			else if(!name.equals("<clinit>"))
  28.242 +				{
  28.243 +				svuidMethods.add(new Item(name, mods, desc));
  28.244 +				}
  28.245 +			}
  28.246 +		}
  28.247 +
  28.248 +	return cv.visitMethod(access, name, desc, signature, exceptions);
  28.249 +}
  28.250 +
  28.251 +/*
  28.252 +	 * Gets class field information for step 4 of the alogrithm. Also determines
  28.253 +	 * if the class already has a SVUID.
  28.254 +	 */
  28.255 +public FieldVisitor visitField(
  28.256 +		final int access,
  28.257 +		final String name,
  28.258 +		final String desc,
  28.259 +		final String signature,
  28.260 +		final Object value){
  28.261 +	if(computeSVUID)
  28.262 +		{
  28.263 +		if(name.equals("serialVersionUID"))
  28.264 +			{
  28.265 +			// since the class already has SVUID, we won't be computing it.
  28.266 +			computeSVUID = false;
  28.267 +			hasSVUID = true;
  28.268 +			}
  28.269 +		/*
  28.270 +					 * Remember field for SVUID computation For field modifiers, only
  28.271 +					 * the ACC_PUBLIC, ACC_PRIVATE, ACC_PROTECTED, ACC_STATIC,
  28.272 +					 * ACC_FINAL, ACC_VOLATILE, and ACC_TRANSIENT flags are used when
  28.273 +					 * computing serialVersionUID values.
  28.274 +					 */
  28.275 +		int mods = access
  28.276 +		           & (Opcodes.ACC_PUBLIC | Opcodes.ACC_PRIVATE
  28.277 +		              | Opcodes.ACC_PROTECTED | Opcodes.ACC_STATIC
  28.278 +		              | Opcodes.ACC_FINAL | Opcodes.ACC_VOLATILE | Opcodes.ACC_TRANSIENT);
  28.279 +
  28.280 +		if((access & Opcodes.ACC_PRIVATE) == 0
  28.281 +		   || (access & (Opcodes.ACC_STATIC | Opcodes.ACC_TRANSIENT)) == 0)
  28.282 +			{
  28.283 +			svuidFields.add(new Item(name, mods, desc));
  28.284 +			}
  28.285 +		}
  28.286 +
  28.287 +	return super.visitField(access, name, desc, signature, value);
  28.288 +}
  28.289 +
  28.290 +/*
  28.291 +	 * Add the SVUID if class doesn't have one
  28.292 +	 */
  28.293 +public void visitEnd(){
  28.294 +	// compute SVUID and add it to the class
  28.295 +	if(computeSVUID && !hasSVUID)
  28.296 +		{
  28.297 +		try
  28.298 +			{
  28.299 +			cv.visitField(Opcodes.ACC_FINAL + Opcodes.ACC_STATIC,
  28.300 +			              "serialVersionUID",
  28.301 +			              "J",
  28.302 +			              null,
  28.303 +			              new Long(computeSVUID()));
  28.304 +			}
  28.305 +		catch(Throwable e)
  28.306 +			{
  28.307 +			throw new RuntimeException("Error while computing SVUID for "
  28.308 +			                           + name, e);
  28.309 +			}
  28.310 +		}
  28.311 +
  28.312 +	super.visitEnd();
  28.313 +}
  28.314 +
  28.315 +// ------------------------------------------------------------------------
  28.316 +// Utility methods
  28.317 +// ------------------------------------------------------------------------
  28.318 +
  28.319 +/**
  28.320 + * Returns the value of SVUID if the class doesn't have one already. Please
  28.321 + * note that 0 is returned if the class already has SVUID, thus use
  28.322 + * <code>isHasSVUID</code> to determine if the class already had an SVUID.
  28.323 + *
  28.324 + * @return Returns the serial version UID
  28.325 + * @throws IOException
  28.326 + */
  28.327 +protected long computeSVUID() throws IOException{
  28.328 +	ByteArrayOutputStream bos = null;
  28.329 +	DataOutputStream dos = null;
  28.330 +	long svuid = 0;
  28.331 +
  28.332 +	try
  28.333 +		{
  28.334 +		bos = new ByteArrayOutputStream();
  28.335 +		dos = new DataOutputStream(bos);
  28.336 +
  28.337 +		/*
  28.338 +					 * 1. The class name written using UTF encoding.
  28.339 +					 */
  28.340 +		dos.writeUTF(name.replace('/', '.'));
  28.341 +
  28.342 +		/*
  28.343 +					 * 2. The class modifiers written as a 32-bit integer.
  28.344 +					 */
  28.345 +		dos.writeInt(access
  28.346 +		             & (Opcodes.ACC_PUBLIC | Opcodes.ACC_FINAL
  28.347 +		                | Opcodes.ACC_INTERFACE | Opcodes.ACC_ABSTRACT));
  28.348 +
  28.349 +		/*
  28.350 +					 * 3. The name of each interface sorted by name written using UTF
  28.351 +					 * encoding.
  28.352 +					 */
  28.353 +		Arrays.sort(interfaces);
  28.354 +		for(int i = 0; i < interfaces.length; i++)
  28.355 +			{
  28.356 +			dos.writeUTF(interfaces[i].replace('/', '.'));
  28.357 +			}
  28.358 +
  28.359 +		/*
  28.360 +					 * 4. For each field of the class sorted by field name (except
  28.361 +					 * private static and private transient fields):
  28.362 +					 *
  28.363 +					 * 1. The name of the field in UTF encoding. 2. The modifiers of the
  28.364 +					 * field written as a 32-bit integer. 3. The descriptor of the field
  28.365 +					 * in UTF encoding
  28.366 +					 *
  28.367 +					 * Note that field signatutes are not dot separated. Method and
  28.368 +					 * constructor signatures are dot separated. Go figure...
  28.369 +					 */
  28.370 +		writeItems(svuidFields, dos, false);
  28.371 +
  28.372 +		/*
  28.373 +					 * 5. If a class initializer exists, write out the following: 1. The
  28.374 +					 * name of the method, <clinit>, in UTF encoding. 2. The modifier of
  28.375 +					 * the method, java.lang.reflect.Modifier.STATIC, written as a
  28.376 +					 * 32-bit integer. 3. The descriptor of the method, ()V, in UTF
  28.377 +					 * encoding.
  28.378 +					 */
  28.379 +		if(hasStaticInitializer)
  28.380 +			{
  28.381 +			dos.writeUTF("<clinit>");
  28.382 +			dos.writeInt(Opcodes.ACC_STATIC);
  28.383 +			dos.writeUTF("()V");
  28.384 +			} // if..
  28.385 +
  28.386 +		/*
  28.387 +					 * 6. For each non-private constructor sorted by method name and
  28.388 +					 * signature: 1. The name of the method, <init>, in UTF encoding. 2.
  28.389 +					 * The modifiers of the method written as a 32-bit integer. 3. The
  28.390 +					 * descriptor of the method in UTF encoding.
  28.391 +					 */
  28.392 +		writeItems(svuidConstructors, dos, true);
  28.393 +
  28.394 +		/*
  28.395 +					 * 7. For each non-private method sorted by method name and
  28.396 +					 * signature: 1. The name of the method in UTF encoding. 2. The
  28.397 +					 * modifiers of the method written as a 32-bit integer. 3. The
  28.398 +					 * descriptor of the method in UTF encoding.
  28.399 +					 */
  28.400 +		writeItems(svuidMethods, dos, true);
  28.401 +
  28.402 +		dos.flush();
  28.403 +
  28.404 +		/*
  28.405 +					 * 8. The SHA-1 algorithm is executed on the stream of bytes
  28.406 +					 * produced by DataOutputStream and produces five 32-bit values
  28.407 +					 * sha[0..4].
  28.408 +					 */
  28.409 +		byte[] hashBytes = computeSHAdigest(bos.toByteArray());
  28.410 +
  28.411 +		/*
  28.412 +					 * 9. The hash value is assembled from the first and second 32-bit
  28.413 +					 * values of the SHA-1 message digest. If the result of the message
  28.414 +					 * digest, the five 32-bit words H0 H1 H2 H3 H4, is in an array of
  28.415 +					 * five int values named sha, the hash value would be computed as
  28.416 +					 * follows:
  28.417 +					 *
  28.418 +					 * long hash = ((sha[0] >>> 24) & 0xFF) | ((sha[0] >>> 16) & 0xFF) <<
  28.419 +					 * 8 | ((sha[0] >>> 8) & 0xFF) << 16 | ((sha[0] >>> 0) & 0xFF) <<
  28.420 +					 * 24 | ((sha[1] >>> 24) & 0xFF) << 32 | ((sha[1] >>> 16) & 0xFF) <<
  28.421 +					 * 40 | ((sha[1] >>> 8) & 0xFF) << 48 | ((sha[1] >>> 0) & 0xFF) <<
  28.422 +					 * 56;
  28.423 +					 */
  28.424 +		for(int i = Math.min(hashBytes.length, 8) - 1; i >= 0; i--)
  28.425 +			{
  28.426 +			svuid = (svuid << 8) | (hashBytes[i] & 0xFF);
  28.427 +			}
  28.428 +		}
  28.429 +	finally
  28.430 +		{
  28.431 +		// close the stream (if open)
  28.432 +		if(dos != null)
  28.433 +			{
  28.434 +			dos.close();
  28.435 +			}
  28.436 +		}
  28.437 +
  28.438 +	return svuid;
  28.439 +}
  28.440 +
  28.441 +/**
  28.442 + * Returns the SHA-1 message digest of the given value.
  28.443 + *
  28.444 + * @param value the value whose SHA message digest must be computed.
  28.445 + * @return the SHA-1 message digest of the given value.
  28.446 + */
  28.447 +protected byte[] computeSHAdigest(final byte[] value){
  28.448 +	try
  28.449 +		{
  28.450 +		return MessageDigest.getInstance("SHA").digest(value);
  28.451 +		}
  28.452 +	catch(Exception e)
  28.453 +		{
  28.454 +		throw new UnsupportedOperationException(e);
  28.455 +		}
  28.456 +}
  28.457 +
  28.458 +/**
  28.459 + * Sorts the items in the collection and writes it to the data output stream
  28.460 + *
  28.461 + * @param itemCollection collection of items
  28.462 + * @param dos            a <code>DataOutputStream</code> value
  28.463 + * @param dotted         a <code>boolean</code> value
  28.464 + * @throws IOException if an error occurs
  28.465 + */
  28.466 +private void writeItems(
  28.467 +		final Collection itemCollection,
  28.468 +		final DataOutputStream dos,
  28.469 +		final boolean dotted) throws IOException{
  28.470 +	int size = itemCollection.size();
  28.471 +	Item items[] = (Item[]) itemCollection.toArray(new Item[size]);
  28.472 +	Arrays.sort(items);
  28.473 +	for(int i = 0; i < size; i++)
  28.474 +		{
  28.475 +		dos.writeUTF(items[i].name);
  28.476 +		dos.writeInt(items[i].access);
  28.477 +		dos.writeUTF(dotted
  28.478 +		             ? items[i].desc.replace('/', '.')
  28.479 +		             : items[i].desc);
  28.480 +		}
  28.481 +}
  28.482 +
  28.483 +// ------------------------------------------------------------------------
  28.484 +// Inner classes
  28.485 +// ------------------------------------------------------------------------
  28.486 +
  28.487 +static class Item implements Comparable{
  28.488 +
  28.489 +	String name;
  28.490 +
  28.491 +	int access;
  28.492 +
  28.493 +	String desc;
  28.494 +
  28.495 +	Item(final String name, final int access, final String desc){
  28.496 +		this.name = name;
  28.497 +		this.access = access;
  28.498 +		this.desc = desc;
  28.499 +	}
  28.500 +
  28.501 +	public int compareTo(final Object o){
  28.502 +		Item other = (Item) o;
  28.503 +		int retVal = name.compareTo(other.name);
  28.504 +		if(retVal == 0)
  28.505 +			{
  28.506 +			retVal = desc.compareTo(other.desc);
  28.507 +			}
  28.508 +		return retVal;
  28.509 +	}
  28.510 +}
  28.511 +}
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/src/clojure/asm/commons/StaticInitMerger.java	Sat Aug 21 06:25:44 2010 -0400
    29.3 @@ -0,0 +1,102 @@
    29.4 +/***
    29.5 + * ASM: a very small and fast Java bytecode manipulation framework
    29.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    29.7 + * All rights reserved.
    29.8 + *
    29.9 + * Redistribution and use in source and binary forms, with or without
   29.10 + * modification, are permitted provided that the following conditions
   29.11 + * are met:
   29.12 + * 1. Redistributions of source code must retain the above copyright
   29.13 + *    notice, this list of conditions and the following disclaimer.
   29.14 + * 2. Redistributions in binary form must reproduce the above copyright
   29.15 + *    notice, this list of conditions and the following disclaimer in the
   29.16 + *    documentation and/or other materials provided with the distribution.
   29.17 + * 3. Neither the name of the copyright holders nor the names of its
   29.18 + *    contributors may be used to endorse or promote products derived from
   29.19 + *    this software without specific prior written permission.
   29.20 + *
   29.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   29.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   29.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   29.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   29.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   29.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   29.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   29.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   29.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   29.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   29.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   29.32 + */
   29.33 +package clojure.asm.commons;
   29.34 +
   29.35 +import clojure.asm.ClassAdapter;
   29.36 +import clojure.asm.ClassVisitor;
   29.37 +import clojure.asm.MethodVisitor;
   29.38 +import clojure.asm.Opcodes;
   29.39 +
   29.40 +/**
   29.41 + * A {@link ClassAdapter} that merges clinit methods into a single one.
   29.42 + *
   29.43 + * @author Eric Bruneton
   29.44 + */
   29.45 +public class StaticInitMerger extends ClassAdapter{
   29.46 +
   29.47 +private String name;
   29.48 +
   29.49 +private MethodVisitor clinit;
   29.50 +
   29.51 +private String prefix;
   29.52 +
   29.53 +private int counter;
   29.54 +
   29.55 +public StaticInitMerger(final String prefix, final ClassVisitor cv){
   29.56 +	super(cv);
   29.57 +	this.prefix = prefix;
   29.58 +}
   29.59 +
   29.60 +public void visit(
   29.61 +		final int version,
   29.62 +		final int access,
   29.63 +		final String name,
   29.64 +		final String signature,
   29.65 +		final String superName,
   29.66 +		final String[] interfaces){
   29.67 +	cv.visit(version, access, name, signature, superName, interfaces);
   29.68 +	this.name = name;
   29.69 +}
   29.70 +
   29.71 +public MethodVisitor visitMethod(
   29.72 +		final int access,
   29.73 +		final String name,
   29.74 +		final String desc,
   29.75 +		final String signature,
   29.76 +		final String[] exceptions){
   29.77 +	MethodVisitor mv;
   29.78 +	if(name.equals("<clinit>"))
   29.79 +		{
   29.80 +		int a = Opcodes.ACC_PRIVATE + Opcodes.ACC_STATIC;
   29.81 +		String n = prefix + counter++;
   29.82 +		mv = cv.visitMethod(a, n, desc, signature, exceptions);
   29.83 +
   29.84 +		if(clinit == null)
   29.85 +			{
   29.86 +			clinit = cv.visitMethod(a, name, desc, null, null);
   29.87 +			}
   29.88 +		clinit.visitMethodInsn(Opcodes.INVOKESTATIC, this.name, n, desc);
   29.89 +		}
   29.90 +	else
   29.91 +		{
   29.92 +		mv = cv.visitMethod(access, name, desc, signature, exceptions);
   29.93 +		}
   29.94 +	return mv;
   29.95 +}
   29.96 +
   29.97 +public void visitEnd(){
   29.98 +	if(clinit != null)
   29.99 +		{
  29.100 +		clinit.visitInsn(Opcodes.RETURN);
  29.101 +		clinit.visitMaxs(0, 0);
  29.102 +		}
  29.103 +	cv.visitEnd();
  29.104 +}
  29.105 +}
    30.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.2 +++ b/src/clojure/asm/commons/TableSwitchGenerator.java	Sat Aug 21 06:25:44 2010 -0400
    30.3 @@ -0,0 +1,55 @@
    30.4 +/***
    30.5 + * ASM: a very small and fast Java bytecode manipulation framework
    30.6 + * Copyright (c) 2000-2005 INRIA, France Telecom
    30.7 + * All rights reserved.
    30.8 + *
    30.9 + * Redistribution and use in source and binary forms, with or without
   30.10 + * modification, are permitted provided that the following conditions
   30.11 + * are met:
   30.12 + * 1. Redistributions of source code must retain the above copyright
   30.13 + *    notice, this list of conditions and the following disclaimer.
   30.14 + * 2. Redistributions in binary form must reproduce the above copyright
   30.15 + *    notice, this list of conditions and the following disclaimer in the
   30.16 + *    documentation and/or other materials provided with the distribution.
   30.17 + * 3. Neither the name of the copyright holders nor the names of its
   30.18 + *    contributors may be used to endorse or promote products derived from
   30.19 + *    this software without specific prior written permission.
   30.20 + *
   30.21 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   30.22 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   30.23 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   30.24 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   30.25 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   30.26 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   30.27 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   30.28 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   30.29 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   30.30 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   30.31 + * THE POSSIBILITY OF SUCH DAMAGE.
   30.32 + */
   30.33 +package clojure.asm.commons;
   30.34 +
   30.35 +import clojure.asm.Label;
   30.36 +
   30.37 +/**
   30.38 + * A code generator for switch statements.
   30.39 + *
   30.40 + * @author Juozas Baliuka
   30.41 + * @author Chris Nokleberg
   30.42 + * @author Eric Bruneton
   30.43 + */
   30.44 +public interface TableSwitchGenerator{
   30.45 +
   30.46 +/**
   30.47 + * Generates the code for a switch case.
   30.48 + *
   30.49 + * @param key the switch case key.
   30.50 + * @param end a label that corresponds to the end of the switch statement.
   30.51 + */
   30.52 +void generateCase(int key, Label end);
   30.53 +
   30.54 +/**
   30.55 + * Generates the code for the default switch case.
   30.56 + */
   30.57 +void generateDefault();
   30.58 +}
    31.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.2 +++ b/src/clojure/asm/commons/package.html	Sat Aug 21 06:25:44 2010 -0400
    31.3 @@ -0,0 +1,48 @@
    31.4 +<html>
    31.5 +<!--
    31.6 + * ASM: a very small and fast Java bytecode manipulation framework
    31.7 + * Copyright (c) 2000-2005 INRIA, France Telecom
    31.8 + * All rights reserved.
    31.9 + *
   31.10 + * Redistribution and use in source and binary forms, with or without
   31.11 + * modification, are permitted provided that the following conditions
   31.12 + * are met:
   31.13 + * 1. Redistributions of source code must retain the above copyright
   31.14 + *    notice, this list of conditions and the following disclaimer.
   31.15 + * 2. Redistributions in binary form must reproduce the above copyright
   31.16 + *    notice, this list of conditions and the following disclaimer in the
   31.17 + *    documentation and/or other materials provided with the distribution.
   31.18 + * 3. Neither the name of the copyright holders nor the names of its
   31.19 + *    contributors may be used to endorse or promote products derived from
   31.20 + *    this software without specific prior written permission.
   31.21 + *
   31.22 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   31.23 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   31.24 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   31.25 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   31.26 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   31.27 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   31.28 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   31.29 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   31.30 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   31.31 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   31.32 + * THE POSSIBILITY OF SUCH DAMAGE.
   31.33 +-->
   31.34 +<body>
   31.35 +Provides some useful class and method adapters. <i>The preferred way of using
   31.36 +	these adapters is by chaining them together and to custom adapters (instead of
   31.37 +	inheriting from them)</i>. Indeed this approach provides more combination
   31.38 +possibilities than inheritance. For instance, suppose you want to implement an
   31.39 +adapter MyAdapter than needs sorted local variables and intermediate stack map
   31.40 +frame values taking into account the local variables sort. By using inheritance,
   31.41 +this would require MyAdapter to extend AnalyzerAdapter, itself extending
   31.42 +LocalVariablesSorter. But AnalyzerAdapter is not a subclass of
   31.43 +LocalVariablesSorter, so this is not possible. On the contrary, by using
   31.44 +delegation, you can make LocalVariablesSorter delegate to AnalyzerAdapter,
   31.45 +itself delegating to MyAdapter. In this case AnalyzerAdapter computes
   31.46 +intermediate frames based on the output of LocalVariablesSorter, and MyAdapter
   31.47 +can add new locals by calling the newLocal method on LocalVariablesSorter, and
   31.48 +can get the stack map frame state before each instruction by reading the locals
   31.49 +and stack fields in AnalyzerAdapter (this requires references from MyAdapter
   31.50 +back to LocalVariablesSorter and AnalyzerAdapter).
   31.51 +</body>
   31.52 \ No newline at end of file
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/clojure/asm/package.html	Sat Aug 21 06:25:44 2010 -0400
    32.3 @@ -0,0 +1,87 @@
    32.4 +<html>
    32.5 +<!--
    32.6 + * ASM: a very small and fast Java bytecode manipulation framework
    32.7 + * Copyright (c) 2000-2005 INRIA, France Telecom
    32.8 + * All rights reserved.
    32.9 + *
   32.10 + * Redistribution and use in source and binary forms, with or without
   32.11 + * modification, are permitted provided that the following conditions
   32.12 + * are met:
   32.13 + * 1. Redistributions of source code must retain the above copyright
   32.14 + *    notice, this list of conditions and the following disclaimer.
   32.15 + * 2. Redistributions in binary form must reproduce the above copyright
   32.16 + *    notice, this list of conditions and the following disclaimer in the
   32.17 + *    documentation and/or other materials provided with the distribution.
   32.18 + * 3. Neither the name of the copyright holders nor the names of its
   32.19 + *    contributors may be used to endorse or promote products derived from
   32.20 + *    this software without specific prior written permission.
   32.21 + *
   32.22 + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   32.23 + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   32.24 + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
   32.25 + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
   32.26 + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
   32.27 + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
   32.28 + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
   32.29 + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
   32.30 + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
   32.31 + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
   32.32 + * THE POSSIBILITY OF SUCH DAMAGE.
   32.33 +-->
   32.34 +<body>
   32.35 +Provides a small and fast bytecode manipulation framework.
   32.36 +
   32.37 +<p>
   32.38 +	The <a href="http://www.objectweb.org/asm">ASM</a> framework is organized
   32.39 +	around the {@link clojure.asm.ClassVisitor ClassVisitor},
   32.40 +	{@link clojure.asm.FieldVisitor FieldVisitor} and
   32.41 +	{@link clojure.asm.MethodVisitor MethodVisitor} interfaces, which allow
   32.42 +	one to visit the fields and methods of a class, including the bytecode
   32.43 +	instructions of each method.
   32.44 +
   32.45 +<p>
   32.46 +	In addition to these main interfaces, ASM provides a {@link
   32.47 +	clojure.asm.ClassReader ClassReader} class, that can parse an
   32.48 +	existing class and make a given visitor visit it. ASM also provides
   32.49 +	a {@link clojure.asm.ClassWriter ClassWriter} class, which is
   32.50 +	a visitor that generates Java class files.
   32.51 +
   32.52 +<p>
   32.53 +	In order to generate a class from scratch, only the {@link
   32.54 +	clojure.asm.ClassWriter ClassWriter} class is necessary. Indeed,
   32.55 +	in order to generate a class, one must just call its visit<i>XXX</i>
   32.56 +	methods with the appropriate arguments to generate the desired fields
   32.57 +	and methods. See the "helloworld" example in the ASM distribution for
   32.58 +	more details about class generation.
   32.59 +
   32.60 +<p>
   32.61 +	In order to modify existing classes, one must use a {@link
   32.62 +	clojure.asm.ClassReader ClassReader} class to analyze
   32.63 +	the original class, a class modifier, and a {@link clojure.asm.ClassWriter
   32.64 +	ClassWriter} to construct the modified class. The class modifier
   32.65 +	is just a {@link clojure.asm.ClassVisitor ClassVisitor}
   32.66 +	that delegates most of the work to another {@link clojure.asm.ClassVisitor
   32.67 +	ClassVisitor}, but that sometimes changes some parameter values,
   32.68 +	or call additional methods, in order to implement the desired
   32.69 +	modification process. In order to make it easier to implement such
   32.70 +	class modifiers, ASM provides the {@link clojure.asm.ClassAdapter
   32.71 +	ClassAdapter} and {@link clojure.asm.MethodAdapter MethodAdapter}
   32.72 +	classes, which implement the {@link clojure.asm.ClassVisitor ClassVisitor}
   32.73 +	and {@link clojure.asm.MethodVisitor MethodVisitor} interfaces by
   32.74 +	delegating all work to other visitors. See the "adapt" example in the ASM
   32.75 +	distribution for more details about class modification.
   32.76 +
   32.77 +<p>
   32.78 +	The size of the core ASM library, <tt>asm.jar</tt>, is only 42KB, which is much
   32.79 +	smaller than the size of the
   32.80 +	<a href="http://jakarta.apache.org/bcel">BCEL</a> library (504KB), and than the
   32.81 +	size of the
   32.82 +	<a href="http://serp.sourceforge.net">SERP</a> library (150KB). ASM is also
   32.83 +	much faster than these tools. Indeed the overhead of a load time class
   32.84 +	transformation process is of the order of 60% with ASM, 700% or more with BCEL,
   32.85 +	and 1100% or more with SERP (see the <tt>test/perf</tt> directory in the ASM
   32.86 +	distribution)!
   32.87 +
   32.88 +	@since ASM 1.3
   32.89 +</body>
   32.90 +</html>
    33.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.2 +++ b/src/clojure/contrib/accumulators.clj	Sat Aug 21 06:25:44 2010 -0400
    33.3 @@ -0,0 +1,324 @@
    33.4 +;; Accumulators
    33.5 +
    33.6 +;; by Konrad Hinsen
    33.7 +;; last updated May 19, 2009
    33.8 +
    33.9 +;; This module defines various accumulators (list, vector, map,
   33.10 +;; sum, product, counter, and combinations thereof) with a common
   33.11 +;; interface defined by the multimethods add and combine.
   33.12 +;; For each accumulator type, its empty value is defined in this module.
   33.13 +;; Applications typically use this as a starting value and add data
   33.14 +;; using the add multimethod.
   33.15 +
   33.16 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   33.17 +;; and distribution terms for this software are covered by the Eclipse
   33.18 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   33.19 +;; which can be found in the file epl-v10.html at the root of this
   33.20 +;; distribution.  By using this software in any fashion, you are
   33.21 +;; agreeing to be bound by the terms of this license.  You must not
   33.22 +;; remove this notice, or any other, from this software.
   33.23 +
   33.24 +(ns
   33.25 +  ^{:author "Konrad Hinsen"
   33.26 +     :doc "A generic accumulator interface and implementations of various
   33.27 +           accumulators."}
   33.28 +  clojure.contrib.accumulators
   33.29 +  (:refer-clojure :exclude (deftype))
   33.30 +  (:use [clojure.contrib.types :only (deftype)])
   33.31 +  (:use [clojure.contrib.def :only (defvar defvar- defmacro-)])
   33.32 +  (:require [clojure.contrib.generic.arithmetic :as ga]))
   33.33 +
   33.34 +(defmulti add
   33.35 +  "Add item to the accumulator acc. The exact meaning of adding an
   33.36 +   an item depends on the type of the accumulator."
   33.37 +   {:arglists '([acc item])}
   33.38 +  (fn [acc item] (type acc)))
   33.39 +
   33.40 +(defn add-items
   33.41 +  "Add all elements of a collection coll to the accumulator acc."
   33.42 +  [acc items]
   33.43 +  (reduce add acc items))
   33.44 +
   33.45 +(defmulti combine
   33.46 +  "Combine the values of the accumulators acc1 and acc2 into a
   33.47 +   single accumulator of the same type."
   33.48 +  {:arglists '([& accs])}
   33.49 +  (fn [& accs] (type (first accs))))
   33.50 +
   33.51 +;
   33.52 +; An ::accumulator type tag is attached to tbe built-in types
   33.53 +; when used as accumulators, and new types are derived from it.
   33.54 +; Multimethods add and combine for ::accumulator sub-dispatch on class.
   33.55 +; We also define generic addition as the combine operation.
   33.56 +;
   33.57 +(let [meta-map {:type ::accumulator}]
   33.58 +  (defn- with-acc-tag
   33.59 +    [x]
   33.60 +    (with-meta x meta-map)))
   33.61 +
   33.62 +(defmethod add ::accumulator
   33.63 +  [a e]
   33.64 +  ((get-method add (class a)) a e))
   33.65 +
   33.66 +(defmethod combine ::accumulator
   33.67 +  [& as]
   33.68 +  (apply (get-method combine (class (first as))) as))
   33.69 +
   33.70 +(defmethod ga/+ ::accumulator
   33.71 +  [x y]
   33.72 +  (combine x y))
   33.73 +
   33.74 +;
   33.75 +; Vector accumulator
   33.76 +;
   33.77 +(defvar empty-vector (with-acc-tag [])
   33.78 +  "An empty vector accumulator. Adding an item appends it at the end.")
   33.79 +
   33.80 +(defmethod combine clojure.lang.IPersistentVector
   33.81 +  [& vs]
   33.82 +  (with-acc-tag (vec (apply concat vs))))
   33.83 +
   33.84 +(defmethod add clojure.lang.IPersistentVector
   33.85 +  [v e]
   33.86 +  (with-acc-tag (conj v e)))
   33.87 +
   33.88 +;
   33.89 +; List accumulator
   33.90 +;
   33.91 +(defvar empty-list (with-acc-tag '())
   33.92 +  "An empty list accumulator. Adding an item appends it at the beginning.")
   33.93 +
   33.94 +(defmethod combine clojure.lang.IPersistentList
   33.95 +  [& vs]
   33.96 +  (with-acc-tag (apply concat vs)))
   33.97 +
   33.98 +(defmethod add clojure.lang.IPersistentList
   33.99 +  [v e]
  33.100 +  (with-acc-tag (conj v e)))
  33.101 +
  33.102 +;
  33.103 +; Queue accumulator
  33.104 +;
  33.105 +(defvar empty-queue (with-acc-tag clojure.lang.PersistentQueue/EMPTY)
  33.106 +  "An empty queue accumulator. Adding an item appends it at the end.")
  33.107 +
  33.108 +(defmethod combine clojure.lang.PersistentQueue
  33.109 +  [& vs]
  33.110 +  (add-items (first vs) (apply concat (rest vs))))
  33.111 +
  33.112 +(defmethod add clojure.lang.PersistentQueue
  33.113 +  [v e]
  33.114 +  (with-acc-tag (conj v e)))
  33.115 +
  33.116 +;
  33.117 +; Set accumulator
  33.118 +;
  33.119 +(defvar empty-set (with-acc-tag #{})
  33.120 +  "An empty set accumulator.")
  33.121 +
  33.122 +(defmethod combine (class empty-set)
  33.123 +  [& vs]
  33.124 +  (with-acc-tag (apply clojure.set/union vs)))
  33.125 +
  33.126 +(defmethod add (class empty-set)
  33.127 +  [v e]
  33.128 +  (with-acc-tag (conj v e)))
  33.129 +
  33.130 +;
  33.131 +; String accumulator
  33.132 +;
  33.133 +(defvar empty-string ""
  33.134 +  "An empty string accumulator. Adding an item (string or character)
  33.135 +   appends it at the end.")
  33.136 +
  33.137 +(defmethod combine java.lang.String
  33.138 +  [& vs]
  33.139 +  (apply str vs))
  33.140 +
  33.141 +(defmethod add java.lang.String
  33.142 +  [v e]
  33.143 +  (str v e))
  33.144 +
  33.145 +;
  33.146 +; Map accumulator
  33.147 +;
  33.148 +(defvar empty-map (with-acc-tag {})
  33.149 +  "An empty map accumulator. Items to be added must be [key value] pairs.")
  33.150 +
  33.151 +(defmethod combine clojure.lang.IPersistentMap
  33.152 +  [& vs]
  33.153 +  (with-acc-tag (apply merge vs)))
  33.154 +
  33.155 +(defmethod add clojure.lang.IPersistentMap
  33.156 +  [v e]
  33.157 +  (with-acc-tag (conj v e)))
  33.158 +
  33.159 +;
  33.160 +; Numerical accumulators: sum, product, minimum, maximum
  33.161 +;
  33.162 +(defmacro- defacc
  33.163 +  [name op empty doc-string]
  33.164 +  (let [type-tag (keyword (str *ns*) (str name))
  33.165 +	empty-symbol (symbol (str "empty-" name))]
  33.166 +  `(let [op# ~op]
  33.167 +     (deftype ~type-tag ~name
  33.168 +       (fn [~'x] {:value ~'x})
  33.169 +       (fn [~'x] (list (:value ~'x))))
  33.170 +     (derive ~type-tag ::accumulator)
  33.171 +     (defvar ~empty-symbol (~name ~empty) ~doc-string)
  33.172 +     (defmethod combine ~type-tag [& vs#]
  33.173 +       (~name (apply op# (map :value vs#))))
  33.174 +     (defmethod add ~type-tag [v# e#]
  33.175 +       (~name (op# (:value v#) e#))))))
  33.176 +
  33.177 +(defacc sum + 0
  33.178 +  "An empty sum accumulator. Only numbers can be added.")
  33.179 +
  33.180 +(defacc product * 1
  33.181 +  "An empty sum accumulator. Only numbers can be added.")
  33.182 +
  33.183 +; The empty maximum accumulator should have value -infinity.
  33.184 +; This is represented by nil and taken into account in an
  33.185 +; adapted max function. In the minimum accumulator, nil is
  33.186 +; similarly used to represent +infinity.
  33.187 +
  33.188 +(defacc maximum (fn [& xs]
  33.189 +		  (when-let [xs (seq (filter identity xs))]
  33.190 +		      (apply max xs)))
  33.191 +                nil
  33.192 +  "An empty maximum accumulator. Only numbers can be added.")
  33.193 +
  33.194 +(defacc minimum (fn [& xs]
  33.195 +		  (when-let [xs (seq (filter identity xs))]
  33.196 +		      (apply min xs)))
  33.197 +                nil
  33.198 +  "An empty minimum accumulator. Only numbers can be added.")
  33.199 +
  33.200 +;
  33.201 +; Numeric min-max accumulator
  33.202 +; (combination of minimum and maximum)
  33.203 +;
  33.204 +(deftype ::min-max min-max
  33.205 +  (fn [min max] {:min min :max max})
  33.206 +  (fn [mm] (list (:min mm) (:max mm))))
  33.207 +
  33.208 +(derive ::min-max ::accumulator)
  33.209 +
  33.210 +(defvar empty-min-max (min-max nil nil)
  33.211 +  "An empty min-max accumulator, combining minimum and maximum.
  33.212 +   Only numbers can be added.")
  33.213 +
  33.214 +(defmethod combine ::min-max
  33.215 +  [& vs]
  33.216 +  (let [total-min (apply min (map :min vs))
  33.217 +	total-max (apply max (map :max vs))]
  33.218 +    (min-max total-min total-max)))
  33.219 +
  33.220 +(defmethod add ::min-max
  33.221 +  [v e]
  33.222 +  (let [min-v (:min v)
  33.223 +	max-v (:max v)
  33.224 +	new-min (if (nil? min-v) e (min min-v e))
  33.225 +	new-max (if (nil? max-v) e (max max-v e))]
  33.226 +    (min-max new-min new-max)))
  33.227 +
  33.228 +;
  33.229 +; Mean and variance accumulator
  33.230 +;
  33.231 +(deftype ::mean-variance mean-variance)
  33.232 +
  33.233 +(derive ::mean-variance ::accumulator)
  33.234 +
  33.235 +(defvar empty-mean-variance (mean-variance {:n 0 :mean 0 :variance 0})
  33.236 +  "An empty mean-variance accumulator, combining sample mean and
  33.237 +   sample variance. Only numbers can be added.")
  33.238 +
  33.239 +(defmethod combine ::mean-variance
  33.240 +  ([mv]
  33.241 +   mv)
  33.242 +
  33.243 +  ([mv1 mv2]
  33.244 +   (let [{n1 :n mean1 :mean var1 :variance} mv1
  33.245 +	 {n2 :n mean2 :mean var2 :variance} mv2
  33.246 +	 n (+ n1 n2)
  33.247 +	 mean (/ (+ (* n1 mean1) (* n2 mean2)) n)
  33.248 +	 sq #(* % %)
  33.249 +	 c    (+ (* n1 (sq (- mean mean1))) (* n2 (sq (- mean mean2))))
  33.250 +	 var  (if (< n 2)
  33.251 +		0
  33.252 +		(/ (+ c (* (dec n1) var1) (* (dec n2) var2)) (dec n)))]
  33.253 +     (mean-variance {:n n :mean mean :variance var})))
  33.254 +   
  33.255 +  ([mv1 mv2 & mvs]
  33.256 +   (reduce combine (combine mv1 mv2) mvs)))
  33.257 +
  33.258 +(defmethod add ::mean-variance
  33.259 +  [mv x]
  33.260 +  (let [{n :n mean :mean var :variance} mv
  33.261 +	n1 (inc n)
  33.262 +	d (- x mean)
  33.263 +	new-mean (+ mean (/ d n1))
  33.264 +	new-var (if (zero? n) 0 (/ (+ (* (dec n) var) (* d (- x new-mean))) n))]
  33.265 +    (mean-variance {:n n1 :mean new-mean :variance new-var})))
  33.266 +
  33.267 +;
  33.268 +; Counter accumulator
  33.269 +;
  33.270 +(deftype ::counter counter)
  33.271 +
  33.272 +(derive ::counter ::accumulator)
  33.273 +
  33.274 +(defvar empty-counter (counter {})
  33.275 +  "An empty counter accumulator. Its value is a map that stores for
  33.276 +   every item the number of times it was added.")
  33.277 +
  33.278 +(defmethod combine ::counter
  33.279 +  [v & vs]
  33.280 +  (letfn [(add-item [cntr [item n]]
  33.281 +		    (assoc cntr item (+ n (get cntr item 0))))
  33.282 +	  (add-two [c1 c2] (reduce add-item c1 c2))]
  33.283 +	 (reduce add-two v vs)))
  33.284 +
  33.285 +(defmethod add ::counter
  33.286 +  [v e]
  33.287 +  (assoc v e (inc (get v e 0))))
  33.288 +
  33.289 +;
  33.290 +; Counter accumulator with total count
  33.291 +;
  33.292 +(deftype ::counter-with-total counter-with-total)
  33.293 +(derive ::counter-with-total ::counter)
  33.294 +
  33.295 +(defvar empty-counter-with-total
  33.296 +  (counter-with-total {:total 0})
  33.297 +  "An empty counter-with-total accumulator. It works like the counter
  33.298 +   accumulator, except that the total number of items added is stored as the
  33.299 +   value of the key :total.")
  33.300 +
  33.301 +(defmethod add ::counter-with-total
  33.302 +  [v e]
  33.303 +  (assoc v e (inc (get v e 0))
  33.304 +	 :total (inc (:total v))))
  33.305 +
  33.306 +;
  33.307 +; Accumulator n-tuple
  33.308 +;
  33.309 +(deftype ::tuple acc-tuple)
  33.310 +
  33.311 +(derive ::tuple ::accumulator)
  33.312 +
  33.313 +(defn empty-tuple
  33.314 +  "Returns an accumulator tuple with the supplied empty-accumulators
  33.315 +   as its value. Accumulator tuples consist of several accumulators that
  33.316 +   work in parallel. Added items must be sequences whose number of elements
  33.317 +   matches the number of sub-accumulators."
  33.318 +  [empty-accumulators]
  33.319 +  (acc-tuple (into [] empty-accumulators)))
  33.320 +
  33.321 +(defmethod combine ::tuple
  33.322 +  [& vs]
  33.323 +  (acc-tuple (vec (map combine vs))))
  33.324 +
  33.325 +(defmethod add ::tuple
  33.326 +  [v e]
  33.327 +  (acc-tuple (vec (map add v e))))
    34.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.2 +++ b/src/clojure/contrib/agent_utils.clj	Sat Aug 21 06:25:44 2010 -0400
    34.3 @@ -0,0 +1,35 @@
    34.4 +;   Copyright (c) Christophe Grand, November 2008. All rights reserved.
    34.5 +
    34.6 +;   The use and distribution terms for this software are covered by the
    34.7 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    34.8 +;   which can be found in the file epl-v10.html at the root of this 
    34.9 +;   distribution.
   34.10 +;   By using this software in any fashion, you are agreeing to be bound by
   34.11 +;   the terms of this license.
   34.12 +;   You must not remove this notice, or any other, from this software.
   34.13 +
   34.14 +;; misc agent utilities
   34.15 +
   34.16 +;; note to other contrib members: feel free to add to this lib
   34.17 +
   34.18 +(ns
   34.19 +    ^{:author "Christophe Grande",
   34.20 +       :doc "Miscellaneous agent utilities
   34.21 + (note to other contrib members: feel free to add to this lib)",
   34.22 +}
   34.23 +  clojure.contrib.agent-utils)
   34.24 +
   34.25 +(defmacro capture-and-send
   34.26 + "Capture the current value of the specified vars and rebind 
   34.27 +  them on the agent thread before executing the action.
   34.28 +  
   34.29 +  Example:
   34.30 +    (capture-and-send [*out*] a f b c)"
   34.31 +    
   34.32 + [vars agent action & args]
   34.33 +  (let [locals (map #(gensym (name %)) vars)]
   34.34 +    `(let [~@(interleave locals vars)
   34.35 +           action# (fn [& args#]
   34.36 +                     (binding [~@(interleave vars locals)]
   34.37 +                       (apply ~action args#)))]
   34.38 +       (send ~agent action# ~@args))))
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/clojure/contrib/apply_macro.clj	Sat Aug 21 06:25:44 2010 -0400
    35.3 @@ -0,0 +1,45 @@
    35.4 +;;; apply_macro.clj: make macros behave like functions
    35.5 +
    35.6 +;; by Stuart Sierra, http://stuartsierra.com/
    35.7 +;; January 28, 2009
    35.8 +
    35.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   35.10 +;; and distribution terms for this software are covered by the Eclipse
   35.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   35.12 +;; which can be found in the file epl-v10.html at the root of this
   35.13 +;; distribution.  By using this software in any fashion, you are
   35.14 +;; agreeing to be bound by the terms of this license.  You must not
   35.15 +;; remove this notice, or any other, from this software.
   35.16 +
   35.17 +
   35.18 +;; Don't use this.  I mean it.  It's evil.  How evil?  You can't
   35.19 +;; handle it, that's how evil it is.  That's right.  I did it so you
   35.20 +;; don't have to, ok?  Look but don't touch.  Use this lib and you'll
   35.21 +;; go blind.
   35.22 +
   35.23 +;; DEPRECATED in 1.2 with no replacement.
   35.24 +
   35.25 +(ns ^{:deprecated "1.2"}
   35.26 +  clojure.contrib.apply-macro)
   35.27 +
   35.28 +;; Copied from clojure.core/spread, which is private.
   35.29 +(defn- spread
   35.30 +  "Flatten final argument list as in apply."
   35.31 +  [arglist]
   35.32 +  (cond
   35.33 +   (nil? arglist) nil
   35.34 +   (nil? (rest arglist)) (seq (first arglist))
   35.35 +   :else (cons (first arglist) (spread (rest arglist)))))
   35.36 +
   35.37 +(defmacro apply-macro
   35.38 +  "This is evil.  Don't ever use it.  It makes a macro behave like a
   35.39 +  function.  Seriously, how messed up is that?
   35.40 +
   35.41 +  Evaluates all args, then uses them as arguments to the macro as with
   35.42 +  apply.
   35.43 +
   35.44 +  (def things [true true false])
   35.45 +  (apply-macro and things)
   35.46 +  ;; Expands to:  (and true true false)"
   35.47 +  [macro & args]
   35.48 +  (cons macro (spread (map eval args))))
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/clojure/contrib/base64.clj	Sat Aug 21 06:25:44 2010 -0400
    36.3 @@ -0,0 +1,99 @@
    36.4 +;;; base64.clj: Experimental Base-64 encoding and (later) decoding
    36.5 +
    36.6 +;; by Stuart Sierra, http://stuartsierra.com/
    36.7 +;; August 19, 2009
    36.8 +
    36.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   36.10 +;; and distribution terms for this software are covered by the Eclipse
   36.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   36.12 +;; which can be found in the file epl-v10.html at the root of this
   36.13 +;; distribution.  By using this software in any fashion, you are
   36.14 +;; agreeing to be bound by the terms of this license.  You must not
   36.15 +;; remove this notice, or any other, from this software.
   36.16 +
   36.17 +
   36.18 +(ns ^{:doc "Base-64 encoding and (maybe later) decoding.  
   36.19 +
   36.20 +  This is mainly here as an example.  It is much slower than the
   36.21 +  Apache Commons Codec implementation or sun.misc.BASE64Encoder."
   36.22 +       :author "Stuart Sierra"}
   36.23 +    clojure.contrib.base64
   36.24 +  (:import (java.io InputStream Writer ByteArrayInputStream
   36.25 +                    StringWriter)))
   36.26 +
   36.27 +(def *base64-alphabet*
   36.28 +     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=")
   36.29 +
   36.30 +(defn encode
   36.31 +  "Encodes bytes of input, writing Base 64 text on output.  alphabet
   36.32 +  is a 65-character String containing the 64 characters to use in the
   36.33 +  encoding; the 65th character is the pad character.  line-length is
   36.34 +  the maximum number of characters per line, nil for no line breaks."
   36.35 +  [^InputStream input ^Writer output ^String alphabet line-length]
   36.36 +  (let [buffer (make-array Byte/TYPE 3)]
   36.37 +    (loop [line 0]
   36.38 +      (let [len (.read input buffer)]
   36.39 +        (when (pos? len)
   36.40 +          ;; Pre-boxing the bytes as Integers is more efficient for
   36.41 +          ;; Clojure's bit operations.
   36.42 +          (let [b0 (Integer/valueOf (int (aget buffer 0)))
   36.43 +                b1 (Integer/valueOf (int (aget buffer 1)))
   36.44 +                b2 (Integer/valueOf (int (aget buffer 2)))]
   36.45 +            (cond (= len 3)
   36.46 +                  (let [s0 (bit-and 0x3F (bit-shift-right b0 2))
   36.47 +                        s1 (bit-and 0x3F
   36.48 +                                    (bit-or (bit-shift-left b0 4)
   36.49 +                                            (bit-shift-right b1 4)))
   36.50 +                        s2 (bit-and 0x3F
   36.51 +                                    (bit-or (bit-shift-left b1 2)
   36.52 +                                            (bit-shift-right b2 6)))
   36.53 +                        s3 (bit-and 0x3F b2)]
   36.54 +                    (.append output (.charAt alphabet s0))
   36.55 +                    (.append output (.charAt alphabet s1))
   36.56 +                    (.append output (.charAt alphabet s2))
   36.57 +                    (.append output (.charAt alphabet s3)))
   36.58 +
   36.59 +                  (= len 2)
   36.60 +                  (let [s0 (bit-and 0x3F (bit-shift-right b0 2))
   36.61 +                        s1 (bit-and 0x3F
   36.62 +                                    (bit-or (bit-shift-left b0 4)
   36.63 +                                            (bit-shift-right b1 4)))
   36.64 +                        s2 (bit-and 0x3F (bit-shift-left b1 2))]
   36.65 +                    (.append output (.charAt alphabet s0))
   36.66 +                    (.append output (.charAt alphabet s1))
   36.67 +                    (.append output (.charAt alphabet s2))
   36.68 +                    (.append output (.charAt alphabet 64)))
   36.69 +
   36.70 +                  (= len 1)
   36.71 +                  (let [s0 (bit-and 0x3F (bit-shift-right b0 2))
   36.72 +                        s1 (bit-and 0x3F (bit-shift-left b0 4))]
   36.73 +                    (.append output (.charAt alphabet s0))
   36.74 +                    (.append output (.charAt alphabet s1))
   36.75 +                    (.append output (.charAt alphabet 64))
   36.76 +                    (.append output (.charAt alphabet 64)))))
   36.77 +            (if (and line-length (> (+ line 4) line-length))
   36.78 +              (do (.append output \newline)
   36.79 +                  (recur 0))
   36.80 +              (recur (+ line 4))))))))
   36.81 +
   36.82 +(defn encode-str
   36.83 +  "Encodes String in base 64; returns a String.  If not specified,
   36.84 +  encoding is UTF-8 and line-length is nil."
   36.85 +  ([s] (encode-str s "UTF-8" nil))
   36.86 +  ([^String s ^String encoding line-length]
   36.87 +     (let [output (StringWriter.)]
   36.88 +       (encode (ByteArrayInputStream. (.getBytes s encoding))
   36.89 +               output *base64-alphabet* line-length)
   36.90 +       (.toString output))))
   36.91 +
   36.92 +
   36.93 +;;; tests 
   36.94 +
   36.95 +;; (deftest t-encode-str
   36.96 +;;   (is (= (encode-str "") ""))
   36.97 +;;   (is (= (encode-str "f") "Zg=="))
   36.98 +;;   (is (= (encode-str "fo") "Zm8="))
   36.99 +;;   (is (= (encode-str "foo") "Zm9v"))
  36.100 +;;   (is (= (encode-str "foob") "Zm9vYg=="))
  36.101 +;;   (is (= (encode-str "fooba") "Zm9vYmE="))
  36.102 +;;   (is (= (encode-str "foobar") "Zm9vYmFy")))
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/clojure/contrib/classpath.clj	Sat Aug 21 06:25:44 2010 -0400
    37.3 @@ -0,0 +1,39 @@
    37.4 +;;; classpath.clj: utilities for working with the Java class path
    37.5 +
    37.6 +;; by Stuart Sierra, http://stuartsierra.com/
    37.7 +;; April 19, 2009
    37.8 +
    37.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   37.10 +;; and distribution terms for this software are covered by the Eclipse
   37.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   37.12 +;; which can be found in the file epl-v10.html at the root of this
   37.13 +;; distribution.  By using this software in any fashion, you are
   37.14 +;; agreeing to be bound by the terms of this license.  You must not
   37.15 +;; remove this notice, or any other, from this software.
   37.16 +
   37.17 +
   37.18 +(ns 
   37.19 +  ^{:author "Stuart Sierra",
   37.20 +     :doc "Utilities for dealing with the JVM's classpath"}
   37.21 +  clojure.contrib.classpath
   37.22 +  (:require [clojure.contrib.jar :as jar])
   37.23 +  (:import (java.io File)
   37.24 +           (java.util.jar JarFile)))
   37.25 +
   37.26 +(defn classpath
   37.27 +  "Returns a sequence of File objects of the elements on CLASSPATH."
   37.28 +  []
   37.29 +  (map #(File. %)
   37.30 +       (.split (System/getProperty "java.class.path")
   37.31 +               (System/getProperty "path.separator"))))
   37.32 +
   37.33 +(defn classpath-directories
   37.34 +  "Returns a sequence of File objects for the directories on classpath."
   37.35 +  []
   37.36 +  (filter #(.isDirectory %) (classpath)))
   37.37 +
   37.38 +(defn classpath-jarfiles
   37.39 +  "Returns a sequence of JarFile objects for the JAR files on classpath."
   37.40 +  []
   37.41 +  (map #(JarFile. %) (filter jar/jar-file? (classpath))))
   37.42 +
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/clojure/contrib/combinatorics.clj	Sat Aug 21 06:25:44 2010 -0400
    38.3 @@ -0,0 +1,164 @@
    38.4 +;;; combinatorics.clj: efficient, functional algorithms for generating lazy
    38.5 +;;; sequences for common combinatorial functions.
    38.6 +
    38.7 +;; by Mark Engelberg (mark.engelberg@gmail.com)
    38.8 +;; January 27, 2009
    38.9 +
   38.10 +(comment
   38.11 +"  
   38.12 +(combinations items n) - A lazy sequence of all the unique
   38.13 +ways of taking n different elements from items.
   38.14 +Example: (combinations [1 2 3] 2) -> ((1 2) (1 3) (2 3))
   38.15 +
   38.16 +(subsets items) - A lazy sequence of all the subsets of
   38.17 +items (but generalized to all sequences, not just sets).
   38.18 +Example: (subsets [1 2 3]) -> (() (1) (2) (3) (1 2) (1 3) (2 3) (1 2 3))
   38.19 +
   38.20 +(cartesian-product & seqs) - Takes any number of sequences
   38.21 +as arguments, and returns a lazy sequence of all the ways
   38.22 +to take one item from each seq.
   38.23 +Example: (cartesian-product [1 2] [3 4]) -> ((1 3) (1 4) (2 3) (2 4))
   38.24 +(cartesian-product seq1 seq2 seq3 ...) behaves like but is
   38.25 +faster than a nested for loop, such as:
   38.26 +(for [i1 seq1 i2 seq2 i3 seq3 ...] (list i1 i2 i3 ...))
   38.27 +
   38.28 +(selections items n) - A lazy sequence of all the ways to
   38.29 +take n (possibly the same) items from the sequence of items.
   38.30 +Example: (selections [1 2] 3) -> ((1 1 1) (1 1 2) (1 2 1) (1 2 2) (2 1 1) (2 1 2) (2 2 1) (2 2 2))
   38.31 +
   38.32 +(permutations items) - A lazy sequence of all the permutations
   38.33 +of items.
   38.34 +Example: (permutations [1 2 3]) -> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
   38.35 +
   38.36 +(lex-permutations items) - A lazy sequence of all distinct
   38.37 +permutations in lexicographic order
   38.38 +(this function returns the permutations as
   38.39 +vectors).  Only works on sequences of comparable
   38.40 +items.  (Note that the result will be quite different from
   38.41 +permutations when the sequence contains duplicate items.)  
   38.42 +Example: (lex-permutations [1 1 2]) -> ([1 1 2] [1 2 1] [2 1 1])
   38.43 +
   38.44 +About permutations vs. lex-permutations:
   38.45 +lex-permutations is faster than permutations, but only works
   38.46 +on sequences of numbers.  They operate differently
   38.47 +on sequences with duplicate items (lex-permutations will only
   38.48 +give you back distinct permutations).  lex-permutations always
   38.49 +returns the permutations sorted lexicographically whereas
   38.50 +permutations will be in an order where the input sequence
   38.51 +comes first.  In general, I recommend using the regular
   38.52 +permutations function unless you have a specific
   38.53 +need for lex-permutations.
   38.54 +
   38.55 +About this code:
   38.56 +These combinatorial functions can be written in an elegant way using recursion.  However, when dealing with combinations and permutations, you're usually generating large numbers of things, and speed counts.  My objective was to write the fastest possible code I could, restricting myself to Clojure's functional, persistent data structures (rather than using Java's arrays) so that this code could be safely leveraged within Clojure's transactional concurrency system.
   38.57 +
   38.58 +I also restricted myself to algorithms that return results in a standard order.  For example, there are faster ways to generate cartesian-product, but I don't know of a faster way to generate the results in the standard nested-for-loop order.
   38.59 +
   38.60 +Most of these algorithms are derived from algorithms found in Knuth's wonderful Art of Computer Programming books (specifically, the volume 4 fascicles), which present fast, iterative solutions to these common combinatorial problems.  Unfortunately, these iterative versions are somewhat inscrutable.  If you want to better understand these algorithms, the Knuth books are the place to start.
   38.61 +
   38.62 +On my own computer, I use versions of all these algorithms that return sequences built with an uncached variation of lazy-seq.  Not only does this boost performance, but it's easier to use these rather large sequences more safely (from a memory consumption standpoint).  If some form of uncached sequences makes it into Clojure, I will update this accordingly.
   38.63 +"
   38.64 +)
   38.65 +
   38.66 +
   38.67 +(ns
   38.68 +  ^{:author "Mark Engelberg",
   38.69 +     :doc "Efficient, functional algorithms for generating lazy
   38.70 +sequences for common combinatorial functions. (See the source code 
   38.71 +for a longer description.)"}
   38.72 +  clojure.contrib.combinatorics)
   38.73 +
   38.74 +(defn- index-combinations
   38.75 +  [n cnt]
   38.76 +  (lazy-seq
   38.77 +   (let [c (vec (cons nil (for [j (range 1 (inc n))] (+ j cnt (- (inc n)))))),
   38.78 +	 iter-comb
   38.79 +	 (fn iter-comb [c j]
   38.80 +	   (if (> j n) nil
   38.81 +	       (let [c (assoc c j (dec (c j)))]
   38.82 +		 (if (< (c j) j) [c (inc j)]
   38.83 +		     (loop [c c, j j]
   38.84 +		       (if (= j 1) [c j]
   38.85 +			   (recur (assoc c (dec j) (dec (c j))) (dec j)))))))),
   38.86 +	 step
   38.87 +	 (fn step [c j]
   38.88 +	   (cons (rseq (subvec c 1 (inc n)))
   38.89 +		 (lazy-seq (let [next-step (iter-comb c j)]
   38.90 +			     (when next-step (step (next-step 0) (next-step 1)))))))]
   38.91 +     (step c 1))))
   38.92 +
   38.93 +(defn combinations
   38.94 +  "All the unique ways of taking n different elements from items"
   38.95 +  [items n]      
   38.96 +  (let [v-items (vec (reverse items))]
   38.97 +    (if (zero? n) (list ())
   38.98 +	(let [cnt (count items)]
   38.99 +	  (cond (> n cnt) nil
  38.100 +		(= n cnt) (list (seq items))
  38.101 +		:else
  38.102 +		(map #(map v-items %) (index-combinations n cnt)))))))
  38.103 +
  38.104 +(defn subsets
  38.105 +  "All the subsets of items"
  38.106 +  [items]
  38.107 +  (mapcat (fn [n] (combinations items n))
  38.108 +	  (range (inc (count items)))))
  38.109 +
  38.110 +(defn cartesian-product
  38.111 +  "All the ways to take one item from each sequence"
  38.112 +  [& seqs]
  38.113 +  (let [v-original-seqs (vec seqs)
  38.114 +	step
  38.115 +	(fn step [v-seqs]
  38.116 +	  (let [increment
  38.117 +		(fn [v-seqs]
  38.118 +		  (loop [i (dec (count v-seqs)), v-seqs v-seqs]
  38.119 +		    (if (= i -1) nil
  38.120 +			(if-let [rst (next (v-seqs i))]
  38.121 +			  (assoc v-seqs i rst)
  38.122 +			  (recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))]
  38.123 +	    (when v-seqs
  38.124 +	       (cons (map first v-seqs)
  38.125 +		     (lazy-seq (step (increment v-seqs)))))))]
  38.126 +    (when (every? first seqs)
  38.127 +      (lazy-seq (step v-original-seqs)))))
  38.128 +
  38.129 +
  38.130 +(defn selections
  38.131 +  "All the ways of taking n (possibly the same) elements from the sequence of items"
  38.132 +  [items n]
  38.133 +  (apply cartesian-product (take n (repeat items))))
  38.134 +
  38.135 +
  38.136 +(defn- iter-perm [v]
  38.137 +  (let [len (count v),
  38.138 +	j (loop [i (- len 2)]
  38.139 +	     (cond (= i -1) nil
  38.140 +		   (< (v i) (v (inc i))) i
  38.141 +		   :else (recur (dec i))))]
  38.142 +    (when j
  38.143 +      (let [vj (v j),
  38.144 +	    l (loop [i (dec len)]
  38.145 +		(if (< vj (v i)) i (recur (dec i))))]
  38.146 +	(loop [v (assoc v j (v l) l vj), k (inc j), l (dec len)]
  38.147 +	  (if (< k l)
  38.148 +	    (recur (assoc v k (v l) l (v k)) (inc k) (dec l))
  38.149 +	    v))))))
  38.150 +
  38.151 +(defn- vec-lex-permutations [v]
  38.152 +  (when v (cons v (lazy-seq (vec-lex-permutations (iter-perm v))))))
  38.153 +
  38.154 +(defn lex-permutations
  38.155 +  "Fast lexicographic permutation generator for a sequence of numbers"
  38.156 +  [c]
  38.157 +  (lazy-seq
  38.158 +   (let [vec-sorted (vec (sort c))]
  38.159 +     (if (zero? (count vec-sorted))
  38.160 +       (list [])
  38.161 +       (vec-lex-permutations vec-sorted)))))
  38.162 +  
  38.163 +(defn permutations
  38.164 +  "All the permutations of items, lexicographic by index"
  38.165 +  [items]
  38.166 +  (let [v (vec items)]
  38.167 +    (map #(map v %) (lex-permutations (range (count v))))))
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/clojure/contrib/command_line.clj	Sat Aug 21 06:25:44 2010 -0400
    39.3 @@ -0,0 +1,121 @@
    39.4 +;   Copyright (c) Chris Houser, Nov-Dec 2008. All rights reserved.
    39.5 +;   The use and distribution terms for this software are covered by the
    39.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    39.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
    39.8 +;   By using this software in any fashion, you are agreeing to be bound by
    39.9 +;   the terms of this license.
   39.10 +;   You must not remove this notice, or any other, from this software.
   39.11 +
   39.12 +; Process command-line arguments according to a given cmdspec
   39.13 +
   39.14 +(ns 
   39.15 +    ^{:author "Chris Houser", 
   39.16 +       :doc "Process command-line arguments according to a given cmdspec"}
   39.17 +    clojure.contrib.command-line
   39.18 +    (:use     (clojure.contrib [string :only (join)])))
   39.19 +
   39.20 +(defn make-map [args cmdspec]
   39.21 +  (let [{spec true [rest-sym] false} (group-by vector? cmdspec)
   39.22 +        rest-str (str rest-sym)
   39.23 +        key-data (into {} (for [[syms [_ default]] (map #(split-with symbol? %)
   39.24 +                                                        (conj spec '[help? h?]))
   39.25 +                                sym syms]
   39.26 +                            [(re-find #"^.*[^?]" (str sym))
   39.27 +                             {:sym (str (first syms)) :default default}]))
   39.28 +        defaults (into {} (for [[_ {:keys [default sym]}] key-data
   39.29 +                                :when default]
   39.30 +                            [sym default]))]
   39.31 +    (loop [[argkey & [argval :as r]] args
   39.32 +           cmdmap (assoc defaults :cmdspec cmdspec rest-str [])]
   39.33 +      (if argkey
   39.34 +        (let [[_ & [keybase]] (re-find #"^--?(.*)" argkey)]
   39.35 +          (cond
   39.36 +            (= keybase nil) (recur r (update-in cmdmap [rest-str] conj argkey))
   39.37 +            (= keybase "")  (update-in cmdmap [rest-str] #(apply conj % r))
   39.38 +            :else (if-let [found (key-data keybase)]
   39.39 +                    (if (= \? (last (:sym found)))
   39.40 +                      (recur r (assoc cmdmap (:sym found) true))
   39.41 +                      (recur (next r) (assoc cmdmap (:sym found)
   39.42 +                                             (if (or (nil? r) (= \- (ffirst r)))
   39.43 +                                               (:default found)
   39.44 +                                               (first r)))))
   39.45 +                    (throw (Exception. (str "Unknown option " argkey))))))
   39.46 +        cmdmap))))
   39.47 +
   39.48 +(defn- align
   39.49 +   "Align strings given as vectors of columns, with first vector
   39.50 +   specifying right or left alignment (:r or :l) for each column."
   39.51 +   [spec & rows]
   39.52 +   (let [maxes (vec (for [n (range (count (first rows)))]
   39.53 +                        (apply max (map (comp count #(nth % n)) rows))))
   39.54 +         fmt (join " " 
   39.55 +                  (for [n (range (count maxes))] 
   39.56 +                     (str "%" 
   39.57 +                        (when-not (zero? (maxes n))
   39.58 +                           (str (when (= (spec n) :l) "-") (maxes n))) 
   39.59 +                          "s")))]
   39.60 +      (join "\n"
   39.61 +         (for [row rows]
   39.62 +            (apply format fmt row)))))
   39.63 +
   39.64 +(defn- rmv-q
   39.65 +   "Remove ?"
   39.66 +   [^String s]
   39.67 +   (if (.endsWith s "?")
   39.68 +      (.substring s 0 (dec (count s)))
   39.69 +      s))
   39.70 +
   39.71 +(defn print-help [desc cmdmap]
   39.72 +  (println desc)
   39.73 +  (println "Options")
   39.74 +  (println 
   39.75 +     (apply align [:l :l :l] 
   39.76 +        (for [spec (:cmdspec cmdmap) :when (vector? spec)]
   39.77 +            (let [[argnames [text default]] (split-with symbol? spec)
   39.78 +                  [_ opt q] (re-find #"^(.*[^?])(\??)$"
   39.79 +                                 (str (first argnames)))
   39.80 +                  argnames  (map (comp rmv-q str) argnames)
   39.81 +                  argnames
   39.82 +                        (join ", "
   39.83 +                          (for [arg argnames]
   39.84 +                            (if (= 1 (count arg))
   39.85 +                              (str "-" arg)
   39.86 +                              (str "--" arg))))]
   39.87 +               [(str "  " argnames (when (= "" q) " <arg>") " ")
   39.88 +                text 
   39.89 +                (if-not default
   39.90 +                  ""
   39.91 +                  (str " [default " default "]"))])))))
   39.92 +
   39.93 +(defmacro with-command-line 
   39.94 +  "Bind locals to command-line args."
   39.95 +  [args desc cmdspec & body]
   39.96 +  (let [locals (vec (for [spec cmdspec]
   39.97 +                      (if (vector? spec)
   39.98 +                        (first spec)
   39.99 +                        spec)))]
  39.100 +    `(let [{:strs ~locals :as cmdmap#} (make-map ~args '~cmdspec)]
  39.101 +       (if (cmdmap# "help?")
  39.102 +         (print-help ~desc cmdmap#)
  39.103 +         (do ~@body)))))
  39.104 +
  39.105 +(comment
  39.106 +
  39.107 +; example of usage:
  39.108 +
  39.109 +(with-command-line *command-line-args*
  39.110 +  "tojs -- Compile ClojureScript to JavaScript"
  39.111 +  [[simple? s? "Runs some simple built-in tests"]
  39.112 +   [serve      "Starts a repl server on the given port" 8081]
  39.113 +   [mkboot?    "Generates a boot.js file"]
  39.114 +   [verbose? v? "Includes extra fn names and comments in js"]
  39.115 +   filenames]
  39.116 +  (binding [*debug-fn-names* verbose? *debug-comments* verbose?]
  39.117 +    (cond
  39.118 +      simple? (simple-tests)
  39.119 +      serve   (start-server (Integer/parseInt serve))
  39.120 +      mkboot? (mkboot)
  39.121 +      :else   (doseq [filename filenames]
  39.122 +                 (filetojs filename)))))
  39.123 +
  39.124 +)
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/clojure/contrib/complex_numbers.clj	Sat Aug 21 06:25:44 2010 -0400
    40.3 @@ -0,0 +1,293 @@
    40.4 +;; Complex numbers
    40.5 +
    40.6 +;; by Konrad Hinsen
    40.7 +;; last updated May 4, 2009
    40.8 +
    40.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   40.10 +;; and distribution terms for this software are covered by the Eclipse
   40.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   40.12 +;; which can be found in the file epl-v10.html at the root of this
   40.13 +;; distribution.  By using this software in any fashion, you are
   40.14 +;; agreeing to be bound by the terms of this license.  You must not
   40.15 +;; remove this notice, or any other, from this software.
   40.16 +
   40.17 +(ns
   40.18 +  ^{:author "Konrad Hinsen"
   40.19 +     :doc "Complex numbers
   40.20 +           NOTE: This library is in evolution. Most math functions are
   40.21 +                 not implemented yet."}
   40.22 +  clojure.contrib.complex-numbers
   40.23 +  (:refer-clojure :exclude (deftype))
   40.24 +  (:use [clojure.contrib.types :only (deftype)]
   40.25 +	[clojure.contrib.generic :only (root-type)])
   40.26 +  (:require [clojure.contrib.generic.arithmetic :as ga]
   40.27 +	    [clojure.contrib.generic.comparison :as gc]
   40.28 +	    [clojure.contrib.generic.math-functions :as gm]))
   40.29 +
   40.30 +;
   40.31 +; Complex numbers are represented as struct maps. The real and imaginary
   40.32 +; parts can be of any type for which arithmetic and maths functions
   40.33 +; are defined.
   40.34 +;
   40.35 +(defstruct complex-struct :real :imag)
   40.36 +
   40.37 +;
   40.38 +; The general complex number type
   40.39 +;
   40.40 +(deftype ::complex complex
   40.41 +  (fn [real imag] (struct complex-struct real imag))
   40.42 +  (fn [c] (vals c)))
   40.43 +
   40.44 +(derive ::complex root-type)
   40.45 +
   40.46 +;
   40.47 +; A specialized subtype for pure imaginary numbers. Introducing this type
   40.48 +; reduces the number of operations by eliminating additions with and
   40.49 +; multiplications by zero.
   40.50 +;
   40.51 +(deftype ::pure-imaginary imaginary
   40.52 +  (fn [imag] (struct complex-struct 0 imag))
   40.53 +  (fn [c] (list (:imag c))))
   40.54 +
   40.55 +(derive ::pure-imaginary ::complex)
   40.56 +
   40.57 +;
   40.58 +; Extraction of real and imaginary parts
   40.59 +;
   40.60 +(def real (accessor complex-struct :real))
   40.61 +(def imag (accessor complex-struct :imag))
   40.62 +
   40.63 +;
   40.64 +; Equality and zero test
   40.65 +;
   40.66 +(defmethod gc/zero? ::complex
   40.67 +  [x]
   40.68 +  (let [[rx ix] (vals x)]
   40.69 +    (and (zero? rx) (zero? ix))))
   40.70 +
   40.71 +(defmethod gc/= [::complex ::complex]
   40.72 +  [x y]
   40.73 +  (let [[rx ix] (vals x)
   40.74 +	[ry iy] (vals y)]
   40.75 +    (and (gc/= rx ry) (gc/= ix iy))))
   40.76 +
   40.77 +(defmethod gc/= [::pure-imaginary ::pure-imaginary]
   40.78 +  [x y]
   40.79 +  (gc/= (imag x) (imag y)))
   40.80 +
   40.81 +(defmethod gc/= [::complex ::pure-imaginary]
   40.82 +  [x y]
   40.83 +  (let [[rx ix] (vals x)]
   40.84 +    (and (gc/zero? rx) (gc/= ix (imag y)))))
   40.85 +
   40.86 +(defmethod gc/= [::pure-imaginary ::complex]
   40.87 +  [x y]
   40.88 +  (let [[ry iy] (vals y)]
   40.89 +    (and (gc/zero? ry) (gc/= (imag x) iy))))
   40.90 +
   40.91 +(defmethod gc/= [::complex root-type]
   40.92 +  [x y]
   40.93 +  (let [[rx ix] (vals x)]
   40.94 +    (and (gc/zero? ix) (gc/= rx y))))
   40.95 +
   40.96 +(defmethod gc/= [root-type ::complex]
   40.97 +  [x y]
   40.98 +  (let [[ry iy] (vals y)]
   40.99 +    (and (gc/zero? iy) (gc/= x ry))))
  40.100 +
  40.101 +(defmethod gc/= [::pure-imaginary root-type]
  40.102 +  [x y]
  40.103 +  (and (gc/zero? (imag x)) (gc/zero? y)))
  40.104 +
  40.105 +(defmethod gc/= [root-type ::pure-imaginary]
  40.106 +  [x y]
  40.107 +  (and (gc/zero? x) (gc/zero? (imag y))))
  40.108 +
  40.109 +;
  40.110 +; Addition
  40.111 +;
  40.112 +(defmethod ga/+ [::complex ::complex]
  40.113 +  [x y]
  40.114 +  (let [[rx ix] (vals x)
  40.115 +	[ry iy] (vals y)]
  40.116 +    (complex (ga/+ rx ry) (ga/+ ix iy))))
  40.117 +
  40.118 +(defmethod ga/+ [::pure-imaginary ::pure-imaginary]
  40.119 +  [x y]
  40.120 +  (imaginary (ga/+ (imag x) (imag y))))
  40.121 +
  40.122 +(defmethod ga/+ [::complex ::pure-imaginary]
  40.123 +  [x y]
  40.124 +  (let [[rx ix] (vals x)]
  40.125 +    (complex rx (ga/+ ix (imag y)))))
  40.126 +
  40.127 +(defmethod ga/+ [::pure-imaginary ::complex]
  40.128 +  [x y]
  40.129 +  (let [[ry iy] (vals y)]
  40.130 +    (complex ry (ga/+ (imag x) iy))))
  40.131 +
  40.132 +(defmethod ga/+ [::complex root-type]
  40.133 +  [x y]
  40.134 +  (let [[rx ix] (vals x)]
  40.135 +    (complex (ga/+ rx y) ix)))
  40.136 +
  40.137 +(defmethod ga/+ [root-type ::complex]
  40.138 +  [x y]
  40.139 +  (let [[ry iy] (vals y)]
  40.140 +    (complex (ga/+ x ry) iy)))
  40.141 +
  40.142 +(defmethod ga/+ [::pure-imaginary root-type]
  40.143 +  [x y]
  40.144 +  (complex y (imag x)))
  40.145 +
  40.146 +(defmethod ga/+ [root-type ::pure-imaginary]
  40.147 +  [x y]
  40.148 +  (complex x (imag y)))
  40.149 +
  40.150 +;
  40.151 +; Negation
  40.152 +;
  40.153 +(defmethod ga/- ::complex
  40.154 +  [x]
  40.155 +  (let [[rx ix] (vals x)]
  40.156 +    (complex (ga/- rx) (ga/- ix))))
  40.157 +
  40.158 +(defmethod ga/- ::pure-imaginary
  40.159 +  [x]
  40.160 +  (imaginary (ga/- (imag x))))
  40.161 +
  40.162 +;
  40.163 +; Subtraction is automatically supplied by ga/-, optimized implementations
  40.164 +; can be added later...
  40.165 +;
  40.166 +
  40.167 +;
  40.168 +; Multiplication
  40.169 +;
  40.170 +(defmethod ga/* [::complex ::complex]
  40.171 +  [x y]
  40.172 +  (let [[rx ix] (vals x)
  40.173 +	[ry iy] (vals y)]
  40.174 +    (complex (ga/- (ga/* rx ry) (ga/* ix iy))
  40.175 +	     (ga/+ (ga/* rx iy) (ga/* ix ry)))))
  40.176 +
  40.177 +(defmethod ga/* [::pure-imaginary ::pure-imaginary]
  40.178 +  [x y]
  40.179 +  (ga/- (ga/* (imag x) (imag y))))
  40.180 +
  40.181 +(defmethod ga/* [::complex ::pure-imaginary]
  40.182 +  [x y]
  40.183 +  (let [[rx ix] (vals x)
  40.184 +	iy (imag y)]
  40.185 +    (complex (ga/- (ga/* ix iy))
  40.186 +	     (ga/* rx iy))))
  40.187 +
  40.188 +(defmethod ga/* [::pure-imaginary ::complex]
  40.189 +  [x y]
  40.190 +  (let [ix (imag x)
  40.191 +	[ry iy] (vals y)]
  40.192 +    (complex (ga/- (ga/* ix iy))
  40.193 +	     (ga/* ix ry))))
  40.194 +
  40.195 +(defmethod ga/* [::complex root-type]
  40.196 +  [x y]
  40.197 +  (let [[rx ix] (vals x)]
  40.198 +    (complex (ga/* rx y) (ga/* ix y))))
  40.199 +
  40.200 +(defmethod ga/* [root-type ::complex]
  40.201 +  [x y]
  40.202 +  (let [[ry iy] (vals y)]
  40.203 +    (complex (ga/* x ry) (ga/* x iy))))
  40.204 +
  40.205 +(defmethod ga/* [::pure-imaginary root-type]
  40.206 +  [x y]
  40.207 +  (imaginary (ga/* (imag x) y)))
  40.208 +
  40.209 +(defmethod ga/* [root-type ::pure-imaginary]
  40.210 +  [x y]
  40.211 +  (imaginary (ga/* x (imag y))))
  40.212 +
  40.213 +;
  40.214 +; Inversion
  40.215 +;
  40.216 +(ga/defmethod* ga / ::complex
  40.217 +  [x]
  40.218 +  (let [[rx ix] (vals x)
  40.219 +	den ((ga/qsym ga /) (ga/+ (ga/* rx rx) (ga/* ix ix)))]
  40.220 +    (complex (ga/* rx den) (ga/- (ga/* ix den)))))
  40.221 +
  40.222 +(ga/defmethod* ga / ::pure-imaginary
  40.223 +  [x]
  40.224 +  (imaginary (ga/- ((ga/qsym ga /) (imag x)))))
  40.225 +
  40.226 +;
  40.227 +; Division is automatically supplied by ga//, optimized implementations
  40.228 +; can be added later...
  40.229 +;
  40.230 +
  40.231 +;
  40.232 +; Conjugation
  40.233 +;
  40.234 +(defmethod gm/conjugate ::complex
  40.235 +  [x]
  40.236 +  (let [[r i] (vals x)]
  40.237 +    (complex r (ga/- i))))
  40.238 +
  40.239 +(defmethod gm/conjugate ::pure-imaginary
  40.240 +  [x]
  40.241 +  (imaginary (ga/- (imag x))))
  40.242 +
  40.243 +;
  40.244 +; Absolute value
  40.245 +;
  40.246 +(defmethod gm/abs ::complex
  40.247 +  [x]
  40.248 +  (let [[r i] (vals x)]
  40.249 +    (gm/sqrt (ga/+ (ga/* r r) (ga/* i i)))))
  40.250 +
  40.251 +(defmethod gm/abs ::pure-imaginary
  40.252 +  [x]
  40.253 +  (gm/abs (imag x)))
  40.254 +
  40.255 +;
  40.256 +; Square root
  40.257 +;
  40.258 +(let [one-half   (/ 1 2)
  40.259 +      one-eighth (/ 1 8)]
  40.260 +  (defmethod gm/sqrt ::complex
  40.261 +    [x]
  40.262 +    (let [[r i] (vals x)]
  40.263 +      (if (and (gc/zero? r) (gc/zero? i))
  40.264 +        0
  40.265 +        (let [; The basic formula would say
  40.266 +              ;    abs (gm/sqrt (ga/+ (ga/* r r) (ga/* i i)))
  40.267 +	      ;    p   (gm/sqrt (ga/* one-half (ga/+ abs r)))
  40.268 +	      ; but the slightly more complicated one below
  40.269 +	      ; avoids overflow for large r or i.
  40.270 +	      ar  (gm/abs r)
  40.271 +	      ai  (gm/abs i)
  40.272 +	      r8  (ga/* one-eighth ar)
  40.273 +	      i8  (ga/* one-eighth ai)
  40.274 +	      abs (gm/sqrt (ga/+ (ga/* r8 r8) (ga/* i8 i8)))
  40.275 +	      p   (ga/* 2 (gm/sqrt (ga/+ abs r8)))
  40.276 +	      q   ((ga/qsym ga /) ai (ga/* 2 p))
  40.277 +	      s   (gm/sgn i)]
  40.278 +	  (if (gc/< r 0)
  40.279 +	    (complex q (ga/* s p))
  40.280 +	    (complex p (ga/* s q))))))))
  40.281 +
  40.282 +;
  40.283 +; Exponential function
  40.284 +;
  40.285 +(defmethod gm/exp ::complex
  40.286 +  [x]
  40.287 +  (let [[r i] (vals x)
  40.288 +	exp-r (gm/exp r)
  40.289 +	cos-i (gm/cos i)
  40.290 +	sin-i (gm/sin i)]
  40.291 +    (complex (ga/* exp-r cos-i) (ga/* exp-r sin-i))))
  40.292 +
  40.293 +(defmethod gm/exp ::pure-imaginary
  40.294 +  [x]
  40.295 +  (let [i (imag x)]
  40.296 +    (complex (gm/cos i) (gm/sin i))))
    41.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    41.2 +++ b/src/clojure/contrib/cond.clj	Sat Aug 21 06:25:44 2010 -0400
    41.3 @@ -0,0 +1,34 @@
    41.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    41.5 +;;  distribution terms for this software are covered by the Eclipse Public
    41.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    41.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    41.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    41.9 +;;  terms of this license.  You must not remove this notice, or any other,
   41.10 +;;  from this software.
   41.11 +;;
   41.12 +;;  File: cond.clj
   41.13 +;;
   41.14 +;;  scgilardi (gmail)
   41.15 +;;  2 October 2008
   41.16 +
   41.17 +(ns ^{:author "Stephen C. Gilardi"
   41.18 +       :doc "Extensions to the basic cond function."} 
   41.19 +  clojure.contrib.cond)
   41.20 +
   41.21 +(defmacro cond-let
   41.22 +  "Takes a binding-form and a set of test/expr pairs. Evaluates each test
   41.23 +  one at a time. If a test returns logical true, cond-let evaluates and
   41.24 +  returns expr with binding-form bound to the value of test and doesn't
   41.25 +  evaluate any of the other tests or exprs. To provide a default value
   41.26 +  either provide a literal that evaluates to logical true and is
   41.27 +  binding-compatible with binding-form, or use :else as the test and don't
   41.28 +  refer to any parts of binding-form in the expr. (cond-let binding-form)
   41.29 +  returns nil."
   41.30 +  [bindings & clauses]
   41.31 +  (let [binding (first bindings)]
   41.32 +    (when-let [[test expr & more] clauses]
   41.33 +      (if (= test :else)
   41.34 +        expr
   41.35 +        `(if-let [~binding ~test]
   41.36 +           ~expr
   41.37 +           (cond-let ~bindings ~@more))))))
    42.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.2 +++ b/src/clojure/contrib/condition.clj	Sat Aug 21 06:25:44 2010 -0400
    42.3 @@ -0,0 +1,147 @@
    42.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    42.5 +;;  distribution terms for this software are covered by the Eclipse Public
    42.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    42.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    42.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    42.9 +;;  terms of this license.  You must not remove this notice, or any other,
   42.10 +;;  from this software.
   42.11 +;;
   42.12 +;;  condition.clj
   42.13 +;;
   42.14 +;;  scgilardi (gmail)
   42.15 +;;  Created 09 June 2009
   42.16 +
   42.17 +(ns ^{:author "Stephen C. Gilardi"
   42.18 +       :doc "Flexible raising and handling of conditions:
   42.19 +
   42.20 +Functions:
   42.21 +
   42.22 +              raise: raises a condition
   42.23 +       handler-case: dispatches raised conditions to appropriate handlers
   42.24 +  print-stack-trace: prints abbreviated or full condition stack traces
   42.25 +
   42.26 +Data:
   42.27 +
   42.28 +  A condition is a map containing values for these keys:
   42.29 +
   42.30 +    - :type, a condition type specifier, typically a keyword
   42.31 +    - :stack-trace, a stack trace to the site of the raise
   42.32 +    - :message, a human-readable message (optional)
   42.33 +    - :cause, a wrapped exception or condition (optional)
   42.34 +    - other keys given as arguments to raise (optional)
   42.35 +
   42.36 +Note: requires AOT compilation.
   42.37 +
   42.38 +Based on an idea from Chouser:
   42.39 +http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"}
   42.40 +  clojure.contrib.condition
   42.41 +  (:require clojure.contrib.condition.Condition)
   42.42 +  (:import clojure.contrib.condition.Condition
   42.43 +           clojure.lang.IPersistentMap)
   42.44 +  (:use (clojure.contrib
   42.45 +         [def :only (defvar)]
   42.46 +         [seq :only (separate)])))
   42.47 +
   42.48 +(defvar *condition*
   42.49 +  "While a handler is running, bound to the condition being handled")
   42.50 +
   42.51 +(defvar *selector*
   42.52 +  "While a handler is running, bound to the selector returned by the
   42.53 +  handler-case dispatch-fn for *condition*")
   42.54 +
   42.55 +(defvar *condition-object*
   42.56 +  "While a handler is running, bound to the Condition object whose metadata
   42.57 +  is the condition")
   42.58 +
   42.59 +(defvar *full-stack-traces* false
   42.60 +  "Bind to true to include clojure.{core,lang,main} frames in stack
   42.61 +  traces")
   42.62 +
   42.63 +(defmacro raise
   42.64 +  "Raises a condition. With no arguments, re-raises the current condition.
   42.65 +  With one argument (a map), raises the argument. With two or more
   42.66 +  arguments, raises a map with keys and values from the arguments."
   42.67 +  ([]
   42.68 +     `(throw *condition-object*))
   42.69 +  ([m]
   42.70 +     `(throw (Condition. ~m)))
   42.71 +  ([key val & keyvals]
   42.72 +     `(raise (hash-map ~key ~val ~@keyvals))))
   42.73 +
   42.74 +(defmacro handler-case
   42.75 +  "Executes body in a context where raised conditions can be handled.
   42.76 +
   42.77 +  dispatch-fn accepts a raised condition (a map) and returns a selector
   42.78 +  used to choose a handler. Commonly, dispatch-fn will be :type to dispatch
   42.79 +  on the condition's :type value.
   42.80 +
   42.81 +  Handlers are forms within body:
   42.82 +
   42.83 +    (handle key
   42.84 +      ...)
   42.85 +
   42.86 +  If a condition is raised, executes the body of the first handler whose
   42.87 +  key satisfies (isa? selector key). If no handlers match, re-raises the
   42.88 +  condition.
   42.89 +
   42.90 +  While a handler is running, *condition* is bound to the condition being
   42.91 +  handled and *selector* is bound to to the value returned by dispatch-fn
   42.92 +  that matched the handler's key."
   42.93 +  [dispatch-fn & body]
   42.94 +  (let [[handlers code]
   42.95 +        (separate #(and (list? %) (= 'handle (first %))) body)]
   42.96 +    `(try
   42.97 +      ~@code
   42.98 +      (catch Condition c#
   42.99 +        (binding [*condition-object* c#
  42.100 +                  *condition* (meta c#)
  42.101 +                  *selector* (~dispatch-fn (meta c#))]
  42.102 +          (cond
  42.103 +           ~@(mapcat
  42.104 +              (fn [[_ key & body]]
  42.105 +                `[(isa? *selector* ~key) (do ~@body)])
  42.106 +              handlers)
  42.107 +           :else (raise)))))))
  42.108 +
  42.109 +(defmulti stack-trace-info
  42.110 +  "Returns header, stack-trace, and cause info from conditions and
  42.111 +  Throwables"
  42.112 +  class)
  42.113 +
  42.114 +(defmethod stack-trace-info IPersistentMap
  42.115 +  [condition]
  42.116 +  [(format "condition: %s, %s" (:type condition)
  42.117 +           (dissoc condition :type :stack-trace :cause))
  42.118 +   (:stack-trace condition)
  42.119 +   (:cause condition)])
  42.120 +
  42.121 +(defmethod stack-trace-info Condition
  42.122 +  [condition]
  42.123 +  (stack-trace-info (meta condition)))
  42.124 +
  42.125 +(defmethod stack-trace-info Throwable
  42.126 +  [throwable]
  42.127 +  [(str throwable)
  42.128 +   (.getStackTrace throwable)
  42.129 +   (.getCause throwable)])
  42.130 +
  42.131 +(defn print-stack-trace
  42.132 +  "Prints a stack trace for a condition or Throwable. Skips frames for
  42.133 +  classes in clojure.{core,lang,main} unless the *full-stack-traces* is
  42.134 +  bound to logical true"
  42.135 +  [x]
  42.136 +  (let [[header frames cause] (stack-trace-info x)]
  42.137 +    (printf "%s\n" header)
  42.138 +    (doseq [frame frames]
  42.139 +      (let [classname (.getClassName frame)]
  42.140 +        (if (or *full-stack-traces*
  42.141 +                (not (re-matches
  42.142 +                      #"clojure.(?:core|lang|main).*" classname)))
  42.143 +          (printf "        at %s/%s(%s:%s)\n"
  42.144 +                  classname
  42.145 +                  (.getMethodName frame)
  42.146 +                  (.getFileName frame)
  42.147 +                  (.getLineNumber frame)))))
  42.148 +    (when cause
  42.149 +      (printf "caused by: ")
  42.150 +      (recur cause))))
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/clojure/contrib/condition/Condition.clj	Sat Aug 21 06:25:44 2010 -0400
    43.3 @@ -0,0 +1,43 @@
    43.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    43.5 +;;  distribution terms for this software are covered by the Eclipse Public
    43.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    43.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    43.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    43.9 +;;  terms of this license.  You must not remove this notice, or any other,
   43.10 +;;  from this software.
   43.11 +;;
   43.12 +;;  Condition.clj
   43.13 +;;
   43.14 +;;  Used by clojure.contrib.condition to implement a "Throwable map"
   43.15 +;;
   43.16 +;;  scgilardi (gmail)
   43.17 +;;  Created 09 June 2009
   43.18 +
   43.19 +(ns clojure.contrib.condition.Condition
   43.20 +  (:gen-class :extends Throwable
   43.21 +              :implements [clojure.lang.IMeta]
   43.22 +              :state state
   43.23 +              :init init
   43.24 +              :post-init post-init
   43.25 +              :constructors {[clojure.lang.IPersistentMap]
   43.26 +                             [String Throwable]}))
   43.27 +
   43.28 +(defn -init
   43.29 +  "Constructs a Condition object with condition (a map) as its
   43.30 +  metadata. Also initializes the superclass with the values at :message
   43.31 +  and :cause, if any, so they are also available via .getMessage and
   43.32 +  .getCause."
   43.33 +  [condition]
   43.34 +  [[(:message condition) (:cause condition)] (atom condition)])
   43.35 +
   43.36 +(defn -post-init
   43.37 +  "Adds :stack-trace to the condition. Drops the bottom 3 frames because
   43.38 +  they are always the same: implementation details of Condition and raise."
   43.39 +  [this condition]
   43.40 +  (swap! (.state this) assoc
   43.41 +         :stack-trace (into-array (drop 3 (.getStackTrace this)))))
   43.42 +
   43.43 +(defn -meta
   43.44 +  "Returns this object's metadata, the condition"
   43.45 +  [this]
   43.46 +  @(.state this))
    44.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    44.2 +++ b/src/clojure/contrib/core.clj	Sat Aug 21 06:25:44 2010 -0400
    44.3 @@ -0,0 +1,89 @@
    44.4 +;   Copyright (c) Laurent Petit and others, March 2009. All rights reserved.
    44.5 +
    44.6 +;   The use and distribution terms for this software are covered by the
    44.7 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    44.8 +;   which can be found in the file epl-v10.html at the root of this 
    44.9 +;   distribution.
   44.10 +;   By using this software in any fashion, you are agreeing to be bound by
   44.11 +;   the terms of this license.
   44.12 +;   You must not remove this notice, or any other, from this software.
   44.13 +
   44.14 +;; functions/macros variants of the ones that can be found in clojure.core
   44.15 +
   44.16 +;; note to other contrib members: feel free to add to this lib
   44.17 +
   44.18 +(ns
   44.19 +  ^{:author "Laurent Petit (and others)"
   44.20 +     :doc "Functions/macros variants of the ones that can be found in clojure.core 
   44.21 + (note to other contrib members: feel free to add to this lib)"}
   44.22 +  clojure.contrib.core
   44.23 +  (:use clojure.contrib.def))
   44.24 +
   44.25 +(defmacro- defnilsafe [docstring non-safe-name nil-safe-name]
   44.26 +  `(defmacro ~nil-safe-name ~docstring
   44.27 +     {:arglists '([~'x ~'form] [~'x ~'form ~'& ~'forms])}
   44.28 +	   ([x# form#]
   44.29 +	     `(let [~'i# ~x#] (when-not (nil? ~'i#) (~'~non-safe-name ~'i# ~form#))))
   44.30 +  	 ([x# form# & more#]
   44.31 +	     `(~'~nil-safe-name (~'~nil-safe-name ~x# ~form#) ~@more#))))
   44.32 +       
   44.33 +(defnilsafe 
   44.34 +  "Same as clojure.core/-> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation).
   44.35 +   Examples :
   44.36 +   (-?> \"foo\" .toUpperCase (.substring 1)) returns \"OO\"
   44.37 +   (-?> nil .toUpperCase (.substring 1)) returns nil
   44.38 +   "
   44.39 +   -> -?>)
   44.40 +    
   44.41 +(defnilsafe 
   44.42 +  "Same as clojure.core/.. but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation).
   44.43 +   Examples :
   44.44 +   (.?. \"foo\" .toUpperCase (.substring 1)) returns \"OO\"
   44.45 +   (.?. nil .toUpperCase (.substring 1)) returns nil
   44.46 +   "
   44.47 +   .. .?.)
   44.48 +
   44.49 +(defnilsafe
   44.50 +  "Same as clojure.core/->> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation).
   44.51 +   Examples :
   44.52 +   (-?>> (range 5) (map inc)) returns (1 2 3 4 5)
   44.53 +   (-?>> [] seq (map inc)) returns nil
   44.54 +   "
   44.55 +  ->> -?>>)
   44.56 +
   44.57 +;; ----------------------------------------------------------------------
   44.58 +;; scgilardi at gmail
   44.59 +
   44.60 +(defn dissoc-in
   44.61 +  "Dissociates an entry from a nested associative structure returning a new
   44.62 +  nested structure. keys is a sequence of keys. Any empty maps that result
   44.63 +  will not be present in the new structure."
   44.64 +  [m [k & ks :as keys]]
   44.65 +  (if ks
   44.66 +    (if-let [nextmap (get m k)]
   44.67 +      (let [newmap (dissoc-in nextmap ks)]
   44.68 +        (if (seq newmap)
   44.69 +          (assoc m k newmap)
   44.70 +          (dissoc m k)))
   44.71 +      m)
   44.72 +    (dissoc m k)))
   44.73 +
   44.74 +(defn new-by-name
   44.75 +  "Constructs a Java object whose class is specified by a String."
   44.76 +  [class-name & args]
   44.77 +  (clojure.lang.Reflector/invokeConstructor
   44.78 +   (clojure.lang.RT/classForName class-name)
   44.79 +   (into-array Object args)))
   44.80 +
   44.81 +(defn seqable?
   44.82 +  "Returns true if (seq x) will succeed, false otherwise."
   44.83 +  [x]
   44.84 +  (or (seq? x)
   44.85 +      (instance? clojure.lang.Seqable x)
   44.86 +      (nil? x)
   44.87 +      (instance? Iterable x)
   44.88 +      (-> x .getClass .isArray)
   44.89 +      (string? x)
   44.90 +      (instance? java.util.Map x)))
   44.91 +
   44.92 +;; ----------------------------------------------------------------------
    45.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    45.2 +++ b/src/clojure/contrib/dataflow.clj	Sat Aug 21 06:25:44 2010 -0400
    45.3 @@ -0,0 +1,509 @@
    45.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    45.5 +;;  distribution terms for this software are covered by the Eclipse Public
    45.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    45.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    45.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    45.9 +;;  terms of this license.  You must not remove this notice, or any other,
   45.10 +;;  from this software.
   45.11 +;;
   45.12 +;;  dataflow.clj
   45.13 +;;
   45.14 +;;  A Library to Support a Dataflow Model of State
   45.15 +;;
   45.16 +;;  straszheimjeffrey (gmail)
   45.17 +;;  Created 10 March 2009
   45.18 +
   45.19 +
   45.20 +(ns
   45.21 +  ^{:author "Jeffrey Straszheim",
   45.22 +     :doc "A library to support a dataflow model of state"}
   45.23 +  clojure.contrib.dataflow
   45.24 +  (:use [clojure.set :only (union intersection difference)])
   45.25 +  (:use [clojure.contrib.graph :only (directed-graph
   45.26 +                                      reverse-graph
   45.27 +                                      dependency-list
   45.28 +                                      get-neighbors)])
   45.29 +  (:use [clojure.walk :only (postwalk)])
   45.30 +  (:use [clojure.contrib.except :only (throwf)])
   45.31 +  (:import java.io.Writer))
   45.32 +
   45.33 +
   45.34 +;;; Chief Data Structures
   45.35 +
   45.36 +
   45.37 +;; Source Cell
   45.38 +
   45.39 +; The data of a source cell is directly set by a calling function.  It
   45.40 +; never depends on other cells.
   45.41 +
   45.42 +(defstruct source-cell
   45.43 +  :name             ; The name, a symbol
   45.44 +  :value            ; Its value, a Ref
   45.45 +  :cell-type)       ; Should be ::source-cell
   45.46 +
   45.47 +;; Cell
   45.48 +
   45.49 +; A standard cell that computes its value from other cells.
   45.50 +
   45.51 +(defstruct standard-cell
   45.52 +  :name            ; The name, a symbol
   45.53 +  :value           ; Its value, a Ref
   45.54 +  :dependents      ; The names of cells on which this depends, a collection
   45.55 +  :fun             ; A closure that computes the value, given an environment
   45.56 +  :display         ; The original expression for display
   45.57 +  :cell-type)      ; Should be ::cell
   45.58 +
   45.59 +(derive ::cell ::dependent-cell) ; A cell that has a dependents field
   45.60 +
   45.61 +;; Validator
   45.62 +
   45.63 +; A cell that has no value, but can throw an exception when run
   45.64 +
   45.65 +(defstruct validator-cell
   45.66 +  :name            ; Always ::validator
   45.67 +  :dependents      ; The names of cells on which this depends, a collection
   45.68 +  :fun             ; A clojure that can throw an exception
   45.69 +  :display         ; The original exprssion for display
   45.70 +  :cell-type)      ; Should be ::validator-cell
   45.71 +
   45.72 +(derive ::validator-cell ::dependent-cell)
   45.73 +
   45.74 +
   45.75 +;; A sentinal value
   45.76 +
   45.77 +(def *empty-value* (java.lang.Object.))
   45.78 +
   45.79 +
   45.80 +;; Dataflow
   45.81 +
   45.82 +; A collection of cells and dependency information
   45.83 +
   45.84 +(defstruct dataflow
   45.85 +  :cells          ; A set of all cells
   45.86 +  :cells-map      ; A map of cell names (symbols) to collections of cells
   45.87 +  :fore-graph     ; The inverse of the dependency graph, nodes are cells
   45.88 +  :topological)   ; A vector of sets of independent nodes -- orders the computation
   45.89 +
   45.90 +
   45.91 +;;; Environment Access
   45.92 +
   45.93 +(defn get-cells
   45.94 +  "Get all the cells named by name"
   45.95 +  [df name]
   45.96 +  ((:cells-map @df) name))
   45.97 +
   45.98 +(defn get-cell
   45.99 +  "Get the single cell named by name"
  45.100 +  [df name]
  45.101 +  (let [cells (get-cells df name)]
  45.102 +    (cond
  45.103 +     (= (count cells) 1) (first cells)
  45.104 +     (> (count cells) 1) (throwf Exception "Cell %s has multiple instances" name)
  45.105 +     :otherwise (throwf Exception "Cell %s is undefined" name))))
  45.106 +
  45.107 +(defn source-cell?
  45.108 +  "Is this cell a source cell?"
  45.109 +  [cell]
  45.110 +  (isa? (:cell-type cell) ::source-cell))
  45.111 +
  45.112 +(defn get-source-cells
  45.113 +  "Returns a collection of source cells from the dataflow"
  45.114 +  [df]
  45.115 +  (for [cell (:cells @df)
  45.116 +        :when (source-cell? cell)]
  45.117 +    cell))
  45.118 +
  45.119 +(defn get-value
  45.120 +  "Gets a value from the df matching the passed symbol.
  45.121 +   Signals an error if the name is not present, or if it not a single
  45.122 +   value."  
  45.123 +  [df name]
  45.124 +  (let [cell (get-cell df name)
  45.125 +        result @(:value cell)]
  45.126 +    (do (when (= *empty-value* result)
  45.127 +          (throwf Exception "Cell named %s empty" name))
  45.128 +        result)))
  45.129 +
  45.130 +(defn get-values
  45.131 +  "Gets a collection of values from the df by name"
  45.132 +  [df name]
  45.133 +  (let [cells (get-cells df name)
  45.134 +        results (map #(-> % :value deref) cells)]
  45.135 +    (do
  45.136 +      (when (some #(= % *empty-value*) results)
  45.137 +        (throwf Exception "At least one empty cell named %s found" name))
  45.138 +      results)))
  45.139 +
  45.140 +(defn get-old-value
  45.141 +  "Looks up an old value"
  45.142 +  [df env name]
  45.143 +  (if (contains? env name)
  45.144 +    (env name)
  45.145 +    (get-value df name)))
  45.146 +
  45.147 +(defn get-value-from-cell
  45.148 +  "Given a cell, get its value"
  45.149 +  [cell]
  45.150 +  (-> cell :value deref))
  45.151 +
  45.152 +;;; Build Dataflow Structure
  45.153 +
  45.154 +(defn- build-cells-map
  45.155 +  "Given a collection of cells, build a name->cells-collection map
  45.156 +   from it."
  45.157 +  [cs]
  45.158 +  (let [step (fn [m c]
  45.159 +               (let [n (:name c)
  45.160 +                     o (get m n #{})
  45.161 +                     s (conj o c)]
  45.162 +                 (assoc m n s)))]
  45.163 +    (reduce step {} cs)))
  45.164 +
  45.165 +(defn- build-back-graph
  45.166 +  "Builds the backward dependency graph from the cells map.  Each
  45.167 +   node of the graph is a cell."
  45.168 +  [cells cells-map]
  45.169 +  (let [step (fn [n]
  45.170 +               (apply union (for [dep-name (:dependents n)]
  45.171 +                              (cells-map dep-name))))
  45.172 +        neighbors (zipmap cells (map step cells))]
  45.173 +    (struct-map directed-graph
  45.174 +        :nodes cells
  45.175 +        :neighbors neighbors)))
  45.176 +
  45.177 +(defn- build-dataflow*
  45.178 +  "Builds the dataflow structure"
  45.179 +  [cs]
  45.180 +  (let [cells (set cs)
  45.181 +        cells-map (build-cells-map cs)
  45.182 +        back-graph (build-back-graph cells cells-map)
  45.183 +        fore-graph (reverse-graph back-graph)]
  45.184 +    (struct-map dataflow
  45.185 +      :cells cells
  45.186 +      :cells-map cells-map
  45.187 +      :fore-graph fore-graph
  45.188 +      :topological (dependency-list back-graph))))
  45.189 +
  45.190 +(def initialize)
  45.191 +
  45.192 +(defn build-dataflow
  45.193 +  "Given a collection of cells, build and return a dataflow object"
  45.194 +  [cs]
  45.195 +  (dosync
  45.196 +   (let [df (ref (build-dataflow* cs))]
  45.197 +     (initialize df)
  45.198 +     df)))
  45.199 +
  45.200 +
  45.201 +;;; Displaying a dataflow
  45.202 +
  45.203 +(defn print-dataflow
  45.204 +  "Prints a dataflow, one cell per line"
  45.205 +  [df]
  45.206 +  (println)
  45.207 +  (let [f (fn [cell] (-> cell :name str))]
  45.208 +    (doseq [cell (sort-by f (:cells @df))]
  45.209 +      (prn cell))))
  45.210 +
  45.211 +
  45.212 +;;; Modifying a Dataflow
  45.213 +
  45.214 +(defn add-cells
  45.215 +  "Given a collection of cells, add them to the dataflow."
  45.216 +  [df cells]
  45.217 +  (dosync
  45.218 +   (let [new-cells (union (set cells) (:cells @df))]
  45.219 +     (ref-set df (build-dataflow* new-cells))
  45.220 +     (initialize df))))
  45.221 +
  45.222 +(defn remove-cells
  45.223 +  "Given a collection of cells, remove them from the dataflow."
  45.224 +  [df cells]
  45.225 +  (dosync
  45.226 +   (let [new-cells (difference (:cells @df) (set cells))]
  45.227 +     (ref-set df (build-dataflow* new-cells))
  45.228 +     (initialize df))))
  45.229 +
  45.230 +
  45.231 +;;; Cell building
  45.232 +
  45.233 +(def *meta* {:type ::dataflow-cell})
  45.234 +
  45.235 +(defn build-source-cell
  45.236 +  "Builds a source cell"
  45.237 +  [name init]
  45.238 +  (with-meta (struct source-cell name (ref init) ::source-cell)
  45.239 +             *meta*))
  45.240 +
  45.241 +(defn- is-col-var?
  45.242 +  [symb]
  45.243 +  (let [name (name symb)]
  45.244 +    (and (= \? (first name))
  45.245 +         (= \* (second name)))))
  45.246 +
  45.247 +(defn- is-old-var?
  45.248 +  [symb]
  45.249 +  (let [name (name symb)]
  45.250 +    (and (= \? (first name))
  45.251 +         (= \- (second name)))))
  45.252 +
  45.253 +(defn- is-var?
  45.254 +  [symb]
  45.255 +  (let [name (name symb)]
  45.256 +    (and (= \? (first name))
  45.257 +         (-> symb is-col-var? not)
  45.258 +         (-> symb is-old-var? not))))
  45.259 +
  45.260 +(defn- cell-name
  45.261 +  [symb]
  45.262 +  `(quote ~(cond (is-var? symb) (-> symb name (.substring 1) symbol)
  45.263 +                 (or (is-col-var? symb)
  45.264 +                     (is-old-var? symb)) (-> symb name (.substring 2) symbol))))
  45.265 +
  45.266 +(defn- replace-symbol
  45.267 +  "Walk the from replacing the ?X forms with the needed calls"
  45.268 +  [dfs ov form]
  45.269 +  (cond
  45.270 +   (-> form symbol? not) form
  45.271 +   (is-var? form) `(get-value ~dfs ~(cell-name form))
  45.272 +   (is-col-var? form) `(get-values ~dfs ~(cell-name form))
  45.273 +   (is-old-var? form) `(get-old-value ~dfs ~ov ~(cell-name form))
  45.274 +   :otherwise form))
  45.275 +
  45.276 +(defn- build-fun
  45.277 +  "Build the closure needed to compute a cell"
  45.278 +  [form]
  45.279 +  (let [dfs (gensym "df_")
  45.280 +        ov (gensym "old_")]
  45.281 +    `(fn [~dfs ~ov] ~(postwalk (partial replace-symbol dfs ov) form))))
  45.282 +
  45.283 +(defn- get-deps
  45.284 +  "Get the names of the dependent cells"
  45.285 +  [form]
  45.286 +  (let [step (fn [f]
  45.287 +               (cond
  45.288 +                (coll? f) (apply union f)
  45.289 +                (-> f symbol? not) nil
  45.290 +                (is-var? f) #{(cell-name f)}
  45.291 +                (is-col-var? f) #{(cell-name f)}
  45.292 +                (is-old-var? f) #{(cell-name f)}
  45.293 +                :otherwise nil))]
  45.294 +    (postwalk step form)))
  45.295 +
  45.296 +(defn build-standard-cell
  45.297 +  "Builds a standard cell"
  45.298 +  [name deps fun expr]
  45.299 +  (with-meta (struct standard-cell name (ref *empty-value*) deps fun expr ::cell)
  45.300 +             *meta*))
  45.301 +
  45.302 +(defn build-validator-cell
  45.303 +  "Builds a validator cell"
  45.304 +  [deps fun expr]
  45.305 +  (with-meta (struct validator-cell ::validator deps fun expr ::validator-cell)
  45.306 +             *meta*))
  45.307 +
  45.308 +(defmacro cell
  45.309 +  "Build a standard cell, like this:
  45.310 +
  45.311 +    (cell fred
  45.312 +       (* ?mary ?joe))
  45.313 +
  45.314 +   Which creates a cell named fred that is the product of a cell mary and cell joe
  45.315 +
  45.316 +   Or:
  45.317 +
  45.318 +    (cell joe
  45.319 +      (apply * ?*sally))
  45.320 +
  45.321 +   Which creates a cell that applies * to the collection of all cells named sally
  45.322 +
  45.323 +   Or:
  45.324 +
  45.325 +    (cell :source fred 0)
  45.326 +
  45.327 +   Which builds a source cell fred with initial value 0
  45.328 +
  45.329 +   Or:
  45.330 +
  45.331 +     (cell :validator (when (< ?fred ?sally)
  45.332 +                          (throwf \"%s must be greater than %s\" ?fred ?sally))
  45.333 +
  45.334 +   Which will perform the validation"
  45.335 +  [type & data]
  45.336 +  (cond
  45.337 +   (symbol? type) (let [name type ; No type for standard cell
  45.338 +                        expr (first data) ; we ignore extra data!
  45.339 +                        deps (get-deps expr)
  45.340 +                        fun (build-fun expr)]
  45.341 +                    `(build-standard-cell '~name ~deps ~fun '~expr))
  45.342 +   (= type :source) (let [[name init] data]
  45.343 +                      `(build-source-cell '~name ~init))
  45.344 +   (= type :validator) (let [[expr] data
  45.345 +                             deps (get-deps expr)
  45.346 +                             fun (build-fun expr)]
  45.347 +                         `(build-validator-cell ~deps ~fun '~expr))))
  45.348 +
  45.349 +                         
  45.350 +;;; Cell Display
  45.351 +
  45.352 +(defmulti display-cell
  45.353 +  "A 'readable' form of the cell"
  45.354 +  :cell-type)
  45.355 +
  45.356 +(defmethod display-cell ::source-cell
  45.357 +  [cell]
  45.358 +  (list 'cell :source (:name cell) (-> cell :value deref)))
  45.359 +
  45.360 +(defmethod display-cell ::cell
  45.361 +  [cell]
  45.362 +  (list 'cell (:name cell) (:display cell) (-> cell :value deref)))
  45.363 +
  45.364 +(defmethod display-cell ::validator-cell
  45.365 +  [cell]
  45.366 +  (list 'cell :validator (:display cell)))
  45.367 +
  45.368 +(defmethod print-method ::dataflow-cell
  45.369 +  [f ^Writer w]
  45.370 +  (binding [*out* w]
  45.371 +    (pr (display-cell f))))
  45.372 +
  45.373 +
  45.374 +;;; Evaluation
  45.375 +
  45.376 +(defmulti eval-cell
  45.377 +  "Evaluate a dataflow cell.  Return [changed, old val]"
  45.378 +  (fn [df data old cell] (:cell-type cell)))
  45.379 +
  45.380 +(defmethod eval-cell ::source-cell
  45.381 +  [df data old cell]
  45.382 +  (let [name (:name cell)
  45.383 +        val (:value cell)
  45.384 +        ov @val]
  45.385 +    (if (contains? data name)
  45.386 +      (let [new-val (data name)]
  45.387 +        (if (not= ov new-val)
  45.388 +          (do (ref-set val new-val)
  45.389 +              [true ov])
  45.390 +          [false ov]))
  45.391 +      [false ov])))
  45.392 +
  45.393 +(defmethod eval-cell ::cell
  45.394 +  [df data old cell]
  45.395 +  (let [val (:value cell)
  45.396 +        old-val @val
  45.397 +        new-val ((:fun cell) df old)]
  45.398 +    (if (not= old-val new-val)
  45.399 +      (do (ref-set val new-val)
  45.400 +          [true old-val])
  45.401 +      [false old-val])))
  45.402 +
  45.403 +(defmethod eval-cell ::validator-cell
  45.404 +  [df data old cell]
  45.405 +  (do ((:fun cell) df old)
  45.406 +      [false nil]))
  45.407 +
  45.408 +(defn- perform-flow
  45.409 +  "Evaluate the needed cells (a set) from the given dataflow.  Data is
  45.410 +   a name-value mapping of new values for the source cells"
  45.411 +  [df data needed]
  45.412 +  (loop [needed needed
  45.413 +         tops (:topological @df)
  45.414 +         old {}]
  45.415 +    (let [now (first tops) ; Now is a set of nodes
  45.416 +          new-tops (next tops)]
  45.417 +      (when (and (-> needed empty? not)
  45.418 +                 (-> now empty? not))
  45.419 +        (let [step (fn [[needed old] cell]
  45.420 +                     (let [[changed ov] (try
  45.421 +                                         (eval-cell df data old cell)
  45.422 +                                         (catch Exception e
  45.423 +                                           (throw (Exception. (str cell) e))))
  45.424 +                           nn (disj needed cell)]
  45.425 +                       (if changed
  45.426 +                         [(union nn (get-neighbors (:fore-graph @df) cell))
  45.427 +                          (assoc old (:name cell) ov)]
  45.428 +                         [nn old])))
  45.429 +              [new-needed new-old] (reduce step
  45.430 +                                           [needed old]
  45.431 +                                           (intersection now needed))]
  45.432 +          (recur new-needed new-tops new-old))))))
  45.433 +         
  45.434 +(defn- validate-update
  45.435 +  "Ensure that all the updated cells are source cells"
  45.436 +  [df names]
  45.437 +  (let [scns (set (map :name (get-source-cells df)))]
  45.438 +    (doseq [name names]
  45.439 +      (when (-> name scns not)
  45.440 +        (throwf Exception "Cell %n is not a source cell" name)))))
  45.441 +        
  45.442 +(defn update-values
  45.443 +  "Given a dataflow, and a map of name-value pairs, update the
  45.444 +   dataflow by binding the new values.  Each name must be of a source
  45.445 +   cell"
  45.446 +  [df data]
  45.447 +  (dosync
  45.448 +   (validate-update df (keys data))
  45.449 +   (let [needed (apply union (for [name (keys data)]
  45.450 +                               (set ((:cells-map @df) name))))]
  45.451 +     (perform-flow df data needed))))
  45.452 +
  45.453 +(defn- initialize
  45.454 +  "Apply all the current source cell values.  Useful for a new
  45.455 +   dataflow, or one that has been updated with new cells"
  45.456 +  [df]
  45.457 +  (let [needed (:cells @df)
  45.458 +        fg (:fore-graph @df)]
  45.459 +    (perform-flow df {} needed)))
  45.460 +
  45.461 +
  45.462 +;;; Watchers
  45.463 +
  45.464 +(defn add-cell-watcher
  45.465 +  "Adds a watcher to a cell to respond to changes of value.  The is a
  45.466 +   function of 4 values: a key, the cell, its old value, its new
  45.467 +   value.  This is implemented using Clojure's add-watch to the
  45.468 +   underlying ref, and shared its sematics"
  45.469 +  [cell key fun]
  45.470 +  (let [val (:value cell)]
  45.471 +    (add-watch val key (fn [key _ old-v new-v]
  45.472 +                         (fun key cell old-v new-v)))))
  45.473 +
  45.474 +
  45.475 +(comment
  45.476 +
  45.477 +  (def df
  45.478 +   (build-dataflow
  45.479 +    [(cell :source fred 1)
  45.480 +     (cell :source mary 0)
  45.481 +     (cell greg (+ ?fred ?mary))
  45.482 +     (cell joan (+ ?fred ?mary))
  45.483 +     (cell joan (* ?fred ?mary))
  45.484 +     (cell sally (apply + ?*joan))
  45.485 +     (cell :validator (when (number? ?-greg)
  45.486 +                        (when (<= ?greg ?-greg)
  45.487 +                          (throwf Exception "Non monotonic"))))]))
  45.488 +
  45.489 +  (do (println)
  45.490 +      (print-dataflow df))
  45.491 +
  45.492 +  (add-cell-watcher (get-cell df 'sally)
  45.493 +                    nil
  45.494 +                    (fn [key cell o n]
  45.495 +                      (printf "sally changed from %s to %s\n" o n)))
  45.496 +
  45.497 +  (update-values df {'fred 1 'mary 1})
  45.498 +  (update-values df {'fred 5 'mary 1})
  45.499 +  (update-values df {'fred 0 'mary 0})
  45.500 +
  45.501 +  (get-value df 'fred)
  45.502 +  (get-values df 'joan)
  45.503 +  (get-value df 'sally)
  45.504 +  (get-value df 'greg)
  45.505 +
  45.506 +  (use :reload 'clojure.contrib.dataflow)
  45.507 +  (use 'clojure.stacktrace) (e)
  45.508 +  (use 'clojure.contrib.trace)
  45.509 +)
  45.510 +    
  45.511 +
  45.512 +;; End of file
    46.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    46.2 +++ b/src/clojure/contrib/datalog.clj	Sat Aug 21 06:25:44 2010 -0400
    46.3 @@ -0,0 +1,64 @@
    46.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    46.5 +;;  distribution terms for this software are covered by the Eclipse Public
    46.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    46.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    46.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    46.9 +;;  terms of this license.  You must not remove this notice, or any other,
   46.10 +;;  from this software.
   46.11 +;;
   46.12 +;;  datalog.clj
   46.13 +;;
   46.14 +;;  A Clojure implementation of Datalog
   46.15 +;;
   46.16 +;;  straszheimjeffrey (gmail)
   46.17 +;;  Created 2 March 2009
   46.18 +
   46.19 +
   46.20 +;;; Please see the example.clj file in the datalog folder
   46.21 +
   46.22 +
   46.23 +(ns 
   46.24 +  ^{:author "Jeffrey Straszheim",
   46.25 +     :doc "A Clojure implementation of Datalog"} 
   46.26 +  clojure.contrib.datalog
   46.27 +  (:use clojure.contrib.datalog.rules
   46.28 +        clojure.contrib.datalog.softstrat
   46.29 +        clojure.contrib.datalog.database)
   46.30 +  (:use [clojure.set :only (intersection)]
   46.31 +        [clojure.contrib.except :only (throwf)]))
   46.32 +
   46.33 +(defstruct work-plan
   46.34 +  :work-plan        ; The underlying structure
   46.35 +  :rules            ; The original rules
   46.36 +  :query            ; The original query
   46.37 +  :work-plan-type)  ; The type of plan
   46.38 +
   46.39 +(defn- validate-work-plan
   46.40 +  "Ensure any top level semantics are not violated"
   46.41 +  [work-plan database]
   46.42 +  (let [common-relations (-> work-plan :rules (intersection (-> database keys set)))]
   46.43 +    (when (-> common-relations
   46.44 +              empty?
   46.45 +              not)
   46.46 +      (throwf "The rules and database define the same relation(s): %s" common-relations))))
   46.47 +  ; More will follow
   46.48 +
   46.49 +(defn build-work-plan
   46.50 +  "Given a list of rules and a query, build a work plan that can be
   46.51 +   used to execute the query."
   46.52 +  [rules query]
   46.53 +  (struct-map work-plan
   46.54 +    :work-plan (build-soft-strat-work-plan rules query)
   46.55 +    :rules rules
   46.56 +    :query query
   46.57 +    :work-plan-type ::soft-stratified))
   46.58 +
   46.59 +(defn run-work-plan
   46.60 +  "Given a work plan, a database, and some query bindings, run the
   46.61 +   work plan and return the results."
   46.62 +  [work-plan database query-bindings]
   46.63 +  (validate-work-plan work-plan database)
   46.64 +  (evaluate-soft-work-set (:work-plan work-plan) database query-bindings))
   46.65 +
   46.66 +
   46.67 +;; End of file
    47.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    47.2 +++ b/src/clojure/contrib/datalog/database.clj	Sat Aug 21 06:25:44 2010 -0400
    47.3 @@ -0,0 +1,288 @@
    47.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    47.5 +;;  distribution terms for this software are covered by the Eclipse Public
    47.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    47.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    47.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    47.9 +;;  terms of this license.  You must not remove this notice, or any other,
   47.10 +;;  from this software.
   47.11 +;;
   47.12 +;;  database.clj
   47.13 +;;
   47.14 +;;  A Clojure implementation of Datalog -- Support for in-memory database
   47.15 +;;
   47.16 +;;  straszheimjeffrey (gmail)
   47.17 +;;  Created 21 Feburary 2009
   47.18 +
   47.19 +
   47.20 +(ns clojure.contrib.datalog.database
   47.21 +  (:use clojure.contrib.datalog.util)
   47.22 +  (:use clojure.contrib.def)
   47.23 +  (:use [clojure.set :only (union intersection difference)])
   47.24 +  (:use [clojure.contrib.except :only (throwf)])
   47.25 +  (:import java.io.Writer))
   47.26 +
   47.27 +
   47.28 +(defstruct relation
   47.29 +  :schema           ; A set of key names
   47.30 +  :data             ; A set of tuples
   47.31 +  :indexes)         ; A map key names to indexes (in turn a map of value to tuples)
   47.32 +
   47.33 +
   47.34 +;;; DDL
   47.35 +
   47.36 +(defmethod print-method ::datalog-database
   47.37 +  [db ^Writer writer]
   47.38 +  (binding [*out* writer]
   47.39 +    (do
   47.40 +      (println "(datalog-database")
   47.41 +      (println "{")
   47.42 +      (doseq [key (keys db)]
   47.43 +        (println)
   47.44 +        (println key)
   47.45 +        (print-method (db key) writer))
   47.46 +      (println "})"))))
   47.47 +
   47.48 +(defn datalog-database
   47.49 +  [rels]
   47.50 +  (with-meta rels {:type ::datalog-database}))
   47.51 +
   47.52 +(def empty-database (datalog-database {}))
   47.53 +
   47.54 +(defmethod print-method ::datalog-relation
   47.55 +  [rel ^Writer writer]
   47.56 +  (binding [*out* writer]
   47.57 +    (do
   47.58 +      (println "(datalog-relation")
   47.59 +      (println " ;; Schema")
   47.60 +      (println " " (:schema rel))
   47.61 +      (println)
   47.62 +      (println " ;; Data")
   47.63 +      (println " #{")
   47.64 +      (doseq [tuple (:data rel)]
   47.65 +        (println "  " tuple))
   47.66 +      (println " }")
   47.67 +      (println)
   47.68 +      (println " ;; Indexes")
   47.69 +      (println "  {")
   47.70 +      (doseq [key (-> rel :indexes keys)]
   47.71 +        (println "  " key)
   47.72 +        (println "    {")
   47.73 +        (doseq [val (keys ((:indexes rel) key))]
   47.74 +          (println "      " val)
   47.75 +          (println "        " (get-in rel [:indexes key val])))
   47.76 +        (println "    }"))
   47.77 +      (println "  })"))))
   47.78 +
   47.79 +(defn datalog-relation
   47.80 +  "Creates a relation"
   47.81 +  [schema data indexes]
   47.82 +  (with-meta (struct relation schema data indexes) {:type ::datalog-relation}))
   47.83 +
   47.84 +(defn add-relation
   47.85 +  "Adds a relation to the database"
   47.86 +  [db name keys]
   47.87 +  (assoc db name (datalog-relation (set keys) #{} {})))
   47.88 +
   47.89 +(defn add-index
   47.90 +  "Adds an index to an empty relation named name"
   47.91 +  [db name key]
   47.92 +  (assert (empty? (:data (db name))))
   47.93 +  (let [rel (db name)
   47.94 +        inx (assoc (:indexes rel) key {})]
   47.95 +    (assoc db name (datalog-relation (:schema rel)
   47.96 +                                     (:data rel)
   47.97 +                                     inx))))
   47.98 +
   47.99 +(defn ensure-relation
  47.100 +  "If the database lacks the named relation, add it"
  47.101 +  [db name keys indexes]
  47.102 +  (if-let [rel (db name)]
  47.103 +    (do
  47.104 +      (assert (= (:schema rel) (set keys)))
  47.105 +      db)
  47.106 +    (let [db1 (add-relation db name keys)]
  47.107 +      (reduce (fn [db key] (add-index db name key))
  47.108 +              db1
  47.109 +              indexes))))
  47.110 +    
  47.111 +
  47.112 +(defmacro make-database
  47.113 +  "Makes a database, like this
  47.114 +   (make-database
  47.115 +     (relation :fred [:mary :sue])
  47.116 +     (index :fred :mary)
  47.117 +     (relation :sally [:jen :becky])
  47.118 +     (index :sally :jen)
  47.119 +     (index :sally :becky))"
  47.120 +  [& commands]
  47.121 +  (let [wrapper (fn [cur new]
  47.122 +                  (let [cmd (first new)
  47.123 +                        body (next new)]
  47.124 +                    (assert (= 2 (count body)))
  47.125 +                    (cond
  47.126 +                     (= cmd 'relation)
  47.127 +                       `(add-relation ~cur ~(first body) ~(fnext body))
  47.128 +                     (= cmd 'index)
  47.129 +                       `(add-index ~cur ~(first body) ~(fnext body))
  47.130 +                     :otherwise (throwf "%s not recognized" new))))]
  47.131 +    (reduce wrapper `empty-database commands)))
  47.132 +
  47.133 +(defn get-relation
  47.134 +  "Get a relation object by name"
  47.135 +  [db rel-name]
  47.136 +  (db rel-name))
  47.137 +
  47.138 +(defn replace-relation
  47.139 +  "Add or replace a fully constructed relation object to the database."
  47.140 +  [db rel-name rel]
  47.141 +  (assoc db rel-name rel))
  47.142 +
  47.143 +
  47.144 +;;; DML
  47.145 +
  47.146 +
  47.147 +(defn database-counts
  47.148 +  "Returns a map with the count of elements in each relation."
  47.149 +  [db]
  47.150 +  (map-values #(-> % :data count) db))
  47.151 +
  47.152 +(defn- modify-indexes
  47.153 +  "Perform f on the indexed tuple-set.  f should take a set and tuple,
  47.154 +   and return the new set."
  47.155 +  [idxs tuple f]
  47.156 +  (into {} (for [ik (keys idxs)]
  47.157 +             (let [im (idxs ik)
  47.158 +                   iv (tuple ik)
  47.159 +                   os (get im iv #{})
  47.160 +                   ns (f os tuple)]
  47.161 +               [ik (if (empty? ns)
  47.162 +                     (dissoc im iv)
  47.163 +                     (assoc im iv (f os tuple)))]))))
  47.164 +
  47.165 +(defn- add-to-indexes
  47.166 +  "Adds the tuple to the appropriate keys in the index map"
  47.167 +  [idxs tuple]
  47.168 +  (modify-indexes idxs tuple conj))
  47.169 +
  47.170 +(defn- remove-from-indexes
  47.171 +  "Removes the tuple from the appropriate keys in the index map"
  47.172 +  [idxs tuple]
  47.173 +  (modify-indexes idxs tuple disj))
  47.174 +
  47.175 +(defn add-tuple
  47.176 +  "Two forms:
  47.177 +
  47.178 +   [db relation-name tuple] adds tuple to the named relation.  Returns
  47.179 +   the new database.
  47.180 +
  47.181 +   [rel tuple] adds to the relation object.  Returns the new relation."
  47.182 +  ([db rel-name tuple]
  47.183 +     (assert (= (-> tuple keys set) (-> rel-name db :schema)))
  47.184 +     (assoc db rel-name (add-tuple (db rel-name) tuple)))
  47.185 +  ([rel tuple]
  47.186 +     (let [data (:data rel)
  47.187 +           new-data (conj data tuple)]
  47.188 +       (if (identical? data new-data) ; optimization hack!
  47.189 +         rel
  47.190 +         (let [idxs (add-to-indexes (:indexes rel) tuple)]
  47.191 +           (assoc rel :data new-data :indexes idxs))))))
  47.192 +
  47.193 +(defn remove-tuple
  47.194 +  "Two forms:
  47.195 +
  47.196 +   [db relation-name tuple] removes the tuple from the named relation,
  47.197 +   returns a new database.
  47.198 +
  47.199 +   [rel tuple] removes the tuple from the relation.  Returns the new
  47.200 +   relation."
  47.201 +  ([db rel-name tuple] (assoc db rel-name (remove-tuple (db rel-name) tuple)))
  47.202 +  ([rel tuple]
  47.203 +     (let [data (:data rel)
  47.204 +           new-data (disj data tuple)]
  47.205 +       (if (identical? data new-data)
  47.206 +         rel
  47.207 +         (let [idxs (remove-from-indexes (:indexes rel) tuple)]
  47.208 +           (assoc rel :data new-data :indexes idxs))))))
  47.209 +                      
  47.210 +(defn add-tuples
  47.211 +  "Adds a collection of tuples to the db, as
  47.212 +   (add-tuples db
  47.213 +      [:rel-name :key-1 1 :key-2 2]
  47.214 +      [:rel-name :key-1 2 :key-2 3])"
  47.215 +  [db & tupls]
  47.216 +  (reduce #(add-tuple %1 (first %2) (apply hash-map (next %2))) db tupls))
  47.217 +
  47.218 +(defn- find-indexes
  47.219 +  "Given a map of indexes and a partial tuple, return the sets of full tuples"
  47.220 +  [idxs pt]
  47.221 +  (if (empty? idxs)
  47.222 +    nil
  47.223 +    (filter identity (for [key (keys pt)]
  47.224 +                       (if-let [idx-map (idxs key)]
  47.225 +                         (get idx-map (pt key) #{})
  47.226 +                         nil)))))
  47.227 +
  47.228 +(defn- match?
  47.229 +  "Is m2 contained in m1?"
  47.230 +  [m1 m2]
  47.231 +  (let [compare (fn [key]
  47.232 +                  (and (contains? m1 key)
  47.233 +                       (= (m1 key) (m2 key))))]
  47.234 +  (every? compare (keys m2))))
  47.235 +
  47.236 +(defn- scan-space
  47.237 +  "Computes a stream of tuples from relation rn matching partial tuple (pt)
  47.238 +   and applies fun to each"
  47.239 +  [fun db rn pt]
  47.240 +  (let [rel (db rn)
  47.241 +        idxs (find-indexes (:indexes rel) pt)
  47.242 +        space (if (empty? idxs)
  47.243 +                (:data rel) ; table scan :(
  47.244 +                (reduce intersection idxs))]
  47.245 +    (trace-datalog (when (empty? idxs)
  47.246 +                     (println (format "Table scan of %s: %s rows!!!!!"
  47.247 +                                      rn
  47.248 +                                      (count space)))))
  47.249 +    (fun #(match? % pt) space)))
  47.250 +    
  47.251 +(defn select
  47.252 +  "finds all matching tuples to the partial tuple (pt) in the relation named (rn)"
  47.253 +  [db rn pt]
  47.254 +  (scan-space filter db rn pt))
  47.255 +
  47.256 +(defn any-match?
  47.257 +  "Finds if there are any matching records for the partial tuple"
  47.258 +  [db rn pt]
  47.259 +  (if (= (-> pt keys set) (:schema (db rn)))
  47.260 +    (contains? (:data (db rn)) pt)
  47.261 +    (scan-space some db rn pt)))
  47.262 +
  47.263 +
  47.264 +;;; Merge
  47.265 +
  47.266 +(defn merge-indexes
  47.267 +  [idx1 idx2]
  47.268 +  (merge-with (fn [h1 h2] (merge-with union h1 h2)) idx1 idx2))
  47.269 +  
  47.270 +(defn merge-relations
  47.271 +  "Merges two relations"
  47.272 +  [r1 r2]
  47.273 +  (assert (= (:schema r1) (:schema r2)))
  47.274 +  (let [merged-indexes (merge-indexes (:indexes r1)
  47.275 +                                      (:indexes r2))
  47.276 +        merged-data (union (:data r1)
  47.277 +                           (:data r2))]
  47.278 +    (assoc r1 :data merged-data :indexes merged-indexes)))
  47.279 +    
  47.280 +(defn database-merge
  47.281 +  "Merges databases together"
  47.282 +  [dbs]
  47.283 +  (apply merge-with merge-relations dbs))
  47.284 +
  47.285 +(defn database-merge-parallel
  47.286 +  "Merges databases together in parallel"
  47.287 +  [dbs]
  47.288 +  (preduce merge-relations dbs))
  47.289 +
  47.290 +
  47.291 +;; End of file
    48.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    48.2 +++ b/src/clojure/contrib/datalog/literals.clj	Sat Aug 21 06:25:44 2010 -0400
    48.3 @@ -0,0 +1,413 @@
    48.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    48.5 +;;  distribution terms for this software are covered by the Eclipse Public
    48.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    48.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    48.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    48.9 +;;  terms of this license.  You must not remove this notice, or any other,
   48.10 +;;  from this software.
   48.11 +;;
   48.12 +;;  literals.clj
   48.13 +;;
   48.14 +;;  A Clojure implementation of Datalog -- Literals
   48.15 +;;
   48.16 +;;  straszheimjeffrey (gmail)
   48.17 +;;  Created 25 Feburary 2009
   48.18 +
   48.19 +
   48.20 +(ns clojure.contrib.datalog.literals
   48.21 +  (:use clojure.contrib.datalog.util)
   48.22 +  (:use clojure.contrib.datalog.database)
   48.23 +  (:use [clojure.set :only (intersection)])
   48.24 +  (:use [clojure.contrib.set :only (subset?)]))
   48.25 +
   48.26 +
   48.27 +;;; Type Definitions
   48.28 +
   48.29 +(defstruct atomic-literal
   48.30 +  :predicate              ; The predicate name
   48.31 +  :term-bindings          ; A map of column names to bindings
   48.32 +  :literal-type)          ; ::literal or ::negated
   48.33 +
   48.34 +(derive ::negated ::literal)
   48.35 +
   48.36 +(defstruct conditional-literal
   48.37 +  :fun                    ; The fun to call
   48.38 +  :symbol                 ; The fun symbol (for display)
   48.39 +  :terms                  ; The formal arguments
   48.40 +  :literal-type)          ; ::conditional
   48.41 +
   48.42 +
   48.43 +;;; Basics
   48.44 +
   48.45 +
   48.46 +(defmulti literal-predicate
   48.47 +  "Return the predicate/relation this conditional operates over"
   48.48 +  :literal-type)
   48.49 +
   48.50 +(defmulti literal-columns
   48.51 +  "Return the column names this applies to"
   48.52 +  :literal-type)
   48.53 +
   48.54 +(defmulti literal-vars
   48.55 +  "Returns the logic vars used by this literal"
   48.56 +  :literal-type)
   48.57 +
   48.58 +(defmulti positive-vars
   48.59 +  "Returns the logic vars used in a positive position"
   48.60 +  :literal-type)
   48.61 +
   48.62 +(defmulti negative-vars
   48.63 +  "Returns the logic vars used in a negative position"
   48.64 +  :literal-type)
   48.65 +
   48.66 +(defmethod literal-predicate ::literal
   48.67 +  [l]
   48.68 +  (:predicate l))
   48.69 +
   48.70 +(defmethod literal-predicate ::conditional
   48.71 +  [l]
   48.72 +  nil)
   48.73 +
   48.74 +(defmethod literal-columns ::literal
   48.75 +  [l]
   48.76 +  (-> l :term-bindings keys set))
   48.77 +
   48.78 +(defmethod literal-columns ::conditional
   48.79 +  [l]
   48.80 +  nil)
   48.81 +
   48.82 +(defmethod literal-vars ::literal
   48.83 +  [l]
   48.84 +  (set (filter is-var? (-> l :term-bindings vals))))
   48.85 +
   48.86 +(defmethod literal-vars ::conditional
   48.87 +  [l]
   48.88 +  (set (filter is-var? (:terms l))))
   48.89 +
   48.90 +(defmethod positive-vars ::literal
   48.91 +  [l]
   48.92 +  (literal-vars l))
   48.93 +
   48.94 +(defmethod positive-vars ::negated
   48.95 +  [l]
   48.96 +  nil)
   48.97 +
   48.98 +(defmethod positive-vars ::conditional
   48.99 +  [l]
  48.100 +  nil)
  48.101 +
  48.102 +(defmethod negative-vars ::literal
  48.103 +  [l]
  48.104 +  nil)
  48.105 +
  48.106 +(defmethod negative-vars ::negated
  48.107 +  [l]
  48.108 +  (literal-vars l))
  48.109 +
  48.110 +(defmethod negative-vars ::conditional
  48.111 +  [l]
  48.112 +  (literal-vars l))
  48.113 +
  48.114 +(defn negated?
  48.115 +  "Is this literal a negated literal?"
  48.116 +  [l]
  48.117 +  (= (:literal-type l) ::negated))
  48.118 +
  48.119 +(defn positive?
  48.120 +  "Is this a positive literal?"
  48.121 +  [l]
  48.122 +  (= (:literal-type l) ::literal))
  48.123 +
  48.124 +
  48.125 +;;; Building Literals
  48.126 +
  48.127 +(def negation-symbol 'not!)
  48.128 +(def conditional-symbol 'if)
  48.129 +
  48.130 +(defmulti build-literal
  48.131 +  "(Returns an unevaluated expression (to be used in macros) of a
  48.132 +   literal."
  48.133 +  first)
  48.134 +
  48.135 +(defn build-atom
  48.136 +  "Returns an unevaluated expression (to be used in a macro) of an
  48.137 +   atom."
  48.138 +  [f type]
  48.139 +  (let [p (first f)
  48.140 +        ts (map #(if (is-var? %) `(quote ~%) %) (next f))
  48.141 +        b (if (seq ts) (apply assoc {} ts) nil)]
  48.142 +    `(struct atomic-literal ~p ~b ~type)))
  48.143 +
  48.144 +(defmethod build-literal :default
  48.145 +  [f]
  48.146 +  (build-atom f ::literal))
  48.147 +
  48.148 +(defmethod build-literal negation-symbol
  48.149 +  [f]
  48.150 +  (build-atom (rest f) ::negated))
  48.151 +
  48.152 +(defmethod build-literal conditional-symbol
  48.153 +  [f]
  48.154 +  (let [symbol (fnext f)
  48.155 +        terms (nnext f)
  48.156 +        fun `(fn [binds#] (apply ~symbol binds#))]
  48.157 +    `(struct conditional-literal
  48.158 +             ~fun
  48.159 +             '~symbol
  48.160 +             '~terms
  48.161 +             ::conditional)))
  48.162 +
  48.163 +
  48.164 +;;; Display
  48.165 +
  48.166 +(defmulti display-literal
  48.167 +  "Converts a struct representing a literal to a normal list"
  48.168 +  :literal-type)
  48.169 +
  48.170 +(defn- display
  48.171 +  [l]
  48.172 +  (conj (-> l :term-bindings list* flatten) (literal-predicate l)))
  48.173 +
  48.174 +(defmethod display-literal ::literal
  48.175 +  [l]
  48.176 +  (display l))
  48.177 +
  48.178 +(defmethod display-literal ::negated
  48.179 +  [l]
  48.180 +  (conj (display l) negation-symbol))
  48.181 +
  48.182 +(defmethod display-literal ::conditional
  48.183 +  [l]
  48.184 +  (list* conditional-symbol (:symbol l) (:terms l)))
  48.185 +
  48.186 +
  48.187 +;;; Sip computation
  48.188 +
  48.189 +(defmulti get-vs-from-cs
  48.190 +  "From a set of columns, return the vars"
  48.191 +  :literal-type)
  48.192 +
  48.193 +(defmethod get-vs-from-cs ::literal
  48.194 +  [l bound]
  48.195 +  (set (filter is-var?
  48.196 +               (vals (select-keys (:term-bindings l)
  48.197 +                                  bound)))))
  48.198 +
  48.199 +(defmethod get-vs-from-cs ::conditional
  48.200 +  [l bound]
  48.201 +  nil)
  48.202 +
  48.203 +
  48.204 +(defmulti get-cs-from-vs
  48.205 +  "From a set of vars, get the columns"
  48.206 +  :literal-type)
  48.207 +
  48.208 +(defmethod get-cs-from-vs ::literal
  48.209 +  [l bound]
  48.210 +  (reduce conj
  48.211 +          #{}
  48.212 +          (remove nil? 
  48.213 +                  (map (fn [[k v]] (if (bound v) k nil))
  48.214 +                       (:term-bindings l)))))
  48.215 +
  48.216 +(defmethod get-cs-from-vs ::conditional
  48.217 +  [l bound]
  48.218 +  nil)
  48.219 +
  48.220 +
  48.221 +(defmulti get-self-bound-cs
  48.222 +  "Get the columns that are bound withing the literal."
  48.223 +  :literal-type)
  48.224 +
  48.225 +(defmethod get-self-bound-cs ::literal
  48.226 +  [l]
  48.227 +  (reduce conj
  48.228 +          #{}
  48.229 +          (remove nil?
  48.230 +                  (map (fn [[k v]] (if (not (is-var? v)) k nil))
  48.231 +                       (:term-bindings l)))))
  48.232 +
  48.233 +(defmethod get-self-bound-cs ::conditional
  48.234 +  [l]
  48.235 +  nil)
  48.236 +
  48.237 +
  48.238 +(defmulti literal-appropriate?
  48.239 +  "When passed a set of bound vars, determines if this literal can be
  48.240 +   used during this point of a SIP computation."
  48.241 +  (fn [b l] (:literal-type l)))
  48.242 +
  48.243 +(defmethod literal-appropriate? ::literal
  48.244 +  [bound l]
  48.245 +  (not (empty? (intersection (literal-vars l) bound))))
  48.246 +
  48.247 +(defmethod literal-appropriate? ::negated
  48.248 +  [bound l]
  48.249 +  (subset? (literal-vars l) bound))
  48.250 +
  48.251 +(defmethod literal-appropriate? ::conditional
  48.252 +  [bound l]
  48.253 +  (subset? (literal-vars l) bound))
  48.254 +
  48.255 +
  48.256 +(defmulti adorned-literal
  48.257 +  "When passed a set of bound columns, returns the adorned literal"
  48.258 +  (fn [l b] (:literal-type l)))
  48.259 +
  48.260 +(defmethod adorned-literal ::literal
  48.261 +  [l bound]
  48.262 +  (let [pred (literal-predicate l)
  48.263 +        bnds (intersection (literal-columns l) bound)]
  48.264 +    (if (empty? bound)
  48.265 +      l
  48.266 +      (assoc l :predicate {:pred pred :bound bnds}))))
  48.267 +
  48.268 +(defmethod adorned-literal ::conditional
  48.269 +  [l bound]
  48.270 +  l)
  48.271 +
  48.272 +
  48.273 +(defn get-adorned-bindings
  48.274 +  "Get the bindings from this adorned literal."
  48.275 +  [pred]
  48.276 +  (:bound pred))
  48.277 +
  48.278 +(defn get-base-predicate
  48.279 +  "Get the base predicate from this predicate."
  48.280 +  [pred]
  48.281 +  (if (map? pred)
  48.282 +    (:pred pred)
  48.283 +    pred))
  48.284 +
  48.285 +
  48.286 +;;; Magic Stuff
  48.287 +
  48.288 +(defn magic-literal
  48.289 +  "Create a magic version of this adorned predicate."
  48.290 +  [l]
  48.291 +  (assert (-> l :literal-type (isa? ::literal)))
  48.292 +  (let [pred (literal-predicate l)
  48.293 +        pred-map (if (map? pred) pred {:pred pred})
  48.294 +        bound (get-adorned-bindings pred)
  48.295 +        ntb (select-keys (:term-bindings l) bound)]
  48.296 +    (assoc l :predicate (assoc pred-map :magic true) :term-bindings ntb :literal-type ::literal)))
  48.297 +
  48.298 +(defn literal-magic?
  48.299 +  "Is this literal magic?"
  48.300 +  [lit]
  48.301 +  (let [pred (literal-predicate lit)]
  48.302 +    (when (map? pred)
  48.303 +      (:magic pred))))
  48.304 +      
  48.305 +(defn build-seed-bindings
  48.306 +  "Given a seed literal, already adorned and in magic form, convert
  48.307 +   its bound constants to new variables."
  48.308 +  [s]
  48.309 +  (assert (-> s :literal-type (isa? ::literal)))
  48.310 +  (let [ntbs (map-values (fn [_] (gensym '?_gen_)) (:term-bindings s))]
  48.311 +    (assoc s :term-bindings ntbs)))
  48.312 +
  48.313 +
  48.314 +;;; Semi-naive support
  48.315 +
  48.316 +(defn negated-literal
  48.317 +  "Given a literal l, return a negated version"
  48.318 +  [l]
  48.319 +  (assert (-> l :literal-type (= ::literal)))
  48.320 +  (assoc l :literal-type ::negated))
  48.321 +
  48.322 +(defn delta-literal
  48.323 +  "Given a literal l, return a delta version"
  48.324 +  [l]
  48.325 +  (let [pred* (:predicate l)
  48.326 +        pred (if (map? pred*) pred* {:pred pred*})]
  48.327 +    (assoc l :predicate (assoc pred :delta true))))
  48.328 +
  48.329 +        
  48.330 +;;; Database operations
  48.331 +
  48.332 +(defn- build-partial-tuple
  48.333 +  [lit binds]
  48.334 +  (let [tbs (:term-bindings lit)
  48.335 +        each (fn [[key val :as pair]]
  48.336 +               (if (is-var? val)
  48.337 +                 (if-let [n (binds val)]
  48.338 +                   [key n]
  48.339 +                   nil)
  48.340 +                 pair))]
  48.341 +    (into {} (remove nil? (map each tbs)))))
  48.342 +
  48.343 +(defn- project-onto-literal
  48.344 +  "Given a literal, and a materialized tuple, return a set of variable
  48.345 +   bindings."
  48.346 +  [lit tuple]
  48.347 +  (let [step (fn [binds [key val]]
  48.348 +               (if (and (is-var? val)
  48.349 +                        (contains? tuple key))
  48.350 +                 (assoc binds val (tuple key))
  48.351 +                 binds))]
  48.352 +    (reduce step {} (:term-bindings lit))))
  48.353 +  
  48.354 +
  48.355 +(defn- join-literal*
  48.356 +  [db lit bs fun]
  48.357 +  (let [each (fn [binds]
  48.358 +               (let [pt (build-partial-tuple lit binds)]
  48.359 +                 (fun binds pt)))]
  48.360 +    (when (contains? db (literal-predicate lit))
  48.361 +      (apply concat (map each bs)))))
  48.362 +
  48.363 +(defmulti join-literal
  48.364 +  "Given a database (db), a literal (lit) and a seq of bindings (bs),
  48.365 +   return a new seq of bindings by joining this literal."
  48.366 +  (fn [db lit bs] (:literal-type lit)))
  48.367 +
  48.368 +(defmethod join-literal ::literal
  48.369 +  [db lit bs]
  48.370 +  (join-literal* db lit bs (fn [binds pt]
  48.371 +                             (map #(merge binds %)
  48.372 +                                  (map (partial project-onto-literal lit)
  48.373 +                                       (select db (literal-predicate lit) pt))))))
  48.374 +
  48.375 +(defmethod join-literal ::negated
  48.376 +  [db lit bs]
  48.377 +  (join-literal* db lit bs (fn [binds pt]
  48.378 +                             (if (any-match? db (literal-predicate lit) pt)
  48.379 +                               nil
  48.380 +                               [binds]))))
  48.381 +
  48.382 +(defmethod join-literal ::conditional
  48.383 +  [db lit bs]
  48.384 +  (let [each (fn [binds]
  48.385 +               (let [resolve (fn [term]
  48.386 +                               (if (is-var? term)
  48.387 +                                 (binds term)
  48.388 +                                 term))
  48.389 +                     args (map resolve (:terms lit))]
  48.390 +                 (if ((:fun lit) args)
  48.391 +                   binds
  48.392 +                   nil)))]
  48.393 +    (remove nil? (map each bs))))
  48.394 +                 
  48.395 +(defn project-literal
  48.396 +  "Project a stream of bindings onto a literal/relation. Returns a new
  48.397 +   db."
  48.398 +  ([db lit bs] (project-literal db lit bs is-var?))
  48.399 +  ([db lit bs var?]
  48.400 +     (assert (= (:literal-type lit) ::literal))
  48.401 +     (let [rel-name (literal-predicate lit)
  48.402 +           columns (-> lit :term-bindings keys)
  48.403 +           idxs (vec (get-adorned-bindings (literal-predicate lit)))
  48.404 +           db1 (ensure-relation db rel-name columns idxs)
  48.405 +           rel (get-relation db1 rel-name)
  48.406 +           step (fn [rel bindings]
  48.407 +                  (let [step (fn [t [k v]]
  48.408 +                               (if (var? v)
  48.409 +                                 (assoc t k (bindings v))
  48.410 +                                 (assoc t k v)))
  48.411 +                        tuple (reduce step {} (:term-bindings lit))]
  48.412 +                    (add-tuple rel tuple)))]
  48.413 +       (replace-relation db rel-name (reduce step rel bs)))))
  48.414 +
  48.415 +
  48.416 +;; End of file
    49.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    49.2 +++ b/src/clojure/contrib/datalog/magic.clj	Sat Aug 21 06:25:44 2010 -0400
    49.3 @@ -0,0 +1,128 @@
    49.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    49.5 +;;  distribution terms for this software are covered by the Eclipse Public
    49.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    49.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    49.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    49.9 +;;  terms of this license.  You must not remove this notice, or any other,
   49.10 +;;  from this software.
   49.11 +;;
   49.12 +;;  magic.clj
   49.13 +;;
   49.14 +;;  A Clojure implementation of Datalog -- Magic Sets
   49.15 +;;
   49.16 +;;  straszheimjeffrey (gmail)
   49.17 +;;  Created 18 Feburary 2009
   49.18 +
   49.19 +
   49.20 +(ns clojure.contrib.datalog.magic
   49.21 +  (:use clojure.contrib.datalog.util
   49.22 +        clojure.contrib.datalog.literals
   49.23 +        clojure.contrib.datalog.rules)
   49.24 +  (:use [clojure.set :only (union intersection difference)]))
   49.25 +
   49.26 +
   49.27 +;;; Adornment
   49.28 +
   49.29 +(defn adorn-query
   49.30 +  "Adorn a query"
   49.31 +  [q]
   49.32 +  (adorned-literal q (get-self-bound-cs q)))
   49.33 +
   49.34 +(defn adorn-rules-set
   49.35 +  "Adorns the given rules-set for the given query.  (rs) is a
   49.36 +   rules-set, (q) is an adorned query."
   49.37 +  [rs q]
   49.38 +  (let [i-preds (all-predicates rs)
   49.39 +        p-map (predicate-map rs)]
   49.40 +    (loop [nrs empty-rules-set ; The rules set being built
   49.41 +           needed #{(literal-predicate q)}]
   49.42 +      (if (empty? needed)
   49.43 +          nrs
   49.44 +          (let [pred (first needed)
   49.45 +                remaining (disj needed pred)
   49.46 +                base-pred (get-base-predicate pred)
   49.47 +                bindings (get-adorned-bindings pred)
   49.48 +                new-rules (p-map base-pred)
   49.49 +                new-adorned-rules (map (partial compute-sip bindings i-preds)
   49.50 +                                       new-rules)
   49.51 +                new-nrs (reduce conj nrs new-adorned-rules)
   49.52 +                current-preds (all-predicates new-nrs)
   49.53 +                not-needed? (fn [pred]
   49.54 +                              (or (current-preds pred)
   49.55 +                                  (-> pred get-base-predicate i-preds not)))
   49.56 +                add-pred (fn [np pred]
   49.57 +                           (if (not-needed? pred) np (conj np pred)))
   49.58 +                add-preds (fn [np rule]
   49.59 +                            (reduce add-pred np (map literal-predicate (:body rule))))
   49.60 +                new-needed (reduce add-preds remaining new-adorned-rules)]
   49.61 +            (recur new-nrs new-needed))))))
   49.62 +
   49.63 +
   49.64 +;;; Magic !
   49.65 +
   49.66 +(defn seed-relation
   49.67 +  "Given a magic form of a query, give back the literal form of its seed
   49.68 +   relation"
   49.69 +  [q]
   49.70 +  (let [pred (-> q literal-predicate get-base-predicate)
   49.71 +        bnds (-> q literal-predicate get-adorned-bindings)]
   49.72 +    (with-meta (assoc q :predicate [pred :magic-seed bnds]) {})))
   49.73 +
   49.74 +(defn seed-rule
   49.75 +  "Given an adorned query, give back its seed rule"
   49.76 +  [q]
   49.77 +  (let [mq (build-seed-bindings (magic-literal q))
   49.78 +        sr (seed-relation mq)]
   49.79 +    (build-rule mq [sr])))
   49.80 +
   49.81 +(defn build-partial-tuple
   49.82 +  "Given a query and a set of bindings, build a partial tuple needed
   49.83 +   to extract the relation from the database."
   49.84 +  [q bindings]
   49.85 +  (into {} (remove nil? (map (fn [[k v :as pair]]
   49.86 +                               (if (is-var? v)
   49.87 +                                 nil
   49.88 +                                 (if (is-query-var? v)
   49.89 +                                   [k (bindings v)]
   49.90 +                                   pair)))
   49.91 +                             (:term-bindings q)))))
   49.92 +
   49.93 +(defn seed-predicate-for-insertion
   49.94 +  "Given a query, return the predicate to use for database insertion."
   49.95 +  [q]
   49.96 +  (let [seed (-> q seed-rule :body first)
   49.97 +        columns (-> seed :term-bindings keys)
   49.98 +        new-term-bindings (-> q :term-bindings (select-keys columns))]
   49.99 +    (assoc seed :term-bindings new-term-bindings)))
  49.100 +    
  49.101 +(defn magic-transform
  49.102 +  "Return a magic transformation of an adorned rules-set (rs).  The
  49.103 +   (i-preds) are the predicates of the intension database.  These
  49.104 +   default to the predicates within the rules-set."
  49.105 +  ([rs]
  49.106 +     (magic-transform rs (all-predicates rs)))
  49.107 +  ([rs i-preds]
  49.108 +     (let [not-duplicate? (fn [l mh bd]
  49.109 +                            (or (not (empty? bd))
  49.110 +                                (not (= (magic-literal l)
  49.111 +                                        mh))))
  49.112 +           xr (fn [rs rule]
  49.113 +                (let [head (:head rule)
  49.114 +                      body (:body rule)
  49.115 +                      mh (magic-literal head)
  49.116 +                      answer-rule (build-rule head
  49.117 +                                              (concat [mh] body))
  49.118 +                      step (fn [[rs bd] l]
  49.119 +                             (if (and (i-preds (literal-predicate l))
  49.120 +                                      (not-duplicate? l mh bd))
  49.121 +                               (let [nr (build-rule (magic-literal l)
  49.122 +                                                    (concat [mh] bd))]
  49.123 +                                 [(conj rs nr) (conj bd l)])
  49.124 +                               [rs (conj bd l)]))
  49.125 +                      [nrs _] (reduce step [rs []] body)]
  49.126 +                  (conj nrs answer-rule)))]
  49.127 +     (reduce xr empty-rules-set rs))))
  49.128 +             
  49.129 +         
  49.130 +
  49.131 +;; End of file
    50.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    50.2 +++ b/src/clojure/contrib/datalog/rules.clj	Sat Aug 21 06:25:44 2010 -0400
    50.3 @@ -0,0 +1,208 @@
    50.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    50.5 +;;  distribution terms for this software are covered by the Eclipse Public
    50.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    50.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    50.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    50.9 +;;  terms of this license.  You must not remove this notice, or any other,
   50.10 +;;  from this software.
   50.11 +;;
   50.12 +;;  rules.clj
   50.13 +;;
   50.14 +;;  A Clojure implementation of Datalog -- Rules Engine
   50.15 +;;
   50.16 +;;  straszheimjeffrey (gmail)
   50.17 +;;  Created 2 Feburary 2009
   50.18 +
   50.19 +
   50.20 +(ns clojure.contrib.datalog.rules
   50.21 +  (:use clojure.contrib.datalog.util)
   50.22 +  (:use clojure.contrib.datalog.literals
   50.23 +       clojure.contrib.datalog.database)
   50.24 +  (:use [clojure.set :only (union intersection difference)])
   50.25 +  (:use [clojure.contrib.set :only (subset?)])
   50.26 +  (:use [clojure.contrib.except :only (throwf)])
   50.27 +  (:import java.io.Writer))
   50.28 +
   50.29 +
   50.30 +(defstruct datalog-rule
   50.31 +  :head
   50.32 +  :body)
   50.33 +
   50.34 +(defn display-rule
   50.35 +  "Return the rule in a readable format."
   50.36 +  [rule]
   50.37 +  (list* '<-
   50.38 +         (-> rule :head display-literal)
   50.39 +         (map display-literal (:body rule))))
   50.40 +
   50.41 +(defn display-query
   50.42 +  "Return a query in a readable format."
   50.43 +  [query]
   50.44 +  (list* '?- (display-literal query)))
   50.45 +
   50.46 +
   50.47 +;;; Check rule safety
   50.48 +
   50.49 +(defn is-safe?
   50.50 +  "Is the rule safe according to the datalog protocol?"
   50.51 +  [rule]
   50.52 +  (let [hv (literal-vars (:head rule))
   50.53 +        bpv (apply union (map positive-vars (:body rule)))
   50.54 +        bnv (apply union (map negative-vars (:body rule)))
   50.55 +        ehv (difference hv bpv)
   50.56 +        env (difference bnv bpv)]
   50.57 +    (when-not (empty? ehv)
   50.58 +      (throwf "Head vars %s not bound in body in rule %s" ehv rule))
   50.59 +    (when-not (empty? env)
   50.60 +      (throwf "Body vars %s not bound in negative positions in rule %s" env rule))
   50.61 +    rule))
   50.62 +
   50.63 +
   50.64 +;;; Rule creation and printing
   50.65 +
   50.66 +(defn build-rule
   50.67 +  [hd bd]
   50.68 +  (with-meta (struct datalog-rule hd bd) {:type ::datalog-rule}))
   50.69 +
   50.70 +(defmacro <-
   50.71 +  "Build a datalog rule.  Like this:
   50.72 +
   50.73 +   (<- (:head :x ?x :y ?y) (:body-1 :x ?x :y ?y) (:body-2 :z ?z) (not! :body-3 :x ?x) (if > ?y ?z))"
   50.74 +  [hd & body]
   50.75 +  (let [head (build-atom hd :clojure.contrib.datalog.literals/literal)
   50.76 +        body (map build-literal body)]
   50.77 +    `(is-safe? (build-rule ~head [~@body]))))
   50.78 +
   50.79 +(defmethod print-method ::datalog-rule
   50.80 +  [rule ^Writer writer]
   50.81 +  (print-method (display-rule rule) writer))
   50.82 +
   50.83 +(defn return-rule-data
   50.84 +  "Returns an untypted rule that will be fully printed"
   50.85 +  [rule]
   50.86 +  (with-meta rule {}))
   50.87 +
   50.88 +(defmacro ?-
   50.89 +  "Define a datalog query"
   50.90 +  [& q]
   50.91 +  (let [qq (build-atom q :clojure.contrib.datalog.literals/literal)]
   50.92 +  `(with-meta ~qq {:type ::datalog-query})))
   50.93 +
   50.94 +(defmethod print-method ::datalog-query
   50.95 +  [query ^Writer writer]
   50.96 +  (print-method (display-query query) writer))
   50.97 +
   50.98 +
   50.99 +
  50.100 +;;; SIP
  50.101 +
  50.102 +(defn compute-sip
  50.103 +  "Given a set of bound column names, return an adorned sip for this
  50.104 +   rule.  A set of intensional predicates should be provided to
  50.105 +   determine what should be adorned."
  50.106 +  [bindings i-preds rule]
  50.107 +  (let [next-lit (fn [bv body]
  50.108 +                   (or (first (drop-while
  50.109 +                               #(not (literal-appropriate? bv %))
  50.110 +                               body))
  50.111 +                       (first (drop-while (complement positive?) body))))
  50.112 +        adorn (fn [lit bvs]
  50.113 +                (if (i-preds (literal-predicate lit))
  50.114 +                  (let [bnds (union (get-cs-from-vs lit bvs)
  50.115 +                                    (get-self-bound-cs lit))]
  50.116 +                    (adorned-literal lit bnds))
  50.117 +                  lit))
  50.118 +        new-h (adorned-literal (:head rule) bindings)]
  50.119 +    (loop [bound-vars (get-vs-from-cs (:head rule) bindings)
  50.120 +           body (:body rule)
  50.121 +           sip []]
  50.122 +      (if-let [next (next-lit bound-vars body)]
  50.123 +        (recur (union bound-vars (literal-vars next))
  50.124 +               (remove #(= % next) body)
  50.125 +               (conj sip (adorn next bound-vars)))
  50.126 +        (build-rule new-h (concat sip body))))))
  50.127 +
  50.128 +
  50.129 +;;; Rule sets
  50.130 +
  50.131 +(defn make-rules-set
  50.132 +  "Given an existing set of rules, make it a 'rules-set' for
  50.133 +   printing."
  50.134 +  [rs]
  50.135 +  (with-meta rs {:type ::datalog-rules-set}))
  50.136 +    
  50.137 +(def empty-rules-set (make-rules-set #{}))
  50.138 +
  50.139 +(defn rules-set
  50.140 +  "Given a collection of rules return a rules set"
  50.141 +  [& rules]
  50.142 +  (reduce conj empty-rules-set rules))
  50.143 +  
  50.144 +(defmethod print-method ::datalog-rules-set
  50.145 +  [rules ^Writer writer]
  50.146 +  (binding [*out* writer]
  50.147 +    (do
  50.148 +      (print "(rules-set")
  50.149 +      (doseq [rule rules]
  50.150 +        (println)
  50.151 +        (print "   ")
  50.152 +        (print rule))
  50.153 +      (println ")"))))
  50.154 +
  50.155 +(defn predicate-map
  50.156 +  "Given a rules-set, return a map of rules keyed by their predicates.
  50.157 +   Each value will be a set of rules."
  50.158 +  [rs]
  50.159 +  (let [add-rule (fn [m r]
  50.160 +                   (let [pred (-> r :head literal-predicate)
  50.161 +                         os (get m pred #{})]
  50.162 +                     (assoc m pred (conj os r))))]
  50.163 +    (reduce add-rule {} rs)))
  50.164 +
  50.165 +(defn all-predicates
  50.166 +  "Given a rules-set, return all defined predicates"
  50.167 +  [rs]
  50.168 +  (set (map literal-predicate (map :head rs))))
  50.169 +
  50.170 +(defn non-base-rules
  50.171 +  "Return a collection of rules that depend, somehow, on other rules"
  50.172 +  [rs]
  50.173 +  (let [pred (all-predicates rs)
  50.174 +        non-base (fn [r]
  50.175 +                   (if (some #(pred %)
  50.176 +                             (map literal-predicate (:body r)))
  50.177 +                     r
  50.178 +                     nil))]
  50.179 +    (remove nil? (map non-base rs))))
  50.180 +
  50.181 +
  50.182 +;;; Database operations
  50.183 +
  50.184 +(def empty-bindings [{}])
  50.185 +
  50.186 +(defn apply-rule
  50.187 +  "Apply the rule against db-1, adding the results to the appropriate
  50.188 +   relation in db-2.  The relation will be created if needed."
  50.189 +  ([db rule] (apply-rule db db rule))
  50.190 +  ([db-1 db-2 rule]
  50.191 +     (trace-datalog (println)
  50.192 +                    (println)
  50.193 +                    (println "--------------- Begin Rule ---------------")
  50.194 +                    (println rule))
  50.195 +     (let [head (:head rule)
  50.196 +           body (:body rule)
  50.197 +           step (fn [bs lit]
  50.198 +                  (trace-datalog (println bs)
  50.199 +                                 (println lit))
  50.200 +                  (join-literal db-1 lit bs))
  50.201 +           bs (reduce step empty-bindings body)]
  50.202 +       (do (trace-datalog (println bs))
  50.203 +           (project-literal db-2 head bs)))))
  50.204 +
  50.205 +(defn apply-rules-set
  50.206 +  [db rs]
  50.207 +  (reduce (fn [rdb rule]
  50.208 +            (apply-rule db rdb rule)) db rs))
  50.209 +
  50.210 +
  50.211 +;; End of file
  50.212 \ No newline at end of file
    51.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    51.2 +++ b/src/clojure/contrib/datalog/softstrat.clj	Sat Aug 21 06:25:44 2010 -0400
    51.3 @@ -0,0 +1,161 @@
    51.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    51.5 +;;  distribution terms for this software are covered by the Eclipse Public
    51.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    51.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    51.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    51.9 +;;  terms of this license.  You must not remove this notice, or any other,
   51.10 +;;  from this software.
   51.11 +;;
   51.12 +;;  softstrat.clj
   51.13 +;;
   51.14 +;;  A Clojure implementation of Datalog -- Soft Stratification
   51.15 +;;
   51.16 +;;  straszheimjeffrey (gmail)
   51.17 +;;  Created 28 Feburary 2009
   51.18 +
   51.19 +
   51.20 +(ns clojure.contrib.datalog.softstrat
   51.21 +  (:use clojure.contrib.datalog.util
   51.22 +        clojure.contrib.datalog.database
   51.23 +        clojure.contrib.datalog.literals
   51.24 +        clojure.contrib.datalog.rules
   51.25 +        clojure.contrib.datalog.magic)
   51.26 +  (:use [clojure.set :only (union intersection difference)])
   51.27 +  (:use [clojure.contrib.seq :only (indexed)])
   51.28 +  (:require [clojure.contrib.graph :as graph]))
   51.29 +
   51.30 +
   51.31 +;;; Dependency graph
   51.32 +
   51.33 +(defn- build-rules-graph
   51.34 +  "Given a rules-set (rs), build a graph where each predicate symbol in rs,
   51.35 +   there is a node n, and for each rule (<- h b-1 b-2 ...), there are edges
   51.36 +   from the (literal-predicate h) -> (literal-predicate b-*), one for each
   51.37 +   b-*."
   51.38 +  [rs]
   51.39 +  (let [preds (all-predicates rs)
   51.40 +        pred-map (predicate-map rs)
   51.41 +        step (fn [nbs pred]
   51.42 +               (let [rules (pred-map pred)
   51.43 +                     preds (reduce (fn [pds lits]
   51.44 +                                     (reduce (fn [pds lit]
   51.45 +                                               (if-let [pred (literal-predicate lit)]
   51.46 +                                                 (conj pds pred)
   51.47 +                                                 pds))
   51.48 +                                             pds
   51.49 +                                             lits))
   51.50 +                                   #{}
   51.51 +                                   (map :body rules))]
   51.52 +                 (assoc nbs pred preds)))
   51.53 +        neighbors (reduce step {} preds)]
   51.54 +    (struct graph/directed-graph preds neighbors)))
   51.55 +
   51.56 +(defn- build-def
   51.57 +  "Given a rules-set, build its def function"
   51.58 +  [rs]
   51.59 +  (let [pred-map (predicate-map rs)
   51.60 +        graph (-> rs
   51.61 +                  build-rules-graph
   51.62 +                  graph/transitive-closure
   51.63 +                  graph/add-loops)]
   51.64 +    (fn [pred]
   51.65 +      (apply union (map set (map pred-map (graph/get-neighbors graph pred)))))))
   51.66 +
   51.67 +
   51.68 +;;; Soft Stratificattion REQ Graph                 
   51.69 +
   51.70 +(defn- req
   51.71 +  "Returns a rules-set that is a superset of req(lit) for the lit at
   51.72 +  index lit-index"
   51.73 +  [rs soft-def rule lit-index]
   51.74 +  (let [head (:head rule)
   51.75 +        body (:body rule)
   51.76 +        lit (nth body lit-index)
   51.77 +        pre (subvec (vec body) 0 lit-index)]
   51.78 +    (conj (-> lit literal-predicate soft-def (magic-transform (all-predicates rs)))
   51.79 +          (build-rule (magic-literal lit) pre))))
   51.80 +
   51.81 +(defn- rule-dep
   51.82 +  "Given a rule, return the set of rules it depends on."
   51.83 +  [rs mrs soft-def rule]
   51.84 +  (let [step (fn [nrs [idx lit]]
   51.85 +               (if (negated? lit)
   51.86 +                 (union nrs (req rs soft-def rule idx))
   51.87 +                 nrs))]
   51.88 +    (intersection mrs
   51.89 +                  (reduce step empty-rules-set (-> rule :body indexed)))))
   51.90 +
   51.91 +(defn- soft-strat-graph
   51.92 +  "The dependency graph for soft stratification."
   51.93 +  [rs mrs]
   51.94 +  (let [soft-def (build-def rs)
   51.95 +        step (fn [nbrs rule]
   51.96 +               (assoc nbrs rule (rule-dep rs mrs soft-def rule)))
   51.97 +        nbrs (reduce step {} mrs)]
   51.98 +    (struct graph/directed-graph mrs nbrs)))
   51.99 +
  51.100 +(defn- build-soft-strat
  51.101 +  "Given a rules-set (unadorned) and an adorned query, return the soft
  51.102 +   stratified list.  The rules will be magic transformed, and the
  51.103 +   magic seed will be appended."
  51.104 +  [rs q]
  51.105 +  (let [ars (adorn-rules-set rs q)
  51.106 +        mrs (conj (magic-transform ars)
  51.107 +                  (seed-rule q))
  51.108 +        gr (soft-strat-graph ars mrs)]
  51.109 +    (map make-rules-set (graph/dependency-list gr))))
  51.110 +        
  51.111 +
  51.112 +;;; Work plan
  51.113 +
  51.114 +(defstruct soft-strat-work-plan
  51.115 +  :query
  51.116 +  :stratification)
  51.117 +
  51.118 +(defn build-soft-strat-work-plan
  51.119 +  "Return a work plan for the given rules-set and query"
  51.120 +  [rs q]
  51.121 +  (let [aq (adorn-query q)]
  51.122 +    (struct soft-strat-work-plan aq (build-soft-strat rs aq))))
  51.123 +
  51.124 +(defn get-all-relations
  51.125 +  "Return a set of all relation names defined in this workplan"
  51.126 +  [ws]
  51.127 +  (apply union (map all-predicates (:stratification ws))))
  51.128 +
  51.129 +
  51.130 +;;; Evaluate
  51.131 +
  51.132 +(defn- weak-consq-operator
  51.133 +  [db strat]
  51.134 +  (trace-datalog (println)
  51.135 +                 (println)
  51.136 +                 (println "=============== Begin iteration ==============="))
  51.137 +  (let [counts (database-counts db)]
  51.138 +    (loop [strat strat]
  51.139 +      (let [rs (first strat)]
  51.140 +        (if rs
  51.141 +          (let [new-db (apply-rules-set db rs)]
  51.142 +            (if (= counts (database-counts new-db))
  51.143 +              (recur (next strat))
  51.144 +              new-db))
  51.145 +          db)))))
  51.146 +
  51.147 +(defn evaluate-soft-work-set
  51.148 +  ([ws db] (evaluate-soft-work-set ws db {}))
  51.149 +  ([ws db bindings]
  51.150 +     (let [query (:query ws)
  51.151 +           strat (:stratification ws)
  51.152 +           seed (seed-predicate-for-insertion query)
  51.153 +           seeded-db (project-literal db seed [bindings] is-query-var?)
  51.154 +           fun (fn [data]
  51.155 +                 (weak-consq-operator data strat))
  51.156 +           equal (fn [db1 db2]
  51.157 +                   (= (database-counts db1) (database-counts db2)))
  51.158 +           new-db (graph/fixed-point seeded-db fun nil equal)
  51.159 +           pt (build-partial-tuple query bindings)]
  51.160 +       (select new-db (literal-predicate query) pt))))
  51.161 +
  51.162 +
  51.163 +
  51.164 +;; End of file
    52.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    52.2 +++ b/src/clojure/contrib/datalog/util.clj	Sat Aug 21 06:25:44 2010 -0400
    52.3 @@ -0,0 +1,89 @@
    52.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    52.5 +;;  distribution terms for this software are covered by the Eclipse Public
    52.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    52.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    52.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    52.9 +;;  terms of this license.  You must not remove this notice, or any other,
   52.10 +;;  from this software.
   52.11 +;;
   52.12 +;;  util.clj
   52.13 +;;
   52.14 +;;  A Clojure implementation of Datalog -- Utilities
   52.15 +;;
   52.16 +;;  straszheimjeffrey (gmail)
   52.17 +;;  Created 3 Feburary 2009
   52.18 +
   52.19 +
   52.20 +(ns clojure.contrib.datalog.util
   52.21 +  (:use [clojure.contrib.seq :only (separate)]))
   52.22 +
   52.23 +
   52.24 +
   52.25 +;;; Bindings and logic vars.  A binding in a hash of logic vars to
   52.26 +;;; bound values.  Logic vars are any symbol prefixed with a \?.
   52.27 +
   52.28 +(defn is-var?
   52.29 +  "Is this a logic variable: e.g. a symbol prefixed with a ?"
   52.30 +  [sym]
   52.31 +  (when (symbol? sym)
   52.32 +    (let [name (name sym)]
   52.33 +      (and (= \? (first name))
   52.34 +           (not= \? (fnext name))))))
   52.35 +
   52.36 +(defn is-query-var?
   52.37 +  "Is this a query variable: e.g. a symbol prefixed with ??"
   52.38 +  [sym]
   52.39 +  (when (symbol? sym)
   52.40 +    (let [name (name sym)]
   52.41 +      (and (= \? (first name))
   52.42 +           (= \? (fnext name))))))
   52.43 +
   52.44 +(defn map-values
   52.45 +  "Like map, but works over the values of a hash map"
   52.46 +  [f hash]
   52.47 +  (let [key-vals (map (fn [[key val]] [key (f val)]) hash)]
   52.48 +    (if (seq key-vals)
   52.49 +      (apply conj (empty hash) key-vals)
   52.50 +      hash)))
   52.51 +
   52.52 +(defn keys-to-vals
   52.53 +  "Given a map and a collection of keys, return the collection of vals"
   52.54 +  [m ks]
   52.55 +  (vals (select-keys m ks)))
   52.56 +
   52.57 +(defn reverse-map
   52.58 +  "Reverse the keys/values of a map"
   52.59 +  [m]
   52.60 +  (into {} (map (fn [[k v]] [v k]) m)))
   52.61 +
   52.62 +
   52.63 +;;; Preduce -- A parallel reduce over hashes
   52.64 +  
   52.65 +(defn preduce
   52.66 +  "Similar to merge-with, but the contents of each key are merged in
   52.67 +   parallel using f.
   52.68 +
   52.69 +   f - a function of 2 arguments.
   52.70 +   data - a collection of hashes."
   52.71 +  [f data]
   52.72 +  (let [data-1 (map (fn [h] (map-values #(list %) h)) data)
   52.73 +        merged (doall (apply merge-with concat data-1))
   52.74 +        ; Groups w/ multiple elements are identified for parallel processing
   52.75 +        [complex simple] (separate (fn [[key vals]] (> (count vals) 1)) merged)
   52.76 +        fold-group (fn [[key vals]] {key (reduce f vals)})
   52.77 +        fix-single (fn [[key [val]]] [key val])]
   52.78 +    (apply merge (concat (pmap fold-group merged) (map fix-single simple)))))
   52.79 +  
   52.80 +
   52.81 +;;; Debuging and Tracing
   52.82 +
   52.83 +(def *trace-datalog* nil)
   52.84 +
   52.85 +(defmacro trace-datalog
   52.86 +  "If *test-datalog* is set to true, run the enclosed commands"
   52.87 +  [& body]
   52.88 +  `(when *trace-datalog*
   52.89 +     ~@body))
   52.90 +
   52.91 + 	
   52.92 +;; End of file
    53.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    53.2 +++ b/src/clojure/contrib/def.clj	Sat Aug 21 06:25:44 2010 -0400
    53.3 @@ -0,0 +1,149 @@
    53.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    53.5 +;;  distribution terms for this software are covered by the Eclipse Public
    53.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    53.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    53.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    53.9 +;;  terms of this license.  You must not remove this notice, or any other,
   53.10 +;;  from this software.
   53.11 +;;
   53.12 +;;  File: def.clj
   53.13 +;;
   53.14 +;;  def.clj provides variants of def that make including doc strings and
   53.15 +;;  making private definitions more succinct.
   53.16 +;;
   53.17 +;;  scgilardi (gmail)
   53.18 +;;  17 May 2008
   53.19 +
   53.20 +(ns 
   53.21 +  ^{:author "Stephen C. Gilardi",
   53.22 +    :doc "def.clj provides variants of def that make including doc strings and
   53.23 +making private definitions more succinct."} 
   53.24 +  clojure.contrib.def)
   53.25 +
   53.26 +(defmacro defvar
   53.27 +  "Defines a var with an optional intializer and doc string"
   53.28 +  ([name]
   53.29 +     (list `def name))
   53.30 +  ([name init]
   53.31 +     (list `def name init))
   53.32 +  ([name init doc]
   53.33 +     (list `def (with-meta name (assoc (meta name) :doc doc)) init)))
   53.34 +
   53.35 +(defmacro defunbound
   53.36 +  "Defines an unbound var with optional doc string"
   53.37 +  ([name]
   53.38 +     (list `def name))
   53.39 +  ([name doc]
   53.40 +     (list `def (with-meta name (assoc (meta name) :doc doc)))))
   53.41 +
   53.42 +(defmacro defmacro-
   53.43 +  "Same as defmacro but yields a private definition"
   53.44 +  [name & decls]
   53.45 +  (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls))
   53.46 +
   53.47 +(defmacro defvar-
   53.48 +  "Same as defvar but yields a private definition"
   53.49 +  [name & decls]
   53.50 +  (list* `defvar (with-meta name (assoc (meta name) :private true)) decls))
   53.51 +
   53.52 +(defmacro defunbound-
   53.53 +  "Same as defunbound but yields a private definition"
   53.54 +  [name & decls]
   53.55 +  (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls))
   53.56 +
   53.57 +(defmacro defstruct-
   53.58 +  "Same as defstruct but yields a private definition"
   53.59 +  [name & decls]
   53.60 +  (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls))
   53.61 +
   53.62 +(defmacro defonce-
   53.63 +  "Same as defonce but yields a private definition"
   53.64 +  ([name expr]
   53.65 +     (list `defonce (with-meta name (assoc (meta name) :private true)) expr))
   53.66 +  ([name expr doc]
   53.67 +     (list `defonce (with-meta name (assoc (meta name) :private true :doc doc)) expr)))
   53.68 +
   53.69 +(defmacro defalias
   53.70 +  "Defines an alias for a var: a new var with the same root binding (if
   53.71 +  any) and similar metadata. The metadata of the alias is its initial
   53.72 +  metadata (as provided by def) merged into the metadata of the original."
   53.73 +  ([name orig]
   53.74 +     `(do
   53.75 +        (alter-meta!
   53.76 +         (if (.hasRoot (var ~orig))
   53.77 +           (def ~name (.getRoot (var ~orig)))
   53.78 +           (def ~name))
   53.79 +         ;; When copying metadata, disregard {:macro false}.
   53.80 +         ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
   53.81 +         #(conj (dissoc % :macro)
   53.82 +                (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
   53.83 +        (var ~name)))
   53.84 +  ([name orig doc]
   53.85 +     (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
   53.86 +
   53.87 +; defhinted by Chouser:
   53.88 +(defmacro defhinted
   53.89 +  "Defines a var with a type hint matching the class of the given
   53.90 +  init.  Be careful about using any form of 'def' or 'binding' to a
   53.91 +  value of a different type.  See http://paste.lisp.org/display/73344"
   53.92 +  [sym init]
   53.93 +  `(do
   53.94 +     (def ~sym ~init)
   53.95 +     (alter-meta! (var ~sym) assoc :tag (class ~sym))
   53.96 +     (var ~sym)))
   53.97 +
   53.98 +; name-with-attributes by Konrad Hinsen:
   53.99 +(defn name-with-attributes
  53.100 +  "To be used in macro definitions.
  53.101 +   Handles optional docstrings and attribute maps for a name to be defined
  53.102 +   in a list of macro arguments. If the first macro argument is a string,
  53.103 +   it is added as a docstring to name and removed from the macro argument
  53.104 +   list. If afterwards the first macro argument is a map, its entries are
  53.105 +   added to the name's metadata map and the map is removed from the
  53.106 +   macro argument list. The return value is a vector containing the name
  53.107 +   with its extended metadata map and the list of unprocessed macro
  53.108 +   arguments."
  53.109 +  [name macro-args]
  53.110 +  (let [[docstring macro-args] (if (string? (first macro-args))
  53.111 +                                 [(first macro-args) (next macro-args)]
  53.112 +                                 [nil macro-args])
  53.113 +    [attr macro-args]          (if (map? (first macro-args))
  53.114 +                                 [(first macro-args) (next macro-args)]
  53.115 +                                 [{} macro-args])
  53.116 +    attr                       (if docstring
  53.117 +                                 (assoc attr :doc docstring)
  53.118 +                                 attr)
  53.119 +    attr                       (if (meta name)
  53.120 +                                 (conj (meta name) attr)
  53.121 +                                 attr)]
  53.122 +    [(with-meta name attr) macro-args]))
  53.123 +
  53.124 +; defnk by Meikel Brandmeyer:
  53.125 +(defmacro defnk
  53.126 + "Define a function accepting keyword arguments. Symbols up to the first
  53.127 + keyword in the parameter list are taken as positional arguments.  Then
  53.128 + an alternating sequence of keywords and defaults values is expected. The
  53.129 + values of the keyword arguments are available in the function body by
  53.130 + virtue of the symbol corresponding to the keyword (cf. :keys destructuring).
  53.131 + defnk accepts an optional docstring as well as an optional metadata map."
  53.132 + [fn-name & fn-tail]
  53.133 + (let [[fn-name [args & body]] (name-with-attributes fn-name fn-tail)
  53.134 +       [pos kw-vals]           (split-with symbol? args)
  53.135 +       syms                    (map #(-> % name symbol) (take-nth 2 kw-vals))
  53.136 +       values                  (take-nth 2 (rest kw-vals))
  53.137 +       sym-vals                (apply hash-map (interleave syms values))
  53.138 +       de-map                  {:keys (vec syms)
  53.139 +                                :or   sym-vals}]
  53.140 +   `(defn ~fn-name
  53.141 +      [~@pos & options#]
  53.142 +      (let [~de-map (apply hash-map options#)]
  53.143 +        ~@body))))
  53.144 +
  53.145 +; defn-memo by Chouser:
  53.146 +(defmacro defn-memo
  53.147 +  "Just like defn, but memoizes the function using clojure.core/memoize"
  53.148 +  [fn-name & defn-stuff]
  53.149 +  `(do
  53.150 +     (defn ~fn-name ~@defn-stuff)
  53.151 +     (alter-var-root (var ~fn-name) memoize)
  53.152 +     (var ~fn-name)))
    54.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    54.2 +++ b/src/clojure/contrib/duck_streams.clj	Sat Aug 21 06:25:44 2010 -0400
    54.3 @@ -0,0 +1,418 @@
    54.4 +;;; duck_streams.clj -- duck-typed I/O streams for Clojure
    54.5 +
    54.6 +;; by Stuart Sierra, http://stuartsierra.com/
    54.7 +;; May 13, 2009
    54.8 +
    54.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   54.10 +;; and distribution terms for this software are covered by the Eclipse
   54.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   54.12 +;; which can be found in the file epl-v10.html at the root of this
   54.13 +;; distribution.  By using this software in any fashion, you are
   54.14 +;; agreeing to be bound by the terms of this license.  You must not
   54.15 +;; remove this notice, or any other, from this software.
   54.16 +
   54.17 +
   54.18 +;; This file defines "duck-typed" I/O utility functions for Clojure.
   54.19 +;; The 'reader' and 'writer' functions will open and return an
   54.20 +;; instance of java.io.BufferedReader and java.io.PrintWriter,
   54.21 +;; respectively, for a variety of argument types -- filenames as
   54.22 +;; strings, URLs, java.io.File's, etc.  'reader' even works on http
   54.23 +;; URLs.
   54.24 +;;
   54.25 +;; Note: this is not really "duck typing" as implemented in languages
   54.26 +;; like Ruby.  A better name would have been "do-what-I-mean-streams"
   54.27 +;; or "just-give-me-a-stream", but ducks are funnier.
   54.28 +
   54.29 +
   54.30 +;; CHANGE LOG
   54.31 +;;
   54.32 +;; July 23, 2010: DEPRECATED in 1.2. Use clojure.java.io instead.
   54.33 +;;
   54.34 +;; May 13, 2009: added functions to open writers for appending
   54.35 +;;
   54.36 +;; May 3, 2009: renamed file to file-str, for compatibility with
   54.37 +;; clojure.contrib.java-utils.  reader/writer no longer use this
   54.38 +;; function.
   54.39 +;;
   54.40 +;; February 16, 2009: (lazy branch) fixed read-lines to work with lazy
   54.41 +;; Clojure.
   54.42 +;;
   54.43 +;; January 10, 2009: added *default-encoding*, so streams are always
   54.44 +;; opened as UTF-8.
   54.45 +;;
   54.46 +;; December 19, 2008: rewrote reader and writer as multimethods; added
   54.47 +;; slurp*, file, and read-lines
   54.48 +;;
   54.49 +;; April 8, 2008: first version
   54.50 +
   54.51 +(ns 
   54.52 +   ^{:author "Stuart Sierra",
   54.53 +     :deprecated "1.2"
   54.54 +     :doc "This file defines \"duck-typed\" I/O utility functions for Clojure.
   54.55 +           The 'reader' and 'writer' functions will open and return an
   54.56 +           instance of java.io.BufferedReader and java.io.PrintWriter,
   54.57 +           respectively, for a variety of argument types -- filenames as
   54.58 +           strings, URLs, java.io.File's, etc.  'reader' even works on http
   54.59 +           URLs.
   54.60 +
   54.61 +           Note: this is not really \"duck typing\" as implemented in languages
   54.62 +           like Ruby.  A better name would have been \"do-what-I-mean-streams\"
   54.63 +           or \"just-give-me-a-stream\", but ducks are funnier."} 
   54.64 +  clojure.contrib.duck-streams
   54.65 +  (:refer-clojure :exclude (spit))
   54.66 +  (:import 
   54.67 +   (java.io Reader InputStream InputStreamReader PushbackReader
   54.68 +            BufferedReader File PrintWriter OutputStream
   54.69 +            OutputStreamWriter BufferedWriter Writer
   54.70 +            FileInputStream FileOutputStream ByteArrayOutputStream
   54.71 +            StringReader ByteArrayInputStream)
   54.72 +   (java.net URI URL MalformedURLException Socket)))
   54.73 +
   54.74 +
   54.75 +(def
   54.76 + ^{:doc "Name of the default encoding to use when reading & writing.
   54.77 +  Default is UTF-8."
   54.78 +    :tag "java.lang.String"}
   54.79 + *default-encoding* "UTF-8")
   54.80 +
   54.81 +(def
   54.82 + ^{:doc "Size, in bytes or characters, of the buffer used when
   54.83 +  copying streams."}
   54.84 + *buffer-size* 1024)
   54.85 +
   54.86 +(def
   54.87 + ^{:doc "Type object for a Java primitive byte array."}
   54.88 + *byte-array-type* (class (make-array Byte/TYPE 0)))
   54.89 +
   54.90 +
   54.91 +(defn ^File file-str
   54.92 +  "Concatenates args as strings and returns a java.io.File.  Replaces
   54.93 +  all / and \\ with File/separatorChar.  Replaces ~ at the start of
   54.94 +  the path with the user.home system property."
   54.95 +  [& args]
   54.96 +  (let [^String s (apply str args)
   54.97 +        s (.replaceAll (re-matcher #"[/\\]" s) File/separator)
   54.98 +        s (if (.startsWith s "~")
   54.99 +            (str (System/getProperty "user.home")
  54.100 +                 File/separator (subs s 1))
  54.101 +            s)]
  54.102 +    (File. s)))
  54.103 +
  54.104 +
  54.105 +(defmulti ^{:tag BufferedReader
  54.106 +             :doc "Attempts to coerce its argument into an open
  54.107 +  java.io.BufferedReader.  Argument may be an instance of Reader,
  54.108 +  BufferedReader, InputStream, File, URI, URL, Socket, or String.
  54.109 +
  54.110 +  If argument is a String, it tries to resolve it first as a URI, then
  54.111 +  as a local file name.  URIs with a 'file' protocol are converted to
  54.112 +  local file names.  Uses *default-encoding* as the text encoding.
  54.113 +
  54.114 +  Should be used inside with-open to ensure the Reader is properly
  54.115 +  closed."
  54.116 +             :arglists '([x])}
  54.117 +  reader class)
  54.118 +
  54.119 +(defmethod reader Reader [x]
  54.120 +  (BufferedReader. x))
  54.121 +
  54.122 +(defmethod reader InputStream [^InputStream x]
  54.123 +  (BufferedReader. (InputStreamReader. x *default-encoding*)))
  54.124 +
  54.125 +(defmethod reader File [^File x]
  54.126 +  (reader (FileInputStream. x)))
  54.127 +
  54.128 +(defmethod reader URL [^URL x]
  54.129 +  (reader (if (= "file" (.getProtocol x))
  54.130 +            (FileInputStream. (.getPath x))
  54.131 +            (.openStream x))))
  54.132 +
  54.133 +(defmethod reader URI [^URI x]
  54.134 +  (reader (.toURL x)))
  54.135 +
  54.136 +(defmethod reader String [^String x]
  54.137 +  (try (let [url (URL. x)]
  54.138 +         (reader url))
  54.139 +       (catch MalformedURLException e
  54.140 +         (reader (File. x)))))
  54.141 +
  54.142 +(defmethod reader Socket [^Socket x]
  54.143 +  (reader (.getInputStream x)))
  54.144 +
  54.145 +(defmethod reader :default [x]
  54.146 +  (throw (Exception. (str "Cannot open " (pr-str x) " as a reader."))))
  54.147 +
  54.148 +
  54.149 +(def
  54.150 + ^{:doc "If true, writer and spit will open files in append mode.
  54.151 + Defaults to false.  Use append-writer or append-spit."
  54.152 +    :tag "java.lang.Boolean"}
  54.153 + *append-to-writer* false)
  54.154 +
  54.155 +
  54.156 +(defmulti ^{:tag PrintWriter
  54.157 +             :doc "Attempts to coerce its argument into an open java.io.PrintWriter
  54.158 +  wrapped around a java.io.BufferedWriter.  Argument may be an
  54.159 +  instance of Writer, PrintWriter, BufferedWriter, OutputStream, File,
  54.160 +  URI, URL, Socket, or String.
  54.161 +
  54.162 +  If argument is a String, it tries to resolve it first as a URI, then
  54.163 +  as a local file name.  URIs with a 'file' protocol are converted to
  54.164 +  local file names.
  54.165 +
  54.166 +  Should be used inside with-open to ensure the Writer is properly
  54.167 +  closed."
  54.168 +             :arglists '([x])}
  54.169 +  writer class)
  54.170 +
  54.171 +(defn- assert-not-appending []
  54.172 +  (when *append-to-writer*
  54.173 +    (throw (Exception. "Cannot change an open stream to append mode."))))
  54.174 +
  54.175 +(defmethod writer PrintWriter [x]
  54.176 +  (assert-not-appending)
  54.177 +  x)
  54.178 +
  54.179 +(defmethod writer BufferedWriter [^BufferedWriter x]
  54.180 +  (assert-not-appending)
  54.181 +  (PrintWriter. x))
  54.182 +
  54.183 +(defmethod writer Writer [x]
  54.184 +  (assert-not-appending)
  54.185 +  ;; Writer includes sub-classes such as FileWriter
  54.186 +  (PrintWriter. (BufferedWriter. x)))   
  54.187 +
  54.188 +(defmethod writer OutputStream [^OutputStream x]
  54.189 +  (assert-not-appending)
  54.190 +  (PrintWriter.
  54.191 +   (BufferedWriter.
  54.192 +    (OutputStreamWriter. x *default-encoding*))))
  54.193 +
  54.194 +(defmethod writer File [^File x]
  54.195 +  (let [stream (FileOutputStream. x *append-to-writer*)]
  54.196 +    (binding [*append-to-writer* false]
  54.197 +      (writer stream))))
  54.198 +
  54.199 +(defmethod writer URL [^URL x]
  54.200 +  (if (= "file" (.getProtocol x))
  54.201 +    (writer (File. (.getPath x)))
  54.202 +    (throw (Exception. (str "Cannot write to non-file URL <" x ">")))))
  54.203 +
  54.204 +(defmethod writer URI [^URI x]
  54.205 +  (writer (.toURL x)))
  54.206 +
  54.207 +(defmethod writer String [^String x]
  54.208 +  (try (let [url (URL. x)]
  54.209 +         (writer url))
  54.210 +       (catch MalformedURLException err
  54.211 +         (writer (File. x)))))
  54.212 +
  54.213 +(defmethod writer Socket [^Socket x]
  54.214 +  (writer (.getOutputStream x)))
  54.215 +
  54.216 +(defmethod writer :default [x]
  54.217 +  (throw (Exception. (str "Cannot open <" (pr-str x) "> as a writer."))))
  54.218 +
  54.219 +
  54.220 +(defn append-writer
  54.221 +  "Like writer but opens file for appending.  Does not work on streams
  54.222 +  that are already open."
  54.223 +  [x]
  54.224 +  (binding [*append-to-writer* true]
  54.225 +    (writer x)))
  54.226 +
  54.227 +
  54.228 +(defn write-lines
  54.229 +  "Writes lines (a seq) to f, separated by newlines.  f is opened with
  54.230 +  writer, and automatically closed at the end of the sequence."
  54.231 +  [f lines]
  54.232 +  (with-open [^PrintWriter writer (writer f)]
  54.233 +    (loop [lines lines]
  54.234 +      (when-let [line (first lines)]
  54.235 +        (.write writer (str line))
  54.236 +        (.println writer)
  54.237 +        (recur (rest lines))))))
  54.238 +
  54.239 +(defn read-lines
  54.240 +  "Like clojure.core/line-seq but opens f with reader.  Automatically
  54.241 +  closes the reader AFTER YOU CONSUME THE ENTIRE SEQUENCE."
  54.242 +  [f]
  54.243 +  (let [read-line (fn this [^BufferedReader rdr]
  54.244 +                    (lazy-seq
  54.245 +                     (if-let [line (.readLine rdr)]
  54.246 +                       (cons line (this rdr))
  54.247 +                       (.close rdr))))]
  54.248 +    (read-line (reader f))))
  54.249 +
  54.250 +(defn ^String slurp*
  54.251 +  "Like clojure.core/slurp but opens f with reader."
  54.252 +  [f]
  54.253 +  (with-open [^BufferedReader r (reader f)]
  54.254 +      (let [sb (StringBuilder.)]
  54.255 +        (loop [c (.read r)]
  54.256 +          (if (neg? c)
  54.257 +            (str sb)
  54.258 +            (do (.append sb (char c))
  54.259 +                (recur (.read r))))))))
  54.260 +
  54.261 +(defn spit
  54.262 +  "Opposite of slurp.  Opens f with writer, writes content, then
  54.263 +  closes f."
  54.264 +  [f content]
  54.265 +  (with-open [^PrintWriter w (writer f)]
  54.266 +      (.print w content)))
  54.267 +
  54.268 +(defn append-spit
  54.269 +  "Like spit but appends to file."
  54.270 +  [f content]
  54.271 +  (with-open [^PrintWriter w (append-writer f)]
  54.272 +    (.print w content)))
  54.273 +
  54.274 +(defn pwd
  54.275 +  "Returns current working directory as a String.  (Like UNIX 'pwd'.)
  54.276 +  Note: In Java, you cannot change the current working directory."
  54.277 +  []
  54.278 +  (System/getProperty "user.dir"))
  54.279 +
  54.280 +
  54.281 +
  54.282 +(defmacro with-out-writer
  54.283 +  "Opens a writer on f, binds it to *out*, and evalutes body.
  54.284 +  Anything printed within body will be written to f."
  54.285 +  [f & body]
  54.286 +  `(with-open [stream# (writer ~f)]
  54.287 +     (binding [*out* stream#]
  54.288 +       ~@body)))
  54.289 +
  54.290 +(defmacro with-out-append-writer
  54.291 +  "Like with-out-writer but appends to file."
  54.292 +  [f & body]
  54.293 +  `(with-open [stream# (append-writer ~f)]
  54.294 +     (binding [*out* stream#]
  54.295 +       ~@body)))
  54.296 +
  54.297 +(defmacro with-in-reader
  54.298 +  "Opens a PushbackReader on f, binds it to *in*, and evaluates body."
  54.299 +  [f & body]
  54.300 +  `(with-open [stream# (PushbackReader. (reader ~f))]
  54.301 +     (binding [*in* stream#]
  54.302 +       ~@body)))
  54.303 +
  54.304 +(defmulti
  54.305 +  ^{:doc "Copies input to output.  Returns nil.
  54.306 +  Input may be an InputStream, Reader, File, byte[], or String.
  54.307 +  Output may be an OutputStream, Writer, or File.
  54.308 +
  54.309 +  Does not close any streams except those it opens itself 
  54.310 +  (on a File).
  54.311 +
  54.312 +  Writing a File fails if the parent directory does not exist."
  54.313 +     :arglists '([input output])}
  54.314 +  copy
  54.315 +  (fn [input output] [(type input) (type output)]))
  54.316 +
  54.317 +(defmethod copy [InputStream OutputStream] [^InputStream input ^OutputStream output]
  54.318 +  (let [buffer (make-array Byte/TYPE *buffer-size*)]
  54.319 +    (loop []
  54.320 +      (let [size (.read input buffer)]
  54.321 +        (when (pos? size)
  54.322 +          (do (.write output buffer 0 size)
  54.323 +              (recur)))))))
  54.324 +
  54.325 +(defmethod copy [InputStream Writer] [^InputStream input ^Writer output]
  54.326 +  (let [^"[B" buffer (make-array Byte/TYPE *buffer-size*)]
  54.327 +    (loop []
  54.328 +      (let [size (.read input buffer)]
  54.329 +        (when (pos? size)
  54.330 +          (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))]
  54.331 +            (do (.write output chars)
  54.332 +                (recur))))))))
  54.333 +
  54.334 +(defmethod copy [InputStream File] [^InputStream input ^File output]
  54.335 +  (with-open [out (FileOutputStream. output)]
  54.336 +    (copy input out)))
  54.337 +
  54.338 +(defmethod copy [Reader OutputStream] [^Reader input ^OutputStream output]
  54.339 +  (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)]
  54.340 +    (loop []
  54.341 +      (let [size (.read input buffer)]
  54.342 +        (when (pos? size)
  54.343 +          (let [bytes (.getBytes (String. buffer 0 size) *default-encoding*)]
  54.344 +            (do (.write output bytes)
  54.345 +                (recur))))))))
  54.346 +
  54.347 +(defmethod copy [Reader Writer] [^Reader input ^Writer output]
  54.348 +  (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)]
  54.349 +    (loop []
  54.350 +      (let [size (.read input buffer)]
  54.351 +        (when (pos? size)
  54.352 +          (do (.write output buffer 0 size)
  54.353 +              (recur)))))))
  54.354 +
  54.355 +(defmethod copy [Reader File] [^Reader input ^File output]
  54.356 +  (with-open [out (FileOutputStream. output)]
  54.357 +    (copy input out)))
  54.358 +
  54.359 +(defmethod copy [File OutputStream] [^File input ^OutputStream output]
  54.360 +  (with-open [in (FileInputStream. input)]
  54.361 +    (copy in output)))
  54.362 +
  54.363 +(defmethod copy [File Writer] [^File input ^Writer output]
  54.364 +  (with-open [in (FileInputStream. input)]
  54.365 +    (copy in output)))
  54.366 +
  54.367 +(defmethod copy [File File] [^File input ^File output]
  54.368 +  (with-open [in (FileInputStream. input)
  54.369 +              out (FileOutputStream. output)]
  54.370 +    (copy in out)))
  54.371 +
  54.372 +(defmethod copy [String OutputStream] [^String input ^OutputStream output]
  54.373 +  (copy (StringReader. input) output))
  54.374 +
  54.375 +(defmethod copy [String Writer] [^String input ^Writer output]
  54.376 +  (copy (StringReader. input) output))
  54.377 +
  54.378 +(defmethod copy [String File] [^String input ^File output]
  54.379 +  (copy (StringReader. input) output))
  54.380 +
  54.381 +(defmethod copy [*byte-array-type* OutputStream] [^"[B" input ^OutputStream output]
  54.382 +  (copy (ByteArrayInputStream. input) output))
  54.383 +
  54.384 +(defmethod copy [*byte-array-type* Writer] [^"[B" input ^Writer output]
  54.385 +  (copy (ByteArrayInputStream. input) output))
  54.386 +
  54.387 +(defmethod copy [*byte-array-type* File] [^"[B" input ^Writer output]
  54.388 +  (copy (ByteArrayInputStream. input) output))
  54.389 +
  54.390 +
  54.391 +(defn make-parents
  54.392 +  "Creates all parent directories of file."
  54.393 +  [^File file]
  54.394 +  (.mkdirs (.getParentFile file)))
  54.395 +
  54.396 +(defmulti
  54.397 +  ^{:doc "Converts argument into a Java byte array.  Argument may be
  54.398 +  a String, File, InputStream, or Reader.  If the argument is already
  54.399 +  a byte array, returns it."
  54.400 +    :arglists '([arg])}
  54.401 +  to-byte-array type)
  54.402 +
  54.403 +(defmethod to-byte-array *byte-array-type* [x] x)
  54.404 +
  54.405 +(defmethod to-byte-array String [^String x]
  54.406 +  (.getBytes x *default-encoding*))
  54.407 +
  54.408 +(defmethod to-byte-array File [^File x]
  54.409 +  (with-open [input (FileInputStream. x)
  54.410 +              buffer (ByteArrayOutputStream.)]
  54.411 +    (copy input buffer)
  54.412 +    (.toByteArray buffer)))
  54.413 +
  54.414 +(defmethod to-byte-array InputStream [^InputStream x]
  54.415 +  (let [buffer (ByteArrayOutputStream.)]
  54.416 +    (copy x buffer)
  54.417 +    (.toByteArray buffer)))
  54.418 +
  54.419 +(defmethod to-byte-array Reader [^Reader x]
  54.420 +  (.getBytes (slurp* x) *default-encoding*))
  54.421 +
    55.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    55.2 +++ b/src/clojure/contrib/error_kit.clj	Sat Aug 21 06:25:44 2010 -0400
    55.3 @@ -0,0 +1,289 @@
    55.4 +;   Copyright (c) Chris Houser, Jan 2009. All rights reserved.
    55.5 +;   The use and distribution terms for this software are covered by the
    55.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    55.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
    55.8 +;   By using this software in any fashion, you are agreeing to be bound by
    55.9 +;   the terms of this license.
   55.10 +;   You must not remove this notice, or any other, from this software.
   55.11 +
   55.12 +; == EXPERIMENTAL ==
   55.13 +; System for defining and using custom errors
   55.14 +; Please contact Chouser if you have any suggestions for better names
   55.15 +; or API adjustments.
   55.16 +
   55.17 +(ns 
   55.18 +  ^{:author "Chris Houser",
   55.19 +     :doc "EXPERIMENTAL
   55.20 +System for defining and using custom errors
   55.21 +Please contact Chouser if you have any suggestions for better names
   55.22 +or API adjustments."} 
   55.23 +  clojure.contrib.error-kit
   55.24 +  (:use [clojure.contrib.def :only (defvar defvar-)]
   55.25 +        [clojure.stacktrace :only (root-cause)]))
   55.26 +
   55.27 +(defn- make-ctrl-exception [msg data]
   55.28 +  "Create an exception object with associated data, used for passing
   55.29 +  control and data to a dynamically containing handler."
   55.30 +  (proxy [Error clojure.lang.IDeref] [msg]
   55.31 +    (toString [] (str "Error Kit Control Exception: " msg ", " (pr-str data)))
   55.32 +    (deref [] data)))
   55.33 +
   55.34 +(defvar- ctrl-exception-class
   55.35 +  (class (make-ctrl-exception nil nil)))
   55.36 +
   55.37 +(defvar- *handler-stack* () "Stack of bound handler symbols")
   55.38 +
   55.39 +(defvar- *continues* {} "Map of currently available continue forms")
   55.40 +
   55.41 +
   55.42 +(defmacro throw-msg
   55.43 +  "Returns a function that throws a Java Exception with the given
   55.44 +  name.  Useful to associate a new error-kit error type with a
   55.45 +  particular Java Exception class, via the :unhandled error key."
   55.46 +  [class-name]
   55.47 +  `(fn [x#] (throw (new ~class-name (:msg x#)))))
   55.48 +
   55.49 +(defn error
   55.50 +  "Base type for all error-kit errors"
   55.51 +  {::args [:msg :unhandled :tag]}
   55.52 +  [details]
   55.53 +  (merge {:tag `error :msg "exception via error-kit"
   55.54 +          :unhandled (throw-msg Exception)}
   55.55 +         details))
   55.56 +
   55.57 +(defn- qualify-sym [sym]
   55.58 +  (let [v (resolve sym)]
   55.59 +    (assert v)
   55.60 +    (apply symbol (map #(str (% (meta v))) [:ns :name]))))
   55.61 +
   55.62 +(defmacro deferror
   55.63 +  "Define a new error type"
   55.64 +  {:arglists '([name [parent-error?] doc-string? [args*] & body]
   55.65 +               [name [parent-error?] doc-string? args-destruct-map & body])}
   55.66 +  [err-name pvec & decl]
   55.67 +  (let [pvec (if (empty? pvec) [`error] pvec)
   55.68 +        [docstr args & body] (if (string? (first decl)) decl (cons nil decl))
   55.69 +        args (or args [])
   55.70 +        argmap (if (vector? args) `{:keys ~args} args)
   55.71 +        body (or body {})
   55.72 +        qual-err-name (symbol (str *ns*) (name err-name))]
   55.73 +    (assert (== (count pvec) 1)) ; only support single-inheritance for now
   55.74 +    (assert (vector? args)) ; only vector (keyword destruct) args for now
   55.75 +    `(do
   55.76 +       (defn ~err-name [details#]
   55.77 +         (let [basedata# ((resolve (first (parents '~qual-err-name))) details#)
   55.78 +               ~argmap basedata#]
   55.79 +           (merge basedata# {:tag '~qual-err-name} (do ~@body) details#)))
   55.80 +       (alter-meta! (var ~err-name) assoc
   55.81 +                    :doc ~docstr ::args ~(vec (map #(keyword (str %)) args)))
   55.82 +       ~@(for [parent pvec]
   55.83 +           `(derive '~qual-err-name '~(qualify-sym parent)))
   55.84 +       (var ~err-name))))
   55.85 +
   55.86 +(defn- throw-to [msg target-map args]
   55.87 +  (throw (make-ctrl-exception msg (assoc target-map :args args))))
   55.88 +
   55.89 +(defn raise*
   55.90 +  "Raise the given error object, best if created by an error
   55.91 +  constructor defined with deferror.  See also 'raise' macro."
   55.92 +  [err]
   55.93 +  (let [err-tag (:tag err)]
   55.94 +    (loop [hs *handler-stack*]
   55.95 +      (if (empty? hs)
   55.96 +        ((:unhandled err) err)
   55.97 +        (let [[{:keys [htag] :as handler}] hs]
   55.98 +          (if (and htag (not (isa? err-tag htag)))
   55.99 +            (recur (next hs))
  55.100 +            (let [rtn ((:hfunc handler) err)]
  55.101 +              (if-not (vector? rtn)
  55.102 +                (throw-to "default" handler (list rtn))
  55.103 +                (condp = (rtn 0)
  55.104 +                  ::continue-with (rtn 1)
  55.105 +                  ::continue (if-let [continue (*continues* (rtn 1))]
  55.106 +                               (throw-to "continue" continue (rtn 2))
  55.107 +                               (do (prn *continues*) (throw
  55.108 +                                 (Exception.
  55.109 +                                   (str "Unbound continue name " (rtn 1))))))
  55.110 +                  ::do-not-handle (recur (next hs))
  55.111 +                  (throw-to "do-not-handle" handler (list rtn)))))))))))
  55.112 +
  55.113 +(defmacro raise
  55.114 +  "Raise an error of the type err-name, constructed with the given args"
  55.115 +  [err-name & args]
  55.116 +  `(raise* (~err-name ~(zipmap (::args (meta (resolve err-name)))
  55.117 +                               args))))
  55.118 +
  55.119 +; It'd be nice to assert that these are used in a tail position of a handler
  55.120 +(defmacro do-not-handle
  55.121 +  "Use in a tail position of a 'handle' form to indicate 'raise' should
  55.122 +  not consider the error handled, but should continue searching for an
  55.123 +  appropriate 'handle' form.  Allows finer-grain control over catching
  55.124 +  than just the error type."
  55.125 +  []
  55.126 +  `[::do-not-handle])
  55.127 +
  55.128 +(defmacro continue-with [value]
  55.129 +  "Use in a tail position of a 'handle' form to cause the currently
  55.130 +  running 'raise' to return the given 'value'."
  55.131 +  `[::continue-with ~value])
  55.132 +
  55.133 +(defmacro continue [continue-name & args]
  55.134 +  "Use in a tail position of a 'handle' form to pass control to the
  55.135 +  named 'continue' form, passing in the given args.  The 'continue'
  55.136 +  form with the given name and the smallest dynamic scope surrounding
  55.137 +  the currently running 'raise' will be used."
  55.138 +  `[::continue '~continue-name [~@args]])
  55.139 +
  55.140 +
  55.141 +(def ^{:doc "Special form to be used inside a 'with-handler'.  When
  55.142 +  any error is 'raised' from withing the dynamic scope of 'body' that
  55.143 +  is of error-name's type or a derived type, the args will be bound
  55.144 +  and the body executed.  If no 'error-name' is given, the body will
  55.145 +  be executed for regardless of the type of error raised.  The body
  55.146 +  may return a value, in which case that will be the return value of
  55.147 +  the entire 'with-handler' form, or it may use any of the special
  55.148 +  return forms, 'do-not-handle', 'continue-with', or 'continue'."
  55.149 +          :arglists '([error-name? [args*] & body]
  55.150 +                      [error-name? args-destruct-map-args & body])}
  55.151 +  handle)
  55.152 +
  55.153 +(def ^{:doc "Special form to be used inside a 'with-handler'.
  55.154 +  Control can be passed to this 'continue' form from a 'raise' enclosed
  55.155 +  in this with-handler's dynamic scope, when this 'continue-name' is
  55.156 +  given to a 'continue' form."
  55.157 +        :arglists '([continue-name [args*] & body])}
  55.158 +  bind-continue)
  55.159 +
  55.160 +(defn- special-form [form]
  55.161 +  (and (list form)
  55.162 +       (symbol? (first form))
  55.163 +       (#{#'handle #'bind-continue} (resolve (first form)))))
  55.164 +
  55.165 +
  55.166 +(defmacro with-handler
  55.167 +  "This is error-kit's dynamic scope form.  The body will be executed
  55.168 +  in a dynamic context that includes all of the following 'handle' and
  55.169 +  'bind-continue' forms."
  55.170 +  [& forms]
  55.171 +  (let [[body special-forms] (split-with (complement special-form) forms)]
  55.172 +    (assert (every? special-form special-forms))
  55.173 +    (let [blockid (gensym)
  55.174 +          handlers (for [[type & more] special-forms
  55.175 +                         :when (= (resolve type) #'handle)]
  55.176 +                     (let [[htag args & hbody] (if (symbol? (first more))
  55.177 +                                                 more
  55.178 +                                                 (cons nil more))
  55.179 +                           argmap (if (vector? args) `{:keys ~args} args)]
  55.180 +                       `{:blockid '~blockid
  55.181 +                         :htag ~(when htag (list `quote (qualify-sym htag)))
  55.182 +                         :hfunc (fn [~argmap] ~@hbody)
  55.183 +                         :rfunc identity}))
  55.184 +          continues (into {}
  55.185 +                          (for [[type & more] special-forms
  55.186 +                                :when (= (resolve type) #'bind-continue)]
  55.187 +                            [(list `quote (first more))
  55.188 +                             `{:blockid '~blockid
  55.189 +                               :rfunc (fn ~@(next more))}]))]
  55.190 +      `(try
  55.191 +         (binding [*handler-stack* (list* ~@handlers @#'*handler-stack*)
  55.192 +                   *continues* (merge @#'*continues* ~@continues)]
  55.193 +           ~@body)
  55.194 +         (catch Throwable e#
  55.195 +           (let [root-cause# (root-cause e#)]
  55.196 +             (if-not (instance? @#'ctrl-exception-class root-cause#)
  55.197 +               (throw e#)
  55.198 +               (let [data# @root-cause#]
  55.199 +                 (if (= '~blockid (:blockid data#))
  55.200 +                   (apply (:rfunc data#) (:args data#))
  55.201 +                   (throw e#))))))))))
  55.202 +
  55.203 +(defn rebind-fn [func]
  55.204 +  (let [a *handler-stack*, b *continues*]
  55.205 +    (fn [& args]
  55.206 +      (binding [*handler-stack* a
  55.207 +                *continues* b]
  55.208 +        (apply func args)))))
  55.209 +
  55.210 +(comment
  55.211 +
  55.212 +(alias 'kit 'clojure.contrib.error-kit)
  55.213 +
  55.214 +; This defines an error and its action if unhandled.  A good choice of
  55.215 +; unhandled. action is to throw a Java exception so users of your code
  55.216 +; who do not want to use error-kit can still use normal Java try/catch
  55.217 +; forms to handle the error.
  55.218 +(kit/deferror number-error [] [n]
  55.219 +  {:msg (str "Number error: " n)
  55.220 +   :unhandled (kit/throw-msg NumberFormatException)})
  55.221 +
  55.222 +(kit/deferror odd-number-error [number-error]
  55.223 +  "Indicates an odd number was given to an operation that is only
  55.224 +  defined for even numbers."
  55.225 +  [n]
  55.226 +  {:msg (str "Can't handle odd number: " n)})
  55.227 +
  55.228 +; Raise an error by name with any extra args defined by the deferror
  55.229 +(defn int-half [i]
  55.230 +  (if (even? i)
  55.231 +    (quot i 2)
  55.232 +    (kit/raise odd-number-error i)))
  55.233 +
  55.234 +; Throws Java NumberFormatException because there's no 'handle' form
  55.235 +(vec (map int-half [2 4 5 8]))
  55.236 +
  55.237 +; Throws Java Exception with details provided by 'raise'
  55.238 +(kit/with-handler
  55.239 +  (vec (map int-half [2 4 5 8]))
  55.240 +  (kit/handle odd-number-error [n]
  55.241 +    (throw (Exception. (format "Odd number %d in vector." n)))))
  55.242 +
  55.243 +; The above is equivalent to the more complicated version below:
  55.244 +(kit/with-handler
  55.245 +  (vec (map int-half [2 4 5 8]))
  55.246 +  (kit/handle {:keys [n tag]}
  55.247 +    (if (isa? tag `odd-number-error)
  55.248 +      (throw (Exception. (format "Odd number %d in vector." n)))
  55.249 +      (kit/do-not-handle))))
  55.250 +
  55.251 +; Returns "invalid" string instead of a vector when an error is encountered
  55.252 +(kit/with-handler
  55.253 +  (vec (map int-half [2 4 5 8]))
  55.254 +  (kit/handle kit/error [n]
  55.255 +    "invalid"))
  55.256 +
  55.257 +; Inserts a zero into the returned vector where there was an error, in
  55.258 +; this case [1 2 0 4]
  55.259 +(kit/with-handler
  55.260 +  (vec (map int-half [2 4 5 8]))
  55.261 +  (kit/handle number-error [n]
  55.262 +    (kit/continue-with 0)))
  55.263 +
  55.264 +; Intermediate continue: [1 2 :oops 5 4]
  55.265 +(defn int-half-vec [s]
  55.266 +  (reduce (fn [v i]
  55.267 +            (kit/with-handler
  55.268 +              (conj v (int-half i))
  55.269 +              (kit/bind-continue instead-of-half [& instead-seq]
  55.270 +                (apply conj v instead-seq))))
  55.271 +    [] s))
  55.272 +
  55.273 +(kit/with-handler
  55.274 +  (int-half-vec [2 4 5 8])
  55.275 +  (kit/handle number-error [n]
  55.276 +    (kit/continue instead-of-half :oops n)))
  55.277 +
  55.278 +; Notes:
  55.279 +
  55.280 +; It seems likely you'd want to convert a handle clause to
  55.281 +; bind-continue, since it would allow higher forms to request what you
  55.282 +; used to do by default.  Thus both should appear in the same
  55.283 +; with-handler form
  55.284 +
  55.285 +; Should continue-names be namespace qualified, and therefore require
  55.286 +; pre-definition in some namespace?
  55.287 +; (kit/defcontinue skip-thing "docstring")
  55.288 +
  55.289 +; Could add 'catch' for Java Exceptions and 'finally' support to
  55.290 +; with-handler forms.
  55.291 +
  55.292 +)
    56.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    56.2 +++ b/src/clojure/contrib/except.clj	Sat Aug 21 06:25:44 2010 -0400
    56.3 @@ -0,0 +1,95 @@
    56.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    56.5 +;;  distribution terms for this software are covered by the Eclipse Public
    56.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    56.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    56.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    56.9 +;;  terms of this license.  You must not remove this notice, or any other,
   56.10 +;;  from this software.
   56.11 +;;
   56.12 +;;  except.clj
   56.13 +;;
   56.14 +;;  Provides functions that make it easy to specify the class, cause, and
   56.15 +;;  message when throwing an Exception or Error. The optional message is
   56.16 +;;  formatted using clojure.core/format.
   56.17 +;;
   56.18 +;;  scgilardi (gmail)
   56.19 +;;  Created 07 July 2008
   56.20 +
   56.21 +(ns 
   56.22 +  ^{:author "Stephen C. Gilardi",
   56.23 +     :doc "Provides functions that make it easy to specify the class, cause, and
   56.24 +message when throwing an Exception or Error. The optional message is
   56.25 +formatted using clojure.core/format."}
   56.26 +  clojure.contrib.except
   56.27 +  (:import (clojure.lang Reflector)))
   56.28 +
   56.29 +(declare throwable)
   56.30 +
   56.31 +(defn throwf
   56.32 +  "Throws an Exception or Error with an optional message formatted using
   56.33 +  clojure.core/format. All arguments are optional:
   56.34 +
   56.35 +      class? cause? format? format-args*
   56.36 +
   56.37 +  - class defaults to Exception, if present it must name a kind of
   56.38 +    Throwable
   56.39 +  - cause defaults to nil, if present it must be a Throwable
   56.40 +  - format is a format string for clojure.core/format
   56.41 +  - format-args are objects that correspond to format specifiers in
   56.42 +    format."
   56.43 +  [& args]
   56.44 +  (throw (throwable args)))
   56.45 +
   56.46 +(defn throw-if
   56.47 +  "Throws an Exception or Error if test is true. args are those documented
   56.48 +  for throwf."
   56.49 +  [test & args]
   56.50 +  (when test
   56.51 +    (throw (throwable args))))
   56.52 +
   56.53 +(defn throw-if-not
   56.54 +  "Throws an Exception or Error if test is false. args are those documented
   56.55 +  for throwf."
   56.56 +  [test & args]
   56.57 +  (when-not test
   56.58 +    (throw (throwable args))))
   56.59 +
   56.60 +(defn throw-arg
   56.61 +  "Throws an IllegalArgumentException. All arguments are optional:
   56.62 +
   56.63 +        cause? format? format-args*
   56.64 +
   56.65 +  - cause defaults to nil, if present it must be a Throwable
   56.66 +  - format is a format string for clojure.core/format
   56.67 +  - format-args are objects that correspond to format specifiers in
   56.68 +    format."
   56.69 +  [& args]
   56.70 +  (throw (throwable (cons IllegalArgumentException args))))
   56.71 +
   56.72 +(defn- throwable?
   56.73 +  "Returns true if x is a Throwable"
   56.74 +  [x]
   56.75 +  (instance? Throwable x))
   56.76 +
   56.77 +(defn- throwable
   56.78 +  "Constructs a Throwable with optional cause and formatted message. Its
   56.79 +  stack trace will begin with our caller's caller. Args are as described
   56.80 +  for throwf except throwable accepts them as list rather than inline."
   56.81 +  [args]
   56.82 +  (let [[arg] args
   56.83 +        [class & args] (if (class? arg) args (cons Exception args))
   56.84 +        [arg] args
   56.85 +        [cause & args] (if (throwable? arg) args (cons nil args))
   56.86 +        message (when args (apply format args))
   56.87 +        ctor-args (into-array Object
   56.88 +                              (cond (and message cause) [message cause]
   56.89 +                                    message [message]
   56.90 +                                    cause [cause]))
   56.91 +        throwable (Reflector/invokeConstructor class ctor-args)
   56.92 +        our-prefix "clojure.contrib.except$throwable"
   56.93 +        not-us? #(not (.startsWith (.getClassName %) our-prefix))
   56.94 +        raw-trace (.getStackTrace throwable)
   56.95 +        edited-trace (into-array StackTraceElement
   56.96 +                      (drop 3 (drop-while not-us? raw-trace)))]
   56.97 +    (.setStackTrace throwable edited-trace)
   56.98 +    throwable))
    57.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    57.2 +++ b/src/clojure/contrib/fcase.clj	Sat Aug 21 06:25:44 2010 -0400
    57.3 @@ -0,0 +1,108 @@
    57.4 +;;; fcase.clj -- simple variants of "case" for Clojure
    57.5 +
    57.6 +;; by Stuart Sierra, http://stuartsierra.com/
    57.7 +;; April 7, 2008
    57.8 +
    57.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
   57.10 +;; and distribution terms for this software are covered by the Eclipse
   57.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   57.12 +;; which can be found in the file epl-v10.html at the root of this
   57.13 +;; distribution.  By using this software in any fashion, you are
   57.14 +;; agreeing to be bound by the terms of this license.  You must not
   57.15 +;; remove this notice, or any other, from this software.
   57.16 +
   57.17 +
   57.18 +;; This file defines a generic "case" macro called "fcase" which takes
   57.19 +;; the equality-testing function as an argument.  It also defines a
   57.20 +;; traditional "case" macro that tests using "=" and variants that
   57.21 +;; test for regular expressions and class membership.
   57.22 +
   57.23 +
   57.24 +;; Note (December 23, 2008): This library has been supplanted by the
   57.25 +;; inclusion of "condp" in clojure.core as of Clojure SVN rev. 1180.
   57.26 +
   57.27 +
   57.28 +(ns 
   57.29 +  ^{:author "Stuart Sierra",
   57.30 +     :doc "This file defines a generic \"case\" macro called \"fcase\" which takes
   57.31 +the equality-testing function as an argument.  It also defines a
   57.32 +traditional \"case\" macro that tests using \"=\" and variants that
   57.33 +test for regular expressions and class membership.
   57.34 +
   57.35 +
   57.36 +Note (December 23, 2008): This library has been supplanted by the
   57.37 +inclusion of \"condp\" in clojure.core as of Clojure SVN rev. 1180."} 
   57.38 +
   57.39 +  clojure.contrib.fcase
   57.40 +  (:refer-clojure :exclude (case)))
   57.41 +
   57.42 +
   57.43 +(defmacro fcase
   57.44 +  "Generic switch/case macro.  'fcase' is short for 'function case'.
   57.45 +
   57.46 +  The 'compare-fn' is a fn of two arguments.
   57.47 +
   57.48 +  The 'test-expr-clauses' are value-expression pairs without
   57.49 +  surrounding parentheses, like in Clojure's 'cond'.
   57.50 +
   57.51 +  The 'case-value' is evaluated once and cached.  Then, 'compare-fn'
   57.52 +  is called once for each clause, with the clause's test value as its
   57.53 +  first argument and 'case-value' as its second argument.  If
   57.54 +  'compare-fn' returns logical true, the clause's expression is
   57.55 +  evaluated and returned.  If 'compare-fn' returns false/nil, we go to
   57.56 +  the next test value.
   57.57 +
   57.58 +  If 'test-expr-clauses' contains an odd number of items, the last
   57.59 +  item is the default expression evaluated if no case-value matches.
   57.60 +  If there is no default expression and no case-value matches, fcase
   57.61 +  returns nil.
   57.62 +
   57.63 +  See specific forms of this macro in 'case' and 're-case'.
   57.64 +
   57.65 +  The test expressions in 'fcase' are always evaluated linearly, in
   57.66 +  order.  For a large number of case expressions it may be more
   57.67 +  efficient to use a hash lookup."
   57.68 +  [compare-fn case-value &
   57.69 +   test-expr-clauses]
   57.70 +  (let [test-val-sym (gensym "test_val")
   57.71 +	test-fn-sym (gensym "test_fn")
   57.72 +	cond-loop (fn this [clauses]
   57.73 +		      (cond
   57.74 +		       (>= (count clauses) 2)
   57.75 +		       (list 'if (list test-fn-sym (first clauses) test-val-sym)
   57.76 +			     (second clauses)
   57.77 +			     (this (rest (rest clauses))))
   57.78 +		       (= (count clauses) 1) (first clauses)))]
   57.79 +    (list 'let [test-val-sym case-value, test-fn-sym compare-fn]
   57.80 +	  (cond-loop test-expr-clauses))))
   57.81 +
   57.82 +(defmacro case
   57.83 +  "Like cond, but test-value is compared against the value of each
   57.84 +  test expression with =.  If they are equal, executes the \"body\"
   57.85 +  expression.  Optional last expression is executed if none of the
   57.86 +  test expressions match."
   57.87 +  [test-value & clauses]
   57.88 +  `(fcase = ~test-value ~@clauses))
   57.89 +
   57.90 +(defmacro re-case
   57.91 +  "Like case, but the test expressions are regular expressions, tested
   57.92 +  with re-find."
   57.93 +  [test-value & clauses]
   57.94 +  `(fcase re-find ~test-value ~@clauses))
   57.95 +
   57.96 +(defmacro instance-case
   57.97 +  "Like case, but the test expressions are Java class names, tested with
   57.98 +  'instance?'."
   57.99 +  [test-value & clauses]
  57.100 +  `(fcase instance? ~test-value ~@clauses))
  57.101 +
  57.102 +(defn in-case-test [test-seq case-value]
  57.103 +  (some (fn [item] (= item case-value))
  57.104 +        test-seq))
  57.105 +
  57.106 +(defmacro in-case
  57.107 +  "Like case, but test expressions are sequences.  The test expression
  57.108 +  is true if any item in the sequence is equal (tested with '=') to
  57.109 +  the test value."
  57.110 +  [test-value & clauses]
  57.111 +  `(fcase in-case-test ~test-value ~@clauses))
    58.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    58.2 +++ b/src/clojure/contrib/find_namespaces.clj	Sat Aug 21 06:25:44 2010 -0400
    58.3 @@ -0,0 +1,136 @@
    58.4 +;;; find_namespaces.clj: search for ns declarations in dirs, JARs, or CLASSPATH
    58.5 +
    58.6 +;; by Stuart Sierra, http://stuartsierra.com/
    58.7 +;; April 19, 2009
    58.8 +
    58.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   58.10 +;; and distribution terms for this software are covered by the Eclipse
   58.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   58.12 +;; which can be found in the file epl-v10.html at the root of this
   58.13 +;; distribution.  By using this software in any fashion, you are
   58.14 +;; agreeing to be bound by the terms of this license.  You must not
   58.15 +;; remove this notice, or any other, from this software.
   58.16 +
   58.17 +
   58.18 +(ns 
   58.19 +  ^{:author "Stuart Sierra",
   58.20 +     :doc "Search for ns declarations in dirs, JARs, or CLASSPATH"} 
   58.21 +  clojure.contrib.find-namespaces
   58.22 +  (:require [clojure.contrib.classpath :as cp]
   58.23 +            [clojure.contrib.jar :as jar])
   58.24 +  (import (java.io File FileReader BufferedReader PushbackReader
   58.25 +                   InputStreamReader)
   58.26 +          (java.util.jar JarFile)))
   58.27 +
   58.28 +
   58.29 +;;; Finding namespaces in a directory tree
   58.30 +
   58.31 +(defn clojure-source-file?
   58.32 +  "Returns true if file is a normal file with a .clj extension."
   58.33 +  [^File file]
   58.34 +  (and (.isFile file)
   58.35 +       (.endsWith (.getName file) ".clj")))
   58.36 +
   58.37 +(defn find-clojure-sources-in-dir
   58.38 +  "Searches recursively under dir for Clojure source files (.clj).
   58.39 +  Returns a sequence of File objects, in breadth-first sort order."
   58.40 +  [^File dir]
   58.41 +  ;; Use sort by absolute path to get breadth-first search.
   58.42 +  (sort-by #(.getAbsolutePath %)
   58.43 +           (filter clojure-source-file? (file-seq dir))))
   58.44 +
   58.45 +(defn comment?
   58.46 +  "Returns true if form is a (comment ...)"
   58.47 +  [form]
   58.48 +  (and (list? form) (= 'comment (first form))))
   58.49 +
   58.50 +(defn ns-decl?
   58.51 +  "Returns true if form is a (ns ...) declaration."
   58.52 +  [form]
   58.53 +  (and (list? form) (= 'ns (first form))))
   58.54 +
   58.55 +(defn read-ns-decl
   58.56 +  "Attempts to read a (ns ...) declaration from rdr, and returns the
   58.57 +  unevaluated form.  Returns nil if read fails or if a ns declaration
   58.58 +  cannot be found.  The ns declaration must be the first Clojure form
   58.59 +  in the file, except for (comment ...)  forms."
   58.60 +  [^PushbackReader rdr]
   58.61 +  (try (let [form (read rdr)]
   58.62 +         (cond
   58.63 +           (ns-decl? form) form
   58.64 +           (comment? form) (recur rdr)
   58.65 +           :else nil))
   58.66 +       (catch Exception e nil)))
   58.67 +
   58.68 +(defn read-file-ns-decl
   58.69 +  "Attempts to read a (ns ...) declaration from file, and returns the
   58.70 +  unevaluated form.  Returns nil if read fails, or if the first form
   58.71 +  is not a ns declaration."
   58.72 +  [^File file]
   58.73 +  (with-open [rdr (PushbackReader. (BufferedReader. (FileReader. file)))]
   58.74 +    (read-ns-decl rdr)))
   58.75 +
   58.76 +(defn find-ns-decls-in-dir
   58.77 +  "Searches dir recursively for (ns ...) declarations in Clojure
   58.78 +  source files; returns the unevaluated ns declarations."
   58.79 +  [^File dir]
   58.80 +  (filter identity (map read-file-ns-decl (find-clojure-sources-in-dir dir))))
   58.81 +
   58.82 +(defn find-namespaces-in-dir
   58.83 +  "Searches dir recursively for (ns ...) declarations in Clojure
   58.84 +  source files; returns the symbol names of the declared namespaces."
   58.85 +  [^File dir]
   58.86 +  (map second (find-ns-decls-in-dir dir)))
   58.87 +
   58.88 +
   58.89 +;;; Finding namespaces in JAR files
   58.90 +
   58.91 +(defn clojure-sources-in-jar
   58.92 +  "Returns a sequence of filenames ending in .clj found in the JAR file."
   58.93 +  [^JarFile jar-file]
   58.94 +  (filter #(.endsWith % ".clj") (jar/filenames-in-jar jar-file)))
   58.95 +
   58.96 +(defn read-ns-decl-from-jarfile-entry
   58.97 +  "Attempts to read a (ns ...) declaration from the named entry in the
   58.98 +  JAR file, and returns the unevaluated form.  Returns nil if the read
   58.99 +  fails, or if the first form is not a ns declaration."
  58.100 +  [^JarFile jarfile ^String entry-name]
  58.101 +  (with-open [rdr (PushbackReader.
  58.102 +                   (BufferedReader.
  58.103 +                    (InputStreamReader.
  58.104 +                     (.getInputStream jarfile (.getEntry jarfile entry-name)))))]
  58.105 +    (read-ns-decl rdr)))
  58.106 +
  58.107 +(defn find-ns-decls-in-jarfile
  58.108 +  "Searches the JAR file for Clojure source files containing (ns ...)
  58.109 +  declarations; returns the unevaluated ns declarations."
  58.110 +  [^JarFile jarfile]
  58.111 +  (filter identity
  58.112 +          (map #(read-ns-decl-from-jarfile-entry jarfile %)
  58.113 +               (clojure-sources-in-jar jarfile))))
  58.114 +
  58.115 +(defn find-namespaces-in-jarfile
  58.116 +  "Searches the JAR file for Clojure source files containing (ns ...)
  58.117 +  declarations.  Returns a sequence of the symbol names of the
  58.118 +  declared namespaces."
  58.119 +  [^JarFile jarfile]
  58.120 +  (map second (find-ns-decls-in-jarfile jarfile)))
  58.121 +
  58.122 +
  58.123 +;;; Finding namespaces anywhere on CLASSPATH
  58.124 +
  58.125 +(defn find-ns-decls-on-classpath
  58.126 +  "Searches CLASSPATH (both directories and JAR files) for Clojure
  58.127 +  source files containing (ns ...) declarations.  Returns a sequence
  58.128 +  of the unevaluated ns declaration forms."
  58.129 +  []
  58.130 +  (concat
  58.131 +   (mapcat find-ns-decls-in-dir (cp/classpath-directories))
  58.132 +   (mapcat find-ns-decls-in-jarfile (cp/classpath-jarfiles))))
  58.133 +
  58.134 +(defn find-namespaces-on-classpath
  58.135 +  "Searches CLASSPATH (both directories and JAR files) for Clojure
  58.136 +  source files containing (ns ...) declarations.  Returns a sequence
  58.137 +  of the symbol names of the declared namespaces."
  58.138 +  []
  58.139 +  (map second (find-ns-decls-on-classpath)))
    59.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    59.2 +++ b/src/clojure/contrib/fnmap.clj	Sat Aug 21 06:25:44 2010 -0400
    59.3 @@ -0,0 +1,36 @@
    59.4 +;;; fnmap.clj: maps that dispatch get/assoc to functions
    59.5 +
    59.6 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
    59.7 +;; and distribution terms for this software are covered by the Eclipse
    59.8 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    59.9 +;; which can be found in the file epl-v10.html at the root of this
   59.10 +;; distribution.  By using this software in any fashion, you are
   59.11 +;; agreeing to be bound by the terms of this license.  You must not
   59.12 +;; remove this notice, or any other, from this software.
   59.13 +
   59.14 +
   59.15 +(ns ^{:author "Stuart Sierra"
   59.16 +       :doc "Maps that dispatch get/assoc to user-defined functions.
   59.17 +
   59.18 +  Note: requires AOT-compilation"}
   59.19 +  clojure.contrib.fnmap
   59.20 +  (:require clojure.contrib.fnmap.PersistentFnMap))
   59.21 +
   59.22 +(defn fnmap
   59.23 +  "Creates a fnmap, or functional map.  A fnmap behaves like an
   59.24 +  ordinary Clojure map, except that calls to get and assoc are
   59.25 +  filtered through user-defined getter and setter functions, which
   59.26 +  operate on an internal map.
   59.27 +
   59.28 +  (getter m key) should return a value for key.
   59.29 +
   59.30 +  (setter m key value) should assoc key with value and return a new
   59.31 +  map for m.
   59.32 +
   59.33 +  All other map operations are passed through to the internal map."
   59.34 +  ([getter setter] (clojure.contrib.fnmap.PersistentFnMap/create getter setter))
   59.35 +  ([getter setter & keyvals]
   59.36 +      (apply assoc
   59.37 +             (clojure.contrib.fnmap.PersistentFnMap/create getter setter)
   59.38 +             keyvals)))
   59.39 +
    60.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    60.2 +++ b/src/clojure/contrib/fnmap/PersistentFnMap.clj	Sat Aug 21 06:25:44 2010 -0400
    60.3 @@ -0,0 +1,70 @@
    60.4 +;; PersistentFnMap.clj: implementation for clojure.contrib.fnmap
    60.5 +
    60.6 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
    60.7 +;; and distribution terms for this software are covered by the Eclipse
    60.8 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    60.9 +;; which can be found in the file epl-v10.html at the root of this
   60.10 +;; distribution.  By using this software in any fashion, you are
   60.11 +;; agreeing to be bound by the terms of this license.  You must not
   60.12 +;; remove this notice, or any other, from this software.
   60.13 +
   60.14 +
   60.15 +;; Thanks to Meikel Brandmeyer for his work on lazymap, which made
   60.16 +;; this implementation easier.
   60.17 +
   60.18 +
   60.19 +(ns clojure.contrib.fnmap.PersistentFnMap
   60.20 +  (:gen-class :extends clojure.lang.APersistentMap
   60.21 +              :state state
   60.22 +              :init init
   60.23 +              :constructors {[clojure.lang.IPersistentMap] [],
   60.24 +                             [clojure.lang.IPersistentMap clojure.lang.IPersistentMap] [clojure.lang.IPersistentMap]}))
   60.25 +
   60.26 +(defn -init
   60.27 +  ([theMap] [[] theMap])
   60.28 +  ([theMap metadata] [[metadata] theMap]))
   60.29 +
   60.30 +(defn create [getter setter]
   60.31 +  (clojure.contrib.fnmap.PersistentFnMap.
   60.32 +   {::getter getter ::setter setter}))
   60.33 +
   60.34 +;; IPersistentMap
   60.35 +
   60.36 +(defn -assoc [this key value]
   60.37 +  (clojure.contrib.fnmap.PersistentFnMap.
   60.38 +   ((::setter (. this state)) (. this state) key value)))
   60.39 +
   60.40 +;; Associative
   60.41 +
   60.42 +(defn- -containsKey [this key]
   60.43 +  (not (nil? ((::getter (. this state)) this key))))
   60.44 +
   60.45 +(defn- -entryAt [this key]
   60.46 +  (clojure.lang.MapEntry. key ((::getter (. this state)) (. this state) key)))
   60.47 +
   60.48 +(defn -valAt
   60.49 +  ([this key]
   60.50 +     ((::getter (. this state)) (. this state) key))
   60.51 +  ([this key default]
   60.52 +     (or ((::getter (. this state)) (. this state) key)
   60.53 +         default)))
   60.54 +
   60.55 +;; Iterable
   60.56 +
   60.57 +(defn -iterator [this]
   60.58 +  (.. this state iterator))
   60.59 +
   60.60 +;; IPersistentCollection
   60.61 +
   60.62 +(defn -count [this]
   60.63 +  (count (. this state)))
   60.64 +
   60.65 +(defn -seq [this]
   60.66 +  (seq (. this state)))
   60.67 +
   60.68 +(defn -cons [this that]
   60.69 +  (.. this state (cons this that)))
   60.70 +
   60.71 +(defn -empty [this]
   60.72 +  (.. this state empty))
   60.73 +
    61.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    61.2 +++ b/src/clojure/contrib/gen_html_docs.clj	Sat Aug 21 06:25:44 2010 -0400
    61.3 @@ -0,0 +1,540 @@
    61.4 +;;; gen-html-docs.clj: Generate HTML documentation for Clojure libs
    61.5 +
    61.6 +;; by Craig Andera, http://pluralsight.com/craig, candera@wangdera.com
    61.7 +;; February 13th, 2009
    61.8 +
    61.9 +;; Copyright (c) Craig Andera, 2009. All rights reserved.  The use
   61.10 +;; and distribution terms for this software are covered by the Eclipse
   61.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   61.12 +;; which can be found in the file epl-v10.html at the root of this
   61.13 +;; distribution.  By using this software in any fashion, you are
   61.14 +;; agreeing to be bound by the terms of this license.  You must not
   61.15 +;; remove this notice, or any other, from this software.
   61.16 +
   61.17 +;; Generates a single HTML page that contains the documentation for
   61.18 +;; one or more Clojure libraries. See the comments section at the end
   61.19 +;; of this file for usage.
   61.20 +
   61.21 +;; TODO
   61.22 +;; 
   61.23 +;; * Make symbols in the source hyperlinks to the appropriate section
   61.24 +;;   of the documentation.
   61.25 +;; * Investigate issue with miglayout mentioned here: 
   61.26 +;;   http://groups.google.com/group/clojure/browse_thread/thread/5a0c4395e44f5a79/3ae483100366bd3d?lnk=gst&q=documentation+browser#3ae483100366bd3d
   61.27 +;;
   61.28 +;; DONE
   61.29 +;;
   61.30 +;; * Move to clojure.contrib
   61.31 +;;   * Change namespace
   61.32 +;;   * Change license as appropriate
   61.33 +;;   * Double-check doc strings
   61.34 +;; * Remove doc strings from source code
   61.35 +;; * Add collapse/expand functionality for all namespaces
   61.36 +;; * Add collapse/expand functionality for each namespace
   61.37 +;; * See if converting to use clojure.contrib.prxml is possible
   61.38 +;; * Figure out why the source doesn't show up for most things
   61.39 +;; * Add collapsible source
   61.40 +;; * Add links at the top to jump to each namespace
   61.41 +;; * Add object type (var, function, whatever)
   61.42 +;; * Add argument lists for functions
   61.43 +;; * Add links at the top of each namespace to jump to members
   61.44 +;; * Add license statement
   61.45 +;; * Remove the whojure dependency
   61.46 +
   61.47 +(ns 
   61.48 +  ^{:author "Craig Andera",
   61.49 +     :doc "Generates a single HTML page that contains the documentation for
   61.50 +one or more Clojure libraries."} 
   61.51 +  clojure.contrib.gen-html-docs
   61.52 +  (:require [clojure.contrib.io :as io]
   61.53 +            [clojure.contrib.string :as s])
   61.54 +  (:use [clojure.contrib repl-utils def prxml])
   61.55 +  (:import [java.lang Exception]
   61.56 +	   [java.util.regex Pattern]))
   61.57 +
   61.58 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   61.59 +;; Doc generation constants
   61.60 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   61.61 +
   61.62 +(def *script* " // <![CDATA[
   61.63 +
   61.64 +function getElem(id)
   61.65 +{
   61.66 +  if( document.getElementById )
   61.67 +  {
   61.68 +    return document.getElementById( id )
   61.69 +  }
   61.70 +  else if ( document.all )
   61.71 +  {
   61.72 +    return eval( 'document.all.' + id )
   61.73 +  }
   61.74 +  else
   61.75 +    return false;
   61.76 +}
   61.77 +
   61.78 +function setDisplayStyle(id,displayStyle)
   61.79 +{
   61.80 +  var elem = getElem (id)
   61.81 +  if (elem)
   61.82 +  {
   61.83 +    elem.style.display = displayStyle
   61.84 +  }
   61.85 +
   61.86 +}
   61.87 +
   61.88 +function setLinkToggleText (id, text)
   61.89 +{
   61.90 + var elem = getElem (id)
   61.91 + if (elem)
   61.92 + {
   61.93 +   elem.innerHTML = text
   61.94 + }
   61.95 +}
   61.96 +
   61.97 +function collapse(id)
   61.98 +{
   61.99 +  setDisplayStyle (id, 'none')
  61.100 +}
  61.101 +
  61.102 +function expand (id)
  61.103 +{
  61.104 +  setDisplayStyle (id, 'block')
  61.105 +}
  61.106 +
  61.107 +function toggleSource( id )
  61.108 +{
  61.109 +  toggle(id, 'linkto-' + id, 'Hide Source', 'Show Source')
  61.110 +}
  61.111 +
  61.112 +function toggle(targetid, linkid, textWhenOpen, textWhenClosed)
  61.113 +{
  61.114 +  var elem = getElem (targetid)
  61.115 +  var link = getElem (linkid)
  61.116 +
  61.117 +  if (elem && link)
  61.118 +  {
  61.119 +    var isOpen = false
  61.120 +    if (elem.style.display == '')
  61.121 +    {
  61.122 +      isOpen = link.innerHTML == textWhenOpen
  61.123 +    }
  61.124 +    else if( elem.style.display == 'block' )
  61.125 +    {
  61.126 +      isOpen = true
  61.127 +    }
  61.128 +    
  61.129 +    if (isOpen)
  61.130 +    {
  61.131 +      elem.style.display = 'none'
  61.132 +      link.innerHTML = textWhenClosed
  61.133 +    }
  61.134 +    else
  61.135 +    {
  61.136 +      elem.style.display = 'block'
  61.137 +      link.innerHTML = textWhenOpen
  61.138 +    }
  61.139 +  }
  61.140 +}
  61.141 +
  61.142 +      //]]>
  61.143 +")
  61.144 +
  61.145 +(def *style* "
  61.146 +.library
  61.147 +{
  61.148 +  padding: 0.5em 0 0 0 
  61.149 +}
  61.150 +.all-libs-toggle,.library-contents-toggle
  61.151 +{
  61.152 + font-size: small;
  61.153 +}
  61.154 +.all-libs-toggle a,.library-contents-toggle a
  61.155 +{
  61.156 + color: white
  61.157 +}
  61.158 +.library-member-doc-whitespace
  61.159 +{
  61.160 + white-space: pre
  61.161 +}
  61.162 +.library-member-source-toggle
  61.163 +{
  61.164 +  font-size: small;
  61.165 +  margin-top: 0.5em
  61.166 +}
  61.167 +.library-member-source
  61.168 +{
  61.169 +  display: none;
  61.170 +  border-left: solid lightblue 
  61.171 +}
  61.172 +.library-member-docs
  61.173 +{
  61.174 +  font-family:monospace
  61.175 +}
  61.176 +.library-member-arglists
  61.177 +{
  61.178 +  font-family: monospace
  61.179 +}
  61.180 +.library-member-type
  61.181 +{
  61.182 +  font-weight: bold; 
  61.183 +  font-size: small;
  61.184 +  font-style: italic;
  61.185 +  color: darkred
  61.186 +}
  61.187 +.lib-links
  61.188 +{
  61.189 +  margin: 0 0 1em 0
  61.190 +}
  61.191 +
  61.192 +.lib-link-header
  61.193 +{
  61.194 +  color: white;
  61.195 +  background: darkgreen;
  61.196 +  width: 100%
  61.197 +}
  61.198 +
  61.199 +.library-name 
  61.200 +{ 
  61.201 +  color: white;
  61.202 +  background: darkblue;
  61.203 +  width: 100%
  61.204 +}
  61.205 +
  61.206 +.missing-library
  61.207 +{
  61.208 +  color: darkred; 
  61.209 +  margin: 0 0 1em 0 
  61.210 +}
  61.211 +
  61.212 +.library-members
  61.213 +{
  61.214 +  list-style: none
  61.215 +}
  61.216 +
  61.217 +.library-member-name
  61.218 +{
  61.219 +  font-weight: bold;
  61.220 +  font-size: 105%
  61.221 +}")
  61.222 +
  61.223 +(defn- extract-documentation 
  61.224 +  "Pulls the documentation for a var v out and turns it into HTML"
  61.225 +  [v]
  61.226 +  (if-let [docs (:doc (meta v))]
  61.227 +    (map 
  61.228 +     (fn [l] 
  61.229 +       [:div {:class "library-member-doc-line"} 
  61.230 +	(if (= 0 (count l)) 
  61.231 +	  [:span {:class "library-member-doc-whitespace"} " "] ; We need something here to make the blank line show up
  61.232 +	  l)]) 
  61.233 +     (s/split #"\n" docs)) 
  61.234 +    ""))
  61.235 +
  61.236 +(defn- member-type 
  61.237 +  "Figures out for a var x whether it's a macro, function, var or multifunction"
  61.238 +  [x]
  61.239 +  (try 
  61.240 +   (let [dx (deref x)] 
  61.241 +     (cond 
  61.242 +      (:macro (meta x)) :macro 
  61.243 +      (fn? dx) :fn 
  61.244 +      (= clojure.lang.MultiFn (:tag (meta x))) :multi 
  61.245 +      true :var))
  61.246 +   (catch Exception e
  61.247 +     :unknown)))
  61.248 +
  61.249 +(defn- anchor-for-member 
  61.250 +  "Returns a suitable HTML anchor name given a library id and a member
  61.251 +  id" 
  61.252 +  [libid memberid]
  61.253 +  (str "member-" libid "-" memberid))
  61.254 +
  61.255 +(defn- id-for-member-source 
  61.256 +  "Returns a suitable HTML id for a source listing given a library and
  61.257 +  a member"
  61.258 +  [libid memberid]
  61.259 +  (str "membersource-" libid "-" memberid))
  61.260 +
  61.261 +(defn- id-for-member-source-link 
  61.262 +  "Returns a suitable HTML id for a link to a source listing given a
  61.263 +  library and a member"
  61.264 +  [libid memberid]
  61.265 +  (str "linkto-membersource-" libid "-" memberid))
  61.266 +
  61.267 +(defn- symbol-for 
  61.268 +  "Given a namespace object ns and a namespaceless symbol memberid
  61.269 +  naming a member of that namespace, returns a namespaced symbol that
  61.270 +  identifies that member."
  61.271 +  [ns memberid]
  61.272 +  (symbol (name (ns-name ns)) (name memberid)))
  61.273 +
  61.274 +(defn- elide-to-one-line 
  61.275 +  "Elides a string down to one line."
  61.276 +  [s]
  61.277 +  (s/replace-re #"(\n.*)+" "..." s))
  61.278 +
  61.279 +(defn- elide-string 
  61.280 +  "Returns a string that is at most the first limit characters of s"
  61.281 +  [s limit]
  61.282 +  (if (< (- limit 3) (count s))
  61.283 +    (str (subs s 0 (- limit 3)) "...")
  61.284 +    s))
  61.285 +
  61.286 +(defn- doc-elided-src 
  61.287 +  "Returns the src with the docs elided."
  61.288 +  [docs src]
  61.289 +  (s/replace-re (re-pattern (str "\"" (Pattern/quote docs) "\"")) 
  61.290 +	  (str "\""
  61.291 +		  (elide-to-one-line docs)
  61.292 +;; 	          (elide-string docs 10)
  61.293 +;;	          "..."
  61.294 +		  "\"")
  61.295 +	  src))
  61.296 +
  61.297 +(defn- format-source [libid memberid v]
  61.298 +  (try
  61.299 +   (let [docs (:doc (meta v)) 
  61.300 +	 src (if-let [ns (find-ns libid)]
  61.301 +	       (get-source (symbol-for ns memberid)))]
  61.302 +     (if (and src docs)
  61.303 +       (doc-elided-src docs src)
  61.304 +       src))
  61.305 +   (catch Exception ex
  61.306 +     nil)))
  61.307 +
  61.308 +(defn- generate-lib-member [libid [n v]]
  61.309 +  [:li {:class "library-member"}
  61.310 +   [:a {:name (anchor-for-member libid n)}]
  61.311 +   [:dl {:class "library-member-table"} 
  61.312 +    [:dt {:class "library-member-name"}
  61.313 +     (str n)]
  61.314 +    [:dd 
  61.315 +     [:div {:class "library-member-info"}
  61.316 +      [:span {:class "library-member-type"} (name (member-type v))]
  61.317 +      " "
  61.318 +      [:span {:class "library-member-arglists"} (str (:arglists (meta v)))]]
  61.319 +     (into [:div {:class "library-member-docs"}] (extract-documentation v))
  61.320 +     (let [member-source-id (id-for-member-source libid n)
  61.321 +	   member-source-link-id (id-for-member-source-link libid n)]
  61.322 +       (if-let [member-source (format-source libid n v)] 
  61.323 +	 [:div {:class "library-member-source-section"}
  61.324 +	  [:div {:class "library-member-source-toggle"}
  61.325 +	   "[ "
  61.326 +	   [:a {:href (format "javascript:toggleSource('%s')" member-source-id)
  61.327 +		:id member-source-link-id} "Show Source"]
  61.328 +	   " ]"]	  
  61.329 +	  [:div {:class "library-member-source" :id member-source-id}
  61.330 +	   [:pre member-source]]]))]]])
  61.331 +
  61.332 +(defn- anchor-for-library 
  61.333 +  "Given a symbol id identifying a namespace, returns an identifier
  61.334 +suitable for use as the name attribute of an HTML anchor tag."
  61.335 +  [id]
  61.336 +  (str "library-" id))
  61.337 +
  61.338 +(defn- generate-lib-member-link 
  61.339 +  "Emits a hyperlink to a member of a namespace given libid (a symbol
  61.340 +identifying the namespace) and the vector [n v], where n is the symbol
  61.341 +naming the member in question and v is the var pointing to the
  61.342 +member." 
  61.343 +  [libid [n v]]
  61.344 +  [:a {:class "lib-member-link" 
  61.345 +       :href (str "#" (anchor-for-member libid n))} (name n)])
  61.346 +
  61.347 +(defn- anchor-for-library-contents 
  61.348 +  "Returns an HTML ID that identifies the element that holds the
  61.349 +documentation contents for the specified library."
  61.350 +  [lib]
  61.351 +  (str "library-contents-" lib))
  61.352 +
  61.353 +(defn- anchor-for-library-contents-toggle 
  61.354 +  "Returns an HTML ID that identifies the element that toggles the
  61.355 +visibility of the library contents."
  61.356 +  [lib]
  61.357 +  (str "library-contents-toggle-" lib))
  61.358 +
  61.359 +(defn- generate-lib-doc 
  61.360 +  "Emits the HTML that documents the namespace identified by the
  61.361 +symbol lib."
  61.362 +  [lib]
  61.363 +  [:div {:class "library"} 
  61.364 +   [:a {:name (anchor-for-library lib)}]
  61.365 +   [:div {:class "library-name"} 
  61.366 +    [:span {:class "library-contents-toggle"} 
  61.367 +     "[ "
  61.368 +     [:a {:id (anchor-for-library-contents-toggle lib) 
  61.369 +	  :href (format "javascript:toggle('%s', '%s', '-', '+')" 
  61.370 +			(anchor-for-library-contents lib)
  61.371 +			(anchor-for-library-contents-toggle lib))} 
  61.372 +      "-"]
  61.373 +     " ] "]
  61.374 +    (name lib)]
  61.375 +   (let [ns (find-ns lib)]
  61.376 +     (if ns 
  61.377 +       (let [lib-members (sort (ns-publics ns))]
  61.378 +	 [:a {:name (anchor-for-library lib)}]
  61.379 +	 [:div {:class "library-contents" :id (anchor-for-library-contents lib)}
  61.380 +	  (into [:div {:class "library-member-links"}]
  61.381 +		(interpose " " (map #(generate-lib-member-link lib %) lib-members)))
  61.382 +	  (into [:ol {:class "library-members"}]
  61.383 +		(map #(generate-lib-member lib %) lib-members))])
  61.384 +       [:div {:class "missing-library library-contents" :id (anchor-for-library-contents lib)} "Could not load library"]))])
  61.385 +
  61.386 +(defn- load-lib 
  61.387 +  "Calls require on the library identified by lib, eating any
  61.388 +exceptions."
  61.389 +  [lib]
  61.390 +  (try 
  61.391 +   (require lib)
  61.392 +   (catch java.lang.Exception x
  61.393 +       nil)))
  61.394 +
  61.395 +(defn- generate-lib-link 
  61.396 +  "Generates a hyperlink to the documentation for a namespace given
  61.397 +lib, a symbol identifying that namespace."
  61.398 +  [lib]
  61.399 +  (let [ns (find-ns lib)]
  61.400 +    (if ns
  61.401 +      [:a {:class "lib-link" :href (str "#" (anchor-for-library lib))} (str (ns-name ns))])))
  61.402 +
  61.403 +(defn- generate-lib-links 
  61.404 +  "Generates the list of hyperlinks to each namespace, given libs, a
  61.405 +vector of symbols naming namespaces."
  61.406 +  [libs]
  61.407 +  (into [:div {:class "lib-links"} 
  61.408 +	 [:div {:class "lib-link-header"} "Namespaces"
  61.409 +	  [:span {:class "all-libs-toggle"} 
  61.410 +	   " [ "
  61.411 +	   [:a {:href "javascript:expandAllNamespaces()"}
  61.412 +	    "Expand All"]
  61.413 +	   " ] [ "
  61.414 +	   [:a {:href "javascript:collapseAllNamespaces()"}
  61.415 +	    "Collapse All"]
  61.416 +	   " ]"]]] 
  61.417 +	(interpose " " (map generate-lib-link libs))))
  61.418 +
  61.419 +(defn generate-toggle-namespace-script 
  61.420 +  [action toggle-text lib]
  61.421 +  (str (format "%s('%s');\n" action (anchor-for-library-contents lib))
  61.422 +       (format "setLinkToggleText('%s', '%s');\n" (anchor-for-library-contents-toggle lib) toggle-text)))
  61.423 +
  61.424 +(defn generate-all-namespaces-action-script 
  61.425 +  [action toggle-text libs]
  61.426 +  (str (format  "function %sAllNamespaces()" action)
  61.427 +       \newline
  61.428 +       "{"
  61.429 +       \newline
  61.430 +       (reduce str (map #(generate-toggle-namespace-script action toggle-text %) libs))
  61.431 +       \newline
  61.432 +       "}"))
  61.433 +
  61.434 +(defn generate-documentation 
  61.435 +  "Returns a string which is the HTML documentation for the libraries
  61.436 +named by libs. Libs is a vector of symbols identifying Clojure
  61.437 +libraries."
  61.438 +  [libs]
  61.439 +  (dorun (map load-lib libs))
  61.440 +  (let [writer (new java.io.StringWriter)]
  61.441 +   (binding [*out* writer] 
  61.442 +     (prxml 
  61.443 +      [:html {:xmlns "http://www.w3.org/1999/xhtml"}
  61.444 +       [:head 
  61.445 +	[:title "Clojure documentation browser"]
  61.446 +	[:style *style*]
  61.447 +	[:script {:language "JavaScript" :type "text/javascript"} [:raw! *script*]]
  61.448 +	
  61.449 +	[:script {:language "JavaScript" :type "text/javascript"}
  61.450 +	 [:raw! "// <![CDATA[!" \newline]
  61.451 +	 (generate-all-namespaces-action-script "expand" "-" libs)
  61.452 +	 (generate-all-namespaces-action-script "collapse" "+" libs)
  61.453 +	 [:raw! \newline "// ]]>"]]]
  61.454 +       (let [lib-vec (sort libs)] 
  61.455 +	 (into [:body (generate-lib-links lib-vec)]
  61.456 +	       (map generate-lib-doc lib-vec)))]))
  61.457 +   (.toString writer)))
  61.458 +
  61.459 +
  61.460 +(defn generate-documentation-to-file 
  61.461 +  "Calls generate-documentation on the libraries named by libs and
  61.462 +emits the generated HTML to the path named by path."
  61.463 +  [path libs]
  61.464 +  (io/spit path (generate-documentation libs)))
  61.465 +
  61.466 +(comment 
  61.467 +  (generate-documentation-to-file 
  61.468 +   "C:/TEMP/CLJ-DOCS.HTML"
  61.469 +   ['clojure.contrib.accumulators])
  61.470 +
  61.471 +  (defn gen-all-docs [] 
  61.472 +    (generate-documentation-to-file 
  61.473 +     "C:/temp/clj-libs.html"
  61.474 +     [
  61.475 +     'clojure.set
  61.476 +     'clojure.main 
  61.477 +     'clojure.core  
  61.478 +     'clojure.zip   
  61.479 +     'clojure.xml
  61.480 +     'clojure.contrib.accumulators
  61.481 +     'clojure.contrib.apply-macro
  61.482 +     'clojure.contrib.auto-agent
  61.483 +     'clojure.contrib.combinatorics
  61.484 +     'clojure.contrib.command-line
  61.485 +     'clojure.contrib.complex-numbers
  61.486 +     'clojure.contrib.cond
  61.487 +     'clojure.contrib.def
  61.488 +     'clojure.contrib.io
  61.489 +     'clojure.contrib.enum
  61.490 +     'clojure.contrib.error-kit
  61.491 +     'clojure.contrib.except
  61.492 +     'clojure.contrib.fcase
  61.493 +     'clojure.contrib.generic
  61.494 +     'clojure.contrib.generic.arithmetic
  61.495 +     'clojure.contrib.generic.collection
  61.496 +     'clojure.contrib.generic.comparison
  61.497 +     'clojure.contrib.generic.functor
  61.498 +     'clojure.contrib.generic.math-functions
  61.499 +     'clojure.contrib.import-static
  61.500 +     'clojure.contrib.javadoc
  61.501 +     'clojure.contrib.javalog
  61.502 +     'clojure.contrib.lazy-seqs
  61.503 +     'clojure.contrib.lazy-xml
  61.504 +     'clojure.contrib.macro-utils
  61.505 +     'clojure.contrib.macros
  61.506 +     'clojure.contrib.math
  61.507 +     'clojure.contrib.miglayout
  61.508 +     'clojure.contrib.mmap
  61.509 +     'clojure.contrib.monads
  61.510 +     'clojure.contrib.ns-utils
  61.511 +     'clojure.contrib.prxml
  61.512 +     'clojure.contrib.repl-ln
  61.513 +     'clojure.contrib.repl-utils
  61.514 +     'clojure.contrib.seq
  61.515 +     'clojure.contrib.server-socket
  61.516 +     'clojure.contrib.shell
  61.517 +     'clojure.contrib.sql
  61.518 +     'clojure.contrib.stream-utils
  61.519 +     'clojure.contrib.string
  61.520 +     'clojure.contrib.test-contrib
  61.521 +     'clojure.contrib.trace
  61.522 +     'clojure.contrib.types
  61.523 +     'clojure.contrib.zip-filter
  61.524 +     'clojure.contrib.javadoc.browse
  61.525 +     'clojure.contrib.json.read
  61.526 +     'clojure.contrib.json.write
  61.527 +     'clojure.contrib.lazy-xml.with-pull
  61.528 +     'clojure.contrib.miglayout.internal
  61.529 +     'clojure.contrib.probabilities.finite-distributions
  61.530 +     'clojure.contrib.probabilities.monte-carlo
  61.531 +     'clojure.contrib.probabilities.random-numbers
  61.532 +     'clojure.contrib.sql.internal
  61.533 +     'clojure.contrib.test-clojure.evaluation
  61.534 +     'clojure.contrib.test-clojure.for
  61.535 +     'clojure.contrib.test-clojure.numbers
  61.536 +     'clojure.contrib.test-clojure.printer
  61.537 +     'clojure.contrib.test-clojure.reader
  61.538 +     'clojure.contrib.test-clojure.sequences
  61.539 +     'clojure.contrib.test-contrib.shell
  61.540 +     'clojure.contrib.test-contrib.string
  61.541 +     'clojure.contrib.zip-filter.xml
  61.542 +     ]))
  61.543 +  )
    62.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    62.2 +++ b/src/clojure/contrib/generic.clj	Sat Aug 21 06:25:44 2010 -0400
    62.3 @@ -0,0 +1,54 @@
    62.4 +;; Support code for generic interfaces
    62.5 +
    62.6 +;; by Konrad Hinsen
    62.7 +;; last updated May 4, 2009
    62.8 +
    62.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   62.10 +;; and distribution terms for this software are covered by the Eclipse
   62.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   62.12 +;; which can be found in the file epl-v10.html at the root of this
   62.13 +;; distribution.  By using this software in any fashion, you are
   62.14 +;; agreeing to be bound by the terms of this license.  You must not
   62.15 +;; remove this notice, or any other, from this software.
   62.16 +
   62.17 +(ns
   62.18 +  ^{:author "Konrad Hinsen"
   62.19 +     :skip-wiki true
   62.20 +     :doc "Generic interfaces
   62.21 +           This library provides generic interfaces in the form of
   62.22 +           multimethods that can be implemented for any type.
   62.23 +           The interfaces partly duplicate existing non-generic
   62.24 +           functions in clojure.core (arithmetic, comparison,
   62.25 +           collections) and partly provide additional functions that
   62.26 +           can be defined for a wide variety of types (functors, math
   62.27 +           functions). More functions will be added in the future."}
   62.28 +  clojure.contrib.generic
   62.29 +  (:use [clojure.contrib.types :only (defadt)]))
   62.30 +
   62.31 +;
   62.32 +; A dispatch function that separates nulary, unary, binary, and
   62.33 +; higher arity calls and also selects on type for unary and binary
   62.34 +; calls.
   62.35 +;
   62.36 +(defn nary-dispatch
   62.37 +  ([] ::nulary)
   62.38 +  ([x] (type x))
   62.39 +  ([x y]
   62.40 +     [(type x) (type y)])
   62.41 +  ([x y & more] ::nary))
   62.42 +
   62.43 +;
   62.44 +; We can't use [::binary :default], so we need to define a root type
   62.45 +; of the type hierarcy. The derivation for Object covers all classes,
   62.46 +; but all non-class types will need an explicit derive clause.
   62.47 +; Ultimately, a macro might take care of this.
   62.48 +;
   62.49 +(def root-type ::any)
   62.50 +(derive Object root-type)
   62.51 +
   62.52 +;
   62.53 +; Symbols referring to ::nulary and ::n-ary
   62.54 +;
   62.55 +(def nulary-type ::nulary)
   62.56 +(def nary-type ::nary)
   62.57 +
    63.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    63.2 +++ b/src/clojure/contrib/generic/arithmetic.clj	Sat Aug 21 06:25:44 2010 -0400
    63.3 @@ -0,0 +1,201 @@
    63.4 +;; Generic interfaces for arithmetic operations
    63.5 +
    63.6 +;; by Konrad Hinsen
    63.7 +;; last updated May 5, 2009
    63.8 +
    63.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   63.10 +;; and distribution terms for this software are covered by the Eclipse
   63.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   63.12 +;; which can be found in the file epl-v10.html at the root of this
   63.13 +;; distribution.  By using this software in any fashion, you are
   63.14 +;; agreeing to be bound by the terms of this license.  You must not
   63.15 +;; remove this notice, or any other, from this software.
   63.16 +
   63.17 +(ns
   63.18 +  ^{:author "Konrad Hinsen"
   63.19 +     :doc "Generic arithmetic interface
   63.20 +           This library defines generic versions of + - * / as multimethods
   63.21 +           that can be defined for any type. The minimal required 
   63.22 +           implementations for a type are binary + and * plus unary - and /.
   63.23 +           Everything else is derived from these automatically. Explicit
   63.24 +           binary definitions for - and / can be provided for
   63.25 +           efficiency reasons."}
   63.26 +  clojure.contrib.generic.arithmetic
   63.27 +  (:use [clojure.contrib.generic
   63.28 +	 :only (root-type nulary-type nary-type nary-dispatch)]
   63.29 +	[clojure.contrib.types :only (defadt)])
   63.30 +  (:refer-clojure :exclude [+ - * /]))
   63.31 +
   63.32 +;
   63.33 +; Universal zero and one values
   63.34 +;
   63.35 +(defadt ::zero zero)
   63.36 +(defadt ::one one)
   63.37 +
   63.38 +(derive ::zero root-type)
   63.39 +(derive ::one root-type)
   63.40 +
   63.41 +;
   63.42 +; Addition
   63.43 +;
   63.44 +; The minimal implementation is for binary my-type. It is possible
   63.45 +; in principle to implement [::unary my-type] as well, though this
   63.46 +; doesn't make any sense.
   63.47 +;
   63.48 +(defmulti + 
   63.49 +  "Return the sum of all arguments. The minimal implementation for type
   63.50 +   ::my-type is the binary form with dispatch value [::my-type ::my-type]."
   63.51 +  {:arglists '([x] [x y] [x y & more])}
   63.52 +  nary-dispatch)
   63.53 +
   63.54 +(defmethod + nulary-type
   63.55 +  []
   63.56 +  zero)
   63.57 +
   63.58 +(defmethod + root-type
   63.59 +  [x] x)
   63.60 +
   63.61 +(defmethod + [root-type ::zero]
   63.62 +  [x y] x)
   63.63 +
   63.64 +(defmethod + [::zero root-type]
   63.65 +  [x y] y)
   63.66 +
   63.67 +(defmethod + nary-type
   63.68 +  [x y & more]
   63.69 +  (if more
   63.70 +    (recur (+ x y) (first more) (next more))
   63.71 +    (+ x y)))
   63.72 +
   63.73 +;
   63.74 +; Subtraction
   63.75 +;
   63.76 +; The minimal implementation is for unary my-type. A default binary
   63.77 +; implementation is provided as (+ x (- y)), but it is possible to
   63.78 +; implement unary my-type explicitly for efficiency reasons.
   63.79 +;
   63.80 +(defmulti -
   63.81 +  "Return the difference of the first argument and the sum of all other
   63.82 +   arguments. The minimal implementation for type ::my-type is the binary
   63.83 +   form with dispatch value [::my-type ::my-type]."
   63.84 +  {:arglists '([x] [x y] [x y & more])}
   63.85 +  nary-dispatch)
   63.86 +
   63.87 +(defmethod - nulary-type
   63.88 +  []
   63.89 +  (throw (java.lang.IllegalArgumentException.
   63.90 +	  "Wrong number of arguments passed")))
   63.91 +
   63.92 +(defmethod - [root-type ::zero]
   63.93 +  [x y] x)
   63.94 +
   63.95 +(defmethod - [::zero root-type]
   63.96 +  [x y] (- y))
   63.97 +
   63.98 +(defmethod - [root-type root-type]
   63.99 +  [x y] (+ x (- y)))
  63.100 +
  63.101 +(defmethod - nary-type
  63.102 +  [x y & more]
  63.103 +  (if more
  63.104 +    (recur (- x y) (first more) (next more))
  63.105 +    (- x y)))
  63.106 +
  63.107 +;
  63.108 +; Multiplication
  63.109 +;
  63.110 +; The minimal implementation is for binary [my-type my-type]. It is possible
  63.111 +; in principle to implement unary my-type as well, though this
  63.112 +; doesn't make any sense.
  63.113 +;
  63.114 +(defmulti *
  63.115 +  "Return the product of all arguments. The minimal implementation for type
  63.116 +   ::my-type is the binary form with dispatch value [::my-type ::my-type]."
  63.117 +  {:arglists '([x] [x y] [x y & more])}
  63.118 +  nary-dispatch)
  63.119 +
  63.120 +(defmethod * nulary-type
  63.121 +  []
  63.122 +  one)
  63.123 +
  63.124 +(defmethod * root-type
  63.125 +  [x] x)
  63.126 +
  63.127 +(defmethod * [root-type ::one]
  63.128 +  [x y] x)
  63.129 +
  63.130 +(defmethod * [::one root-type]
  63.131 +  [x y] y)
  63.132 +
  63.133 +(defmethod * nary-type
  63.134 +  [x y & more]
  63.135 +  (if more
  63.136 +    (recur (* x y) (first more) (next more))
  63.137 +    (* x y)))
  63.138 +
  63.139 +;
  63.140 +; Division
  63.141 +;
  63.142 +; The minimal implementation is for unary my-type. A default binary
  63.143 +; implementation is provided as (* x (/ y)), but it is possible to
  63.144 +; implement binary [my-type my-type] explicitly for efficiency reasons.
  63.145 +;
  63.146 +(defmulti /
  63.147 +  "Return the quotient of the first argument and the product of all other
  63.148 +   arguments. The minimal implementation for type ::my-type is the binary
  63.149 +   form with dispatch value [::my-type ::my-type]."
  63.150 +  {:arglists '([x] [x y] [x y & more])}
  63.151 +  nary-dispatch)
  63.152 +
  63.153 +(defmethod / nulary-type
  63.154 +  []
  63.155 +  (throw (java.lang.IllegalArgumentException.
  63.156 +	  "Wrong number of arguments passed")))
  63.157 +
  63.158 +(defmethod / [root-type ::one]
  63.159 +  [x y] x)
  63.160 +
  63.161 +(defmethod / [::one root-type]
  63.162 +  [x y] (/ y))
  63.163 +
  63.164 +(defmethod / [root-type root-type]
  63.165 +  [x y] (* x (/ y)))
  63.166 +
  63.167 +(defmethod / nary-type
  63.168 +  [x y & more]
  63.169 +  (if more
  63.170 +    (recur (/ x y) (first more) (next more))
  63.171 +    (/ x y)))
  63.172 +
  63.173 +;
  63.174 +; Macros to permit access to the / multimethod via namespace qualification
  63.175 +;
  63.176 +(defmacro defmethod*
  63.177 +  "Define a method implementation for the multimethod name in namespace ns.
  63.178 +   Required for implementing the division function from another namespace."
  63.179 +  [ns name & args]
  63.180 +  (let [qsym (symbol (str ns) (str name))]
  63.181 +    `(defmethod ~qsym ~@args)))
  63.182 +
  63.183 +(defmacro qsym
  63.184 +  "Create the qualified symbol corresponding to sym in namespace ns.
  63.185 +   Required to access the division function from another namespace,
  63.186 +   e.g. as (qsym clojure.contrib.generic.arithmetic /)."
  63.187 +  [ns sym]
  63.188 +  (symbol (str ns) (str sym)))
  63.189 +
  63.190 +;
  63.191 +; Minimal implementations for java.lang.Number
  63.192 +;
  63.193 +(defmethod + [java.lang.Number java.lang.Number]
  63.194 +  [x y] (clojure.core/+ x y))
  63.195 +
  63.196 +(defmethod - java.lang.Number
  63.197 +  [x] (clojure.core/- x))
  63.198 +
  63.199 +(defmethod * [java.lang.Number java.lang.Number]
  63.200 +  [x y] (clojure.core/* x y))
  63.201 +
  63.202 +(defmethod / java.lang.Number
  63.203 +  [x] (clojure.core// x))
  63.204 +
    64.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    64.2 +++ b/src/clojure/contrib/generic/collection.clj	Sat Aug 21 06:25:44 2010 -0400
    64.3 @@ -0,0 +1,116 @@
    64.4 +;; Generic interfaces for collection-related functions
    64.5 +
    64.6 +;; by Konrad Hinsen
    64.7 +;; last updated May 5, 2009
    64.8 +
    64.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   64.10 +;; and distribution terms for this software are covered by the Eclipse
   64.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   64.12 +;; which can be found in the file epl-v10.html at the root of this
   64.13 +;; distribution.  By using this software in any fashion, you are
   64.14 +;; agreeing to be bound by the terms of this license.  You must not
   64.15 +;; remove this notice, or any other, from this software.
   64.16 +
   64.17 +(ns
   64.18 +  ^{:author "Konrad Hinsen"
   64.19 +     :doc "Generic arithmetic interface
   64.20 +           This library defines generic versions of common
   64.21 +           collection-related functions as multimethods that can be
   64.22 +           defined for any type."}
   64.23 +  clojure.contrib.generic.collection
   64.24 +  (:refer-clojure :exclude [assoc conj dissoc empty get into seq]))
   64.25 +
   64.26 +;
   64.27 +; assoc
   64.28 +;
   64.29 +(defmulti assoc
   64.30 +  "Returns a new collection in which the values corresponding to the
   64.31 +   given keys are updated by the given values. Each type of collection
   64.32 +   can have specific restrictions on the possible keys."
   64.33 +   {:arglists '([coll & key-val-pairs])}
   64.34 +   (fn [coll & items] (type coll)))
   64.35 +
   64.36 +(defmethod assoc :default
   64.37 +  [map & key-val-pairs]
   64.38 +  (apply clojure.core/assoc map key-val-pairs))
   64.39 +
   64.40 +; assoc-in
   64.41 +
   64.42 +;
   64.43 +; conj
   64.44 +;
   64.45 +(defmulti conj
   64.46 +  "Returns a new collection resulting from adding all xs to coll."
   64.47 +   {:arglists '([coll & xs])}
   64.48 +  (fn [coll & xs] (type coll)))
   64.49 +
   64.50 +(defmethod conj :default
   64.51 +  [coll & xs]
   64.52 +  (apply clojure.core/conj coll xs))
   64.53 +
   64.54 +;
   64.55 +; diassoc
   64.56 +;
   64.57 +(defmulti dissoc
   64.58 +  "Returns a new collection in which the entries corresponding to the
   64.59 +   given keys are removed. Each type of collection can have specific
   64.60 +   restrictions on the possible keys."
   64.61 +   {:arglists '([coll & keys])}
   64.62 +   (fn [coll & keys] (type coll)))
   64.63 +
   64.64 +(defmethod dissoc :default
   64.65 +  [map & keys]
   64.66 +  (apply clojure.core/dissoc map keys))
   64.67 +
   64.68 +;
   64.69 +; empty
   64.70 +;
   64.71 +(defmulti empty
   64.72 +  "Returns an empty collection of the same kind as the argument"
   64.73 +   {:arglists '([coll])}
   64.74 +   type)
   64.75 +
   64.76 +(defmethod empty :default
   64.77 +  [coll]
   64.78 +  (clojure.core/empty coll))
   64.79 +
   64.80 +;
   64.81 +; get
   64.82 +;
   64.83 +(defmulti get
   64.84 +  "Returns the element of coll referred to by key. Each type of collection
   64.85 +   can have specific restrictions on the possible keys."
   64.86 +   {:arglists '([coll key] [coll key not-found])}
   64.87 +  (fn [coll & args] (type coll)))
   64.88 +
   64.89 +(defmethod get :default
   64.90 +  ([coll key]
   64.91 +     (clojure.core/get coll key))
   64.92 +  ([coll key not-found]
   64.93 +     (clojure.core/get coll key not-found)))
   64.94 +
   64.95 +;
   64.96 +; into
   64.97 +;
   64.98 +(defmulti into
   64.99 +  "Returns a new coll consisting of to-coll with all of the items of
  64.100 +  from-coll conjoined."
  64.101 +   {:arglists '([to from])}
  64.102 +  (fn [to from] (type to)))
  64.103 +
  64.104 +(declare seq)
  64.105 +(defmethod into :default
  64.106 +  [to from]
  64.107 +  (reduce conj to (seq from)))
  64.108 +
  64.109 +;
  64.110 +; seq
  64.111 +;
  64.112 +(defmulti seq
  64.113 +  "Returns a seq on the object s."
  64.114 +  {:arglists '([s])}
  64.115 +  type)
  64.116 +
  64.117 +(defmethod seq :default
  64.118 +  [s]
  64.119 +  (clojure.core/seq s))
    65.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    65.2 +++ b/src/clojure/contrib/generic/comparison.clj	Sat Aug 21 06:25:44 2010 -0400
    65.3 @@ -0,0 +1,214 @@
    65.4 +;; Generic interfaces for comparison operations
    65.5 +
    65.6 +;; by Konrad Hinsen
    65.7 +;; last updated May 25, 2010
    65.8 +
    65.9 +;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved.  The use
   65.10 +;; and distribution terms for this software are covered by the Eclipse
   65.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   65.12 +;; which can be found in the file epl-v10.html at the root of this
   65.13 +;; distribution.  By using this software in any fashion, you are
   65.14 +;; agreeing to be bound by the terms of this license.  You must not
   65.15 +;; remove this notice, or any other, from this software.
   65.16 +
   65.17 +(ns
   65.18 +  ^{:author "Konrad Hinsen"
   65.19 +     :doc "Generic comparison interface
   65.20 +           This library defines generic versions of = < > <= >= zero?
   65.21 +           as multimethods that can be defined for any type. Of the
   65.22 +           greater/less-than relations, types must minimally implement >."}
   65.23 +  clojure.contrib.generic.comparison
   65.24 +  (:refer-clojure :exclude [= < > <= >= zero? pos? neg? min max])
   65.25 +  (:use [clojure.contrib.generic
   65.26 +	 :only (root-type nulary-type nary-type nary-dispatch)]))
   65.27 +
   65.28 +;
   65.29 +; zero? pos? neg?
   65.30 +;
   65.31 +(defmulti zero?
   65.32 +  "Return true of x is zero."
   65.33 +  {:arglists '([x])}
   65.34 +  type)
   65.35 +
   65.36 +(defmulti pos?
   65.37 +  "Return true of x is positive."
   65.38 +  {:arglists '([x])}
   65.39 +  type)
   65.40 +
   65.41 +(defmulti neg?
   65.42 +  "Return true of x is negative."
   65.43 +  {:arglists '([x])}
   65.44 +  type)
   65.45 +
   65.46 +;
   65.47 +; Equality
   65.48 +;
   65.49 +(defmulti =
   65.50 +  "Return true if all arguments are equal. The minimal implementation for type
   65.51 +   ::my-type is the binary form with dispatch value [::my-type ::my-type]."
   65.52 +  {:arglists '([x] [x y] [x y & more])}
   65.53 +  nary-dispatch)
   65.54 +
   65.55 +(defmethod = root-type
   65.56 +  [x] true)
   65.57 +
   65.58 +(defmethod = nary-type
   65.59 +  [x y & more]
   65.60 +  (if (= x y)
   65.61 +    (if (next more)
   65.62 +      (recur y (first more) (next more))
   65.63 +      (= y (first more)))
   65.64 +    false))
   65.65 +
   65.66 +;
   65.67 +; Greater-than
   65.68 +;
   65.69 +(defmulti >
   65.70 +  "Return true if each argument is larger than the following ones.
   65.71 +   The minimal implementation for type ::my-type is the binary form
   65.72 +   with dispatch value [::my-type ::my-type]."
   65.73 +  {:arglists '([x] [x y] [x y & more])}
   65.74 +  nary-dispatch)
   65.75 +
   65.76 +(defmethod > root-type
   65.77 +  [x] true)
   65.78 +
   65.79 +(defmethod > nary-type
   65.80 +  [x y & more]
   65.81 +  (if (> x y)
   65.82 +    (if (next more)
   65.83 +      (recur y (first more) (next more))
   65.84 +      (> y (first more)))
   65.85 +    false))
   65.86 +
   65.87 +;
   65.88 +; Less-than defaults to greater-than with arguments inversed
   65.89 +;
   65.90 +(defmulti <
   65.91 +  "Return true if each argument is smaller than the following ones.
   65.92 +   The minimal implementation for type ::my-type is the binary form
   65.93 +   with dispatch value [::my-type ::my-type]. A default implementation
   65.94 +   is provided in terms of >."
   65.95 +  {:arglists '([x] [x y] [x y & more])}
   65.96 +  nary-dispatch)
   65.97 +
   65.98 +(defmethod < root-type
   65.99 +  [x] true)
  65.100 +
  65.101 +(defmethod < [root-type root-type]
  65.102 +  [x y]
  65.103 +  (> y x))
  65.104 +
  65.105 +(defmethod < nary-type
  65.106 +  [x y & more]
  65.107 +  (if (< x y)
  65.108 +    (if (next more)
  65.109 +      (recur y (first more) (next more))
  65.110 +      (< y (first more)))
  65.111 +    false))
  65.112 +
  65.113 +;
  65.114 +; Greater-or-equal defaults to (complement <)
  65.115 +;
  65.116 +(defmulti >=
  65.117 +  "Return true if each argument is larger than or equal to the following
  65.118 +   ones. The minimal implementation for type ::my-type is the binary form
  65.119 +   with dispatch value [::my-type ::my-type]. A default implementation
  65.120 +   is provided in terms of <."
  65.121 +  {:arglists '([x] [x y] [x y & more])}
  65.122 +  nary-dispatch)
  65.123 +
  65.124 +(defmethod >= root-type
  65.125 +  [x] true)
  65.126 +
  65.127 +(defmethod >= [root-type root-type]
  65.128 +  [x y]
  65.129 +  (not (< x y)))
  65.130 +
  65.131 +(defmethod >= nary-type
  65.132 +  [x y & more]
  65.133 +  (if (>= x y)
  65.134 +    (if (next more)
  65.135 +      (recur y (first more) (next more))
  65.136 +      (>= y (first more)))
  65.137 +    false))
  65.138 +
  65.139 +;
  65.140 +; Less-than defaults to (complement >)
  65.141 +;
  65.142 +(defmulti <=
  65.143 +  "Return true if each arguments is smaller than or equal to the following
  65.144 +   ones. The minimal implementation for type ::my-type is the binary form
  65.145 +   with dispatch value [::my-type ::my-type]. A default implementation
  65.146 +   is provided in terms of >."
  65.147 +  {:arglists '([x] [x y] [x y & more])}
  65.148 +  nary-dispatch)
  65.149 +
  65.150 +(defmethod <= root-type
  65.151 +  [x] true)
  65.152 +
  65.153 +(defmethod <= [root-type root-type]
  65.154 +  [x y]
  65.155 +  (not (> x y)))
  65.156 +
  65.157 +(defmethod <= nary-type
  65.158 +  [x y & more]
  65.159 +  (if (<= x y)
  65.160 +    (if (next more)
  65.161 +      (recur y (first more) (next more))
  65.162 +      (<= y (first more)))
  65.163 +    false))
  65.164 +
  65.165 +;
  65.166 +; Implementations for Clojure's built-in types
  65.167 +;
  65.168 +(defmethod zero? java.lang.Number
  65.169 +  [x]
  65.170 +  (clojure.core/zero? x))
  65.171 +
  65.172 +(defmethod pos? java.lang.Number
  65.173 +  [x]
  65.174 +  (clojure.core/pos? x))
  65.175 +
  65.176 +(defmethod neg? java.lang.Number
  65.177 +  [x]
  65.178 +  (clojure.core/neg? x))
  65.179 +
  65.180 +(defmethod = [Object Object]
  65.181 +  [x y]
  65.182 +  (clojure.core/= x y))
  65.183 +
  65.184 +(defmethod > [java.lang.Number java.lang.Number]
  65.185 +  [x y]
  65.186 +  (clojure.core/> x y))
  65.187 +
  65.188 +(defmethod < [java.lang.Number java.lang.Number]
  65.189 +  [x y]
  65.190 +  (clojure.core/< x y))
  65.191 +
  65.192 +(defmethod >= [java.lang.Number java.lang.Number]
  65.193 +  [x y]
  65.194 +  (clojure.core/>= x y))
  65.195 +
  65.196 +(defmethod <= [java.lang.Number java.lang.Number]
  65.197 +  [x y]
  65.198 +  (clojure.core/<= x y))
  65.199 +
  65.200 +;
  65.201 +; Functions defined in terms of the comparison operators
  65.202 +;
  65.203 +(defn max
  65.204 +  "Returns the greatest of its arguments. Like clojure.core/max except that
  65.205 +   is uses generic comparison functions implementable for any data type."
  65.206 +  ([x] x)
  65.207 +  ([x y] (if (> x y) x y))
  65.208 +  ([x y & more]
  65.209 +   (reduce max (max x y) more)))
  65.210 +
  65.211 +(defn min
  65.212 +  "Returns the least of its arguments. Like clojure.core/min except that
  65.213 +   is uses generic comparison functions implementable for any data type."
  65.214 +  ([x] x)
  65.215 +  ([x y] (if (< x y) x y))
  65.216 +  ([x y & more]
  65.217 +   (reduce min (min x y) more)))
    66.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    66.2 +++ b/src/clojure/contrib/generic/functor.clj	Sat Aug 21 06:25:44 2010 -0400
    66.3 @@ -0,0 +1,40 @@
    66.4 +;; Generic interface for functors
    66.5 +
    66.6 +;; by Konrad Hinsen
    66.7 +;; last updated May 3, 2009
    66.8 +
    66.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   66.10 +;; and distribution terms for this software are covered by the Eclipse
   66.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   66.12 +;; which can be found in the file epl-v10.html at the root of this
   66.13 +;; distribution.  By using this software in any fashion, you are
   66.14 +;; agreeing to be bound by the terms of this license.  You must not
   66.15 +;; remove this notice, or any other, from this software.
   66.16 +
   66.17 +(ns
   66.18 +  ^{:author "Konrad Hinsen"
   66.19 +     :doc "Generic functor interface (fmap)"}
   66.20 +  clojure.contrib.generic.functor)
   66.21 +
   66.22 +
   66.23 +(defmulti fmap
   66.24 +  "Applies function f to each item in the data structure s and returns
   66.25 +   a structure of the same kind."
   66.26 +   {:arglists '([f s])}
   66.27 +   (fn [f s] (type s)))
   66.28 +
   66.29 +(defmethod fmap clojure.lang.IPersistentList
   66.30 +  [f v]
   66.31 +  (into (empty v) (map f v)))
   66.32 +
   66.33 +(defmethod fmap clojure.lang.IPersistentVector
   66.34 +  [f v]
   66.35 +  (into (empty v) (map f v)))
   66.36 +
   66.37 +(defmethod fmap clojure.lang.IPersistentMap
   66.38 +  [f m]
   66.39 +  (into (empty m) (for [[k v] m] [k (f v)])))
   66.40 +
   66.41 +(defmethod fmap clojure.lang.IPersistentSet
   66.42 +  [f s]
   66.43 +  (into (empty s) (map f s)))
    67.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    67.2 +++ b/src/clojure/contrib/generic/math_functions.clj	Sat Aug 21 06:25:44 2010 -0400
    67.3 @@ -0,0 +1,114 @@
    67.4 +;; Generic interfaces for mathematical functions
    67.5 +
    67.6 +;; by Konrad Hinsen
    67.7 +;; last updated May 5, 2009
    67.8 +
    67.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   67.10 +;; and distribution terms for this software are covered by the Eclipse
   67.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   67.12 +;; which can be found in the file epl-v10.html at the root of this
   67.13 +;; distribution.  By using this software in any fashion, you are
   67.14 +;; agreeing to be bound by the terms of this license.  You must not
   67.15 +;; remove this notice, or any other, from this software.
   67.16 +
   67.17 +(ns
   67.18 +  ^{:author "Konrad Hinsen"
   67.19 +     :doc "Generic math function interface
   67.20 +           This library defines generic versions of common mathematical
   67.21 +           functions such as sqrt or sin as multimethods that can be
   67.22 +           defined for any type."}
   67.23 +  clojure.contrib.generic.math-functions
   67.24 +  (:use [clojure.contrib.def :only (defmacro-)])
   67.25 +  (:require [clojure.contrib.generic.arithmetic :as ga]
   67.26 +	    [clojure.contrib.generic.comparison :as gc]))
   67.27 +
   67.28 +(defmacro- defmathfn-1
   67.29 +  [name]
   67.30 +  (let [java-symbol (symbol "java.lang.Math" (str name))]
   67.31 +    `(do
   67.32 +       (defmulti ~name
   67.33 +	 ~(str "Return the " name " of x.")
   67.34 +	 {:arglists '([~'x])}
   67.35 +	 type)
   67.36 +       (defmethod ~name java.lang.Number
   67.37 +	 [~'x]
   67.38 +	 (~java-symbol ~'x)))))
   67.39 +
   67.40 +(defn- two-types [x y] [(type x) (type y)])
   67.41 +
   67.42 +(defmacro- defmathfn-2
   67.43 +  [name]
   67.44 +  (let [java-symbol (symbol "java.lang.Math" (str name))]
   67.45 +    `(do
   67.46 +       (defmulti ~name
   67.47 +	 ~(str "Return the " name " of x and y.")
   67.48 +	 {:arglists '([~'x ~'y])}
   67.49 +	 two-types)
   67.50 +       (defmethod ~name [java.lang.Number java.lang.Number]
   67.51 +	 [~'x ~'y]
   67.52 +	 (~java-symbol ~'x ~'y)))))
   67.53 +
   67.54 +; List of math functions taken from
   67.55 +; http://java.sun.com/j2se/1.4.2/docs/api/java/lang/Math.html
   67.56 +(defmathfn-1 abs)
   67.57 +(defmathfn-1 acos)
   67.58 +(defmathfn-1 asin)
   67.59 +(defmathfn-1 atan)
   67.60 +(defmathfn-2 atan2)
   67.61 +(defmathfn-1 ceil)
   67.62 +(defmathfn-1 cos)
   67.63 +(defmathfn-1 exp)
   67.64 +(defmathfn-1 floor)
   67.65 +(defmathfn-1 log)
   67.66 +(defmathfn-2 pow)
   67.67 +(defmathfn-1 rint)
   67.68 +(defmathfn-1 round)
   67.69 +(defmathfn-1 sin)
   67.70 +(defmathfn-1 sqrt)
   67.71 +(defmathfn-1 tan)
   67.72 +
   67.73 +;
   67.74 +; Sign
   67.75 +;
   67.76 +(defmulti sgn
   67.77 +  "Return the sign of x (-1, 0, or 1)."
   67.78 +  {:arglists '([x])}
   67.79 +  type)
   67.80 +
   67.81 +(defmethod sgn :default
   67.82 +  [x]
   67.83 +  (cond (gc/zero? x) 0
   67.84 +	(gc/> x 0) 1
   67.85 +	:else -1))
   67.86 +
   67.87 +;
   67.88 +; Conjugation
   67.89 +;
   67.90 +(defmulti conjugate
   67.91 +  "Return the conjugate of x."
   67.92 +  {:arglists '([x])}
   67.93 +  type)
   67.94 +
   67.95 +(defmethod conjugate :default
   67.96 +  [x] x)
   67.97 +
   67.98 +;
   67.99 +; Square
  67.100 +;
  67.101 +(defmulti sqr
  67.102 +  "Return the square of x."
  67.103 +  {:arglists '([x])}
  67.104 +  type)
  67.105 +
  67.106 +(defmethod sqr :default
  67.107 +  [x]
  67.108 +  (ga/* x x))
  67.109 +
  67.110 +;
  67.111 +; Approximate equality for use with floating point types
  67.112 +;
  67.113 +(defn approx=
  67.114 +  "Return true if the absolute value of the difference between x and y
  67.115 +   is less than eps."
  67.116 +  [x y eps]
  67.117 +  (gc/< (abs (ga/- x y)) eps))
    68.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    68.2 +++ b/src/clojure/contrib/graph.clj	Sat Aug 21 06:25:44 2010 -0400
    68.3 @@ -0,0 +1,228 @@
    68.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
    68.5 +;;  distribution terms for this software are covered by the Eclipse Public
    68.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    68.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    68.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    68.9 +;;  terms of this license.  You must not remove this notice, or any other,
   68.10 +;;  from this software.
   68.11 +;;
   68.12 +;;  graph
   68.13 +;;
   68.14 +;;  Basic Graph Theory Algorithms
   68.15 +;;
   68.16 +;;  straszheimjeffrey (gmail)
   68.17 +;;  Created 23 June 2009
   68.18 +
   68.19 +
   68.20 +(ns 
   68.21 +  ^{:author "Jeffrey Straszheim",
   68.22 +     :doc "Basic graph theory algorithms"}
   68.23 +  clojure.contrib.graph
   68.24 +  (use [clojure.set :only (union)]))
   68.25 +
   68.26 +
   68.27 +(defstruct directed-graph
   68.28 +  :nodes       ; The nodes of the graph, a collection
   68.29 +  :neighbors)  ; A function that, given a node returns a collection
   68.30 +               ; neighbor nodes.
   68.31 +
   68.32 +(defn get-neighbors
   68.33 +  "Get the neighbors of a node."
   68.34 +  [g n]
   68.35 +  ((:neighbors g) n))
   68.36 +
   68.37 +
   68.38 +;; Graph Modification
   68.39 +
   68.40 +(defn reverse-graph
   68.41 +  "Given a directed graph, return another directed graph with the
   68.42 +   order of the edges reversed."
   68.43 +  [g]
   68.44 +  (let [op (fn [rna idx]
   68.45 +             (let [ns (get-neighbors g idx)
   68.46 +                   am (fn [m val]
   68.47 +                        (assoc m val (conj (get m val #{}) idx)))]
   68.48 +               (reduce am rna ns)))
   68.49 +        rn (reduce op {} (:nodes g))]
   68.50 +    (struct directed-graph (:nodes g) rn)))
   68.51 +
   68.52 +(defn add-loops
   68.53 +  "For each node n, add the edge n->n if not already present."
   68.54 +  [g]
   68.55 +  (struct directed-graph
   68.56 +          (:nodes g)
   68.57 +          (into {} (map (fn [n]
   68.58 +                          [n (conj (set (get-neighbors g n)) n)]) (:nodes g)))))
   68.59 +
   68.60 +(defn remove-loops
   68.61 +  "For each node n, remove any edges n->n."
   68.62 +  [g]
   68.63 +  (struct directed-graph
   68.64 +          (:nodes g)
   68.65 +          (into {} (map (fn [n]
   68.66 +                          [n (disj (set (get-neighbors g n)) n)]) (:nodes g)))))
   68.67 +
   68.68 +
   68.69 +;; Graph Walk
   68.70 +
   68.71 +(defn lazy-walk
   68.72 +  "Return a lazy sequence of the nodes of a graph starting a node n.  Optionally,
   68.73 +   provide a set of visited notes (v) and a collection of nodes to
   68.74 +   visit (ns)."
   68.75 +  ([g n]
   68.76 +     (lazy-walk g [n] #{}))
   68.77 +  ([g ns v]
   68.78 +     (lazy-seq (let [s (seq (drop-while v ns))
   68.79 +                     n (first s)
   68.80 +                     ns (rest s)]
   68.81 +                 (when s
   68.82 +                   (cons n (lazy-walk g (concat (get-neighbors g n) ns) (conj v n))))))))
   68.83 +
   68.84 +(defn transitive-closure
   68.85 +  "Returns the transitive closure of a graph.  The neighbors are lazily computed.
   68.86 +
   68.87 +   Note: some version of this algorithm return all edges a->a
   68.88 +   regardless of whether such loops exist in the original graph.  This
   68.89 +   version does not.  Loops will be included only if produced by
   68.90 +   cycles in the graph.  If you have code that depends on such
   68.91 +   behavior, call (-> g transitive-closure add-loops)"
   68.92 +  [g]
   68.93 +  (let [nns (fn [n]
   68.94 +              [n (delay (lazy-walk g (get-neighbors g n) #{}))])
   68.95 +        nbs (into {} (map nns (:nodes g)))]
   68.96 +    (struct directed-graph
   68.97 +            (:nodes g)
   68.98 +            (fn [n] (force (nbs n))))))
   68.99 +          
  68.100 +                
  68.101 +;; Strongly Connected Components
  68.102 +
  68.103 +(defn- post-ordered-visit
  68.104 +  "Starting at node n, perform a post-ordered walk."
  68.105 +  [g n [visited acc :as state]]
  68.106 +  (if (visited n)
  68.107 +    state
  68.108 +    (let [[v2 acc2] (reduce (fn [st nd] (post-ordered-visit g nd st))
  68.109 +                            [(conj visited n) acc]
  68.110 +                            (get-neighbors g n))]
  68.111 +      [v2 (conj acc2 n)])))
  68.112 +  
  68.113 +(defn post-ordered-nodes
  68.114 +  "Return a sequence of indexes of a post-ordered walk of the graph."
  68.115 +  [g]
  68.116 +  (fnext (reduce #(post-ordered-visit g %2 %1)
  68.117 +                 [#{} []]
  68.118 +                 (:nodes g))))
  68.119 +
  68.120 +(defn scc
  68.121 +  "Returns, as a sequence of sets, the strongly connected components
  68.122 +   of g."
  68.123 +  [g]
  68.124 +  (let [po (reverse (post-ordered-nodes g))
  68.125 +        rev (reverse-graph g)
  68.126 +        step (fn [stack visited acc]
  68.127 +               (if (empty? stack)
  68.128 +                 acc
  68.129 +                 (let [[nv comp] (post-ordered-visit rev
  68.130 +                                                     (first stack)
  68.131 +                                                     [visited #{}])
  68.132 +                       ns (remove nv stack)]
  68.133 +                   (recur ns nv (conj acc comp)))))]
  68.134 +    (step po #{} [])))
  68.135 +
  68.136 +(defn component-graph
  68.137 +  "Given a graph, perhaps with cycles, return a reduced graph that is acyclic.
  68.138 +   Each node in the new graph will be a set of nodes from the old.
  68.139 +   These sets are the strongly connected components.  Each edge will
  68.140 +   be the union of the corresponding edges of the prior graph."
  68.141 +  ([g]
  68.142 +     (component-graph g (scc g)))
  68.143 +  ([g sccs]
  68.144 +     (let [find-node-set (fn [n]
  68.145 +                           (some #(if (% n) % nil) sccs))
  68.146 +           find-neighbors (fn [ns]
  68.147 +                            (let [nbs1 (map (partial get-neighbors g) ns)
  68.148 +                                  nbs2 (map set nbs1)
  68.149 +                                  nbs3 (apply union nbs2)]
  68.150 +                              (set (map find-node-set nbs3))))
  68.151 +           nm (into {} (map (fn [ns] [ns (find-neighbors ns)]) sccs))]
  68.152 +       (struct directed-graph (set sccs) nm))))
  68.153 +
  68.154 +(defn recursive-component?
  68.155 +  "Is the component (recieved from scc) self recursive?"
  68.156 +  [g ns]
  68.157 +  (or (> (count ns) 1)
  68.158 +      (let [n (first ns)]
  68.159 +        (some #(= % n) (get-neighbors g n)))))
  68.160 +
  68.161 +(defn self-recursive-sets
  68.162 +  "Returns, as a sequence of sets, the components of a graph that are
  68.163 +   self-recursive."
  68.164 +  [g]
  68.165 +  (filter (partial recursive-component? g) (scc g)))
  68.166 +                          
  68.167 +
  68.168 +;; Dependency Lists
  68.169 +
  68.170 +(defn fixed-point
  68.171 +  "Repeatedly apply fun to data until (equal old-data new-data)
  68.172 +   returns true.  If max iterations occur, it will throw an
  68.173 +   exception.  Set max to nil for unlimited iterations."
  68.174 +  [data fun max equal]
  68.175 +  (let [step (fn step [data idx]
  68.176 +               (when (and idx (= 0 idx))
  68.177 +                 (throw (Exception. "Fixed point overflow")))
  68.178 +               (let [new-data (fun data)]
  68.179 +                 (if (equal data new-data)
  68.180 +                   new-data
  68.181 +                   (recur new-data (and idx (dec idx))))))]
  68.182 +    (step data max)))
  68.183 +                  
  68.184 +(defn- fold-into-sets
  68.185 +  [priorities]
  68.186 +  (let [max (inc (apply max 0 (vals priorities)))
  68.187 +        step (fn [acc [n dep]]
  68.188 +               (assoc acc dep (conj (acc dep) n)))]
  68.189 +    (reduce step
  68.190 +            (vec (replicate max #{}))
  68.191 +            priorities)))
  68.192 +            
  68.193 +(defn dependency-list
  68.194 +  "Similar to a topological sort, this returns a vector of sets. The
  68.195 +   set of nodes at index 0 are independent.  The set at index 1 depend
  68.196 +   on index 0; those at 2 depend on 0 and 1, and so on.  Those withing
  68.197 +   a set have no mutual dependencies.  Assume the input graph (which
  68.198 +   much be acyclic) has an edge a->b when a depends on b."
  68.199 +  [g]
  68.200 +  (let [step (fn [d]
  68.201 +               (let [update (fn [n]
  68.202 +                              (inc (apply max -1 (map d (get-neighbors g n)))))]
  68.203 +                 (into {} (map (fn [[k v]] [k (update k)]) d))))
  68.204 +        counts (fixed-point (zipmap (:nodes g) (repeat 0))
  68.205 +                            step
  68.206 +                            (inc (count (:nodes g)))
  68.207 +                            =)]
  68.208 +    (fold-into-sets counts)))
  68.209 +    
  68.210 +(defn stratification-list
  68.211 +  "Similar to dependency-list (see doc), except two graphs are
  68.212 +   provided.  The first is as dependency-list.  The second (which may
  68.213 +   have cycles) provides a partial-dependency relation.  If node a
  68.214 +   depends on node b (meaning an edge a->b exists) in the second
  68.215 +   graph, node a must be equal or later in the sequence."
  68.216 +  [g1 g2]
  68.217 +  (assert (= (-> g1 :nodes set) (-> g2 :nodes set)))
  68.218 +  (let [step (fn [d]
  68.219 +               (let [update (fn [n]
  68.220 +                              (max (inc (apply max -1
  68.221 +                                               (map d (get-neighbors g1 n))))
  68.222 +                                   (apply max -1 (map d (get-neighbors g2 n)))))]
  68.223 +                 (into {} (map (fn [[k v]] [k (update k)]) d))))
  68.224 +        counts (fixed-point (zipmap (:nodes g1) (repeat 0))
  68.225 +                            step
  68.226 +                            (inc (count (:nodes g1)))
  68.227 +                            =)]
  68.228 +    (fold-into-sets counts)))
  68.229 +
  68.230 +
  68.231 +;; End of file
    69.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    69.2 +++ b/src/clojure/contrib/greatest_least.clj	Sat Aug 21 06:25:44 2010 -0400
    69.3 @@ -0,0 +1,65 @@
    69.4 +(ns 
    69.5 +  ^{:author "Vincent Foley",
    69.6 +     :doc "Various functions for finding greatest and least values in a collection"}
    69.7 +  clojure.contrib.greatest-least)
    69.8 +
    69.9 +(defn- boundary
   69.10 +  [cmp-fn f & args]
   69.11 +  (when args
   69.12 +    (reduce (fn [a b] (if (cmp-fn (compare (f b) (f a)))
   69.13 +                        b
   69.14 +                        a)) args)))
   69.15 +
   69.16 +(defn greatest-by
   69.17 +  "Return the argument for which f yields the greatest value."
   69.18 +  [f & args]
   69.19 +  (apply boundary pos? f args))
   69.20 +
   69.21 +(defn greatest
   69.22 +  "Return the greatest argument."
   69.23 +  [& args]
   69.24 +  (apply greatest-by identity args))
   69.25 +
   69.26 +(defn least-by
   69.27 +  "Return the argument for which f yields the smallest value."
   69.28 +  [f & args]
   69.29 +  (apply boundary neg? f args))
   69.30 +
   69.31 +(defn least
   69.32 +  "Return the smallest element."
   69.33 +  [& args]
   69.34 +  (apply least-by identity args))
   69.35 +
   69.36 +
   69.37 +(defn- boundary-all
   69.38 +  [cmp-fn f & args]
   69.39 +  (when args
   69.40 +    (reduce (fn [a b]
   69.41 +              (if (nil? a)
   69.42 +                (cons b nil)
   69.43 +                (let [x (compare (f b) (f (first a)))]
   69.44 +                  (cond (zero? x) (cons b a)
   69.45 +                        (cmp-fn x) (cons b nil)
   69.46 +                        :else a))))
   69.47 +            nil
   69.48 +            args)))
   69.49 +
   69.50 +(defn all-greatest-by
   69.51 +  "Return all the elements for which f yields the greatest value."
   69.52 +  [f & args]
   69.53 +  (apply boundary-all pos? f args))
   69.54 +
   69.55 +(defn all-greatest
   69.56 +  "Returns all the greatest elements."
   69.57 +  [& args]
   69.58 +  (apply all-greatest-by identity args))
   69.59 +
   69.60 +(defn all-least-by
   69.61 +  "Return all the elements for which f yields the least value."
   69.62 +  [f & args]
   69.63 +  (apply boundary-all neg? f args))
   69.64 +
   69.65 +(defn all-least
   69.66 +  "Returns all the least elements."
   69.67 +  [& args]
   69.68 +  (apply all-least-by identity args))
    70.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    70.2 +++ b/src/clojure/contrib/http/agent.clj	Sat Aug 21 06:25:44 2010 -0400
    70.3 @@ -0,0 +1,386 @@
    70.4 +;;; http/agent.clj: agent-based asynchronous HTTP client
    70.5 +
    70.6 +;; by Stuart Sierra, http://stuartsierra.com/
    70.7 +;; August 17, 2009
    70.8 +
    70.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   70.10 +;; and distribution terms for this software are covered by the Eclipse
   70.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   70.12 +;; which can be found in the file epl-v10.html at the root of this
   70.13 +;; distribution.  By using this software in any fashion, you are
   70.14 +;; agreeing to be bound by the terms of this license.  You must not
   70.15 +;; remove this notice, or any other, from this software.
   70.16 +
   70.17 +;; DEPRECATED IN 1.2. Use direct Java bits, or take a look at
   70.18 +;;                    http://github.com/technomancy/clojure-http-client
   70.19 +
   70.20 +(ns ^{:deprecated "1.2"
   70.21 +      :doc "Agent-based asynchronous HTTP client.
   70.22 +
   70.23 +  This is a HTTP client library based on Java's HttpURLConnection
   70.24 +  class and Clojure's Agent system.  It allows you to make multiple
   70.25 +  HTTP requests in parallel.
   70.26 +
   70.27 +  Start an HTTP request with the 'http-agent' function, which
   70.28 +  immediately returns a Clojure Agent.  You will never deref this
   70.29 +  agent; that is handled by the accessor functions.  The agent will
   70.30 +  execute the HTTP request on a separate thread.
   70.31 +
   70.32 +  If you pass a :handler function to http-agent, that function will be
   70.33 +  called as soon as the HTTP response body is ready.  The handler
   70.34 +  function is called with one argument, the HTTP agent itself.  The
   70.35 +  handler can read the response body by calling the 'stream' function
   70.36 +  on the agent.
   70.37 +
   70.38 +  The value returned by the handler function becomes part of the state
   70.39 +  of the agent, and you can retrieve it with the 'result' function.
   70.40 +  If you call 'result' before the HTTP request has finished, it will
   70.41 +  block until the handler function returns.
   70.42 +
   70.43 +  If you don't provide a handler function, the default handler will
   70.44 +  buffer the entire response body in memory, which you can retrieve
   70.45 +  with the 'bytes', 'string', or 'stream' functions.  Like 'result',
   70.46 +  these functions will block until the HTTP request is completed.
   70.47 +
   70.48 +  If you want to check if an HTTP request is finished without
   70.49 +  blocking, use the 'done?' function.
   70.50 +
   70.51 +  A single GET request could be as simple as:
   70.52 +
   70.53 +    (string (http-agent \"http://www.stuartsierra.com/\"))
   70.54 +
   70.55 +  A simple POST might look like:
   70.56 +
   70.57 +    (http-agent \"http...\" :method \"POST\" :body \"foo=1\")
   70.58 +
   70.59 +  And you could write the response directly to a file like this:
   70.60 +
   70.61 +    (require '[clojure.contrib.io :as d])
   70.62 +
   70.63 +    (http-agent \"http...\"
   70.64 +                :handler (fn [agnt] 
   70.65 +                           (with-open [w (d/writer \"/tmp/out\")] 
   70.66 +                             (d/copy (stream agnt) w))))
   70.67 +"
   70.68 +       :author "Stuart Sierra"
   70.69 +       }
   70.70 +
   70.71 +  clojure.contrib.http.agent
   70.72 +  (:refer-clojure :exclude [bytes])
   70.73 +  (:require [clojure.contrib.http.connection :as c]
   70.74 +            [clojure.contrib.io :as duck])
   70.75 +  (:import (java.io InputStream ByteArrayOutputStream
   70.76 +                    ByteArrayInputStream)
   70.77 +           (java.net HttpURLConnection)))
   70.78 +
   70.79 +
   70.80 +;;; PRIVATE
   70.81 +
   70.82 +(declare result stream)
   70.83 +
   70.84 +(defn- setup-http-connection
   70.85 +  "Sets the instance method, redirect behavior, and request headers of
   70.86 +  the HttpURLConnection."
   70.87 +  [^HttpURLConnection conn options]
   70.88 +  (when-let [t (:connect-timeout options)]
   70.89 +    (.setConnectTimeout conn t))
   70.90 +  (when-let [t (:read-timeout options)]
   70.91 +    (.setReadTimeout conn t))
   70.92 +  (.setRequestMethod conn (:method options))
   70.93 +  (.setInstanceFollowRedirects conn (:follow-redirects options))
   70.94 +  (doseq [[name value] (:headers options)]
   70.95 +    (.setRequestProperty conn name value)))
   70.96 +
   70.97 +(defn- start-request
   70.98 +  "Agent action that starts sending the HTTP request."
   70.99 +  [state options]
  70.100 +  (let [conn (::connection state)]
  70.101 +    (setup-http-connection conn options)
  70.102 +    (c/start-http-connection conn (:body options))
  70.103 +    (assoc state ::state ::started)))
  70.104 +
  70.105 +(defn- connection-success? [^HttpURLConnection conn]
  70.106 +  "Returns true if the HttpURLConnection response code is in the 2xx
  70.107 +  range."
  70.108 +  (= 2 (quot (.getResponseCode conn) 100)))
  70.109 +
  70.110 +(defn- open-response
  70.111 +  "Agent action that opens the response body stream on the HTTP
  70.112 +  request; this will block until the response stream is available." ;
  70.113 +  [state options]
  70.114 +  (let [^HttpURLConnection conn (::connection state)]
  70.115 +    (assoc state
  70.116 +      ::response-stream (if (connection-success? conn)
  70.117 +                          (.getInputStream conn)
  70.118 +                          (.getErrorStream conn))
  70.119 +      ::state ::receiving)))
  70.120 +
  70.121 +(defn- handle-response
  70.122 +  "Agent action that calls the provided handler function, with no
  70.123 +  arguments, and sets the ::result key of the agent to the handler's
  70.124 +  return value."
  70.125 +  [state handler options]
  70.126 +  (let [conn (::connection state)]
  70.127 +    (assoc state
  70.128 +      ::result (handler)
  70.129 +      ::state ::finished)))
  70.130 +
  70.131 +(defn- disconnect
  70.132 +  "Agent action that closes the response body stream and disconnects
  70.133 +  the HttpURLConnection."
  70.134 +  [state options]
  70.135 +  (when (::response-stream state)
  70.136 +    (.close ^InputStream (::response-stream state)))
  70.137 +  (.disconnect ^HttpURLConnection (::connection state))
  70.138 +  (assoc state
  70.139 +    ::response-stream nil
  70.140 +    ::state ::disconnected))
  70.141 +
  70.142 +(defn- status-in-range?
  70.143 +  "Returns true if the response status of the HTTP agent begins with
  70.144 +  digit, an Integer."
  70.145 +  [digit http-agnt]
  70.146 +  (= digit (quot (.getResponseCode
  70.147 +                              ^HttpURLConnection (::connection @http-agnt))
  70.148 +                             100)))
  70.149 +
  70.150 +(defn- ^ByteArrayOutputStream get-byte-buffer [http-agnt]
  70.151 +  (let [buffer (result http-agnt)]
  70.152 +    (if (instance? ByteArrayOutputStream buffer)
  70.153 +      buffer
  70.154 +      (throw (Exception. "Handler result was not a ByteArrayOutputStream")))))
  70.155 +
  70.156 +
  70.157 +(defn buffer-bytes
  70.158 +  "The default HTTP agent result handler; it collects the response
  70.159 +  body in a java.io.ByteArrayOutputStream, which can later be
  70.160 +  retrieved with the 'stream', 'string', and 'bytes' functions."
  70.161 +  [http-agnt]
  70.162 +  (let [output (ByteArrayOutputStream.)]
  70.163 +    (duck/copy (or (stream http-agnt) "") output)
  70.164 +    output))
  70.165 +
  70.166 +
  70.167 +;;; CONSTRUCTOR
  70.168 +
  70.169 +(def *http-agent-defaults*
  70.170 +     {:method "GET"
  70.171 +      :headers {}
  70.172 +      :body nil
  70.173 +      :connect-timeout 0
  70.174 +      :read-timeout 0
  70.175 +      :follow-redirects true
  70.176 +      :handler buffer-bytes})
  70.177 +
  70.178 +(defn http-agent
  70.179 +  "Creates (and immediately returns) an Agent representing an HTTP
  70.180 +  request running in a new thread.
  70.181 +
  70.182 +  options are key/value pairs:
  70.183 +
  70.184 +  :method string
  70.185 +
  70.186 +  The HTTP method name.  Default is \"GET\".
  70.187 +
  70.188 +  :headers h
  70.189 +
  70.190 +  HTTP headers, as a Map or a sequence of pairs like 
  70.191 +  ([key1,value1], [key2,value2])  Default is nil.
  70.192 +
  70.193 +  :body b
  70.194 +  
  70.195 +  HTTP request entity body, one of nil, String, byte[], InputStream,
  70.196 +  Reader, or File.  Default is nil.
  70.197 +
  70.198 +  :connect-timeout int
  70.199 +
  70.200 +  Timeout value, in milliseconds, when opening a connection to the
  70.201 +  URL.  Default is zero, meaning no timeout.
  70.202 +
  70.203 +  :read-timeout int
  70.204 +
  70.205 +  Timeout value, in milliseconds, when reading data from the
  70.206 +  connection.  Default is zero, meaning no timeout.
  70.207 +
  70.208 +  :follow-redirects boolean
  70.209 +
  70.210 +  If true, HTTP 3xx redirects will be followed automatically.  Default
  70.211 +  is true.
  70.212 +
  70.213 +  :handler f
  70.214 +
  70.215 +  Function to be called when the HTTP response body is ready.  If you
  70.216 +  do not provide a handler function, the default is to buffer the
  70.217 +  entire response body in memory.
  70.218 +
  70.219 +  The handler function will be called with the HTTP agent as its
  70.220 +  argument, and can use the 'stream' function to read the response
  70.221 +  body.  The return value of this function will be stored in the state
  70.222 +  of the agent and can be retrieved with the 'result' function.  Any
  70.223 +  exceptions thrown by this function will be added to the agent's
  70.224 +  error queue (see agent-errors).  The default function collects the
  70.225 +  response stream in a memory buffer.
  70.226 +  "
  70.227 +  ([uri & options]
  70.228 +     (let [opts (merge *http-agent-defaults* (apply array-map options))]
  70.229 +       (let [a (agent {::connection (c/http-connection uri)
  70.230 +                       ::state ::created
  70.231 +                       ::uri uri
  70.232 +                       ::options opts})]
  70.233 +         (send-off a start-request opts)
  70.234 +         (send-off a open-response opts)
  70.235 +         (send-off a handle-response (partial (:handler opts) a) opts)
  70.236 +         (send-off a disconnect opts)))))
  70.237 +
  70.238 +
  70.239 +;;; RESPONSE BODY ACCESSORS
  70.240 +
  70.241 +(defn result
  70.242 +  "Returns the value returned by the :handler function of the HTTP
  70.243 +  agent; blocks until the HTTP request is completed.  The default
  70.244 +  handler function returns a ByteArrayOutputStream."
  70.245 +  [http-agnt]
  70.246 +  (await http-agnt)
  70.247 +  (::result @http-agnt))
  70.248 +
  70.249 +(defn stream
  70.250 +  "Returns an InputStream of the HTTP response body.  When called by
  70.251 +  the handler function passed to http-agent, this is the raw
  70.252 +  HttpURLConnection stream.
  70.253 +
  70.254 +  If the default handler function was used, this function returns a
  70.255 +  ByteArrayInputStream on the buffered response body."
  70.256 +  [http-agnt]
  70.257 +  (let [a @http-agnt]
  70.258 +    (if (= (::state a) ::receiving)
  70.259 +      (::response-stream a)
  70.260 +      (ByteArrayInputStream.
  70.261 +       (.toByteArray (get-byte-buffer http-agnt))))))
  70.262 +
  70.263 +(defn bytes
  70.264 +  "Returns a Java byte array of the content returned by the server;
  70.265 +  nil if the content is not yet available."
  70.266 +  [http-agnt]
  70.267 +  (.toByteArray (get-byte-buffer http-agnt)))
  70.268 +
  70.269 +(defn string
  70.270 +  "Returns the HTTP response body as a string, using the given
  70.271 +  encoding.
  70.272 +
  70.273 +  If no encoding is given, uses the encoding specified in the server
  70.274 +  headers, or clojure.contrib.io/*default-encoding* if it is
  70.275 +  not specified."
  70.276 +  ([http-agnt]
  70.277 +     (await http-agnt) ;; have to wait for Content-Encoding
  70.278 +     (string http-agnt (or (.getContentEncoding
  70.279 +                            ^HttpURLConnection (::connection @http-agnt))
  70.280 +                           duck/*default-encoding*)))
  70.281 +  ([http-agnt ^String encoding]
  70.282 +     (.toString (get-byte-buffer http-agnt) encoding)))
  70.283 +
  70.284 +
  70.285 +;;; REQUEST ACCESSORS
  70.286 +
  70.287 +(defn request-uri
  70.288 +  "Returns the URI/URL requested by this HTTP agent, as a String."
  70.289 +  [http-agnt]
  70.290 +  (::uri @http-agnt))
  70.291 +
  70.292 +(defn request-headers
  70.293 +  "Returns the request headers specified for this HTTP agent."
  70.294 +  [http-agnt]
  70.295 +  (:headers (::options @http-agnt)))
  70.296 +
  70.297 +(defn method
  70.298 +  "Returns the HTTP method name used by this HTTP agent, as a String."
  70.299 +  [http-agnt]
  70.300 +  (:method (::options @http-agnt)))
  70.301 +
  70.302 +(defn request-body
  70.303 +  "Returns the HTTP request body given to this HTTP agent.  
  70.304 +
  70.305 +  Note: if the request body was an InputStream or a Reader, it will no
  70.306 +  longer be usable."
  70.307 +  [http-agnt]
  70.308 +  (:body (::options @http-agnt)))
  70.309 +
  70.310 +
  70.311 +;;; RESPONSE ACCESSORS
  70.312 +
  70.313 +(defn done?
  70.314 +  "Returns true if the HTTP request/response has completed."
  70.315 +  [http-agnt]
  70.316 +  (if (#{::finished ::disconnected} (::state @http-agnt))
  70.317 +    true false))
  70.318 +
  70.319 +(defn status
  70.320 +  "Returns the HTTP response status code (e.g. 200, 404) for this
  70.321 +  request, as an Integer, or nil if the status has not yet been
  70.322 +  received."
  70.323 +  [http-agnt]
  70.324 +  (when (done? http-agnt)
  70.325 +    (.getResponseCode ^HttpURLConnection (::connection @http-agnt))))
  70.326 +
  70.327 +(defn message
  70.328 +  "Returns the HTTP response message (e.g. 'Not Found'), for this
  70.329 +  request, or nil if the response has not yet been received."
  70.330 +  [http-agnt]
  70.331 +  (when (done? http-agnt)
  70.332 +    (.getResponseMessage ^HttpURLConnection (::connection @http-agnt))))
  70.333 +
  70.334 +(defn headers
  70.335 +  "Returns a map of HTTP response headers.  Header names are converted
  70.336 +  to keywords in all lower-case Header values are strings.  If a
  70.337 +  header appears more than once, only the last value is returned."
  70.338 +  [http-agnt]
  70.339 +  (reduce (fn [m [^String k v]]
  70.340 +            (assoc m (when k (keyword (.toLowerCase k))) (last v)))
  70.341 +          {} (.getHeaderFields
  70.342 +              ^HttpURLConnection (::connection @http-agnt))))
  70.343 +
  70.344 +(defn headers-seq
  70.345 +  "Returns the HTTP response headers in order as a sequence of
  70.346 +  [String,String] pairs.  The first 'header' name may be null for the
  70.347 +  HTTP status line."
  70.348 +  [http-agnt]
  70.349 +  (let [^HttpURLConnection conn (::connection @http-agnt)
  70.350 +        f (fn thisfn [^Integer i]
  70.351 +            ;; Get value first because first key may be nil.
  70.352 +            (when-let [value (.getHeaderField conn i)]
  70.353 +              (cons [(.getHeaderFieldKey conn i) value]
  70.354 +                    (thisfn (inc i)))))]
  70.355 +    (lazy-seq (f 0))))
  70.356 +
  70.357 +
  70.358 +;;; RESPONSE STATUS CODE ACCESSORS
  70.359 +
  70.360 +(defn success?
  70.361 +  "Returns true if the HTTP response code was in the 200-299 range."
  70.362 +  [http-agnt]
  70.363 +  (status-in-range? 2 http-agnt))
  70.364 +
  70.365 +(defn redirect?
  70.366 +  "Returns true if the HTTP response code was in the 300-399 range.
  70.367 +
  70.368 +  Note: if the :follow-redirects option was true (the default),
  70.369 +  redirects will be followed automatically and a the agent will never
  70.370 +  return a 3xx response code."
  70.371 +  [http-agnt]
  70.372 +  (status-in-range? 3 http-agnt))
  70.373 +
  70.374 +(defn client-error?
  70.375 +  "Returns true if the HTTP response code was in the 400-499 range."
  70.376 +  [http-agnt]
  70.377 +  (status-in-range? 4 http-agnt))
  70.378 +
  70.379 +(defn server-error?
  70.380 +  "Returns true if the HTTP response code was in the 500-599 range."
  70.381 +  [http-agnt]
  70.382 +  (status-in-range? 5 http-agnt))
  70.383 +
  70.384 +(defn error?
  70.385 +  "Returns true if the HTTP response code was in the 400-499 range OR
  70.386 +  the 500-599 range."
  70.387 +  [http-agnt]
  70.388 +  (or (client-error? http-agnt)
  70.389 +      (server-error? http-agnt)))
    71.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    71.2 +++ b/src/clojure/contrib/http/connection.clj	Sat Aug 21 06:25:44 2010 -0400
    71.3 @@ -0,0 +1,62 @@
    71.4 +;;; http/connection.clj: low-level HTTP client API around HttpURLConnection
    71.5 +
    71.6 +;; by Stuart Sierra, http://stuartsierra.com/
    71.7 +;; June 8, 2009
    71.8 +
    71.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   71.10 +;; and distribution terms for this software are covered by the Eclipse
   71.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   71.12 +;; which can be found in the file epl-v10.html at the root of this
   71.13 +;; distribution.  By using this software in any fashion, you are
   71.14 +;; agreeing to be bound by the terms of this license.  You must not
   71.15 +;; remove this notice, or any other, from this software.
   71.16 +
   71.17 +;; DEPRECATED IN 1.2. Use direct Java bits, or take a look at
   71.18 +;;                    http://github.com/technomancy/clojure-http-client
   71.19 +
   71.20 +(ns ^{:deprecated "1.2"
   71.21 +      :doc "Low-level HTTP client API around HttpURLConnection"}
   71.22 +  clojure.contrib.http.connection
   71.23 +  (:require [clojure.contrib.io :as duck])
   71.24 +  (:import (java.net URI URL HttpURLConnection)
   71.25 +           (java.io File InputStream Reader)))
   71.26 +
   71.27 +(defn http-connection
   71.28 +  "Opens an HttpURLConnection at the URL, handled by as-url."
   71.29 +  [url]
   71.30 +  (.openConnection (duck/as-url url)))
   71.31 +
   71.32 +(defmulti
   71.33 +  ^{:doc "Transmits a request entity body."}
   71.34 +  send-request-entity (fn [conn entity] (type entity)))
   71.35 +
   71.36 +(defmethod send-request-entity duck/*byte-array-type* [^HttpURLConnection conn entity]
   71.37 +  (.setFixedLengthStreamingMode conn (count entity))
   71.38 +  (.connect conn)
   71.39 +  (duck/copy entity (.getOutputStream conn)))
   71.40 +
   71.41 +(defmethod send-request-entity String [conn ^String entity]
   71.42 +  (send-request-entity conn (.getBytes entity duck/*default-encoding*)))
   71.43 +
   71.44 +(defmethod send-request-entity File [^HttpURLConnection conn ^File entity]
   71.45 +  (.setFixedLengthStreamingMode conn (.length entity))
   71.46 +  (.connect conn)
   71.47 +  (duck/copy entity (.getOutputStream conn)))
   71.48 +
   71.49 +(defmethod send-request-entity InputStream [^HttpURLConnection conn entity]
   71.50 +  (.setChunkedStreamingMode conn -1)
   71.51 +  (.connect conn)
   71.52 +  (duck/copy entity (.getOutputStream conn)))
   71.53 +
   71.54 +(defmethod send-request-entity Reader [^HttpURLConnection conn entity]
   71.55 +  (.setChunkedStreamingMode conn -1)
   71.56 +  (.connect conn)
   71.57 +  (duck/copy entity (.getOutputStream conn)))
   71.58 +
   71.59 +(defn start-http-connection
   71.60 +  ([^HttpURLConnection conn] (.connect conn))
   71.61 +  ([^HttpURLConnection conn request-entity-body]
   71.62 +     (if request-entity-body
   71.63 +       (do (.setDoOutput conn true)
   71.64 +           (send-request-entity conn request-entity-body))
   71.65 +       (.connect conn))))
    72.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    72.2 +++ b/src/clojure/contrib/import_static.clj	Sat Aug 21 06:25:44 2010 -0400
    72.3 @@ -0,0 +1,63 @@
    72.4 +;;; import_static.clj -- import static Java methods/fields into Clojure
    72.5 +
    72.6 +;; by Stuart Sierra, http://stuartsierra.com/
    72.7 +;; June 1, 2008
    72.8 +
    72.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
   72.10 +;; and distribution terms for this software are covered by the Eclipse
   72.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   72.12 +;; which can be found in the file epl-v10.html at the root of this
   72.13 +;; distribution.  By using this software in any fashion, you are
   72.14 +;; agreeing to be bound by the terms of this license.  You must not
   72.15 +;; remove this notice, or any other, from this software.
   72.16 +
   72.17 +
   72.18 +
   72.19 +(ns 
   72.20 +  ^{:author "Stuart Sierra",
   72.21 +     :doc "Import static Java methods/fields into Clojure"}
   72.22 +  clojure.contrib.import-static
   72.23 +            (:use clojure.set))
   72.24 +
   72.25 +(defmacro import-static
   72.26 +  "Imports the named static fields and/or static methods of the class
   72.27 +  as (private) symbols in the current namespace.
   72.28 +
   72.29 +  Example: 
   72.30 +      user=> (import-static java.lang.Math PI sqrt)
   72.31 +      nil
   72.32 +      user=> PI
   72.33 +      3.141592653589793
   72.34 +      user=> (sqrt 16)
   72.35 +      4.0
   72.36 +
   72.37 +  Note: The class name must be fully qualified, even if it has already
   72.38 +  been imported.  Static methods are defined as MACROS, not
   72.39 +  first-class fns."
   72.40 +  [class & fields-and-methods]
   72.41 +  (let [only (set (map str fields-and-methods))
   72.42 +        the-class (. Class forName (str class))
   72.43 +        static? (fn [x]
   72.44 +                    (. java.lang.reflect.Modifier
   72.45 +                       (isStatic (. x (getModifiers)))))
   72.46 +        statics (fn [array]
   72.47 +                    (set (map (memfn getName)
   72.48 +                              (filter static? array))))
   72.49 +        all-fields (statics (. the-class (getFields)))
   72.50 +        all-methods (statics (. the-class (getMethods)))
   72.51 +        fields-to-do (intersection all-fields only)
   72.52 +        methods-to-do (intersection all-methods only)
   72.53 +        make-sym (fn [string]
   72.54 +                     (with-meta (symbol string) {:private true}))
   72.55 +        import-field (fn [name]
   72.56 +                         (list 'def (make-sym name)
   72.57 +                               (list '. class (symbol name))))
   72.58 +        import-method (fn [name]
   72.59 +                          (list 'defmacro (make-sym name)
   72.60 +                                '[& args]
   72.61 +                                (list 'list ''. (list 'quote class)
   72.62 +                                      (list 'apply 'list
   72.63 +                                            (list 'quote (symbol name))
   72.64 +                                            'args))))]
   72.65 +    `(do ~@(map import-field fields-to-do)
   72.66 +         ~@(map import-method methods-to-do))))
    73.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    73.2 +++ b/src/clojure/contrib/io.clj	Sat Aug 21 06:25:44 2010 -0400
    73.3 @@ -0,0 +1,564 @@
    73.4 +;;; io.clj -- duck-typed I/O streams for Clojure
    73.5 +
    73.6 +;; by Stuart Sierra, http://stuartsierra.com/
    73.7 +;; May 13, 2009
    73.8 +
    73.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   73.10 +;; and distribution terms for this software are covered by the Eclipse
   73.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   73.12 +;; which can be found in the file epl-v10.html at the root of this
   73.13 +;; distribution.  By using this software in any fashion, you are
   73.14 +;; agreeing to be bound by the terms of this license.  You must not
   73.15 +;; remove this notice, or any other, from this software.
   73.16 +
   73.17 +
   73.18 +;; This file defines "duck-typed" I/O utility functions for Clojure.
   73.19 +;; The 'reader' and 'writer' functions will open and return an
   73.20 +;; instance of java.io.BufferedReader and java.io.BufferedWriter,
   73.21 +;; respectively, for a variety of argument types -- filenames as
   73.22 +;; strings, URLs, java.io.File's, etc.  'reader' even works on http
   73.23 +;; URLs.
   73.24 +;;
   73.25 +;; Note: this is not really "duck typing" as implemented in languages
   73.26 +;; like Ruby.  A better name would have been "do-what-I-mean-streams"
   73.27 +;; or "just-give-me-a-stream", but ducks are funnier.
   73.28 +
   73.29 +
   73.30 +;; CHANGE LOG
   73.31 +;;
   73.32 +;; July 23, 2010: Most functions here are deprecated. Use
   73.33 +;; clojure.java.io
   73.34 +;;
   73.35 +;; May 13, 2009: added functions to open writers for appending
   73.36 +;;
   73.37 +;; May 3, 2009: renamed file to file-str, for compatibility with
   73.38 +;; clojure.contrib.java.  reader/writer no longer use this
   73.39 +;; function.
   73.40 +;;
   73.41 +;; February 16, 2009: (lazy branch) fixed read-lines to work with lazy
   73.42 +;; Clojure.
   73.43 +;;
   73.44 +;; January 10, 2009: added *default-encoding*, so streams are always
   73.45 +;; opened as UTF-8.
   73.46 +;;
   73.47 +;; December 19, 2008: rewrote reader and writer as multimethods; added
   73.48 +;; slurp*, file, and read-lines
   73.49 +;;
   73.50 +;; April 8, 2008: first version
   73.51 +
   73.52 +
   73.53 +
   73.54 +(ns 
   73.55 +  ^{:author "Stuart Sierra",
   73.56 +     :doc "This file defines polymorphic I/O utility functions for Clojure.
   73.57 +
   73.58 +           The Streams protocol defines reader, writer, input-stream and
   73.59 +           output-stream methods that return BufferedReader, BufferedWriter,
   73.60 +           BufferedInputStream and BufferedOutputStream instances (respectively),
   73.61 +           with default implementations extended to a variety of argument
   73.62 +           types: URLs or filenames as strings, java.io.File's, Sockets, etc."}
   73.63 +  clojure.contrib.io
   73.64 +  (:refer-clojure :exclude (spit))
   73.65 +  (:import 
   73.66 +   (java.io Reader InputStream InputStreamReader PushbackReader
   73.67 +            BufferedReader File OutputStream
   73.68 +            OutputStreamWriter BufferedWriter Writer
   73.69 +            FileInputStream FileOutputStream ByteArrayOutputStream
   73.70 +            StringReader ByteArrayInputStream
   73.71 +            BufferedInputStream BufferedOutputStream
   73.72 +            CharArrayReader)
   73.73 +   (java.net URI URL MalformedURLException Socket)))
   73.74 +
   73.75 +
   73.76 +(def
   73.77 + ^{:doc "Name of the default encoding to use when reading & writing.
   73.78 +  Default is UTF-8."
   73.79 +    :tag "java.lang.String"}
   73.80 + *default-encoding* "UTF-8")
   73.81 +
   73.82 +(def
   73.83 + ^{:doc "Size, in bytes or characters, of the buffer used when
   73.84 +  copying streams."}
   73.85 + *buffer-size* 1024)
   73.86 +
   73.87 +(def
   73.88 + ^{:doc "Type object for a Java primitive byte array."}
   73.89 + *byte-array-type* (class (make-array Byte/TYPE 0)))
   73.90 +
   73.91 +(def
   73.92 + ^{:doc "Type object for a Java primitive char array."}
   73.93 + *char-array-type* (class (make-array Character/TYPE 0)))
   73.94 +
   73.95 +
   73.96 +(defn ^File file-str
   73.97 +  "Concatenates args as strings and returns a java.io.File.  Replaces
   73.98 +  all / and \\ with File/separatorChar.  Replaces ~ at the start of
   73.99 +  the path with the user.home system property."
  73.100 +  [& args]
  73.101 +  (let [^String s (apply str args)
  73.102 +        s (.replace s \\ File/separatorChar)
  73.103 +        s (.replace s \/ File/separatorChar)
  73.104 +        s (if (.startsWith s "~")
  73.105 +            (str (System/getProperty "user.home")
  73.106 +                 File/separator (subs s 1))
  73.107 +            s)]
  73.108 +    (File. s)))
  73.109 +
  73.110 +(def
  73.111 + ^{:doc "If true, writer, output-stream and spit will open files in append mode.
  73.112 +          Defaults to false.  Instead of binding this var directly, use append-writer,
  73.113 +          append-output-stream or append-spit."
  73.114 +    :tag "java.lang.Boolean"}
  73.115 + *append* false)
  73.116 +
  73.117 +(defn- assert-not-appending []
  73.118 +  (when *append*
  73.119 +    (throw (Exception. "Cannot change an open stream to append mode."))))
  73.120 +
  73.121 +;; @todo -- Both simple and elaborate methods for controlling buffering of
  73.122 +;; in the Streams protocol were implemented, considered, and postponed
  73.123 +;; see http://groups.google.com/group/clojure-dev/browse_frm/thread/3e39e9b3982f542b
  73.124 +(defprotocol Streams
  73.125 +  (reader [x]
  73.126 +    "Attempts to coerce its argument into an open java.io.Reader.
  73.127 +     The default implementations of this protocol always return a
  73.128 +     java.io.BufferedReader.
  73.129 +
  73.130 +     Default implementations are provided for Reader, BufferedReader,
  73.131 +     InputStream, File, URI, URL, Socket, byte arrays, character arrays,
  73.132 +     and String.
  73.133 +
  73.134 +     If argument is a String, it tries to resolve it first as a URI, then
  73.135 +     as a local file name.  URIs with a 'file' protocol are converted to
  73.136 +     local file names.  If this fails, a final attempt is made to resolve
  73.137 +     the string as a resource on the CLASSPATH.
  73.138 +
  73.139 +     Uses *default-encoding* as the text encoding.
  73.140 +
  73.141 +     Should be used inside with-open to ensure the Reader is properly
  73.142 +     closed.")
  73.143 +  (writer [x]
  73.144 +    "Attempts to coerce its argument into an open java.io.Writer.
  73.145 +     The default implementations of this protocol always return a
  73.146 +     java.io.BufferedWriter.
  73.147 +
  73.148 +     Default implementations are provided for Writer, BufferedWriter,
  73.149 +     OutputStream, File, URI, URL, Socket, and String.
  73.150 +
  73.151 +     If the argument is a String, it tries to resolve it first as a URI, then
  73.152 +     as a local file name.  URIs with a 'file' protocol are converted to
  73.153 +     local file names.
  73.154 +
  73.155 +     Should be used inside with-open to ensure the Writer is properly
  73.156 +     closed.")
  73.157 +  (input-stream [x]
  73.158 +    "Attempts to coerce its argument into an open java.io.InputStream.
  73.159 +     The default implementations of this protocol always return a
  73.160 +     java.io.BufferedInputStream.
  73.161 +
  73.162 +     Default implementations are defined for OutputStream, File, URI, URL,
  73.163 +     Socket, byte array, and String arguments.
  73.164 +
  73.165 +     If the argument is a String, it tries to resolve it first as a URI, then
  73.166 +     as a local file name.  URIs with a 'file' protocol are converted to
  73.167 +     local file names.
  73.168 +
  73.169 +     Should be used inside with-open to ensure the InputStream is properly
  73.170 +     closed.")
  73.171 +  (output-stream [x]
  73.172 +    "Attempts to coerce its argument into an open java.io.OutputStream.
  73.173 +     The default implementations of this protocol always return a
  73.174 +     java.io.BufferedOutputStream.
  73.175 +
  73.176 +     Default implementations are defined for OutputStream, File, URI, URL,
  73.177 +     Socket, and String arguments.
  73.178 +
  73.179 +     If the argument is a String, it tries to resolve it first as a URI, then
  73.180 +     as a local file name.  URIs with a 'file' protocol are converted to
  73.181 +     local file names.
  73.182 +
  73.183 +     Should be used inside with-open to ensure the OutputStream is
  73.184 +     properly closed."))
  73.185 +
  73.186 +(def default-streams-impl
  73.187 +  {:reader #(reader (input-stream %))
  73.188 +   :writer #(writer (output-stream %))
  73.189 +   :input-stream #(throw (Exception. (str "Cannot open <" (pr-str %) "> as an InputStream.")))
  73.190 +   :output-stream #(throw (Exception. (str "Cannot open <" (pr-str %) "> as an OutputStream.")))})
  73.191 +
  73.192 +(extend File
  73.193 +  Streams
  73.194 +  (assoc default-streams-impl
  73.195 +    :input-stream #(input-stream (FileInputStream. ^File %))
  73.196 +    :output-stream #(let [stream (FileOutputStream. ^File % *append*)]
  73.197 +                      (binding [*append* false]
  73.198 +                        (output-stream stream)))))
  73.199 +(extend URL
  73.200 +  Streams
  73.201 +  (assoc default-streams-impl
  73.202 +    :input-stream (fn [^URL x]
  73.203 +                    (input-stream (if (= "file" (.getProtocol x))
  73.204 +                                    (FileInputStream. (.getPath x))
  73.205 +                                    (.openStream x))))
  73.206 +    :output-stream (fn [^URL x]
  73.207 +                     (if (= "file" (.getProtocol x))
  73.208 +                       (output-stream (File. (.getPath x)))
  73.209 +                       (throw (Exception. (str "Can not write to non-file URL <" x ">")))))))
  73.210 +(extend URI
  73.211 +  Streams
  73.212 +  (assoc default-streams-impl
  73.213 +    :input-stream #(input-stream (.toURL ^URI %))
  73.214 +    :output-stream #(output-stream (.toURL ^URI %))))
  73.215 +(extend String
  73.216 +  Streams
  73.217 +  (assoc default-streams-impl
  73.218 +    :input-stream #(try
  73.219 +                     (input-stream (URL. %))
  73.220 +                     (catch MalformedURLException e
  73.221 +                       (input-stream (File. ^String %))))
  73.222 +    :output-stream #(try
  73.223 +                      (output-stream (URL. %))
  73.224 +                      (catch MalformedURLException err
  73.225 +                        (output-stream (File. ^String %))))))
  73.226 +(extend Socket
  73.227 +  Streams
  73.228 +  (assoc default-streams-impl
  73.229 +    :input-stream #(.getInputStream ^Socket %)
  73.230 +    :output-stream #(output-stream (.getOutputStream ^Socket %))))
  73.231 +(extend *byte-array-type*
  73.232 +  Streams
  73.233 +  (assoc default-streams-impl :input-stream #(input-stream (ByteArrayInputStream. %))))
  73.234 +(extend *char-array-type*
  73.235 +  Streams
  73.236 +  (assoc default-streams-impl :reader #(reader (CharArrayReader. %))))
  73.237 +(extend Object
  73.238 +  Streams
  73.239 +  default-streams-impl)
  73.240 +
  73.241 +(extend Reader
  73.242 +  Streams
  73.243 +  (assoc default-streams-impl :reader #(BufferedReader. %)))
  73.244 +(extend BufferedReader
  73.245 +  Streams
  73.246 +  (assoc default-streams-impl :reader identity))
  73.247 +(defn- inputstream->reader
  73.248 +  [^InputStream is]
  73.249 +  (reader (InputStreamReader. is *default-encoding*)))
  73.250 +(extend InputStream
  73.251 +  Streams
  73.252 +  (assoc default-streams-impl :input-stream #(BufferedInputStream. %)
  73.253 +    :reader inputstream->reader))
  73.254 +(extend BufferedInputStream
  73.255 +  Streams
  73.256 +  (assoc default-streams-impl
  73.257 +    :input-stream identity
  73.258 +    :reader inputstream->reader))
  73.259 +
  73.260 +(extend Writer
  73.261 +  Streams
  73.262 +  (assoc default-streams-impl :writer #(do (assert-not-appending)
  73.263 +                                           (BufferedWriter. %))))
  73.264 +(extend BufferedWriter
  73.265 +  Streams
  73.266 +  (assoc default-streams-impl :writer #(do (assert-not-appending) %)))
  73.267 +(defn- outputstream->writer
  73.268 +  [^OutputStream os]
  73.269 +  (assert-not-appending)
  73.270 +  (writer (OutputStreamWriter. os *default-encoding*)))
  73.271 +(extend OutputStream
  73.272 +  Streams
  73.273 +  (assoc default-streams-impl
  73.274 +    :output-stream #(do (assert-not-appending)
  73.275 +                        (BufferedOutputStream. %))
  73.276 +    :writer outputstream->writer))
  73.277 +(extend BufferedOutputStream
  73.278 +  Streams
  73.279 +  (assoc default-streams-impl
  73.280 +    :output-stream #(do (assert-not-appending) %)
  73.281 +      :writer outputstream->writer))
  73.282 +
  73.283 +(defn append-output-stream
  73.284 +  "Like output-stream but opens file for appending.  Does not work on streams
  73.285 +  that are already open."
  73.286 +  {:deprecated "1.2"}
  73.287 +  [x]
  73.288 +  (binding [*append* true]
  73.289 +    (output-stream x)))
  73.290 +
  73.291 +(defn append-writer
  73.292 +  "Like writer but opens file for appending.  Does not work on streams
  73.293 +  that are already open."
  73.294 +  {:deprecated "1.2"}
  73.295 +  [x]
  73.296 +  (binding [*append* true]
  73.297 +    (writer x)))
  73.298 +
  73.299 +(defn write-lines
  73.300 +  "Writes lines (a seq) to f, separated by newlines.  f is opened with
  73.301 +  writer, and automatically closed at the end of the sequence."
  73.302 +  [f lines]
  73.303 +  (with-open [^BufferedWriter writer (writer f)]
  73.304 +    (loop [lines lines]
  73.305 +      (when-let [line (first lines)]
  73.306 +        (.write writer (str line))
  73.307 +        (.newLine writer)
  73.308 +        (recur (rest lines))))))
  73.309 +
  73.310 +(defn read-lines
  73.311 +  "Like clojure.core/line-seq but opens f with reader.  Automatically
  73.312 +  closes the reader AFTER YOU CONSUME THE ENTIRE SEQUENCE."
  73.313 +  [f]
  73.314 +  (let [read-line (fn this [^BufferedReader rdr]
  73.315 +                    (lazy-seq
  73.316 +                     (if-let [line (.readLine rdr)]
  73.317 +                       (cons line (this rdr))
  73.318 +                       (.close rdr))))]
  73.319 +    (read-line (reader f))))
  73.320 +
  73.321 +(defn ^String slurp*
  73.322 +  "Like clojure.core/slurp but opens f with reader."
  73.323 +  {:deprecated "1.2"}
  73.324 +  [f]
  73.325 +  (with-open [^BufferedReader r (reader f)]
  73.326 +      (let [sb (StringBuilder.)]
  73.327 +        (loop [c (.read r)]
  73.328 +          (if (neg? c)
  73.329 +            (str sb)
  73.330 +            (do (.append sb (char c))
  73.331 +                (recur (.read r))))))))
  73.332 +
  73.333 +(defn spit
  73.334 +  "Opposite of slurp.  Opens f with writer, writes content, then
  73.335 +  closes f."
  73.336 +  {:deprecated "1.2"}
  73.337 +  [f content]
  73.338 +  (with-open [^Writer w (writer f)]
  73.339 +    (.write w content)))
  73.340 +
  73.341 +(defn append-spit
  73.342 +  "Like spit but appends to file."
  73.343 +  {:deprecated "1.2"}
  73.344 +  [f content]
  73.345 +  (with-open [^Writer w (append-writer f)]
  73.346 +    (.write w content)))
  73.347 +
  73.348 +(defn pwd
  73.349 +  "Returns current working directory as a String.  (Like UNIX 'pwd'.)
  73.350 +  Note: In Java, you cannot change the current working directory."
  73.351 +  {:deprecated "1.2"}
  73.352 +  []
  73.353 +  (System/getProperty "user.dir"))
  73.354 +
  73.355 +(defmacro with-out-writer
  73.356 +  "Opens a writer on f, binds it to *out*, and evalutes body.
  73.357 +  Anything printed within body will be written to f."
  73.358 +  [f & body]
  73.359 +  `(with-open [stream# (writer ~f)]
  73.360 +     (binding [*out* stream#]
  73.361 +       ~@body)))
  73.362 +
  73.363 +(defmacro with-out-append-writer
  73.364 +  "Like with-out-writer but appends to file."
  73.365 +  {:deprecated "1.2"}
  73.366 +  [f & body]
  73.367 +  `(with-open [stream# (append-writer ~f)]
  73.368 +     (binding [*out* stream#]
  73.369 +       ~@body)))
  73.370 +
  73.371 +(defmacro with-in-reader
  73.372 +  "Opens a PushbackReader on f, binds it to *in*, and evaluates body."
  73.373 +  [f & body]
  73.374 +  `(with-open [stream# (PushbackReader. (reader ~f))]
  73.375 +     (binding [*in* stream#]
  73.376 +       ~@body)))
  73.377 +
  73.378 +(defmulti
  73.379 +  ^{:deprecated "1.2"
  73.380 +    :doc "Copies input to output.  Returns nil.
  73.381 +  Input may be an InputStream, Reader, File, byte[], or String.
  73.382 +  Output may be an OutputStream, Writer, or File.
  73.383 +
  73.384 +  Does not close any streams except those it opens itself 
  73.385 +  (on a File).
  73.386 +
  73.387 +  Writing a File fails if the parent directory does not exist."
  73.388 +     :arglists '([input output])}
  73.389 +  copy
  73.390 +  (fn [input output] [(type input) (type output)]))
  73.391 +
  73.392 +(defmethod copy [InputStream OutputStream] [^InputStream input ^OutputStream output]
  73.393 +  (let [buffer (make-array Byte/TYPE *buffer-size*)]
  73.394 +    (loop []
  73.395 +      (let [size (.read input buffer)]
  73.396 +        (when (pos? size)
  73.397 +          (do (.write output buffer 0 size)
  73.398 +              (recur)))))))
  73.399 +
  73.400 +(defmethod copy [InputStream Writer] [^InputStream input ^Writer output]
  73.401 +  (let [^"[B" buffer (make-array Byte/TYPE *buffer-size*)]
  73.402 +    (loop []
  73.403 +      (let [size (.read input buffer)]
  73.404 +        (when (pos? size)
  73.405 +          (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))]
  73.406 +            (do (.write output chars)
  73.407 +                (recur))))))))
  73.408 +
  73.409 +(defmethod copy [InputStream File] [^InputStream input ^File output]
  73.410 +  (with-open [out (FileOutputStream. output)]
  73.411 +    (copy input out)))
  73.412 +
  73.413 +(defmethod copy [Reader OutputStream] [^Reader input ^OutputStream output]
  73.414 +  (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)]
  73.415 +    (loop []
  73.416 +      (let [size (.read input buffer)]
  73.417 +        (when (pos? size)
  73.418 +          (let [bytes (.getBytes (String. buffer 0 size) *default-encoding*)]
  73.419 +            (do (.write output bytes)
  73.420 +                (recur))))))))
  73.421 +
  73.422 +(defmethod copy [Reader Writer] [^Reader input ^Writer output]
  73.423 +  (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)]
  73.424 +    (loop []
  73.425 +      (let [size (.read input buffer)]
  73.426 +        (when (pos? size)
  73.427 +          (do (.write output buffer 0 size)
  73.428 +              (recur)))))))
  73.429 +
  73.430 +(defmethod copy [Reader File] [^Reader input ^File output]
  73.431 +  (with-open [out (FileOutputStream. output)]
  73.432 +    (copy input out)))
  73.433 +
  73.434 +(defmethod copy [File OutputStream] [^File input ^OutputStream output]
  73.435 +  (with-open [in (FileInputStream. input)]
  73.436 +    (copy in output)))
  73.437 +
  73.438 +(defmethod copy [File Writer] [^File input ^Writer output]
  73.439 +  (with-open [in (FileInputStream. input)]
  73.440 +    (copy in output)))
  73.441 +
  73.442 +(defmethod copy [File File] [^File input ^File output]
  73.443 +  (with-open [in (FileInputStream. input)
  73.444 +              out (FileOutputStream. output)]
  73.445 +    (copy in out)))
  73.446 +
  73.447 +(defmethod copy [String OutputStream] [^String input ^OutputStream output]
  73.448 +  (copy (StringReader. input) output))
  73.449 +
  73.450 +(defmethod copy [String Writer] [^String input ^Writer output]
  73.451 +  (copy (StringReader. input) output))
  73.452 +
  73.453 +(defmethod copy [String File] [^String input ^File output]
  73.454 +  (copy (StringReader. input) output))
  73.455 +
  73.456 +(defmethod copy [*char-array-type* OutputStream] [input ^OutputStream output]
  73.457 +  (copy (CharArrayReader. input) output))
  73.458 +
  73.459 +(defmethod copy [*char-array-type* Writer] [input ^Writer output]
  73.460 +  (copy (CharArrayReader. input) output))
  73.461 +
  73.462 +(defmethod copy [*char-array-type* File] [input ^File output]
  73.463 +  (copy (CharArrayReader. input) output))
  73.464 +
  73.465 +(defmethod copy [*byte-array-type* OutputStream] [^"[B" input ^OutputStream output]
  73.466 +  (copy (ByteArrayInputStream. input) output))
  73.467 +
  73.468 +(defmethod copy [*byte-array-type* Writer] [^"[B" input ^Writer output]
  73.469 +  (copy (ByteArrayInputStream. input) output))
  73.470 +
  73.471 +(defmethod copy [*byte-array-type* File] [^"[B" input ^Writer output]
  73.472 +  (copy (ByteArrayInputStream. input) output))
  73.473 +
  73.474 +(defn make-parents
  73.475 +  "Creates all parent directories of file."
  73.476 +  [^File file]
  73.477 +  (.mkdirs (.getParentFile file)))
  73.478 +
  73.479 +(defmulti
  73.480 +  ^{:doc "Converts argument into a Java byte array.  Argument may be
  73.481 +  a String, File, InputStream, or Reader.  If the argument is already
  73.482 +  a byte array, returns it."
  73.483 +    :arglists '([arg])}
  73.484 +  to-byte-array type)
  73.485 +
  73.486 +(defmethod to-byte-array *byte-array-type* [x] x)
  73.487 +
  73.488 +(defmethod to-byte-array String [^String x]
  73.489 +  (.getBytes x *default-encoding*))
  73.490 +
  73.491 +(defmethod to-byte-array File [^File x]
  73.492 +  (with-open [input (FileInputStream. x)
  73.493 +              buffer (ByteArrayOutputStream.)]
  73.494 +    (copy input buffer)
  73.495 +    (.toByteArray buffer)))
  73.496 +
  73.497 +(defmethod to-byte-array InputStream [^InputStream x]
  73.498 +  (let [buffer (ByteArrayOutputStream.)]
  73.499 +    (copy x buffer)
  73.500 +    (.toByteArray buffer)))
  73.501 +
  73.502 +(defmethod to-byte-array Reader [^Reader x]
  73.503 +  (.getBytes (slurp* x) *default-encoding*))
  73.504 +
  73.505 +(defmulti relative-path-string 
  73.506 +  "Interpret a String or java.io.File as a relative path string. 
  73.507 +   Building block for clojure.contrib.java/file."
  73.508 +  {:deprecated "1.2"}
  73.509 +  class)
  73.510 +
  73.511 +(defmethod relative-path-string String [^String s]
  73.512 +  (relative-path-string (File. s)))
  73.513 +
  73.514 +(defmethod relative-path-string File [^File f]
  73.515 +  (if (.isAbsolute f)
  73.516 +    (throw (IllegalArgumentException. (str f " is not a relative path")))
  73.517 +    (.getPath f)))
  73.518 +
  73.519 +(defmulti ^File as-file 
  73.520 +  "Interpret a String or a java.io.File as a File. Building block
  73.521 +   for clojure.contrib.java/file, which you should prefer
  73.522 +   in most cases."
  73.523 +  {:deprecated "1.2"}
  73.524 +  class)
  73.525 +(defmethod as-file String [^String s] (File. s))
  73.526 +(defmethod as-file File [f] f)
  73.527 +
  73.528 +(defn ^File file
  73.529 +  "Returns a java.io.File from string or file args."
  73.530 +  {:deprecated "1.2"}
  73.531 +  ([arg]                      
  73.532 +     (as-file arg))
  73.533 +  ([parent child]             
  73.534 +     (File. ^File (as-file parent) ^String (relative-path-string child)))
  73.535 +  ([parent child & more]
  73.536 +     (reduce file (file parent child) more)))
  73.537 +
  73.538 +(defn delete-file
  73.539 +  "Delete file f. Raise an exception if it fails unless silently is true."
  73.540 +  [f & [silently]]
  73.541 +  (or (.delete (file f))
  73.542 +      silently
  73.543 +      (throw (java.io.IOException. (str "Couldn't delete " f)))))
  73.544 +
  73.545 +(defn delete-file-recursively
  73.546 +  "Delete file f. If it's a directory, recursively delete all its contents.
  73.547 +Raise an exception if any deletion fails unless silently is true."
  73.548 +  [f & [silently]]
  73.549 +  (let [f (file f)]
  73.550 +    (if (.isDirectory f)
  73.551 +      (doseq [child (.listFiles f)]
  73.552 +        (delete-file-recursively child silently)))
  73.553 +    (delete-file f silently)))
  73.554 +
  73.555 +(defmulti
  73.556 +  ^{:deprecated "1.2"
  73.557 +    :doc "Coerces argument (URL, URI, or String) to a java.net.URL."
  73.558 +    :arglists '([arg])}
  73.559 +  as-url type)
  73.560 +
  73.561 +(defmethod as-url URL [x] x)
  73.562 +
  73.563 +(defmethod as-url URI [^URI x] (.toURL x))
  73.564 +
  73.565 +(defmethod as-url String [^String x] (URL. x))
  73.566 +
  73.567 +(defmethod as-url File [^File x] (.toURL x))
    74.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    74.2 +++ b/src/clojure/contrib/jar.clj	Sat Aug 21 06:25:44 2010 -0400
    74.3 @@ -0,0 +1,35 @@
    74.4 +;;; jar.clj: utilities for working with Java JAR files
    74.5 +
    74.6 +;; by Stuart Sierra, http://stuartsierra.com/
    74.7 +;; April 19, 2009
    74.8 +
    74.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
   74.10 +;; and distribution terms for this software are covered by the Eclipse
   74.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   74.12 +;; which can be found in the file epl-v10.html at the root of this
   74.13 +;; distribution.  By using this software in any fashion, you are
   74.14 +;; agreeing to be bound by the terms of this license.  You must not
   74.15 +;; remove this notice, or any other, from this software.
   74.16 +
   74.17 +
   74.18 +(ns 
   74.19 +  ^{:author "Stuart Sierra",
   74.20 +     :doc "Utilities for working with Java JAR files"}
   74.21 +  clojure.contrib.jar
   74.22 +  (:import (java.io File)
   74.23 +           (java.util.jar JarFile)))
   74.24 +
   74.25 +(defn jar-file?
   74.26 +  "Returns true if file is a normal file with a .jar or .JAR extension."
   74.27 +  [^File file]
   74.28 +  (and (.isFile file)
   74.29 +       (or (.endsWith (.getName file) ".jar")
   74.30 +           (.endsWith (.getName file) ".JAR"))))
   74.31 +
   74.32 +(defn filenames-in-jar
   74.33 +  "Returns a sequence of Strings naming the non-directory entries in
   74.34 +  the JAR file."
   74.35 +  [^JarFile jar-file]
   74.36 +  (map #(.getName %)
   74.37 +       (filter #(not (.isDirectory %))
   74.38 +               (enumeration-seq (.entries jar-file)))))
    75.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    75.2 +++ b/src/clojure/contrib/java_utils.clj	Sat Aug 21 06:25:44 2010 -0400
    75.3 @@ -0,0 +1,219 @@
    75.4 +;   Copyright (c) Stuart Halloway & Contributors, April 2009. All rights reserved.
    75.5 +;   The use and distribution terms for this software are covered by the
    75.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    75.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
    75.8 +;   By using this software in any fashion, you are agreeing to be bound by
    75.9 +;   the terms of this license.
   75.10 +;   You must not remove this notice, or any other, from this software.
   75.11 +
   75.12 +;;
   75.13 +;; CHANGELOG
   75.14 +;;
   75.15 +;; Most functions deprecated in 1.2. Some already exist in c.c.io, and
   75.16 +;; some replaced by c.c.reflections
   75.17 +
   75.18 +(ns 
   75.19 +  ^{:author "Stuart Halloway, Stephen C. Gilardi, Shawn Hoover, Perry Trolard, Stuart Sierra",
   75.20 +     :doc "A set of utilties for dealing with Java stuff like files and properties.
   75.21 +
   75.22 +   Design goals:
   75.23 +
   75.24 +   (1) Ease-of-use. These APIs should be convenient. Performance is secondary.
   75.25 +
   75.26 +   (2) Duck typing. I hate having to think about the difference between
   75.27 +       a string that names a file, and a File. Ditto for a ton of other 
   75.28 +       wrapper classes in the Java world (URL, InternetAddress). With these
   75.29 +       APIs you should be able to think about domain equivalence, not type
   75.30 +       equivalence.
   75.31 +
   75.32 +   (3) No bossiness. I am not marking any of these functions as private
   75.33 +       the docstrings will tell you the intended usage but do what works for you. 					
   75.34 +
   75.35 +   Feedback welcome!
   75.36 +
   75.37 +   If something in this module violates the principle of least surprise, please 
   75.38 +   let me (Stu) and the Clojure community know via the mailing list.
   75.39 +   Contributors:
   75.40 +
   75.41 +   Stuart Halloway
   75.42 +   Stephen C. Gilardi
   75.43 +   Shawn Hoover
   75.44 +   Perry Trolard
   75.45 +   Stuart Sierra
   75.46 +"}
   75.47 +  clojure.contrib.java-utils
   75.48 +  (:import [java.io File FileOutputStream]
   75.49 +	   [java.util Properties]
   75.50 +           [java.net URI URL]))
   75.51 +
   75.52 +(defmulti relative-path-string 
   75.53 +  "Interpret a String or java.io.File as a relative path string. 
   75.54 +   Building block for clojure.contrib.java-utils/file."
   75.55 +  {:deprecated "1.2"}
   75.56 +  class)
   75.57 +
   75.58 +(defmethod relative-path-string String [^String s]
   75.59 +  (relative-path-string (File. s)))
   75.60 +
   75.61 +(defmethod relative-path-string File [^File f]
   75.62 +  (if (.isAbsolute f)
   75.63 +    (throw (IllegalArgumentException. (str f " is not a relative path")))
   75.64 +    (.getPath f)))
   75.65 +
   75.66 +(defmulti ^File as-file 
   75.67 +  "Interpret a String or a java.io.File as a File. Building block
   75.68 +   for clojure.contrib.java-utils/file, which you should prefer
   75.69 +   in most cases."
   75.70 +  {:deprecated "1.2"}
   75.71 +  class)
   75.72 +(defmethod as-file String [^String s] (File. s))
   75.73 +(defmethod as-file File [f] f)
   75.74 +
   75.75 +(defn ^File file
   75.76 +  "Returns a java.io.File from string or file args."
   75.77 +  {:deprecated "1.2"}
   75.78 +  ([arg]                      
   75.79 +     (as-file arg))
   75.80 +  ([parent child]             
   75.81 +     (File. ^File (as-file parent) ^String (relative-path-string child)))
   75.82 +  ([parent child & more]
   75.83 +     (reduce file (file parent child) more)))
   75.84 +
   75.85 +(defn as-str
   75.86 +  "Like clojure.core/str, but if an argument is a keyword or symbol,
   75.87 +  its name will be used instead of its literal representation.
   75.88 +
   75.89 +  Example:
   75.90 +     (str :foo :bar)     ;;=> \":foo:bar\"
   75.91 +     (as-str :foo :bar)  ;;=> \"foobar\" 
   75.92 +
   75.93 +  Note that this does not apply to keywords or symbols nested within
   75.94 +  data structures; they will be rendered as with str.
   75.95 +
   75.96 +  Example:
   75.97 +     (str {:foo :bar})     ;;=> \"{:foo :bar}\"
   75.98 +     (as-str {:foo :bar})  ;;=> \"{:foo :bar}\" "
   75.99 +  {:deprecated "1.2"}
  75.100 +  ([] "")
  75.101 +  ([x] (if (instance? clojure.lang.Named x)
  75.102 +         (name x)
  75.103 +         (str x)))
  75.104 +  ([x & ys]
  75.105 +     ((fn [^StringBuilder sb more]
  75.106 +        (if more
  75.107 +          (recur (. sb  (append (as-str (first more)))) (next more))
  75.108 +          (str sb)))
  75.109 +      (new StringBuilder ^String (as-str x)) ys)))
  75.110 +
  75.111 +(defn get-system-property 
  75.112 +  "Get a system property."
  75.113 +  ([stringable]
  75.114 +   (System/getProperty (as-str stringable)))
  75.115 +  ([stringable default]
  75.116 +   (System/getProperty (as-str stringable) default)))
  75.117 +
  75.118 +(defn set-system-properties
  75.119 +  "Set some system properties. Nil clears a property."
  75.120 +  [settings]
  75.121 +  (doseq [[name val] settings]
  75.122 +    (if val
  75.123 +      (System/setProperty (as-str name) (as-str val))
  75.124 +      (System/clearProperty (as-str name)))))
  75.125 +
  75.126 +(defmacro with-system-properties
  75.127 +  "setting => property-name value
  75.128 +
  75.129 +  Sets the system properties to the supplied values, executes the body, and
  75.130 +  sets the properties back to their original values. Values of nil are
  75.131 +  translated to a clearing of the property."
  75.132 +  [settings & body]
  75.133 +  `(let [settings# ~settings
  75.134 +         current# (reduce (fn [coll# k#]
  75.135 +			    (assoc coll# k# (get-system-property k#)))
  75.136 +			  {}
  75.137 +			  (keys settings#))]
  75.138 +     (set-system-properties settings#)       
  75.139 +     (try
  75.140 +      ~@body
  75.141 +      (finally
  75.142 +       (set-system-properties current#)))))
  75.143 +
  75.144 +
  75.145 +; Not there is no corresponding props->map. Just destructure!
  75.146 +(defn ^Properties as-properties
  75.147 +  "Convert any seq of pairs to a java.utils.Properties instance.
  75.148 +   Uses as-str to convert both keys and values into strings."
  75.149 +  {:tag Properties}
  75.150 +  [m]
  75.151 +  (let [p (Properties.)]
  75.152 +    (doseq [[k v] m]
  75.153 +      (.setProperty p (as-str k) (as-str v)))
  75.154 +    p))
  75.155 +
  75.156 +(defn read-properties
  75.157 +  "Read properties from file-able."
  75.158 +  [file-able]
  75.159 +  (with-open [f (java.io.FileInputStream. (file file-able))]
  75.160 +    (doto (Properties.)
  75.161 +      (.load f))))
  75.162 +
  75.163 +(defn write-properties
  75.164 +  "Write properties to file-able."
  75.165 +  {:tag Properties}
  75.166 +  ([m file-able] (write-properties m file-able nil))
  75.167 +  ([m file-able comments]
  75.168 +    (with-open [^FileOutputStream f (FileOutputStream. (file file-able))]
  75.169 +      (doto (as-properties m)
  75.170 +        (.store f ^String comments)))))
  75.171 +
  75.172 +(defn delete-file
  75.173 +  "Delete file f. Raise an exception if it fails unless silently is true."
  75.174 +  {:deprecated "1.2"}
  75.175 +  [f & [silently]]
  75.176 +  (or (.delete (file f))
  75.177 +      silently
  75.178 +      (throw (java.io.IOException. (str "Couldn't delete " f)))))
  75.179 +
  75.180 +(defn delete-file-recursively
  75.181 +  "Delete file f. If it's a directory, recursively delete all its contents.
  75.182 +Raise an exception if any deletion fails unless silently is true."
  75.183 +  {:deprecated "1.2"}
  75.184 +  [f & [silently]]
  75.185 +  (let [f (file f)]
  75.186 +    (if (.isDirectory f)
  75.187 +      (doseq [child (.listFiles f)]
  75.188 +        (delete-file-recursively child silently)))
  75.189 +    (delete-file f silently)))
  75.190 +
  75.191 +(defmulti
  75.192 +  ^{:deprecated "1.2"
  75.193 +    :doc "Coerces argument (URL, URI, or String) to a java.net.URL."
  75.194 +    :arglists '([arg])}
  75.195 +  as-url type)
  75.196 +
  75.197 +(defmethod as-url URL [x] x)
  75.198 +
  75.199 +(defmethod as-url URI [^URI x] (.toURL x))
  75.200 +
  75.201 +(defmethod as-url String [^String x] (URL. x))
  75.202 +
  75.203 +(defmethod as-url File [^File x] (.toURL x))
  75.204 +
  75.205 +(defn wall-hack-method
  75.206 +  "Calls a private or protected method.
  75.207 +   params is a vector of class which correspond to the arguments to the method
  75.208 +   obj is nil for static methods, the instance object otherwise
  75.209 +   the method name is given as a symbol or a keyword (something Named)"
  75.210 +  {:deprecated "1.2"}
  75.211 +  [class-name method-name params obj & args]
  75.212 +  (-> class-name (.getDeclaredMethod (name method-name) (into-array Class params))
  75.213 +    (doto (.setAccessible true))
  75.214 +    (.invoke obj (into-array Object args))))
  75.215 +
  75.216 +(defn wall-hack-field
  75.217 +  "Access to private or protected field."
  75.218 +  {:deprecated "1.2"}
  75.219 +  [class-name field-name obj]
  75.220 +  (-> class-name (.getDeclaredField (name field-name))
  75.221 +    (doto (.setAccessible true))
  75.222 +    (.get obj)))
    76.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    76.2 +++ b/src/clojure/contrib/javadoc.clj	Sat Aug 21 06:25:44 2010 -0400
    76.3 @@ -0,0 +1,4 @@
    76.4 +(ns ^{:deprecated "1.2"}
    76.5 +  clojure.contrib.javadoc)
    76.6 +
    76.7 +(throw (Exception. "clojure.contrib.javadoc/javadoc can now be found in clojure.java.javadoc"))
    77.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    77.2 +++ b/src/clojure/contrib/javadoc/browse.clj	Sat Aug 21 06:25:44 2010 -0400
    77.3 @@ -0,0 +1,51 @@
    77.4 +;;; browse.clj -- start a web browser from Clojure
    77.5 +
    77.6 +;   Copyright (c) Christophe Grand, December 2008. All rights reserved.
    77.7 +;   The use and distribution terms for this software are covered by the
    77.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    77.9 +;   which can be found in the file epl-v10.html at the root of this 
   77.10 +;   distribution.
   77.11 +;   By using this software in any fashion, you are agreeing to be bound by
   77.12 +;   the terms of this license.
   77.13 +;   You must not remove this notice, or any other, from this software.
   77.14 +
   77.15 +(ns 
   77.16 +  ^{:author "Christophe Grand",
   77.17 +    :deprecated "1.2"
   77.18 +    :doc "Start a web browser from Clojure"}
   77.19 +  clojure.contrib.javadoc.browse
   77.20 +  (:require [clojure.contrib.shell :as sh]) 
   77.21 +  (:import (java.net URI)))
   77.22 +
   77.23 +(defn- macosx? []
   77.24 +  (-> "os.name" System/getProperty .toLowerCase
   77.25 +    (.startsWith "mac os x")))
   77.26 +
   77.27 +(def *open-url-script* (when (macosx?) "/usr/bin/open"))
   77.28 +
   77.29 +(defn open-url-in-browser
   77.30 +  "Opens url (a string) in the default system web browser.  May not
   77.31 +  work on all platforms.  Returns url on success, nil if not
   77.32 +  supported."
   77.33 +  [url]
   77.34 +  (try 
   77.35 +    (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" 
   77.36 +      "isDesktopSupported" (to-array nil))
   77.37 +      (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" 
   77.38 +            "getDesktop" (to-array nil))
   77.39 +        (.browse (URI. url)))
   77.40 +      url)
   77.41 +    (catch ClassNotFoundException e
   77.42 +      nil)))        
   77.43 +
   77.44 +(defn open-url-in-swing
   77.45 + "Opens url (a string) in a Swing window."
   77.46 + [url]
   77.47 +  ; the implementation of this function resides in another namespace to be loaded "on demand"
   77.48 +  ; this fixes a bug on mac os x where requiring repl-utils turns the process into a GUI app
   77.49 +  ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32
   77.50 +  (require 'clojure.contrib.javadoc.browse-ui)
   77.51 +  ((find-var 'clojure.contrib.javadoc.browse-ui/open-url-in-swing) url))
   77.52 +
   77.53 +(defn browse-url [url]
   77.54 +  (or (open-url-in-browser url) (when *open-url-script* (sh/sh *open-url-script* (str url)) true) (open-url-in-swing url)))
    78.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    78.2 +++ b/src/clojure/contrib/javadoc/browse_ui.clj	Sat Aug 21 06:25:44 2010 -0400
    78.3 @@ -0,0 +1,31 @@
    78.4 +;;; browse_ui.clj -- starts a swing web browser :-(
    78.5 +
    78.6 +;   Copyright (c) Christophe Grand, December 2008. All rights reserved.
    78.7 +;   The use and distribution terms for this software are covered by the
    78.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    78.9 +;   which can be found in the file epl-v10.html at the root of this 
   78.10 +;   distribution.
   78.11 +;   By using this software in any fashion, you are agreeing to be bound by
   78.12 +;   the terms of this license.
   78.13 +;   You must not remove this notice, or any other, from this software.
   78.14 +
   78.15 +(ns ^{:deprecated "1.2"}
   78.16 +  clojure.contrib.javadoc.browse-ui)
   78.17 +
   78.18 +(defn open-url-in-swing
   78.19 +  "Opens url (a string) in a Swing window."
   78.20 +  [url]
   78.21 +  (let [htmlpane (javax.swing.JEditorPane. url)]
   78.22 +    (.setEditable htmlpane false)
   78.23 +    (.addHyperlinkListener htmlpane
   78.24 +      (proxy [javax.swing.event.HyperlinkListener] []
   78.25 +        (hyperlinkUpdate [^javax.swing.event.HyperlinkEvent e]
   78.26 +          (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED))
   78.27 +            (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e)
   78.28 +              (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e))
   78.29 +              (.setPage htmlpane (.getURL e)))))))
   78.30 +    (doto (javax.swing.JFrame.)
   78.31 +      (.setContentPane (javax.swing.JScrollPane. htmlpane))
   78.32 +      (.setBounds 32 32 700 900)
   78.33 +      (.show))))
   78.34 +      
    79.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    79.2 +++ b/src/clojure/contrib/jmx.clj	Sat Aug 21 06:25:44 2010 -0400
    79.3 @@ -0,0 +1,121 @@
    79.4 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
    79.5 +;; and distribution terms for this software are covered by the Eclipse
    79.6 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    79.7 +;; which can be found in the file epl-v10.html at the root of this
    79.8 +;; distribution.  By using this software in any fashion, you are
    79.9 +;; agreeing to be bound by the terms of this license.  You must not
   79.10 +;; remove this notice, or any other, from this software.
   79.11 +
   79.12 +
   79.13 +(ns ^{:author "Stuart Halloway"
   79.14 +       :doc "JMX support for Clojure
   79.15 +
   79.16 +  Requires post-Clojure 1.0 git edge for clojure.test, clojure.backtrace.
   79.17 +  This is prerelease.
   79.18 +  This API will change.
   79.19 +  Send reports to stu@thinkrelevance.com.
   79.20 +
   79.21 +  Usage
   79.22 +    (require '[clojure.contrib.jmx :as jmx])
   79.23 +
   79.24 +  What beans do I have?
   79.25 +
   79.26 +    (jmx/mbean-names \"*:*\")
   79.27 +    -> #<HashSet [java.lang:type=MemoryPool,name=CMS Old Gen, 
   79.28 +                  java.lang:type=Memory, ...]
   79.29 +
   79.30 +  What attributes does a bean have?
   79.31 +
   79.32 +    (jmx/attribute-names \"java.lang:type=Memory\")
   79.33 +    -> (:Verbose :ObjectPendingFinalizationCount 
   79.34 +        :HeapMemoryUsage :NonHeapMemoryUsage)
   79.35 +
   79.36 +  What is the value of an attribute? 
   79.37 +
   79.38 +    (jmx/read \"java.lang:type=Memory\" :ObjectPendingFinalizationCount)
   79.39 +    -> 0
   79.40 +
   79.41 +  Can't I just have *all* the attributes in a Clojure map?
   79.42 +
   79.43 +    (jmx/mbean \"java.lang:type=Memory\")
   79.44 +    -> {:NonHeapMemoryUsage
   79.45 +         {:used 16674024, :max 138412032, :init 24317952, :committed 24317952},
   79.46 +        :HeapMemoryUsage
   79.47 +         {:used 18619064, :max 85393408, :init 0, :committed 83230720},
   79.48 +        :ObjectPendingFinalizationCount 0,
   79.49 +        :Verbose false}
   79.50 +
   79.51 +  Can I find and invoke an operation?
   79.52 +
   79.53 +    (jmx/operation-names \"java.lang:type=Memory\")
   79.54 +    -> (:gc)  
   79.55 +    (jmx/invoke \"java.lang:type=Memory\" :gc)
   79.56 +    -> nil
   79.57 +  
   79.58 +  What about some other process? Just run *any* of the above code
   79.59 +  inside a with-connection:
   79.60 +
   79.61 +    (jmx/with-connection {:host \"localhost\", :port 3000} 
   79.62 +      (jmx/mbean \"java.lang:type=Memory\"))
   79.63 +    -> {:ObjectPendingFinalizationCount 0, 
   79.64 +        :HeapMemoryUsage ... etc.}
   79.65 +
   79.66 +  Can I serve my own beans?  Sure, just drop a Clojure ref
   79.67 +  into an instance of clojure.contrib.jmx.Bean, and the bean
   79.68 +  will expose read-only attributes for every key/value pair
   79.69 +  in the ref:
   79.70 +
   79.71 +    (jmx/register-mbean
   79.72 +       (Bean.
   79.73 +       (ref {:string-attribute \"a-string\"}))
   79.74 +       \"my.namespace:name=Value\")"}
   79.75 +  clojure.contrib.jmx
   79.76 +  (:refer-clojure :exclude [read])
   79.77 +  (:use clojure.contrib.def
   79.78 +        [clojure.contrib.string :only [as-str]]
   79.79 +        [clojure.stacktrace :only (root-cause)]
   79.80 +        [clojure.walk :only [postwalk]])
   79.81 +  (:import [clojure.lang Associative]
   79.82 +           java.lang.management.ManagementFactory
   79.83 +           [javax.management Attribute DynamicMBean MBeanInfo ObjectName RuntimeMBeanException MBeanAttributeInfo]
   79.84 +           [javax.management.remote JMXConnectorFactory JMXServiceURL]))
   79.85 +
   79.86 +(defvar *connection* (ManagementFactory/getPlatformMBeanServer)
   79.87 +  "The connection to be used for JMX ops. Defaults to the local process.")
   79.88 +
   79.89 +(load "jmx/data")
   79.90 +(load "jmx/client")
   79.91 +(load "jmx/server")
   79.92 +
   79.93 +(defn mbean-names
   79.94 +  "Finds all MBeans matching a name on the current *connection*."
   79.95 +   [n]
   79.96 +  (.queryNames *connection* (as-object-name n) nil))
   79.97 +
   79.98 +(defn attribute-names 
   79.99 +  "All attribute names available on an MBean."
  79.100 +  [n]
  79.101 +  (doall (map #(-> % .getName keyword)
  79.102 +              (.getAttributes (mbean-info n)))))
  79.103 +
  79.104 +(defn operation-names
  79.105 +  "All operation names available on an MBean."
  79.106 +  [n]
  79.107 +  (doall (map #(-> % .getName keyword) (operations n))))
  79.108 +
  79.109 +(defn invoke [n op & args]
  79.110 +  (if ( seq args)
  79.111 +    (.invoke *connection* (as-object-name n) (as-str op)
  79.112 +             (into-array args)
  79.113 +             (into-array String  (op-param-types n op)))
  79.114 +    (.invoke *connection* (as-object-name n) (as-str op)
  79.115 +             nil nil)))
  79.116 +
  79.117 +(defn mbean
  79.118 +  "Like clojure.core/bean, but for JMX beans. Returns a read-only map of
  79.119 +   a JMX bean's attributes. If an attribute it not supported, value is
  79.120 +   set to the exception thrown."
  79.121 +  [n]
  79.122 +  (into {} (map (fn [attr-name] [(keyword attr-name) (read-supported n attr-name)])
  79.123 +                (attribute-names n))))
  79.124 +
    80.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    80.2 +++ b/src/clojure/contrib/jmx/Bean.clj	Sat Aug 21 06:25:44 2010 -0400
    80.3 @@ -0,0 +1,35 @@
    80.4 +(ns clojure.contrib.jmx.Bean
    80.5 +  (:gen-class
    80.6 +   :implements [javax.management.DynamicMBean]
    80.7 +   :init init
    80.8 +   :state state
    80.9 +   :constructors {[Object] []})
   80.10 +  (:require [clojure.contrib.jmx :as jmx])
   80.11 +  (:import [javax.management DynamicMBean MBeanInfo AttributeList]))
   80.12 +
   80.13 +(defn -init [derefable]
   80.14 +  [[] derefable])
   80.15 +
   80.16 +; TODO: rest of the arguments, as needed
   80.17 +(defn generate-mbean-info [clj-bean]
   80.18 +  (MBeanInfo. (.. clj-bean getClass getName)                      ; class name
   80.19 +              "Clojure Dynamic MBean"                             ; description
   80.20 +              (jmx/map->attribute-infos @(.state clj-bean))       ; attributes
   80.21 +              nil                                                 ; constructors
   80.22 +              nil                                                 ; operations
   80.23 +              nil))                                               ; notifications                                          
   80.24 +
   80.25 +(defn -getMBeanInfo
   80.26 +  [this]
   80.27 +  (generate-mbean-info this))
   80.28 +
   80.29 +(defn -getAttribute
   80.30 +  [this attr]
   80.31 +  (@(.state this) (keyword attr)))
   80.32 +
   80.33 +(defn -getAttributes
   80.34 +  [this attrs]
   80.35 +  (let [result (AttributeList.)]
   80.36 +    (doseq [attr attrs]
   80.37 +      (.add result (.getAttribute this attr)))
   80.38 +    result))
   80.39 \ No newline at end of file
    81.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    81.2 +++ b/src/clojure/contrib/jmx/client.clj	Sat Aug 21 06:25:44 2010 -0400
    81.3 @@ -0,0 +1,87 @@
    81.4 +;; JMX client APIs for Clojure
    81.5 +;; docs in clojure/contrib/jmx.clj!!
    81.6 +
    81.7 +;; by Stuart Halloway
    81.8 +
    81.9 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
   81.10 +;; and distribution terms for this software are covered by the Eclipse
   81.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   81.12 +;; which can be found in the file epl-v10.html at the root of this
   81.13 +;; distribution.  By using this software in any fashion, you are
   81.14 +;; agreeing to be bound by the terms of this license.  You must not
   81.15 +;; remove this notice, or any other, from this software.
   81.16 +
   81.17 +
   81.18 +(in-ns 'clojure.contrib.jmx)
   81.19 +
   81.20 +(defmacro with-connection
   81.21 +  "Execute body with JMX connection specified by opts. opts can also
   81.22 +   include an optional :environment key which is passed as the
   81.23 +   environment arg to JMXConnectorFactory/connect."
   81.24 +  [opts & body]
   81.25 +  `(let [opts# ~opts
   81.26 +         env# (get opts# :environment {})
   81.27 +         opts# (dissoc opts# :environment)]
   81.28 +     (with-open [connector# (javax.management.remote.JMXConnectorFactory/connect
   81.29 +                             (JMXServiceURL. (jmx-url opts#)) env#)]
   81.30 +       (binding [*connection* (.getMBeanServerConnection connector#)]
   81.31 +         ~@body))))
   81.32 +
   81.33 +(defn mbean-info [n]
   81.34 +  (.getMBeanInfo *connection* (as-object-name n)))
   81.35 +
   81.36 +(defn raw-read
   81.37 +  "Read an mbean property. Returns low-level Java object model for
   81.38 +   composites, tabulars, etc. Most callers should use read."
   81.39 +  [n attr]
   81.40 +  (.getAttribute *connection* (as-object-name n) (as-str attr)))
   81.41 +
   81.42 +(defvar read
   81.43 +  (comp jmx->clj raw-read)
   81.44 +  "Read an mbean property.")
   81.45 +
   81.46 +(defn read-supported
   81.47 +  "Calls read to read an mbean property, *returning* unsupported
   81.48 +   operation exceptions instead of throwing them. Used to keep mbean
   81.49 +   from blowing up. Note: There is no good exception that aggregates
   81.50 +   unsupported operations, hence the overly-general catch block."
   81.51 +  [n attr]
   81.52 +  (try
   81.53 +   (read n attr)
   81.54 +   (catch Exception e
   81.55 +     e)))
   81.56 +
   81.57 +(defn write! [n attr value]
   81.58 +  (.setAttribute
   81.59 +   *connection*
   81.60 +   (as-object-name n)
   81.61 +   (Attribute. (as-str attr) value)))
   81.62 +
   81.63 +(defn attribute-info
   81.64 +  "Get the MBeanAttributeInfo for an attribute."
   81.65 +  [object-name attr-name]
   81.66 +  (filter #(= (as-str attr-name) (.getName %))
   81.67 +          (.getAttributes (mbean-info object-name))))
   81.68 +
   81.69 +(defn readable?
   81.70 +  "Is attribute readable?"
   81.71 +  [n attr]
   81.72 +  (.isReadable () (mbean-info n)))
   81.73 +
   81.74 +(defn operations
   81.75 +  "All oeprations available on an MBean."
   81.76 +  [n]
   81.77 +  (.getOperations (mbean-info n)))
   81.78 +
   81.79 +(defn operation
   81.80 +  "The MBeanOperationInfo for operation op on mbean n. Used by invoke."
   81.81 +  [n op]
   81.82 +  (first  (filter #(= (-> % .getName keyword) op) (operations n))))
   81.83 +
   81.84 +(defn op-param-types 
   81.85 +  "The parameter types (as class name strings) for operation op on n.
   81.86 +   Used for invoke."
   81.87 +  [n op]
   81.88 +  (map #(-> % .getType) (.getSignature (operation n op))))
   81.89 +
   81.90 +
    82.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    82.2 +++ b/src/clojure/contrib/jmx/data.clj	Sat Aug 21 06:25:44 2010 -0400
    82.3 @@ -0,0 +1,104 @@
    82.4 +;; Conversions between JMX data structures and idiomatic Clojure
    82.5 +;; docs in clojure/contrib/jmx.clj!!
    82.6 +
    82.7 +;; by Stuart Halloway
    82.8 +
    82.9 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
   82.10 +;; and distribution terms for this software are covered by the Eclipse
   82.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   82.12 +;; which can be found in the file epl-v10.html at the root of this
   82.13 +;; distribution.  By using this software in any fashion, you are
   82.14 +;; agreeing to be bound by the terms of this license.  You must not
   82.15 +;; remove this notice, or any other, from this software.
   82.16 +
   82.17 +
   82.18 +(in-ns 'clojure.contrib.jmx)
   82.19 +
   82.20 +(declare jmx->clj)
   82.21 +
   82.22 +(defn jmx-url
   82.23 +  "Build a JMX URL from options."
   82.24 +  ([] (jmx-url {}))
   82.25 +  ([overrides]
   82.26 +     (let [opts (merge {:host "localhost", :port "3000", :jndi-path "jmxrmi"} overrides)]
   82.27 +       (format "service:jmx:rmi:///jndi/rmi://%s:%s/%s" (opts :host) (opts :port) (opts :jndi-path)))))
   82.28 +
   82.29 +(defmulti as-object-name
   82.30 +  "Interpret an object as a JMX ObjectName."
   82.31 +  { :arglists '([string-or-name]) }
   82.32 +  class)
   82.33 +(defmethod as-object-name String [n] (ObjectName. n))
   82.34 +(defmethod as-object-name ObjectName [n] n)
   82.35 +
   82.36 +(defn composite-data->map [cd]
   82.37 +  (into {}
   82.38 +        (map (fn [attr] [(keyword attr) (jmx->clj (.get cd attr))])
   82.39 +             (.. cd getCompositeType keySet))))
   82.40 +
   82.41 +(defn maybe-keywordize
   82.42 +  "Convert a string key to a keyword, leaving other types alone. Used to
   82.43 +   simplify keys in the tabular data API."
   82.44 +  [s]
   82.45 +  (if (string? s) (keyword s) s))
   82.46 +
   82.47 +(defn maybe-atomize
   82.48 +  "Convert a list of length 1 into its contents, leaving other things alone.
   82.49 +  Used to simplify keys in the tabular data API."
   82.50 +  [k]
   82.51 +  (if (and (instance? java.util.List k)
   82.52 +           (= 1 (count k)))
   82.53 +    (first k)
   82.54 +    k))
   82.55 +
   82.56 +(defvar simplify-tabular-data-key
   82.57 +  (comp maybe-keywordize maybe-atomize))
   82.58 +
   82.59 +(defn tabular-data->map [td]
   82.60 +  (into {}
   82.61 +        ; the need for into-array here was a surprise, and may not
   82.62 +        ; work for all examples. Are keys always arrays?
   82.63 +        (map (fn [k]
   82.64 +               [(simplify-tabular-data-key k) (jmx->clj (.get td (into-array k)))])
   82.65 +             (.keySet td))))
   82.66 +
   82.67 +(defmulti jmx->clj
   82.68 +  "Coerce JMX data structures into Clojure data.
   82.69 +  Handles CompositeData, TabularData, maps, and atoms."
   82.70 +  { :argslists '([jmx-data-structure]) }
   82.71 +  (fn [x]
   82.72 +    (cond
   82.73 +     (instance? javax.management.openmbean.CompositeData x) :composite
   82.74 +     (instance? javax.management.openmbean.TabularData x) :tabular
   82.75 +     (instance? clojure.lang.Associative x) :map
   82.76 +     :default :default)))
   82.77 +(defmethod jmx->clj :composite [c] (composite-data->map c))
   82.78 +(defmethod jmx->clj :tabular [t] (tabular-data->map t))
   82.79 +(defmethod jmx->clj :map [m]  (into {} (zipmap (keys m) (map jmx->clj (vals m)))))
   82.80 +(defmethod jmx->clj :default [obj] obj)
   82.81 +
   82.82 +(def guess-attribute-map
   82.83 +     {"java.lang.Integer" "int"
   82.84 +      "java.lang.Boolean" "boolean"
   82.85 +      "java.lang.Long" "long"
   82.86 +      })
   82.87 +
   82.88 +(defn guess-attribute-typename
   82.89 +  "Guess the attribute typename for MBeanAttributeInfo based on the attribute value."
   82.90 +  [value]
   82.91 +  (let [classname (.getName (class value))]
   82.92 +    (get guess-attribute-map classname classname)))
   82.93 +
   82.94 +(defn build-attribute-info
   82.95 +  "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map."
   82.96 +  ([attr-name attr-value]
   82.97 +     (build-attribute-info
   82.98 +      (as-str attr-name)
   82.99 +      (guess-attribute-typename attr-value)
  82.100 +      (as-str attr-name) true false false))
  82.101 +  ([name type desc readable? writable? is?] (MBeanAttributeInfo. name type desc readable? writable? is? )))
  82.102 +
  82.103 +(defn map->attribute-infos
  82.104 +  "Construct an MBeanAttributeInfo[] from a Clojure associative."
  82.105 +  [attr-map]
  82.106 +  (into-array (map (fn [[attr-name value]] (build-attribute-info attr-name value))
  82.107 +                   attr-map)))
    83.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    83.2 +++ b/src/clojure/contrib/jmx/server.clj	Sat Aug 21 06:25:44 2010 -0400
    83.3 @@ -0,0 +1,18 @@
    83.4 +;; JMX server APIs for Clojure
    83.5 +;; docs in clojure/contrib/jmx.clj!!
    83.6 +
    83.7 +;; by Stuart Halloway
    83.8 +
    83.9 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
   83.10 +;; and distribution terms for this software are covered by the Eclipse
   83.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   83.12 +;; which can be found in the file epl-v10.html at the root of this
   83.13 +;; distribution.  By using this software in any fashion, you are
   83.14 +;; agreeing to be bound by the terms of this license.  You must not
   83.15 +;; remove this notice, or any other, from this software.
   83.16 +
   83.17 +(in-ns 'clojure.contrib.jmx)
   83.18 +
   83.19 +(defn register-mbean [mbean mbean-name]
   83.20 +  (.registerMBean *connection* mbean (as-object-name mbean-name)))
   83.21 +
    84.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    84.2 +++ b/src/clojure/contrib/json.clj	Sat Aug 21 06:25:44 2010 -0400
    84.3 @@ -0,0 +1,341 @@
    84.4 +;;; json.clj: JavaScript Object Notation (JSON) parser/writer
    84.5 +
    84.6 +;; by Stuart Sierra, http://stuartsierra.com/
    84.7 +;; January 30, 2010
    84.8 +
    84.9 +;; Copyright (c) Stuart Sierra, 2010. All rights reserved.  The use
   84.10 +;; and distribution terms for this software are covered by the Eclipse
   84.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   84.12 +;; which can be found in the file epl-v10.html at the root of this
   84.13 +;; distribution.  By using this software in any fashion, you are
   84.14 +;; agreeing to be bound by the terms of this license.  You must not
   84.15 +;; remove this notice, or any other, from this software.
   84.16 +
   84.17 +(ns ^{:author "Stuart Sierra"
   84.18 +       :doc "JavaScript Object Notation (JSON) parser/writer.
   84.19 +  See http://www.json.org/
   84.20 +  To write JSON, use json-str, write-json, or write-json.
   84.21 +  To read JSON, use read-json."}
   84.22 +    clojure.contrib.json
   84.23 +  (:use [clojure.contrib.pprint :only (write formatter-out)]
   84.24 +        [clojure.contrib.string :only (as-str)])
   84.25 +  (:import (java.io PrintWriter PushbackReader StringWriter
   84.26 +                    StringReader Reader EOFException)))
   84.27 +
   84.28 +;;; JSON READER
   84.29 +
   84.30 +(declare read-json-reader)
   84.31 +
   84.32 +(defn- read-json-array [^PushbackReader stream keywordize?]
   84.33 +  ;; Expects to be called with the head of the stream AFTER the
   84.34 +  ;; opening bracket.
   84.35 +  (loop [i (.read stream), result (transient [])]
   84.36 +    (let [c (char i)]
   84.37 +      (cond
   84.38 +       (= i -1) (throw (EOFException. "JSON error (end-of-file inside array)"))
   84.39 +       (Character/isWhitespace c) (recur (.read stream) result)
   84.40 +       (= c \,) (recur (.read stream) result)
   84.41 +       (= c \]) (persistent! result)
   84.42 +       :else (do (.unread stream (int c))
   84.43 +                 (let [element (read-json-reader stream keywordize? true nil)]
   84.44 +                   (recur (.read stream) (conj! result element))))))))
   84.45 +
   84.46 +(defn- read-json-object [^PushbackReader stream keywordize?]
   84.47 +  ;; Expects to be called with the head of the stream AFTER the
   84.48 +  ;; opening bracket.
   84.49 +  (loop [i (.read stream), key nil, result (transient {})]
   84.50 +    (let [c (char i)]
   84.51 +      (cond
   84.52 +       (= i -1) (throw (EOFException. "JSON error (end-of-file inside object)"))
   84.53 +
   84.54 +       (Character/isWhitespace c) (recur (.read stream) key result)
   84.55 +
   84.56 +       (= c \,) (recur (.read stream) nil result)
   84.57 +
   84.58 +       (= c \:) (recur (.read stream) key result)
   84.59 +
   84.60 +       (= c \}) (if (nil? key)
   84.61 +                  (persistent! result)
   84.62 +                  (throw (Exception. "JSON error (key missing value in object)")))
   84.63 +
   84.64 +       :else (do (.unread stream i)
   84.65 +                 (let [element (read-json-reader stream keywordize? true nil)]
   84.66 +                   (if (nil? key)
   84.67 +                     (if (string? element)
   84.68 +                       (recur (.read stream) element result)
   84.69 +                       (throw (Exception. "JSON error (non-string key in object)")))
   84.70 +                     (recur (.read stream) nil
   84.71 +                            (assoc! result (if keywordize? (keyword key) key)
   84.72 +                                    element)))))))))
   84.73 +
   84.74 +(defn- read-json-hex-character [^PushbackReader stream]
   84.75 +  ;; Expects to be called with the head of the stream AFTER the
   84.76 +  ;; initial "\u".  Reads the next four characters from the stream.
   84.77 +  (let [digits [(.read stream)
   84.78 +                (.read stream)
   84.79 +                (.read stream)
   84.80 +                (.read stream)]]
   84.81 +    (when (some neg? digits)
   84.82 +      (throw (EOFException. "JSON error (end-of-file inside Unicode character escape)")))
   84.83 +    (let [chars (map char digits)]
   84.84 +      (when-not (every? #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9 \a \b \c \d \e \f \A \B \C \D \E \F}
   84.85 +                        chars)
   84.86 +        (throw (Exception. "JSON error (invalid hex character in Unicode character escape)")))
   84.87 +      (char (Integer/parseInt (apply str chars) 16)))))
   84.88 +
   84.89 +(defn- read-json-escaped-character [^PushbackReader stream]
   84.90 +  ;; Expects to be called with the head of the stream AFTER the
   84.91 +  ;; initial backslash.
   84.92 +  (let [c (char (.read stream))]
   84.93 +    (cond
   84.94 +     (#{\" \\ \/} c) c
   84.95 +     (= c \b) \backspace
   84.96 +     (= c \f) \formfeed
   84.97 +     (= c \n) \newline
   84.98 +     (= c \r) \return
   84.99 +     (= c \t) \tab
  84.100 +     (= c \u) (read-json-hex-character stream))))
  84.101 +
  84.102 +(defn- read-json-quoted-string [^PushbackReader stream]
  84.103 +  ;; Expects to be called with the head of the stream AFTER the
  84.104 +  ;; opening quotation mark.
  84.105 +  (let [buffer (StringBuilder.)]
  84.106 +    (loop [i (.read stream)]
  84.107 +      (let [c (char i)]
  84.108 +        (cond
  84.109 +         (= i -1) (throw (EOFException. "JSON error (end-of-file inside string)"))
  84.110 +         (= c \") (str buffer)
  84.111 +         (= c \\) (do (.append buffer (read-json-escaped-character stream))
  84.112 +                      (recur (.read stream)))
  84.113 +         :else (do (.append buffer c)
  84.114 +                   (recur (.read stream))))))))
  84.115 +
  84.116 +(defn- read-json-reader
  84.117 +  ([^PushbackReader stream keywordize? eof-error? eof-value]
  84.118 +     (loop [i (.read stream)]
  84.119 +       (let [c (char i)]
  84.120 +         (cond
  84.121 +          ;; Handle end-of-stream
  84.122 +          (= i -1) (if eof-error?
  84.123 +                     (throw (EOFException. "JSON error (end-of-file)"))
  84.124 +                     eof-value)
  84.125 +
  84.126 +          ;; Ignore whitespace
  84.127 +          (Character/isWhitespace c) (recur (.read stream))
  84.128 +
  84.129 +          ;; Read numbers, true, and false with Clojure reader
  84.130 +          (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c)
  84.131 +          (do (.unread stream i)
  84.132 +              (read stream true nil))
  84.133 +
  84.134 +          ;; Read strings
  84.135 +          (= c \") (read-json-quoted-string stream)
  84.136 +
  84.137 +          ;; Read null as nil
  84.138 +          (= c \n) (let [ull [(char (.read stream))
  84.139 +                              (char (.read stream))
  84.140 +                              (char (.read stream))]]
  84.141 +                     (if (= ull [\u \l \l])
  84.142 +                       nil
  84.143 +                       (throw (Exception. (str "JSON error (expected null): " c ull)))))
  84.144 +
  84.145 +          ;; Read true
  84.146 +          (= c \t) (let [rue [(char (.read stream))
  84.147 +                              (char (.read stream))
  84.148 +                              (char (.read stream))]]
  84.149 +                     (if (= rue [\r \u \e])
  84.150 +                       true
  84.151 +                       (throw (Exception. (str "JSON error (expected true): " c rue)))))
  84.152 +
  84.153 +          ;; Read false
  84.154 +          (= c \f) (let [alse [(char (.read stream))
  84.155 +                               (char (.read stream))
  84.156 +                               (char (.read stream))
  84.157 +                               (char (.read stream))]]
  84.158 +                     (if (= alse [\a \l \s \e])
  84.159 +                       false
  84.160 +                       (throw (Exception. (str "JSON error (expected false): " c alse)))))
  84.161 +
  84.162 +          ;; Read JSON objects
  84.163 +          (= c \{) (read-json-object stream keywordize?)
  84.164 +
  84.165 +          ;; Read JSON arrays
  84.166 +          (= c \[) (read-json-array stream keywordize?)
  84.167 +
  84.168 +          :else (throw (Exception. (str "JSON error (unexpected character): " c))))))))
  84.169 +
  84.170 +(defprotocol Read-JSON-From
  84.171 +  (read-json-from [input keywordize? eof-error? eof-value]
  84.172 +                  "Reads one JSON value from input String or Reader.
  84.173 +  If keywordize? is true, object keys will be converted to keywords.
  84.174 +  If eof-error? is true, empty input will throw an EOFException; if
  84.175 +  false EOF will return eof-value. "))
  84.176 +
  84.177 +(extend-protocol
  84.178 + Read-JSON-From
  84.179 + String
  84.180 + (read-json-from [input keywordize? eof-error? eof-value]
  84.181 +                 (read-json-reader (PushbackReader. (StringReader. input))
  84.182 +                                   keywordize? eof-error? eof-value))
  84.183 + PushbackReader
  84.184 + (read-json-from [input keywordize? eof-error? eof-value]
  84.185 +                 (read-json-reader input
  84.186 +                                   keywordize? eof-error? eof-value))
  84.187 + Reader
  84.188 + (read-json-from [input keywordize? eof-error? eof-value]
  84.189 +                 (read-json-reader (PushbackReader. input)
  84.190 +                                   keywordize? eof-error? eof-value)))
  84.191 +
  84.192 +(defn read-json
  84.193 +  "Reads one JSON value from input String or Reader.
  84.194 +  If keywordize? is true (default), object keys will be converted to
  84.195 +  keywords.  If eof-error? is true (default), empty input will throw
  84.196 +  an EOFException; if false EOF will return eof-value. "
  84.197 +  ([input]
  84.198 +     (read-json-from input true true nil))
  84.199 +  ([input keywordize?]
  84.200 +     (read-json-from input keywordize? true nil))
  84.201 +  ([input keywordize? eof-error? eof-value]
  84.202 +     (read-json-from input keywordize? eof-error? eof-value)))
  84.203 +
  84.204 +
  84.205 +;;; JSON PRINTER
  84.206 +
  84.207 +(defprotocol Write-JSON
  84.208 +  (write-json [object out]
  84.209 +              "Print object to PrintWriter out as JSON"))
  84.210 +
  84.211 +(defn- write-json-string [^CharSequence s ^PrintWriter out]
  84.212 +  (let [sb (StringBuilder. ^Integer (count s))]
  84.213 +    (.append sb \")
  84.214 +    (dotimes [i (count s)]
  84.215 +      (let [cp (Character/codePointAt s i)]
  84.216 +        (cond
  84.217 +         ;; Handle printable JSON escapes before ASCII
  84.218 +         (= cp 34) (.append sb "\\\"")
  84.219 +         (= cp 92) (.append sb "\\\\")
  84.220 +         (= cp 47) (.append sb "\\/")
  84.221 +         ;; Print simple ASCII characters
  84.222 +         (< 31 cp 127) (.append sb (.charAt s i))
  84.223 +         ;; Handle non-printable JSON escapes
  84.224 +         (= cp 8) (.append sb "\\b")
  84.225 +         (= cp 12) (.append sb "\\f")
  84.226 +         (= cp 10) (.append sb "\\n")
  84.227 +         (= cp 13) (.append sb "\\r")
  84.228 +         (= cp 9) (.append sb "\\t")
  84.229 +         ;; Any other character is Hexadecimal-escaped
  84.230 +         :else (.append sb (format "\\u%04x" cp)))))
  84.231 +    (.append sb \")
  84.232 +    (.print out (str sb))))
  84.233 +
  84.234 +(defn- write-json-object [m ^PrintWriter out] 
  84.235 +  (.print out \{)
  84.236 +  (loop [x m]
  84.237 +    (when (seq m)
  84.238 +      (let [[k v] (first x)]
  84.239 +        (when (nil? k)
  84.240 +          (throw (Exception. "JSON object keys cannot be nil/null")))
  84.241 +        (.print out \")
  84.242 +        (.print out (as-str k))
  84.243 +        (.print out \")
  84.244 +        (.print out \:)
  84.245 +        (write-json v out))
  84.246 +      (let [nxt (next x)]
  84.247 +        (when (seq nxt)
  84.248 +          (.print out \,)
  84.249 +          (recur nxt)))))
  84.250 +  (.print out \}))
  84.251 +
  84.252 +(defn- write-json-array [s ^PrintWriter out]
  84.253 +  (.print out \[)
  84.254 +  (loop [x s]
  84.255 +    (when (seq x)
  84.256 +      (let [fst (first x)
  84.257 +            nxt (next x)]
  84.258 +        (write-json fst out)
  84.259 +        (when (seq nxt)
  84.260 +          (.print out \,)
  84.261 +          (recur nxt)))))
  84.262 +  (.print out \]))
  84.263 +
  84.264 +(defn- write-json-bignum [x ^PrintWriter out]
  84.265 +  (.print out (str x)))
  84.266 +
  84.267 +(defn- write-json-plain [x ^PrintWriter out]
  84.268 +  (.print out x))
  84.269 +
  84.270 +(defn- write-json-null [x ^PrintWriter out]
  84.271 +  (.print out "null"))
  84.272 +
  84.273 +(defn- write-json-named [x ^PrintWriter out]
  84.274 +  (write-json-string (name x) out))
  84.275 +
  84.276 +(defn- write-json-generic [x out]
  84.277 +  (if (.isArray (class x))
  84.278 +    (write-json (seq x) out)
  84.279 +    (throw (Exception. (str "Don't know how to write JSON of " (class x))))))
  84.280 +  
  84.281 +(extend nil Write-JSON
  84.282 +        {:write-json write-json-null})
  84.283 +(extend clojure.lang.Named Write-JSON
  84.284 +        {:write-json write-json-named})
  84.285 +(extend java.lang.Boolean Write-JSON
  84.286 +        {:write-json write-json-plain})
  84.287 +(extend java.lang.Number Write-JSON
  84.288 +        {:write-json write-json-plain})
  84.289 +(extend java.math.BigInteger Write-JSON
  84.290 +        {:write-json write-json-bignum})
  84.291 +(extend java.math.BigDecimal Write-JSON
  84.292 +        {:write-json write-json-bignum})
  84.293 +(extend java.lang.CharSequence Write-JSON
  84.294 +        {:write-json write-json-string})
  84.295 +(extend java.util.Map Write-JSON
  84.296 +        {:write-json write-json-object})
  84.297 +(extend java.util.Collection Write-JSON
  84.298 +        {:write-json write-json-array})
  84.299 +(extend clojure.lang.ISeq Write-JSON
  84.300 +        {:write-json write-json-array})
  84.301 +(extend java.lang.Object Write-JSON
  84.302 +        {:write-json write-json-generic})
  84.303 +
  84.304 +(defn json-str
  84.305 +  "Converts x to a JSON-formatted string."
  84.306 +  [x]
  84.307 +  (let [sw (StringWriter.)
  84.308 +        out (PrintWriter. sw)]
  84.309 +    (write-json x out)
  84.310 +    (.toString sw)))
  84.311 +
  84.312 +(defn print-json
  84.313 +  "Write JSON-formatted output to *out*"
  84.314 +  [x]
  84.315 +  (write-json x *out*))
  84.316 +
  84.317 +
  84.318 +;;; JSON PRETTY-PRINTER
  84.319 +
  84.320 +;; Based on code by Tom Faulhaber
  84.321 +
  84.322 +(defn- pprint-json-array [s] 
  84.323 +  ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s))
  84.324 +
  84.325 +(defn- pprint-json-object [m]
  84.326 +  ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 
  84.327 +   (for [[k v] m] [(as-str k) v])))
  84.328 +
  84.329 +(defn- pprint-json-generic [x]
  84.330 +  (if (.isArray (class x))
  84.331 +    (pprint-json-array (seq x))
  84.332 +    (print (json-str x))))
  84.333 +  
  84.334 +(defn- pprint-json-dispatch [x]
  84.335 +  (cond (nil? x) (print "null")
  84.336 +        (instance? java.util.Map x) (pprint-json-object x)
  84.337 +        (instance? java.util.Collection x) (pprint-json-array x)
  84.338 +        (instance? clojure.lang.ISeq x) (pprint-json-array x)
  84.339 +        :else (pprint-json-generic x)))
  84.340 +
  84.341 +(defn pprint-json
  84.342 +  "Pretty-prints JSON representation of x to *out*"
  84.343 +  [x]
  84.344 +  (write x :dispatch pprint-json-dispatch))
    85.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    85.2 +++ b/src/clojure/contrib/lazy_seqs.clj	Sat Aug 21 06:25:44 2010 -0400
    85.3 @@ -0,0 +1,90 @@
    85.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    85.5 +;;  distribution terms for this software are covered by the Eclipse Public
    85.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    85.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    85.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    85.9 +;;  terms of this license.  You must not remove this notice, or any other,
   85.10 +;;  from this software.
   85.11 +;;
   85.12 +;;  lazy-seqs
   85.13 +;;
   85.14 +;;  == Lazy sequences ==
   85.15 +;;
   85.16 +;;  primes - based on the "naive" implemention described in [1] plus a
   85.17 +;;           small "wheel" which eliminates multiples of 2, 3, 5, and
   85.18 +;;           7 from consideration by incrementing past them. Also inspired
   85.19 +;;           by code from Christophe Grand in [2].
   85.20 +;;
   85.21 +;;  fibs   - all the Fibonacci numbers
   85.22 +;;
   85.23 +;;  powers-of-2 - all the powers of 2
   85.24 +;;
   85.25 +;;  == Lazy sequence functions ==
   85.26 +;;
   85.27 +;;  (partition-all, shuffle moved to clojure.core)
   85.28 +;;  (rand-elt moved to clojure.core/rand-nth)
   85.29 +;;  (rotations, moved to seq_utils.clj)
   85.30 +;;  (permutations and combinations moved to combinatorics.clj)
   85.31 +;;
   85.32 +;;  [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
   85.33 +;;  [2] http://clj-me.blogspot.com/2008/06/primes.html
   85.34 +;;
   85.35 +;;  scgilardi (gmail)
   85.36 +;;  Created 07 June 2008
   85.37 +
   85.38 +(ns 
   85.39 +  ^{:author "Stephen C. Gilardi",
   85.40 +     :doc "
   85.41 +==== Lazy sequences ====
   85.42 +
   85.43 + primes - based on the \"naive\" implemention described in [1] plus a
   85.44 +          small \"wheel\" which eliminates multiples of 2, 3, 5, and
   85.45 +          7 from consideration by incrementing past them. Also inspired
   85.46 +          by code from Christophe Grand in [2].
   85.47 +
   85.48 + fibs   - all the Fibonacci numbers
   85.49 +
   85.50 + powers-of-2 - all the powers of 2
   85.51 +
   85.52 + ==== Lazy sequence functions ====
   85.53 +
   85.54 + (partition-all, shuffle moved to clojure.core)
   85.55 + (rand-elt moved to clojure.core/rand-nth)
   85.56 + (rotations, rand-elt  moved to seq_utils.clj)
   85.57 + (permutations and combinations moved to combinatorics.clj)
   85.58 +
   85.59 + [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
   85.60 + [2] http://clj-me.blogspot.com/2008/06/primes.html
   85.61 +"}
   85.62 +  clojure.contrib.lazy-seqs
   85.63 +  (:use clojure.contrib.def))
   85.64 +
   85.65 +; primes cannot be written efficiently as a function, because
   85.66 +; it needs to look back on the whole sequence. contrast with
   85.67 +; fibs and powers-of-2 which only need a fixed buffer of 1 or 2
   85.68 +; previous values.
   85.69 +(defvar primes
   85.70 +  (concat 
   85.71 +   [2 3 5 7]
   85.72 +   (lazy-seq
   85.73 +    (let [primes-from
   85.74 +	  (fn primes-from [n [f & r]]
   85.75 +	    (if (some #(zero? (rem n %))
   85.76 +		      (take-while #(<= (* % %) n) primes))
   85.77 +	      (recur (+ n f) r)
   85.78 +	      (lazy-seq (cons n (primes-from (+ n f) r)))))
   85.79 +	  wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6  4  2
   85.80 +			6 4 6 8 4 2 4 2 4 8 6 4 6 2  4  6
   85.81 +			2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])]
   85.82 +      (primes-from 11 wheel))))
   85.83 +  "Lazy sequence of all the prime numbers.")
   85.84 +
   85.85 +(defn fibs
   85.86 +  "Returns a lazy sequence of all the Fibonacci numbers."
   85.87 +  []
   85.88 +  (map first (iterate (fn [[a b]] [b (+ a b)]) [0 1])))
   85.89 +
   85.90 +(defn powers-of-2
   85.91 +  "Returns a lazy sequence of all the powers of 2"
   85.92 +  []
   85.93 +  (iterate #(bit-shift-left % 1) 1))
    86.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    86.2 +++ b/src/clojure/contrib/lazy_xml.clj	Sat Aug 21 06:25:44 2010 -0400
    86.3 @@ -0,0 +1,215 @@
    86.4 +;   Copyright (c) Chris Houser, Dec 2008. All rights reserved.
    86.5 +;   The use and distribution terms for this software are covered by the
    86.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    86.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
    86.8 +;   By using this software in any fashion, you are agreeing to be bound by
    86.9 +;   the terms of this license.
   86.10 +;   You must not remove this notice, or any other, from this software.
   86.11 +
   86.12 +; Functions to parse xml lazily and emit back to text.
   86.13 +
   86.14 +(ns 
   86.15 +    ^{:author "Chris Houser",
   86.16 +       :doc "Functions to parse xml lazily and emit back to text."}
   86.17 +    clojure.contrib.lazy-xml
   86.18 +    (:use [clojure.xml :as xml :only []]
   86.19 +          [clojure.contrib.seq :only [fill-queue]])
   86.20 +    (:import (org.xml.sax Attributes InputSource)
   86.21 +             (org.xml.sax.helpers DefaultHandler)
   86.22 +             (javax.xml.parsers SAXParserFactory)
   86.23 +             (java.util.concurrent LinkedBlockingQueue TimeUnit)
   86.24 +             (java.lang.ref WeakReference)
   86.25 +             (java.io Reader)))
   86.26 +
   86.27 +(defstruct node :type :name :attrs :str)
   86.28 +
   86.29 +; http://www.extreme.indiana.edu/xgws/xsoap/xpp/
   86.30 +(def has-pull false)
   86.31 +(defn- parse-seq-pull [& _])
   86.32 +(try
   86.33 +  (load "lazy_xml/with_pull")
   86.34 +  (catch Exception e
   86.35 +    (when-not (re-find #"XmlPullParser" (str e))
   86.36 +      (throw e))))
   86.37 +
   86.38 +(defn startparse-sax [s ch]
   86.39 +  (.. SAXParserFactory newInstance newSAXParser (parse s ch)))
   86.40 +
   86.41 +(defn parse-seq
   86.42 +  "Parses the source s, which can be a File, InputStream or String
   86.43 +  naming a URI. Returns a lazy sequence of maps with two or more of
   86.44 +  the keys :type, :name, :attrs, and :str. Other SAX-compatible
   86.45 +  parsers can be supplied by passing startparse, a fn taking a source
   86.46 +  and a ContentHandler and returning a parser. If a parser is
   86.47 +  specified, it will be run in a separate thread and be allowed to get
   86.48 +  ahead by queue-size items, which defaults to maxint.  If no parser
   86.49 +  is specified and org.xmlpull.v1.XmlPullParser is in the classpath,
   86.50 +  this superior pull parser will be used."
   86.51 +  ([s] (if has-pull
   86.52 +         (parse-seq-pull s)
   86.53 +         (parse-seq s startparse-sax)))
   86.54 +  ([s startparse] (parse-seq s startparse Integer/MAX_VALUE))
   86.55 +  ([s startparse queue-size]
   86.56 +   (let [s (if (instance? Reader s) (InputSource. s) s)
   86.57 +         f (fn filler-func [fill]
   86.58 +             (startparse s (proxy [DefaultHandler] []
   86.59 +               (startElement [uri local-name q-name ^Attributes atts]
   86.60 +                 ;(prn :start-element q-name)(flush)
   86.61 +                 (let [attrs (into {} (for [i (range (.getLength atts))]
   86.62 +                                           [(keyword (.getQName atts i))
   86.63 +                                            (.getValue atts i)]))]
   86.64 +                   (fill (struct node :start-element (keyword q-name) attrs))))
   86.65 +               (endElement [uri local-name q-name]
   86.66 +                 ;(prn :end-element q-name)(flush)
   86.67 +                 (fill (struct node :end-element (keyword q-name))))
   86.68 +               (characters [ch start length]
   86.69 +                 ;(prn :characters)(flush)
   86.70 +                 (let [st (String. ch start length)]
   86.71 +                   (when (seq (.trim st))
   86.72 +                     (fill (struct node :characters nil nil st))))))))]
   86.73 +     (fill-queue f :queue-size queue-size))))
   86.74 +
   86.75 +
   86.76 +(defstruct element :tag :attrs :content)
   86.77 +(declare mktree)
   86.78 +
   86.79 +(defn- siblings [coll]
   86.80 +  (lazy-seq
   86.81 +    (when-let [s (seq coll)]
   86.82 +      (let [event (first s)]
   86.83 +        (condp = (:type event)
   86.84 +          :characters    (cons (:str event) (siblings (rest s)))
   86.85 +          :start-element (let [t (mktree s)]
   86.86 +                           (cons (first t) (siblings (rest t))))
   86.87 +          :end-element   [(rest s)])))))
   86.88 +
   86.89 +(defn- mktree
   86.90 +  [[elem & events]]
   86.91 +    (lazy-seq
   86.92 +      (let [sibs (siblings events)]
   86.93 +        ;(prn :elem elem)
   86.94 +        (cons
   86.95 +          (struct element (:name elem) (:attrs elem) (drop-last sibs))
   86.96 +          (lazy-seq (last sibs))))))
   86.97 +
   86.98 +(defn parse-trim
   86.99 +  "Parses the source s, which can be a File, InputStream or String
  86.100 +  naming a URI. Returns a lazy tree of the clojure.xml/element
  86.101 +  struct-map, which has the keys :tag, :attrs, and :content and
  86.102 +  accessor fns tag, attrs, and content, with the whitespace trimmed
  86.103 +  from around each content string. This format is compatible with what
  86.104 +  clojure.xml/parse produces, except :content is a lazy seq instead of
  86.105 +  a vector.  Other SAX-compatible parsers can be supplied by passing
  86.106 +  startparse, a fn taking a source and a ContentHandler and returning
  86.107 +  a parser. If a parser is specified, it will be run in a separate
  86.108 +  thread and be allowed to get ahead by queue-size items, which
  86.109 +  defaults to maxing.  If no parser is specified and
  86.110 +  org.xmlpull.v1.XmlPullParser is in the classpath, this superior pull
  86.111 +  parser will be used."
  86.112 +  ([s] (first (mktree (parse-seq s))))
  86.113 +  ([s startparse queue-size]
  86.114 +    (first (mktree (parse-seq s startparse queue-size)))))
  86.115 +
  86.116 +(defn attributes [e]
  86.117 +  (let [v (vec (:attrs e))]
  86.118 +    (reify org.xml.sax.Attributes
  86.119 +      (getLength [_] (count v))
  86.120 +      (getURI [_ i] (namespace (key (v i))))
  86.121 +      (getLocalName [_ i] (name (key (v i))))
  86.122 +      (getQName [_ i] (name (key (v i))))
  86.123 +      (getValue [_ uri name] (get (:attrs e) name))
  86.124 +      (^String getValue [_ ^int i] (val (v i)))
  86.125 +      (^String getType [_ ^int i] "CDATA"))))
  86.126 +
  86.127 +(defn- emit-element
  86.128 +  "Recursively prints as XML text the element struct e.  To have it
  86.129 +  print extra whitespace like clojure.xml/emit, use the :pad true
  86.130 +  option."
  86.131 +  [e ^org.xml.sax.ContentHandler ch]
  86.132 +  (if (instance? String e)
  86.133 +    (.characters ch (.toCharArray ^String e) 0 (count e))
  86.134 +    (let [nspace (namespace (:tag e))
  86.135 +          qname (name (:tag e))]
  86.136 +      (.startElement ch (or nspace "") qname qname (attributes e))
  86.137 +      (doseq [c (:content e)]
  86.138 +        (emit-element c ch))
  86.139 +      (.endElement ch (or nspace "") qname qname))))
  86.140 +  
  86.141 +
  86.142 +(defn emit
  86.143 +  [e & {:as opts}]
  86.144 +  (let [content-handler (atom nil)
  86.145 +        trans (-> (javax.xml.transform.TransformerFactory/newInstance)
  86.146 +                .newTransformer)]
  86.147 +
  86.148 +    (when (:indent opts)
  86.149 +      (.setOutputProperty trans "indent" "yes")
  86.150 +      (.setOutputProperty trans "{http://xml.apache.org/xslt}indent-amount"
  86.151 +                          (str (:indent opts))))
  86.152 +
  86.153 +    (when (contains? opts :xml-declaration)
  86.154 +      (.setOutputProperty trans "omit-xml-declaration" 
  86.155 +                          (if (:xml-declaration opts) "no" "yes")))
  86.156 +
  86.157 +    (when (:encoding opts)
  86.158 +      (.setOutputProperty trans "encoding" (:encoding opts)))
  86.159 +
  86.160 +    (.transform
  86.161 +      trans
  86.162 +      (javax.xml.transform.sax.SAXSource.
  86.163 +        (reify org.xml.sax.XMLReader
  86.164 +          (getContentHandler [_] @content-handler)
  86.165 +          (setDTDHandler [_ handler])
  86.166 +          (setFeature [_ name value])
  86.167 +          (setProperty [_ name value])
  86.168 +          (setContentHandler [_ ch] (reset! content-handler ch))
  86.169 +          (^void parse [_ ^org.xml.sax.InputSource _]
  86.170 +            (when @content-handler
  86.171 +              (.startDocument @content-handler)
  86.172 +              (emit-element e @content-handler)
  86.173 +              (.endDocument @content-handler))))
  86.174 +        (org.xml.sax.InputSource.))
  86.175 +      (javax.xml.transform.stream.StreamResult. *out*))))
  86.176 +
  86.177 +(comment
  86.178 +
  86.179 +(def atomstr "<?xml version='1.0' encoding='UTF-8'?>
  86.180 +<feed xmlns='http://www.w3.org/2005/Atom'>
  86.181 +  <id>tag:blogger.com,1999:blog-28403206</id>
  86.182 +  <updated>2008-02-14T08:00:58.567-08:00</updated>
  86.183 +  <title type='text'>n01senet</title>
  86.184 +  <link rel='alternate' type='text/html' href='http://n01senet.blogspot.com/'/>
  86.185 +  <entry xmlns:foo='http://foo' xmlns:bar='http://bar'>
  86.186 +    <id>1</id>
  86.187 +    <published>2008-02-13</published>
  86.188 +    <title type='text'>clojure is the best lisp yet</title>
  86.189 +    <author><name>Chouser</name></author>
  86.190 +  </entry>
  86.191 +  <entry>
  86.192 +    <id>2</id>
  86.193 +    <published>2008-02-07</published>
  86.194 +    <title type='text'>experimenting with vnc</title>
  86.195 +    <author><name>agriffis</name></author>
  86.196 +  </entry>
  86.197 +</feed>
  86.198 +")
  86.199 +
  86.200 +(def tree (parse-trim (java.io.StringReader. atomstr)
  86.201 +                 startparse-sax
  86.202 +                 1))
  86.203 +(println "\nsax")
  86.204 +(emit tree)
  86.205 +
  86.206 +(def tree (parse-trim (java.io.StringReader. atomstr)))
  86.207 +(println "\ndefault")
  86.208 +(emit tree)
  86.209 +
  86.210 +(def tree (xml/parse (org.xml.sax.InputSource. (java.io.StringReader. atomstr))))
  86.211 +(println "\norig")
  86.212 +(emit tree)
  86.213 +
  86.214 +; When used with zip and zip-filter, you can get do queries like this
  86.215 +; without parsing more than the first few tags:
  86.216 +; (zip/node (first (xml-> (zip/xml-zip tree) :id)))
  86.217 +
  86.218 +)
    87.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    87.2 +++ b/src/clojure/contrib/lazy_xml/with_pull.clj	Sat Aug 21 06:25:44 2010 -0400
    87.3 @@ -0,0 +1,58 @@
    87.4 +;   Copyright (c) Chris Houser, Dec 2008. All rights reserved.
    87.5 +;   The use and distribution terms for this software are covered by the
    87.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    87.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
    87.8 +;   By using this software in any fashion, you are agreeing to be bound by
    87.9 +;   the terms of this license.
   87.10 +;   You must not remove this notice, or any other, from this software.
   87.11 +
   87.12 +; optional module to allow lazy-xml to use pull parser instead of sax
   87.13 +
   87.14 +(in-ns 'clojure.contrib.lazy-xml)
   87.15 +(import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory))
   87.16 +
   87.17 +(defn- attrs [xpp]
   87.18 +  (for [i (range (.getAttributeCount xpp))]
   87.19 +    [(keyword (.getAttributeName xpp i))
   87.20 +     (.getAttributeValue xpp i)]))
   87.21 +
   87.22 +(defn- ns-decs [xpp]
   87.23 +  (let [d (.getDepth xpp)]
   87.24 +    (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))]
   87.25 +      (let [prefix (.getNamespacePrefix xpp i)]
   87.26 +        [(keyword (str "xmlns" (when prefix (str ":" prefix))))
   87.27 +         (.getNamespaceUri xpp i)]))))
   87.28 +
   87.29 +(defn- attr-hash [xpp]
   87.30 +  (into {} (concat (ns-decs xpp) (attrs xpp))))
   87.31 +
   87.32 +(defn- pull-step [xpp]
   87.33 +  (let [step (fn [xpp]
   87.34 +               (condp = (.next xpp)
   87.35 +                 XmlPullParser/START_TAG
   87.36 +                   (cons (struct node :start-element
   87.37 +                                 (keyword (.getName xpp))
   87.38 +                                 (attr-hash xpp))
   87.39 +                         (pull-step xpp))
   87.40 +                   XmlPullParser/END_TAG
   87.41 +                   (cons (struct node :end-element
   87.42 +                                 (keyword (.getName xpp)))
   87.43 +                         (pull-step xpp))
   87.44 +                   XmlPullParser/TEXT
   87.45 +                   (let [text (.trim (.getText xpp))]
   87.46 +                     (if (empty? text)
   87.47 +                       (recur xpp)
   87.48 +                       (cons (struct node :characters nil nil text)
   87.49 +                             (pull-step xpp))))))]
   87.50 +    (lazy-seq (step xpp))))
   87.51 +
   87.52 +(def ^{:private true} factory
   87.53 +  (doto (XmlPullParserFactory/newInstance)
   87.54 +    (.setNamespaceAware true)))
   87.55 +
   87.56 +(defn- parse-seq-pull [s]
   87.57 +  (let [xpp (.newPullParser factory)]
   87.58 +    (.setInput xpp s)
   87.59 +    (pull-step xpp)))
   87.60 +
   87.61 +(def has-pull true)
    88.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    88.2 +++ b/src/clojure/contrib/logging.clj	Sat Aug 21 06:25:44 2010 -0400
    88.3 @@ -0,0 +1,343 @@
    88.4 +;;; logging.clj -- delegated logging for Clojure
    88.5 + 
    88.6 +;; by Alex Taggart
    88.7 +;; July 27, 2009
    88.8 + 
    88.9 +;; Copyright (c) Alex Taggart, July 2009. All rights reserved.  The use
   88.10 +;; and distribution terms for this software are covered by the Eclipse
   88.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   88.12 +;; which can be found in the file epl-v10.html at the root of this
   88.13 +;; distribution.  By using this software in any fashion, you are
   88.14 +;; agreeing to be bound by the terms of this license.  You must not
   88.15 +;; remove this notice, or any other, from this software.
   88.16 +(ns 
   88.17 +  ^{:author "Alex Taggart, Timothy Pratley",
   88.18 +     :doc
   88.19 +  "Logging macros which delegate to a specific logging implementation. At
   88.20 +  runtime a specific implementation is selected from, in order, Apache
   88.21 +  commons-logging, log4j, and finally java.util.logging.
   88.22 +  
   88.23 +  Logging levels are specified by clojure keywords corresponding to the
   88.24 +  values used in log4j and commons-logging:
   88.25 +    :trace, :debug, :info, :warn, :error, :fatal
   88.26 +  
   88.27 +  Logging occurs with the log macro, or the level-specific convenience macros,
   88.28 +  which write either directly or via an agent.  For performance reasons, direct
   88.29 +  logging is enabled by default, but setting the *allow-direct-logging* boolean
   88.30 +  atom to false will disable it. If logging is invoked within a transaction it
   88.31 +  will always use an agent.
   88.32 +  
   88.33 +  The log macros will not evaluate their 'message' unless the specific logging
   88.34 +  level is in effect. Alternately, you can use the spy macro when you have code
   88.35 +  that needs to be evaluated, and also want to output the code and its result to
   88.36 +  the debug log.
   88.37 +  
   88.38 +  Unless otherwise specified, the current namespace (as identified by *ns*) will
   88.39 +  be used as the log-ns (similar to how the java class name is usually used).
   88.40 +  Note: your log configuration should display the name that was passed to the
   88.41 +  logging implementation, and not perform stack-inspection, otherwise you'll see
   88.42 +  something like \"fn__72$impl_write_BANG__39__auto____81\" in your logs.
   88.43 +  
   88.44 +  Use the enabled? macro to write conditional code against the logging level
   88.45 +  (beyond simply whether or not to call log, which is handled automatically).
   88.46 +  
   88.47 +  You can redirect all java writes of System.out and System.err to the log
   88.48 +  system by calling log-capture!.  To rebind *out* and *err* to the log system
   88.49 +  invoke with-logs.  In both cases a log-ns (e.g., \"com.example.captured\")
   88.50 +  needs to be specified to namespace the output."}
   88.51 +  clojure.contrib.logging)
   88.52 +
   88.53 +(declare *impl-name* impl-get-log impl-enabled? impl-write!)
   88.54 +
   88.55 +;; Macros used so that implementation-specific functions all have the same meta.
   88.56 +
   88.57 +(defmacro def-impl-name
   88.58 +  {:private true} [& body]
   88.59 +  `(def
   88.60 +    ^{:doc "The name of the logging implementation used."}
   88.61 +    *impl-name*
   88.62 +    ~@body))
   88.63 +
   88.64 +(defmacro def-impl-get-log
   88.65 +  {:private true} [& body]
   88.66 +  `(def
   88.67 +    ^{:doc
   88.68 +  "Returns an implementation-specific log by string namespace. End-users should
   88.69 +  not need to call this."
   88.70 +       :arglist '([~'log-ns])}
   88.71 +    impl-get-log
   88.72 +    (memoize ~@body)))
   88.73 +
   88.74 +(defmacro def-impl-enabled?
   88.75 +  {:private true} [& body]
   88.76 +  `(def
   88.77 +    ^{:doc
   88.78 +  "Implementation-specific check if a particular level is enabled. End-users
   88.79 +  should not need to call this."
   88.80 +       :arglist '([~'log ~'level])}
   88.81 +    impl-enabled?
   88.82 +    ~@body))
   88.83 +
   88.84 +(defmacro def-impl-write!
   88.85 +  {:private true} [& body]
   88.86 +  `(def
   88.87 +    ^{:doc
   88.88 +  "Implementation-specific write of a log message. End-users should not need to
   88.89 +  call this."
   88.90 +       :arglist '([~'log ~'level ~'message ~'throwable])}
   88.91 +    impl-write!
   88.92 +    ~@body))
   88.93 +
   88.94 +(defn- commons-logging
   88.95 +  "Defines the commons-logging-based implementations of the core logging
   88.96 +  functions. End-users should never need to call this."
   88.97 +  []
   88.98 +  (try
   88.99 +    (import (org.apache.commons.logging LogFactory Log))
  88.100 +    (eval
  88.101 +      `(do
  88.102 +        (def-impl-name "org.apache.commons.logging")
  88.103 +        (def-impl-get-log
  88.104 +          (fn [log-ns#]
  88.105 +            (org.apache.commons.logging.LogFactory/getLog ^String log-ns#)))
  88.106 +        (def-impl-enabled?
  88.107 +          (fn [^org.apache.commons.logging.Log log# level#]
  88.108 +            (condp = level#
  88.109 +              :trace (.isTraceEnabled log#)
  88.110 +              :debug (.isDebugEnabled log#)
  88.111 +              :info  (.isInfoEnabled  log#)
  88.112 +              :warn  (.isWarnEnabled  log#)
  88.113 +              :error (.isErrorEnabled log#)
  88.114 +              :fatal (.isFatalEnabled log#))))
  88.115 +        (def-impl-write!
  88.116 +          (fn [^org.apache.commons.logging.Log log# level# msg# e#]
  88.117 +            (condp = level#
  88.118 +              :trace (.trace log# msg# e#)
  88.119 +              :debug (.debug log# msg# e#)
  88.120 +              :info  (.info  log# msg# e#)
  88.121 +              :warn  (.warn  log# msg# e#)
  88.122 +              :error (.error log# msg# e#)
  88.123 +              :fatal (.fatal log# msg# e#))))
  88.124 +        true))
  88.125 +    (catch Exception e nil)))
  88.126 +
  88.127 +
  88.128 +(defn- log4j-logging
  88.129 +  "Defines the log4j-based implementations of the core logging functions.
  88.130 +   End-users should never need to call this."
  88.131 +  []
  88.132 +  (try
  88.133 +    (import (org.apache.log4j Logger Level))
  88.134 +    (eval
  88.135 +      '(do
  88.136 +        (def-impl-name "org.apache.log4j")
  88.137 +        (def-impl-get-log
  88.138 +          (fn [log-ns#]
  88.139 +            (org.apache.log4j.Logger/getLogger ^String log-ns#)))
  88.140 +        (let [levels# {:trace org.apache.log4j.Level/TRACE
  88.141 +                       :debug org.apache.log4j.Level/DEBUG
  88.142 +                       :info  org.apache.log4j.Level/INFO
  88.143 +                       :warn  org.apache.log4j.Level/WARN
  88.144 +                       :error org.apache.log4j.Level/ERROR
  88.145 +                       :fatal org.apache.log4j.Level/FATAL}]
  88.146 +          (def-impl-enabled?
  88.147 +            (fn [^org.apache.log4j.Logger log# level#]
  88.148 +              (.isEnabledFor log# (levels# level#))))
  88.149 +          (def-impl-write!
  88.150 +            (fn [^org.apache.log4j.Logger log# level# msg# e#]
  88.151 +              (if-not e#
  88.152 +                (.log log# (levels# level#) msg#)
  88.153 +                (.log log# (levels# level#) msg# e#)))))
  88.154 +        true))
  88.155 +    (catch Exception e nil)))
  88.156 +
  88.157 +
  88.158 +(defn- java-logging
  88.159 +  "Defines the java-logging-based implementations of the core logging
  88.160 +  functions. End-users should never need to call this."
  88.161 +  []
  88.162 +  (try
  88.163 +    (import (java.util.logging Logger Level))
  88.164 +    (eval
  88.165 +      `(do
  88.166 +        (def-impl-name "java.util.logging")
  88.167 +        (def-impl-get-log
  88.168 +          (fn [log-ns#]
  88.169 +            (java.util.logging.Logger/getLogger log-ns#)))
  88.170 +        (let [levels# {:trace java.util.logging.Level/FINEST
  88.171 +                       :debug java.util.logging.Level/FINE
  88.172 +                       :info  java.util.logging.Level/INFO
  88.173 +                       :warn  java.util.logging.Level/WARNING
  88.174 +                       :error java.util.logging.Level/SEVERE
  88.175 +                       :fatal java.util.logging.Level/SEVERE}]
  88.176 +          (def-impl-enabled?
  88.177 +            (fn [^java.util.logging.Logger log# level#]
  88.178 +              (.isLoggable log# (levels# level#))))
  88.179 +          (def-impl-write!
  88.180 +            (fn [^java.util.logging.Logger log# level# msg# e#]
  88.181 +              (if-not e#
  88.182 +                (.log log# ^java.util.logging.Level (levels# level#)
  88.183 +                           ^String (str msg#))
  88.184 +                (.log log# ^java.util.logging.Level (levels# level#)
  88.185 +                           ^String (str msg#) ^Throwable e#)))))
  88.186 +        true))
  88.187 +    (catch Exception e nil)))
  88.188 +
  88.189 +
  88.190 +;; Initialize implementation-specific functions
  88.191 +(or (commons-logging)
  88.192 +    (log4j-logging)
  88.193 +    (java-logging)
  88.194 +    (throw ; this should never happen in 1.5+
  88.195 +      (RuntimeException.
  88.196 +        "Valid logging implementation could not be found.")))
  88.197 +
  88.198 +
  88.199 +(def ^{:doc
  88.200 +  "The default agent used for performing logging durng a transaction or when
  88.201 +  direct logging is disabled."}
  88.202 +  *logging-agent* (agent nil))
  88.203 +
  88.204 +
  88.205 +(def ^{:doc
  88.206 +  "A boolean indicating whether direct logging (as opposed to via an agent) is
  88.207 +  allowed when not operating from within a transaction. Defaults to true."}
  88.208 +  *allow-direct-logging* (atom true))
  88.209 +
  88.210 +
  88.211 +(defmacro log
  88.212 +  "Logs a message, either directly or via an agent. Also see the level-specific
  88.213 +  convenience macros."
  88.214 +  ([level message]
  88.215 +    `(log ~level ~message nil))
  88.216 +  ([level message throwable]
  88.217 +    `(log ~level ~message ~throwable ~(str *ns*)))
  88.218 +  ([level message throwable log-ns]
  88.219 +    `(let [log# (impl-get-log ~log-ns)]
  88.220 +      (if (impl-enabled? log# ~level)
  88.221 +        (if (and @*allow-direct-logging*
  88.222 +                 (not (clojure.lang.LockingTransaction/isRunning)))
  88.223 +          (impl-write! log# ~level ~message ~throwable)
  88.224 +          (send-off *logging-agent*
  88.225 +            (fn [_# l# v# m# t#] (impl-write! l# v# m# t#))
  88.226 +            log# ~level ~message ~throwable))))))
  88.227 +
  88.228 +
  88.229 +(defmacro enabled?
  88.230 +  "Returns true if the specific logging level is enabled.  Use of this function
  88.231 +  should only be necessary if one needs to execute alternate code paths beyond
  88.232 +  whether the log should be written to."
  88.233 +  ([level]
  88.234 +    `(enabled? ~level ~(str *ns*)))
  88.235 +  ([level log-ns]
  88.236 +    `(impl-enabled? (impl-get-log ~log-ns) ~level)))
  88.237 +
  88.238 +
  88.239 +(defmacro spy
  88.240 +  "Evaluates expr and outputs the form and its result to the debug log; returns 
  88.241 +  the result of expr."
  88.242 +  [expr]
  88.243 +  `(let [a# ~expr] (log :debug (str '~expr " => " a#)) a#))
  88.244 +
  88.245 +
  88.246 +(defn log-stream
  88.247 +  "Creates a PrintStream that will output to the log. End-users should not need
  88.248 +  to invoke this."
  88.249 +  [level log-ns]
  88.250 +  (java.io.PrintStream.
  88.251 +    (proxy [java.io.ByteArrayOutputStream] []
  88.252 +      (flush []
  88.253 +        (proxy-super flush)
  88.254 +        (let [s (.trim (.toString ^java.io.ByteArrayOutputStream this))]
  88.255 +          (proxy-super reset)
  88.256 +          (if (> (.length s) 0)
  88.257 +            (log level s nil log-ns)))))
  88.258 +    true))
  88.259 +
  88.260 +
  88.261 +(def ^{:doc
  88.262 +  "A ref used by log-capture! to maintain a reference to the original System.out
  88.263 +  and System.err streams."
  88.264 +  :private true}
  88.265 +  *old-std-streams* (ref nil))
  88.266 +
  88.267 +
  88.268 +(defn log-capture!
  88.269 +  "Captures System.out and System.err, redirecting all writes of those streams
  88.270 +  to :info and :error logging, respectively. The specified log-ns value will
  88.271 +  be used to namespace all redirected logging. NOTE: this will not redirect
  88.272 +  output of *out* or *err*; for that, use with-logs."
  88.273 +  [log-ns]
  88.274 +  (dosync
  88.275 +    (let [new-out (log-stream :info log-ns)
  88.276 +          new-err (log-stream :error log-ns)]
  88.277 +      ; don't overwrite the original values
  88.278 +      (if (nil? @*old-std-streams*)
  88.279 +        (ref-set *old-std-streams* {:out System/out :err System/err})) 
  88.280 +      (System/setOut new-out)
  88.281 +      (System/setErr new-err))))
  88.282 +
  88.283 +
  88.284 +(defn log-uncapture!
  88.285 +  "Restores System.out and System.err to their original values."
  88.286 +  []
  88.287 +  (dosync
  88.288 +    (when-let [{old-out :out old-err :err} @*old-std-streams*]
  88.289 +      (ref-set *old-std-streams* nil)
  88.290 +      (System/setOut old-out)
  88.291 +      (System/setErr old-err))))
  88.292 +
  88.293 +
  88.294 +(defmacro with-logs
  88.295 +  "Evaluates exprs in a context in which *out* and *err* are bound to :info and
  88.296 +  :error logging, respectively. The specified log-ns value will be used to
  88.297 +  namespace all redirected logging."
  88.298 +  [log-ns & body]
  88.299 +  (if (and log-ns (seq body))
  88.300 +    `(binding [*out* (java.io.OutputStreamWriter.
  88.301 +                       (log-stream :info ~log-ns))
  88.302 +               *err* (java.io.OutputStreamWriter.
  88.303 +                       (log-stream :error ~log-ns))]
  88.304 +      ~@body)))
  88.305 +
  88.306 +(defmacro trace
  88.307 +  "Logs a message at the trace level."
  88.308 +  ([message]
  88.309 +    `(log :trace ~message))
  88.310 +  ([message throwable]
  88.311 +    `(log :trace ~message ~throwable)))
  88.312 +
  88.313 +(defmacro debug
  88.314 +  "Logs a message at the debug level."
  88.315 +  ([message]
  88.316 +    `(log :debug ~message))
  88.317 +  ([message throwable]
  88.318 +    `(log :debug ~message ~throwable)))
  88.319 +
  88.320 +(defmacro info
  88.321 +  "Logs a message at the info level."
  88.322 +  ([message]
  88.323 +    `(log :info ~message))
  88.324 +  ([message throwable]
  88.325 +    `(log :info ~message ~throwable)))
  88.326 +
  88.327 +(defmacro warn
  88.328 +  "Logs a message at the warn level."
  88.329 +  ([message]
  88.330 +    `(log :warn ~message))
  88.331 +  ([message throwable]
  88.332 +    `(log :warn ~message ~throwable)))
  88.333 +
  88.334 +(defmacro error
  88.335 +  "Logs a message at the error level."
  88.336 +  ([message]
  88.337 +    `(log :error ~message))
  88.338 +  ([message throwable]
  88.339 +    `(log :error ~message ~throwable)))
  88.340 +
  88.341 +(defmacro fatal
  88.342 +  "Logs a message at the fatal level."
  88.343 +  ([message]
  88.344 +    `(log :fatal ~message))
  88.345 +  ([message throwable]
  88.346 +    `(log :fatal ~message ~throwable)))
    89.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    89.2 +++ b/src/clojure/contrib/macro_utils.clj	Sat Aug 21 06:25:44 2010 -0400
    89.3 @@ -0,0 +1,270 @@
    89.4 +;; Macrolet and symbol-macrolet
    89.5 +
    89.6 +;; by Konrad Hinsen
    89.7 +;; last updated January 14, 2010
    89.8 +
    89.9 +;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved.  The use
   89.10 +;; and distribution terms for this software are covered by the Eclipse
   89.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   89.12 +;; which can be found in the file epl-v10.html at the root of this
   89.13 +;; distribution.  By using this software in any fashion, you are
   89.14 +;; agreeing to be bound by the terms of this license.  You must not
   89.15 +;; remove this notice, or any other, from this software.
   89.16 +
   89.17 +(ns
   89.18 +  ^{:author "Konrad Hinsen"
   89.19 +     :doc "Local macros and symbol macros
   89.20 +
   89.21 +           Local macros are defined by a macrolet form. They are usable only
   89.22 +           inside its body. Symbol macros can be defined globally
   89.23 +           (defsymbolmacro) or locally (symbol-macrolet). A symbol
   89.24 +           macro defines a form that replaces a symbol during macro
   89.25 +           expansion. Function arguments and symbols bound in let
   89.26 +           forms are not subject to symbol macro expansion.
   89.27 +
   89.28 +           Local macros are most useful in the definition of the expansion
   89.29 +           of another macro, they may be used anywhere. Global symbol
   89.30 +           macros can be used only inside a with-symbol-macros form."}
   89.31 +  clojure.contrib.macro-utils
   89.32 +  (:use [clojure.contrib.def :only (defvar-)]))
   89.33 +
   89.34 +; A set of all special forms. Special forms are not macro-expanded, making
   89.35 +; it impossible to shadow them by macro definitions. For most special
   89.36 +; forms, all the arguments are simply macro-expanded, but some forms
   89.37 +; get special treatment.
   89.38 +(defvar- special-forms
   89.39 +  (into #{} (keys clojure.lang.Compiler/specials)))
   89.40 +; Value in the Clojure 1.2 branch:
   89.41 +; #{deftype* new quote & var set! monitor-enter recur . case* clojure.core/import* reify* do fn* throw monitor-exit letfn* finally let* loop* try catch if def}
   89.42 +
   89.43 +; The following three vars are constantly redefined using the binding
   89.44 +; form, imitating dynamic scoping.
   89.45 +;
   89.46 +; Local macros.
   89.47 +(defvar- macro-fns {})
   89.48 +; Local symbol macros.
   89.49 +(defvar- macro-symbols {})
   89.50 +; Symbols defined inside let forms or function arguments.
   89.51 +(defvar- protected-symbols #{})
   89.52 +
   89.53 +(defn- reserved?
   89.54 +  [symbol]
   89.55 +  "Return true if symbol is a reserved symbol (starting or ending with a dot)."
   89.56 +  (let [s (str symbol)]
   89.57 +    (or (= "." (subs s 0 1))
   89.58 +	(= "." (subs s (dec (count s)))))))
   89.59 +
   89.60 +(defn- expand-symbol
   89.61 +  "Expand symbol macros"
   89.62 +  [symbol]
   89.63 +  (cond (contains? protected-symbols symbol) symbol
   89.64 +	(reserved? symbol)                   symbol
   89.65 +	(contains? macro-symbols symbol)     (get macro-symbols symbol)
   89.66 +	:else (let [v (resolve symbol)
   89.67 +		    m (meta v)]
   89.68 +		(if (:symbol-macro m)
   89.69 +		  (var-get v)
   89.70 +		  symbol))))
   89.71 +
   89.72 +(defn- expand-1
   89.73 +  "Perform a single non-recursive macro expansion of form."
   89.74 +  [form]
   89.75 +  (cond
   89.76 +    (seq? form)
   89.77 +      (let [f (first form)]
   89.78 +        (cond (contains? special-forms f) form
   89.79 +	      (contains? macro-fns f)     (apply (get macro-fns f) (rest form))
   89.80 +	      (symbol? f)                 (let [exp (expand-symbol f)]
   89.81 +					    (if (= exp f)
   89.82 +					      (clojure.core/macroexpand-1 form)
   89.83 +					      (cons exp (rest form))))
   89.84 +	      ; handle defmacro macros and Java method special forms
   89.85 +	      :else (clojure.core/macroexpand-1 form)))
   89.86 +    (symbol? form)
   89.87 +      (expand-symbol form)
   89.88 +     :else
   89.89 +       form))
   89.90 +
   89.91 +(defn- expand
   89.92 +  "Perform repeated non-recursive macro expansion of form, until it no
   89.93 +   longer changes."
   89.94 +  [form]
   89.95 +  (let [ex (expand-1 form)]
   89.96 +    (if (identical? ex form)
   89.97 +      form
   89.98 +      (recur ex))))
   89.99 +
  89.100 +(declare expand-all)
  89.101 +
  89.102 +(defn- expand-args
  89.103 +  "Recursively expand the arguments of form, leaving its first
  89.104 +   n elements unchanged."
  89.105 +  ([form]
  89.106 +   (expand-args form 1))
  89.107 +  ([form n]
  89.108 +   (doall (concat (take n form) (map expand-all (drop n form))))))
  89.109 +
  89.110 +(defn- expand-bindings
  89.111 +  [bindings exprs]
  89.112 +  (if (empty? bindings)
  89.113 +    (list (doall (map expand-all exprs)))
  89.114 +    (let [[[s b] & bindings] bindings]
  89.115 +      (let [b (expand-all b)]
  89.116 +	(binding [protected-symbols (conj protected-symbols s)]
  89.117 +	  (doall (cons [s b] (expand-bindings bindings exprs))))))))
  89.118 +
  89.119 +(defn- expand-with-bindings
  89.120 +  "Handle let* and loop* forms. The symbols defined in them are protected
  89.121 +   from symbol macro expansion, the definitions and the body expressions
  89.122 +   are expanded recursively."
  89.123 +  [form]
  89.124 +  (let [f        (first form)
  89.125 +	bindings (partition 2 (second form))
  89.126 +	exprs    (rest (rest form))
  89.127 +	expanded (expand-bindings bindings exprs)
  89.128 +	bindings (vec (apply concat (butlast expanded)))
  89.129 +	exprs    (last expanded)]
  89.130 +    (cons f (cons bindings exprs))))
  89.131 +
  89.132 +(defn- expand-fn-body
  89.133 +  [[args & exprs]]
  89.134 +  (binding [protected-symbols (reduce conj protected-symbols
  89.135 +				     (filter #(not (= % '&)) args))]
  89.136 +    (cons args (doall (map expand-all exprs)))))
  89.137 +
  89.138 +(defn- expand-fn
  89.139 +  "Handle fn* forms. The arguments are protected from symbol macro
  89.140 +   expansion, the bodies are expanded recursively."
  89.141 +  [form]
  89.142 +  (let [[f & bodies] form
  89.143 +	name         (when (symbol? (first bodies)) (first bodies))
  89.144 +	bodies       (if (symbol? (first bodies)) (rest bodies) bodies)
  89.145 +	bodies       (if (vector? (first bodies)) (list bodies) bodies)
  89.146 +	bodies       (doall (map expand-fn-body bodies))]
  89.147 +    (if (nil? name)
  89.148 +      (cons f bodies)
  89.149 +      (cons f (cons name bodies)))))
  89.150 +
  89.151 +(defn- expand-method
  89.152 +  "Handle a method in a deftype* or reify* form."
  89.153 +  [m]
  89.154 +  (rest (expand-fn (cons 'fn* m))))
  89.155 +
  89.156 +(defn- expand-deftype
  89.157 +  "Handle deftype* forms."
  89.158 +  [[symbol typename classname fields implements interfaces & methods]]
  89.159 +  (assert (= implements :implements))
  89.160 +  (let [expanded-methods (map expand-method methods)]
  89.161 +    (concat
  89.162 +     (list symbol typename classname fields implements interfaces)
  89.163 +     expanded-methods)))
  89.164 +
  89.165 +(defn- expand-reify
  89.166 +  "Handle reify* forms."
  89.167 +  [[symbol interfaces & methods]]
  89.168 +  (let [expanded-methods (map expand-method methods)]
  89.169 +    (cons symbol (cons interfaces expanded-methods))))
  89.170 +
  89.171 +; Handlers for special forms that require special treatment. The default
  89.172 +; is expand-args.
  89.173 +(defvar- special-form-handlers
  89.174 +  {'quote 	  identity
  89.175 +   'var   	  identity
  89.176 +   'def   	  #(expand-args % 2)
  89.177 +   'new           #(expand-args % 2)
  89.178 +   'let*          expand-with-bindings
  89.179 +   'loop*         expand-with-bindings
  89.180 +   'fn*           expand-fn
  89.181 +   'deftype*      expand-deftype
  89.182 +   'reify*        expand-reify})
  89.183 +
  89.184 +(defn- expand-list
  89.185 +  "Recursively expand a form that is a list or a cons."
  89.186 +  [form]
  89.187 +  (let [f (first form)]
  89.188 +    (if (symbol? f)
  89.189 +      (if (contains? special-forms f)
  89.190 +	((get special-form-handlers f expand-args) form)
  89.191 +	(expand-args form))
  89.192 +      (doall (map expand-all form)))))
  89.193 +
  89.194 +(defn- expand-all
  89.195 +  "Expand a form recursively."
  89.196 +  [form]
  89.197 +  (let [exp (expand form)]
  89.198 +    (cond (symbol? exp) exp
  89.199 +	  (seq? exp) (expand-list exp)
  89.200 +	  (vector? exp) (into [] (map expand-all exp))
  89.201 +	  (map? exp) (into {} (map expand-all (seq exp)))
  89.202 +	  :else exp)))
  89.203 +
  89.204 +(defmacro macrolet
  89.205 +  "Define local macros that are used in the expansion of exprs. The
  89.206 +   syntax is the same as for letfn forms."
  89.207 +  [fn-bindings & exprs]
  89.208 +  (let [names      (map first fn-bindings)
  89.209 +	name-map   (into {} (map (fn [n] [(list 'quote n) n]) names))
  89.210 +	macro-map  (eval `(letfn ~fn-bindings ~name-map))]
  89.211 +    (binding [macro-fns     (merge macro-fns macro-map)
  89.212 +	      macro-symbols (apply dissoc macro-symbols names)]
  89.213 +      `(do ~@(doall (map expand-all exprs))))))
  89.214 +
  89.215 +(defmacro symbol-macrolet
  89.216 +  "Define local symbol macros that are used in the expansion of exprs.
  89.217 +   The syntax is the same as for let forms."
  89.218 +  [symbol-bindings & exprs]
  89.219 +  (let [symbol-map (into {} (map vec (partition 2 symbol-bindings)))
  89.220 +	names      (keys symbol-map)]
  89.221 +    (binding [macro-fns     (apply dissoc macro-fns names)
  89.222 +	      macro-symbols (merge macro-symbols symbol-map)]
  89.223 +      `(do ~@(doall (map expand-all exprs))))))
  89.224 +
  89.225 +(defmacro defsymbolmacro
  89.226 +  "Define a symbol macro. Because symbol macros are not part of
  89.227 +   Clojure's built-in macro expansion system, they can be used only
  89.228 +   inside a with-symbol-macros form."
  89.229 +  [symbol expansion]
  89.230 +  (let [meta-map (if (meta symbol) (meta symbol) {})
  89.231 +	meta-map (assoc meta-map :symbol-macro true)]
  89.232 +  `(def ~(with-meta symbol meta-map) (quote ~expansion))))
  89.233 +
  89.234 +(defmacro with-symbol-macros
  89.235 +  "Fully expand exprs, including symbol macros."
  89.236 +  [& exprs]
  89.237 +  `(do ~@(doall (map expand-all exprs))))
  89.238 +
  89.239 +(defmacro deftemplate
  89.240 +  "Define a macro that expands into forms after replacing the
  89.241 +   symbols in params (a vector) by the corresponding parameters
  89.242 +   given in the macro call."
  89.243 +  [name params & forms]
  89.244 +  (let [param-map (for [p params] (list (list 'quote p) (gensym)))
  89.245 +	template-params (vec (map second param-map))
  89.246 +	param-map (vec (apply concat param-map))
  89.247 +	expansion (list 'list (list 'quote `symbol-macrolet) param-map
  89.248 +			(list 'quote (cons 'do forms)))]
  89.249 +    `(defmacro ~name ~template-params ~expansion)))
  89.250 +
  89.251 +(defn mexpand-1
  89.252 +  "Like clojure.core/macroexpand-1, but takes into account symbol macros."
  89.253 +  [form]
  89.254 +  (binding [macro-fns {}
  89.255 +	    macro-symbols {}
  89.256 +	    protected-symbols #{}]
  89.257 +    (expand-1 form)))
  89.258 +
  89.259 +(defn mexpand
  89.260 +  "Like clojure.core/macroexpand, but takes into account symbol macros."
  89.261 +  [form]
  89.262 +  (binding [macro-fns {}
  89.263 +	    macro-symbols {}
  89.264 +	    protected-symbols #{}]
  89.265 +    (expand form)))
  89.266 +
  89.267 +(defn mexpand-all
  89.268 +  "Perform a full recursive macro expansion of a form."
  89.269 +  [form]
  89.270 +  (binding [macro-fns {}
  89.271 +	    macro-symbols {}
  89.272 +	    protected-symbols #{}]
  89.273 +    (expand-all form)))
    90.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    90.2 +++ b/src/clojure/contrib/macros.clj	Sat Aug 21 06:25:44 2010 -0400
    90.3 @@ -0,0 +1,84 @@
    90.4 +;; Various useful macros
    90.5 +;;
    90.6 +;; Everybody is invited to add their own little macros here!
    90.7 +;;
    90.8 +;; The use and distribution terms for this software are covered by the
    90.9 +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   90.10 +;; which can be found in the file epl-v10.html at the root of this
   90.11 +;; distribution. By using this software in any fashion, you are
   90.12 +;; agreeing to be bound by the terms of this license. You must not
   90.13 +;; remove this notice, or any other, from this software.
   90.14 +
   90.15 +(ns
   90.16 +  ^{:author "Konrad Hinsen"
   90.17 +     :doc "Various small macros"}
   90.18 +  clojure.contrib.macros)
   90.19 +
   90.20 +;; By Konrad Hinsen
   90.21 +(defmacro const
   90.22 +  "Evaluate the constant expression expr at compile time."
   90.23 +  [expr]
   90.24 +  (eval expr))
   90.25 +
   90.26 +;; By Konrad Hinsen
   90.27 +; This macro is made obsolete by Clojure's built-in letfn. I renamed it to
   90.28 +; letfn- (to avoid a name clash) but leave it in for a while, since its
   90.29 +; syntax is not quite the same as Clojure's. Expect this to disappear
   90.30 +; in the long run!
   90.31 +(defmacro letfn-
   90.32 +  "OBSOLETE: use clojure.core/letfn
   90.33 +   A variant of let for local function definitions. fn-bindings consists
   90.34 +   of name/args/body triples, with (letfn [name args body] ...)
   90.35 +   being equivalent to (let [name (fn name args body)] ...)."
   90.36 +  [fn-bindings & exprs]
   90.37 +  (let [makefn (fn [[name args body]] (list name (list 'fn name args body)))
   90.38 +	fns (vec (apply concat (map makefn (partition 3 fn-bindings))))]
   90.39 +  `(let ~fns ~@exprs)))
   90.40 +
   90.41 + ;; By Konrad Hinsen
   90.42 +
   90.43 + (defn- unqualified-symbol
   90.44 +  [s]
   90.45 +  (let [s-str (str s)]
   90.46 +    (symbol (subs s-str (inc (.indexOf s-str (int \/)))))))
   90.47 + 
   90.48 +(defn- bound-var?
   90.49 +  [var]
   90.50 +  (try
   90.51 +    (do (deref var) true)
   90.52 +    (catch java.lang.IllegalStateException e false)))
   90.53 +
   90.54 +(defn- fns-from-ns
   90.55 +  [ns ns-symbol]
   90.56 +  (apply concat
   90.57 +    (for [[k v] (ns-publics ns)
   90.58 +          :when (and (bound-var? v)
   90.59 +                     (fn? @v)
   90.60 +                     (not (:macro (meta v))))]
   90.61 +       [k (symbol (str ns-symbol) (str k))])))
   90.62 +
   90.63 +(defn- expand-symbol
   90.64 +  [ns-or-var-sym]
   90.65 +  (if (= ns-or-var-sym '*ns*)
   90.66 +    (fns-from-ns *ns* (ns-name *ns*))
   90.67 +    (if-let [ns (find-ns ns-or-var-sym)]
   90.68 +      (fns-from-ns ns ns-or-var-sym)
   90.69 +      (list (unqualified-symbol ns-or-var-sym) ns-or-var-sym))))
   90.70 +
   90.71 +(defmacro with-direct-linking
   90.72 +  "EXPERIMENTAL!
   90.73 +   Compiles the functions in body with direct links to the functions
   90.74 +   named in symbols, i.e. without a var lookup for each invocation.
   90.75 +   Symbols is a vector of symbols that name either vars or namespaces.
   90.76 +   A namespace reference is replaced by the list of all symbols in the
   90.77 +   namespace that are bound to functions. If symbols is not provided,
   90.78 +   the default value ['clojure.core] is used. The symbol *ns* can be
   90.79 +   used to refer to the current namespace."
   90.80 +  {:arglists '([symbols? & body])}
   90.81 +  [& body]
   90.82 +  (let [[symbols body] (if (vector? (first body))
   90.83 +                         [(first body) (rest body)]
   90.84 +                         [['clojure.core] body])
   90.85 +  			bindings (vec (mapcat expand-symbol symbols))]
   90.86 +    `(let ~bindings ~@body)))
   90.87 + 
   90.88 \ No newline at end of file
    91.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    91.2 +++ b/src/clojure/contrib/map_utils.clj	Sat Aug 21 06:25:44 2010 -0400
    91.3 @@ -0,0 +1,55 @@
    91.4 +;;  Copyright (c) Jason Wolfe. All rights reserved.  The use and
    91.5 +;;  distribution terms for this software are covered by the Eclipse Public
    91.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    91.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    91.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    91.9 +;;  terms of this license.  You must not remove this notice, or any other,
   91.10 +;;  from this software.
   91.11 +;;
   91.12 +;;  map_utils.clj
   91.13 +;;
   91.14 +;;  Utilities for operating on Clojure maps.
   91.15 +;;
   91.16 +;;  jason at w01fe dot com
   91.17 +;;  Created 25 Feb 2009
   91.18 +
   91.19 +(ns 
   91.20 +  ^{:author "Jason Wolfe, Chris Houser",
   91.21 +     :doc "Utilities for operating on Clojure maps."}
   91.22 +  clojure.contrib.map-utils)
   91.23 +
   91.24 +
   91.25 +(defmacro lazy-get 
   91.26 +  "Like get, but doesn't evaluate not-found unless it is needed."
   91.27 +  [map key not-found]
   91.28 +  `(if-let [pair# (find ~map ~key)] 
   91.29 +       (val pair#)
   91.30 +     ~not-found))
   91.31 +
   91.32 +(defn safe-get 
   91.33 +  "Like get, but throws an exception if the key is not found."
   91.34 +  [map key] 
   91.35 +  (lazy-get map key 
   91.36 +   (throw (IllegalArgumentException. (format "Key %s not found in %s" key map)))))
   91.37 +
   91.38 +(defn safe-get-in 
   91.39 +  "Like get-in, but throws an exception if any key is not found."
   91.40 +  [map ks]
   91.41 +  (reduce safe-get map ks))
   91.42 +
   91.43 +; by Chouser:
   91.44 +(defn deep-merge-with
   91.45 +  "Like merge-with, but merges maps recursively, applying the given fn
   91.46 +  only when there's a non-map at a particular level.
   91.47 +
   91.48 +  (deepmerge + {:a {:b {:c 1 :d {:x 1 :y 2}} :e 3} :f 4}
   91.49 +               {:a {:b {:c 2 :d {:z 9} :z 3} :e 100}})
   91.50 +  -> {:a {:b {:z 3, :c 3, :d {:z 9, :x 1, :y 2}}, :e 103}, :f 4}"
   91.51 +  [f & maps]
   91.52 +  (apply
   91.53 +    (fn m [& maps]
   91.54 +      (if (every? map? maps)
   91.55 +        (apply merge-with m maps)
   91.56 +        (apply f maps)))
   91.57 +    maps))
   91.58 +
    92.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    92.2 +++ b/src/clojure/contrib/math.clj	Sat Aug 21 06:25:44 2010 -0400
    92.3 @@ -0,0 +1,247 @@
    92.4 +;;; math.clj: math functions that deal intelligently with the various
    92.5 +;;; types in Clojure's numeric tower, as well as math functions
    92.6 +;;; commonly found in Scheme implementations.
    92.7 +
    92.8 +;; by Mark Engelberg (mark.engelberg@gmail.com)
    92.9 +;; January 17, 2009
   92.10 +
   92.11 +;; expt - (expt x y) is x to the yth power, returns an exact number
   92.12 +;;   if the base is an exact number, and the power is an integer,
   92.13 +;;   otherwise returns a double.
   92.14 +;; abs - (abs n) is the absolute value of n
   92.15 +;; gcd - (gcd m n) returns the greatest common divisor of m and n
   92.16 +;; lcm - (lcm m n) returns the least common multiple of m and n
   92.17 +
   92.18 +;; The behavior of the next three functions on doubles is consistent
   92.19 +;; with the behavior of the corresponding functions
   92.20 +;; in Java's Math library, but on exact numbers, returns an integer.
   92.21 +
   92.22 +;; floor - (floor n) returns the greatest integer less than or equal to n.
   92.23 +;;   If n is an exact number, floor returns an integer,
   92.24 +;;   otherwise a double.
   92.25 +;; ceil - (ceil n) returns the least integer greater than or equal to n.
   92.26 +;;   If n is an exact number, ceil returns an integer,
   92.27 +;;   otherwise a double.
   92.28 +;; round - (round n) rounds to the nearest integer.
   92.29 +;;   round always returns an integer.  round rounds up for values
   92.30 +;;   exactly in between two integers.
   92.31 +
   92.32 +
   92.33 +;; sqrt - Implements the sqrt behavior I'm accustomed to from PLT Scheme,
   92.34 +;;   specifically, if the input is an exact number, and is a square
   92.35 +;;   of an exact number, the output will be exact.  The downside
   92.36 +;;   is that for the common case (inexact square root), some extra
   92.37 +;;   computation is done to look for an exact square root first.
   92.38 +;;   So if you need blazingly fast square root performance, and you
   92.39 +;;   know you're just going to need a double result, you're better
   92.40 +;;   off calling java's Math/sqrt, or alternatively, you could just
   92.41 +;;   convert your input to a double before calling this sqrt function.
   92.42 +;;   If Clojure ever gets complex numbers, then this function will
   92.43 +;;   need to be updated (so negative inputs yield complex outputs).
   92.44 +;; exact-integer-sqrt - Implements a math function from the R6RS Scheme
   92.45 +;;   standard.  (exact-integer-sqrt k) where k is a non-negative integer,
   92.46 +;;   returns [s r] where k = s^2+r and k < (s+1)^2.  In other words, it
   92.47 +;;   returns the floor of the square root and the "remainder".
   92.48 +
   92.49 +(ns 
   92.50 +  ^{:author "Mark Engelberg",
   92.51 +     :doc "Math functions that deal intelligently with the various
   92.52 +types in Clojure's numeric tower, as well as math functions
   92.53 +commonly found in Scheme implementations.
   92.54 +
   92.55 +expt - (expt x y) is x to the yth power, returns an exact number
   92.56 +  if the base is an exact number, and the power is an integer,
   92.57 +  otherwise returns a double.
   92.58 +abs - (abs n) is the absolute value of n
   92.59 +gcd - (gcd m n) returns the greatest common divisor of m and n
   92.60 +lcm - (lcm m n) returns the least common multiple of m and n
   92.61 +
   92.62 +The behavior of the next three functions on doubles is consistent
   92.63 +with the behavior of the corresponding functions
   92.64 +in Java's Math library, but on exact numbers, returns an integer.
   92.65 +
   92.66 +floor - (floor n) returns the greatest integer less than or equal to n.
   92.67 +  If n is an exact number, floor returns an integer,
   92.68 +  otherwise a double.
   92.69 +ceil - (ceil n) returns the least integer greater than or equal to n.
   92.70 +  If n is an exact number, ceil returns an integer,
   92.71 +  otherwise a double.
   92.72 +round - (round n) rounds to the nearest integer.
   92.73 +  round always returns an integer.  round rounds up for values
   92.74 +  exactly in between two integers.
   92.75 +
   92.76 +
   92.77 +sqrt - Implements the sqrt behavior I'm accustomed to from PLT Scheme,
   92.78 +  specifically, if the input is an exact number, and is a square
   92.79 +  of an exact number, the output will be exact.  The downside
   92.80 +  is that for the common case (inexact square root), some extra
   92.81 +  computation is done to look for an exact square root first.
   92.82 +  So if you need blazingly fast square root performance, and you
   92.83 +  know you're just going to need a double result, you're better
   92.84 +  off calling java's Math/sqrt, or alternatively, you could just
   92.85 +  convert your input to a double before calling this sqrt function.
   92.86 +  If Clojure ever gets complex numbers, then this function will
   92.87 +  need to be updated (so negative inputs yield complex outputs).
   92.88 +exact-integer-sqrt - Implements a math function from the R6RS Scheme
   92.89 +  standard.  (exact-integer-sqrt k) where k is a non-negative integer,
   92.90 +  returns [s r] where k = s^2+r and k < (s+1)^2.  In other words, it
   92.91 +  returns the floor of the square root and the "remainder".
   92.92 +"}
   92.93 +  clojure.contrib.math)
   92.94 +
   92.95 +(derive ::integer ::exact)
   92.96 +(derive java.lang.Integer ::integer)
   92.97 +(derive java.math.BigInteger ::integer)
   92.98 +(derive java.lang.Long ::integer)
   92.99 +(derive java.math.BigDecimal ::exact)
  92.100 +(derive clojure.lang.Ratio ::exact)
  92.101 +(derive java.lang.Double ::inexact)
  92.102 +(derive java.lang.Float ::inexact)
  92.103 +
  92.104 +(defmulti ^{:arglists '([base pow])
  92.105 +	     :doc "(expt base pow) is base to the pow power.
  92.106 +Returns an exact number if the base is an exact number and the power is an integer, otherwise returns a double."}
  92.107 +  expt (fn [x y] [(class x) (class y)]))
  92.108 +
  92.109 +(defn- expt-int [base pow]
  92.110 +  (loop [n pow, y (num 1), z base]
  92.111 +    (let [t (bit-and n 1), n (bit-shift-right n 1)]
  92.112 +      (cond
  92.113 +       (zero? t) (recur n y (* z z))
  92.114 +       (zero? n) (* z y)
  92.115 +       :else (recur n (* z y) (* z z))))))
  92.116 +
  92.117 +(defmethod expt [::exact ::integer] [base pow]
  92.118 +  (cond
  92.119 +   (pos? pow) (expt-int base pow)
  92.120 +   (zero? pow) 1
  92.121 +   :else (/ 1 (expt-int base (- pow)))))
  92.122 +
  92.123 +(defmethod expt :default [base pow] (Math/pow base pow))
  92.124 +
  92.125 +(defn abs "(abs n) is the absolute value of n" [n]
  92.126 +  (cond
  92.127 +   (not (number? n)) (throw (IllegalArgumentException.
  92.128 +			     "abs requires a number"))
  92.129 +   (neg? n) (- n)
  92.130 +   :else n))
  92.131 +
  92.132 +(defmulti ^{:arglists '([n])
  92.133 +	     :doc "(floor n) returns the greatest integer less than or equal to n.
  92.134 +If n is an exact number, floor returns an integer, otherwise a double."}
  92.135 +  floor class)
  92.136 +(defmethod floor ::integer [n] n)
  92.137 +(defmethod floor java.math.BigDecimal [n] (.. n (setScale 0 BigDecimal/ROUND_FLOOR) (toBigInteger)))
  92.138 +(defmethod floor clojure.lang.Ratio [n]
  92.139 +  (if (pos? n) (quot (. n numerator) (. n denominator))
  92.140 +      (dec (quot (. n numerator) (. n denominator)))))
  92.141 +(defmethod floor :default [n]
  92.142 +  (Math/floor n))
  92.143 +
  92.144 +(defmulti ^{:arglists '([n])
  92.145 +	     :doc "(ceil n) returns the least integer greater than or equal to n.
  92.146 +If n is an exact number, ceil returns an integer, otherwise a double."}
  92.147 +  ceil class)
  92.148 +(defmethod ceil ::integer [n] n)
  92.149 +(defmethod ceil java.math.BigDecimal [n] (.. n (setScale 0 BigDecimal/ROUND_CEILING) (toBigInteger)))
  92.150 +(defmethod ceil clojure.lang.Ratio [n]
  92.151 +  (if (pos? n) (inc (quot (. n numerator) (. n denominator)))
  92.152 +      (quot (. n numerator) (. n denominator))))
  92.153 +(defmethod ceil :default [n]
  92.154 +  (Math/ceil n))
  92.155 +
  92.156 +(defmulti ^{:arglists '([n])
  92.157 +	     :doc "(round n) rounds to the nearest integer.
  92.158 +round always returns an integer.  Rounds up for values exactly in between two integers."}
  92.159 +  round class)
  92.160 +(defmethod round ::integer [n] n)
  92.161 +(defmethod round java.math.BigDecimal [n] (floor (+ n 0.5M)))
  92.162 +(defmethod round clojure.lang.Ratio [n] (floor (+ n 1/2)))
  92.163 +(defmethod round :default [n] (Math/round n))
  92.164 +
  92.165 +(defn gcd "(gcd a b) returns the greatest common divisor of a and b" [a b]
  92.166 +  (if (or (not (integer? a)) (not (integer? b)))
  92.167 +    (throw (IllegalArgumentException. "gcd requires two integers"))  
  92.168 +    (loop [a (abs a) b (abs b)]
  92.169 +      (if (zero? b) a,
  92.170 +	  (recur b (mod a b))))))
  92.171 +
  92.172 +(defn lcm
  92.173 +  "(lcm a b) returns the least common multiple of a and b"
  92.174 +  [a b]
  92.175 +  (when (or (not (integer? a)) (not (integer? b)))
  92.176 +    (throw (IllegalArgumentException. "lcm requires two integers")))
  92.177 +  (cond (zero? a) 0
  92.178 +        (zero? b) 0
  92.179 +        :else (abs (* b (quot a (gcd a b))))))
  92.180 +
  92.181 +; Length of integer in binary, used as helper function for sqrt.
  92.182 +(defmulti ^{:private true} integer-length class)
  92.183 +(defmethod integer-length java.lang.Integer [n]
  92.184 +  (count (Integer/toBinaryString n)))
  92.185 +(defmethod integer-length java.lang.Long [n]
  92.186 +  (count (Long/toBinaryString n)))
  92.187 +(defmethod integer-length java.math.BigInteger [n]
  92.188 +  (count (. n toString 2)))
  92.189 +
  92.190 +;; Produces the largest integer less than or equal to the square root of n
  92.191 +;; Input n must be a non-negative integer
  92.192 +(defn- integer-sqrt [n]
  92.193 +  (cond
  92.194 +   (> n 24)
  92.195 +   (let [n-len (integer-length n)]
  92.196 +     (loop [init-value (if (even? n-len)
  92.197 +			 (bit-shift-left 1 (bit-shift-right n-len 1))
  92.198 +			 (bit-shift-left 2 (bit-shift-right n-len 1)))]
  92.199 +       (let [iterated-value (bit-shift-right (+ init-value (quot n init-value)) 1)]
  92.200 +	 (if (>= iterated-value init-value)
  92.201 +	   init-value
  92.202 +	   (recur iterated-value)))))
  92.203 +   (> n 15) 4
  92.204 +   (> n  8) 3
  92.205 +   (> n  3) 2
  92.206 +   (> n  0) 1
  92.207 +   (> n -1) 0))
  92.208 +
  92.209 +(defn exact-integer-sqrt "(exact-integer-sqrt n) expects a non-negative integer n, and returns [s r] where n = s^2+r and n < (s+1)^2.  In other words, it returns the floor of the square root and the 'remainder'.
  92.210 +For example, (exact-integer-sqrt 15) is [3 6] because 15 = 3^2+6."
  92.211 +  [n]
  92.212 +  (if (or (not (integer? n)) (neg? n))
  92.213 +    (throw (IllegalArgumentException. "exact-integer-sqrt requires a non-negative integer"))
  92.214 +    (let [isqrt (integer-sqrt n),
  92.215 +	  error (- n (* isqrt isqrt))]
  92.216 +      [isqrt error])))
  92.217 +
  92.218 +(defmulti ^{:arglists '([n])
  92.219 +	     :doc "Square root, but returns exact number if possible."}
  92.220 +  sqrt class)
  92.221 +(defmethod sqrt ::integer [n]
  92.222 +  (if (neg? n) Double/NaN
  92.223 +      (let [isqrt (integer-sqrt n),
  92.224 +	    error (- n (* isqrt isqrt))]
  92.225 +	(if (zero? error) isqrt
  92.226 +	    (Math/sqrt n)))))
  92.227 +
  92.228 +(defmethod sqrt clojure.lang.Ratio [n]
  92.229 +  (if (neg? n) Double/NaN
  92.230 +      (let [numerator (.numerator n),
  92.231 +	    denominator (.denominator n),
  92.232 +	    sqrtnum (sqrt numerator)]
  92.233 +	(if (float? sqrtnum)
  92.234 +	  (Math/sqrt n)
  92.235 +	  (let [sqrtden (sqrt denominator)]
  92.236 +	    (if (float? sqrtnum)
  92.237 +	      (Math/sqrt n)
  92.238 +	      (/ sqrtnum sqrtden)))))))
  92.239 +
  92.240 +(defmethod sqrt java.math.BigDecimal [n]
  92.241 +  (if (neg? n) Double/NaN
  92.242 +      (let [frac (rationalize n),
  92.243 +	    sqrtfrac (sqrt frac)]
  92.244 +	(if (ratio? sqrtfrac)
  92.245 +	  (/ (BigDecimal. (.numerator sqrtfrac))
  92.246 +	     (BigDecimal. (.denominator sqrtfrac)))
  92.247 +	  sqrtfrac))))
  92.248 +
  92.249 +(defmethod sqrt :default [n]
  92.250 +  (Math/sqrt n))
    93.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    93.2 +++ b/src/clojure/contrib/miglayout.clj	Sat Aug 21 06:25:44 2010 -0400
    93.3 @@ -0,0 +1,79 @@
    93.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    93.5 +;;  distribution terms for this software are covered by the Eclipse Public
    93.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    93.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    93.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    93.9 +;;  terms of this license.  You must not remove this notice, or any other,
   93.10 +;;  from this software.
   93.11 +;;
   93.12 +;;  clojure.contrib.miglayout
   93.13 +;;
   93.14 +;;  Clojure support for the MiGLayout layout manager
   93.15 +;;  http://www.miglayout.com/
   93.16 +;;
   93.17 +;;  Example:
   93.18 +;;
   93.19 +;;    (use '[clojure.contrib.miglayout.test :as mlt :only ()])
   93.20 +;;    (dotimes [i 5] (mlt/run-test i))
   93.21 +;;
   93.22 +;;  scgilardi (gmail)
   93.23 +;;  Created 5 October 2008
   93.24 +
   93.25 +(ns 
   93.26 +    ^{:author "Stephen C. Gilardi",
   93.27 +       :doc "Clojure support for the MiGLayout layout manager
   93.28 +http://www.miglayout.com/
   93.29 +
   93.30 +Example:
   93.31 +
   93.32 +  (use '[clojure.contrib.miglayout.test :as mlt :only ()])
   93.33 +  (dotimes [i 5] (mlt/run-test i))
   93.34 +
   93.35 +"}
   93.36 +  clojure.contrib.miglayout
   93.37 +  (:import javax.swing.JComponent)
   93.38 +  (:use clojure.contrib.miglayout.internal))
   93.39 +
   93.40 +(defn miglayout
   93.41 +  "Adds java.awt.Components to a javax.swing.JComponent with constraints
   93.42 +  formatted for the MiGLayout layout manager.
   93.43 +
   93.44 +  Arguments: container [item constraint*]*
   93.45 +
   93.46 +    - container: the container for the specified components, its layout
   93.47 +      manager will be set to a new instance of MigLayout
   93.48 +
   93.49 +    - an inline series of items and constraints--each item may be followed
   93.50 +      by zero or more constraints.
   93.51 +
   93.52 +  Item:
   93.53 +
   93.54 +    - An item is either a Component or one of the keywords :layout
   93.55 +     :column or :row. Constraints for a keyword item affect the entire
   93.56 +      layout.
   93.57 +
   93.58 +  Constraint: string, keyword, vector, map, or set
   93.59 +
   93.60 +    - A string specifies one or more constraints each with zero or more
   93.61 +      arguments.
   93.62 +    - A keyword specifies a single constraint without arguments
   93.63 +    - A vector specifies a single constraint with one or more arguments
   93.64 +    - A map specifies one or more constraints as keys, each mapped to a
   93.65 +      single argument
   93.66 +    - A set groups two or more constraints, each a string, keyword,
   93.67 +      vector, map, or set
   93.68 +
   93.69 +  Any items marked with an \"id\" constraint will be included in a map from
   93.70 +  id to component attached to the container. The map can be retrieved using
   93.71 +  clojure.contrib.miglayout/components."
   93.72 +  [^JComponent container & args]
   93.73 +  (let [item-constraints (apply parse-item-constraints args)
   93.74 +        {:keys [keywords components]} item-constraints
   93.75 +        {:keys [layout column row]} keywords]
   93.76 +    (do-layout container layout column row components)))
   93.77 +
   93.78 +(defn components
   93.79 +  "Returns a map from id (a keyword) to component for all components with
   93.80 +  an id constraint set"
   93.81 +  [^JComponent container]
   93.82 +  (get-components container))
    94.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    94.2 +++ b/src/clojure/contrib/miglayout/internal.clj	Sat Aug 21 06:25:44 2010 -0400
    94.3 @@ -0,0 +1,120 @@
    94.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
    94.5 +;;  distribution terms for this software are covered by the Eclipse Public
    94.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
    94.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
    94.8 +;;  using this software in any fashion, you are agreeing to be bound by the
    94.9 +;;  terms of this license.  You must not remove this notice, or any other,
   94.10 +;;  from this software.
   94.11 +;;
   94.12 +;;  clojure.contrib.miglayout.internal
   94.13 +;;
   94.14 +;;  Internal functions for 'clojure.contrib.miglayout
   94.15 +;;
   94.16 +;;  scgilardi (gmail)
   94.17 +;;  Created 13 October 2008
   94.18 +
   94.19 +(ns clojure.contrib.miglayout.internal
   94.20 +  (:import (clojure.lang RT Reflector)
   94.21 +           java.awt.Component
   94.22 +           javax.swing.JComponent)
   94.23 +  (:use (clojure.contrib
   94.24 +         [core :only (new-by-name)]
   94.25 +         [except :only (throwf)]
   94.26 +         [fcase :only (fcase)]
   94.27 +         [string :only (as-str)])))
   94.28 +
   94.29 +(def MigLayout "net.miginfocom.swing.MigLayout")
   94.30 +(def LayoutCallback "net.miginfocom.layout.LayoutCallback")
   94.31 +(def ConstraintParser "net.miginfocom.layout.ConstraintParser")
   94.32 +
   94.33 +(declare format-constraints)
   94.34 +
   94.35 +(defn format-constraint
   94.36 +  "Returns a vector of vectors representing one or more constraints
   94.37 +  separated by commas. Constraints may be specified in Clojure using
   94.38 +  strings, keywords, vectors, maps, and/or sets."
   94.39 +  [c]
   94.40 +  [[", "]
   94.41 +   (fcase #(%1 %2) c
   94.42 +     string?  [c]
   94.43 +     keyword? [c]
   94.44 +     vector?  (interpose " " c)
   94.45 +     map?     (apply concat (interpose [", "] (map #(interpose " " %) c)))
   94.46 +     set?     (apply concat (interpose [", "] (map format-constraints c)))
   94.47 +     (throwf IllegalArgumentException
   94.48 +             "unrecognized constraint: %s (%s)" c (class c)))])
   94.49 +
   94.50 +(defn format-constraints
   94.51 +  "Returns a string representing all the constraints for one keyword-item
   94.52 +  or component formatted for miglayout."
   94.53 +  [& constraints]
   94.54 +  (let [formatted
   94.55 +        (apply str
   94.56 +          (map as-str
   94.57 +            (rest (reduce concat []
   94.58 +              (mapcat format-constraint constraints)))))]
   94.59 +;;  (prn formatted)
   94.60 +    formatted))
   94.61 +
   94.62 +(defn component?
   94.63 +  "Returns true if x is a java.awt.Component"
   94.64 +  [x]
   94.65 +  (instance? Component x))
   94.66 +
   94.67 +(defn constraint?
   94.68 +  "Returns true if x is not a keyword-item or component"
   94.69 +  [x]
   94.70 +  (not
   94.71 +   (or (component? x)
   94.72 +       (#{:layout :column :row} x))))
   94.73 +
   94.74 +(defn parse-item-constraints
   94.75 +  "Iterates over args and builds a map containing values associated with
   94.76 +  :keywords and :components. The value for :keywords is a map from keyword
   94.77 +  items to constraints strings. The value for :components is a vector of
   94.78 +  vectors each associating a component with its constraints string."
   94.79 +  [& args]
   94.80 +  (loop [[item & args] args
   94.81 +         item-constraints {:keywords {} :components []}]
   94.82 +    (if item
   94.83 +      (let [[constraints args] (split-with constraint? args)]
   94.84 +        (recur args
   94.85 +          (update-in
   94.86 +           item-constraints
   94.87 +           [(if (component? item) :components :keywords)]
   94.88 +           conj [item (apply format-constraints constraints)])))
   94.89 +      item-constraints)))
   94.90 +
   94.91 +(defn parse-component-constraint
   94.92 +  "Parses a component constraint string returning a CC object"
   94.93 +  [constraint]
   94.94 +  (Reflector/invokeStaticMethod
   94.95 +   ConstraintParser "parseComponentConstraint" (into-array [constraint])))
   94.96 +
   94.97 +(defn add-components
   94.98 +  "Adds components with constraints to a container"
   94.99 +  [^JComponent container components]
  94.100 +  (loop [[[^Component component constraint] & components] components
  94.101 +         id-map nil]
  94.102 +    (if component
  94.103 +      (let [cc (parse-component-constraint constraint)]
  94.104 +        (.add container component cc)
  94.105 +        (recur
  94.106 +         components
  94.107 +         (if-let [id (.getId cc)]
  94.108 +           (assoc id-map (keyword id) component)
  94.109 +           id-map)))
  94.110 +      (doto container (.putClientProperty ::components id-map)))))
  94.111 +
  94.112 +(defn get-components
  94.113 +  "Returns a map from id to component for all components with an id"
  94.114 +  [^JComponent container]
  94.115 +  (.getClientProperty container ::components))
  94.116 +
  94.117 +(defn do-layout
  94.118 +  "Attaches a MigLayout layout manager to container and adds components
  94.119 +  with constraints"
  94.120 +  [^JComponent container layout column row components]
  94.121 +  (doto container
  94.122 +    (.setLayout (new-by-name MigLayout layout column row))
  94.123 +    (add-components components)))
    95.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    95.2 +++ b/src/clojure/contrib/mmap.clj	Sat Aug 21 06:25:44 2010 -0400
    95.3 @@ -0,0 +1,90 @@
    95.4 +;   Copyright (c) Chris Houser, April 2008. All rights reserved.
    95.5 +;   The use and distribution terms for this software are covered by the
    95.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    95.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
    95.8 +;   By using this software in any fashion, you are agreeing to be bound by
    95.9 +;   the terms of this license.
   95.10 +;   You must not remove this notice, or any other, from this software.
   95.11 +
   95.12 +; Functions for memory-mapping files, plus some functions that use a
   95.13 +; mmaped file for "normal" activies -- slurp, load-file, etc.
   95.14 +
   95.15 +(ns 
   95.16 +  ^{:author "Chris Houser",
   95.17 +     :doc "Functions for memory-mapping files, plus some functions that use a
   95.18 +mmaped file for \"normal\" activies -- slurp, load-file, etc."}
   95.19 +  clojure.contrib.mmap
   95.20 +    (:refer-clojure :exclude (slurp load-file))
   95.21 +    (:import (java.nio ByteBuffer CharBuffer)
   95.22 +             (java.io PushbackReader InputStream InputStreamReader
   95.23 +                      FileInputStream)))
   95.24 +
   95.25 +;(set! *warn-on-reflection* true)
   95.26 +
   95.27 +(def READ_ONLY ^{:private true}
   95.28 +  (java.nio.channels.FileChannel$MapMode/READ_ONLY))
   95.29 +
   95.30 +(defn mmap
   95.31 +  "Memory-map the file named f.  Returns a ByteBuffer."
   95.32 +  [f]
   95.33 +  (let [channel (.getChannel (FileInputStream. f))]
   95.34 +    (.map channel READ_ONLY 0 (.size channel))))
   95.35 +
   95.36 +(defn slurp
   95.37 +  "Reads the file named by f and returns it as a string."
   95.38 +  [^String f]
   95.39 +  (.. java.nio.charset.Charset (forName "UTF-8")
   95.40 +      (newDecoder) (decode (mmap f))))
   95.41 +
   95.42 +(defn buffer-stream
   95.43 +  "Returns an InputStream for a ByteBuffer, such as returned by mmap."
   95.44 +  [^ByteBuffer buf]
   95.45 +  (proxy [InputStream] []
   95.46 +    (available [] (.remaining buf))
   95.47 +    (read
   95.48 +      ([] (if (.hasRemaining buf) (.get buf) -1))
   95.49 +      ([dst offset len] (let [actlen (min (.remaining buf) len)]
   95.50 +                          (.get buf dst offset actlen)
   95.51 +                          (if (< actlen 1) -1 actlen))))))
   95.52 +
   95.53 +(defn load-file [f]
   95.54 +  "Like clojure.lang/load-file, but uses mmap internally."
   95.55 +  (with-open [rdr (-> f mmap buffer-stream InputStreamReader. PushbackReader.)]
   95.56 +    (load-reader rdr)))
   95.57 +
   95.58 +
   95.59 +(comment
   95.60 +
   95.61 +(alias 'mmap 'clojure.contrib.mmap)
   95.62 +(alias 'core 'clojure.core)
   95.63 +
   95.64 +;---
   95.65 +; zip_filter.clj is 95KB
   95.66 +(def tf "/home/chouser/build/clojure/src/clj/clojure/core.clj")
   95.67 +(println "\nload-file" tf)
   95.68 +(time (dotimes [_ 5] (core/load-file tf))) ; 5420.177813 msecs
   95.69 +(time (dotimes [_ 5] (mmap/load-file tf))) ; 7946.854434 msecs -- not so good
   95.70 +
   95.71 +;---
   95.72 +; kern.log.0 is 961KB
   95.73 +(def tf "/var/log/kern.log.0")
   95.74 +(println "\nslurp" tf)
   95.75 +(time (dotimes [_ 10] (.length (core/slurp tf)))) ; 435.767226 msecs
   95.76 +(time (dotimes [_ 10] (.length (mmap/slurp tf)))) ;  93.176858 msecs
   95.77 +
   95.78 +;---
   95.79 +; kern.log.0 is 961KB
   95.80 +(def tf "/var/log/kern.log.0")
   95.81 +(println "\nregex slurp large" tf)
   95.82 +(time (dotimes [_ 10] (count (re-seq #"EXT3.*" (core/slurp tf))))) ; 416
   95.83 +(time (dotimes [_ 10] (count (re-seq #"EXT3.*" (mmap/slurp tf))))) ; 101
   95.84 +
   95.85 +;---
   95.86 +; mmap.clj is about 3.1KB
   95.87 +(def tf "/home/chouser/proj/clojure-contrib/src/clojure/contrib/mmap.clj")
   95.88 +(println "\nregex slurp small" tf)
   95.89 +
   95.90 +(time (dotimes [_ 1000] (count (re-seq #"defn \S*" (core/slurp tf))))) ; 308
   95.91 +(time (dotimes [_ 1000] (count (re-seq #"defn \S*" (mmap/slurp tf))))) ; 198
   95.92 +
   95.93 +)
    96.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    96.2 +++ b/src/clojure/contrib/mock.clj	Sat Aug 21 06:25:44 2010 -0400
    96.3 @@ -0,0 +1,285 @@
    96.4 +;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure
    96.5 +
    96.6 +;; by Matt Clark
    96.7 +
    96.8 +;; Copyright (c) Matt Clark, 2009. All rights reserved.  The use
    96.9 +;; and distribution terms for this software are covered by the Eclipse
   96.10 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php).
   96.11 +;; By using this software in any fashion, you are
   96.12 +;; agreeing to be bound by the terms of this license.  You must not
   96.13 +;; remove this notice, or any other, from this software.
   96.14 +;;------------------------------------------------------------------------------
   96.15 +
   96.16 +(comment
   96.17 +  ;; This is a simple function mocking library I accidentally wrote as a side
   96.18 +  ;; effect of trying to write an opengl library in clojure. This is loosely
   96.19 +  ;; based on various ruby and java mocking frameworks I have used in the past
   96.20 +  ;; such as mockito, easymock, and whatever rspec uses.
   96.21 +  ;;
   96.22 +  ;; expect uses bindings to wrap the functions that are being tested and
   96.23 +  ;; then validates the invocation count at the end. The expect macro is the
   96.24 +  ;; main entry point and it is given a vector of binding pairs.
   96.25 +  ;; The first of each pair names the dependent function you want to override,
   96.26 +  ;; while the second is a hashmap containing the mock description, usually
   96.27 +  ;; created via the simple helper methods described below.
   96.28 +  ;;
   96.29 +  ;; Usage:
   96.30 +  ;;
   96.31 +  ;; there are one or more dependent functions:
   96.32 +  
   96.33 +  (defn dep-fn1 [] "time consuming calculation in 3rd party library")
   96.34 +  (defn dep-fn2 [x] "function with undesirable side effects while testing")
   96.35 +  
   96.36 +  ;; then we have the code under test that calls these other functions:
   96.37 +  
   96.38 +  (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2))
   96.39 +
   96.40 +  ;; to test this code, we simply surround it with an expect macro within
   96.41 +  ;; the test:
   96.42 +  
   96.43 +  (expect [dep-fn1 (times 1)
   96.44 +           dep-fn2 (times 1 (has-args [#(= "a" %)]))]
   96.45 +    (my-code-under-test))
   96.46 +
   96.47 +  ;; When an expectation fails during execution of the function under test,
   96.48 +  ;; an error condition function is called with the name of the function
   96.49 +  ;; being mocked, the expected form and the actual value. These
   96.50 +  ;; error functions can be overridden to allow easy integration into
   96.51 +  ;; test frameworks such as test-is by reporting errors in the function
   96.52 +  ;; overrides.
   96.53 +  
   96.54 +  ) ;; end comment
   96.55 +
   96.56 +(ns clojure.contrib.mock
   96.57 +  ^{:author "Matt Clark",
   96.58 +     :doc "function mocking/expectations for Clojure" }
   96.59 +  (:use [clojure.contrib.seq :only (positions)]
   96.60 +        [clojure.contrib.def :only (defmacro-)]))
   96.61 +
   96.62 +
   96.63 +;;------------------------------------------------------------------------------
   96.64 +;; These are the error condition functions. Override them to integrate into
   96.65 +;; the test framework of your choice, or to simply customize error handling.
   96.66 +
   96.67 +(defn report-problem
   96.68 +  {:dynamic true}
   96.69 +  ([function expected actual]
   96.70 +    (report-problem function expected actual "Expectation not met."))
   96.71 +  ([function expected actual message]
   96.72 +    (prn (str message " Function name: " function
   96.73 +           " expected: " expected " actual: " actual))))
   96.74 +
   96.75 +(defn no-matching-function-signature
   96.76 +  {:dynamic true} 
   96.77 +  [function expected actual]
   96.78 +  (report-problem function expected actual
   96.79 +    "No matching real function signature for given argument count."))
   96.80 +
   96.81 +(defn unexpected-args 
   96.82 +  {:dynamic true}
   96.83 +  [function expected actual i]
   96.84 +  (report-problem function expected actual
   96.85 +    (str "Argument " i " has an unexpected value for function.")))
   96.86 +
   96.87 +(defn incorrect-invocation-count 
   96.88 +  {:dynamic true}
   96.89 +  [function expected actual]
   96.90 +  (report-problem function expected actual "Unexpected invocation count."))
   96.91 +
   96.92 +
   96.93 +;;------------------------------------------------------------------------------
   96.94 +;;  Internal Functions - ignore these
   96.95 +
   96.96 +
   96.97 +(defn- has-arg-count-match?
   96.98 +  "Given the sequence of accepted argument vectors for a function,
   96.99 +returns true if at least one matches the given-count value."
  96.100 +  [arg-lists given-count]
  96.101 +  (some #(let [[ind] (positions #{'&} %)]
  96.102 +           (if ind
  96.103 +             (>= given-count ind)
  96.104 +             (= (count %) given-count)))
  96.105 +        arg-lists))
  96.106 +
  96.107 +
  96.108 +(defn has-matching-signature?
  96.109 +  "Calls no-matching-function-signature if no match is found for the given
  96.110 +function. If no argslist meta data is available for the function, it is
  96.111 +not called."
  96.112 +  [fn-name args]
  96.113 +  (let [arg-count (count args)
  96.114 +            arg-lists (:arglists (meta (resolve fn-name)))]
  96.115 +        (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count)))
  96.116 +          (no-matching-function-signature fn-name arg-lists args))))
  96.117 +
  96.118 +
  96.119 +(defn make-arg-checker
  96.120 +  "Creates the argument verifying function for a replaced dependency within
  96.121 +the expectation bound scope. These functions take the additional argument
  96.122 +of the name of the replaced function, then the rest of their args. It is
  96.123 +designed to be called from the mock function generated in the first argument
  96.124 +of the mock info object created by make-mock."
  96.125 +  [arg-preds arg-pred-forms]
  96.126 +  (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)]
  96.127 +    (fn [fn-name & args]
  96.128 +      (every? true?
  96.129 +        (map (fn [pred arg pred-form i] (if (pred arg) true
  96.130 +                                          (unexpected-args fn-name pred-form arg i)))
  96.131 +          sanitized-preds args arg-pred-forms (iterate inc 0))))))
  96.132 +
  96.133 +
  96.134 +(defn make-count-checker
  96.135 +  "creates the count checker that is invoked at the end of an expectation, after
  96.136 +the code under test has all been executed. The function returned takes the
  96.137 +name of the associated dependency and the invocation count as arguments."
  96.138 +  [pred pred-form]
  96.139 +  (let [pred-fn (if (integer? pred) #(= pred %) pred)]
  96.140 +    (fn [fn-name v] (if (pred-fn v) true
  96.141 +                      (incorrect-invocation-count fn-name pred-form v)))))
  96.142 +
  96.143 +; Borrowed from clojure core. Remove if this ever becomes public there.
  96.144 +(defmacro- assert-args
  96.145 +  [fnname & pairs]
  96.146 +  `(do (when-not ~(first pairs)
  96.147 +         (throw (IllegalArgumentException.
  96.148 +                  ~(str fnname " requires " (second pairs)))))
  96.149 +     ~(let [more (nnext pairs)]
  96.150 +        (when more
  96.151 +          (list* `assert-args fnname more)))))
  96.152 +
  96.153 +(defn make-mock
  96.154 +  "creates a vector containing the following information for the named function:
  96.155 +1. dependent function replacement - verifies signature, calls arg checker,
  96.156 +increases count, returns return value.
  96.157 +2. an atom containing the invocation count
  96.158 +3. the invocation count checker function
  96.159 +4. a symbol of the name of the function being replaced."
  96.160 +  [fn-name expectation-hash]
  96.161 +  (assert-args make-mock
  96.162 +    (map? expectation-hash) "a map of expectations")
  96.163 +  (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true))
  96.164 +        count-atom (atom 0)
  96.165 +        ret-fn (or
  96.166 +                 (expectation-hash :calls)
  96.167 +                 (fn [& args] (expectation-hash :returns)))]
  96.168 +    [(fn [& args]
  96.169 +       (has-matching-signature? fn-name args)
  96.170 +       (apply arg-checker fn-name args)
  96.171 +       (swap! count-atom inc)
  96.172 +       (apply ret-fn args))
  96.173 +     count-atom
  96.174 +     (or (expectation-hash :times) (fn [fn-name v] true))
  96.175 +     fn-name]))
  96.176 +
  96.177 +
  96.178 +(defn validate-counts
  96.179 +  "given the sequence of all mock data for the expectation, simply calls the
  96.180 +count checker for each dependency."
  96.181 +  [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i)))
  96.182 +
  96.183 +(defn ^{:private true} make-bindings [expect-bindings mock-data-sym]
  96.184 +  `[~@(interleave (map #(first %) (partition 2 expect-bindings))
  96.185 +        (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0))
  96.186 +          (range (quot (count expect-bindings) 2))))])
  96.187 +
  96.188 +
  96.189 +;;------------------------------------------------------------------------------
  96.190 +;; These are convenience functions to improve the readability and use of this
  96.191 +;; library. Useful in expressions such as:
  96.192 +;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc)
  96.193 +
  96.194 +(defn once [x] (= 1 x))
  96.195 +
  96.196 +(defn never [x] (zero? x))
  96.197 +
  96.198 +(defn more-than [x] #(< x %))
  96.199 +
  96.200 +(defn less-than [x] #(> x %))
  96.201 +
  96.202 +(defn between [x y] #(and (< x %) (> y %)))
  96.203 +
  96.204 +
  96.205 +;;------------------------------------------------------------------------------
  96.206 +;; The following functions can be used to build up the expectation hash.
  96.207 +
  96.208 +(defn returns
  96.209 +  "Creates or associates to an existing expectation hash the :returns key with
  96.210 +a value to be returned by the expectation after a successful invocation
  96.211 +matching its expected arguments (if applicable).
  96.212 +Usage:
  96.213 +(returns ret-value expectation-hash?)"
  96.214 +
  96.215 +  ([val] (returns val {}))
  96.216 +  ([val expectation-hash] (assoc expectation-hash :returns val)))
  96.217 +
  96.218 +
  96.219 +(defn calls
  96.220 +  "Creates or associates to an existing expectation hash the :calls key with a
  96.221 +function that will be called with the given arguments. The return value from
  96.222 +this function will be returned returned by the expected function. If both this
  96.223 +and returns are specified, the return value of \"calls\" will have precedence.
  96.224 +Usage:
  96.225 +(calls some-fn expectation-hash?)"
  96.226 +
  96.227 +  ([val] (calls val {}))
  96.228 +  ([val expectation-hash] (assoc expectation-hash :calls val)))
  96.229 +
  96.230 +
  96.231 +(defmacro has-args
  96.232 +  "Creates or associates to an existing expectation hash the :has-args key with
  96.233 +a value corresponding to a function that will either return true if its
  96.234 +argument expectations are met or throw an exception with the details of the
  96.235 +first failed argument it encounters.
  96.236 +Only specify as many predicates as you are interested in verifying. The rest
  96.237 +of the values are safely ignored.
  96.238 +Usage:
  96.239 +(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)"
  96.240 +
  96.241 +  ([arg-pred-forms] `(has-args ~arg-pred-forms {}))
  96.242 +  ([arg-pred-forms expect-hash-form]
  96.243 +    (assert-args has-args
  96.244 +      (vector? arg-pred-forms) "a vector of argument predicates")
  96.245 +    `(assoc ~expect-hash-form :has-args
  96.246 +       (make-arg-checker ~arg-pred-forms '~arg-pred-forms))))
  96.247 +
  96.248 +
  96.249 +(defmacro times
  96.250 +  "Creates or associates to an existing expectation hash the :times key with a
  96.251 +value corresponding to a predicate function which expects an integer value.
  96.252 +This function can either be specified as the first argument to times or can be
  96.253 +the result of calling times with an integer argument, in which case the
  96.254 +predicate will default to being an exact match.  This predicate is called at
  96.255 +the end of an expect expression to validate that an expected dependency
  96.256 +function was called the expected number of times.
  96.257 +Usage:
  96.258 +(times n)
  96.259 +(times #(> n %))
  96.260 +(times n expectation-hash)"
  96.261 +  ([times-fn] `(times ~times-fn {}))
  96.262 +  ([times-fn expectation-hash]
  96.263 +    `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn))))
  96.264 +
  96.265 +
  96.266 +;-------------------------------------------------------------------------------
  96.267 +; The main expect macro.
  96.268 +(defmacro expect
  96.269 + "Use expect to redirect calls to dependent functions that are made within the
  96.270 +code under test. Instead of calling the functions that would normally be used,
  96.271 +temporary stubs are used, which can verify function parameters and call counts.
  96.272 +Return values can also be specified as needed.
  96.273 +Usage:
  96.274 +(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))]
  96.275 +  (function-under-test a b c))"
  96.276 +
  96.277 +  [expect-bindings & body]
  96.278 +  (assert-args expect
  96.279 +    (vector? expect-bindings) "a vector of expectation bindings"
  96.280 +    (even? (count expect-bindings))
  96.281 +    "an even number of forms in expectation bindings")
  96.282 +  (let [mock-data (gensym "mock-data_")]
  96.283 +    `(let [~mock-data (map (fn [args#]
  96.284 +                             (apply clojure.contrib.mock/make-mock args#))
  96.285 +                        ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m))
  96.286 +                                       (partition 2 expect-bindings))))]
  96.287 +       (binding ~(make-bindings expect-bindings mock-data) ~@body)
  96.288 +       (clojure.contrib.mock/validate-counts ~mock-data) true)))
    97.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    97.2 +++ b/src/clojure/contrib/mock.clj.rej	Sat Aug 21 06:25:44 2010 -0400
    97.3 @@ -0,0 +1,569 @@
    97.4 +diff a/src/main/clojure/clojure/contrib/mock.clj b/src/main/clojure/clojure/contrib/mock.clj	(rejected hunks)
    97.5 +@@ -1,285 +1,282 @@
    97.6 +-;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure
    97.7 +-
    97.8 +-;; by Matt Clark
    97.9 +-
   97.10 +-;; Copyright (c) Matt Clark, 2009. All rights reserved.  The use
   97.11 +-;; and distribution terms for this software are covered by the Eclipse
   97.12 +-;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php).
   97.13 +-;; By using this software in any fashion, you are
   97.14 +-;; agreeing to be bound by the terms of this license.  You must not
   97.15 +-;; remove this notice, or any other, from this software.
   97.16 +-;;------------------------------------------------------------------------------
   97.17 +-
   97.18 +-(comment
   97.19 +-  ;; This is a simple function mocking library I accidentally wrote as a side
   97.20 +-  ;; effect of trying to write an opengl library in clojure. This is loosely
   97.21 +-  ;; based on various ruby and java mocking frameworks I have used in the past
   97.22 +-  ;; such as mockito, easymock, and whatever rspec uses.
   97.23 +-  ;;
   97.24 +-  ;; expect uses bindings to wrap the functions that are being tested and
   97.25 +-  ;; then validates the invocation count at the end. The expect macro is the
   97.26 +-  ;; main entry point and it is given a vector of binding pairs.
   97.27 +-  ;; The first of each pair names the dependent function you want to override,
   97.28 +-  ;; while the second is a hashmap containing the mock description, usually
   97.29 +-  ;; created via the simple helper methods described below.
   97.30 +-  ;;
   97.31 +-  ;; Usage:
   97.32 +-  ;;
   97.33 +-  ;; there are one or more dependent functions:
   97.34 +-  
   97.35 +-  (defn dep-fn1 [] "time consuming calculation in 3rd party library")
   97.36 +-  (defn dep-fn2 [x] "function with undesirable side effects while testing")
   97.37 +-  
   97.38 +-  ;; then we have the code under test that calls these other functions:
   97.39 +-  
   97.40 +-  (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2))
   97.41 +-
   97.42 +-  ;; to test this code, we simply surround it with an expect macro within
   97.43 +-  ;; the test:
   97.44 +-  
   97.45 +-  (expect [dep-fn1 (times 1)
   97.46 +-           dep-fn2 (times 1 (has-args [#(= "a" %)]))]
   97.47 +-    (my-code-under-test))
   97.48 +-
   97.49 +-  ;; When an expectation fails during execution of the function under test,
   97.50 +-  ;; an error condition function is called with the name of the function
   97.51 +-  ;; being mocked, the expected form and the actual value. These
   97.52 +-  ;; error functions can be overridden to allow easy integration into
   97.53 +-  ;; test frameworks such as test-is by reporting errors in the function
   97.54 +-  ;; overrides.
   97.55 +-  
   97.56 +-  ) ;; end comment
   97.57 +-
   97.58 +-(ns clojure.contrib.mock
   97.59 +-  ^{:author "Matt Clark",
   97.60 +-     :doc "function mocking/expectations for Clojure" }
   97.61 +-  (:use [clojure.contrib.seq :only (positions)]
   97.62 +-        [clojure.contrib.def :only (defmacro-)]))
   97.63 +-
   97.64 +-
   97.65 +-;;------------------------------------------------------------------------------
   97.66 +-;; These are the error condition functions. Override them to integrate into
   97.67 +-;; the test framework of your choice, or to simply customize error handling.
   97.68 +-
   97.69 +-(defn report-problem
   97.70 +-  {:dynamic true}
   97.71 +-  ([function expected actual]
   97.72 +-    (report-problem function expected actual "Expectation not met."))
   97.73 +-  ([function expected actual message]
   97.74 +-    (prn (str message " Function name: " function
   97.75 +-           " expected: " expected " actual: " actual))))
   97.76 +-
   97.77 +-(defn no-matching-function-signature
   97.78 +-  {:dynamic true} 
   97.79 +-  [function expected actual]
   97.80 +-  (report-problem function expected actual
   97.81 +-    "No matching real function signature for given argument count."))
   97.82 +-
   97.83 +-(defn unexpected-args 
   97.84 +-  {:dynamic true}
   97.85 +-  [function expected actual i]
   97.86 +-  (report-problem function expected actual
   97.87 +-    (str "Argument " i " has an unexpected value for function.")))
   97.88 +-
   97.89 +-(defn incorrect-invocation-count 
   97.90 +-  {:dynamic true}
   97.91 +-  [function expected actual]
   97.92 +-  (report-problem function expected actual "Unexpected invocation count."))
   97.93 +-
   97.94 +-
   97.95 +-;;------------------------------------------------------------------------------
   97.96 +-;;  Internal Functions - ignore these
   97.97 +-
   97.98 +-
   97.99 +-(defn- has-arg-count-match?
  97.100 +-  "Given the sequence of accepted argument vectors for a function,
  97.101 +-returns true if at least one matches the given-count value."
  97.102 +-  [arg-lists given-count]
  97.103 +-  (some #(let [[ind] (positions #{'&} %)]
  97.104 +-           (if ind
  97.105 +-             (>= given-count ind)
  97.106 +-             (= (count %) given-count)))
  97.107 +-        arg-lists))
  97.108 +-
  97.109 +-
  97.110 +-(defn has-matching-signature?
  97.111 +-  "Calls no-matching-function-signature if no match is found for the given
  97.112 +-function. If no argslist meta data is available for the function, it is
  97.113 +-not called."
  97.114 +-  [fn-name args]
  97.115 +-  (let [arg-count (count args)
  97.116 +-            arg-lists (:arglists (meta (resolve fn-name)))]
  97.117 +-        (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count)))
  97.118 +-          (no-matching-function-signature fn-name arg-lists args))))
  97.119 +-
  97.120 +-
  97.121 +-(defn make-arg-checker
  97.122 +-  "Creates the argument verifying function for a replaced dependency within
  97.123 +-the expectation bound scope. These functions take the additional argument
  97.124 +-of the name of the replaced function, then the rest of their args. It is
  97.125 +-designed to be called from the mock function generated in the first argument
  97.126 +-of the mock info object created by make-mock."
  97.127 +-  [arg-preds arg-pred-forms]
  97.128 +-  (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)]
  97.129 +-    (fn [fn-name & args]
  97.130 +-      (every? true?
  97.131 +-        (map (fn [pred arg pred-form i] (if (pred arg) true
  97.132 +-                                          (unexpected-args fn-name pred-form arg i)))
  97.133 +-          sanitized-preds args arg-pred-forms (iterate inc 0))))))
  97.134 +-
  97.135 +-
  97.136 +-(defn make-count-checker
  97.137 +-  "creates the count checker that is invoked at the end of an expectation, after
  97.138 +-the code under test has all been executed. The function returned takes the
  97.139 +-name of the associated dependency and the invocation count as arguments."
  97.140 +-  [pred pred-form]
  97.141 +-  (let [pred-fn (if (integer? pred) #(= pred %) pred)]
  97.142 +-    (fn [fn-name v] (if (pred-fn v) true
  97.143 +-                      (incorrect-invocation-count fn-name pred-form v)))))
  97.144 +-
  97.145 +-; Borrowed from clojure core. Remove if this ever becomes public there.
  97.146 +-(defmacro- assert-args
  97.147 +-  [fnname & pairs]
  97.148 +-  `(do (when-not ~(first pairs)
  97.149 +-         (throw (IllegalArgumentException.
  97.150 +-                  ~(str fnname " requires " (second pairs)))))
  97.151 +-     ~(let [more (nnext pairs)]
  97.152 +-        (when more
  97.153 +-          (list* `assert-args fnname more)))))
  97.154 +-
  97.155 +-(defn make-mock
  97.156 +-  "creates a vector containing the following information for the named function:
  97.157 +-1. dependent function replacement - verifies signature, calls arg checker,
  97.158 +-increases count, returns return value.
  97.159 +-2. an atom containing the invocation count
  97.160 +-3. the invocation count checker function
  97.161 +-4. a symbol of the name of the function being replaced."
  97.162 +-  [fn-name expectation-hash]
  97.163 +-  (assert-args make-mock
  97.164 +-    (map? expectation-hash) "a map of expectations")
  97.165 +-  (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true))
  97.166 +-        count-atom (atom 0)
  97.167 +-        ret-fn (or
  97.168 +-                 (expectation-hash :calls)
  97.169 +-                 (fn [& args] (expectation-hash :returns)))]
  97.170 +-    [(fn [& args]
  97.171 +-       (has-matching-signature? fn-name args)
  97.172 +-       (apply arg-checker fn-name args)
  97.173 +-       (swap! count-atom inc)
  97.174 +-       (apply ret-fn args))
  97.175 +-     count-atom
  97.176 +-     (or (expectation-hash :times) (fn [fn-name v] true))
  97.177 +-     fn-name]))
  97.178 +-
  97.179 +-
  97.180 +-(defn validate-counts
  97.181 +-  "given the sequence of all mock data for the expectation, simply calls the
  97.182 +-count checker for each dependency."
  97.183 +-  [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i)))
  97.184 +-
  97.185 +-(defn ^{:private true} make-bindings [expect-bindings mock-data-sym]
  97.186 +-  `[~@(interleave (map #(first %) (partition 2 expect-bindings))
  97.187 +-        (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0))
  97.188 +-          (range (quot (count expect-bindings) 2))))])
  97.189 +-
  97.190 +-
  97.191 +-;;------------------------------------------------------------------------------
  97.192 +-;; These are convenience functions to improve the readability and use of this
  97.193 +-;; library. Useful in expressions such as:
  97.194 +-;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc)
  97.195 +-
  97.196 +-(defn once [x] (= 1 x))
  97.197 +-
  97.198 +-(defn never [x] (zero? x))
  97.199 +-
  97.200 +-(defn more-than [x] #(< x %))
  97.201 +-
  97.202 +-(defn less-than [x] #(> x %))
  97.203 +-
  97.204 +-(defn between [x y] #(and (< x %) (> y %)))
  97.205 +-
  97.206 +-
  97.207 +-;;------------------------------------------------------------------------------
  97.208 +-;; The following functions can be used to build up the expectation hash.
  97.209 +-
  97.210 +-(defn returns
  97.211 +-  "Creates or associates to an existing expectation hash the :returns key with
  97.212 +-a value to be returned by the expectation after a successful invocation
  97.213 +-matching its expected arguments (if applicable).
  97.214 +-Usage:
  97.215 +-(returns ret-value expectation-hash?)"
  97.216 +-
  97.217 +-  ([val] (returns val {}))
  97.218 +-  ([val expectation-hash] (assoc expectation-hash :returns val)))
  97.219 +-
  97.220 +-
  97.221 +-(defn calls
  97.222 +-  "Creates or associates to an existing expectation hash the :calls key with a
  97.223 +-function that will be called with the given arguments. The return value from
  97.224 +-this function will be returned returned by the expected function. If both this
  97.225 +-and returns are specified, the return value of \"calls\" will have precedence.
  97.226 +-Usage:
  97.227 +-(calls some-fn expectation-hash?)"
  97.228 +-
  97.229 +-  ([val] (calls val {}))
  97.230 +-  ([val expectation-hash] (assoc expectation-hash :calls val)))
  97.231 +-
  97.232 +-
  97.233 +-(defmacro has-args
  97.234 +-  "Creates or associates to an existing expectation hash the :has-args key with
  97.235 +-a value corresponding to a function that will either return true if its
  97.236 +-argument expectations are met or throw an exception with the details of the
  97.237 +-first failed argument it encounters.
  97.238 +-Only specify as many predicates as you are interested in verifying. The rest
  97.239 +-of the values are safely ignored.
  97.240 +-Usage:
  97.241 +-(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)"
  97.242 +-
  97.243 +-  ([arg-pred-forms] `(has-args ~arg-pred-forms {}))
  97.244 +-  ([arg-pred-forms expect-hash-form]
  97.245 +-    (assert-args has-args
  97.246 +-      (vector? arg-pred-forms) "a vector of argument predicates")
  97.247 +-    `(assoc ~expect-hash-form :has-args
  97.248 +-       (make-arg-checker ~arg-pred-forms '~arg-pred-forms))))
  97.249 +-
  97.250 +-
  97.251 +-(defmacro times
  97.252 +-  "Creates or associates to an existing expectation hash the :times key with a
  97.253 +-value corresponding to a predicate function which expects an integer value.
  97.254 +-This function can either be specified as the first argument to times or can be
  97.255 +-the result of calling times with an integer argument, in which case the
  97.256 +-predicate will default to being an exact match.  This predicate is called at
  97.257 +-the end of an expect expression to validate that an expected dependency
  97.258 +-function was called the expected number of times.
  97.259 +-Usage:
  97.260 +-(times n)
  97.261 +-(times #(> n %))
  97.262 +-(times n expectation-hash)"
  97.263 +-  ([times-fn] `(times ~times-fn {}))
  97.264 +-  ([times-fn expectation-hash]
  97.265 +-    `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn))))
  97.266 +-
  97.267 +-
  97.268 +-;-------------------------------------------------------------------------------
  97.269 +-; The main expect macro.
  97.270 +-(defmacro expect
  97.271 +- "Use expect to redirect calls to dependent functions that are made within the
  97.272 +-code under test. Instead of calling the functions that would normally be used,
  97.273 +-temporary stubs are used, which can verify function parameters and call counts.
  97.274 +-Return values can also be specified as needed.
  97.275 +-Usage:
  97.276 +-(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))]
  97.277 +-  (function-under-test a b c))"
  97.278 +-
  97.279 +-  [expect-bindings & body]
  97.280 +-  (assert-args expect
  97.281 +-    (vector? expect-bindings) "a vector of expectation bindings"
  97.282 +-    (even? (count expect-bindings))
  97.283 +-    "an even number of forms in expectation bindings")
  97.284 +-  (let [mock-data (gensym "mock-data_")]
  97.285 +-    `(let [~mock-data (map (fn [args#]
  97.286 +-                             (apply clojure.contrib.mock/make-mock args#))
  97.287 +-                        ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m))
  97.288 +-                                       (partition 2 expect-bindings))))]
  97.289 +-       (binding ~(make-bindings expect-bindings mock-data) ~@body)
  97.290 +-       (clojure.contrib.mock/validate-counts ~mock-data) true)))
  97.291 ++;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure
  97.292 ++
  97.293 ++;;  by Matt Clark
  97.294 ++
  97.295 ++;;  Copyright (c) Matt Clark, 2009. All rights reserved.  The use and
  97.296 ++;;  distribution terms for this software are covered by the Eclipse Public
  97.297 ++;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
  97.298 ++;;  be found in the file epl-v10.html at the root of this distribution.  By
  97.299 ++;;  using this software in any fashion, you are agreeing to be bound by the
  97.300 ++;;  terms of this license.  You must not remove this notice, or any other
  97.301 ++;;  from this software.
  97.302 ++;;------------------------------------------------------------------------------
  97.303 ++
  97.304 ++(comment
  97.305 ++  ;; Mock is a function mocking utility loosely based on various ruby and java
  97.306 ++  ;; mocking frameworks such as mockito, easymock, and rspec yet adapted to
  97.307 ++  ;; fit the functional style of clojure.
  97.308 ++  ;;
  97.309 ++  ;; Mock uses bindings to wrap the functions that are being tested and
  97.310 ++  ;; then validates the invocation count at the end. The expect macro is the
  97.311 ++  ;; main entry point and it is given a vector of binding pairs.
  97.312 ++  ;; The first of each pair names the dependent function you want to override
  97.313 ++  ;; while the second is a hashmap containing the mock description, usually
  97.314 ++  ;; created via the simple helper methods described below.
  97.315 ++  ;;
  97.316 ++  ;; Usage:
  97.317 ++  ;;
  97.318 ++  ;; there are one or more dependent functions:
  97.319 ++
  97.320 ++  (defn dep-fn1 [] "time consuming calculation in 3rd party library")
  97.321 ++  (defn dep-fn2 [x] "function with undesirable side effects while testing")
  97.322 ++
  97.323 ++  ;; then we have the code under test that calls these other functions:
  97.324 ++
  97.325 ++  (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2))
  97.326 ++
  97.327 ++  ;; to test this code, we simply surround it with an expect macro within
  97.328 ++  ;; the test:
  97.329 ++
  97.330 ++  (expect [dep-fn1 (times 1)
  97.331 ++           dep-fn2 (times 1 (has-args [#(= "a" %)]))]
  97.332 ++          (my-code-under-test))
  97.333 ++
  97.334 ++  ;; When an expectation fails during execution of the function under test
  97.335 ++  ;; an error condition function is called with the name of the function
  97.336 ++  ;; being mocked, the expected form and the actual value. These
  97.337 ++  ;; error functions can be overridden to allow easy integration into
  97.338 ++  ;; test frameworks such as test-is by reporting errors in the function
  97.339 ++  ;; overrides.
  97.340 ++
  97.341 ++  ) ;; end comment
  97.342 ++
  97.343 ++(ns clojure.contrib.mock
  97.344 ++  ^{:author "Matt Clark"
  97.345 ++     :doc "function mocking/expectations for Clojure" }
  97.346 ++  (:use [clojure.contrib.seq :only (positions)]
  97.347 ++        [clojure.contrib.def :only (defmacro-)]))
  97.348 ++
  97.349 ++
  97.350 ++;;------------------------------------------------------------------------------
  97.351 ++;; These are the error condition functions. Override them to integrate into
  97.352 ++;; the test framework of your choice, or to simply customize error handling.
  97.353 ++
  97.354 ++(defn report-problem
  97.355 ++  {:dynamic true}
  97.356 ++  ([function expected actual]
  97.357 ++     (report-problem function expected actual "Expectation not met."))
  97.358 ++  ([function expected actual message]
  97.359 ++     (prn (str message " Function name: " function
  97.360 ++               " expected: " expected " actual: " actual))))
  97.361 ++
  97.362 ++(defn no-matching-function-signature
  97.363 ++  {:dynamic true}
  97.364 ++  [function expected actual]
  97.365 ++  (report-problem function expected actual
  97.366 ++                  "No matching real function signature for given argument count."))
  97.367 ++
  97.368 ++(defn unexpected-args
  97.369 ++  {:dynamic true}
  97.370 ++  [function expected actual i]
  97.371 ++  (report-problem function expected actual
  97.372 ++                  (str "Argument " i " has an unexpected value for function.")))
  97.373 ++
  97.374 ++(defn incorrect-invocation-count
  97.375 ++  {:dynamic true}
  97.376 ++  [function expected actual]
  97.377 ++  (report-problem function expected actual "Unexpected invocation count."))
  97.378 ++
  97.379 ++
  97.380 ++;;------------------------------------------------------------------------------
  97.381 ++;;  Internal Functions - ignore these
  97.382 ++
  97.383 ++
  97.384 ++(defn- has-arg-count-match?
  97.385 ++  "Given the sequence of accepted argument vectors for a function
  97.386 ++returns true if at least one matches the given-count value."
  97.387 ++  [arg-lists given-count]
  97.388 ++  (some #(let [[ind] (positions #{'&} %)]
  97.389 ++           (if ind
  97.390 ++             (>= given-count ind)
  97.391 ++             (= (count %) given-count)))
  97.392 ++        arg-lists))
  97.393 ++
  97.394 ++
  97.395 ++(defn has-matching-signature?
  97.396 ++  "Calls no-matching-function-signature if no match is found for the given
  97.397 ++function. If no argslist meta data is available for the function, it is
  97.398 ++not called."
  97.399 ++  [fn-name args]
  97.400 ++  (let [arg-count (count args)
  97.401 ++        arg-lists (:arglists (meta (resolve fn-name)))]
  97.402 ++    (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count)))
  97.403 ++      (no-matching-function-signature fn-name arg-lists args))))
  97.404 ++
  97.405 ++
  97.406 ++(defn make-arg-checker
  97.407 ++  "Creates the argument verifying function for a replaced dependency within
  97.408 ++the expectation bound scope. These functions take the additional argument
  97.409 ++of the name of the replaced function, then the rest of their args. It is
  97.410 ++designed to be called from the mock function generated in the first argument
  97.411 ++of the mock info object created by make-mock."
  97.412 ++  [arg-preds arg-pred-forms]
  97.413 ++  (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)]
  97.414 ++    (fn [fn-name & args]
  97.415 ++      (every? true?
  97.416 ++              (map (fn [pred arg pred-form i] (if (pred arg) true
  97.417 ++                                                  (unexpected-args fn-name
  97.418 ++                                                                   pred-form arg i)))
  97.419 ++                   sanitized-preds args arg-pred-forms (iterate inc 0))))))
  97.420 ++
  97.421 ++
  97.422 ++(defn make-count-checker
  97.423 ++  "creates the count checker that is invoked at the end of an expectation, after
  97.424 ++the code under test has all been executed. The function returned takes the
  97.425 ++name of the associated dependency and the invocation count as arguments."
  97.426 ++  [pred pred-form]
  97.427 ++  (let [pred-fn (if (integer? pred) #(= pred %) pred)]
  97.428 ++    (fn [fn-name v] (if (pred-fn v) true
  97.429 ++                        (incorrect-invocation-count fn-name pred-form v)))))
  97.430 ++
  97.431 ++(defn make-mock
  97.432 ++  "creates a vector containing the following information for the named function:
  97.433 ++1. dependent function replacement - verifies signature, calls arg checker
  97.434 ++increases count, returns return value.
  97.435 ++2. an atom containing the invocation count
  97.436 ++3. the invocation count checker function
  97.437 ++4. a symbol of the name of the function being replaced."
  97.438 ++  [fn-name expectation-hash]
  97.439 ++  {:pre [(map? expectation-hash)
  97.440 ++         (symbol? fn-name)]}
  97.441 ++  (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true))
  97.442 ++        count-atom (atom 0)
  97.443 ++        ret-fn (or
  97.444 ++                (expectation-hash :calls)
  97.445 ++                (fn [& args] (expectation-hash :returns)))]
  97.446 ++    [(fn [& args]
  97.447 ++       (has-matching-signature? fn-name args)
  97.448 ++       (apply arg-checker fn-name args)
  97.449 ++       (swap! count-atom inc)
  97.450 ++       (apply ret-fn args))
  97.451 ++     count-atom
  97.452 ++     (or (expectation-hash :times) (fn [fn-name v] true))
  97.453 ++     fn-name]))
  97.454 ++
  97.455 ++
  97.456 ++(defn validate-counts
  97.457 ++  "given the sequence of all mock data for the expectation, simply calls the
  97.458 ++count checker for each dependency."
  97.459 ++  [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i)))
  97.460 ++
  97.461 ++(defn- make-bindings [expect-bindings mock-data-sym]
  97.462 ++  `[~@(interleave (map #(first %) (partition 2 expect-bindings))
  97.463 ++                  (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0))
  97.464 ++                       (range (quot (count expect-bindings) 2))))])
  97.465 ++
  97.466 ++
  97.467 ++;;------------------------------------------------------------------------------
  97.468 ++;; These are convenience functions to improve the readability and use of this
  97.469 ++;; library. Useful in expressions such as:
  97.470 ++;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc)
  97.471 ++
  97.472 ++;; best used in the times function
  97.473 ++(defn once [x] (= 1 x))
  97.474 ++
  97.475 ++(defn never [x] (zero? x))
  97.476 ++
  97.477 ++(defn more-than [x] #(< x %))
  97.478 ++
  97.479 ++(defn less-than [x] #(> x %))
  97.480 ++
  97.481 ++(defn between [x y] #(and (< x %) (> y %)))
  97.482 ++
  97.483 ++;;best used in the has-args function
  97.484 ++(defn anything [x] true)
  97.485 ++
  97.486 ++
  97.487 ++;;------------------------------------------------------------------------------
  97.488 ++;; The following functions can be used to build up the expectation hash.
  97.489 ++
  97.490 ++(defn returns
  97.491 ++  "Creates or associates to an existing expectation hash the :returns key with
  97.492 ++a value to be returned by the expectation after a successful invocation
  97.493 ++matching its expected arguments (if applicable).
  97.494 ++Usage:
  97.495 ++(returns ret-value expectation-hash?)"
  97.496 ++
  97.497 ++  ([val] (returns val {}))
  97.498 ++  ([val expectation-hash]
  97.499 ++   {:pre [(map? expectation-hash)]}
  97.500 ++   (assoc expectation-hash :returns val)))
  97.501 ++
  97.502 ++
  97.503 ++(defn calls
  97.504 ++  "Creates or associates to an existing expectation hash the :calls key with a
  97.505 ++function that will be called with the given arguments. The return value from
  97.506 ++this function will be returned by the expected function. If both this
  97.507 ++and returns are specified, the return value of \"calls\" will have precedence.
  97.508 ++Usage:
  97.509 ++(calls some-fn expectation-hash?)"
  97.510 ++
  97.511 ++  ([val] (calls val {}))
  97.512 ++  ([val expectation-hash]
  97.513 ++   {:pre [(map? expectation-hash)]}
  97.514 ++   (assoc expectation-hash :calls val)))
  97.515 ++
  97.516 ++
  97.517 ++(defmacro has-args
  97.518 ++  "Creates or associates to an existing expectation hash the :has-args key with
  97.519 ++a value corresponding to a function that will either return true if its
  97.520 ++argument expectations are met or throw an exception with the details of the
  97.521 ++first failed argument it encounters.
  97.522 ++Only specify as many predicates as you are interested in verifying. The rest
  97.523 ++of the values are safely ignored.
  97.524 ++Usage:
  97.525 ++(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)"
  97.526 ++
  97.527 ++  ([arg-pred-forms] `(has-args ~arg-pred-forms {}))
  97.528 ++  ([arg-pred-forms expectation-hash]
  97.529 ++   {:pre [(vector? arg-pred-forms)
  97.530 ++          (map? expectation-hash)]}
  97.531 ++    `(assoc ~expectation-hash :has-args
  97.532 ++       (make-arg-checker ~arg-pred-forms '~arg-pred-forms))))
  97.533 ++
  97.534 ++
  97.535 ++(defmacro times
  97.536 ++  "Creates or associates to an existing expectation hash the :times key with a
  97.537 ++value corresponding to a predicate function which expects an integer value.
  97.538 ++Also, an integer can be specified, in which case the times will only be an
  97.539 ++exact match. The times check is called at the end of an expect expression to
  97.540 ++validate that an expected dependency function was called the expected
  97.541 ++number of times.
  97.542 ++Usage:
  97.543 ++(times n)
  97.544 ++(times #(> n %))
  97.545 ++(times n expectation-hash)"
  97.546 ++  ([times-fn] `(times ~times-fn {}))
  97.547 ++  ([times-fn expectation-hash]
  97.548 ++   {:pre [(map? expectation-hash)]}
  97.549 ++   `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn))))
  97.550 ++
  97.551 ++
  97.552 ++;-------------------------------------------------------------------------------
  97.553 ++; The main expect macro.
  97.554 ++(defmacro expect
  97.555 ++  "Use expect to redirect calls to dependent functions that are made within the
  97.556 ++code under test. Instead of calling the functions that would normally be used
  97.557 ++temporary stubs are used, which can verify function parameters and call counts.
  97.558 ++Return values of overridden functions can also be specified as needed.
  97.559 ++Usage:
  97.560 ++(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))]
  97.561 ++        (function-under-test a b c))"
  97.562 ++
  97.563 ++  [expect-bindings & body]
  97.564 ++   {:pre [(vector? expect-bindings)
  97.565 ++          (even? (count expect-bindings))]}
  97.566 ++  (let [mock-data (gensym "mock-data_")]
  97.567 ++    `(let [~mock-data (map (fn [args#]
  97.568 ++                             (apply clojure.contrib.mock/make-mock args#))
  97.569 ++                        ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m))
  97.570 ++                                       (partition 2 expect-bindings))))]
  97.571 ++       (binding ~(make-bindings expect-bindings mock-data) ~@body)
  97.572 ++       (clojure.contrib.mock/validate-counts ~mock-data) true)))
    98.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    98.2 +++ b/src/clojure/contrib/mock/test_adapter.clj	Sat Aug 21 06:25:44 2010 -0400
    98.3 @@ -0,0 +1,38 @@
    98.4 +;;; test_adapter.clj: clojure.test adapter for mocking/expectation framework for Clojure
    98.5 +
    98.6 +;; by Matt Clark
    98.7 +
    98.8 +;; Copyright (c) Matt Clark, 2009. All rights reserved.  The use
    98.9 +;; and distribution terms for this software are covered by the Eclipse
   98.10 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php).
   98.11 +;; By using this software in any fashion, you are
   98.12 +;; agreeing to be bound by the terms of this license.  You must not
   98.13 +;; remove this notice, or any other, from this software.
   98.14 +
   98.15 +(ns clojure.contrib.mock.test-adapter
   98.16 + (:require [clojure.contrib.mock :as mock])
   98.17 + (:use clojure.test
   98.18 +       clojure.contrib.ns-utils))
   98.19 +
   98.20 +(immigrate 'clojure.contrib.mock)
   98.21 +
   98.22 +(defn report-problem
   98.23 + "This function is designed to be used in a binding macro to override
   98.24 +the report-problem function in clojure.contrib.mock. Instead of printing
   98.25 +the error to the console, the error is logged via clojure.test."
   98.26 + {:dynamic true}
   98.27 + [fn-name expected actual msg]
   98.28 + (report {:type :fail,
   98.29 +          :message (str msg " Function name: " fn-name),
   98.30 +          :expected expected,
   98.31 +          :actual actual}))
   98.32 +
   98.33 +
   98.34 +(defmacro expect [& body]
   98.35 +  "Use this macro instead of the standard c.c.mock expect macro to have
   98.36 +failures reported through clojure.test."
   98.37 +  `(binding [mock/report-problem report-problem]
   98.38 +     (mock/expect ~@body)))
   98.39 +
   98.40 +
   98.41 +
    99.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    99.2 +++ b/src/clojure/contrib/monadic_io_streams.clj	Sat Aug 21 06:25:44 2010 -0400
    99.3 @@ -0,0 +1,145 @@
    99.4 +;; Monadic I/O
    99.5 +
    99.6 +;; by Konrad Hinsen
    99.7 +;; last updated June 24, 2009
    99.8 +
    99.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
   99.10 +;; and distribution terms for this software are covered by the Eclipse
   99.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   99.12 +;; which can be found in the file epl-v10.html at the root of this
   99.13 +;; distribution.  By using this software in any fashion, you are
   99.14 +;; agreeing to be bound by the terms of this license.  You must not
   99.15 +;; remove this notice, or any other, from this software.
   99.16 +
   99.17 +(ns
   99.18 +  ^{:author "Konrad Hinsen"
   99.19 +     :doc "Monadic I/O with Java input/output streams
   99.20 +           Defines monadic I/O statements to be used in a state monad
   99.21 +           with an input or output stream as the state. The macro
   99.22 +           monadic-io creates a stream, runs a monadic I/O statement
   99.23 +           on it, and closes the stream. This structure permits the
   99.24 +           definition of purely functional compound I/O statements
   99.25 +           which are applied to streams that can never escape from the
   99.26 +           monadic statement sequence."}
   99.27 +  clojure.contrib.monadic-io-streams
   99.28 +  (:refer-clojure :exclude (read-line print println flush))
   99.29 +  (:use [clojure.contrib.monads
   99.30 +	 :only (with-monad domonad state-m state-m-until)])
   99.31 +  (:use [clojure.contrib.generic.functor :only (fmap)])
   99.32 +  (:use [clojure.java.io :only (reader writer)]))
   99.33 +
   99.34 +;
   99.35 +; Wrap the state into a closure to make sure that "evil" code
   99.36 +; can't obtain the stream using fetch-state and manipulate it.
   99.37 +;
   99.38 +(let [key (Object.)
   99.39 +      lock (fn [state] (fn [x] (if (identical? x key) state nil)))
   99.40 +      unlock (fn [state] (state key))]
   99.41 +
   99.42 +  ;
   99.43 +  ; Basic stream I/O statements as provided by Java
   99.44 +  ;
   99.45 +  (defn read-char
   99.46 +    "Read a single character"
   99.47 +    []
   99.48 +    (fn [s] [(.read (unlock s)) s]))
   99.49 +
   99.50 +  (defn read-line
   99.51 +    "Read a single line"
   99.52 +    []
   99.53 +    (fn [s] [(.readLine (unlock s)) s]))
   99.54 +
   99.55 +  (defn skip-chars
   99.56 +    "Skip n characters"
   99.57 +    [n]
   99.58 +    (fn [s] [(.skip (unlock s) n) s]))
   99.59 +
   99.60 +  (defn write
   99.61 +    "Write text (a string)"
   99.62 +    [^String text]
   99.63 +    (fn [s] [(.write (unlock s) text) s]))
   99.64 +
   99.65 +  (defn flush
   99.66 +    "Flush"
   99.67 +    []
   99.68 +    (fn [s] [(.flush (unlock s)) s]))
   99.69 +
   99.70 +  (defn print
   99.71 +    "Print obj"
   99.72 +    [obj]
   99.73 +    (fn [s] [(.print (unlock s) obj) s]))
   99.74 +
   99.75 +  (defn println
   99.76 +    "Print obj followed by a newline"
   99.77 +    ([]
   99.78 +     (fn [s] [(.println (unlock s)) s]))
   99.79 +    ([obj]
   99.80 +     (fn [s] [(.println (unlock s) obj) s])))
   99.81 +
   99.82 +  ;
   99.83 +  ; Inject I/O streams into monadic I/O statements
   99.84 +  ;
   99.85 +  (defn with-reader
   99.86 +    "Create a reader from reader-spec, run the monadic I/O statement
   99.87 +     on it, and close the reader. reader-spec can be any object accepted
   99.88 +     by clojure.contrib.io/reader."
   99.89 +    [reader-spec statement]
   99.90 +    (with-open [r (reader reader-spec)]
   99.91 +      (first (statement (lock r)))))
   99.92 +
   99.93 +  (defn with-writer
   99.94 +    "Create a writer from writer-spec, run the monadic I/O statement
   99.95 +     on it, and close the writer. writer-spec can be any object accepted
   99.96 +     by clojure.contrib.io/writer."
   99.97 +    [writer-spec statement]
   99.98 +    (with-open [w (writer writer-spec)]
   99.99 +      (first (statement (lock w)))))
  99.100 +
  99.101 +  (defn with-io-streams
  99.102 +    "Open one or more streams as specified by io-spec, run a monadic
  99.103 +     I/O statement on them, and close the streams. io-spec is
  99.104 +     a binding-like vector in which each stream is specified by
  99.105 +     three element: a keyword by which the stream can be referred to,
  99.106 +     the stream mode (:read or :write), and a stream specification as
  99.107 +     accepted by clojure.contrib.io/reader (mode :read) or
  99.108 +     clojure.contrib.io/writer (mode :write). The statement
  99.109 +     is run on a state which is a map from keywords to corresponding
  99.110 +     streams. Single-stream monadic I/O statements must be wrapped
  99.111 +     with clojure.contrib.monads/with-state-field."
  99.112 +    [io-specs statement]
  99.113 +    (letfn [(run-io [io-specs state statement]
  99.114 +	      (if (zero? (count io-specs))
  99.115 +		(first (statement state))
  99.116 +		(let [[[key mode stream-spec] & r] io-specs
  99.117 +		      opener (cond (= mode :read) reader
  99.118 +				   (= mode :write) writer
  99.119 +				   :else (throw
  99.120 +					  (Exception.
  99.121 +					   "Mode must be :read or :write")))]
  99.122 +		  (with-open [stream (opener stream-spec)]
  99.123 +		    (run-io r (assoc state key (lock stream)) statement)))))]
  99.124 +      (run-io (partition 3 io-specs) {} statement))))
  99.125 +
  99.126 +;
  99.127 +; Compound I/O statements
  99.128 +;
  99.129 +(with-monad state-m
  99.130 +
  99.131 +  (defn- add-line
  99.132 +    "Read one line and add it to the end of the vector lines. Return
  99.133 +     [lines eof], where eof is an end-of-file flag. The input eof argument
  99.134 +     is not used."
  99.135 +    [[lines eof]]
  99.136 +    (domonad
  99.137 +      [line (read-line)]
  99.138 +      (if (nil? line)
  99.139 +        [lines true]
  99.140 +        [(conj lines line) false])))
  99.141 +
  99.142 +  (defn read-lines
  99.143 +    "Read all lines and return them in a vector"
  99.144 +    []
  99.145 +    (domonad
  99.146 +      [[lines eof] (state-m-until second add-line [[] false])]
  99.147 +      lines)))
  99.148 +
   100.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   100.2 +++ b/src/clojure/contrib/monads.clj	Sat Aug 21 06:25:44 2010 -0400
   100.3 @@ -0,0 +1,580 @@
   100.4 +;; Monads in Clojure
   100.5 +
   100.6 +;; by Konrad Hinsen
   100.7 +;; last updated June 30, 2009
   100.8 +
   100.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
  100.10 +;; and distribution terms for this software are covered by the Eclipse
  100.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  100.12 +;; which can be found in the file epl-v10.html at the root of this
  100.13 +;; distribution.  By using this software in any fashion, you are
  100.14 +;; agreeing to be bound by the terms of this license.  You must not
  100.15 +;; remove this notice, or any other, from this software.
  100.16 +
  100.17 +(ns
  100.18 +  ^{:author "Konrad Hinsen"
  100.19 +     :see-also [["http://onclojure.com/2009/03/05/a-monad-tutorial-for-clojure-programmers-part-1/" "Monad tutorial part 1"]
  100.20 +		["http://onclojure.com/2009/03/06/a-monad-tutorial-for-clojure-programmers-part-2/" "Monad tutorial part 2"]
  100.21 +		["http://onclojure.com/2009/03/23/a-monad-tutorial-for-clojure-programmers-part-3/" "Monad tutorial part 3"]
  100.22 +		["http://onclojure.com/2009/04/24/a-monad-tutorial-for-clojure-programmers-part-4/" "Monad tutorial part 4"]
  100.23 +		["http://intensivesystems.net/tutorials/monads_101.html" "Monads in Clojure part 1"]
  100.24 +		["http://intensivesystems.net/tutorials/monads_201.html" "Monads in Clojure part 2"]]
  100.25 +     :doc "This library contains the most commonly used monads as well
  100.26 +           as macros for defining and using monads and useful monadic
  100.27 +           functions."}
  100.28 +  clojure.contrib.monads
  100.29 +  (:require [clojure.contrib.accumulators])
  100.30 +  (:use [clojure.contrib.macro-utils :only (with-symbol-macros defsymbolmacro)])
  100.31 +  (:use [clojure.contrib.def :only (name-with-attributes)]))
  100.32 +
  100.33 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100.34 +;;
  100.35 +;; Defining monads
  100.36 +;;
  100.37 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100.38 +
  100.39 +(defmacro monad
  100.40 +   "Define a monad by defining the monad operations. The definitions
  100.41 +    are written like bindings to the monad operations m-bind and
  100.42 +    m-result (required) and m-zero and m-plus (optional)."
  100.43 +   [operations]
  100.44 +   `(let [~'m-bind   ::undefined
  100.45 +	  ~'m-result ::undefined
  100.46 +	  ~'m-zero   ::undefined
  100.47 +	  ~'m-plus   ::undefined
  100.48 +	  ~@operations]
  100.49 +      {:m-result ~'m-result
  100.50 +       :m-bind ~'m-bind 
  100.51 +       :m-zero ~'m-zero
  100.52 +       :m-plus ~'m-plus}))
  100.53 +
  100.54 +(defmacro defmonad
  100.55 +   "Define a named monad by defining the monad operations. The definitions
  100.56 +    are written like bindings to the monad operations m-bind and
  100.57 +    m-result (required) and m-zero and m-plus (optional)."
  100.58 +
  100.59 +   ([name doc-string operations]
  100.60 +    (let [doc-name (with-meta name {:doc doc-string})]
  100.61 +      `(defmonad ~doc-name ~operations)))
  100.62 +
  100.63 +   ([name operations]
  100.64 +    `(def ~name (monad ~operations))))
  100.65 +
  100.66 +
  100.67 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100.68 +;;
  100.69 +;; Using monads
  100.70 +;;
  100.71 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100.72 +
  100.73 +(defn- add-monad-step
  100.74 +  "Add a monad comprehension step before the already transformed
  100.75 +   monad comprehension expression mexpr."
  100.76 +  [mexpr step]
  100.77 +  (let [[bform expr] step]
  100.78 +    (cond (identical? bform :when)  `(if ~expr ~mexpr ~'m-zero)
  100.79 +	  (identical? bform :let)   `(let ~expr ~mexpr)
  100.80 +	  :else (list 'm-bind expr (list 'fn [bform] mexpr)))))
  100.81 +
  100.82 +(defn- monad-expr
  100.83 +   "Transforms a monad comprehension, consisting of a list of steps
  100.84 +    and an expression defining the final value, into an expression
  100.85 +    chaining together the steps using :bind and returning the final value
  100.86 +    using :result. The steps are given as a vector of
  100.87 +    binding-variable/monadic-expression pairs."
  100.88 +   [steps expr]
  100.89 +   (when (odd? (count steps))
  100.90 +     (throw (Exception. "Odd number of elements in monad comprehension steps")))
  100.91 +   (let [rsteps (reverse (partition 2 steps))
  100.92 +	 [lr ls] (first rsteps)]
  100.93 +     (if (= lr expr)
  100.94 +       ; Optimization: if the result expression is equal to the result
  100.95 +       ; of the last computation step, we can eliminate an m-bind to
  100.96 +       ; m-result.
  100.97 +       (reduce add-monad-step
  100.98 +	       ls
  100.99 +	       (rest rsteps))
 100.100 +       ; The general case.
 100.101 +       (reduce add-monad-step
 100.102 +	       (list 'm-result expr)
 100.103 +	       rsteps))))
 100.104 +
 100.105 +(defmacro with-monad
 100.106 +   "Evaluates an expression after replacing the keywords defining the
 100.107 +    monad operations by the functions associated with these keywords
 100.108 +    in the monad definition given by name."
 100.109 +   [monad & exprs]
 100.110 +   `(let [name#      ~monad
 100.111 +	  ~'m-bind   (:m-bind name#)
 100.112 +	  ~'m-result (:m-result name#)
 100.113 +	  ~'m-zero   (:m-zero name#)
 100.114 +	  ~'m-plus   (:m-plus name#)]
 100.115 +      (with-symbol-macros ~@exprs)))
 100.116 +
 100.117 +(defmacro domonad
 100.118 +   "Monad comprehension. Takes the name of a monad, a vector of steps
 100.119 +    given as binding-form/monadic-expression pairs, and a result value
 100.120 +    specified by expr. The monadic-expression terms can use the binding
 100.121 +    variables of the previous steps.
 100.122 +    If the monad contains a definition of m-zero, the step list can also
 100.123 +    contain conditions of the form :when p, where the predicate p can
 100.124 +    contain the binding variables from all previous steps.
 100.125 +    A clause of the form :let [binding-form expr ...], where the bindings
 100.126 +    are given as a vector as for the use in let, establishes additional
 100.127 +    bindings that can be used in the following steps."
 100.128 +   ([steps expr]
 100.129 +    (monad-expr steps expr))
 100.130 +   ([name steps expr]
 100.131 +    (let [mexpr (monad-expr steps expr)]
 100.132 +      `(with-monad ~name ~mexpr))))
 100.133 +
 100.134 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.135 +;;
 100.136 +;; Defining functions used with monads
 100.137 +;;
 100.138 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.139 +
 100.140 +(defmacro defmonadfn
 100.141 +  "Like defn, but for functions that use monad operations and are used inside
 100.142 +   a with-monad block."
 100.143 +  {:arglists '([name docstring? attr-map? args expr]
 100.144 +	       [name docstring? attr-map? (args expr) ...])}
 100.145 +  [name & options]
 100.146 +  (let [[name options]  (name-with-attributes name options)
 100.147 +	fn-name (symbol (str *ns*) (format "m+%s+m" (str name)))
 100.148 +	make-fn-body    (fn [args expr]
 100.149 +			  (list (vec (concat ['m-bind 'm-result
 100.150 +					      'm-zero 'm-plus] args))
 100.151 +				(list `with-symbol-macros expr)))]
 100.152 +    (if (list? (first options))
 100.153 +      ; multiple arities
 100.154 +      (let [arglists        (map first options)
 100.155 +	    exprs           (map second options)
 100.156 +	    ]
 100.157 +	`(do
 100.158 +	   (defsymbolmacro ~name (partial ~fn-name ~'m-bind ~'m-result 
 100.159 +                                                   ~'m-zero ~'m-plus))
 100.160 +	   (defn ~fn-name ~@(map make-fn-body arglists exprs))))
 100.161 +      ; single arity
 100.162 +      (let [[args expr] options]
 100.163 +	`(do
 100.164 +	   (defsymbolmacro ~name (partial ~fn-name ~'m-bind ~'m-result 
 100.165 +                                                   ~'m-zero ~'m-plus))
 100.166 +	   (defn ~fn-name ~@(make-fn-body args expr)))))))
 100.167 +
 100.168 +
 100.169 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.170 +;;
 100.171 +;; Commonly used monad functions
 100.172 +;;
 100.173 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.174 +
 100.175 +; Define the four basic monad operations as symbol macros that
 100.176 +; expand to their unqualified symbol equivalents. This makes it possible
 100.177 +; to use them inside macro templates without having to quote them.
 100.178 +(defsymbolmacro m-result m-result)
 100.179 +(defsymbolmacro m-bind m-bind)
 100.180 +(defsymbolmacro m-zero m-zero)
 100.181 +(defsymbolmacro m-plus m-plus)
 100.182 +
 100.183 +(defmacro m-lift
 100.184 +  "Converts a function f of n arguments into a function of n
 100.185 +  monadic arguments returning a monadic value."
 100.186 +  [n f]
 100.187 +  (let [expr (take n (repeatedly #(gensym "x_")))
 100.188 +	vars (vec (take n (repeatedly #(gensym "mv_"))))
 100.189 +	steps (vec (interleave expr vars))]
 100.190 +    (list `fn vars (monad-expr steps (cons f expr)))))
 100.191 +
 100.192 +(defmonadfn m-join
 100.193 +  "Converts a monadic value containing a monadic value into a 'simple'
 100.194 +   monadic value."
 100.195 +  [m]
 100.196 +  (m-bind m identity))
 100.197 +
 100.198 +(defmonadfn m-fmap
 100.199 +  "Bind the monadic value m to the function returning (f x) for argument x"
 100.200 +  [f m]
 100.201 +  (m-bind m (fn [x] (m-result (f x)))))
 100.202 +
 100.203 +(defmonadfn m-seq
 100.204 +  "'Executes' the monadic values in ms and returns a sequence of the
 100.205 +   basic values contained in them."
 100.206 +  [ms]
 100.207 +  (reduce (fn [q p]
 100.208 +	    (m-bind p (fn [x]
 100.209 +			(m-bind q (fn [y]
 100.210 +				    (m-result (cons x y)))) )))
 100.211 +	  (m-result '())
 100.212 +	  (reverse ms)))
 100.213 +
 100.214 +(defmonadfn m-map
 100.215 +  "'Executes' the sequence of monadic values resulting from mapping
 100.216 +   f onto the values xs. f must return a monadic value."
 100.217 +  [f xs]
 100.218 +  (m-seq (map f xs)))
 100.219 +
 100.220 +(defmonadfn m-chain
 100.221 +  "Chains together monadic computation steps that are each functions
 100.222 +   of one parameter. Each step is called with the result of the previous
 100.223 +   step as its argument. (m-chain (step1 step2)) is equivalent to
 100.224 +   (fn [x] (domonad [r1 (step1 x) r2 (step2 r1)] r2))."
 100.225 +  [steps]
 100.226 +  (reduce (fn m-chain-link [chain-expr step]
 100.227 +	    (fn [v] (m-bind (chain-expr v) step)))
 100.228 +	  m-result
 100.229 +	  steps))
 100.230 +
 100.231 +(defmonadfn m-reduce
 100.232 +  "Return the reduction of (m-lift 2 f) over the list of monadic values mvs
 100.233 +   with initial value (m-result val)."
 100.234 +  ([f mvs]
 100.235 +   (if (empty? mvs)
 100.236 +     (m-result (f))
 100.237 +     (let [m-f (m-lift 2 f)]
 100.238 +       (reduce m-f mvs))))
 100.239 +  ([f val mvs]
 100.240 +   (let [m-f    (m-lift 2 f)
 100.241 +	 m-val  (m-result val)]
 100.242 +     (reduce m-f m-val mvs))))
 100.243 +
 100.244 +(defmonadfn m-until
 100.245 +  "While (p x) is false, replace x by the value returned by the
 100.246 +   monadic computation (f x). Return (m-result x) for the first
 100.247 +   x for which (p x) is true."
 100.248 +  [p f x]
 100.249 +  (if (p x)
 100.250 +    (m-result x)
 100.251 +    (domonad
 100.252 +      [y (f x)
 100.253 +       z (m-until p f y)]
 100.254 +      z)))
 100.255 +
 100.256 +(defmacro m-when
 100.257 +  "If test is logical true, return monadic value m-expr, else return
 100.258 +   (m-result nil)."
 100.259 +  [test m-expr]
 100.260 +  `(if ~test ~m-expr (~'m-result nil)))
 100.261 +
 100.262 +(defmacro m-when-not
 100.263 +  "If test if logical false, return monadic value m-expr, else return
 100.264 +   (m-result nil)."
 100.265 +  [test m-expr]
 100.266 +  `(if ~test (~'m-result nil) ~m-expr))
 100.267 +
 100.268 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.269 +;;
 100.270 +;; Utility functions used in monad definitions
 100.271 +;;
 100.272 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.273 +
 100.274 +(defn- flatten*
 100.275 +  "Like #(apply concat %), but fully lazy: it evaluates each sublist
 100.276 +   only when it is needed."
 100.277 +  [ss]
 100.278 +  (lazy-seq
 100.279 +   (when-let [s (seq ss)]
 100.280 +     (concat (first s) (flatten* (rest s))))))
 100.281 +
 100.282 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.283 +;;
 100.284 +;; Commonly used monads
 100.285 +;;
 100.286 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.287 +
 100.288 +; Identity monad
 100.289 +(defmonad identity-m
 100.290 +   "Monad describing plain computations. This monad does in fact nothing
 100.291 +    at all. It is useful for testing, for combination with monad
 100.292 +    transformers, and for code that is parameterized with a monad."
 100.293 +  [m-result identity
 100.294 +   m-bind   (fn m-result-id [mv f]
 100.295 +	      (f mv))
 100.296 +  ])
 100.297 +
 100.298 +; Maybe monad
 100.299 +(defmonad maybe-m
 100.300 +   "Monad describing computations with possible failures. Failure is
 100.301 +    represented by nil, any other value is considered valid. As soon as
 100.302 +    a step returns nil, the whole computation will yield nil as well."
 100.303 +   [m-zero   nil
 100.304 +    m-result (fn m-result-maybe [v] v)
 100.305 +    m-bind   (fn m-bind-maybe [mv f]
 100.306 +               (if (nil? mv) nil (f mv)))
 100.307 +    m-plus   (fn m-plus-maybe [& mvs]
 100.308 +	       (first (drop-while nil? mvs)))
 100.309 +    ])
 100.310 +
 100.311 +; Sequence monad (called "list monad" in Haskell)
 100.312 +(defmonad sequence-m
 100.313 +   "Monad describing multi-valued computations, i.e. computations
 100.314 +    that can yield multiple values. Any object implementing the seq
 100.315 +    protocol can be used as a monadic value."
 100.316 +   [m-result (fn m-result-sequence [v]
 100.317 +	       (list v))
 100.318 +    m-bind   (fn m-bind-sequence [mv f]
 100.319 +               (flatten* (map f mv)))
 100.320 +    m-zero   (list)
 100.321 +    m-plus   (fn m-plus-sequence [& mvs]
 100.322 +               (flatten* mvs))
 100.323 +    ])
 100.324 +
 100.325 +; Set monad
 100.326 +(defmonad set-m
 100.327 +   "Monad describing multi-valued computations, like sequence-m,
 100.328 +    but returning sets of results instead of sequences of results."
 100.329 +   [m-result (fn m-result-set [v]
 100.330 +	       #{v})
 100.331 +    m-bind   (fn m-bind-set [mv f]
 100.332 +               (apply clojure.set/union (map f mv)))
 100.333 +    m-zero   #{}
 100.334 +    m-plus   (fn m-plus-set [& mvs]
 100.335 +               (apply clojure.set/union mvs))
 100.336 +    ])
 100.337 +
 100.338 +; State monad
 100.339 +(defmonad state-m
 100.340 +   "Monad describing stateful computations. The monadic values have the
 100.341 +    structure (fn [old-state] [result new-state])."
 100.342 +   [m-result  (fn m-result-state [v]
 100.343 +	        (fn [s] [v s]))
 100.344 +    m-bind    (fn m-bind-state [mv f]
 100.345 +	        (fn [s]
 100.346 +		  (let [[v ss] (mv s)]
 100.347 +		    ((f v) ss))))
 100.348 +   ])
 100.349 +
 100.350 +(defn update-state
 100.351 +  "Return a state-monad function that replaces the current state by the
 100.352 +   result of f applied to the current state and that returns the old state."
 100.353 +  [f]
 100.354 +  (fn [s] [s (f s)]))
 100.355 +
 100.356 +(defn set-state
 100.357 +  "Return a state-monad function that replaces the current state by s and
 100.358 +   returns the previous state."
 100.359 +  [s]
 100.360 +  (update-state (fn [_] s)))
 100.361 +
 100.362 +(defn fetch-state
 100.363 +  "Return a state-monad function that returns the current state and does not
 100.364 +   modify it."
 100.365 +  []
 100.366 +  (update-state identity))
 100.367 +
 100.368 +(defn fetch-val
 100.369 +  "Return a state-monad function that assumes the state to be a map and
 100.370 +   returns the value corresponding to the given key. The state is not modified."
 100.371 +  [key]
 100.372 +  (domonad state-m
 100.373 +    [s (fetch-state)]
 100.374 +    (key s)))
 100.375 +
 100.376 +(defn update-val
 100.377 +  "Return a state-monad function that assumes the state to be a map and
 100.378 +   replaces the value associated with the given key by the return value
 100.379 +   of f applied to the old value. The old value is returned."
 100.380 +  [key f]
 100.381 +  (fn [s]
 100.382 +    (let [old-val (get s key)
 100.383 +	  new-s   (assoc s key (f old-val))]
 100.384 +      [old-val new-s])))
 100.385 +
 100.386 +(defn set-val
 100.387 +  "Return a state-monad function that assumes the state to be a map and
 100.388 +   replaces the value associated with key by val. The old value is returned."
 100.389 +  [key val]
 100.390 +  (update-val key (fn [_] val)))
 100.391 +
 100.392 +(defn with-state-field
 100.393 +  "Returns a state-monad function that expects a map as its state and
 100.394 +   runs statement (another state-monad function) on the state defined by
 100.395 +   the map entry corresponding to key. The map entry is updated with the
 100.396 +   new state returned by statement."
 100.397 +  [key statement]
 100.398 +  (fn [s]
 100.399 +    (let [substate (get s key nil)
 100.400 +	  [result new-substate] (statement substate)
 100.401 +	  new-state (assoc s key new-substate)]
 100.402 +      [result new-state])))
 100.403 +
 100.404 +(defn state-m-until
 100.405 +  "An optimized implementation of m-until for the state monad that
 100.406 +   replaces recursion by a loop."
 100.407 +  [p f x]
 100.408 +  (letfn [(until [p f x s]
 100.409 +	    (if (p x)
 100.410 +	      [x s]
 100.411 +	      (let [[x s] ((f x) s)]
 100.412 +		(recur p f x s))))]
 100.413 +    (fn [s] (until p f x s))))
 100.414 +
 100.415 +; Writer monad
 100.416 +(defn writer-m
 100.417 +  "Monad describing computations that accumulate data on the side, e.g. for
 100.418 +   logging. The monadic values have the structure [value log]. Any of the
 100.419 +   accumulators from clojure.contrib.accumulators can be used for storing the
 100.420 +   log data. Its empty value is passed as a parameter."
 100.421 +  [empty-accumulator]
 100.422 +  (monad
 100.423 +     [m-result  (fn m-result-writer [v]
 100.424 +	          [v empty-accumulator])
 100.425 +      m-bind    (fn m-bind-writer [mv f]
 100.426 +	          (let [[v1 a1] mv
 100.427 +			[v2 a2] (f v1)]
 100.428 +		    [v2 (clojure.contrib.accumulators/combine a1 a2)]))
 100.429 +     ]))
 100.430 +
 100.431 +(defmonadfn write [v]
 100.432 +  (let [[_ a] (m-result nil)]
 100.433 +    [nil (clojure.contrib.accumulators/add a v)]))
 100.434 +
 100.435 +(defn listen [mv]
 100.436 +  (let [[v a] mv] [[v a] a]))
 100.437 +
 100.438 +(defn censor [f mv]
 100.439 +  (let [[v a] mv] [v (f a)]))
 100.440 +
 100.441 +; Continuation monad
 100.442 +
 100.443 +(defmonad cont-m
 100.444 +  "Monad describing computations in continuation-passing style. The monadic
 100.445 +   values are functions that are called with a single argument representing
 100.446 +   the continuation of the computation, to which they pass their result."
 100.447 +  [m-result   (fn m-result-cont [v]
 100.448 +		(fn [c] (c v)))
 100.449 +   m-bind     (fn m-bind-cont [mv f]
 100.450 +		(fn [c]
 100.451 +		  (mv (fn [v] ((f v) c)))))
 100.452 +   ])
 100.453 +
 100.454 +(defn run-cont
 100.455 +  "Execute the computation c in the cont monad and return its result."
 100.456 +  [c]
 100.457 +  (c identity))
 100.458 +
 100.459 +(defn call-cc
 100.460 +  "A computation in the cont monad that calls function f with a single
 100.461 +   argument representing the current continuation. The function f should
 100.462 +   return a continuation (which becomes the return value of call-cc),
 100.463 +   or call the passed-in current continuation to terminate."
 100.464 +  [f]
 100.465 +  (fn [c]
 100.466 +    (let [cc (fn cc [a] (fn [_] (c a)))
 100.467 +	  rc (f cc)]
 100.468 +      (rc c))))
 100.469 +
 100.470 +
 100.471 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.472 +;;
 100.473 +;; Monad transformers
 100.474 +;;
 100.475 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100.476 +
 100.477 +(defmacro monad-transformer
 100.478 +   "Define a monad transforer in terms of the monad operations and the base
 100.479 +    monad. The argument which-m-plus chooses if m-zero and m-plus are taken
 100.480 +    from the base monad or from the transformer."
 100.481 +  [base which-m-plus operations]
 100.482 +  `(let [which-m-plus# (cond (= ~which-m-plus :m-plus-default)
 100.483 +			       (if (= ::undefined (with-monad ~base ~'m-plus))
 100.484 +			         :m-plus-from-transformer
 100.485 +			         :m-plus-from-base)
 100.486 +			     (or (= ~which-m-plus :m-plus-from-base)
 100.487 +				 (= ~which-m-plus :m-plus-from-transformer))
 100.488 +			       ~which-m-plus
 100.489 +			     :else
 100.490 +			       (throw (java.lang.IllegalArgumentException.
 100.491 +				       "undefined m-plus choice")))
 100.492 +	 combined-monad# (monad ~operations)]
 100.493 +    (if (= which-m-plus# :m-plus-from-base)
 100.494 +      (assoc combined-monad#
 100.495 +	:m-zero (with-monad ~base ~'m-zero)
 100.496 +	:m-plus (with-monad ~base ~'m-plus))
 100.497 +      combined-monad#)))
 100.498 +       
 100.499 +(defn maybe-t
 100.500 +  "Monad transformer that transforms a monad m into a monad in which
 100.501 +   the base values can be invalid (represented by nothing, which defaults
 100.502 +   to nil). The third argument chooses if m-zero and m-plus are inherited
 100.503 +   from the base monad (use :m-plus-from-base) or adopt maybe-like
 100.504 +   behaviour (use :m-plus-from-transformer). The default is :m-plus-from-base
 100.505 +   if the base monad m has a definition for m-plus, and
 100.506 +   :m-plus-from-transformer otherwise."
 100.507 +  ([m] (maybe-t m nil :m-plus-default))
 100.508 +  ([m nothing] (maybe-t m nothing :m-plus-default))
 100.509 +  ([m nothing which-m-plus]
 100.510 +   (monad-transformer m which-m-plus
 100.511 +     [m-result (with-monad m m-result)
 100.512 +      m-bind   (with-monad m
 100.513 +		 (fn m-bind-maybe-t [mv f]
 100.514 +		   (m-bind mv
 100.515 +			   (fn [x]
 100.516 +			     (if (identical? x nothing)
 100.517 +			       (m-result nothing)
 100.518 +			       (f x))))))
 100.519 +      m-zero   (with-monad m (m-result nothing))
 100.520 +      m-plus   (with-monad m
 100.521 +	         (fn m-plus-maybe-t [& mvs]
 100.522 +		   (if (empty? mvs)
 100.523 +		     (m-result nothing)
 100.524 +		     (m-bind (first mvs)
 100.525 +			     (fn [v]
 100.526 +			       (if (= v nothing)
 100.527 +				 (apply m-plus-maybe-t (rest mvs))
 100.528 +				 (m-result v)))))))
 100.529 +      ])))
 100.530 +
 100.531 +(defn sequence-t
 100.532 +  "Monad transformer that transforms a monad m into a monad in which
 100.533 +   the base values are sequences. The argument which-m-plus chooses
 100.534 +   if m-zero and m-plus are inherited from the base monad
 100.535 +   (use :m-plus-from-base) or adopt sequence-like
 100.536 +   behaviour (use :m-plus-from-transformer). The default is :m-plus-from-base
 100.537 +   if the base monad m has a definition for m-plus, and
 100.538 +   :m-plus-from-transformer otherwise."
 100.539 +  ([m] (sequence-t m :m-plus-default))
 100.540 +  ([m which-m-plus]
 100.541 +   (monad-transformer m which-m-plus
 100.542 +     [m-result (with-monad m
 100.543 +	         (fn m-result-sequence-t [v]
 100.544 +		   (m-result (list v))))
 100.545 +      m-bind   (with-monad m
 100.546 +		 (fn m-bind-sequence-t [mv f]
 100.547 +		   (m-bind mv
 100.548 +			   (fn [xs]
 100.549 +			     (m-fmap flatten*
 100.550 +				     (m-map f xs))))))
 100.551 +      m-zero   (with-monad m (m-result (list)))
 100.552 +      m-plus   (with-monad m
 100.553 +                 (fn m-plus-sequence-t [& mvs]
 100.554 +		   (m-reduce concat (list) mvs)))
 100.555 +      ])))
 100.556 +
 100.557 +;; Contributed by Jim Duey
 100.558 +(defn state-t
 100.559 +  "Monad transformer that transforms a monad m into a monad of stateful
 100.560 +  computations that have the base monad type as their result."
 100.561 +  [m]
 100.562 +  (monad [m-result (with-monad m
 100.563 +		     (fn m-result-state-t [v]
 100.564 +                       (fn [s]
 100.565 +			 (m-result [v s]))))
 100.566 +	  m-bind   (with-monad m
 100.567 +                     (fn m-bind-state-t [stm f]
 100.568 +                       (fn [s]
 100.569 +                         (m-bind (stm s)
 100.570 +                                 (fn [[v ss]]
 100.571 +                                   ((f v) ss))))))
 100.572 +          m-zero   (with-monad m
 100.573 +                     (if (= ::undefined m-zero)
 100.574 +		       ::undefined
 100.575 +		       (fn [s]
 100.576 +			 m-zero)))
 100.577 +          m-plus   (with-monad m
 100.578 +                     (if (= ::undefined m-plus)
 100.579 +		       ::undefined
 100.580 +		       (fn [& stms]
 100.581 +			 (fn [s]
 100.582 +			   (apply m-plus (map #(% s) stms))))))
 100.583 +          ]))
   101.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   101.2 +++ b/src/clojure/contrib/ns_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   101.3 @@ -0,0 +1,100 @@
   101.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   101.5 +;;  distribution terms for this software are covered by the Eclipse Public
   101.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   101.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   101.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   101.9 +;;  terms of this license.  You must not remove this notice, or any other,
  101.10 +;;  from this software.
  101.11 +
  101.12 +;;  scgilardi (gmail)
  101.13 +;;  23 April 2008
  101.14 +
  101.15 +;;  DEPRECATED in 1.2: dir and print-dir. Use dir and dir-fn in
  101.16 +;;  clojure.repl.
  101.17 +
  101.18 +(ns 
  101.19 +  ^{:author "Stephen C. Gilardi",
  101.20 +    :doc "Namespace utilities
  101.21 +
  101.22 +  get-ns          returns the namespace named by a symbol or throws
  101.23 +                  if the namespace does not exist
  101.24 +
  101.25 +  ns-vars         returns a sorted seq of symbols naming public vars
  101.26 +                  in a namespace
  101.27 +
  101.28 +  print-docs      prints documentation for the public vars in a
  101.29 +                  namespace
  101.30 +
  101.31 +  immigrate       Create a public var in this namespace for each
  101.32 +                  public var in the namespaces named by ns-names.
  101.33 +                  From James Reeves
  101.34 +
  101.35 +  vars            returns a sorted seq of symbols naming public vars
  101.36 +                  in a namespace (macro)
  101.37 +
  101.38 +  docs            prints documentation for the public vars in a
  101.39 +                  namespace (macro)"}
  101.40 +  clojure.contrib.ns-utils
  101.41 +  (:use clojure.contrib.except))
  101.42 +
  101.43 +;; Namespace Utilities
  101.44 +
  101.45 +(defn get-ns
  101.46 +  "Returns the namespace named by ns-sym or throws if the
  101.47 +  namespace does not exist"
  101.48 +  [ns-sym]
  101.49 +  (let [ns (find-ns ns-sym)]
  101.50 +    (throw-if (not ns) "Unable to find namespace: %s" ns-sym)
  101.51 +    ns))
  101.52 +
  101.53 +(defn ns-vars
  101.54 +  "Returns a sorted seq of symbols naming public vars in
  101.55 +  a namespace"
  101.56 +  [ns]
  101.57 +  (sort (map first (ns-publics ns))))
  101.58 +
  101.59 +(defn print-dir
  101.60 +  "Prints a sorted directory of public vars in a namespace"
  101.61 +  {:deprecated "1.2"}
  101.62 +  [ns]
  101.63 +  (doseq [item (ns-vars ns)]
  101.64 +    (println item)))
  101.65 +
  101.66 +(defn print-docs
  101.67 +  "Prints documentation for the public vars in a namespace"
  101.68 +  [ns]
  101.69 +  (doseq [item (ns-vars ns)]
  101.70 +    (print-doc (ns-resolve ns item))))
  101.71 +
  101.72 +;; Convenience
  101.73 +
  101.74 +(defmacro vars
  101.75 +  "Returns a sorted seq of symbols naming public vars in
  101.76 +  a namespace"
  101.77 +  [nsname]
  101.78 +  `(ns-vars (get-ns '~nsname)))
  101.79 +
  101.80 +(defmacro dir
  101.81 +  "Prints a sorted directory of public vars in a namespace"
  101.82 +  {:deprecated "1.2"}
  101.83 +  [nsname]
  101.84 +  `(print-dir (get-ns '~nsname)))
  101.85 +
  101.86 +(defmacro docs
  101.87 +  "Prints documentation for the public vars in a namespace"
  101.88 +  [nsname]
  101.89 +  `(print-docs (get-ns '~nsname)))
  101.90 +
  101.91 +(defn immigrate
  101.92 +  "Create a public var in this namespace for each public var in the
  101.93 +  namespaces named by ns-names. The created vars have the same name, root
  101.94 +  binding, and metadata as the original except that their :ns metadata
  101.95 +  value is this namespace."
  101.96 +  [& ns-names]
  101.97 +  (doseq [ns ns-names]
  101.98 +    (require ns)
  101.99 +    (doseq [[sym var] (ns-publics ns)]
 101.100 +      (let [sym (with-meta sym (assoc (meta var) :ns *ns*))]
 101.101 +        (if (.hasRoot var)
 101.102 +          (intern *ns* sym (.getRoot var))
 101.103 +          (intern *ns* sym))))))
   102.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   102.2 +++ b/src/clojure/contrib/pprint.clj	Sat Aug 21 06:25:44 2010 -0400
   102.3 @@ -0,0 +1,40 @@
   102.4 +;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure
   102.5 +
   102.6 +;; by Tom Faulhaber
   102.7 +;; April 3, 2009
   102.8 +
   102.9 +;;   Copyright (c) Tom Faulhaber, April 2009. All rights reserved.
  102.10 +;;   The use and distribution terms for this software are covered by the
  102.11 +;;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  102.12 +;;   which can be found in the file epl-v10.html at the root of this distribution.
  102.13 +;;   By using this software in any fashion, you are agreeing to be bound by
  102.14 +;;   the terms of this license.
  102.15 +;;   You must not remove this notice, or any other, from this
  102.16 +;;   software.
  102.17 +
  102.18 +;; DEPRECATED in 1.2.  Promoted to clojure.pprint
  102.19 +
  102.20 +(ns 
  102.21 +    ^{:author "Tom Faulhaber",
  102.22 +      :deprecated "1.2"
  102.23 +      :doc "This module comprises two elements:
  102.24 +1) A pretty printer for Clojure data structures, implemented in the 
  102.25 +   function \"pprint\"
  102.26 +2) A Common Lisp compatible format function, implemented as 
  102.27 +   \"cl-format\" because Clojure is using the name \"format\" 
  102.28 +   for its Java-based format function.
  102.29 +
  102.30 +See documentation for those functions for more information or complete 
  102.31 +documentation on the the clojure-contrib web site on github.",
  102.32 +       }
  102.33 +    clojure.contrib.pprint
  102.34 +  (:use clojure.contrib.pprint.utilities)
  102.35 +  (:use clojure.contrib.pprint.pretty-writer
  102.36 +        clojure.contrib.pprint.column-writer))
  102.37 +
  102.38 +
  102.39 +(load "pprint/pprint_base")
  102.40 +(load "pprint/cl_format")
  102.41 +(load "pprint/dispatch")
  102.42 +
  102.43 +nil
   103.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   103.2 +++ b/src/clojure/contrib/pprint/cl_format.clj	Sat Aug 21 06:25:44 2010 -0400
   103.3 @@ -0,0 +1,1844 @@
   103.4 +;;; cl_format.clj -- part of the pretty printer for Clojure
   103.5 +
   103.6 +;; by Tom Faulhaber
   103.7 +;; April 3, 2009
   103.8 +
   103.9 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  103.10 +;   The use and distribution terms for this software are covered by the
  103.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  103.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  103.13 +;   By using this software in any fashion, you are agreeing to be bound by
  103.14 +;   the terms of this license.
  103.15 +;   You must not remove this notice, or any other, from this software.
  103.16 +
  103.17 +;; This module implements the Common Lisp compatible format function as documented
  103.18 +;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at:
  103.19 +;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000)
  103.20 +
  103.21 +(in-ns 'clojure.contrib.pprint)
  103.22 +
  103.23 +;;; Forward references
  103.24 +(declare compile-format)
  103.25 +(declare execute-format)
  103.26 +(declare init-navigator)
  103.27 +;;; End forward references
  103.28 +
  103.29 +(defn cl-format 
  103.30 +  "An implementation of a Common Lisp compatible format function. cl-format formats its
  103.31 +arguments to an output stream or string based on the format control string given. It 
  103.32 +supports sophisticated formatting of structured data.
  103.33 +
  103.34 +Writer is an instance of java.io.Writer, true to output to *out* or nil to output 
  103.35 +to a string, format-in is the format control string and the remaining arguments 
  103.36 +are the data to be formatted.
  103.37 +
  103.38 +The format control string is a string to be output with embedded 'format directives' 
  103.39 +describing how to format the various arguments passed in.
  103.40 +
  103.41 +If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format 
  103.42 +returns nil.
  103.43 +
  103.44 +For example:
  103.45 + (let [results [46 38 22]]
  103.46 +        (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" 
  103.47 +                   (count results) results))
  103.48 +
  103.49 +Prints to *out*:
  103.50 + There are 3 results: 46, 38, 22
  103.51 +
  103.52 +Detailed documentation on format control strings is available in the \"Common Lisp the 
  103.53 +Language, 2nd edition\", Chapter 22 (available online at:
  103.54 +http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) 
  103.55 +and in the Common Lisp HyperSpec at 
  103.56 +http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm
  103.57 +"
  103.58 +  {:see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" 
  103.59 +               "Common Lisp the Language"]
  103.60 +              ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm"
  103.61 +               "Common Lisp HyperSpec"]]}
  103.62 +  [writer format-in & args]
  103.63 +  (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
  103.64 +        navigator (init-navigator args)]
  103.65 +    (execute-format writer compiled-format navigator)))
  103.66 +
  103.67 +(def ^{:private true} *format-str* nil)
  103.68 +
  103.69 +(defn- format-error [message offset] 
  103.70 +  (let [full-message (str message \newline *format-str* \newline 
  103.71 +                           (apply str (repeat offset \space)) "^" \newline)]
  103.72 +    (throw (RuntimeException. full-message))))
  103.73 +
  103.74 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103.75 +;;; Argument navigators manage the argument list
  103.76 +;;; as the format statement moves through the list
  103.77 +;;; (possibly going forwards and backwards as it does so)
  103.78 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103.79 +
  103.80 +(defstruct ^{:private true}
  103.81 +  arg-navigator :seq :rest :pos )
  103.82 +
  103.83 +(defn init-navigator 
  103.84 +  "Create a new arg-navigator from the sequence with the position set to 0"
  103.85 +  {:skip-wiki true}
  103.86 +  [s]
  103.87 +  (let [s (seq s)]
  103.88 +    (struct arg-navigator s s 0)))
  103.89 +
  103.90 +;; TODO call format-error with offset
  103.91 +(defn- next-arg [ navigator ]
  103.92 +  (let [ rst (:rest navigator) ]
  103.93 +    (if rst
  103.94 +      [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
  103.95 +     (throw (new Exception  "Not enough arguments for format definition")))))
  103.96 +
  103.97 +(defn- next-arg-or-nil [navigator]
  103.98 +  (let [rst (:rest navigator)]
  103.99 +    (if rst
 103.100 +      [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
 103.101 +      [nil navigator])))
 103.102 +
 103.103 +;; Get an argument off the arg list and compile it if it's not already compiled
 103.104 +(defn- get-format-arg [navigator]
 103.105 +  (let [[raw-format navigator] (next-arg navigator)
 103.106 +        compiled-format (if (instance? String raw-format) 
 103.107 +                               (compile-format raw-format)
 103.108 +                               raw-format)]
 103.109 +    [compiled-format navigator]))
 103.110 +
 103.111 +(declare relative-reposition)
 103.112 +
 103.113 +(defn- absolute-reposition [navigator position]
 103.114 +  (if (>= position (:pos navigator))
 103.115 +    (relative-reposition navigator (- (:pos navigator) position))
 103.116 +    (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position)))
 103.117 +
 103.118 +(defn- relative-reposition [navigator position]
 103.119 +  (let [newpos (+ (:pos navigator) position)]
 103.120 +    (if (neg? position)
 103.121 +      (absolute-reposition navigator newpos)
 103.122 +      (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos))))
 103.123 +
 103.124 +(defstruct ^{:private true}
 103.125 +  compiled-directive :func :def :params :offset)
 103.126 +
 103.127 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.128 +;;; When looking at the parameter list, we may need to manipulate
 103.129 +;;; the argument list as well (for 'V' and '#' parameter types).
 103.130 +;;; We hide all of this behind a function, but clients need to
 103.131 +;;; manage changing arg navigator
 103.132 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.133 +
 103.134 +;; TODO: validate parameters when they come from arg list
 103.135 +(defn- realize-parameter [[param [raw-val offset]] navigator]
 103.136 +  (let [[real-param new-navigator]
 103.137 +        (cond 
 103.138 +         (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary
 103.139 +         [raw-val navigator]
 103.140 +
 103.141 +         (= raw-val :parameter-from-args) 
 103.142 +         (next-arg navigator)
 103.143 +
 103.144 +         (= raw-val :remaining-arg-count) 
 103.145 +         [(count (:rest navigator)) navigator]
 103.146 +
 103.147 +         true 
 103.148 +         [raw-val navigator])]
 103.149 +    [[param [real-param offset]] new-navigator]))
 103.150 +         
 103.151 +(defn- realize-parameter-list [parameter-map navigator]
 103.152 +  (let [[pairs new-navigator] 
 103.153 +        (map-passing-context realize-parameter navigator parameter-map)]
 103.154 +    [(into {} pairs) new-navigator]))
 103.155 +
 103.156 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.157 +;;; Functions that support individual directives
 103.158 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.159 +
 103.160 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.161 +;;; Common handling code for ~A and ~S
 103.162 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.163 +
 103.164 +(declare opt-base-str)
 103.165 +
 103.166 +(def ^{:private true}
 103.167 +     special-radix-markers {2 "#b" 8 "#o", 16 "#x"})
 103.168 +
 103.169 +(defn- format-simple-number [n]
 103.170 +  (cond 
 103.171 +    (integer? n) (if (= *print-base* 10)
 103.172 +                   (str n (if *print-radix* "."))
 103.173 +                   (str
 103.174 +                    (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
 103.175 +                    (opt-base-str *print-base* n)))
 103.176 +    (ratio? n) (str
 103.177 +                (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
 103.178 +                (opt-base-str *print-base* (.numerator n))
 103.179 +                "/"
 103.180 +                (opt-base-str *print-base* (.denominator n)))
 103.181 +    :else nil))
 103.182 +
 103.183 +(defn- format-ascii [print-func params arg-navigator offsets]
 103.184 +  (let [ [arg arg-navigator] (next-arg arg-navigator) 
 103.185 +         ^String base-output (or (format-simple-number arg) (print-func arg))
 103.186 +         base-width (.length base-output)
 103.187 +         min-width (+ base-width (:minpad params))
 103.188 +         width (if (>= min-width (:mincol params)) 
 103.189 +                 min-width
 103.190 +                 (+ min-width 
 103.191 +                    (* (+ (quot (- (:mincol params) min-width 1) 
 103.192 +                                (:colinc params) )
 103.193 +                          1)
 103.194 +                       (:colinc params))))
 103.195 +         chars (apply str (repeat (- width base-width) (:padchar params)))]
 103.196 +    (if (:at params)
 103.197 +      (print (str chars base-output))
 103.198 +      (print (str base-output chars)))
 103.199 +    arg-navigator))
 103.200 +
 103.201 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.202 +;;; Support for the integer directives ~D, ~X, ~O, ~B and some
 103.203 +;;; of ~R
 103.204 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.205 +
 103.206 +(defn- integral?
 103.207 +  "returns true if a number is actually an integer (that is, has no fractional part)"
 103.208 +  [x]
 103.209 +  (cond
 103.210 +   (integer? x) true
 103.211 +   (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part
 103.212 +   (float? x)   (= x (Math/floor x))
 103.213 +   (ratio? x)   (let [^clojure.lang.Ratio r x]
 103.214 +                  (= 0 (rem (.numerator r) (.denominator r))))
 103.215 +   :else        false))
 103.216 +
 103.217 +(defn- remainders
 103.218 +  "Return the list of remainders (essentially the 'digits') of val in the given base"
 103.219 +  [base val]
 103.220 +  (reverse 
 103.221 +   (first 
 103.222 +    (consume #(if (pos? %) 
 103.223 +                [(rem % base) (quot % base)] 
 103.224 +                [nil nil]) 
 103.225 +             val))))
 103.226 +
 103.227 +;;; TODO: xlated-val does not seem to be used here.
 103.228 +(defn- base-str
 103.229 +  "Return val as a string in the given base"
 103.230 +  [base val]
 103.231 +  (if (zero? val)
 103.232 +    "0"
 103.233 +    (let [xlated-val (cond
 103.234 +                       (float? val) (bigdec val)
 103.235 +                       (ratio? val) (let [^clojure.lang.Ratio r val] 
 103.236 +                                      (/ (.numerator r) (.denominator r)))
 103.237 +                       :else val)] 
 103.238 +      (apply str 
 103.239 +             (map 
 103.240 +              #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) 
 103.241 +              (remainders base val))))))
 103.242 +
 103.243 +(def ^{:private true}
 103.244 +     java-base-formats {8 "%o", 10 "%d", 16 "%x"})
 103.245 +
 103.246 +(defn- opt-base-str
 103.247 +  "Return val as a string in the given base, using clojure.core/format if supported
 103.248 +for improved performance"
 103.249 +  [base val]
 103.250 +  (let [format-str (get java-base-formats base)]
 103.251 +    (if (and format-str (integer? val) (-> val class .getName (.startsWith "java.")))
 103.252 +      (clojure.core/format format-str val)
 103.253 +      (base-str base val))))
 103.254 +
 103.255 +(defn- group-by* [unit lis]
 103.256 +  (reverse
 103.257 +   (first
 103.258 +    (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis)))))
 103.259 +
 103.260 +(defn- format-integer [base params arg-navigator offsets]
 103.261 +  (let [[arg arg-navigator] (next-arg arg-navigator)]
 103.262 +    (if (integral? arg)
 103.263 +      (let [neg (neg? arg)
 103.264 +            pos-arg (if neg (- arg) arg)
 103.265 +            raw-str (opt-base-str base pos-arg)
 103.266 +            group-str (if (:colon params)
 103.267 +                        (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str))
 103.268 +                              commas (repeat (count groups) (:commachar params))]
 103.269 +                          (apply str (next (interleave commas groups))))
 103.270 +                        raw-str)
 103.271 +            ^String signed-str (cond
 103.272 +                                  neg (str "-" group-str)
 103.273 +                                  (:at params) (str "+" group-str)
 103.274 +                                  true group-str)
 103.275 +            padded-str (if (< (.length signed-str) (:mincol params))
 103.276 +                         (str (apply str (repeat (- (:mincol params) (.length signed-str)) 
 103.277 +                                                 (:padchar params)))
 103.278 +                              signed-str)
 103.279 +                         signed-str)]
 103.280 +        (print padded-str))
 103.281 +      (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 
 103.282 +                               :padchar (:padchar params) :at true} 
 103.283 +                    (init-navigator [arg]) nil))
 103.284 +    arg-navigator))
 103.285 +
 103.286 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.287 +;;; Support for english formats (~R and ~:R)
 103.288 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.289 +
 103.290 +(def ^{:private true}
 103.291 +     english-cardinal-units 
 103.292 +     ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"
 103.293 +      "ten" "eleven" "twelve" "thirteen" "fourteen"
 103.294 +      "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"])
 103.295 +
 103.296 +(def ^{:private true}
 103.297 +     english-ordinal-units 
 103.298 +     ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth"
 103.299 +      "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth"
 103.300 +      "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"])
 103.301 +
 103.302 +(def ^{:private true}
 103.303 +     english-cardinal-tens
 103.304 +     ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"])
 103.305 +
 103.306 +(def ^{:private true}
 103.307 +     english-ordinal-tens
 103.308 +     ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth"
 103.309 +      "sixtieth" "seventieth" "eightieth" "ninetieth"])
 103.310 +
 103.311 +;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales)
 103.312 +;; Number names from http://www.jimloy.com/math/billion.htm
 103.313 +;; We follow the rules for writing numbers from the Blue Book
 103.314 +;; (http://www.grammarbook.com/numbers/numbers.asp)
 103.315 +(def ^{:private true}
 103.316 +     english-scale-numbers 
 103.317 +     ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" 
 103.318 +      "sextillion" "septillion" "octillion" "nonillion" "decillion" 
 103.319 +      "undecillion" "duodecillion" "tredecillion" "quattuordecillion" 
 103.320 +      "quindecillion" "sexdecillion" "septendecillion" 
 103.321 +      "octodecillion" "novemdecillion" "vigintillion"])
 103.322 +
 103.323 +(defn- format-simple-cardinal
 103.324 +  "Convert a number less than 1000 to a cardinal english string"
 103.325 +  [num]
 103.326 +  (let [hundreds (quot num 100)
 103.327 +        tens (rem num 100)]
 103.328 +    (str
 103.329 +     (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred"))
 103.330 +     (if (and (pos? hundreds) (pos? tens)) " ")
 103.331 +     (if (pos? tens) 
 103.332 +       (if (< tens 20) 
 103.333 +         (nth english-cardinal-units tens)
 103.334 +         (let [ten-digit (quot tens 10)
 103.335 +               unit-digit (rem tens 10)]
 103.336 +           (str
 103.337 +            (if (pos? ten-digit) (nth english-cardinal-tens ten-digit))
 103.338 +            (if (and (pos? ten-digit) (pos? unit-digit)) "-")
 103.339 +            (if (pos? unit-digit) (nth english-cardinal-units unit-digit)))))))))
 103.340 +
 103.341 +(defn- add-english-scales
 103.342 +  "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string
 103.343 +offset is a factor of 10^3 to multiply by"
 103.344 +  [parts offset]
 103.345 +  (let [cnt (count parts)]
 103.346 +    (loop [acc []
 103.347 +           pos (dec cnt)
 103.348 +           this (first parts)
 103.349 +           remainder (next parts)]
 103.350 +      (if (nil? remainder)
 103.351 +        (str (apply str (interpose ", " acc))
 103.352 +             (if (and (not (empty? this)) (not (empty? acc))) ", ")
 103.353 +             this
 103.354 +             (if (and (not (empty? this)) (pos? (+ pos offset)))
 103.355 +               (str " " (nth english-scale-numbers (+ pos offset)))))
 103.356 +        (recur 
 103.357 +         (if (empty? this)
 103.358 +           acc
 103.359 +           (conj acc (str this " " (nth english-scale-numbers (+ pos offset)))))
 103.360 +         (dec pos)
 103.361 +         (first remainder)
 103.362 +         (next remainder))))))
 103.363 +
 103.364 +(defn- format-cardinal-english [params navigator offsets]
 103.365 +  (let [[arg navigator] (next-arg navigator)]
 103.366 +    (if (= 0 arg)
 103.367 +      (print "zero")
 103.368 +      (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs
 103.369 +            parts (remainders 1000 abs-arg)]
 103.370 +        (if (<= (count parts) (count english-scale-numbers))
 103.371 +          (let [parts-strs (map format-simple-cardinal parts)
 103.372 +                full-str (add-english-scales parts-strs 0)]
 103.373 +            (print (str (if (neg? arg) "minus ") full-str)))
 103.374 +          (format-integer ;; for numbers > 10^63, we fall back on ~D
 103.375 +           10
 103.376 +           { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true}
 103.377 +           (init-navigator [arg])
 103.378 +           { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}))))
 103.379 +    navigator))
 103.380 +
 103.381 +(defn- format-simple-ordinal
 103.382 +  "Convert a number less than 1000 to a ordinal english string
 103.383 +Note this should only be used for the last one in the sequence"
 103.384 +  [num]
 103.385 +  (let [hundreds (quot num 100)
 103.386 +        tens (rem num 100)]
 103.387 +    (str
 103.388 +     (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred"))
 103.389 +     (if (and (pos? hundreds) (pos? tens)) " ")
 103.390 +     (if (pos? tens) 
 103.391 +       (if (< tens 20) 
 103.392 +         (nth english-ordinal-units tens)
 103.393 +         (let [ten-digit (quot tens 10)
 103.394 +               unit-digit (rem tens 10)]
 103.395 +           (if (and (pos? ten-digit) (not (pos? unit-digit)))
 103.396 +             (nth english-ordinal-tens ten-digit)
 103.397 +             (str
 103.398 +              (if (pos? ten-digit) (nth english-cardinal-tens ten-digit))
 103.399 +              (if (and (pos? ten-digit) (pos? unit-digit)) "-")
 103.400 +              (if (pos? unit-digit) (nth english-ordinal-units unit-digit))))))
 103.401 +       (if (pos? hundreds) "th")))))
 103.402 +
 103.403 +(defn- format-ordinal-english [params navigator offsets]
 103.404 +  (let [[arg navigator] (next-arg navigator)]
 103.405 +    (if (= 0 arg)
 103.406 +      (print "zeroth")
 103.407 +      (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs
 103.408 +            parts (remainders 1000 abs-arg)]
 103.409 +        (if (<= (count parts) (count english-scale-numbers))
 103.410 +          (let [parts-strs (map format-simple-cardinal (drop-last parts))
 103.411 +                head-str (add-english-scales parts-strs 1)
 103.412 +                tail-str (format-simple-ordinal (last parts))]
 103.413 +            (print (str (if (neg? arg) "minus ") 
 103.414 +                        (cond 
 103.415 +                         (and (not (empty? head-str)) (not (empty? tail-str))) 
 103.416 +                         (str head-str ", " tail-str)
 103.417 +                         
 103.418 +                         (not (empty? head-str)) (str head-str "th")
 103.419 +                         :else tail-str))))
 103.420 +          (do (format-integer ;; for numbers > 10^63, we fall back on ~D
 103.421 +               10
 103.422 +               { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true}
 103.423 +               (init-navigator [arg])
 103.424 +               { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})
 103.425 +              (let [low-two-digits (rem arg 100)
 103.426 +                    not-teens (or (< 11 low-two-digits) (> 19 low-two-digits))
 103.427 +                    low-digit (rem low-two-digits 10)]
 103.428 +                (print (cond 
 103.429 +                        (and (== low-digit 1) not-teens) "st"
 103.430 +                        (and (== low-digit 2) not-teens) "nd"
 103.431 +                        (and (== low-digit 3) not-teens) "rd"
 103.432 +                        :else "th")))))))
 103.433 +    navigator))
 103.434 +
 103.435 +
 103.436 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.437 +;;; Support for roman numeral formats (~@R and ~@:R)
 103.438 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.439 +
 103.440 +(def ^{:private true}
 103.441 +     old-roman-table
 103.442 +     [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"]
 103.443 +      [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"]
 103.444 +      [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"]
 103.445 +      [ "M" "MM" "MMM"]])
 103.446 +
 103.447 +(def ^{:private true}
 103.448 +     new-roman-table
 103.449 +     [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"]
 103.450 +      [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"]
 103.451 +      [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"]
 103.452 +      [ "M" "MM" "MMM"]])
 103.453 +
 103.454 +(defn- format-roman
 103.455 +  "Format a roman numeral using the specified look-up table"
 103.456 +  [table params navigator offsets]
 103.457 +  (let [[arg navigator] (next-arg navigator)]
 103.458 +    (if (and (number? arg) (> arg 0) (< arg 4000))
 103.459 +      (let [digits (remainders 10 arg)]
 103.460 +        (loop [acc []
 103.461 +               pos (dec (count digits))
 103.462 +               digits digits]
 103.463 +          (if (empty? digits)
 103.464 +            (print (apply str acc))
 103.465 +            (let [digit (first digits)]
 103.466 +              (recur (if (= 0 digit) 
 103.467 +                       acc 
 103.468 +                       (conj acc (nth (nth table pos) (dec digit))))
 103.469 +                     (dec pos)
 103.470 +                     (next digits))))))
 103.471 +      (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D
 103.472 +           10
 103.473 +           { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true}
 103.474 +           (init-navigator [arg])
 103.475 +           { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}))
 103.476 +    navigator))
 103.477 +
 103.478 +(defn- format-old-roman [params navigator offsets]
 103.479 +  (format-roman old-roman-table params navigator offsets))
 103.480 +
 103.481 +(defn- format-new-roman [params navigator offsets]
 103.482 +  (format-roman new-roman-table params navigator offsets))
 103.483 +
 103.484 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.485 +;;; Support for character formats (~C)
 103.486 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.487 +
 103.488 +(def ^{:private true} 
 103.489 +     special-chars { 8 "Backspace", 9 "Tab",  10 "Newline", 13 "Return", 32 "Space"})
 103.490 +
 103.491 +(defn- pretty-character [params navigator offsets]
 103.492 +  (let [[c navigator] (next-arg navigator)
 103.493 +        as-int (int c)
 103.494 +        base-char (bit-and as-int 127)
 103.495 +        meta (bit-and as-int 128)
 103.496 +        special (get special-chars base-char)]
 103.497 +    (if (> meta 0) (print "Meta-"))
 103.498 +    (print (cond
 103.499 +            special special
 103.500 +            (< base-char 32) (str "Control-" (char (+ base-char 64)))
 103.501 +            (= base-char 127) "Control-?"
 103.502 +            :else (char base-char)))
 103.503 +    navigator))
 103.504 +
 103.505 +(defn- readable-character [params navigator offsets]
 103.506 +  (let [[c navigator] (next-arg navigator)]
 103.507 +    (condp = (:char-format params)
 103.508 +      \o (cl-format true "\\o~3,'0o" (int c))
 103.509 +      \u (cl-format true "\\u~4,'0x" (int c))
 103.510 +      nil (pr c))
 103.511 +    navigator))
 103.512 +
 103.513 +(defn- plain-character [params navigator offsets]
 103.514 +  (let [[char navigator] (next-arg navigator)]
 103.515 +    (print char)
 103.516 +    navigator))
 103.517 +
 103.518 +;; Check to see if a result is an abort (~^) construct
 103.519 +;; TODO: move these funcs somewhere more appropriate
 103.520 +(defn- abort? [context]
 103.521 +  (let [token (first context)]
 103.522 +    (or (= :up-arrow token) (= :colon-up-arrow token))))
 103.523 +
 103.524 +;; Handle the execution of "sub-clauses" in bracket constructions
 103.525 +(defn- execute-sub-format [format args base-args]
 103.526 +  (second
 103.527 +   (map-passing-context 
 103.528 +    (fn [element context]
 103.529 +      (if (abort? context)
 103.530 +        [nil context] ; just keep passing it along
 103.531 +        (let [[params args] (realize-parameter-list (:params element) context)
 103.532 +              [params offsets] (unzip-map params)
 103.533 +              params (assoc params :base-args base-args)]
 103.534 +          [nil (apply (:func element) [params args offsets])])))
 103.535 +    args
 103.536 +    format)))
 103.537 +
 103.538 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.539 +;;; Support for real number formats
 103.540 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.541 +
 103.542 +;; TODO - return exponent as int to eliminate double conversion
 103.543 +(defn- float-parts-base
 103.544 +  "Produce string parts for the mantissa (normalized 1-9) and exponent"
 103.545 +  [^Object f]
 103.546 +  (let [^String s (.toLowerCase (.toString f))
 103.547 +        exploc (.indexOf s (int \e))]
 103.548 +    (if (neg? exploc)
 103.549 +      (let [dotloc (.indexOf s (int \.))]
 103.550 +        (if (neg? dotloc)
 103.551 +          [s (str (dec (count s)))]
 103.552 +          [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))]))
 103.553 +      [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))])))
 103.554 +
 103.555 +
 103.556 +(defn- float-parts
 103.557 +  "Take care of leading and trailing zeros in decomposed floats"
 103.558 +  [f]
 103.559 +  (let [[m ^String e] (float-parts-base f)
 103.560 +        m1 (rtrim m \0)
 103.561 +        m2 (ltrim m1 \0)
 103.562 +        delta (- (count m1) (count m2))
 103.563 +        ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)]
 103.564 +    (if (empty? m2)
 103.565 +      ["0" 0]
 103.566 +      [m2 (- (Integer/valueOf e) delta)])))
 103.567 +
 103.568 +(defn- round-str [m e d w]
 103.569 +  (if (or d w)
 103.570 +    (let [len (count m)
 103.571 +          round-pos (if d (+ e d 1))
 103.572 +          round-pos (if (and w (< (inc e) (dec w)) 
 103.573 +                             (or (nil? round-pos) (< (dec w) round-pos)))
 103.574 +                      (dec w)
 103.575 +                      round-pos)
 103.576 +          [m1 e1 round-pos len] (if (= round-pos 0) 
 103.577 +                                  [(str "0" m) (inc e) 1 (inc len)]
 103.578 +                                  [m e round-pos len])]
 103.579 +      (if round-pos
 103.580 +        (if (neg? round-pos)
 103.581 +          ["0" 0 false]
 103.582 +          (if (> len round-pos)
 103.583 +            (let [round-char (nth m1 round-pos)
 103.584 +                  ^String result (subs m1 0 round-pos)]
 103.585 +              (if (>= (int round-char) (int \5))
 103.586 +                (let [result-val (Integer/valueOf result)
 103.587 +                      leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1)))
 103.588 +                      round-up-result (str leading-zeros
 103.589 +                                           (String/valueOf (+ result-val 
 103.590 +                                                              (if (neg? result-val) -1 1))))
 103.591 +                      expanded (> (count round-up-result) (count result))]
 103.592 +                  [round-up-result e1 expanded])
 103.593 +                [result e1 false]))
 103.594 +            [m e false]))
 103.595 +        [m e false]))
 103.596 +    [m e false]))
 103.597 +
 103.598 +(defn- expand-fixed [m e d]
 103.599 +  (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m)
 103.600 +        len (count m1)
 103.601 +        target-len (if d (+ e d 1) (inc e))]
 103.602 +    (if (< len target-len) 
 103.603 +      (str m1 (apply str (repeat (- target-len len) \0))) 
 103.604 +      m1)))
 103.605 +
 103.606 +(defn- insert-decimal
 103.607 +  "Insert the decimal point at the right spot in the number to match an exponent"
 103.608 +  [m e]
 103.609 +  (if (neg? e)
 103.610 +    (str "." m)
 103.611 +    (let [loc (inc e)]
 103.612 +      (str (subs m 0 loc) "." (subs m loc)))))
 103.613 +
 103.614 +(defn- get-fixed [m e d]
 103.615 +  (insert-decimal (expand-fixed m e d) e))
 103.616 +
 103.617 +(defn- insert-scaled-decimal
 103.618 +  "Insert the decimal point at the right spot in the number to match an exponent"
 103.619 +  [m k]
 103.620 +  (if (neg? k)
 103.621 +    (str "." m)
 103.622 +    (str (subs m 0 k) "." (subs m k))))
 103.623 +
 103.624 +;; the function to render ~F directives
 103.625 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 103.626 +(defn- fixed-float [params navigator offsets]
 103.627 +  (let [w (:w params)
 103.628 +        d (:d params)
 103.629 +        [arg navigator] (next-arg navigator)
 103.630 +        [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg])
 103.631 +        [mantissa exp] (float-parts abs)
 103.632 +        scaled-exp (+ exp (:k params))
 103.633 +        add-sign (or (:at params) (neg? arg))
 103.634 +        append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp))
 103.635 +        [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp 
 103.636 +                                                          d (if w (- w (if add-sign 1 0))))
 103.637 +        fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d)
 103.638 +        prepend-zero (= (first fixed-repr) \.)]
 103.639 +    (if w
 103.640 +      (let [len (count fixed-repr)
 103.641 +            signed-len (if add-sign (inc len) len)
 103.642 +            prepend-zero (and prepend-zero (not (>= signed-len w)))
 103.643 +            append-zero (and append-zero (not (>= signed-len w)))
 103.644 +            full-len (if (or prepend-zero append-zero)
 103.645 +                       (inc signed-len) 
 103.646 +                       signed-len)]
 103.647 +        (if (and (> full-len w) (:overflowchar params))
 103.648 +          (print (apply str (repeat w (:overflowchar params))))
 103.649 +          (print (str
 103.650 +                  (apply str (repeat (- w full-len) (:padchar params)))
 103.651 +                  (if add-sign sign) 
 103.652 +                  (if prepend-zero "0")
 103.653 +                  fixed-repr
 103.654 +                  (if append-zero "0")))))
 103.655 +      (print (str
 103.656 +              (if add-sign sign) 
 103.657 +              (if prepend-zero "0")
 103.658 +              fixed-repr
 103.659 +              (if append-zero "0"))))
 103.660 +    navigator))
 103.661 +
 103.662 +
 103.663 +;; the function to render ~E directives
 103.664 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 103.665 +;; TODO: define ~E representation for Infinity
 103.666 +(defn- exponential-float [params navigator offsets]
 103.667 +  (let [[arg navigator] (next-arg navigator)]
 103.668 +    (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))]
 103.669 +      (let [w (:w params)
 103.670 +            d (:d params)
 103.671 +            e (:e params)
 103.672 +            k (:k params)
 103.673 +            expchar (or (:exponentchar params) \E)
 103.674 +            add-sign (or (:at params) (neg? arg))
 103.675 +            prepend-zero (<= k 0)
 103.676 +            ^Integer scaled-exp (- exp (dec k))
 103.677 +            scaled-exp-str (str (Math/abs scaled-exp))
 103.678 +            scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) 
 103.679 +                                (if e (apply str 
 103.680 +                                             (repeat 
 103.681 +                                              (- e 
 103.682 +                                                 (count scaled-exp-str)) 
 103.683 +                                              \0))) 
 103.684 +                                scaled-exp-str)
 103.685 +            exp-width (count scaled-exp-str)
 103.686 +            base-mantissa-width (count mantissa)
 103.687 +            scaled-mantissa (str (apply str (repeat (- k) \0))
 103.688 +                                 mantissa
 103.689 +                                 (if d 
 103.690 +                                   (apply str 
 103.691 +                                          (repeat 
 103.692 +                                           (- d (dec base-mantissa-width)
 103.693 +                                              (if (neg? k) (- k) 0)) \0))))
 103.694 +            w-mantissa (if w (- w exp-width))
 103.695 +            [rounded-mantissa _ incr-exp] (round-str 
 103.696 +                                           scaled-mantissa 0
 103.697 +                                           (cond
 103.698 +                                            (= k 0) (dec d)
 103.699 +                                            (pos? k) d
 103.700 +                                            (neg? k) (dec d))
 103.701 +                                           (if w-mantissa 
 103.702 +                                             (- w-mantissa (if add-sign 1 0))))
 103.703 +            full-mantissa (insert-scaled-decimal rounded-mantissa k)
 103.704 +            append-zero (and (= k (count rounded-mantissa)) (nil? d))]
 103.705 +        (if (not incr-exp)
 103.706 +          (if w
 103.707 +            (let [len (+ (count full-mantissa) exp-width)
 103.708 +                  signed-len (if add-sign (inc len) len)
 103.709 +                  prepend-zero (and prepend-zero (not (= signed-len w)))
 103.710 +                  full-len (if prepend-zero (inc signed-len) signed-len)
 103.711 +                  append-zero (and append-zero (< full-len w))]
 103.712 +              (if (and (or (> full-len w) (and e (> (- exp-width 2) e)))
 103.713 +                       (:overflowchar params))
 103.714 +                (print (apply str (repeat w (:overflowchar params))))
 103.715 +                (print (str
 103.716 +                        (apply str 
 103.717 +                               (repeat 
 103.718 +                                (- w full-len (if append-zero 1 0) )
 103.719 +                                (:padchar params)))
 103.720 +                        (if add-sign (if (neg? arg) \- \+)) 
 103.721 +                        (if prepend-zero "0")
 103.722 +                        full-mantissa
 103.723 +                        (if append-zero "0")
 103.724 +                        scaled-exp-str))))
 103.725 +            (print (str
 103.726 +                    (if add-sign (if (neg? arg) \- \+)) 
 103.727 +                    (if prepend-zero "0")
 103.728 +                    full-mantissa
 103.729 +                    (if append-zero "0")
 103.730 +                    scaled-exp-str)))
 103.731 +          (recur [rounded-mantissa (inc exp)]))))
 103.732 +    navigator))
 103.733 +
 103.734 +;; the function to render ~G directives
 103.735 +;; This just figures out whether to pass the request off to ~F or ~E based 
 103.736 +;; on the algorithm in CLtL.
 103.737 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 103.738 +;; TODO: refactor so that float-parts isn't called twice
 103.739 +(defn- general-float [params navigator offsets]
 103.740 +  (let [[arg _] (next-arg navigator)
 103.741 +        [mantissa exp] (float-parts (if (neg? arg) (- arg) arg))
 103.742 +        w (:w params)
 103.743 +        d (:d params)
 103.744 +        e (:e params)
 103.745 +        n (if (= arg 0.0) 0 (inc exp))
 103.746 +        ee (if e (+ e 2) 4)
 103.747 +        ww (if w (- w ee))
 103.748 +        d (if d d (max (count mantissa) (min n 7)))
 103.749 +        dd (- d n)]
 103.750 +    (if (<= 0 dd d)
 103.751 +      (let [navigator (fixed-float {:w ww, :d dd, :k 0, 
 103.752 +                                    :overflowchar (:overflowchar params),
 103.753 +                                    :padchar (:padchar params), :at (:at params)} 
 103.754 +                                   navigator offsets)]
 103.755 +        (print (apply str (repeat ee \space)))
 103.756 +        navigator)
 103.757 +      (exponential-float params navigator offsets))))
 103.758 +
 103.759 +;; the function to render ~$ directives
 103.760 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 103.761 +(defn- dollar-float [params navigator offsets]
 103.762 +  (let [[^Double arg navigator] (next-arg navigator)
 103.763 +        [mantissa exp] (float-parts (Math/abs arg))
 103.764 +        d (:d params) ; digits after the decimal
 103.765 +        n (:n params) ; minimum digits before the decimal
 103.766 +        w (:w params) ; minimum field width
 103.767 +        add-sign (or (:at params) (neg? arg))
 103.768 +        [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil)
 103.769 +        ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d)
 103.770 +        full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr)
 103.771 +        full-len (+ (count full-repr) (if add-sign 1 0))]
 103.772 +    (print (str
 103.773 +            (if (and (:colon params) add-sign) (if (neg? arg) \- \+))
 103.774 +            (apply str (repeat (- w full-len) (:padchar params)))
 103.775 +            (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+))
 103.776 +            full-repr))
 103.777 +    navigator))
 103.778 +        
 103.779 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.780 +;;; Support for the '~[...~]' conditional construct in its
 103.781 +;;; different flavors
 103.782 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.783 +
 103.784 +;; ~[...~] without any modifiers chooses one of the clauses based on the param or 
 103.785 +;; next argument
 103.786 +;; TODO check arg is positive int
 103.787 +(defn- choice-conditional [params arg-navigator offsets]
 103.788 +  (let [arg (:selector params)
 103.789 +        [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator))
 103.790 +        clauses (:clauses params)
 103.791 +        clause (if (or (neg? arg) (>= arg (count clauses)))
 103.792 +                 (first (:else params))
 103.793 +                 (nth clauses arg))]
 103.794 +    (if clause
 103.795 +      (execute-sub-format clause navigator (:base-args params))
 103.796 +      navigator)))
 103.797 +
 103.798 +;; ~:[...~] with the colon reads the next argument treating it as a truth value
 103.799 +(defn- boolean-conditional [params arg-navigator offsets]
 103.800 +  (let [[arg navigator] (next-arg arg-navigator)
 103.801 +        clauses (:clauses params)
 103.802 +        clause (if arg
 103.803 +                 (second clauses)
 103.804 +                 (first clauses))]
 103.805 +    (if clause
 103.806 +      (execute-sub-format clause navigator (:base-args params))
 103.807 +      navigator)))
 103.808 +
 103.809 +;; ~@[...~] with the at sign executes the conditional if the next arg is not
 103.810 +;; nil/false without consuming the arg
 103.811 +(defn- check-arg-conditional [params arg-navigator offsets]
 103.812 +  (let [[arg navigator] (next-arg arg-navigator)
 103.813 +        clauses (:clauses params)
 103.814 +        clause (if arg (first clauses))]
 103.815 +    (if arg
 103.816 +      (if clause
 103.817 +        (execute-sub-format clause arg-navigator (:base-args params))
 103.818 +        arg-navigator)
 103.819 +      navigator)))
 103.820 +
 103.821 +
 103.822 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.823 +;;; Support for the '~{...~}' iteration construct in its
 103.824 +;;; different flavors
 103.825 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.826 +
 103.827 +
 103.828 +;; ~{...~} without any modifiers uses the next argument as an argument list that 
 103.829 +;; is consumed by all the iterations
 103.830 +(defn- iterate-sublist [params navigator offsets]
 103.831 +  (let [max-count (:max-iterations params)
 103.832 +        param-clause (first (:clauses params))
 103.833 +        [clause navigator] (if (empty? param-clause) 
 103.834 +                             (get-format-arg navigator)
 103.835 +                             [param-clause navigator]) 
 103.836 +        [arg-list navigator] (next-arg navigator)
 103.837 +        args (init-navigator arg-list)]
 103.838 +    (loop [count 0
 103.839 +           args args
 103.840 +           last-pos (num -1)]
 103.841 +      (if (and (not max-count) (= (:pos args) last-pos) (> count 1))
 103.842 +        ;; TODO get the offset in here and call format exception
 103.843 +        (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!")))
 103.844 +      (if (or (and (empty? (:rest args))
 103.845 +                   (or (not (:colon (:right-params params))) (> count 0)))
 103.846 +              (and max-count (>= count max-count)))
 103.847 +        navigator
 103.848 +        (let [iter-result (execute-sub-format clause args (:base-args params))] 
 103.849 +          (if (= :up-arrow (first iter-result))
 103.850 +            navigator
 103.851 +            (recur (inc count) iter-result (:pos args))))))))
 103.852 +
 103.853 +;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the
 103.854 +;; sublists is used as the arglist for a single iteration.
 103.855 +(defn- iterate-list-of-sublists [params navigator offsets]
 103.856 +  (let [max-count (:max-iterations params)
 103.857 +        param-clause (first (:clauses params))
 103.858 +        [clause navigator] (if (empty? param-clause) 
 103.859 +                             (get-format-arg navigator)
 103.860 +                             [param-clause navigator]) 
 103.861 +        [arg-list navigator] (next-arg navigator)]
 103.862 +    (loop [count 0
 103.863 +           arg-list arg-list]
 103.864 +      (if (or (and (empty? arg-list)
 103.865 +                   (or (not (:colon (:right-params params))) (> count 0)))
 103.866 +              (and max-count (>= count max-count)))
 103.867 +        navigator
 103.868 +        (let [iter-result (execute-sub-format 
 103.869 +                           clause 
 103.870 +                           (init-navigator (first arg-list))
 103.871 +                           (init-navigator (next arg-list)))]
 103.872 +          (if (= :colon-up-arrow (first iter-result))
 103.873 +            navigator
 103.874 +            (recur (inc count) (next arg-list))))))))
 103.875 +
 103.876 +;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations
 103.877 +;; is consumed by all the iterations
 103.878 +(defn- iterate-main-list [params navigator offsets]
 103.879 +  (let [max-count (:max-iterations params)
 103.880 +        param-clause (first (:clauses params))
 103.881 +        [clause navigator] (if (empty? param-clause) 
 103.882 +                             (get-format-arg navigator)
 103.883 +                             [param-clause navigator])]
 103.884 +    (loop [count 0
 103.885 +           navigator navigator
 103.886 +           last-pos (num -1)]
 103.887 +      (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1))
 103.888 +        ;; TODO get the offset in here and call format exception
 103.889 +        (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!")))
 103.890 +      (if (or (and (empty? (:rest navigator))
 103.891 +                   (or (not (:colon (:right-params params))) (> count 0)))
 103.892 +              (and max-count (>= count max-count)))
 103.893 +        navigator
 103.894 +        (let [iter-result (execute-sub-format clause navigator (:base-args params))] 
 103.895 +          (if (= :up-arrow (first iter-result))
 103.896 +            (second iter-result)
 103.897 +            (recur 
 103.898 +             (inc count) iter-result (:pos navigator))))))))
 103.899 +
 103.900 +;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one
 103.901 +;; of which is consumed with each iteration
 103.902 +(defn- iterate-main-sublists [params navigator offsets]
 103.903 +  (let [max-count (:max-iterations params)
 103.904 +        param-clause (first (:clauses params))
 103.905 +        [clause navigator] (if (empty? param-clause) 
 103.906 +                             (get-format-arg navigator)
 103.907 +                             [param-clause navigator]) 
 103.908 +        ]
 103.909 +    (loop [count 0
 103.910 +           navigator navigator]
 103.911 +      (if (or (and (empty? (:rest navigator))
 103.912 +                   (or (not (:colon (:right-params params))) (> count 0)))
 103.913 +              (and max-count (>= count max-count)))
 103.914 +        navigator
 103.915 +        (let [[sublist navigator] (next-arg-or-nil navigator)
 103.916 +              iter-result (execute-sub-format clause (init-navigator sublist) navigator)]
 103.917 +          (if (= :colon-up-arrow (first iter-result))
 103.918 +            navigator
 103.919 +            (recur (inc count) navigator)))))))
 103.920 +
 103.921 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.922 +;;; The '~< directive has two completely different meanings
 103.923 +;;; in the '~<...~>' form it does justification, but with
 103.924 +;;; ~<...~:>' it represents the logical block operation of the
 103.925 +;;; pretty printer.
 103.926 +;;; 
 103.927 +;;; Unfortunately, the current architecture decides what function
 103.928 +;;; to call at form parsing time before the sub-clauses have been
 103.929 +;;; folded, so it is left to run-time to make the decision.
 103.930 +;;; 
 103.931 +;;; TODO: make it possible to make these decisions at compile-time.
 103.932 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.933 +
 103.934 +(declare format-logical-block)
 103.935 +(declare justify-clauses)
 103.936 +
 103.937 +(defn- logical-block-or-justify [params navigator offsets]
 103.938 +  (if (:colon (:right-params params))
 103.939 +    (format-logical-block params navigator offsets)
 103.940 +    (justify-clauses params navigator offsets)))
 103.941 +
 103.942 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.943 +;;; Support for the '~<...~>' justification directive
 103.944 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 103.945 +
 103.946 +(defn- render-clauses [clauses navigator base-navigator]
 103.947 +  (loop [clauses clauses
 103.948 +         acc []
 103.949 +         navigator navigator]
 103.950 +    (if (empty? clauses)
 103.951 +      [acc navigator]
 103.952 +      (let [clause (first clauses)
 103.953 +            [iter-result result-str] (binding [*out* (java.io.StringWriter.)]
 103.954 +                                       [(execute-sub-format clause navigator base-navigator) 
 103.955 +                                        (.toString *out*)])]
 103.956 +        (if (= :up-arrow (first iter-result))
 103.957 +          [acc (second iter-result)]
 103.958 +          (recur (next clauses) (conj acc result-str) iter-result))))))
 103.959 +
 103.960 +;; TODO support for ~:; constructions
 103.961 +(defn- justify-clauses [params navigator offsets]
 103.962 +  (let [[[eol-str] new-navigator] (when-let [else (:else params)]
 103.963 +                                    (render-clauses else navigator (:base-args params)))
 103.964 +        navigator (or new-navigator navigator)
 103.965 +        [else-params new-navigator] (when-let [p (:else-params params)]
 103.966 +                                      (realize-parameter-list p navigator))
 103.967 +        navigator (or new-navigator navigator)
 103.968 +        min-remaining (or (first (:min-remaining else-params)) 0)
 103.969 +        max-columns (or (first (:max-columns else-params))
 103.970 +                        (get-max-column *out*))
 103.971 +        clauses (:clauses params)
 103.972 +        [strs navigator] (render-clauses clauses navigator (:base-args params))
 103.973 +        slots (max 1
 103.974 +                   (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0)))
 103.975 +        chars (reduce + (map count strs))
 103.976 +        mincol (:mincol params)
 103.977 +        minpad (:minpad params)
 103.978 +        colinc (:colinc params)
 103.979 +        minout (+ chars (* slots minpad))
 103.980 +        result-columns (if (<= minout mincol) 
 103.981 +                         mincol
 103.982 +                         (+ mincol (* colinc
 103.983 +                                      (+ 1 (quot (- minout mincol 1) colinc)))))
 103.984 +        total-pad (- result-columns chars)
 103.985 +        pad (max minpad (quot total-pad slots))
 103.986 +        extra-pad (- total-pad (* pad slots))
 103.987 +        pad-str (apply str (repeat pad (:padchar params)))]
 103.988 +    (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) 
 103.989 +                        max-columns))
 103.990 +      (print eol-str))
 103.991 +    (loop [slots slots
 103.992 +           extra-pad extra-pad
 103.993 +           strs strs
 103.994 +           pad-only (or (:colon params)
 103.995 +                        (and (= (count strs) 1) (not (:at params))))]
 103.996 +      (if (seq strs)
 103.997 +        (do
 103.998 +          (print (str (if (not pad-only) (first strs))
 103.999 +                      (if (or pad-only (next strs) (:at params)) pad-str)
103.1000 +                      (if (pos? extra-pad) (:padchar params))))
103.1001 +          (recur 
103.1002 +           (dec slots)
103.1003 +           (dec extra-pad)
103.1004 +           (if pad-only strs (next strs))
103.1005 +           false))))
103.1006 +    navigator))
103.1007 +
103.1008 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1009 +;;; Support for case modification with ~(...~).
103.1010 +;;; We do this by wrapping the underlying writer with
103.1011 +;;; a special writer to do the appropriate modification. This
103.1012 +;;; allows us to support arbitrary-sized output and sources
103.1013 +;;; that may block.
103.1014 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1015 +
103.1016 +(defn- downcase-writer 
103.1017 +  "Returns a proxy that wraps writer, converting all characters to lower case"
103.1018 +  [^java.io.Writer writer]
103.1019 +  (proxy [java.io.Writer] []
103.1020 +    (close [] (.close writer))
103.1021 +    (flush [] (.flush writer))
103.1022 +    (write ([^chars cbuf ^Integer off ^Integer len] 
103.1023 +              (.write writer cbuf off len))
103.1024 +           ([x]
103.1025 +              (condp = (class x)
103.1026 +		String 
103.1027 +		(let [s ^String x]
103.1028 +		  (.write writer (.toLowerCase s)))
103.1029 +
103.1030 +		Integer
103.1031 +		(let [c ^Character x]
103.1032 +		  (.write writer (int (Character/toLowerCase (char c))))))))))
103.1033 +
103.1034 +(defn- upcase-writer 
103.1035 +  "Returns a proxy that wraps writer, converting all characters to upper case"
103.1036 +  [^java.io.Writer writer]
103.1037 +  (proxy [java.io.Writer] []
103.1038 +    (close [] (.close writer))
103.1039 +    (flush [] (.flush writer))
103.1040 +    (write ([^chars cbuf ^Integer off ^Integer len] 
103.1041 +              (.write writer cbuf off len))
103.1042 +           ([x]
103.1043 +              (condp = (class x)
103.1044 +		String 
103.1045 +		(let [s ^String x]
103.1046 +		  (.write writer (.toUpperCase s)))
103.1047 +
103.1048 +		Integer
103.1049 +		(let [c ^Character x]
103.1050 +		  (.write writer (int (Character/toUpperCase (char c))))))))))
103.1051 +
103.1052 +(defn- capitalize-string
103.1053 +  "Capitalizes the words in a string. If first? is false, don't capitalize the 
103.1054 +                                      first character of the string even if it's a letter."
103.1055 +  [s first?]
103.1056 +  (let [^Character f (first s) 
103.1057 +        s (if (and first? f (Character/isLetter f))
103.1058 +            (str (Character/toUpperCase f) (subs s 1))
103.1059 +            s)]
103.1060 +    (apply str 
103.1061 +           (first
103.1062 +            (consume
103.1063 +             (fn [s]
103.1064 +               (if (empty? s)
103.1065 +                 [nil nil]
103.1066 +                 (let [m (re-matcher #"\W\w" s)
103.1067 +                       match (re-find m)
103.1068 +                       offset (and match (inc (.start m)))]
103.1069 +                   (if offset
103.1070 +                     [(str (subs s 0 offset) 
103.1071 +                           (Character/toUpperCase ^Character (nth s offset)))
103.1072 +                      (subs s (inc offset))]
103.1073 +                     [s nil]))))
103.1074 +             s)))))
103.1075 +
103.1076 +(defn- capitalize-word-writer
103.1077 +  "Returns a proxy that wraps writer, captializing all words"
103.1078 +  [^java.io.Writer writer]
103.1079 +  (let [last-was-whitespace? (ref true)] 
103.1080 +    (proxy [java.io.Writer] []
103.1081 +      (close [] (.close writer))
103.1082 +      (flush [] (.flush writer))
103.1083 +      (write 
103.1084 +       ([^chars cbuf ^Integer off ^Integer len] 
103.1085 +          (.write writer cbuf off len))
103.1086 +       ([x]
103.1087 +          (condp = (class x)
103.1088 +            String 
103.1089 +            (let [s ^String x]
103.1090 +              (.write writer 
103.1091 +                      ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?))
103.1092 +              (dosync 
103.1093 +               (ref-set last-was-whitespace? 
103.1094 +                        (Character/isWhitespace 
103.1095 +                         ^Character (nth s (dec (count s)))))))
103.1096 +
103.1097 +            Integer
103.1098 +            (let [c (char x)]
103.1099 +              (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] 
103.1100 +                (.write writer (int mod-c))
103.1101 +                (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x))))))))))))
103.1102 +
103.1103 +(defn- init-cap-writer
103.1104 +  "Returns a proxy that wraps writer, capitalizing the first word"
103.1105 +  [^java.io.Writer writer]
103.1106 +  (let [capped (ref false)] 
103.1107 +    (proxy [java.io.Writer] []
103.1108 +      (close [] (.close writer))
103.1109 +      (flush [] (.flush writer))
103.1110 +      (write ([^chars cbuf ^Integer off ^Integer len] 
103.1111 +                (.write writer cbuf off len))
103.1112 +             ([x]
103.1113 +                (condp = (class x)
103.1114 +                 String 
103.1115 +                 (let [s (.toLowerCase ^String x)]
103.1116 +                   (if (not @capped) 
103.1117 +                     (let [m (re-matcher #"\S" s)
103.1118 +                           match (re-find m)
103.1119 +                           offset (and match (.start m))]
103.1120 +                       (if offset
103.1121 +                         (do (.write writer 
103.1122 +                                   (str (subs s 0 offset) 
103.1123 +                                        (Character/toUpperCase ^Character (nth s offset))
103.1124 +                                        (.toLowerCase ^String (subs s (inc offset)))))
103.1125 +                           (dosync (ref-set capped true)))
103.1126 +                         (.write writer s))) 
103.1127 +                     (.write writer (.toLowerCase s))))
103.1128 +
103.1129 +                 Integer
103.1130 +                 (let [c ^Character (char x)]
103.1131 +                   (if (and (not @capped) (Character/isLetter c))
103.1132 +                     (do
103.1133 +                       (dosync (ref-set capped true))
103.1134 +                       (.write writer (int (Character/toUpperCase c))))
103.1135 +                     (.write writer (int (Character/toLowerCase c)))))))))))
103.1136 +
103.1137 +(defn- modify-case [make-writer params navigator offsets]
103.1138 +  (let [clause (first (:clauses params))]
103.1139 +    (binding [*out* (make-writer *out*)] 
103.1140 +      (execute-sub-format clause navigator (:base-args params)))))
103.1141 +
103.1142 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1143 +;;; If necessary, wrap the writer in a PrettyWriter object
103.1144 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1145 +
103.1146 +(defn get-pretty-writer [writer]
103.1147 +  (if (pretty-writer? writer) 
103.1148 +    writer
103.1149 +    (pretty-writer writer *print-right-margin* *print-miser-width*)))
103.1150 + 
103.1151 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1152 +;;; Support for column-aware operations ~&, ~T
103.1153 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1154 +
103.1155 +;; TODO: make an automatic newline for non-ColumnWriters
103.1156 +(defn fresh-line
103.1157 +  "Make a newline if the Writer is not already at the beginning of the line.
103.1158 +N.B. Only works on ColumnWriters right now."
103.1159 +  []
103.1160 +  (if (not (= 0 (get-column (:base @@*out*))))
103.1161 +    (prn)))
103.1162 +
103.1163 +(defn- absolute-tabulation [params navigator offsets]
103.1164 +  (let [colnum (:colnum params) 
103.1165 +        colinc (:colinc params)
103.1166 +        current (get-column (:base @@*out*))
103.1167 +        space-count (cond
103.1168 +                     (< current colnum) (- colnum current)
103.1169 +                     (= colinc 0) 0
103.1170 +                     :else (- colinc (rem (- current colnum) colinc)))]
103.1171 +    (print (apply str (repeat space-count \space))))
103.1172 +  navigator)
103.1173 +
103.1174 +(defn- relative-tabulation [params navigator offsets]
103.1175 +  (let [colrel (:colnum params) 
103.1176 +        colinc (:colinc params)
103.1177 +        start-col (+ colrel (get-column (:base @@*out*)))
103.1178 +        offset (if (pos? colinc) (rem start-col colinc) 0)
103.1179 +        space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))]
103.1180 +    (print (apply str (repeat space-count \space))))
103.1181 +  navigator)
103.1182 +
103.1183 +
103.1184 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1185 +;;; Support for accessing the pretty printer from a format
103.1186 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1187 +
103.1188 +;; TODO: support ~@; per-line-prefix separator
103.1189 +;; TODO: get the whole format wrapped so we can start the lb at any column
103.1190 +(defn- format-logical-block [params navigator offsets]
103.1191 +  (let [clauses (:clauses params)
103.1192 +        clause-count (count clauses)
103.1193 +        prefix (cond
103.1194 +                (> clause-count 1) (:string (:params (first (first clauses))))
103.1195 +                (:colon params) "(")
103.1196 +        body (nth clauses (if (> clause-count 1) 1 0))
103.1197 +        suffix (cond
103.1198 +                (> clause-count 2) (:string (:params (first (nth clauses 2))))
103.1199 +                (:colon params) ")")
103.1200 +        [arg navigator] (next-arg navigator)]
103.1201 +    (pprint-logical-block :prefix prefix :suffix suffix
103.1202 +      (execute-sub-format 
103.1203 +       body 
103.1204 +       (init-navigator arg)
103.1205 +       (:base-args params)))
103.1206 +    navigator))
103.1207 +
103.1208 +(defn- set-indent [params navigator offsets]
103.1209 +  (let [relative-to (if (:colon params) :current :block)]
103.1210 +    (pprint-indent relative-to (:n params))
103.1211 +    navigator))
103.1212 +
103.1213 +;;; TODO: support ~:T section options for ~T
103.1214 +
103.1215 +(defn- conditional-newline [params navigator offsets]
103.1216 +  (let [kind (if (:colon params) 
103.1217 +               (if (:at params) :mandatory :fill)
103.1218 +               (if (:at params) :miser :linear))]
103.1219 +    (pprint-newline kind)
103.1220 +    navigator))
103.1221 +
103.1222 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1223 +;;; The table of directives we support, each with its params,
103.1224 +;;; properties, and the compilation function
103.1225 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1226 +
103.1227 +;; We start with a couple of helpers
103.1228 +(defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ]
103.1229 +  [char, 
103.1230 +   {:directive char,
103.1231 +    :params `(array-map ~@params),
103.1232 +    :flags flags,
103.1233 +    :bracket-info bracket-info,
103.1234 +    :generator-fn (concat '(fn [ params offset]) generator-fn) }])
103.1235 +
103.1236 +(defmacro ^{:private true}
103.1237 +  defdirectives 
103.1238 +  [ & directives ]
103.1239 +  `(def ^{:private true}
103.1240 +        directive-table (hash-map ~@(mapcat process-directive-table-element directives))))
103.1241 +
103.1242 +(defdirectives 
103.1243 +  (\A 
103.1244 +   [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] 
103.1245 +   #{ :at :colon :both} {}
103.1246 +   #(format-ascii print-str %1 %2 %3))
103.1247 +
103.1248 +  (\S 
103.1249 +   [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] 
103.1250 +   #{ :at :colon :both} {}
103.1251 +   #(format-ascii pr-str %1 %2 %3))
103.1252 +
103.1253 +  (\D
103.1254 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
103.1255 +    :commainterval [ 3 Integer]]
103.1256 +   #{ :at :colon :both } {}
103.1257 +   #(format-integer 10 %1 %2 %3))
103.1258 +
103.1259 +  (\B
103.1260 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
103.1261 +    :commainterval [ 3 Integer]]
103.1262 +   #{ :at :colon :both } {}
103.1263 +   #(format-integer 2 %1 %2 %3))
103.1264 +
103.1265 +  (\O
103.1266 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
103.1267 +    :commainterval [ 3 Integer]]
103.1268 +   #{ :at :colon :both } {}
103.1269 +   #(format-integer 8 %1 %2 %3))
103.1270 +
103.1271 +  (\X
103.1272 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
103.1273 +    :commainterval [ 3 Integer]]
103.1274 +   #{ :at :colon :both } {}
103.1275 +   #(format-integer 16 %1 %2 %3))
103.1276 +
103.1277 +  (\R
103.1278 +   [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
103.1279 +    :commainterval [ 3 Integer]]
103.1280 +   #{ :at :colon :both } {}
103.1281 +   (do
103.1282 +     (cond                          ; ~R is overloaded with bizareness
103.1283 +       (first (:base params))     #(format-integer (:base %1) %1 %2 %3)
103.1284 +       (and (:at params) (:colon params))   #(format-old-roman %1 %2 %3)
103.1285 +       (:at params)               #(format-new-roman %1 %2 %3)
103.1286 +       (:colon params)            #(format-ordinal-english %1 %2 %3)
103.1287 +       true                       #(format-cardinal-english %1 %2 %3))))
103.1288 +
103.1289 +  (\P
103.1290 +   [ ]
103.1291 +   #{ :at :colon :both } {}
103.1292 +   (fn [params navigator offsets]
103.1293 +     (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator)
103.1294 +           strs (if (:at params) ["y" "ies"] ["" "s"])
103.1295 +           [arg navigator] (next-arg navigator)]
103.1296 +       (print (if (= arg 1) (first strs) (second strs)))
103.1297 +       navigator)))
103.1298 +
103.1299 +  (\C
103.1300 +   [:char-format [nil Character]]
103.1301 +   #{ :at :colon :both } {}
103.1302 +   (cond
103.1303 +     (:colon params) pretty-character
103.1304 +     (:at params) readable-character
103.1305 +     :else plain-character))
103.1306 +
103.1307 +  (\F
103.1308 +   [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] 
103.1309 +    :padchar [\space Character] ]
103.1310 +   #{ :at } {}
103.1311 +   fixed-float)
103.1312 +
103.1313 +  (\E
103.1314 +   [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] 
103.1315 +    :overflowchar [nil Character] :padchar [\space Character] 
103.1316 +    :exponentchar [nil Character] ]
103.1317 +   #{ :at } {}
103.1318 +   exponential-float)
103.1319 +
103.1320 +  (\G
103.1321 +   [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] 
103.1322 +    :overflowchar [nil Character] :padchar [\space Character] 
103.1323 +    :exponentchar [nil Character] ]
103.1324 +   #{ :at } {}
103.1325 +   general-float)
103.1326 +
103.1327 +  (\$
103.1328 +   [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]]
103.1329 +   #{ :at :colon :both} {}
103.1330 +   dollar-float)
103.1331 +
103.1332 +  (\% 
103.1333 +   [ :count [1 Integer] ] 
103.1334 +   #{ } {}
103.1335 +   (fn [params arg-navigator offsets]
103.1336 +     (dotimes [i (:count params)]
103.1337 +       (prn))
103.1338 +     arg-navigator))
103.1339 +
103.1340 +  (\&
103.1341 +   [ :count [1 Integer] ] 
103.1342 +   #{ :pretty } {}
103.1343 +   (fn [params arg-navigator offsets]
103.1344 +     (let [cnt (:count params)]
103.1345 +       (if (pos? cnt) (fresh-line))
103.1346 +       (dotimes [i (dec cnt)]
103.1347 +         (prn)))
103.1348 +     arg-navigator))
103.1349 +
103.1350 +  (\| 
103.1351 +   [ :count [1 Integer] ] 
103.1352 +   #{ } {}
103.1353 +   (fn [params arg-navigator offsets]
103.1354 +     (dotimes [i (:count params)]
103.1355 +       (print \formfeed))
103.1356 +     arg-navigator))
103.1357 +
103.1358 +  (\~ 
103.1359 +   [ :n [1 Integer] ] 
103.1360 +   #{ } {}
103.1361 +   (fn [params arg-navigator offsets]
103.1362 +     (let [n (:n params)]
103.1363 +       (print (apply str (repeat n \~)))
103.1364 +       arg-navigator)))
103.1365 +
103.1366 +  (\newline ;; Whitespace supression is handled in the compilation loop
103.1367 +   [ ] 
103.1368 +   #{:colon :at} {}
103.1369 +   (fn [params arg-navigator offsets]
103.1370 +     (if (:at params)
103.1371 +       (prn))
103.1372 +     arg-navigator))
103.1373 +
103.1374 +  (\T
103.1375 +   [ :colnum [1 Integer] :colinc [1 Integer] ] 
103.1376 +   #{ :at :pretty } {}
103.1377 +   (if (:at params)
103.1378 +     #(relative-tabulation %1 %2 %3)
103.1379 +     #(absolute-tabulation %1 %2 %3)))
103.1380 +
103.1381 +  (\* 
103.1382 +   [ :n [1 Integer] ] 
103.1383 +   #{ :colon :at } {}
103.1384 +   (fn [params navigator offsets]
103.1385 +     (let [n (:n params)]
103.1386 +       (if (:at params)
103.1387 +         (absolute-reposition navigator n)
103.1388 +         (relative-reposition navigator (if (:colon params) (- n) n)))
103.1389 +       )))
103.1390 +
103.1391 +  (\? 
103.1392 +   [ ] 
103.1393 +   #{ :at } {}
103.1394 +   (if (:at params)
103.1395 +     (fn [params navigator offsets]     ; args from main arg list
103.1396 +       (let [[subformat navigator] (get-format-arg navigator)]
103.1397 +         (execute-sub-format subformat navigator  (:base-args params))))
103.1398 +     (fn [params navigator offsets]     ; args from sub-list
103.1399 +       (let [[subformat navigator] (get-format-arg navigator)
103.1400 +             [subargs navigator] (next-arg navigator)
103.1401 +             sub-navigator (init-navigator subargs)]
103.1402 +         (execute-sub-format subformat sub-navigator (:base-args params))
103.1403 +         navigator))))
103.1404 +       
103.1405 +
103.1406 +  (\(
103.1407 +   [ ]
103.1408 +   #{ :colon :at :both} { :right \), :allows-separator nil, :else nil }
103.1409 +   (let [mod-case-writer (cond
103.1410 +                           (and (:at params) (:colon params))
103.1411 +                           upcase-writer
103.1412 +
103.1413 +                           (:colon params)
103.1414 +                           capitalize-word-writer
103.1415 +
103.1416 +                           (:at params)
103.1417 +                           init-cap-writer
103.1418 +
103.1419 +                           :else
103.1420 +                           downcase-writer)]
103.1421 +     #(modify-case mod-case-writer %1 %2 %3)))
103.1422 +
103.1423 +  (\) [] #{} {} nil) 
103.1424 +
103.1425 +  (\[
103.1426 +   [ :selector [nil Integer] ]
103.1427 +   #{ :colon :at } { :right \], :allows-separator true, :else :last }
103.1428 +   (cond
103.1429 +     (:colon params)
103.1430 +     boolean-conditional
103.1431 +
103.1432 +     (:at params)
103.1433 +     check-arg-conditional
103.1434 +
103.1435 +     true
103.1436 +     choice-conditional))
103.1437 +
103.1438 +  (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] 
103.1439 +   #{ :colon } { :separator true } nil) 
103.1440 +   
103.1441 +  (\] [] #{} {} nil) 
103.1442 +
103.1443 +  (\{
103.1444 +   [ :max-iterations [nil Integer] ]
103.1445 +   #{ :colon :at :both} { :right \}, :allows-separator false }
103.1446 +   (cond
103.1447 +     (and (:at params) (:colon params))
103.1448 +     iterate-main-sublists
103.1449 +
103.1450 +     (:colon params)
103.1451 +     iterate-list-of-sublists
103.1452 +
103.1453 +     (:at params)
103.1454 +     iterate-main-list
103.1455 +
103.1456 +     true
103.1457 +     iterate-sublist))
103.1458 +
103.1459 +   
103.1460 +  (\} [] #{:colon} {} nil) 
103.1461 +
103.1462 +  (\<
103.1463 +   [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]]
103.1464 +   #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first }
103.1465 +   logical-block-or-justify)
103.1466 +
103.1467 +  (\> [] #{:colon} {} nil) 
103.1468 +
103.1469 +  ;; TODO: detect errors in cases where colon not allowed
103.1470 +  (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] 
103.1471 +   #{:colon} {} 
103.1472 +   (fn [params navigator offsets]
103.1473 +     (let [arg1 (:arg1 params)
103.1474 +           arg2 (:arg2 params)
103.1475 +           arg3 (:arg3 params)
103.1476 +           exit (if (:colon params) :colon-up-arrow :up-arrow)]
103.1477 +       (cond
103.1478 +         (and arg1 arg2 arg3)
103.1479 +         (if (<= arg1 arg2 arg3) [exit navigator] navigator)
103.1480 +
103.1481 +         (and arg1 arg2)
103.1482 +         (if (= arg1 arg2) [exit navigator] navigator)
103.1483 +
103.1484 +         arg1
103.1485 +         (if (= arg1 0) [exit navigator] navigator)
103.1486 +
103.1487 +         true     ; TODO: handle looking up the arglist stack for info
103.1488 +         (if (if (:colon params) 
103.1489 +               (empty? (:rest (:base-args params)))
103.1490 +               (empty? (:rest navigator)))
103.1491 +           [exit navigator] navigator))))) 
103.1492 +
103.1493 +  (\W 
103.1494 +   [] 
103.1495 +   #{:at :colon :both} {}
103.1496 +   (if (or (:at params) (:colon params))
103.1497 +     (let [bindings (concat
103.1498 +                     (if (:at params) [:level nil :length nil] [])
103.1499 +                     (if (:colon params) [:pretty true] []))]
103.1500 +       (fn [params navigator offsets]
103.1501 +         (let [[arg navigator] (next-arg navigator)]
103.1502 +           (if (apply write arg bindings)
103.1503 +             [:up-arrow navigator]
103.1504 +             navigator))))
103.1505 +     (fn [params navigator offsets]
103.1506 +       (let [[arg navigator] (next-arg navigator)]
103.1507 +         (if (write-out arg)
103.1508 +           [:up-arrow navigator]
103.1509 +           navigator)))))
103.1510 +
103.1511 +  (\_
103.1512 +   []
103.1513 +   #{:at :colon :both} {}
103.1514 +   conditional-newline)
103.1515 +
103.1516 +  (\I
103.1517 +   [:n [0 Integer]]
103.1518 +   #{:colon} {}
103.1519 +   set-indent)
103.1520 +  )
103.1521 +
103.1522 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1523 +;;; Code to manage the parameters and flags associated with each
103.1524 +;;; directive in the format string.
103.1525 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103.1526 +
103.1527 +(def ^{:private true}
103.1528 +     param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))")
103.1529 +(def ^{:private true}
103.1530 +     special-params #{ :parameter-from-args :remaining-arg-count })
103.1531 +
103.1532 +(defn- extract-param [[s offset saw-comma]]
103.1533 +  (let [m (re-matcher param-pattern s)
103.1534 +        param (re-find m)]
103.1535 +    (if param
103.1536 +      (let [token-str (first (re-groups m))
103.1537 +            remainder (subs s (.end m))
103.1538 +            new-offset (+ offset (.end m))]
103.1539 +        (if (not (= \, (nth remainder 0)))
103.1540 +          [ [token-str offset] [remainder new-offset false]]
103.1541 +          [ [token-str offset] [(subs remainder 1) (inc new-offset) true]]))
103.1542 +      (if saw-comma 
103.1543 +        (format-error "Badly formed parameters in format directive" offset)
103.1544 +        [ nil [s offset]]))))
103.1545 +
103.1546 +
103.1547 +(defn- extract-params [s offset] 
103.1548 +  (consume extract-param [s offset false]))
103.1549 +
103.1550 +(defn- translate-param
103.1551 +  "Translate the string representation of a param to the internalized
103.1552 +                                      representation"
103.1553 +  [[^String p offset]]
103.1554 +  [(cond 
103.1555 +    (= (.length p) 0) nil
103.1556 +    (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args
103.1557 +    (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count
103.1558 +    (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1)
103.1559 +    true (new Integer p))
103.1560 +   offset])
103.1561 + 
103.1562 +(def ^{:private true}
103.1563 +     flag-defs { \: :colon, \@ :at })
103.1564 +
103.1565 +(defn- extract-flags [s offset]
103.1566 +  (consume
103.1567 +   (fn [[s offset flags]]
103.1568 +     (if (empty? s)
103.1569 +       [nil [s offset flags]]
103.1570 +       (let [flag (get flag-defs (first s))]
103.1571 +         (if flag
103.1572 +           (if (contains? flags flag)
103.1573 +             (format-error 
103.1574 +              (str "Flag \"" (first s) "\" appears more than once in a directive")
103.1575 +              offset)
103.1576 +             [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]])
103.1577 +           [nil [s offset flags]]))))
103.1578 +   [s offset {}]))
103.1579 +
103.1580 +(defn- check-flags [def flags]
103.1581 +  (let [allowed (:flags def)]
103.1582 +    (if (and (not (:at allowed)) (:at flags))
103.1583 +      (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"")
103.1584 +                    (nth (:at flags) 1)))
103.1585 +    (if (and (not (:colon allowed)) (:colon flags))
103.1586 +      (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"")
103.1587 +                    (nth (:colon flags) 1)))
103.1588 +    (if (and (not (:both allowed)) (:at flags) (:colon flags))
103.1589 +      (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" 
103.1590 +                         (:directive def) "\"")
103.1591 +                    (min (nth (:colon flags) 1) (nth (:at flags) 1))))))
103.1592 +
103.1593 +(defn- map-params
103.1594 +  "Takes a directive definition and the list of actual parameters and
103.1595 +a map of flags and returns a map of the parameters and flags with defaults
103.1596 +filled in. We check to make sure that there are the right types and number
103.1597 +of parameters as well."
103.1598 +  [def params flags offset]
103.1599 +  (check-flags def flags)
103.1600 +  (if (> (count params) (count (:params def)))
103.1601 +    (format-error 
103.1602 +     (cl-format 
103.1603 +      nil 
103.1604 +      "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed"
103.1605 +      (:directive def) (count params) (count (:params def)))
103.1606 +     (second (first params))))
103.1607 +  (doall
103.1608 +   (map #(let [val (first %1)]
103.1609 +           (if (not (or (nil? val) (contains? special-params val) 
103.1610 +                        (instance? (second (second %2)) val)))
103.1611 +             (format-error (str "Parameter " (name (first %2))
103.1612 +                                " has bad type in directive \"" (:directive def) "\": "
103.1613 +                                (class val))
103.1614 +                           (second %1))) )
103.1615 +        params (:params def)))
103.1616 +     
103.1617 +  (merge                                ; create the result map
103.1618 +   (into (array-map) ; start with the default values, make sure the order is right
103.1619 +         (reverse (for [[name [default]] (:params def)] [name [default offset]])))
103.1620 +   (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils
103.1621 +   flags))                                ; and finally add the flags
103.1622 +
103.1623 +(defn- compile-directive [s offset]
103.1624 +  (let [[raw-params [rest offset]] (extract-params s offset)
103.1625 +        [_ [rest offset flags]] (extract-flags rest offset)
103.1626 +        directive (first rest)
103.1627 +        def (get directive-table (Character/toUpperCase ^Character directive))
103.1628 +        params (if def (map-params def (map translate-param raw-params) flags offset))]
103.1629 +    (if (not directive)
103.1630 +      (format-error "Format string ended in the middle of a directive" offset))
103.1631 +    (if (not def)
103.1632 +      (format-error (str "Directive \"" directive "\" is undefined") offset))
103.1633 +    [(struct compiled-directive ((:generator-fn def) params offset) def params offset)
103.1634 +     (let [remainder (subs rest 1) 
103.1635 +           offset (inc offset)
103.1636 +           trim? (and (= \newline (:directive def))
103.1637 +                      (not (:colon params)))
103.1638 +           trim-count (if trim? (prefix-count remainder [\space \tab]) 0)
103.1639 +           remainder (subs remainder trim-count)
103.1640 +           offset (+ offset trim-count)]
103.1641 +       [remainder offset])]))
103.1642 +    
103.1643 +(defn- compile-raw-string [s offset]
103.1644 +  (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset))
103.1645 +
103.1646 +(defn- right-bracket [this] (:right (:bracket-info (:def this))))
103.1647 +(defn- separator? [this] (:separator (:bracket-info (:def this))))
103.1648 +(defn- else-separator? [this] 
103.1649 +  (and (:separator (:bracket-info (:def this)))
103.1650 +       (:colon (:params this))))
103.1651 +  
103.1652 +
103.1653 +(declare collect-clauses)
103.1654 +
103.1655 +(defn- process-bracket [this remainder]
103.1656 +  (let [[subex remainder] (collect-clauses (:bracket-info (:def this))
103.1657 +                                           (:offset this) remainder)]
103.1658 +    [(struct compiled-directive 
103.1659 +             (:func this) (:def this) 
103.1660 +             (merge (:params this) (tuple-map subex (:offset this)))
103.1661 +             (:offset this))
103.1662 +     remainder]))
103.1663 +
103.1664 +(defn- process-clause [bracket-info offset remainder]
103.1665 +  (consume 
103.1666 +   (fn [remainder]
103.1667 +     (if (empty? remainder)
103.1668 +       (format-error "No closing bracket found." offset)
103.1669 +       (let [this (first remainder)
103.1670 +             remainder (next remainder)]
103.1671 +         (cond
103.1672 +          (right-bracket this)
103.1673 +          (process-bracket this remainder)
103.1674 +
103.1675 +          (= (:right bracket-info) (:directive (:def this)))
103.1676 +          [ nil [:right-bracket (:params this) nil remainder]]
103.1677 +
103.1678 +          (else-separator? this)
103.1679 +          [nil [:else nil (:params this) remainder]]
103.1680 +
103.1681 +          (separator? this)
103.1682 +          [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~;
103.1683 +
103.1684 +          true
103.1685 +          [this remainder]))))
103.1686 +   remainder))
103.1687 +
103.1688 +(defn- collect-clauses [bracket-info offset remainder]
103.1689 +  (second
103.1690 +   (consume
103.1691 +    (fn [[clause-map saw-else remainder]]
103.1692 +      (let [[clause [type right-params else-params remainder]] 
103.1693 +            (process-clause bracket-info offset remainder)]
103.1694 +        (cond
103.1695 +         (= type :right-bracket)
103.1696 +         [nil [(merge-with concat clause-map 
103.1697 +                           {(if saw-else :else :clauses) [clause] 
103.1698 +                            :right-params right-params})
103.1699 +               remainder]]
103.1700 +
103.1701 +         (= type :else)
103.1702 +         (cond
103.1703 +          (:else clause-map)
103.1704 +          (format-error "Two else clauses (\"~:;\") inside bracket construction." offset)
103.1705 +         
103.1706 +          (not (:else bracket-info))
103.1707 +          (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." 
103.1708 +                        offset)
103.1709 +
103.1710 +          (and (= :first (:else bracket-info)) (seq (:clauses clause-map)))
103.1711 +          (format-error
103.1712 +           "The else clause (\"~:;\") is only allowed in the first position for this directive." 
103.1713 +           offset)
103.1714 +         
103.1715 +          true         ; if the ~:; is in the last position, the else clause
103.1716 +                                        ; is next, this was a regular clause
103.1717 +          (if (= :first (:else bracket-info))
103.1718 +            [true [(merge-with concat clause-map { :else [clause] :else-params else-params})
103.1719 +                   false remainder]]
103.1720 +            [true [(merge-with concat clause-map { :clauses [clause] })
103.1721 +                   true remainder]]))
103.1722 +
103.1723 +         (= type :separator)
103.1724 +         (cond
103.1725 +          saw-else
103.1726 +          (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset)
103.1727 +         
103.1728 +          (not (:allows-separator bracket-info))
103.1729 +          (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." 
103.1730 +                        offset)
103.1731 +         
103.1732 +          true
103.1733 +          [true [(merge-with concat clause-map { :clauses [clause] })
103.1734 +                 false remainder]]))))
103.1735 +    [{ :clauses [] } false remainder])))
103.1736 +
103.1737 +(defn- process-nesting
103.1738 +  "Take a linearly compiled format and process the bracket directives to give it 
103.1739 +   the appropriate tree structure"
103.1740 +  [format]
103.1741 +  (first
103.1742 +   (consume 
103.1743 +    (fn [remainder]
103.1744 +      (let [this (first remainder)
103.1745 +            remainder (next remainder)
103.1746 +            bracket (:bracket-info (:def this))]
103.1747 +        (if (:right bracket)
103.1748 +          (process-bracket this remainder)
103.1749 +          [this remainder])))
103.1750 +    format)))
103.1751 +
103.1752 +(defn compile-format 
103.1753 +  "Compiles format-str into a compiled format which can be used as an argument
103.1754 +to cl-format just like a plain format string. Use this function for improved 
103.1755 +performance when you're using the same format string repeatedly"
103.1756 +  [ format-str ]
103.1757 +;  (prlabel compiling format-str)
103.1758 +  (binding [*format-str* format-str]
103.1759 +    (process-nesting
103.1760 +     (first 
103.1761 +      (consume 
103.1762 +       (fn [[^String s offset]]
103.1763 +         (if (empty? s)
103.1764 +           [nil s]
103.1765 +           (let [tilde (.indexOf s (int \~))]
103.1766 +             (cond
103.1767 +              (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]]
103.1768 +              (zero? tilde)  (compile-directive (subs s 1) (inc offset))
103.1769 +              true 
103.1770 +              [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]]))))
103.1771 +       [format-str 0])))))
103.1772 +
103.1773 +(defn- needs-pretty 
103.1774 +  "determine whether a given compiled format has any directives that depend on the
103.1775 +column number or pretty printing"
103.1776 +  [format]
103.1777 +  (loop [format format]
103.1778 +    (if (empty? format)
103.1779 +      false
103.1780 +      (if (or (:pretty (:flags (:def (first format))))
103.1781 +              (some needs-pretty (first (:clauses (:params (first format)))))
103.1782 +              (some needs-pretty (first (:else (:params (first format))))))
103.1783 +        true
103.1784 +        (recur (next format))))))
103.1785 +
103.1786 +(defn execute-format 
103.1787 +  "Executes the format with the arguments. This should never be used directly, but is public
103.1788 +because the formatter macro uses it."
103.1789 +  {:skip-wiki true}
103.1790 +  ([stream format args]
103.1791 +     (let [^java.io.Writer real-stream (cond 
103.1792 +                                         (not stream) (java.io.StringWriter.)
103.1793 +                                         (true? stream) *out*
103.1794 +                                         :else stream)
103.1795 +           ^java.io.Writer wrapped-stream (if (and (needs-pretty format) 
103.1796 +                                                    (not (pretty-writer? real-stream)))
103.1797 +                                             (get-pretty-writer real-stream)
103.1798 +                                             real-stream)]
103.1799 +       (binding [*out* wrapped-stream]
103.1800 +         (try
103.1801 +          (execute-format format args)
103.1802 +          (finally
103.1803 +           (if-not (identical? real-stream wrapped-stream)
103.1804 +             (.flush wrapped-stream))))
103.1805 +         (if (not stream) (.toString real-stream)))))
103.1806 +  ([format args]
103.1807 +     (map-passing-context 
103.1808 +      (fn [element context]
103.1809 +        (if (abort? context)
103.1810 +          [nil context]
103.1811 +          (let [[params args] (realize-parameter-list 
103.1812 +                               (:params element) context)
103.1813 +                [params offsets] (unzip-map params)
103.1814 +                params (assoc params :base-args args)]
103.1815 +            [nil (apply (:func element) [params args offsets])])))
103.1816 +      args
103.1817 +      format)))
103.1818 +
103.1819 +
103.1820 +(defmacro formatter
103.1821 +  "Makes a function which can directly run format-in. The function is
103.1822 +fn [stream & args] ... and returns nil unless the stream is nil (meaning 
103.1823 +output to a string) in which case it returns the resulting string.
103.1824 +
103.1825 +format-in can be either a control string or a previously compiled format."
103.1826 +  [format-in]
103.1827 +  (let [cf (gensym "compiled-format")]
103.1828 +    `(let [format-in# ~format-in]
103.1829 +       (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#))
103.1830 +           (fn [stream# & args#]
103.1831 +             (let [navigator# (init-navigator args#)]
103.1832 +               (execute-format stream# ~cf navigator#)))))))
103.1833 +
103.1834 +(defmacro formatter-out
103.1835 +  "Makes a function which can directly run format-in. The function is
103.1836 +fn [& args] ... and returns nil. This version of the formatter macro is
103.1837 +designed to be used with *out* set to an appropriate Writer. In particular,
103.1838 +this is meant to be used as part of a pretty printer dispatch method.
103.1839 +
103.1840 +format-in can be either a control string or a previously compiled format."
103.1841 +  [format-in]
103.1842 +  (let [cf (gensym "compiled-format")]
103.1843 +    `(let [format-in# ~format-in]
103.1844 +       (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#))
103.1845 +           (fn [& args#]
103.1846 +             (let [navigator# (init-navigator args#)]
103.1847 +               (execute-format ~cf navigator#)))))))
   104.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   104.2 +++ b/src/clojure/contrib/pprint/column_writer.clj	Sat Aug 21 06:25:44 2010 -0400
   104.3 @@ -0,0 +1,80 @@
   104.4 +;;; column_writer.clj -- part of the pretty printer for Clojure
   104.5 +
   104.6 +;; by Tom Faulhaber
   104.7 +;; April 3, 2009
   104.8 +;; Revised to use proxy instead of gen-class April 2010
   104.9 +
  104.10 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  104.11 +;   The use and distribution terms for this software are covered by the
  104.12 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  104.13 +;   which can be found in the file epl-v10.html at the root of this distribution.
  104.14 +;   By using this software in any fashion, you are agreeing to be bound by
  104.15 +;   the terms of this license.
  104.16 +;   You must not remove this notice, or any other, from this software.
  104.17 +
  104.18 +;; This module implements a column-aware wrapper around an instance of java.io.Writer
  104.19 +
  104.20 +(ns clojure.contrib.pprint.column-writer
  104.21 +  (:import
  104.22 +   [clojure.lang IDeref]
  104.23 +   [java.io Writer]))
  104.24 +
  104.25 +(def *default-page-width* 72)
  104.26 +
  104.27 +(defn- get-field [^Writer this sym]
  104.28 +  (sym @@this))
  104.29 +
  104.30 +(defn- set-field [^Writer this sym new-val] 
  104.31 +  (alter @this assoc sym new-val))
  104.32 +
  104.33 +(defn get-column [this]
  104.34 +  (get-field this :cur))
  104.35 +
  104.36 +(defn get-line [this]
  104.37 +  (get-field this :line))
  104.38 +
  104.39 +(defn get-max-column [this]
  104.40 +  (get-field this :max))
  104.41 +
  104.42 +(defn set-max-column [this new-max]
  104.43 +  (dosync (set-field this :max new-max))
  104.44 +  nil)
  104.45 +
  104.46 +(defn get-writer [this]
  104.47 +  (get-field this :base))
  104.48 +
  104.49 +(defn- write-char [^Writer this ^Integer c]
  104.50 +  (dosync (if (= c (int \newline))
  104.51 +	    (do
  104.52 +              (set-field this :cur 0)
  104.53 +              (set-field this :line (inc (get-field this :line))))
  104.54 +	    (set-field this :cur (inc (get-field this :cur)))))
  104.55 +  (.write ^Writer (get-field this :base) c))
  104.56 +
  104.57 +(defn column-writer   
  104.58 +  ([writer] (column-writer writer *default-page-width*))
  104.59 +  ([writer max-columns]
  104.60 +     (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})]
  104.61 +       (proxy [Writer IDeref] []
  104.62 +         (deref [] fields)
  104.63 +         (write
  104.64 +          ([^chars cbuf ^Integer off ^Integer len] 
  104.65 +             (let [^Writer writer (get-field this :base)] 
  104.66 +               (.write writer cbuf off len)))
  104.67 +          ([x]
  104.68 +             (condp = (class x)
  104.69 +               String 
  104.70 +               (let [^String s x
  104.71 +                     nl (.lastIndexOf s (int \newline))]
  104.72 +                 (dosync (if (neg? nl)
  104.73 +                           (set-field this :cur (+ (get-field this :cur) (count s)))
  104.74 +                           (do
  104.75 +                             (set-field this :cur (- (count s) nl 1))
  104.76 +                             (set-field this :line (+ (get-field this :line)
  104.77 +                                                      (count (filter #(= % \newline) s)))))))
  104.78 +                 (.write ^Writer (get-field this :base) s))
  104.79 +
  104.80 +               Integer
  104.81 +               (write-char this x)
  104.82 +               Long
  104.83 +               (write-char this x))))))))
   105.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   105.2 +++ b/src/clojure/contrib/pprint/dispatch.clj	Sat Aug 21 06:25:44 2010 -0400
   105.3 @@ -0,0 +1,447 @@
   105.4 +;; dispatch.clj -- part of the pretty printer for Clojure
   105.5 +
   105.6 +;; by Tom Faulhaber
   105.7 +;; April 3, 2009
   105.8 +
   105.9 +;   Copyright (c) Tom Faulhaber, Feb 2009. All rights reserved.
  105.10 +;   The use and distribution terms for this software are covered by the
  105.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  105.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  105.13 +;   By using this software in any fashion, you are agreeing to be bound by
  105.14 +;   the terms of this license.
  105.15 +;   You must not remove this notice, or any other, from this software.
  105.16 +
  105.17 +;; This module implements the default dispatch tables for pretty printing code and
  105.18 +;; data.
  105.19 +
  105.20 +(in-ns 'clojure.contrib.pprint)
  105.21 +
  105.22 +(defn use-method
  105.23 +  "Installs a function as a new method of multimethod associated with dispatch-value. "
  105.24 +  [multifn dispatch-val func]
  105.25 +  (. multifn addMethod dispatch-val func))
  105.26 +
  105.27 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105.28 +;; Implementations of specific dispatch table entries
  105.29 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105.30 +
  105.31 +;;; Handle forms that can be "back-translated" to reader macros
  105.32 +;;; Not all reader macros can be dealt with this way or at all. 
  105.33 +;;; Macros that we can't deal with at all are:
  105.34 +;;; ;  - The comment character is aborbed by the reader and never is part of the form
  105.35 +;;; `  - Is fully processed at read time into a lisp expression (which will contain concats
  105.36 +;;;      and regular quotes).
  105.37 +;;; ~@ - Also fully eaten by the processing of ` and can't be used outside.
  105.38 +;;; ,  - is whitespace and is lost (like all other whitespace). Formats can generate commas
  105.39 +;;;      where they deem them useful to help readability.
  105.40 +;;; ^ - Adding metadata completely disappears at read time and the data appears to be
  105.41 +;;;      completely lost.
  105.42 +;;;
  105.43 +;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{})
  105.44 +;;; or directly by printing the objects using Clojure's built-in print functions (like
  105.45 +;;; :keyword, \char, or ""). The notable exception is #() which is special-cased.
  105.46 +
  105.47 +(def reader-macros
  105.48 +     {'quote "'", 'clojure.core/deref "@", 
  105.49 +      'var "#'", 'clojure.core/unquote "~"})
  105.50 +
  105.51 +(defn pprint-reader-macro [alis]
  105.52 +  (let [^String macro-char (reader-macros (first alis))]
  105.53 +    (when (and macro-char (= 2 (count alis)))
  105.54 +      (.write ^java.io.Writer *out* macro-char)
  105.55 +      (write-out (second alis))
  105.56 +      true)))
  105.57 +
  105.58 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105.59 +;; Dispatch for the basic data types when interpreted
  105.60 +;; as data (as opposed to code).
  105.61 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105.62 +
  105.63 +;;; TODO: inline these formatter statements into funcs so that we
  105.64 +;;; are a little easier on the stack. (Or, do "real" compilation, a
  105.65 +;;; la Common Lisp)
  105.66 +
  105.67 +;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>"))
  105.68 +(defn pprint-simple-list [alis]
  105.69 +  (pprint-logical-block :prefix "(" :suffix ")"
  105.70 +    (loop [alis (seq alis)]
  105.71 +      (when alis
  105.72 +	(write-out (first alis))
  105.73 +	(when (next alis)
  105.74 +	  (.write ^java.io.Writer *out* " ")
  105.75 +	  (pprint-newline :linear)
  105.76 +	  (recur (next alis)))))))
  105.77 +
  105.78 +(defn pprint-list [alis]
  105.79 +  (if-not (pprint-reader-macro alis)
  105.80 +    (pprint-simple-list alis)))
  105.81 +
  105.82 +;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>"))
  105.83 +(defn pprint-vector [avec]
  105.84 +  (pprint-logical-block :prefix "[" :suffix "]"
  105.85 +    (loop [aseq (seq avec)]
  105.86 +      (when aseq
  105.87 +	(write-out (first aseq))
  105.88 +	(when (next aseq)
  105.89 +	  (.write ^java.io.Writer *out* " ")
  105.90 +	  (pprint-newline :linear)
  105.91 +	  (recur (next aseq)))))))
  105.92 +
  105.93 +(def pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>"))
  105.94 +
  105.95 +;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>"))
  105.96 +(defn pprint-map [amap]
  105.97 +  (pprint-logical-block :prefix "{" :suffix "}"
  105.98 +    (loop [aseq (seq amap)]
  105.99 +      (when aseq
 105.100 +	(pprint-logical-block 
 105.101 +          (write-out (ffirst aseq))
 105.102 +          (.write ^java.io.Writer *out* " ")
 105.103 +          (pprint-newline :linear)
 105.104 +          (write-out (fnext (first aseq))))
 105.105 +        (when (next aseq)
 105.106 +          (.write ^java.io.Writer *out* ", ")
 105.107 +          (pprint-newline :linear)
 105.108 +          (recur (next aseq)))))))
 105.109 +
 105.110 +(def pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>"))
 105.111 +(defn pprint-ref [ref]
 105.112 +  (pprint-logical-block  :prefix "#<Ref " :suffix ">"
 105.113 +    (write-out @ref)))
 105.114 +(defn pprint-atom [ref]
 105.115 +  (pprint-logical-block :prefix "#<Atom " :suffix ">"
 105.116 +    (write-out @ref)))
 105.117 +(defn pprint-agent [ref]
 105.118 +  (pprint-logical-block :prefix "#<Agent " :suffix ">"
 105.119 +    (write-out @ref)))
 105.120 +
 105.121 +(defn pprint-simple-default [obj]
 105.122 +  (cond 
 105.123 +    (.isArray (class obj)) (pprint-array obj)
 105.124 +    (and *print-suppress-namespaces* (symbol? obj)) (print (name obj))
 105.125 +    :else (pr obj)))
 105.126 +
 105.127 +
 105.128 +(defmulti 
 105.129 +  *simple-dispatch*
 105.130 +  "The pretty print dispatch function for simple data structure format."
 105.131 +  {:arglists '[[object]]} 
 105.132 +  class)
 105.133 +
 105.134 +(use-method *simple-dispatch* clojure.lang.ISeq pprint-list)
 105.135 +(use-method *simple-dispatch* clojure.lang.IPersistentVector pprint-vector)
 105.136 +(use-method *simple-dispatch* clojure.lang.IPersistentMap pprint-map)
 105.137 +(use-method *simple-dispatch* clojure.lang.IPersistentSet pprint-set)
 105.138 +(use-method *simple-dispatch* clojure.lang.Ref pprint-ref)
 105.139 +(use-method *simple-dispatch* clojure.lang.Atom pprint-atom)
 105.140 +(use-method *simple-dispatch* clojure.lang.Agent pprint-agent)
 105.141 +(use-method *simple-dispatch* nil pr)
 105.142 +(use-method *simple-dispatch* :default pprint-simple-default)
 105.143 +
 105.144 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.145 +;;; Dispatch for the code table
 105.146 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.147 +
 105.148 +(declare pprint-simple-code-list)
 105.149 +
 105.150 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.151 +;;; Format something that looks like a simple def (sans metadata, since the reader
 105.152 +;;; won't give it to us now).
 105.153 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.154 +
 105.155 +(def pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>"))
 105.156 +
 105.157 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.158 +;;; Format something that looks like a defn or defmacro
 105.159 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.160 +
 105.161 +;;; Format the params and body of a defn with a single arity
 105.162 +(defn- single-defn [alis has-doc-str?]
 105.163 +  (if (seq alis)
 105.164 +    (do
 105.165 +      (if has-doc-str?
 105.166 +        ((formatter-out " ~_"))
 105.167 +        ((formatter-out " ~@_")))
 105.168 +      ((formatter-out "~{~w~^ ~_~}") alis))))
 105.169 +
 105.170 +;;; Format the param and body sublists of a defn with multiple arities
 105.171 +(defn- multi-defn [alis has-doc-str?]
 105.172 +  (if (seq alis)
 105.173 +    ((formatter-out " ~_~{~w~^ ~_~}") alis)))
 105.174 +
 105.175 +;;; TODO: figure out how to support capturing metadata in defns (we might need a 
 105.176 +;;; special reader)
 105.177 +(defn pprint-defn [alis]
 105.178 +  (if (next alis) 
 105.179 +    (let [[defn-sym defn-name & stuff] alis
 105.180 +          [doc-str stuff] (if (string? (first stuff))
 105.181 +                            [(first stuff) (next stuff)]
 105.182 +                            [nil stuff])
 105.183 +          [attr-map stuff] (if (map? (first stuff))
 105.184 +                             [(first stuff) (next stuff)]
 105.185 +                             [nil stuff])]
 105.186 +      (pprint-logical-block :prefix "(" :suffix ")"
 105.187 +        ((formatter-out "~w ~1I~@_~w") defn-sym defn-name)
 105.188 +        (if doc-str
 105.189 +          ((formatter-out " ~_~w") doc-str))
 105.190 +        (if attr-map
 105.191 +          ((formatter-out " ~_~w") attr-map))
 105.192 +        ;; Note: the multi-defn case will work OK for malformed defns too
 105.193 +        (cond
 105.194 +         (vector? (first stuff)) (single-defn stuff (or doc-str attr-map))
 105.195 +         :else (multi-defn stuff (or doc-str attr-map)))))
 105.196 +    (pprint-simple-code-list alis)))
 105.197 +
 105.198 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.199 +;;; Format something with a binding form
 105.200 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.201 +
 105.202 +(defn pprint-binding-form [binding-vec]
 105.203 +  (pprint-logical-block :prefix "[" :suffix "]"
 105.204 +    (loop [binding binding-vec]
 105.205 +      (when (seq binding)
 105.206 +        (pprint-logical-block binding
 105.207 +          (write-out (first binding))
 105.208 +          (when (next binding)
 105.209 +            (.write ^java.io.Writer *out* " ")
 105.210 +            (pprint-newline :miser)
 105.211 +            (write-out (second binding))))
 105.212 +        (when (next (rest binding))
 105.213 +          (.write ^java.io.Writer *out* " ")
 105.214 +          (pprint-newline :linear)
 105.215 +          (recur (next (rest binding))))))))
 105.216 +
 105.217 +(defn pprint-let [alis]
 105.218 +  (let [base-sym (first alis)]
 105.219 +    (pprint-logical-block :prefix "(" :suffix ")"
 105.220 +      (if (and (next alis) (vector? (second alis)))
 105.221 +        (do
 105.222 +          ((formatter-out "~w ~1I~@_") base-sym)
 105.223 +          (pprint-binding-form (second alis))
 105.224 +          ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis))))
 105.225 +        (pprint-simple-code-list alis)))))
 105.226 +
 105.227 +
 105.228 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.229 +;;; Format something that looks like "if"
 105.230 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.231 +
 105.232 +(def pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>"))
 105.233 +
 105.234 +(defn pprint-cond [alis]
 105.235 +  (pprint-logical-block :prefix "(" :suffix ")"
 105.236 +    (pprint-indent :block 1)
 105.237 +    (write-out (first alis))
 105.238 +    (when (next alis)
 105.239 +      (.write ^java.io.Writer *out* " ")
 105.240 +      (pprint-newline :linear)
 105.241 +     (loop [alis (next alis)]
 105.242 +       (when alis
 105.243 +         (pprint-logical-block alis
 105.244 +          (write-out (first alis))
 105.245 +          (when (next alis)
 105.246 +            (.write ^java.io.Writer *out* " ")
 105.247 +            (pprint-newline :miser)
 105.248 +            (write-out (second alis))))
 105.249 +         (when (next (rest alis))
 105.250 +           (.write ^java.io.Writer *out* " ")
 105.251 +           (pprint-newline :linear)
 105.252 +           (recur (next (rest alis)))))))))
 105.253 +
 105.254 +(defn pprint-condp [alis]
 105.255 +  (if (> (count alis) 3) 
 105.256 +    (pprint-logical-block :prefix "(" :suffix ")"
 105.257 +      (pprint-indent :block 1)
 105.258 +      (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis)
 105.259 +      (loop [alis (seq (drop 3 alis))]
 105.260 +        (when alis
 105.261 +          (pprint-logical-block alis
 105.262 +            (write-out (first alis))
 105.263 +            (when (next alis)
 105.264 +              (.write ^java.io.Writer *out* " ")
 105.265 +              (pprint-newline :miser)
 105.266 +              (write-out (second alis))))
 105.267 +          (when (next (rest alis))
 105.268 +            (.write ^java.io.Writer *out* " ")
 105.269 +            (pprint-newline :linear)
 105.270 +            (recur (next (rest alis)))))))
 105.271 +    (pprint-simple-code-list alis)))
 105.272 +
 105.273 +;;; The map of symbols that are defined in an enclosing #() anonymous function
 105.274 +(def *symbol-map* {})
 105.275 +
 105.276 +(defn pprint-anon-func [alis]
 105.277 +  (let [args (second alis)
 105.278 +        nlis (first (rest (rest alis)))]
 105.279 +    (if (vector? args)
 105.280 +      (binding [*symbol-map* (if (= 1 (count args)) 
 105.281 +                               {(first args) "%"}
 105.282 +                               (into {} 
 105.283 +                                     (map 
 105.284 +                                      #(vector %1 (str \% %2)) 
 105.285 +                                      args 
 105.286 +                                      (range 1 (inc (count args))))))]
 105.287 +        ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis))
 105.288 +      (pprint-simple-code-list alis))))
 105.289 +
 105.290 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.291 +;;; The master definitions for formatting lists in code (that is, (fn args...) or
 105.292 +;;; special forms).
 105.293 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 105.294 +
 105.295 +;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is
 105.296 +;;; easier on the stack.
 105.297 +
 105.298 +(defn pprint-simple-code-list [alis]
 105.299 +  (pprint-logical-block :prefix "(" :suffix ")"
 105.300 +    (pprint-indent :block 1)
 105.301 +    (loop [alis (seq alis)]
 105.302 +      (when alis
 105.303 +	(write-out (first alis))
 105.304 +	(when (next alis)
 105.305 +	  (.write ^java.io.Writer *out* " ")
 105.306 +	  (pprint-newline :linear)
 105.307 +	  (recur (next alis)))))))
 105.308 +
 105.309 +;;; Take a map with symbols as keys and add versions with no namespace.
 105.310 +;;; That is, if ns/sym->val is in the map, add sym->val to the result.
 105.311 +(defn two-forms [amap]
 105.312 +  (into {} 
 105.313 +        (mapcat 
 105.314 +         identity 
 105.315 +         (for [x amap] 
 105.316 +           [x [(symbol (name (first x))) (second x)]]))))
 105.317 +
 105.318 +(defn add-core-ns [amap]
 105.319 +  (let [core "clojure.core"]
 105.320 +    (into {}
 105.321 +          (map #(let [[s f] %] 
 105.322 +                  (if (not (or (namespace s) (special-symbol? s)))
 105.323 +                    [(symbol core (name s)) f]
 105.324 +                    %))
 105.325 +               amap))))
 105.326 +
 105.327 +(def *code-table*
 105.328 +     (two-forms
 105.329 +      (add-core-ns
 105.330 +       {'def pprint-hold-first, 'defonce pprint-hold-first, 
 105.331 +	'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn,
 105.332 +        'let pprint-let, 'loop pprint-let, 'binding pprint-let,
 105.333 +        'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let,
 105.334 +	'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let,
 105.335 +	'when-first pprint-let,
 105.336 +        'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if,
 105.337 +        'cond pprint-cond, 'condp pprint-condp,
 105.338 +        'fn* pprint-anon-func,
 105.339 +        '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first,
 105.340 +        'locking pprint-hold-first, 'struct pprint-hold-first,
 105.341 +        'struct-map pprint-hold-first, 
 105.342 +        })))
 105.343 +
 105.344 +(defn pprint-code-list [alis]
 105.345 +  (if-not (pprint-reader-macro alis) 
 105.346 +    (if-let [special-form (*code-table* (first alis))]
 105.347 +      (special-form alis)
 105.348 +      (pprint-simple-code-list alis))))
 105.349 +
 105.350 +(defn pprint-code-symbol [sym] 
 105.351 +  (if-let [arg-num (sym *symbol-map*)]
 105.352 +    (print arg-num)
 105.353 +    (if *print-suppress-namespaces* 
 105.354 +      (print (name sym))
 105.355 +      (pr sym))))
 105.356 +
 105.357 +(defmulti 
 105.358 +  *code-dispatch*
 105.359 +  "The pretty print dispatch function for pretty printing Clojure code."
 105.360 +  {:arglists '[[object]]} 
 105.361 +  class)
 105.362 +
 105.363 +(use-method *code-dispatch* clojure.lang.ISeq pprint-code-list)
 105.364 +(use-method *code-dispatch* clojure.lang.Symbol pprint-code-symbol)
 105.365 +
 105.366 +;; The following are all exact copies of *simple-dispatch*
 105.367 +(use-method *code-dispatch* clojure.lang.IPersistentVector pprint-vector)
 105.368 +(use-method *code-dispatch* clojure.lang.IPersistentMap pprint-map)
 105.369 +(use-method *code-dispatch* clojure.lang.IPersistentSet pprint-set)
 105.370 +(use-method *code-dispatch* clojure.lang.Ref pprint-ref)
 105.371 +(use-method *code-dispatch* clojure.lang.Atom pprint-atom)
 105.372 +(use-method *code-dispatch* clojure.lang.Agent pprint-agent)
 105.373 +(use-method *code-dispatch* nil pr)
 105.374 +(use-method *code-dispatch* :default pprint-simple-default)
 105.375 +
 105.376 +(set-pprint-dispatch *simple-dispatch*)
 105.377 +
 105.378 +
 105.379 +;;; For testing
 105.380 +(comment
 105.381 +
 105.382 +(with-pprint-dispatch *code-dispatch* 
 105.383 +  (pprint 
 105.384 +   '(defn cl-format 
 105.385 +      "An implementation of a Common Lisp compatible format function"
 105.386 +      [stream format-in & args]
 105.387 +      (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
 105.388 +            navigator (init-navigator args)]
 105.389 +        (execute-format stream compiled-format navigator)))))
 105.390 +
 105.391 +(with-pprint-dispatch *code-dispatch* 
 105.392 +  (pprint 
 105.393 +   '(defn cl-format 
 105.394 +      [stream format-in & args]
 105.395 +      (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
 105.396 +            navigator (init-navigator args)]
 105.397 +        (execute-format stream compiled-format navigator)))))
 105.398 +
 105.399 +(with-pprint-dispatch *code-dispatch* 
 105.400 +  (pprint
 105.401 +   '(defn- -write 
 105.402 +      ([this x]
 105.403 +         (condp = (class x)
 105.404 +           String 
 105.405 +           (let [s0 (write-initial-lines this x)
 105.406 +                 s (.replaceFirst s0 "\\s+$" "")
 105.407 +                 white-space (.substring s0 (count s))
 105.408 +                 mode (getf :mode)]
 105.409 +             (if (= mode :writing)
 105.410 +               (dosync
 105.411 +                (write-white-space this)
 105.412 +                (.col_write this s)
 105.413 +                (setf :trailing-white-space white-space))
 105.414 +               (add-to-buffer this (make-buffer-blob s white-space))))
 105.415 +
 105.416 +           Integer
 105.417 +           (let [c ^Character x]
 105.418 +             (if (= (getf :mode) :writing)
 105.419 +               (do 
 105.420 +                 (write-white-space this)
 105.421 +                 (.col_write this x))
 105.422 +               (if (= c (int \newline))
 105.423 +                 (write-initial-lines this "\n")
 105.424 +                 (add-to-buffer this (make-buffer-blob (str (char c)) nil))))))))))
 105.425 +
 105.426 +(with-pprint-dispatch *code-dispatch* 
 105.427 +  (pprint 
 105.428 +   '(defn pprint-defn [writer alis]
 105.429 +      (if (next alis) 
 105.430 +        (let [[defn-sym defn-name & stuff] alis
 105.431 +              [doc-str stuff] (if (string? (first stuff))
 105.432 +                                [(first stuff) (next stuff)]
 105.433 +                                [nil stuff])
 105.434 +              [attr-map stuff] (if (map? (first stuff))
 105.435 +                                 [(first stuff) (next stuff)]
 105.436 +                                 [nil stuff])]
 105.437 +          (pprint-logical-block writer :prefix "(" :suffix ")"
 105.438 +                                (cl-format true "~w ~1I~@_~w" defn-sym defn-name)
 105.439 +                                (if doc-str
 105.440 +                                  (cl-format true " ~_~w" doc-str))
 105.441 +                                (if attr-map
 105.442 +                                  (cl-format true " ~_~w" attr-map))
 105.443 +                                ;; Note: the multi-defn case will work OK for malformed defns too
 105.444 +                                (cond
 105.445 +                                  (vector? (first stuff)) (single-defn stuff (or doc-str attr-map))
 105.446 +                                  :else (multi-defn stuff (or doc-str attr-map)))))
 105.447 +        (pprint-simple-code-list writer alis)))))
 105.448 +)
 105.449 +nil
 105.450 +
   106.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   106.2 +++ b/src/clojure/contrib/pprint/pprint_base.clj	Sat Aug 21 06:25:44 2010 -0400
   106.3 @@ -0,0 +1,342 @@
   106.4 +;;; pprint_base.clj -- part of the pretty printer for Clojure
   106.5 +
   106.6 +;; by Tom Faulhaber
   106.7 +;; April 3, 2009
   106.8 +
   106.9 +;   Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved.
  106.10 +;   The use and distribution terms for this software are covered by the
  106.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  106.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  106.13 +;   By using this software in any fashion, you are agreeing to be bound by
  106.14 +;   the terms of this license.
  106.15 +;   You must not remove this notice, or any other, from this software.
  106.16 +
  106.17 +;; This module implements the generic pretty print functions and special variables
  106.18 +
  106.19 +(in-ns 'clojure.contrib.pprint)
  106.20 +
  106.21 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.22 +;; Variables that control the pretty printer
  106.23 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.24 +
  106.25 +;;;
  106.26 +;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core
  106.27 +;;; TODO: use *print-dup* here (or is it supplanted by other variables?)
  106.28 +;;; TODO: make dispatch items like "(let..." get counted in *print-length*
  106.29 +;;; constructs
  106.30 +
  106.31 +
  106.32 +(def
  106.33 + ^{ :doc "Bind to true if you want write to use pretty printing"}
  106.34 + *print-pretty* true)
  106.35 +
  106.36 +(defonce ; If folks have added stuff here, don't overwrite
  106.37 + ^{ :doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch
  106.38 +to modify."}
  106.39 + *print-pprint-dispatch* nil)
  106.40 +
  106.41 +(def
  106.42 + ^{ :doc "Pretty printing will try to avoid anything going beyond this column.
  106.43 +Set it to nil to have pprint let the line be arbitrarily long. This will ignore all 
  106.44 +non-mandatory newlines."}
  106.45 + *print-right-margin* 72)
  106.46 +
  106.47 +(def
  106.48 + ^{ :doc "The column at which to enter miser style. Depending on the dispatch table, 
  106.49 +miser style add newlines in more places to try to keep lines short allowing for further 
  106.50 +levels of nesting."}
  106.51 + *print-miser-width* 40)
  106.52 +
  106.53 +;;; TODO implement output limiting
  106.54 +(def
  106.55 + ^{ :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"}
  106.56 + *print-lines* nil)
  106.57 +
  106.58 +;;; TODO: implement circle and shared
  106.59 +(def
  106.60 + ^{ :doc "Mark circular structures (N.B. This is not yet used)"}
  106.61 + *print-circle* nil)
  106.62 +
  106.63 +;;; TODO: should we just use *print-dup* here?
  106.64 +(def
  106.65 + ^{ :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"}
  106.66 + *print-shared* nil)
  106.67 +
  106.68 +(def
  106.69 + ^{ :doc "Don't print namespaces with symbols. This is particularly useful when 
  106.70 +pretty printing the results of macro expansions"}
  106.71 + *print-suppress-namespaces* nil)
  106.72 +
  106.73 +;;; TODO: support print-base and print-radix in cl-format
  106.74 +;;; TODO: support print-base and print-radix in rationals
  106.75 +(def
  106.76 + ^{ :doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, 
  106.77 +or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the 
  106.78 +radix specifier is in the form #XXr where XX is the decimal value of *print-base* "}
  106.79 + *print-radix* nil)
  106.80 +
  106.81 +(def
  106.82 + ^{ :doc "The base to use for printing integers and rationals."}
  106.83 + *print-base* 10)
  106.84 +
  106.85 +
  106.86 +
  106.87 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.88 +;; Internal variables that keep track of where we are in the 
  106.89 +;; structure
  106.90 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.91 +
  106.92 +(def ^{ :private true } *current-level* 0)
  106.93 +
  106.94 +(def ^{ :private true } *current-length* nil)
  106.95 +
  106.96 +;; TODO: add variables for length, lines.
  106.97 +
  106.98 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.99 +;; Support for the write function
 106.100 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 106.101 +
 106.102 +(declare format-simple-number)
 106.103 +
 106.104 +(def ^{:private true} orig-pr pr)
 106.105 +
 106.106 +(defn- pr-with-base [x]
 106.107 +  (if-let [s (format-simple-number x)]
 106.108 +    (print s)
 106.109 +    (orig-pr x)))
 106.110 +
 106.111 +(def ^{:private true} write-option-table
 106.112 +     {;:array            *print-array*
 106.113 +      :base             'clojure.contrib.pprint/*print-base*,
 106.114 +      ;;:case             *print-case*,
 106.115 +      :circle           'clojure.contrib.pprint/*print-circle*,
 106.116 +      ;;:escape           *print-escape*,
 106.117 +      ;;:gensym           *print-gensym*,
 106.118 +      :length           'clojure.core/*print-length*,
 106.119 +      :level            'clojure.core/*print-level*,
 106.120 +      :lines            'clojure.contrib.pprint/*print-lines*,
 106.121 +      :miser-width      'clojure.contrib.pprint/*print-miser-width*,
 106.122 +      :dispatch         'clojure.contrib.pprint/*print-pprint-dispatch*,
 106.123 +      :pretty           'clojure.contrib.pprint/*print-pretty*,
 106.124 +      :radix            'clojure.contrib.pprint/*print-radix*,
 106.125 +      :readably         'clojure.core/*print-readably*,
 106.126 +      :right-margin     'clojure.contrib.pprint/*print-right-margin*,
 106.127 +      :suppress-namespaces 'clojure.contrib.pprint/*print-suppress-namespaces*})
 106.128 +
 106.129 +
 106.130 +(defmacro ^{:private true} binding-map [amap & body]
 106.131 +  (let []
 106.132 +    `(do
 106.133 +       (. clojure.lang.Var (pushThreadBindings ~amap))
 106.134 +       (try
 106.135 +        ~@body
 106.136 +        (finally
 106.137 +         (. clojure.lang.Var (popThreadBindings)))))))
 106.138 +
 106.139 +(defn- table-ize [t m] 
 106.140 +  (apply hash-map (mapcat 
 106.141 +                   #(when-let [v (get t (key %))] [(find-var v) (val %)]) 
 106.142 +                   m)))
 106.143 +
 106.144 +(defn- pretty-writer? 
 106.145 +  "Return true iff x is a PrettyWriter"
 106.146 +  [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x)))
 106.147 +
 106.148 +(defn- make-pretty-writer 
 106.149 +  "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width"
 106.150 +  [base-writer right-margin miser-width]
 106.151 +  (pretty-writer base-writer right-margin miser-width))
 106.152 +
 106.153 +(defmacro ^{:private true} with-pretty-writer [base-writer & body]
 106.154 +  `(let [base-writer# ~base-writer
 106.155 +         new-writer# (not (pretty-writer? base-writer#))]
 106.156 +     (binding [*out* (if new-writer#
 106.157 +                      (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*)
 106.158 +                      base-writer#)]
 106.159 +       ~@body
 106.160 +       (.flush *out*))))
 106.161 +
 106.162 +
 106.163 +;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc.
 106.164 +(defn write-out 
 106.165 +  "Write an object to *out* subject to the current bindings of the printer control 
 106.166 +variables. Use the kw-args argument to override individual variables for this call (and 
 106.167 +any recursive calls).
 106.168 +
 106.169 +*out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility
 106.170 +of the caller.
 106.171 +
 106.172 +This method is primarily intended for use by pretty print dispatch functions that 
 106.173 +already know that the pretty printer will have set up their environment appropriately.
 106.174 +Normal library clients should use the standard \"write\" interface. "
 106.175 +  [object]
 106.176 +  (let [length-reached (and 
 106.177 +                        *current-length*
 106.178 +                        *print-length*
 106.179 +                        (>= *current-length* *print-length*))]
 106.180 +    (if-not *print-pretty*
 106.181 +      (pr object)
 106.182 +      (if length-reached
 106.183 +        (print "...")
 106.184 +        (do
 106.185 +          (if *current-length* (set! *current-length* (inc *current-length*)))
 106.186 +          (*print-pprint-dispatch* object))))
 106.187 +    length-reached))
 106.188 +
 106.189 +(defn write 
 106.190 +  "Write an object subject to the current bindings of the printer control variables.
 106.191 +Use the kw-args argument to override individual variables for this call (and any 
 106.192 +recursive calls). Returns the string result if :stream is nil or nil otherwise.
 106.193 +
 106.194 +The following keyword arguments can be passed with values:
 106.195 +  Keyword              Meaning                              Default value
 106.196 +  :stream              Writer for output or nil             true (indicates *out*)
 106.197 +  :base                Base to use for writing rationals    Current value of *print-base*
 106.198 +  :circle*             If true, mark circular structures    Current value of *print-circle*
 106.199 +  :length              Maximum elements to show in sublists Current value of *print-length*
 106.200 +  :level               Maximum depth                        Current value of *print-level*
 106.201 +  :lines*              Maximum lines of output              Current value of *print-lines*
 106.202 +  :miser-width         Width to enter miser mode            Current value of *print-miser-width*
 106.203 +  :dispatch            The pretty print dispatch function   Current value of *print-pprint-dispatch*
 106.204 +  :pretty              If true, do pretty printing          Current value of *print-pretty*
 106.205 +  :radix               If true, prepend a radix specifier   Current value of *print-radix*
 106.206 +  :readably*           If true, print readably              Current value of *print-readably*
 106.207 +  :right-margin        The column for the right margin      Current value of *print-right-margin*
 106.208 +  :suppress-namespaces If true, no namespaces in symbols    Current value of *print-suppress-namespaces*
 106.209 +
 106.210 +  * = not yet supported
 106.211 +"
 106.212 +  [object & kw-args]
 106.213 +  (let [options (merge {:stream true} (apply hash-map kw-args))]
 106.214 +    (binding-map (table-ize write-option-table options) 
 106.215 +      (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) 
 106.216 +        (let [optval (if (contains? options :stream) 
 106.217 +                       (:stream options)
 106.218 +                       true) 
 106.219 +              base-writer (condp = optval
 106.220 +                            nil (java.io.StringWriter.)
 106.221 +                            true *out*
 106.222 +                            optval)]
 106.223 +          (if *print-pretty*
 106.224 +            (with-pretty-writer base-writer
 106.225 +              (write-out object))
 106.226 +            (binding [*out* base-writer]
 106.227 +              (pr object)))
 106.228 +          (if (nil? optval) 
 106.229 +            (.toString ^java.io.StringWriter base-writer)))))))
 106.230 +
 106.231 +
 106.232 +(defn pprint 
 106.233 +  "Pretty print object to the optional output writer. If the writer is not provided, 
 106.234 +print the object to the currently bound value of *out*."
 106.235 +  ([object] (pprint object *out*)) 
 106.236 +  ([object writer]
 106.237 +     (with-pretty-writer writer
 106.238 +       (binding [*print-pretty* true]
 106.239 +         (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) 
 106.240 +           (write-out object)))
 106.241 +       (if (not (= 0 (get-column *out*)))
 106.242 +         (.write *out* (int \newline))))))
 106.243 +
 106.244 +(defmacro pp 
 106.245 +  "A convenience macro that pretty prints the last thing output. This is
 106.246 +exactly equivalent to (pprint *1)."
 106.247 +  [] `(pprint *1))
 106.248 +
 106.249 +(defn set-pprint-dispatch  
 106.250 +  "Set the pretty print dispatch function to a function matching (fn [obj] ...)
 106.251 +where obj is the object to pretty print. That function will be called with *out* set
 106.252 +to a pretty printing writer to which it should do its printing.
 106.253 +
 106.254 +For example functions, see *simple-dispatch* and *code-dispatch* in 
 106.255 +clojure.contrib.pprint.dispatch.clj."
 106.256 +  [function]
 106.257 +  (let [old-meta (meta #'*print-pprint-dispatch*)]
 106.258 +    (alter-var-root #'*print-pprint-dispatch* (constantly function))
 106.259 +    (alter-meta! #'*print-pprint-dispatch* (constantly old-meta)))
 106.260 +  nil)
 106.261 +
 106.262 +(defmacro with-pprint-dispatch 
 106.263 +  "Execute body with the pretty print dispatch function bound to function."
 106.264 +  [function & body]
 106.265 +  `(binding [*print-pprint-dispatch* ~function]
 106.266 +     ~@body))
 106.267 +
 106.268 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 106.269 +;; Support for the functional interface to the pretty printer
 106.270 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 106.271 +
 106.272 +(defn- parse-lb-options [opts body]
 106.273 +  (loop [body body
 106.274 +         acc []]
 106.275 +    (if (opts (first body))
 106.276 +      (recur (drop 2 body) (concat acc (take 2 body)))
 106.277 +      [(apply hash-map acc) body])))
 106.278 +
 106.279 +(defn- check-enumerated-arg [arg choices]
 106.280 +  (if-not (choices arg)
 106.281 +          (throw
 106.282 +           (IllegalArgumentException.
 106.283 +            ;; TODO clean up choices string
 106.284 +            (str "Bad argument: " arg ". It must be one of " choices)))))
 106.285 +
 106.286 +(defn level-exceeded []
 106.287 +  (and *print-level* (>= *current-level* *print-level*)))
 106.288 +
 106.289 +(defmacro pprint-logical-block 
 106.290 +  "Execute the body as a pretty printing logical block with output to *out* which 
 106.291 +must be a pretty printing writer. When used from pprint or cl-format, this can be 
 106.292 +assumed. 
 106.293 +
 106.294 +Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, 
 106.295 +and :suffix."
 106.296 +  {:arglists '[[options* body]]}
 106.297 +  [& args]
 106.298 +  (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)]
 106.299 +    `(do (if (level-exceeded) 
 106.300 +           (.write ^java.io.Writer *out* "#")
 106.301 +           (binding [*current-level* (inc *current-level*)
 106.302 +                     *current-length* 0] 
 106.303 +             (start-block *out*
 106.304 +                          ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options))
 106.305 +             ~@body
 106.306 +             (end-block *out*)))
 106.307 +         nil)))
 106.308 +
 106.309 +(defn pprint-newline
 106.310 +  "Print a conditional newline to a pretty printing stream. kind specifies if the 
 106.311 +newline is :linear, :miser, :fill, or :mandatory. 
 106.312 +
 106.313 +Output is sent to *out* which must be a pretty printing writer."
 106.314 +  [kind] 
 106.315 +  (check-enumerated-arg kind #{:linear :miser :fill :mandatory})
 106.316 +  (nl *out* kind))
 106.317 +
 106.318 +(defn pprint-indent 
 106.319 +  "Create an indent at this point in the pretty printing stream. This defines how 
 106.320 +following lines are indented. relative-to can be either :block or :current depending 
 106.321 +whether the indent should be computed relative to the start of the logical block or
 106.322 +the current column position. n is an offset. 
 106.323 +
 106.324 +Output is sent to *out* which must be a pretty printing writer."
 106.325 +  [relative-to n] 
 106.326 +  (check-enumerated-arg relative-to #{:block :current})
 106.327 +  (indent *out* relative-to n))
 106.328 +
 106.329 +;; TODO a real implementation for pprint-tab
 106.330 +(defn pprint-tab 
 106.331 +  "Tab at this point in the pretty printing stream. kind specifies whether the tab
 106.332 +is :line, :section, :line-relative, or :section-relative. 
 106.333 +
 106.334 +Colnum and colinc specify the target column and the increment to move the target
 106.335 +forward if the output is already past the original target.
 106.336 +
 106.337 +Output is sent to *out* which must be a pretty printing writer.
 106.338 +
 106.339 +THIS FUNCTION IS NOT YET IMPLEMENTED."
 106.340 +  [kind colnum colinc] 
 106.341 +  (check-enumerated-arg kind #{:line :section :line-relative :section-relative})
 106.342 +  (throw (UnsupportedOperationException. "pprint-tab is not yet implemented")))
 106.343 +
 106.344 +
 106.345 +nil
   107.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   107.2 +++ b/src/clojure/contrib/pprint/pretty_writer.clj	Sat Aug 21 06:25:44 2010 -0400
   107.3 @@ -0,0 +1,488 @@
   107.4 +;;; pretty_writer.clj -- part of the pretty printer for Clojure
   107.5 +
   107.6 +;; by Tom Faulhaber
   107.7 +;; April 3, 2009
   107.8 +;; Revised to use proxy instead of gen-class April 2010
   107.9 +
  107.10 +;   Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved.
  107.11 +;   The use and distribution terms for this software are covered by the
  107.12 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  107.13 +;   which can be found in the file epl-v10.html at the root of this distribution.
  107.14 +;   By using this software in any fashion, you are agreeing to be bound by
  107.15 +;   the terms of this license.
  107.16 +;   You must not remove this notice, or any other, from this software.
  107.17 +
  107.18 +;; This module implements a wrapper around a java.io.Writer which implements the
  107.19 +;; core of the XP algorithm.
  107.20 +
  107.21 +(ns clojure.contrib.pprint.pretty-writer
  107.22 +  (:refer-clojure :exclude (deftype))
  107.23 +  (:use clojure.contrib.pprint.utilities)
  107.24 +  (:use [clojure.contrib.pprint.column-writer
  107.25 +         :only (column-writer get-column get-max-column)])
  107.26 +  (:import
  107.27 +   [clojure.lang IDeref]
  107.28 +   [java.io Writer]))
  107.29 +
  107.30 +;; TODO: Support for tab directives
  107.31 +
  107.32 +
  107.33 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107.34 +;;; Forward declarations
  107.35 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107.36 +
  107.37 +(declare get-miser-width)
  107.38 +
  107.39 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107.40 +;;; Macros to simplify dealing with types and classes. These are
  107.41 +;;; really utilities, but I'm experimenting with them here.
  107.42 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107.43 +
  107.44 +(defmacro ^{:private true} 
  107.45 +  getf 
  107.46 +  "Get the value of the field a named by the argument (which should be a keyword)."
  107.47 +  [sym]
  107.48 +  `(~sym @@~'this))
  107.49 +
  107.50 +(defmacro ^{:private true} 
  107.51 +  setf [sym new-val] 
  107.52 +  "Set the value of the field SYM to NEW-VAL"
  107.53 +  `(alter @~'this assoc ~sym ~new-val))
  107.54 +
  107.55 +(defmacro ^{:private true} 
  107.56 +  deftype [type-name & fields]
  107.57 +  (let [name-str (name type-name)]
  107.58 +    `(do
  107.59 +       (defstruct ~type-name :type-tag ~@fields)
  107.60 +       (defn- ~(symbol (str "make-" name-str)) 
  107.61 +         [& vals#] (apply struct ~type-name ~(keyword name-str) vals#))
  107.62 +       (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str))))))
  107.63 +
  107.64 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107.65 +;;; The data structures used by pretty-writer
  107.66 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107.67 +
  107.68 +(defstruct ^{:private true} logical-block
  107.69 +           :parent :section :start-col :indent
  107.70 +           :done-nl :intra-block-nl
  107.71 +           :prefix :per-line-prefix :suffix
  107.72 +           :logical-block-callback)
  107.73 +
  107.74 +(defn ancestor? [parent child]
  107.75 +  (loop [child (:parent child)]
  107.76 +    (cond 
  107.77 +     (nil? child) false
  107.78 +     (identical? parent child) true
  107.79 +     :else (recur (:parent child)))))
  107.80 +
  107.81 +(defstruct ^{:private true} section :parent)
  107.82 +
  107.83 +(defn buffer-length [l] 
  107.84 +  (let [l (seq l)]
  107.85 +    (if l 
  107.86 +      (- (:end-pos (last l)) (:start-pos (first l)))
  107.87 +      0)))
  107.88 +
  107.89 +; A blob of characters (aka a string)
  107.90 +(deftype buffer-blob :data :trailing-white-space :start-pos :end-pos)
  107.91 +
  107.92 +; A newline
  107.93 +(deftype nl-t :type :logical-block :start-pos :end-pos)
  107.94 +
  107.95 +(deftype start-block-t :logical-block :start-pos :end-pos)
  107.96 +
  107.97 +(deftype end-block-t :logical-block :start-pos :end-pos)
  107.98 +
  107.99 +(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos)
 107.100 +
 107.101 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.102 +;;; Functions to write tokens in the output buffer
 107.103 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.104 +
 107.105 +(declare emit-nl)
 107.106 +
 107.107 +(defmulti write-token #(:type-tag %2))
 107.108 +(defmethod write-token :start-block-t [^Writer this token]
 107.109 +   (when-let [cb (getf :logical-block-callback)] (cb :start))
 107.110 +   (let [lb (:logical-block token)]
 107.111 +    (dosync
 107.112 +     (when-let [^String prefix (:prefix lb)] 
 107.113 +       (.write (getf :base) prefix))
 107.114 +     (let [col (get-column (getf :base))]
 107.115 +       (ref-set (:start-col lb) col)
 107.116 +       (ref-set (:indent lb) col)))))
 107.117 +
 107.118 +(defmethod write-token :end-block-t [^Writer this token]
 107.119 +  (when-let [cb (getf :logical-block-callback)] (cb :end))
 107.120 +  (when-let [^String suffix (:suffix (:logical-block token))] 
 107.121 +    (.write (getf :base) suffix)))
 107.122 +
 107.123 +(defmethod write-token :indent-t [^Writer this token]
 107.124 +  (let [lb (:logical-block token)]
 107.125 +    (ref-set (:indent lb) 
 107.126 +             (+ (:offset token)
 107.127 +                (condp = (:relative-to token)
 107.128 +		  :block @(:start-col lb)
 107.129 +		  :current (get-column (getf :base)))))))
 107.130 +
 107.131 +(defmethod write-token :buffer-blob [^Writer this token]
 107.132 +  (.write (getf :base) ^String (:data token)))
 107.133 +
 107.134 +(defmethod write-token :nl-t [^Writer this token]
 107.135 +;  (prlabel wt @(:done-nl (:logical-block token)))
 107.136 +;  (prlabel wt (:type token) (= (:type token) :mandatory))
 107.137 +  (if (or (= (:type token) :mandatory)
 107.138 +           (and (not (= (:type token) :fill))
 107.139 +                @(:done-nl (:logical-block token))))
 107.140 +    (emit-nl this token)
 107.141 +    (if-let [^String tws (getf :trailing-white-space)]
 107.142 +      (.write (getf :base) tws)))
 107.143 +  (dosync (setf :trailing-white-space nil)))
 107.144 +
 107.145 +(defn- write-tokens [^Writer this tokens force-trailing-whitespace]
 107.146 +  (doseq [token tokens]
 107.147 +    (if-not (= (:type-tag token) :nl-t)
 107.148 +      (if-let [^String tws (getf :trailing-white-space)]
 107.149 +	(.write (getf :base) tws)))
 107.150 +    (write-token this token)
 107.151 +    (setf :trailing-white-space (:trailing-white-space token)))
 107.152 +  (let [^String tws (getf :trailing-white-space)] 
 107.153 +    (when (and force-trailing-whitespace tws)
 107.154 +      (.write (getf :base) tws)
 107.155 +      (setf :trailing-white-space nil))))
 107.156 +
 107.157 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.158 +;;; emit-nl? method defs for each type of new line. This makes
 107.159 +;;; the decision about whether to print this type of new line.
 107.160 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.161 +
 107.162 +
 107.163 +(defn- tokens-fit? [^Writer this tokens]
 107.164 +;;;  (prlabel tf? (get-column (getf :base) (buffer-length tokens))
 107.165 +  (let [maxcol (get-max-column (getf :base))]
 107.166 +    (or 
 107.167 +     (nil? maxcol) 
 107.168 +     (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol))))
 107.169 +
 107.170 +(defn- linear-nl? [this lb section]
 107.171 +;  (prlabel lnl? @(:done-nl lb) (tokens-fit? this section))
 107.172 +  (or @(:done-nl lb)
 107.173 +      (not (tokens-fit? this section))))
 107.174 +
 107.175 +(defn- miser-nl? [^Writer this lb section]
 107.176 +  (let [miser-width (get-miser-width this)
 107.177 +        maxcol (get-max-column (getf :base))]
 107.178 +    (and miser-width maxcol
 107.179 +         (>= @(:start-col lb) (- maxcol miser-width))
 107.180 +         (linear-nl? this lb section))))
 107.181 +
 107.182 +(defmulti emit-nl? (fn [t _ _ _] (:type t)))
 107.183 +
 107.184 +(defmethod emit-nl? :linear [newl this section _]
 107.185 +  (let [lb (:logical-block newl)]
 107.186 +    (linear-nl? this lb section)))
 107.187 +
 107.188 +(defmethod emit-nl? :miser [newl this section _]
 107.189 +  (let [lb (:logical-block newl)]
 107.190 +    (miser-nl? this lb section)))
 107.191 +
 107.192 +(defmethod emit-nl? :fill [newl this section subsection]
 107.193 +  (let [lb (:logical-block newl)]
 107.194 +    (or @(:intra-block-nl lb)
 107.195 +        (not (tokens-fit? this subsection))
 107.196 +        (miser-nl? this lb section))))
 107.197 +
 107.198 +(defmethod emit-nl? :mandatory [_ _ _ _]
 107.199 +  true)
 107.200 +
 107.201 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.202 +;;; Various support functions
 107.203 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.204 +
 107.205 +
 107.206 +(defn- get-section [buffer]
 107.207 +  (let [nl (first buffer) 
 107.208 +        lb (:logical-block nl)
 107.209 +        section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb)))
 107.210 +                                 (next buffer)))]
 107.211 +    [section (seq (drop (inc (count section)) buffer))])) 
 107.212 +
 107.213 +(defn- get-sub-section [buffer]
 107.214 +  (let [nl (first buffer) 
 107.215 +        lb (:logical-block nl)
 107.216 +        section (seq (take-while #(let [nl-lb (:logical-block %)]
 107.217 +                                    (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb)))))
 107.218 +                            (next buffer)))]
 107.219 +    section)) 
 107.220 +
 107.221 +(defn- update-nl-state [lb]
 107.222 +  (dosync
 107.223 +   (ref-set (:intra-block-nl lb) false)
 107.224 +   (ref-set (:done-nl lb) true)
 107.225 +   (loop [lb (:parent lb)]
 107.226 +     (if lb
 107.227 +       (do (ref-set (:done-nl lb) true)
 107.228 +           (ref-set (:intra-block-nl lb) true)
 107.229 +           (recur (:parent lb)))))))
 107.230 +
 107.231 +(defn emit-nl [^Writer this nl]
 107.232 +  (.write (getf :base) (int \newline))
 107.233 +  (dosync (setf :trailing-white-space nil))
 107.234 +  (let [lb (:logical-block nl)
 107.235 +        ^String prefix (:per-line-prefix lb)] 
 107.236 +    (if prefix 
 107.237 +      (.write (getf :base) prefix))
 107.238 +    (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix))
 107.239 +					  \space))] 
 107.240 +      (.write (getf :base) istr))
 107.241 +    (update-nl-state lb)))
 107.242 +
 107.243 +(defn- split-at-newline [tokens]
 107.244 +  (let [pre (seq (take-while #(not (nl-t? %)) tokens))]
 107.245 +    [pre (seq (drop (count pre) tokens))]))
 107.246 +
 107.247 +;;; Methods for showing token strings for debugging
 107.248 +
 107.249 +(defmulti tok :type-tag)
 107.250 +(defmethod tok :nl-t [token]
 107.251 +  (:type token))
 107.252 +(defmethod tok :buffer-blob [token]
 107.253 +  (str \" (:data token) (:trailing-white-space token) \"))
 107.254 +(defmethod tok :default [token]
 107.255 +  (:type-tag token))
 107.256 +(defn toks [toks] (map tok toks))
 107.257 +
 107.258 +;;; write-token-string is called when the set of tokens in the buffer
 107.259 +;;; is longer than the available space on the line
 107.260 +
 107.261 +(defn- write-token-string [this tokens]
 107.262 +  (let [[a b] (split-at-newline tokens)]
 107.263 +;;    (prlabel wts (toks a) (toks b))
 107.264 +    (if a (write-tokens this a false))
 107.265 +    (if b
 107.266 +      (let [[section remainder] (get-section b)
 107.267 +            newl (first b)]
 107.268 +;;         (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) 
 107.269 +        (let [do-nl (emit-nl? newl this section (get-sub-section b))
 107.270 +              result (if do-nl 
 107.271 +                       (do
 107.272 +;;                          (prlabel emit-nl (:type newl))
 107.273 +                         (emit-nl this newl)
 107.274 +                         (next b))
 107.275 +                       b)
 107.276 +              long-section (not (tokens-fit? this result))
 107.277 +              result (if long-section
 107.278 +                       (let [rem2 (write-token-string this section)]
 107.279 +;;;                              (prlabel recurse (toks rem2))
 107.280 +                         (if (= rem2 section)
 107.281 +                           (do ; If that didn't produce any output, it has no nls
 107.282 +                                        ; so we'll force it
 107.283 +                             (write-tokens this section false)
 107.284 +                             remainder)
 107.285 +                           (into [] (concat rem2 remainder))))
 107.286 +                       result)
 107.287 +;;              ff (prlabel wts (toks result))
 107.288 +              ] 
 107.289 +          result)))))
 107.290 +
 107.291 +(defn- write-line [^Writer this]
 107.292 +  (dosync
 107.293 +   (loop [buffer (getf :buffer)]
 107.294 +;;     (prlabel wl1 (toks buffer))
 107.295 +     (setf :buffer (into [] buffer))
 107.296 +     (if (not (tokens-fit? this buffer))
 107.297 +       (let [new-buffer (write-token-string this buffer)]
 107.298 +;;          (prlabel wl new-buffer)
 107.299 +         (if-not (identical? buffer new-buffer)
 107.300 +                 (recur new-buffer)))))))
 107.301 +
 107.302 +;;; Add a buffer token to the buffer and see if it's time to start
 107.303 +;;; writing
 107.304 +(defn- add-to-buffer [^Writer this token]
 107.305 +;  (prlabel a2b token)
 107.306 +  (dosync
 107.307 +   (setf :buffer (conj (getf :buffer) token))
 107.308 +   (if (not (tokens-fit? this (getf :buffer)))
 107.309 +     (write-line this))))
 107.310 +
 107.311 +;;; Write all the tokens that have been buffered
 107.312 +(defn- write-buffered-output [^Writer this]
 107.313 +  (write-line this)
 107.314 +  (if-let [buf (getf :buffer)]
 107.315 +    (do
 107.316 +      (write-tokens this buf true)
 107.317 +      (setf :buffer []))))
 107.318 +
 107.319 +;;; If there are newlines in the string, print the lines up until the last newline, 
 107.320 +;;; making the appropriate adjustments. Return the remainder of the string
 107.321 +(defn- write-initial-lines 
 107.322 +  [^Writer this ^String s] 
 107.323 +  (let [lines (.split s "\n" -1)]
 107.324 +    (if (= (count lines) 1)
 107.325 +      s
 107.326 +      (dosync 
 107.327 +       (let [^String prefix (:per-line-prefix (first (getf :logical-blocks)))
 107.328 +             ^String l (first lines)] 
 107.329 +         (if (= :buffering (getf :mode))
 107.330 +           (let [oldpos (getf :pos)
 107.331 +                 newpos (+ oldpos (count l))]
 107.332 +             (setf :pos newpos)
 107.333 +             (add-to-buffer this (make-buffer-blob l nil oldpos newpos))
 107.334 +             (write-buffered-output this))
 107.335 +           (.write (getf :base) l))
 107.336 +         (.write (getf :base) (int \newline))
 107.337 +         (doseq [^String l (next (butlast lines))]
 107.338 +           (.write (getf :base) l)
 107.339 +           (.write (getf :base) (int \newline))
 107.340 +           (if prefix
 107.341 +             (.write (getf :base) prefix)))
 107.342 +         (setf :buffering :writing)
 107.343 +         (last lines))))))
 107.344 +
 107.345 +
 107.346 +(defn write-white-space [^Writer this]
 107.347 +  (if-let [^String tws (getf :trailing-white-space)]
 107.348 +    (dosync
 107.349 +     (.write (getf :base) tws)
 107.350 +     (setf :trailing-white-space nil))))
 107.351 +
 107.352 +(defn- write-char [^Writer this ^Integer c]
 107.353 +  (if (= (getf :mode) :writing)
 107.354 +    (do 
 107.355 +      (write-white-space this)
 107.356 +      (.write (getf :base) c))
 107.357 +    (if (= c \newline)
 107.358 +      (write-initial-lines this "\n")
 107.359 +      (let [oldpos (getf :pos)
 107.360 +            newpos (inc oldpos)]
 107.361 +        (dosync
 107.362 +         (setf :pos newpos)
 107.363 +         (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos)))))))
 107.364 +
 107.365 +
 107.366 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.367 +;;; Initialize the pretty-writer instance
 107.368 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.369 +
 107.370 +
 107.371 +(defn pretty-writer [writer max-columns miser-width]
 107.372 +  (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))
 107.373 +        fields (ref {:pretty-writer true
 107.374 +                     :base (column-writer writer max-columns)
 107.375 +                     :logical-blocks lb 
 107.376 +                     :sections nil
 107.377 +                     :mode :writing
 107.378 +                     :buffer []
 107.379 +                     :buffer-block lb
 107.380 +                     :buffer-level 1
 107.381 +                     :miser-width miser-width
 107.382 +                     :trailing-white-space nil
 107.383 +                     :pos 0})]
 107.384 +    (proxy [Writer IDeref] []
 107.385 +      (deref [] fields)
 107.386 +
 107.387 +      (write 
 107.388 +       ([x]
 107.389 +          ;;     (prlabel write x (getf :mode))
 107.390 +          (condp = (class x)
 107.391 +            String 
 107.392 +            (let [^String s0 (write-initial-lines this x)
 107.393 +                  ^String s (.replaceFirst s0 "\\s+$" "")
 107.394 +                  white-space (.substring s0 (count s))
 107.395 +                  mode (getf :mode)]
 107.396 +              (dosync
 107.397 +               (if (= mode :writing)
 107.398 +                 (do
 107.399 +                   (write-white-space this)
 107.400 +                   (.write (getf :base) s)
 107.401 +                   (setf :trailing-white-space white-space))
 107.402 +                 (let [oldpos (getf :pos)
 107.403 +                       newpos (+ oldpos (count s0))]
 107.404 +                   (setf :pos newpos)
 107.405 +                   (add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
 107.406 +
 107.407 +            Integer
 107.408 +            (write-char this x)
 107.409 +            Long
 107.410 +            (write-char this x))))
 107.411 +
 107.412 +      (flush []
 107.413 +             (if (= (getf :mode) :buffering)
 107.414 +               (dosync 
 107.415 +                (write-tokens this (getf :buffer) true)
 107.416 +                (setf :buffer []))
 107.417 +               (write-white-space this)))
 107.418 +
 107.419 +      (close []
 107.420 +             (.flush this)))))
 107.421 +
 107.422 +
 107.423 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.424 +;;; Methods for pretty-writer
 107.425 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 107.426 +
 107.427 +(defn start-block 
 107.428 +  [^Writer this 
 107.429 +   ^String prefix ^String per-line-prefix ^String suffix]
 107.430 +  (dosync 
 107.431 +   (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0)
 107.432 +                    (ref false) (ref false)
 107.433 +                    prefix per-line-prefix suffix)]
 107.434 +     (setf :logical-blocks lb)
 107.435 +     (if (= (getf :mode) :writing)
 107.436 +       (do
 107.437 +         (write-white-space this)
 107.438 +          (when-let [cb (getf :logical-block-callback)] (cb :start))
 107.439 +          (if prefix 
 107.440 +           (.write (getf :base) prefix))
 107.441 +         (let [col (get-column (getf :base))]
 107.442 +           (ref-set (:start-col lb) col)
 107.443 +           (ref-set (:indent lb) col)))
 107.444 +       (let [oldpos (getf :pos)
 107.445 +             newpos (+ oldpos (if prefix (count prefix) 0))]
 107.446 +         (setf :pos newpos)
 107.447 +         (add-to-buffer this (make-start-block-t lb oldpos newpos)))))))
 107.448 +
 107.449 +(defn end-block [^Writer this]
 107.450 +  (dosync
 107.451 +   (let [lb (getf :logical-blocks)
 107.452 +         ^String suffix (:suffix lb)]
 107.453 +     (if (= (getf :mode) :writing)
 107.454 +       (do
 107.455 +         (write-white-space this)
 107.456 +         (if suffix
 107.457 +           (.write (getf :base) suffix))
 107.458 +         (when-let [cb (getf :logical-block-callback)] (cb :end)))
 107.459 +       (let [oldpos (getf :pos)
 107.460 +             newpos (+ oldpos (if suffix (count suffix) 0))]
 107.461 +         (setf :pos newpos)
 107.462 +         (add-to-buffer this (make-end-block-t lb oldpos newpos))))
 107.463 +     (setf :logical-blocks (:parent lb)))))
 107.464 +
 107.465 +(defn nl [^Writer this type]
 107.466 +  (dosync 
 107.467 +   (setf :mode :buffering)
 107.468 +   (let [pos (getf :pos)]
 107.469 +     (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos)))))
 107.470 +
 107.471 +(defn indent [^Writer this relative-to offset]
 107.472 +  (dosync 
 107.473 +   (let [lb (getf :logical-blocks)]
 107.474 +     (if (= (getf :mode) :writing)
 107.475 +       (do
 107.476 +         (write-white-space this)
 107.477 +         (ref-set (:indent lb) 
 107.478 +                  (+ offset (condp = relative-to
 107.479 +			      :block @(:start-col lb)
 107.480 +			      :current (get-column (getf :base))))))
 107.481 +       (let [pos (getf :pos)]
 107.482 +         (add-to-buffer this (make-indent-t lb relative-to offset pos pos)))))))
 107.483 +
 107.484 +(defn get-miser-width [^Writer this]
 107.485 +  (getf :miser-width))
 107.486 +
 107.487 +(defn set-miser-width [^Writer this new-miser-width]
 107.488 +  (dosync (setf :miser-width new-miser-width)))
 107.489 +
 107.490 +(defn set-logical-block-callback [^Writer this f]
 107.491 +  (dosync (setf :logical-block-callback f)))
   108.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   108.2 +++ b/src/clojure/contrib/pprint/utilities.clj	Sat Aug 21 06:25:44 2010 -0400
   108.3 @@ -0,0 +1,104 @@
   108.4 +;;; utilities.clj -- part of the pretty printer for Clojure
   108.5 +
   108.6 +;; by Tom Faulhaber
   108.7 +;; April 3, 2009
   108.8 +
   108.9 +;   Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved.
  108.10 +;   The use and distribution terms for this software are covered by the
  108.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  108.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  108.13 +;   By using this software in any fashion, you are agreeing to be bound by
  108.14 +;   the terms of this license.
  108.15 +;   You must not remove this notice, or any other, from this software.
  108.16 +
  108.17 +;; This module implements some utility function used in formatting and pretty
  108.18 +;; printing. The functions here could go in a more general purpose library,
  108.19 +;; perhaps.
  108.20 +
  108.21 +(ns clojure.contrib.pprint.utilities)
  108.22 +
  108.23 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  108.24 +;;; Helper functions for digesting formats in the various
  108.25 +;;; phases of their lives.
  108.26 +;;; These functions are actually pretty general.
  108.27 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  108.28 +
  108.29 +(defn map-passing-context [func initial-context lis]
  108.30 +  (loop [context initial-context
  108.31 +         lis lis
  108.32 +         acc []]
  108.33 +    (if (empty? lis)
  108.34 +      [acc context]
  108.35 +    (let [this (first lis)
  108.36 +          remainder (next lis)
  108.37 +          [result new-context] (apply func [this context])]
  108.38 +      (recur new-context remainder (conj acc result))))))
  108.39 +
  108.40 +(defn consume [func initial-context]
  108.41 +  (loop [context initial-context
  108.42 +         acc []]
  108.43 +    (let [[result new-context] (apply func [context])]
  108.44 +      (if (not result)
  108.45 +        [acc new-context]
  108.46 +      (recur new-context (conj acc result))))))
  108.47 +
  108.48 +(defn consume-while [func initial-context]
  108.49 +  (loop [context initial-context
  108.50 +         acc []]
  108.51 +    (let [[result continue new-context] (apply func [context])]
  108.52 +      (if (not continue)
  108.53 +        [acc context]
  108.54 +      (recur new-context (conj acc result))))))
  108.55 +
  108.56 +(defn unzip-map [m]
  108.57 +  "Take a  map that has pairs in the value slots and produce a pair of maps, 
  108.58 +   the first having all the first elements of the pairs and the second all 
  108.59 +   the second elements of the pairs"
  108.60 +  [(into {} (for [[k [v1 v2]] m] [k v1]))
  108.61 +   (into {} (for [[k [v1 v2]] m] [k v2]))])
  108.62 +
  108.63 +(defn tuple-map [m v1]
  108.64 +  "For all the values, v, in the map, replace them with [v v1]"
  108.65 +  (into {} (for [[k v] m] [k [v v1]])))
  108.66 +
  108.67 +(defn rtrim [s c]
  108.68 +  "Trim all instances of c from the end of sequence s"
  108.69 +  (let [len (count s)]
  108.70 +    (if (and (pos? len) (= (nth s (dec (count s))) c))
  108.71 +      (loop [n (dec len)]
  108.72 +        (cond 
  108.73 +         (neg? n) ""
  108.74 +         (not (= (nth s n) c)) (subs s 0 (inc n))
  108.75 +         true (recur (dec n))))
  108.76 +      s)))
  108.77 +
  108.78 +(defn ltrim [s c]
  108.79 +  "Trim all instances of c from the beginning of sequence s"
  108.80 +  (let [len (count s)]
  108.81 +    (if (and (pos? len) (= (nth s 0) c))
  108.82 +      (loop [n 0]
  108.83 +        (if (or (= n len) (not (= (nth s n) c)))
  108.84 +          (subs s n)
  108.85 +          (recur (inc n))))
  108.86 +      s)))
  108.87 +
  108.88 +(defn prefix-count [aseq val]
  108.89 +  "Return the number of times that val occurs at the start of sequence aseq, 
  108.90 +if val is a seq itself, count the number of times any element of val occurs at the
  108.91 +beginning of aseq"
  108.92 +  (let [test (if (coll? val) (set val) #{val})]
  108.93 +    (loop [pos 0]
  108.94 +     (if (or (= pos (count aseq)) (not (test (nth aseq pos))))
  108.95 +       pos
  108.96 +       (recur (inc pos))))))
  108.97 +
  108.98 +(defn prerr [& args]
  108.99 +  "Println to *err*"
 108.100 +  (binding [*out* *err*]
 108.101 +    (apply println args)))
 108.102 +       
 108.103 +(defmacro prlabel [prefix arg & more-args]
 108.104 +  "Print args to *err* in name = value format"
 108.105 +  `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) 
 108.106 +                                                  (cons arg (seq more-args))))))
 108.107 +
   109.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   109.2 +++ b/src/clojure/contrib/probabilities/finite_distributions.clj	Sat Aug 21 06:25:44 2010 -0400
   109.3 @@ -0,0 +1,203 @@
   109.4 +;; Finite probability distributions
   109.5 +
   109.6 +;; by Konrad Hinsen
   109.7 +;; last updated January 8, 2010
   109.8 +
   109.9 +;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved.  The use
  109.10 +;; and distribution terms for this software are covered by the Eclipse
  109.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  109.12 +;; which can be found in the file epl-v10.html at the root of this
  109.13 +;; distribution.  By using this software in any fashion, you are
  109.14 +;; agreeing to be bound by the terms of this license.  You must not
  109.15 +;; remove this notice, or any other, from this software.
  109.16 +
  109.17 +(ns
  109.18 +  ^{:author "Konrad Hinsen"
  109.19 +     :doc "Finite probability distributions
  109.20 +           This library defines a monad for combining finite probability
  109.21 +           distributions."}
  109.22 +  clojure.contrib.probabilities.finite-distributions
  109.23 +  (:use [clojure.contrib.monads
  109.24 +	 :only (defmonad domonad with-monad maybe-t m-lift m-chain)]
  109.25 +	 [clojure.contrib.def :only (defvar)]))
  109.26 +
  109.27 +; The probability distribution monad. It is limited to finite probability
  109.28 +; distributions (e.g. there is a finite number of possible value), which
  109.29 +; are represented as maps from values to probabilities.
  109.30 +
  109.31 +(defmonad dist-m
  109.32 +  "Monad describing computations on fuzzy quantities, represented by a finite
  109.33 +   probability distribution for the possible values. A distribution is
  109.34 +   represented by a map from values to probabilities."
  109.35 +  [m-result (fn m-result-dist [v]
  109.36 +	      {v 1})
  109.37 +   m-bind   (fn m-bind-dist [mv f]
  109.38 +	      (reduce (partial merge-with +)
  109.39 +		      (for [[x p] mv  [y q] (f x)]
  109.40 +			{y (* q p)})))
  109.41 +   ])
  109.42 +
  109.43 +; Applying the monad transformer maybe-t to the basic dist monad results
  109.44 +; in the cond-dist monad that can handle invalid values. The total probability
  109.45 +; for invalid values ends up as the probability of m-zero (which is nil).
  109.46 +; The function normalize takes this probability out of the distribution and
  109.47 +; re-distributes its weight over the valid values.
  109.48 +
  109.49 +(defvar cond-dist-m
  109.50 +  (maybe-t dist-m)
  109.51 +  "Variant of the dist monad that can handle undefined values.")
  109.52 +
  109.53 +; Normalization
  109.54 +
  109.55 +(defn- scale-by
  109.56 +  "Multiply each entry in dist by the scale factor s and remove zero entries."
  109.57 +  [dist s]
  109.58 +  (into {}
  109.59 +	(for [[val p] dist :when (> p 0)]
  109.60 +	  [val (* p s)])))
  109.61 +
  109.62 +(defn normalize-cond [cdist]
  109.63 +  "Normalize a probability distribution resulting from a computation in
  109.64 +   the cond-dist monad by re-distributing the weight of the invalid values
  109.65 +   over the valid ones."
  109.66 +  (let [missing (get cdist nil 0)
  109.67 +	dist    (dissoc cdist nil)]
  109.68 +    (cond (zero? missing) dist
  109.69 +	  (= 1 missing)   {}
  109.70 +	  :else (let [scale  (/ 1 (- 1 missing))]
  109.71 +		  (scale-by dist scale)))))
  109.72 +
  109.73 +(defn normalize
  109.74 +  "Convert a weight map (e.g. a map of counter values) to a distribution
  109.75 +   by multiplying with a normalization factor. If the map has a key
  109.76 +   :total, its value is assumed to be the sum over all the other values and
  109.77 +   it is used for normalization. Otherwise, the sum is calculated
  109.78 +   explicitly. The :total key is removed from the resulting distribution."
  109.79 +  [weights]
  109.80 +  (let [total (:total weights)
  109.81 +	w (dissoc weights :total)
  109.82 +	s (/ 1 (if (nil? total) (reduce + (vals w)) total))]
  109.83 +    (scale-by w s)))
  109.84 +
  109.85 +; Functions that construct distributions
  109.86 +
  109.87 +(defn uniform
  109.88 +  "Return a distribution in which each of the elements of coll
  109.89 +   has the same probability."
  109.90 +  [coll]
  109.91 +  (let [n (count coll)
  109.92 +	p (/ 1 n)]
  109.93 +    (into {} (for [x (seq coll)] [x p]))))
  109.94 +
  109.95 +(defn choose
  109.96 +  "Construct a distribution from an explicit list of probabilities
  109.97 +   and values. They are given in the form of a vector of probability-value
  109.98 +   pairs. In the last pair, the probability can be given by the keyword
  109.99 +   :else, which stands for 1 minus the total of the other probabilities."
 109.100 +  [& choices]
 109.101 +  (letfn [(add-choice [dist [p v]]
 109.102 +	    (cond (nil? p) dist
 109.103 +		  (= p :else)
 109.104 +		        (let [total-p (reduce + (vals dist))]
 109.105 +			  (assoc dist v (- 1 total-p)))
 109.106 +		  :else (assoc dist v p)))]
 109.107 +    (reduce add-choice {} (partition 2 choices))))
 109.108 +
 109.109 +(defn bernoulli
 109.110 +  [p]
 109.111 +  "Returns the Bernoulli distribution for probability p."
 109.112 +  (choose p 1 :else 0))
 109.113 +
 109.114 +(defn- bc
 109.115 +  [n]
 109.116 +  "Returns the binomial coefficients for a given n."
 109.117 +  (let [r (inc n)]
 109.118 +     (loop [c 1
 109.119 +	    f (list 1)]
 109.120 +       (if (> c n)
 109.121 +	 f
 109.122 +	 (recur (inc c) (cons (* (/ (- r c) c) (first f)) f))))))
 109.123 +
 109.124 +(defn binomial
 109.125 +  [n p]
 109.126 +  "Returns the binomial distribution, which is the distribution of the
 109.127 +   number of successes in a series of n experiments whose individual
 109.128 +   success probability is p."
 109.129 +  (let [q (- 1 p)
 109.130 +	n1 (inc n)
 109.131 +	k (range n1)
 109.132 +	pk (take n1 (iterate #(* p %) 1))
 109.133 +	ql (reverse (take n1 (iterate #(* q %) 1)))
 109.134 +	f (bc n)]
 109.135 +    (into {} (map vector k (map * f pk ql)))))
 109.136 +
 109.137 +(defn make-distribution
 109.138 +  "Returns the distribution in which each element x of the collection
 109.139 +   has a probability proportional to (f x)"
 109.140 +  [coll f]
 109.141 +  (normalize (into {} (for [k coll] [k (f k)]))))
 109.142 +
 109.143 +(defn zipf
 109.144 +  "Returns the Zipf distribution in which the numbers k=1..n have
 109.145 +   probabilities proportional to 1/k^s."
 109.146 +  [s n]
 109.147 +  (make-distribution (range 1 (inc n)) #(/ (java.lang.Math/pow % s))))
 109.148 +
 109.149 +(defn certainly
 109.150 +  "Returns a distribution in which the single value v has probability 1."
 109.151 +  [v]
 109.152 +  {v 1})
 109.153 +
 109.154 +(with-monad dist-m
 109.155 +
 109.156 +  (defn join-with
 109.157 +    "Returns the distribution of (f x y) with x from dist1 and y from dist2."
 109.158 +    [f dist1 dist2]
 109.159 +    ((m-lift 2 f) dist1 dist2))
 109.160 +
 109.161 +)
 109.162 +
 109.163 +(with-monad cond-dist-m
 109.164 +  (defn cond-prob
 109.165 +    "Returns the conditional probability for the values in dist that satisfy
 109.166 +     the predicate pred."
 109.167 +    [pred dist]
 109.168 +    (normalize-cond
 109.169 +      (domonad
 109.170 +        [v dist
 109.171 +	 :when (pred v)]
 109.172 +	v))))
 109.173 +
 109.174 +; Select (with equal probability) N items from a sequence
 109.175 +
 109.176 +(defn- nth-and-rest [n xs]
 109.177 +  "Return a list containing the n-th value of xs and the sequence
 109.178 +   obtained by removing the n-th value from xs."
 109.179 +  (let [[h t] (split-at n xs)]
 109.180 +    (list (first t) (concat h (rest t)))))
 109.181 +
 109.182 +(with-monad dist-m
 109.183 +
 109.184 +  (defn- select-n [n xs]
 109.185 +    (letfn [(select-1 [[s xs]]
 109.186 +	      (uniform (for [i (range (count xs))]
 109.187 +			 (let [[nth rest] (nth-and-rest i xs)]
 109.188 +			   (list (cons nth s) rest)))))]
 109.189 +      ((m-chain (replicate n select-1)) (list '() xs))))
 109.190 +
 109.191 +  (defn select [n xs]
 109.192 +    "Return the distribution for all possible ordered selections of n elements
 109.193 +     out of xs."
 109.194 +    ((m-lift 1 first) (select-n n xs)))
 109.195 +
 109.196 +)
 109.197 +
 109.198 +; Find the probability that a given predicate is satisfied
 109.199 +
 109.200 +(defn prob
 109.201 +  "Return the probability that the predicate pred is satisfied in the
 109.202 +   distribution dist, i.e. the sum of the probabilities of the values
 109.203 +   that satisfy pred."
 109.204 +  [pred dist]
 109.205 +  (apply + (for [[x p] dist :when (pred x)] p)))
 109.206 +
   110.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   110.2 +++ b/src/clojure/contrib/probabilities/monte_carlo.clj	Sat Aug 21 06:25:44 2010 -0400
   110.3 @@ -0,0 +1,240 @@
   110.4 +;; Monte-Carlo algorithms
   110.5 +
   110.6 +;; by Konrad Hinsen
   110.7 +;; last updated May 3, 2009
   110.8 +
   110.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
  110.10 +;; and distribution terms for this software are covered by the Eclipse
  110.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  110.12 +;; which can be found in the file epl-v10.html at the root of this
  110.13 +;; distribution.  By using this software in any fashion, you are
  110.14 +;; agreeing to be bound by the terms of this license.  You must not
  110.15 +;; remove this notice, or any other, from this software.
  110.16 +
  110.17 +(ns
  110.18 +  ^{:author "Konrad Hinsen"
  110.19 +     :doc "Monte-Carlo method support
  110.20 +
  110.21 +           Monte-Carlo methods transform an input random number stream
  110.22 +           (usually having a continuous uniform distribution in the
  110.23 +           interval [0, 1)) into a random number stream whose distribution
  110.24 +           satisfies certain conditions (usually the expectation value
  110.25 +           is equal to some desired quantity). They are thus
  110.26 +           transformations from one probability distribution to another one.
  110.27 +
  110.28 +           This library represents a Monte-Carlo method by a function that
  110.29 +           takes as input the state of a random number stream with
  110.30 +           uniform distribution (see
  110.31 +           clojure.contrib.probabilities.random-numbers) and returns a
  110.32 +           vector containing one sample value of the desired output
  110.33 +           distribution and the final state of the input random number
  110.34 +           stream. Such functions are state monad values and can be
  110.35 +           composed using operations defined in clojure.contrib.monads."}
  110.36 +  clojure.contrib.probabilities.monte-carlo
  110.37 +  (:refer-clojure :exclude (deftype))
  110.38 +  (:use [clojure.contrib.macros :only (const)])
  110.39 +  (:use [clojure.contrib.types :only (deftype)])
  110.40 +  (:use [clojure.contrib.stream-utils :only (defstream stream-next)])
  110.41 +  (:use [clojure.contrib.monads
  110.42 +	 :only (with-monad state-m m-lift m-seq m-fmap)])
  110.43 +  (:require [clojure.contrib.generic.arithmetic :as ga])
  110.44 +  (:require [clojure.contrib.accumulators :as acc]))
  110.45 +
  110.46 +;; Random number transformers and random streams
  110.47 +;;
  110.48 +;; A random number transformer is a function that takes a random stream
  110.49 +;; state as input and returns the next value from the transformed stream
  110.50 +;; plus the new state of the input stream. Random number transformers
  110.51 +;; are thus state monad values.
  110.52 +;;
  110.53 +;; Distributions are implemented as random number transformers that
  110.54 +;; transform a uniform distribution in the interval [0, 1) to the
  110.55 +;; desired distribution. Composition of such distributions allows
  110.56 +;; the realization of any kind of Monte-Carlo algorithm. The result
  110.57 +;; of such a composition is always again a distribution.
  110.58 +;;
  110.59 +;; Random streams are defined by a random number transformer and an
  110.60 +;; input random number stream. If the randon number transformer represents
  110.61 +;; a distribution, the input stream must have a uniform distribution
  110.62 +;; in the interval [0, 1).
  110.63 +
  110.64 +; Random stream definition
  110.65 +(deftype ::random-stream random-stream
  110.66 +  "Define a random stream by a distribution and the state of a
  110.67 +   random number stream with uniform distribution in [0, 1)."
  110.68 +  {:arglists '([distribution random-stream-state])}
  110.69 +  (fn [d rs] (list d rs)))
  110.70 +
  110.71 +(defstream ::random-stream
  110.72 +  [[d rs]]
  110.73 +  (let [[r nrs] (d rs)]
  110.74 +    [r (random-stream d nrs)]))
  110.75 +
  110.76 +; Rejection of values is used in the construction of distributions
  110.77 +(defn reject
  110.78 +  "Return the distribution that results from rejecting the values from
  110.79 +   dist that do not satisfy predicate p."
  110.80 +  [p dist]
  110.81 +  (fn [rs]
  110.82 +    (let [[r nrs] (dist rs)]
  110.83 +      (if (p r)
  110.84 +	(recur nrs)
  110.85 +	[r nrs]))))
  110.86 +
  110.87 +; Draw a value from a discrete distribution given as a map from
  110.88 +; values to probabilities.
  110.89 +; (see clojure.contrib.probabilities.finite-distributions)
  110.90 +(with-monad state-m
  110.91 +  (defn discrete
  110.92 +    "A discrete distribution, defined by a map dist mapping values
  110.93 +     to probabilities. The sum of probabilities must be one."
  110.94 +    [dist]
  110.95 +    (letfn [(pick-at-level [l dist-items]
  110.96 +	      (let [[[x p] & rest-dist] dist-items]
  110.97 +		(if (> p l)
  110.98 +		  x
  110.99 +		  (recur (- l p) rest-dist))))]
 110.100 +      (m-fmap #(pick-at-level % (seq dist)) stream-next))))
 110.101 +
 110.102 +; Uniform distribution in an finite half-open interval
 110.103 +(with-monad state-m
 110.104 +  (defn interval
 110.105 +    [a b]
 110.106 +    "Transform a sequence of uniform random numbers in the interval [0, 1)
 110.107 +     into a sequence of uniform random numbers in the interval [a, b)."
 110.108 +    (let [d (- b a)
 110.109 +	  f (if (zero? a)
 110.110 +	      (if (= d 1)
 110.111 +		identity
 110.112 +		(fn [r] (* d r)))
 110.113 +	      (if (= d 1)
 110.114 +		(fn [r] (+ a r))
 110.115 +		(fn [r] (+ a (* d r)))))]
 110.116 +      (m-fmap f stream-next))))
 110.117 +
 110.118 +; Normal (Gaussian) distribution
 110.119 +(defn normal
 110.120 +  "Transform a sequence urs of uniform random number in the interval [0, 1)
 110.121 +   into a sequence of normal random numbers with mean mu and standard
 110.122 +   deviation sigma."
 110.123 +  [mu sigma]
 110.124 +  ; This function implements the Kinderman-Monahan ratio method:
 110.125 +  ;  A.J. Kinderman & J.F. Monahan
 110.126 +  ;  Computer Generation of Random Variables Using the Ratio of Uniform Deviates
 110.127 +  ;  ACM Transactions on Mathematical Software 3(3) 257-260, 1977
 110.128 +  (fn [rs]
 110.129 +    (let [[u1  rs] (stream-next rs)
 110.130 +	  [u2* rs] (stream-next rs)
 110.131 +	  u2 (- 1. u2*)
 110.132 +	  s (const (* 4 (/ (. Math exp (- 0.5)) (. Math sqrt 2.))))
 110.133 +	  z (* s (/ (- u1 0.5) u2))
 110.134 +	  zz (+ (* 0.25 z z) (. Math log u2))]
 110.135 +      (if (> zz 0)
 110.136 +	(recur rs)
 110.137 +	[(+ mu (* sigma z)) rs]))))
 110.138 +
 110.139 +; Lognormal distribution
 110.140 +(with-monad state-m
 110.141 +  (defn lognormal
 110.142 +    "Transform a sequence of uniform random numbesr in the interval [0, 1)
 110.143 +     into a sequence of lognormal random numbers with mean mu and standard
 110.144 +     deviation sigma."
 110.145 +    [mu sigma]
 110.146 +    (m-fmap #(. Math exp %) (normal mu sigma))))
 110.147 +
 110.148 +; Exponential distribution
 110.149 +(with-monad state-m
 110.150 +  (defn exponential
 110.151 +    "Transform a sequence of uniform random numbers in the interval [0, 1)
 110.152 +     into a sequence of exponential random numbers with parameter lambda."
 110.153 +    [lambda]
 110.154 +    (when (<= lambda 0)
 110.155 +      (throw (IllegalArgumentException.
 110.156 +  	    "exponential distribution requires a positive argument")))
 110.157 +    (let [neg-inv-lambda (- (/ lambda))
 110.158 +	  ; remove very small numbers to prevent log from returning -Infinity
 110.159 +	  not-too-small  (reject #(< % 1e-323) stream-next)]
 110.160 +      (m-fmap #(* (. Math log %) neg-inv-lambda) not-too-small))))
 110.161 +
 110.162 +; Another implementation of the normal distribution. It uses the
 110.163 +; Box-Muller transform, but discards one of the two result values
 110.164 +; at each cycle because the random number transformer interface cannot
 110.165 +; handle two outputs at the same time.
 110.166 +(defn normal-box-muller
 110.167 +  "Transform a sequence of uniform random numbers in the interval [0, 1)
 110.168 +   into a sequence of normal random numbers with mean mu and standard
 110.169 +   deviation sigma."
 110.170 +  [mu sigma]
 110.171 +  (fn [rs]
 110.172 +    (let [[u1 rs] (stream-next rs)
 110.173 +	  [u2 rs] (stream-next rs)
 110.174 +	   v1 (- (* 2.0 u1) 1.0)
 110.175 +	   v2 (- (* 2.0 u2) 1.0)
 110.176 +	   s  (+ (* v1 v1) (* v2 v2))
 110.177 +	   ls (. Math sqrt (/ (* -2.0 (. Math log s)) s))
 110.178 +	   x1 (* v1 ls)
 110.179 +	   x2 (* v2 ls)]
 110.180 +	  (if (or (>= s 1) (= s 0))
 110.181 +	    (recur rs)
 110.182 +	    [x1 rs]))))
 110.183 +
 110.184 +; Finite samples from a distribution
 110.185 +(with-monad state-m
 110.186 +
 110.187 +    (defn sample
 110.188 +      "Return the distribution of samples of length n from the
 110.189 +       distribution dist"
 110.190 +      [n dist]
 110.191 +      (m-seq (replicate n dist)))
 110.192 +
 110.193 +    (defn sample-reduce
 110.194 +      "Returns the distribution of the reduction of f over n samples from the
 110.195 +       distribution dist."
 110.196 +      ([f n dist]
 110.197 +	 (if (zero? n)
 110.198 +	   (m-result (f))
 110.199 +	   (let [m-f    (m-lift 2 f)
 110.200 +		 sample (replicate n dist)]
 110.201 +	     (reduce m-f sample))))
 110.202 +      ([f val n dist]
 110.203 +	 (let [m-f    (m-lift 2 f)
 110.204 +	       m-val  (m-result val)
 110.205 +	       sample (replicate n dist)]
 110.206 +	   (reduce m-f m-val sample))))
 110.207 +
 110.208 +    (defn sample-sum
 110.209 +      "Return the distribution of the sum over n samples from the
 110.210 +       distribution dist."
 110.211 +      [n dist]
 110.212 +      (sample-reduce ga/+ n dist))
 110.213 +
 110.214 +    (defn sample-mean
 110.215 +      "Return the distribution of the mean over n samples from the
 110.216 +       distribution dist"
 110.217 +      [n dist]
 110.218 +      (let [div-by-n (m-lift 1 #(ga/* % (/ n)))]
 110.219 +	(div-by-n (sample-sum n dist))))
 110.220 +
 110.221 +    (defn sample-mean-variance
 110.222 +      "Return the distribution of the mean-and-variance (a vector containing
 110.223 +       the mean and the variance) over n samples from the distribution dist"
 110.224 +      [n dist]
 110.225 +      (let [extract (m-lift 1 (fn [mv] [(:mean mv) (:variance mv)]))]
 110.226 +	(extract (sample-reduce acc/add acc/empty-mean-variance n dist))))
 110.227 +
 110.228 +)
 110.229 +
 110.230 +; Uniform distribution inside an n-sphere
 110.231 +(with-monad state-m
 110.232 +  (defn n-sphere
 110.233 +    "Return a uniform distribution of n-dimensional vectors inside an
 110.234 +     n-sphere of radius r."
 110.235 +    [n r]
 110.236 +    (let [box-dist    (sample n (interval (- r) r))
 110.237 +	  sq          #(* % %)
 110.238 +	  r-sq        (sq r)
 110.239 +	  vec-sq      #(apply + (map sq %))
 110.240 +	  sphere-dist (reject #(> (vec-sq %) r-sq) box-dist)
 110.241 +	  as-vectors  (m-lift 1 vec)]
 110.242 +      (as-vectors sphere-dist))))
 110.243 +
   111.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   111.2 +++ b/src/clojure/contrib/probabilities/random_numbers.clj	Sat Aug 21 06:25:44 2010 -0400
   111.3 @@ -0,0 +1,63 @@
   111.4 +;; Random number generators
   111.5 +
   111.6 +;; by Konrad Hinsen
   111.7 +;; last updated May 3, 2009
   111.8 +
   111.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
  111.10 +;; and distribution terms for this software are covered by the Eclipse
  111.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  111.12 +;; which can be found in the file epl-v10.html at the root of this
  111.13 +;; distribution.  By using this software in any fashion, you are
  111.14 +;; agreeing to be bound by the terms of this license.  You must not
  111.15 +;; remove this notice, or any other, from this software.
  111.16 +
  111.17 +(ns
  111.18 +  ^{:author "Konrad Hinsen"
  111.19 +     :doc "Random number streams
  111.20 +
  111.21 +           This library provides random number generators with a common
  111.22 +           stream interface. They all produce pseudo-random numbers that are
  111.23 +           uniformly distributed in the interval [0, 1), i.e. 0 is a
  111.24 +           possible value but 1 isn't. For transformations to other
  111.25 +           distributions, see clojure.contrib.probabilities.monte-carlo.
  111.26 +
  111.27 +           At the moment, the only generator provided is a rather simple
  111.28 +           linear congruential generator."}
  111.29 +  clojure.contrib.probabilities.random-numbers
  111.30 +  (:refer-clojure :exclude (deftype))
  111.31 +  (:use [clojure.contrib.types :only (deftype)])
  111.32 +  (:use [clojure.contrib.stream-utils :only (defstream)])
  111.33 +  (:use [clojure.contrib.def :only (defvar)]))
  111.34 +
  111.35 +;; Linear congruential generator
  111.36 +;; http://en.wikipedia.org/wiki/Linear_congruential_generator
  111.37 +
  111.38 +(deftype ::lcg lcg
  111.39 +  "Create a linear congruential generator"
  111.40 +  {:arglists '([modulus multiplier increment seed])}
  111.41 +  (fn [modulus multiplier increment seed]
  111.42 +    {:m modulus :a multiplier :c increment :seed seed})
  111.43 +  (fn [s] (map s (list :m :a :c :seed))))
  111.44 +
  111.45 +(defstream ::lcg
  111.46 +  [lcg-state]
  111.47 +  (let [{m :m a :a c :c seed :seed} lcg-state
  111.48 +	value (/ (float seed) (float m))
  111.49 +	new-seed (rem (+ c (* a seed)) m)]
  111.50 +    [value (assoc lcg-state :seed new-seed)]))
  111.51 +
  111.52 +;; A generator based on Clojure's built-in rand function
  111.53 +;; (and thus random from java.lang.Math)
  111.54 +;; Note that this generator uses an internal mutable state.
  111.55 +;;
  111.56 +;; The state is *not* stored in the stream object and can thus
  111.57 +;; *not* be restored!
  111.58 +
  111.59 +(defvar rand-stream (with-meta 'rand {:type ::rand-stream})
  111.60 +  "A random number stream based on clojure.core/rand. Note that this
  111.61 +   generator uses an internal mutable state. The state is thus not stored
  111.62 +   in the stream object and cannot be restored.")
  111.63 +
  111.64 +(defstream ::rand-stream
  111.65 +  [dummy-state]
  111.66 +  [(rand) dummy-state])
   112.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   112.2 +++ b/src/clojure/contrib/profile.clj	Sat Aug 21 06:25:44 2010 -0400
   112.3 @@ -0,0 +1,110 @@
   112.4 +;;; profile.clj: simple code profiling & timing
   112.5 +
   112.6 +;; by Stuart Sierra, http://stuartsierra.com/
   112.7 +;; May 9, 2009
   112.8 +
   112.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
  112.10 +;; and distribution terms for this software are covered by the Eclipse
  112.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  112.12 +;; which can be found in the file epl-v10.html at the root of this
  112.13 +;; distribution.  By using this software in any fashion, you are
  112.14 +;; agreeing to be bound by the terms of this license.  You must not
  112.15 +;; remove this notice, or any other, from this software.
  112.16 +
  112.17 +
  112.18 +(ns ^{:author "Stuart Sierra"
  112.19 +       :doc "Simple code profiling & timing measurement.
  112.20 +
  112.21 +Wrap any section of code in the prof macro, giving it a name, like this:
  112.22 +
  112.23 +       (defn my-function [x y]
  112.24 +         (let [sum (prof :addition (+ x y))
  112.25 +               product (prof :multiplication (* x y))]
  112.26 +           [sum product]))
  112.27 +
  112.28 +The run your code in the profile macro, like this:
  112.29 +
  112.30 +       (profile (dotimes [i 10000] (my-function 3 4)))
  112.31 +
  112.32 +Which prints a report for each named section of code:
  112.33 +
  112.34 +          Name      mean       min       max     count       sum
  112.35 +      addition       265         0     37000     10000   2655000
  112.36 +multiplication       274         0     53000     10000   2747000
  112.37 +
  112.38 +Times are measured in nanoseconds, to the maximum precision available
  112.39 +under the JVM.  See the function documentation for more details.
  112.40 +"}
  112.41 +  clojure.contrib.profile)
  112.42 +
  112.43 +(def *profile-data* nil)
  112.44 +
  112.45 +(def ^{:doc "Set this to false before loading/compiling to omit
  112.46 +profiling code."}  *enable-profiling* true)
  112.47 +
  112.48 +(defmacro prof
  112.49 +  "If *enable-profiling* is true, wraps body in profiling code.
  112.50 +  Returns the result of body. Profile timings will be stored in
  112.51 +  *profile-data* using name, which must be a keyword, as the key.
  112.52 +  Timings are measured with System/nanoTime."
  112.53 +  [name & body]
  112.54 +  (assert (keyword? name))
  112.55 +  (if *enable-profiling*
  112.56 +    `(if *profile-data*
  112.57 +       (let [start-time# (System/nanoTime)
  112.58 +             value# (do ~@body)
  112.59 +             elapsed# (- (System/nanoTime) start-time#)]
  112.60 +         (swap! *profile-data* assoc ~name
  112.61 +                (conj (get @*profile-data* ~name) elapsed#))
  112.62 +         value#)
  112.63 +       ~@body)
  112.64 +    `(do ~@body)))
  112.65 +
  112.66 +(defmacro with-profile-data
  112.67 +  "Executes body with *profile-data* bound to an atom of a new map.
  112.68 +  Returns the raw profile data as a map.  Keys in the map are profile
  112.69 +  names (keywords), and values are lists of elapsed time, in
  112.70 +  nanoseconds."
  112.71 +  [& body]
  112.72 +  `(binding [*profile-data* (atom {})]
  112.73 +     ~@body
  112.74 +     @*profile-data*))
  112.75 +
  112.76 +(defn summarize
  112.77 +  "Takes the raw data returned by with-profile-data and returns a map
  112.78 +  from names to summary statistics.  Each value in the map will look
  112.79 +  like:
  112.80 +
  112.81 +     {:mean ..., :min ..., :max ..., :count ..., :sum ...}
  112.82 +
  112.83 +  :mean, :min, and :max are how long the profiled section took to run,
  112.84 +  in nanoseconds.  :count is the total number of times the profiled
  112.85 +  section was executed.  :sum is the total amount of time spent in the
  112.86 +  profiled section, in nanoseconds."
  112.87 +  [profile-data]
  112.88 +  (reduce (fn [m [k v]]
  112.89 +            (let [cnt (count v)
  112.90 +                  sum (reduce + v)]
  112.91 +              (assoc m k {:mean (int (/ sum cnt))
  112.92 +                          :min (apply min v)
  112.93 +                          :max (apply max v)
  112.94 +                          :count cnt
  112.95 +                          :sum sum})))
  112.96 +          {} profile-data))
  112.97 +
  112.98 +(defn print-summary
  112.99 +  "Prints a table of the results returned by summarize."
 112.100 +  [profile-summary]
 112.101 +  (let [name-width (apply max 1 (map (comp count name) (keys profile-summary)))
 112.102 +        fmt-string (str "%" name-width "s  %8d  %8d  %8d  %8d  %8d%n")]
 112.103 +    (printf (.replace fmt-string \d \s)
 112.104 +            "Name" "mean" "min" "max" "count" "sum")
 112.105 +    (doseq [k (sort (keys profile-summary))]
 112.106 +      (let [v (get profile-summary k)]
 112.107 +        (printf fmt-string (name k) (:mean v) (:min v) (:max v) (:count v) (:sum v))))))
 112.108 +
 112.109 +(defmacro profile
 112.110 +  "Runs body with profiling enabled, then prints a summary of
 112.111 +  results.  Returns nil."
 112.112 +  [& body]
 112.113 +  `(print-summary (summarize (with-profile-data (do ~@body)))))
   113.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   113.2 +++ b/src/clojure/contrib/properties.clj	Sat Aug 21 06:25:44 2010 -0400
   113.3 @@ -0,0 +1,77 @@
   113.4 +;   Copyright (c) Stuart Halloway & Contributors, April 2009. All rights reserved.
   113.5 +;   The use and distribution terms for this software are covered by the
   113.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   113.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   113.8 +;   By using this software in any fashion, you are agreeing to be bound by
   113.9 +;   the terms of this license.
  113.10 +;   You must not remove this notice, or any other, from this software.
  113.11 +
  113.12 +;; DEPRECATED in 1.2.  Moved to c.c.java-utils
  113.13 +
  113.14 +(ns ^{:deprecated "1.2"}
  113.15 +  clojure.contrib.properties
  113.16 +  (:use [clojure.contrib.string :only (as-str)]
  113.17 +        [clojure.contrib.io :only (file)])
  113.18 +  (:import (java.util Properties)
  113.19 +           (java.io FileInputStream FileOutputStream)))
  113.20 +
  113.21 +(defn get-system-property 
  113.22 +  "Get a system property."
  113.23 +  ([stringable]
  113.24 +   (System/getProperty (as-str stringable)))
  113.25 +  ([stringable default]
  113.26 +   (System/getProperty (as-str stringable) default)))
  113.27 +
  113.28 +(defn set-system-properties
  113.29 +  "Set some system properties. Nil clears a property."
  113.30 +  [settings]
  113.31 +  (doseq [[name val] settings]
  113.32 +    (if val
  113.33 +      (System/setProperty (as-str name) (as-str val))
  113.34 +      (System/clearProperty (as-str name)))))
  113.35 +
  113.36 +(defmacro with-system-properties
  113.37 +  "setting => property-name value
  113.38 +
  113.39 +  Sets the system properties to the supplied values, executes the body, and
  113.40 +  sets the properties back to their original values. Values of nil are
  113.41 +  translated to a clearing of the property."
  113.42 +  [settings & body]
  113.43 +  `(let [settings# ~settings
  113.44 +         current# (reduce (fn [coll# k#]
  113.45 +			    (assoc coll# k# (get-system-property k#)))
  113.46 +			  {}
  113.47 +			  (keys settings#))]
  113.48 +     (set-system-properties settings#)       
  113.49 +     (try
  113.50 +      ~@body
  113.51 +      (finally
  113.52 +       (set-system-properties current#)))))
  113.53 +
  113.54 +
  113.55 +; Not there is no corresponding props->map. Just destructure!
  113.56 +(defn ^Properties as-properties
  113.57 +  "Convert any seq of pairs to a java.utils.Properties instance.
  113.58 +   Uses as-str to convert both keys and values into strings."
  113.59 +  {:tag Properties}
  113.60 +  [m]
  113.61 +  (let [p (Properties.)]
  113.62 +    (doseq [[k v] m]
  113.63 +      (.setProperty p (as-str k) (as-str v)))
  113.64 +    p))
  113.65 +
  113.66 +(defn read-properties
  113.67 +  "Read properties from file-able."
  113.68 +  [file-able]
  113.69 +  (with-open [f (java.io.FileInputStream. (file file-able))]
  113.70 +    (doto (Properties.)
  113.71 +      (.load f))))
  113.72 +
  113.73 +(defn write-properties
  113.74 +  "Write properties to file-able."
  113.75 +  {:tag Properties}
  113.76 +  ([m file-able] (write-properties m file-able nil))
  113.77 +  ([m file-able comments]
  113.78 +    (with-open [^FileOutputStream f (FileOutputStream. (file file-able))]
  113.79 +      (doto (as-properties m)
  113.80 +        (.store f ^String comments)))))
   114.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   114.2 +++ b/src/clojure/contrib/prxml.clj	Sat Aug 21 06:25:44 2010 -0400
   114.3 @@ -0,0 +1,170 @@
   114.4 +;;; prxml.clj -- compact syntax for generating XML
   114.5 +
   114.6 +;; by Stuart Sierra, http://stuartsierra.com/
   114.7 +;; March 29, 2009
   114.8 +
   114.9 +;; Copyright (c) 2009 Stuart Sierra. All rights reserved.  The use and
  114.10 +;; distribution terms for this software are covered by the Eclipse
  114.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  114.12 +;; which can be found in the file epl-v10.html at the root of this
  114.13 +;; distribution.  By using this software in any fashion, you are
  114.14 +;; agreeing to be bound by the terms of this license.  You must not
  114.15 +;; remove this notice, or any other, from this software.
  114.16 +
  114.17 +
  114.18 +;; Change Log
  114.19 +;;
  114.20 +;; March 29, 2009: added *prxml-indent*
  114.21 +;;
  114.22 +;; January 4, 2009: initial version
  114.23 +
  114.24 +
  114.25 +;; See function "prxml" at the bottom of this file for documentation.
  114.26 +
  114.27 +
  114.28 +(ns 
  114.29 +  ^{:author "Stuart Sierra",
  114.30 +     :doc "Compact syntax for generating XML. See the documentation of \"prxml\" 
  114.31 +for details."}
  114.32 +  clojure.contrib.prxml
  114.33 +  (:use [clojure.contrib.string :only (escape as-str)]))
  114.34 +
  114.35 +(def
  114.36 + ^{:doc "If true, empty tags will have a space before the closing />"}
  114.37 + *html-compatible* false)
  114.38 +
  114.39 +(def
  114.40 + ^{:doc "The number of spaces to indent sub-tags.  nil for no indent
  114.41 +  and no extra line-breaks."}
  114.42 + *prxml-indent* nil)
  114.43 +
  114.44 +(def ^{:private true} *prxml-tag-depth* 0)
  114.45 +
  114.46 +(def ^{:private true} print-xml)  ; forward declaration
  114.47 +
  114.48 +(defn- escape-xml [s]
  114.49 +  (escape {\< "&lt;"
  114.50 +           \> "&gt;"
  114.51 +           \& "&amp;"
  114.52 +           \' "&apos;"
  114.53 +           \" "&quot;"} s))
  114.54 +
  114.55 +(defn- prxml-attribute [name value]
  114.56 +  (print " ")
  114.57 +  (print (as-str name))
  114.58 +  (print "=\"")
  114.59 +  (print (escape-xml (str value)))
  114.60 +  (print "\""))
  114.61 +
  114.62 +(defmulti ^{:private true} print-xml-tag (fn [tag attrs content] tag))
  114.63 +
  114.64 +(defmethod print-xml-tag :raw! [tag attrs contents]
  114.65 +  (doseq [c contents] (print c)))
  114.66 +
  114.67 +(defmethod print-xml-tag :comment! [tag attrs contents]
  114.68 +  (print "<!-- ")
  114.69 +  (doseq [c contents] (print c))
  114.70 +  (print " -->"))
  114.71 +
  114.72 +(defmethod print-xml-tag :decl! [tag attrs contents]
  114.73 +  (let [attrs (merge {:version "1.0" :encoding "UTF-8"}
  114.74 +                     attrs)]
  114.75 +    ;; Must enforce ordering of pseudo-attributes:
  114.76 +    (print "<?xml version=\"")
  114.77 +    (print (:version attrs))
  114.78 +    (print "\" encoding=\"")
  114.79 +    (print (:encoding attrs))
  114.80 +    (print "\"")
  114.81 +    (when (:standalone attrs)
  114.82 +      (print " standalone=\"")
  114.83 +      (print (:standalone attrs))
  114.84 +      (print "\""))
  114.85 +    (print "?>")))
  114.86 +
  114.87 +(defmethod print-xml-tag :cdata! [tag attrs contents]
  114.88 +  (print "<![CDATA[")
  114.89 +  (doseq [c contents] (print c))
  114.90 +  (print "]]>"))
  114.91 +
  114.92 +(defmethod print-xml-tag :doctype! [tag attrs contents]
  114.93 +  (print "<!DOCTYPE ")
  114.94 +  (doseq [c contents] (print c))
  114.95 +  (print ">"))
  114.96 +
  114.97 +(defmethod print-xml-tag :default [tag attrs contents]
  114.98 +  (let [tag-name (as-str tag)]
  114.99 +    (when *prxml-indent*
 114.100 +      (newline)
 114.101 +      (dotimes [n (* *prxml-tag-depth* *prxml-indent*)] (print " ")))
 114.102 +    (print "<")
 114.103 +    (print tag-name)
 114.104 +    (doseq [[name value] attrs]
 114.105 +      (prxml-attribute name value))
 114.106 +    (if (seq contents)
 114.107 +      (do  ;; not an empty tag
 114.108 +        (print ">")
 114.109 +        (if (every? string? contents)
 114.110 +          ;; tag only contains strings:
 114.111 +          (do (doseq [c contents] (print-xml c))
 114.112 +              (print "</") (print tag-name) (print ">"))
 114.113 +          ;; tag contains sub-tags:
 114.114 +          (do (binding [*prxml-tag-depth* (inc *prxml-tag-depth*)]
 114.115 +                (doseq [c contents] (print-xml c)))
 114.116 +              (when *prxml-indent*
 114.117 +                (newline)
 114.118 +                (dotimes [n (* *prxml-tag-depth* *prxml-indent*)] (print " ")))
 114.119 +              (print "</") (print tag-name) (print ">"))))
 114.120 +      ;; empty tag:
 114.121 +      (print (if *html-compatible* " />" "/>")))))
 114.122 +
 114.123 +
 114.124 +(defmulti ^{:private true} print-xml class)
 114.125 +
 114.126 +(defmethod print-xml clojure.lang.IPersistentVector [x]
 114.127 +  (let [[tag & contents] x
 114.128 +        [attrs content] (if (map? (first contents))
 114.129 +                          [(first contents) (rest contents)]
 114.130 +                          [{} contents])]
 114.131 +    (print-xml-tag tag attrs content)))
 114.132 +
 114.133 +(defmethod print-xml clojure.lang.ISeq [x]
 114.134 +  ;; Recurse into sequences, so we can use (map ...) inside prxml.
 114.135 +  (doseq [c x] (print-xml c)))
 114.136 +
 114.137 +(defmethod print-xml clojure.lang.Keyword [x]
 114.138 +  (print-xml-tag x {} nil))
 114.139 +
 114.140 +(defmethod print-xml String [x]
 114.141 +  (print (escape-xml x)))
 114.142 +
 114.143 +(defmethod print-xml nil [x])
 114.144 +
 114.145 +(defmethod print-xml :default [x]
 114.146 +  (print x))
 114.147 +
 114.148 +
 114.149 +(defn prxml
 114.150 +  "Print XML to *out*.  Vectors become XML tags: the first item is the
 114.151 +  tag name; optional second item is a map of attributes.
 114.152 +
 114.153 +  Sequences are processed recursively, so you can use map and other
 114.154 +  sequence functions inside prxml.
 114.155 +
 114.156 +    (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]])
 114.157 +    ; => <p class=\"greet\"><i>Ladies &amp; gentlemen</i></p>
 114.158 +
 114.159 +  PSEUDO-TAGS: some keywords have special meaning:
 114.160 +
 114.161 +    :raw!      do not XML-escape contents
 114.162 +    :comment!  create an XML comment
 114.163 +    :decl!     create an XML declaration, with attributes
 114.164 +    :cdata!    create a CDATA section
 114.165 +    :doctype!  create a DOCTYPE!
 114.166 +
 114.167 +    (prxml [:p [:raw! \"<i>here & gone</i>\"]])
 114.168 +    ; => <p><i>here & gone</i></p>
 114.169 +
 114.170 +    (prxml [:decl! {:version \"1.1\"}])
 114.171 +    ; => <?xml version=\"1.1\" encoding=\"UTF-8\"?>"
 114.172 +  [& args]
 114.173 +  (doseq [arg args] (print-xml arg)))
   115.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   115.2 +++ b/src/clojure/contrib/reflect.clj	Sat Aug 21 06:25:44 2010 -0400
   115.3 @@ -0,0 +1,33 @@
   115.4 +;   Copyright (c) 2010 Stuart Halloway & Contributors. All rights
   115.5 +;   reserved.  The use and distribution terms for this software are
   115.6 +;   covered by the Eclipse Public License 1.0
   115.7 +;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
   115.8 +;   found in the file epl-v10.html at the root of this distribution.
   115.9 +;   By using this software in any fashion, you are agreeing to be
  115.10 +;   bound by the terms of this license.  You must not remove this
  115.11 +;   notice, or any other, from this software.
  115.12 +
  115.13 +(ns clojure.contrib.reflect)
  115.14 +
  115.15 +(defn call-method
  115.16 +  "Calls a private or protected method.
  115.17 +
  115.18 +   params is a vector of classes which correspond to the arguments to
  115.19 +   the method e
  115.20 +
  115.21 +   obj is nil for static methods, the instance object otherwise.
  115.22 +
  115.23 +   The method-name is given a symbol or a keyword (something Named)."
  115.24 +  [klass method-name params obj & args]
  115.25 +  (-> klass (.getDeclaredMethod (name method-name)
  115.26 +                                (into-array Class params))
  115.27 +      (doto (.setAccessible true))
  115.28 +      (.invoke obj (into-array Object args))))
  115.29 +
  115.30 +(defn get-field
  115.31 +  "Access to private or protected field.  field-name is a symbol or
  115.32 +  keyword."
  115.33 +  [klass field-name obj]
  115.34 +  (-> klass (.getDeclaredField (name field-name))
  115.35 +      (doto (.setAccessible true))
  115.36 +      (.get obj)))
   116.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   116.2 +++ b/src/clojure/contrib/repl_ln.clj	Sat Aug 21 06:25:44 2010 -0400
   116.3 @@ -0,0 +1,274 @@
   116.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   116.5 +;;  distribution terms for this software are covered by the Eclipse Public
   116.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   116.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   116.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   116.9 +;;  terms of this license.  You must not remove this notice, or any other,
  116.10 +;;  from this software.
  116.11 +;;
  116.12 +;;  A repl with that provides support for lines and line numbers in the
  116.13 +;;  input stream.
  116.14 +;;
  116.15 +;;  scgilardi (gmail)
  116.16 +;;  Created 28 November 2008
  116.17 +
  116.18 +(ns 
  116.19 +  ^{:author "Stephen C. Gilardi",
  116.20 +     :doc "A repl with that provides support for lines and line numbers in the
  116.21 +           input stream."}
  116.22 +  clojure.contrib.repl-ln
  116.23 +  (:gen-class)
  116.24 +  (:import (clojure.lang Compiler LineNumberingPushbackReader RT Var)
  116.25 +           (java.io InputStreamReader OutputStreamWriter PrintWriter)
  116.26 +           java.util.Date)
  116.27 +  (:require clojure.main)
  116.28 +  (:use [clojure.contrib.def
  116.29 +         :only (defmacro- defonce- defstruct- defvar-)]))
  116.30 +
  116.31 +;; Private
  116.32 +
  116.33 +(declare repl)
  116.34 +
  116.35 +(defstruct- repl-info
  116.36 +  :name :started :name-fmt :prompt-fmt :serial :thread :depth)
  116.37 +
  116.38 +(defvar- +name-formats+
  116.39 +  {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d"}
  116.40 +  "For set-name, maps our dynamic value codes to arg positions in
  116.41 +  the call to format in repl-name")
  116.42 +
  116.43 +(defvar- +prompt-formats+
  116.44 +  {"%S" "%1$d" "%T" "%2$d" "%D" "%3$d" "%L" "%4$d" "%N" "%5$s"}
  116.45 +  "For set-prompt, maps our dynamic value codes to arg positions in
  116.46 +  the call to format in repl-prompt")
  116.47 +
  116.48 +(defvar- +info-format+
  116.49 +  ["Name:       %s"
  116.50 +   "Started:    %s"
  116.51 +   "Name-fmt:   \"%s\""
  116.52 +   "Prompt-fmt: \"%s\""
  116.53 +   "Serial:     %d"
  116.54 +   "Thread:     %d"
  116.55 +   "Depth:      %d"
  116.56 +   "Line:       %d"])
  116.57 +
  116.58 +(defvar- +info-defaults+
  116.59 +  (struct-map repl-info
  116.60 +    :name-fmt   "repl-%S"
  116.61 +    :prompt-fmt "%S:%L %N=> "
  116.62 +    :depth      0)
  116.63 +  "Default/root values for repl info")
  116.64 +
  116.65 +(defonce- *serial-number* (atom 0)
  116.66 +  "Serial number counter")
  116.67 +
  116.68 +(defonce- *info* +info-defaults+
  116.69 +  "Public info for this repl")
  116.70 +
  116.71 +(defonce- *private* {}
  116.72 +  "Private info for this repl")
  116.73 +
  116.74 +(defmacro- update
  116.75 +  "Replaces the map thread-locally bound to map-var with a copy that
  116.76 +  includes updated and/or new values from keys and vals."
  116.77 +  [map-var & key-vals]
  116.78 +  `(set! ~map-var (assoc ~map-var ~@key-vals)))
  116.79 +
  116.80 +(defn- repl-name
  116.81 +  "Returns the repl name based on this repl's name-fmt"
  116.82 +  []
  116.83 +  (let [{:keys [name-fmt]} *private*
  116.84 +        {:keys [serial thread depth]} *info*]
  116.85 +    (format name-fmt serial thread depth)))
  116.86 +
  116.87 +(defn- prompt-hook
  116.88 +  []
  116.89 +  (let [prompt (*private* :prompt)]
  116.90 +    (var-set Compiler/LINE (.getLineNumber *in*))
  116.91 +    (prompt)))
  116.92 +
  116.93 +(defn- process-inits
  116.94 +  "Processes initial pairs of args of the form:
  116.95 +
  116.96 +    -i     filepath, or
  116.97 +    --init filepath
  116.98 +
  116.99 +  by loading the referenced files, then accepts an optional terminating arg
 116.100 +  of the form:
 116.101 +
 116.102 +    -r, or
 116.103 +    --repl
 116.104 +
 116.105 +  Returns a seq of any remaining args."
 116.106 +  [args]
 116.107 +  (loop [[init filename & more :as args] args]
 116.108 +    (if (#{"-i" "--init"} init)
 116.109 +      (do
 116.110 +        (clojure.main/load-script filename)
 116.111 +        (recur more))
 116.112 +      (if (#{"-r" "--repl"} init)
 116.113 +        (rest args)
 116.114 +        args))))
 116.115 +
 116.116 +(defn- process-command-line
 116.117 +  "Args are strings passed in from the command line. Loads any requested
 116.118 +  init files and binds *command-line-args* to a seq of the remaining args"
 116.119 +  [args]
 116.120 +  (set! *command-line-args* (process-inits args)))
 116.121 +
 116.122 +(defn stream-repl
 116.123 +  "Repl entry point that provides convenient overriding of input, output,
 116.124 +  and err streams via sequential keyword-value pairs. Default values
 116.125 +  for :in, :out, and :err are streams associated with System/in,
 116.126 +  System/out, and System/err using UTF-8 encoding. Also supports all the
 116.127 +  options provided by clojure.contrib.repl-ln/repl."
 116.128 +  [& options]
 116.129 +  (let [enc RT/UTF8
 116.130 +        {:keys [in out err]
 116.131 +         :or {in (LineNumberingPushbackReader.
 116.132 +                  (InputStreamReader. System/in enc))
 116.133 +              out (OutputStreamWriter. System/out enc)
 116.134 +              err (PrintWriter. (OutputStreamWriter. System/err enc))}}
 116.135 +        (apply hash-map options)]
 116.136 +    (binding [*in* in *out* out *err* err]
 116.137 +      (apply repl options))))
 116.138 +
 116.139 +(defn- -main
 116.140 +  "Main entry point, starts a repl enters the user namespace and processes
 116.141 +  command line args."
 116.142 +  [& args]
 116.143 +  (repl :init
 116.144 +        (fn []
 116.145 +          (println "Clojure" (clojure-version))
 116.146 +          (in-ns 'user)
 116.147 +          (process-command-line args))))
 116.148 +
 116.149 +;; Public
 116.150 +
 116.151 +(defn repl-prompt
 116.152 +  "Returns the current repl prompt based on this repl's prompt-fmt"
 116.153 +  []
 116.154 +  (let [{:keys [prompt-fmt]} *private*
 116.155 +        {:keys [serial thread depth]} *info*
 116.156 +        line (.getLineNumber *in*)
 116.157 +        namespace (ns-name *ns*)]
 116.158 +    (format prompt-fmt serial thread depth line namespace)))
 116.159 +
 116.160 +(defn set-repl-name
 116.161 +  "Sets the repl name format to the string name-fmt. Include the following
 116.162 +  codes in the name to make the corresponding dynamic values part of it:
 116.163 +
 116.164 +    %S - repl serial number
 116.165 +    %T - thread id
 116.166 +    %D - nesting depth in this thread
 116.167 +
 116.168 +  With no arguments, resets the repl name to its default: \"repl-%S\""
 116.169 +  ([]
 116.170 +     (set-repl-name (+info-defaults+ :name-fmt)))
 116.171 +  ([name-fmt]
 116.172 +     (update *info* :name-fmt name-fmt)
 116.173 +     (loop [[[code fmt] & more] (seq +name-formats+)
 116.174 +            name-fmt name-fmt]
 116.175 +       (if code
 116.176 +         (recur more (.replace name-fmt code fmt))
 116.177 +         (update *private* :name-fmt name-fmt)))
 116.178 +     (let [name (repl-name)]
 116.179 +       (update *info* :name name)
 116.180 +       (var-set Compiler/SOURCE name))
 116.181 +     nil))
 116.182 +
 116.183 +(defn set-repl-prompt
 116.184 +  "Sets the repl prompt. Include the following codes in the prompt to make
 116.185 +  the corresponding dynamic values part of it:
 116.186 +
 116.187 +    %S - repl serial number
 116.188 +    %T - thread id
 116.189 +    %D - nesting depth in this thread
 116.190 +    %L - input line number
 116.191 +    %N - namespace name
 116.192 +
 116.193 +  With no arguments, resets the repl pompt to its default: \"%S:%L %N=> \""
 116.194 +  ([]
 116.195 +     (set-repl-prompt (+info-defaults+ :prompt-fmt)))
 116.196 +  ([prompt-fmt]
 116.197 +     (update *info* :prompt-fmt prompt-fmt)
 116.198 +     (loop [[[code fmt] & more] (seq +prompt-formats+)
 116.199 +            prompt-fmt prompt-fmt]
 116.200 +       (if code
 116.201 +         (recur more (.replace prompt-fmt code fmt))
 116.202 +         (update *private* :prompt-fmt prompt-fmt)))
 116.203 +     nil))
 116.204 +
 116.205 +(defn repl-info
 116.206 +  "Returns a map of info about the current repl"
 116.207 +  []
 116.208 +  (let [line (.getLineNumber *in*)]
 116.209 +    (assoc *info* :line line)))
 116.210 +
 116.211 +(defn print-repl-info
 116.212 +  "Prints info about the current repl"
 116.213 +  []
 116.214 +  (let [{:keys [name started name-fmt prompt-fmt serial thread depth line]}
 116.215 +        (repl-info)]
 116.216 +    (printf
 116.217 +     (apply str (interleave +info-format+ (repeat "\n")))
 116.218 +     name started name-fmt prompt-fmt serial thread depth line)))
 116.219 +
 116.220 +(defn repl
 116.221 +  "A repl that supports line numbers. For definitions and evaluations made
 116.222 +  at the repl, the repl-name and line number will be reported as the
 116.223 +  origin. Use set-repl-name and set-repl-prompt to customize the repl name
 116.224 +  and prompt. This repl supports all of the keyword arguments documented
 116.225 +  for clojure.main/repl with the following change and additions:
 116.226 +
 116.227 +       - :prompt has a new default
 116.228 +         default: #(clojure.core/print (repl-prompt))
 116.229 +
 116.230 +       - :name-fmt, Name format string
 116.231 +         default: the name-fmt of the parent repl, or \"repl-%S\"
 116.232 +
 116.233 +       - :prompt-fmt, Prompt format string
 116.234 +         default: the prompt-fmt of the parent repl, or \"%S:%L %N=> \""
 116.235 +  [& options]
 116.236 +  (let [{:keys [init need-prompt prompt flush read eval print caught
 116.237 +                name-fmt prompt-fmt]
 116.238 +         :or {init        #()
 116.239 +              need-prompt (if (instance? LineNumberingPushbackReader *in*)
 116.240 +                            #(.atLineStart *in*)
 116.241 +                            #(identity true))
 116.242 +              prompt      #(clojure.core/print (repl-prompt))
 116.243 +              flush       flush
 116.244 +              read        clojure.main/repl-read
 116.245 +              eval        eval
 116.246 +              print       prn
 116.247 +              caught      clojure.main/repl-caught
 116.248 +              name-fmt    (*info* :name-fmt)
 116.249 +              prompt-fmt  (*info* :prompt-fmt)}}
 116.250 +              (apply hash-map options)]
 116.251 +    (try
 116.252 +     (Var/pushThreadBindings
 116.253 +      {Compiler/SOURCE (var-get Compiler/SOURCE)
 116.254 +       Compiler/LINE (var-get Compiler/LINE)
 116.255 +       (var *info*) *info*
 116.256 +       (var *private*) {}})
 116.257 +     (update *info*
 116.258 +             :started (Date.)
 116.259 +             :serial (swap! *serial-number* inc)
 116.260 +             :thread (.getId (Thread/currentThread))
 116.261 +             :depth (inc (*info* :depth)))
 116.262 +     (update *private*
 116.263 +             :prompt prompt)
 116.264 +     (set-repl-name name-fmt)
 116.265 +     (set-repl-prompt prompt-fmt)
 116.266 +     (clojure.main/repl
 116.267 +      :init init
 116.268 +      :need-prompt need-prompt
 116.269 +      :prompt prompt-hook
 116.270 +      :flush flush
 116.271 +      :read read
 116.272 +      :eval eval
 116.273 +      :print print
 116.274 +      :caught caught)
 116.275 +     (finally
 116.276 +      (Var/popThreadBindings)
 116.277 +      (prn)))))
   117.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   117.2 +++ b/src/clojure/contrib/repl_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   117.3 @@ -0,0 +1,213 @@
   117.4 +;   Copyright (c) Chris Houser, Dec 2008. All rights reserved.
   117.5 +;   The use and distribution terms for this software are covered by the
   117.6 +;   Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
   117.7 +;   which can be found in the file CPL.TXT at the root of this distribution.
   117.8 +;   By using this software in any fashion, you are agreeing to be bound by
   117.9 +;   the terms of this license.
  117.10 +;   You must not remove this notice, or any other, from this software.
  117.11 +
  117.12 +; Utilities meant to be used interactively at the REPL
  117.13 +
  117.14 +;; Deprecated in 1.2: source, get-source, and apropos. These are
  117.15 +;; available in clojure.repl as source, source-fn, and apropos, respectively.
  117.16 +
  117.17 +(ns 
  117.18 +  ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim",
  117.19 +     :doc "Utilities meant to be used interactively at the REPL"}
  117.20 +  clojure.contrib.repl-utils
  117.21 +  (:import (java.io File LineNumberReader InputStreamReader PushbackReader)
  117.22 +           (java.lang.reflect Modifier Method Constructor)
  117.23 +           (clojure.lang RT Compiler Compiler$C))
  117.24 +  (:require [clojure.contrib.string :as s])
  117.25 +  (:use [clojure.contrib.seq :only (indexed)]
  117.26 +        [clojure.contrib.javadoc.browse :only (browse-url)]))
  117.27 +
  117.28 +;; ----------------------------------------------------------------------
  117.29 +;; Examine Java classes
  117.30 +
  117.31 +(defn- sortable [t]
  117.32 +  (apply str (map (fn [[a b]] (str a (format "%04d" (Integer. b))))
  117.33 +                  (partition 2 (concat (s/partition #"\d+" t) [0])))))
  117.34 +
  117.35 +(defn- param-str [m]
  117.36 +  (str " (" (s/join
  117.37 +              "," (map (fn [[c i]]
  117.38 +                         (if (> i 3)
  117.39 +                           (str (.getSimpleName c) "*" i)
  117.40 +                           (s/join "," (replicate i (.getSimpleName c)))))
  117.41 +                       (reduce (fn [pairs y] (let [[x i] (peek pairs)]
  117.42 +                                               (if (= x y)
  117.43 +                                                 (conj (pop pairs) [y (inc i)])
  117.44 +                                                 (conj pairs [y 1]))))
  117.45 +                               [] (.getParameterTypes m))))
  117.46 +  ")"))
  117.47 +
  117.48 +(defn- member-details [m]
  117.49 +  (let [static? (Modifier/isStatic (.getModifiers m))
  117.50 +        method? (instance? Method m)
  117.51 +        ctor?   (instance? Constructor m)
  117.52 +        text (if ctor?
  117.53 +               (str "<init>" (param-str m))
  117.54 +               (str
  117.55 +                 (when static? "static ")
  117.56 +                 (.getName m) " : "
  117.57 +                 (if method?
  117.58 +                   (str (.getSimpleName (.getReturnType m)) (param-str m))
  117.59 +                   (str (.getSimpleName (.getType m))))))]
  117.60 +    (assoc (bean m)
  117.61 +           :sort-val [(not static?) method? (sortable text)]
  117.62 +           :text text
  117.63 +           :member m)))
  117.64 +
  117.65 +(defn show
  117.66 +  "With one arg prints all static and instance members of x or (class x).
  117.67 +  Each member is listed with a number which can be given as 'selector'
  117.68 +  to return the member object -- the REPL will print more details for
  117.69 +  that member.
  117.70 +
  117.71 +  The selector also may be a string or regex, in which case only
  117.72 +  members whose names match 'selector' as a case-insensitive regex
  117.73 +  will be printed.
  117.74 +
  117.75 +  Finally, the selector also may be a predicate, in which case only
  117.76 +  members for which the predicate returns true will be printed.  The
  117.77 +  predicate will be passed a single argument, a map that includes the
  117.78 +  :text that will be printed and the :member object itself, as well as
  117.79 +  all the properies of the member object as translated by 'bean'.
  117.80 +
  117.81 +  Examples: (show Integer)  (show [])  (show String 23)  (show String \"case\")"
  117.82 +  ([x] (show x (constantly true)))
  117.83 +  ([x selector]
  117.84 +      (let [c (if (class? x) x (class x))
  117.85 +            members (sort-by :sort-val
  117.86 +                             (map member-details
  117.87 +                                  (concat (.getFields c)
  117.88 +                                          (.getMethods c)
  117.89 +                                          (.getConstructors c))))]
  117.90 +        (if (number? selector)
  117.91 +          (:member (nth members selector))
  117.92 +          (let [pred (if (ifn? selector)
  117.93 +                       selector
  117.94 +                       #(re-find (re-pattern (str "(?i)" selector)) (:name %)))]
  117.95 +            (println "=== " (Modifier/toString (.getModifiers c)) c " ===")
  117.96 +            (doseq [[i m] (indexed members)]
  117.97 +              (when (pred m)
  117.98 +                (printf "[%2d] %s\n" i (:text m)))))))))
  117.99 +
 117.100 +;; ----------------------------------------------------------------------
 117.101 +;; Examine Clojure functions (Vars, really)
 117.102 +
 117.103 +(defn get-source
 117.104 +  "Returns a string of the source code for the given symbol, if it can
 117.105 +  find it.  This requires that the symbol resolve to a Var defined in
 117.106 +  a namespace for which the .clj is in the classpath.  Returns nil if
 117.107 +  it can't find the source.  For most REPL usage, 'source' is more
 117.108 +  convenient.
 117.109 +  
 117.110 +  Example: (get-source 'filter)"
 117.111 +  {:deprecated "1.2"}
 117.112 +  [x]
 117.113 +  (when-let [v (resolve x)]
 117.114 +    (when-let [filepath (:file (meta v))]
 117.115 +      (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)]
 117.116 +        (with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
 117.117 +          (dotimes [_ (dec (:line (meta v)))] (.readLine rdr))
 117.118 +          (let [text (StringBuilder.)
 117.119 +                pbr (proxy [PushbackReader] [rdr]
 117.120 +                      (read [] (let [i (proxy-super read)]
 117.121 +                                 (.append text (char i))
 117.122 +                                 i)))]
 117.123 +            (read (PushbackReader. pbr))
 117.124 +            (str text)))))))
 117.125 +
 117.126 +(defmacro source
 117.127 +  "Prints the source code for the given symbol, if it can find it.
 117.128 +  This requires that the symbol resolve to a Var defined in a
 117.129 +  namespace for which the .clj is in the classpath.
 117.130 +  
 117.131 +  Example: (source filter)"
 117.132 +  {:deprecated "1.2"}
 117.133 +  [n]
 117.134 +  `(println (or (get-source '~n) (str "Source not found"))))
 117.135 +
 117.136 +(defn apropos
 117.137 +  "Given a regular expression or stringable thing, return a seq of 
 117.138 +all definitions in all currently-loaded namespaces that match the
 117.139 +str-or-pattern."
 117.140 +  {:deprecated "1.2"}
 117.141 +  [str-or-pattern]
 117.142 +  (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern)
 117.143 +                   #(re-find str-or-pattern (str %))
 117.144 +                   #(s/substring? (str str-or-pattern) (str %)))]
 117.145 +    (mapcat (fn [ns]
 117.146 +              (filter matches? (keys (ns-publics ns))))
 117.147 +            (all-ns))))
 117.148 +
 117.149 +;; ----------------------------------------------------------------------
 117.150 +;; Handle Ctrl-C keystrokes
 117.151 +
 117.152 +(def ^{:doc "Threads to stop when Ctrl-C is pressed.  See 'add-break-thread!'"}
 117.153 +  break-threads (atom {}))
 117.154 +
 117.155 +(let [first-time (atom true)]
 117.156 +  (defn start-handling-break
 117.157 +    "Register INT signal handler.  After calling this, Ctrl-C will cause
 117.158 +    all break-threads to be stopped.  See 'add-break-thread!'"
 117.159 +    []
 117.160 +    (when (= :need-init
 117.161 +             (swap! first-time
 117.162 +                    {:need-init false, false false, true :need-init}))
 117.163 +      (sun.misc.Signal/handle
 117.164 +        (sun.misc.Signal. "INT")
 117.165 +        (proxy [sun.misc.SignalHandler] []
 117.166 +          (handle [sig]
 117.167 +            (let [exc (Exception. (str sig))]
 117.168 +              (doseq [tref (vals @break-threads) :when (.get tref)]
 117.169 +                (.stop (.get tref) exc)))))))))
 117.170 +
 117.171 +(defn add-break-thread!
 117.172 +  "Add the given thread to break-threads so that it will be stopped
 117.173 +  any time the user presses Ctrl-C.  Calls start-handling-break for
 117.174 +  you.  Adds the current thread if none is given."
 117.175 +  ([] (add-break-thread! (Thread/currentThread)))
 117.176 +  ([t]
 117.177 +    (start-handling-break)
 117.178 +    (let [tref (java.lang.ref.WeakReference. t)]
 117.179 +      (swap! break-threads assoc (.getId t) tref))))
 117.180 +
 117.181 +;; ----------------------------------------------------------------------
 117.182 +;; Compiler hooks
 117.183 +
 117.184 +(defn expression-info
 117.185 +  "Uses the Clojure compiler to analyze the given s-expr.  Returns
 117.186 +  a map with keys :class and :primitive? indicating what the compiler
 117.187 +  concluded about the return value of the expression.  Returns nil if
 117.188 +  not type info can be determined at compile-time.
 117.189 +  
 117.190 +  Example: (expression-info '(+ (int 5) (float 10)))
 117.191 +  Returns: {:class float, :primitive? true}"
 117.192 +  [expr]
 117.193 +  (let [fn-ast (Compiler/analyze Compiler$C/EXPRESSION `(fn [] ~expr))
 117.194 +        expr-ast (.body (first (.methods fn-ast)))]
 117.195 +    (when (.hasJavaClass expr-ast)
 117.196 +      {:class (.getJavaClass expr-ast)
 117.197 +       :primitive? (.isPrimitive (.getJavaClass expr-ast))})))
 117.198 +
 117.199 +;; ----------------------------------------------------------------------
 117.200 +;; scgilardi at gmail
 117.201 +
 117.202 +(defn run*
 117.203 +  "Loads the specified namespace and invokes its \"main\" function with
 117.204 +  optional args."
 117.205 +  [ns-sym & args]
 117.206 +  (require ns-sym :reload-all)
 117.207 +  (apply (ns-resolve ns-sym 'main) args))
 117.208 +
 117.209 +(defmacro run
 117.210 +  "Loads the specified namespace and invokes its \"main\" function with
 117.211 +  optional args. ns-name is not evaluated."
 117.212 +  [ns-name & args]
 117.213 +  `(run* '~ns-name ~@args))
 117.214 +
 117.215 +
 117.216 +(load "repl_utils/javadoc")
   118.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   118.2 +++ b/src/clojure/contrib/repl_utils/javadoc.clj	Sat Aug 21 06:25:44 2010 -0400
   118.3 @@ -0,0 +1,83 @@
   118.4 +;   Copyright (c) Christophe Grand, November 2008. All rights reserved.
   118.5 +
   118.6 +;   The use and distribution terms for this software are covered by the
   118.7 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   118.8 +;   which can be found in the file epl-v10.html at the root of this 
   118.9 +;   distribution.
  118.10 +;   By using this software in any fashion, you are agreeing to be bound by
  118.11 +;   the terms of this license.
  118.12 +;   You must not remove this notice, or any other, from this software.
  118.13 +
  118.14 +; thanks to Stuart Sierra
  118.15 +
  118.16 +; a repl helper to quickly open javadocs.
  118.17 +
  118.18 +(def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:")
  118.19 +(def *feeling-lucky* true)
  118.20 +
  118.21 +(def
  118.22 + ^{:doc "Ref to a list of local paths for Javadoc-generated HTML
  118.23 +  files."}
  118.24 + *local-javadocs* (ref (list)))
  118.25 + 
  118.26 +(def *core-java-api*
  118.27 +  (if (= "1.5" (System/getProperty "java.specification.version"))
  118.28 +    "http://java.sun.com/j2se/1.5.0/docs/api/"
  118.29 +    "http://java.sun.com/javase/6/docs/api/"))
  118.30 +
  118.31 +(def
  118.32 + ^{:doc "Ref to a map from package name prefixes to URLs for remote
  118.33 +  Javadocs."}
  118.34 + *remote-javadocs*
  118.35 + (ref (sorted-map
  118.36 +       "java." *core-java-api*
  118.37 +       "javax." *core-java-api*
  118.38 +       "org.ietf.jgss." *core-java-api*
  118.39 +       "org.omg." *core-java-api*
  118.40 +       "org.w3c.dom." *core-java-api*
  118.41 +       "org.xml.sax." *core-java-api*
  118.42 +       "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/"
  118.43 +       "org.apache.commons.io." "http://commons.apache.org/io/api-release/"
  118.44 +       "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/")))
  118.45 +
  118.46 +(defn add-local-javadoc
  118.47 +  "Adds to the list of local Javadoc paths."
  118.48 +  [path]
  118.49 +  (dosync (commute *local-javadocs* conj path)))
  118.50 +
  118.51 +(defn add-remote-javadoc
  118.52 +  "Adds to the list of remote Javadoc URLs.  package-prefix is the
  118.53 +  beginning of the package name that has docs at this URL."
  118.54 +  [package-prefix url]
  118.55 +  (dosync (commute *remote-javadocs* assoc package-prefix url)))
  118.56 +
  118.57 +(defn find-javadoc-url
  118.58 +  "Searches for a URL for the given class name.  Tries
  118.59 +  *local-javadocs* first, then *remote-javadocs*.  Returns a string."
  118.60 +  {:tag String}
  118.61 +  [^String classname]
  118.62 +  (let [file-path (.replace classname \. File/separatorChar)
  118.63 +        url-path (.replace classname \. \/)]
  118.64 +    (if-let [file ^File (first
  118.65 +                           (filter #(.exists ^File %)
  118.66 +                             (map #(File. (str %) (str file-path ".html"))
  118.67 +                               @*local-javadocs*)))]
  118.68 +      (-> file .toURI str)
  118.69 +      ;; If no local file, try remote URLs:
  118.70 +      (or (some (fn [[prefix url]]
  118.71 +                  (when (.startsWith classname prefix)
  118.72 +                    (str url url-path ".html")))
  118.73 +            @*remote-javadocs*)
  118.74 +        ;; if *feeling-lucky* try a web search
  118.75 +        (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html"))))))
  118.76 +
  118.77 +(defn javadoc
  118.78 +  "Opens a browser window displaying the javadoc for the argument.
  118.79 +  Tries *local-javadocs* first, then *remote-javadocs*."
  118.80 +  [class-or-object]
  118.81 +  (let [^Class c (if (instance? Class class-or-object) 
  118.82 +                    class-or-object 
  118.83 +                    (class class-or-object))]
  118.84 +    (if-let [url (find-javadoc-url (.getName c))]
  118.85 +        (browse-url url)
  118.86 +      (println "Could not find Javadoc for" c))))
   119.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   119.2 +++ b/src/clojure/contrib/seq.clj	Sat Aug 21 06:25:44 2010 -0400
   119.3 @@ -0,0 +1,238 @@
   119.4 +;;; seq_utils.clj -- Sequence utilities for Clojure
   119.5 +
   119.6 +;; by Stuart Sierra, http://stuartsierra.com/
   119.7 +;; last updated March 2, 2009
   119.8 +
   119.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
  119.10 +;; and distribution terms for this software are covered by the Eclipse
  119.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  119.12 +;; which can be found in the file epl-v10.html at the root of this
  119.13 +;; distribution.  By using this software in any fashion, you are
  119.14 +;; agreeing to be bound by the terms of this license.  You must not
  119.15 +;; remove this notice, or any other, from this software.
  119.16 +
  119.17 +
  119.18 +;; Change Log
  119.19 +;;
  119.20 +;; January 10, 2009 (Stuart Sierra):
  119.21 +;;
  119.22 +;; * BREAKING CHANGE: "includes?" now takes collection as first
  119.23 +;;   argument.  This is more consistent with Clojure collection
  119.24 +;;   functions; see discussion at http://groups.google.com/group/clojure/browse_thread/thread/8b2c8dc96b39ddd7/a8866d34b601ff43
  119.25 +
  119.26 +
  119.27 +(ns 
  119.28 +  ^{:author "Stuart Sierra (and others)",
  119.29 +     :doc "Sequence utilities for Clojure"}
  119.30 +  clojure.contrib.seq
  119.31 +  (:import (java.util.concurrent LinkedBlockingQueue TimeUnit)
  119.32 +           (java.lang.ref WeakReference))
  119.33 +  (:refer-clojure :exclude [frequencies shuffle partition-by reductions partition-all group-by flatten]))
  119.34 +
  119.35 +
  119.36 +;; 'flatten' written by Rich Hickey,
  119.37 +;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b
  119.38 +(defn flatten
  119.39 +  "DEPRECATED. Prefer clojure.core version.
  119.40 +  Takes any nested combination of sequential things (lists, vectors,
  119.41 +  etc.) and returns their contents as a single, flat sequence.
  119.42 +  (flatten nil) returns nil."
  119.43 +  {:deprecated "1.2"}
  119.44 +  [x]
  119.45 +  (filter (complement sequential?)
  119.46 +          (rest (tree-seq sequential? seq x))))
  119.47 +
  119.48 +(defn separate
  119.49 +  "Returns a vector:
  119.50 +   [ (filter f s), (filter (complement f) s) ]"
  119.51 +  [f s]
  119.52 +  [(filter f s) (filter (complement f) s)])
  119.53 +
  119.54 +(defn indexed
  119.55 +  "Returns a lazy sequence of [index, item] pairs, where items come
  119.56 +  from 's' and indexes count up from zero.
  119.57 +
  119.58 +  (indexed '(a b c d))  =>  ([0 a] [1 b] [2 c] [3 d])"
  119.59 +  [s]
  119.60 +  (map vector (iterate inc 0) s))
  119.61 +
  119.62 +;; group-by written by Rich Hickey;
  119.63 +;; see http://paste.lisp.org/display/64190
  119.64 +(defn group-by 
  119.65 +  "DEPRECATED. Prefer clojure.core version.
  119.66 +   Returns a sorted map of the elements of coll keyed by the result of
  119.67 +  f on each element. The value at each key will be a vector of the
  119.68 +  corresponding elements, in the order they appeared in coll."
  119.69 +  {:deprecated "1.2"}
  119.70 +  [f coll]
  119.71 +  (reduce
  119.72 +   (fn [ret x]
  119.73 +     (let [k (f x)]
  119.74 +       (assoc ret k (conj (get ret k []) x))))
  119.75 +   (sorted-map) coll))
  119.76 +
  119.77 +;; partition-by originally written by Rich Hickey;
  119.78 +;; modified by Stuart Sierra
  119.79 +(defn partition-by
  119.80 +  "DEPRECATED. Prefer clojure.core version.
  119.81 +   Applies f to each value in coll, splitting it each time f returns
  119.82 +   a new value.  Returns a lazy seq of lazy seqs."
  119.83 +  {:deprecated "1.2"}
  119.84 +  [f coll]
  119.85 +  (when-let [s (seq coll)]
  119.86 +    (let [fst (first s)
  119.87 +          fv (f fst)
  119.88 +          run (cons fst (take-while #(= fv (f %)) (rest s)))]
  119.89 +      (lazy-seq
  119.90 +       (cons run (partition-by f (drop (count run) s)))))))
  119.91 +
  119.92 +(defn frequencies
  119.93 +  "DEPRECATED. Prefer clojure.core version.
  119.94 +  Returns a map from distinct items in coll to the number of times
  119.95 +  they appear."
  119.96 +  {:deprecated "1.2"}
  119.97 +  [coll]
  119.98 +  (reduce (fn [counts x]
  119.99 +              (assoc counts x (inc (get counts x 0))))
 119.100 +          {} coll))
 119.101 +
 119.102 +;; recursive sequence helpers by Christophe Grand
 119.103 +;; see http://clj-me.blogspot.com/2009/01/recursive-seqs.html
 119.104 +(defmacro rec-seq 
 119.105 + "Similar to lazy-seq but binds the resulting seq to the supplied 
 119.106 +  binding-name, allowing for recursive expressions."
 119.107 + [binding-name & body]
 119.108 +  `(let [s# (atom nil)]
 119.109 +     (reset! s# (lazy-seq (let [~binding-name @s#] ~@body)))))
 119.110 +             
 119.111 +(defmacro rec-cat 
 119.112 + "Similar to lazy-cat but binds the resulting sequence to the supplied 
 119.113 +  binding-name, allowing for recursive expressions."
 119.114 + [binding-name & exprs]
 119.115 +  `(rec-seq ~binding-name (lazy-cat ~@exprs)))
 119.116 +         
 119.117 +     
 119.118 +;; reductions by Chris Houser
 119.119 +;; see http://groups.google.com/group/clojure/browse_thread/thread/3edf6e82617e18e0/58d9e319ad92aa5f?#58d9e319ad92aa5f
 119.120 +(defn reductions
 119.121 +  "DEPRECATED. Prefer clojure.core version.
 119.122 +  Returns a lazy seq of the intermediate values of the reduction (as
 119.123 +  per reduce) of coll by f, starting with init."
 119.124 +  {:deprecated "1.2"}
 119.125 +  ([f coll]
 119.126 +   (if (seq coll)
 119.127 +     (rec-seq self (cons (first coll) (map f self (rest coll))))
 119.128 +     (cons (f) nil)))
 119.129 +  ([f init coll]
 119.130 +   (rec-seq self (cons init (map f self coll)))))
 119.131 +
 119.132 +(defn rotations
 119.133 +  "Returns a lazy seq of all rotations of a seq"
 119.134 +  [x]
 119.135 +  (if (seq x)
 119.136 +    (map
 119.137 +     (fn [n _]
 119.138 +       (lazy-cat (drop n x) (take n x)))
 119.139 +     (iterate inc 0) x)
 119.140 +    (list nil)))
 119.141 +
 119.142 +(defn partition-all
 119.143 +  "DEPRECATED. Prefer clojure.core version.
 119.144 +  Returns a lazy sequence of lists like clojure.core/partition, but may
 119.145 +  include lists with fewer than n items at the end."
 119.146 +  {:deprecated "1.2"}
 119.147 +  ([n coll]
 119.148 +     (partition-all n n coll))
 119.149 +  ([n step coll]
 119.150 +     (lazy-seq
 119.151 +      (when-let [s (seq coll)]
 119.152 +        (cons (take n s) (partition-all n step (drop step s)))))))
 119.153 +  
 119.154 +(defn shuffle
 119.155 +  "DEPRECATED. Prefer clojure.core version.
 119.156 +  Return a random permutation of coll"
 119.157 +  {:deprecated "1.2"}
 119.158 +  [coll]
 119.159 +  (let [l (java.util.ArrayList. coll)]
 119.160 +    (java.util.Collections/shuffle l)
 119.161 +    (seq l)))
 119.162 +
 119.163 +(defn rand-elt
 119.164 +  "DEPRECATED. Prefer clojure.core/rand-nth.
 119.165 +   Return a random element of this seq"
 119.166 +  {:deprecated "1.2"}
 119.167 +  [s]
 119.168 +  (nth s (rand-int (count s))))
 119.169 +
 119.170 +;; seq-on written by Konrad Hinsen
 119.171 +(defmulti seq-on
 119.172 +  "Returns a seq on the object s. Works like the built-in seq but as
 119.173 +   a multimethod that can have implementations for new classes and types."
 119.174 +  {:arglists '([s])}
 119.175 +  type)
 119.176 +
 119.177 +(defmethod seq-on :default
 119.178 +  [s]
 119.179 +  (seq s))
 119.180 +
 119.181 +
 119.182 +(defn find-first
 119.183 +  "Returns the first item of coll for which (pred item) returns logical true.
 119.184 +  Consumes sequences up to the first match, will consume the entire sequence
 119.185 +  and return nil if no match is found."
 119.186 +  [pred coll]
 119.187 +  (first (filter pred coll)))
 119.188 +
 119.189 +; based on work related to Rich Hickey's seque.
 119.190 +; blame Chouser for anything broken or ugly.
 119.191 +(defn fill-queue
 119.192 +  "filler-func will be called in another thread with a single arg
 119.193 +  'fill'.  filler-func may call fill repeatedly with one arg each
 119.194 +  time which will be pushed onto a queue, blocking if needed until
 119.195 +  this is possible.  fill-queue will return a lazy seq of the values
 119.196 +  filler-func has pushed onto the queue, blocking if needed until each
 119.197 +  next element becomes available.  filler-func's return value is ignored."
 119.198 +  ([filler-func & optseq]
 119.199 +    (let [opts (apply array-map optseq)
 119.200 +          apoll (:alive-poll opts 1)
 119.201 +          q (LinkedBlockingQueue. (:queue-size opts 1))
 119.202 +          NIL (Object.) ;nil sentinel since LBQ doesn't support nils
 119.203 +          weak-target (Object.)
 119.204 +          alive? (WeakReference. weak-target)
 119.205 +          fill (fn fill [x]
 119.206 +                 (if (.get alive?)
 119.207 +                   (if (.offer q (if (nil? x) NIL x) apoll TimeUnit/SECONDS)
 119.208 +                     x
 119.209 +                     (recur x))
 119.210 +                   (throw (Exception. "abandoned"))))
 119.211 +          f (future
 119.212 +              (try
 119.213 +                (filler-func fill)
 119.214 +                (finally
 119.215 +                  (.put q q))) ;q itself is eos sentinel
 119.216 +              nil)] ; set future's value to nil
 119.217 +      ((fn drain []
 119.218 +         weak-target ; force closing over this object
 119.219 +         (lazy-seq
 119.220 +           (let [x (.take q)]
 119.221 +             (if (identical? x q)
 119.222 +               @f  ;will be nil, touch just to propagate errors
 119.223 +               (cons (if (identical? x NIL) nil x)
 119.224 +                     (drain))))))))))
 119.225 +
 119.226 +(defn positions
 119.227 +  "Returns a lazy sequence containing the positions at which pred
 119.228 +   is true for items in coll."
 119.229 +  [pred coll]
 119.230 +  (for [[idx elt] (indexed coll) :when (pred elt)] idx))
 119.231 +
 119.232 +(defn includes?
 119.233 +  "Returns true if coll contains something equal (with =) to x,
 119.234 +  in linear time. Deprecated. Prefer 'contains?' for key testing,
 119.235 +  or 'some' for ad hoc linear searches."
 119.236 +  {:deprecated "1.2"}
 119.237 +  [coll x]
 119.238 +  (boolean (some (fn [y] (= y x)) coll)))
 119.239 +
 119.240 +
 119.241 +
   120.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   120.2 +++ b/src/clojure/contrib/seq_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   120.3 @@ -0,0 +1,244 @@
   120.4 +;;; seq_utils.clj -- Sequence utilities for Clojure
   120.5 +
   120.6 +;; by Stuart Sierra, http://stuartsierra.com/
   120.7 +;; last updated March 2, 2009
   120.8 +
   120.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
  120.10 +;; and distribution terms for this software are covered by the Eclipse
  120.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  120.12 +;; which can be found in the file epl-v10.html at the root of this
  120.13 +;; distribution.  By using this software in any fashion, you are
  120.14 +;; agreeing to be bound by the terms of this license.  You must not
  120.15 +;; remove this notice, or any other, from this software.
  120.16 +
  120.17 +
  120.18 +;; Change Log
  120.19 +;;
  120.20 +;; DEPRECATED in 1.2. Some functions promoted to clojure.core and some
  120.21 +;; moved to c.c.seq
  120.22 +;;
  120.23 +;; January 10, 2009 (Stuart Sierra):
  120.24 +;;
  120.25 +;; * BREAKING CHANGE: "includes?" now takes collection as first
  120.26 +;;   argument.  This is more consistent with Clojure collection
  120.27 +;;   functions; see discussion at http://groups.google.com/group/clojure/browse_thread/thread/8b2c8dc96b39ddd7/a8866d34b601ff43
  120.28 +;;
  120.29 +
  120.30 +(ns 
  120.31 +  ^{:author "Stuart Sierra (and others)",
  120.32 +    :deprecated "1.2"
  120.33 +    :doc "Sequence utilities for Clojure"}
  120.34 +  clojure.contrib.seq-utils
  120.35 +  (:import (java.util.concurrent LinkedBlockingQueue TimeUnit)
  120.36 +           (java.lang.ref WeakReference))
  120.37 +  (:refer-clojure :exclude [frequencies shuffle partition-by reductions partition-all group-by flatten]))
  120.38 +
  120.39 +
  120.40 +;; 'flatten' written by Rich Hickey,
  120.41 +;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b
  120.42 +(defn flatten
  120.43 +  "DEPRECATED. Prefer clojure.core version.
  120.44 +  Takes any nested combination of sequential things (lists, vectors,
  120.45 +  etc.) and returns their contents as a single, flat sequence.
  120.46 +  (flatten nil) returns nil."
  120.47 +  {:deprecated "1.2"}
  120.48 +  [x]
  120.49 +  (filter (complement sequential?)
  120.50 +          (rest (tree-seq sequential? seq x))))
  120.51 +
  120.52 +(defn separate
  120.53 +  "Returns a vector:
  120.54 +   [ (filter f s), (filter (complement f) s) ]"
  120.55 +  [f s]
  120.56 +  [(filter f s) (filter (complement f) s)])
  120.57 +
  120.58 +(defn indexed
  120.59 +  "Returns a lazy sequence of [index, item] pairs, where items come
  120.60 +  from 's' and indexes count up from zero.
  120.61 +
  120.62 +  (indexed '(a b c d))  =>  ([0 a] [1 b] [2 c] [3 d])"
  120.63 +  [s]
  120.64 +  (map vector (iterate inc 0) s))
  120.65 +
  120.66 +;; group-by written by Rich Hickey;
  120.67 +;; see http://paste.lisp.org/display/64190
  120.68 +(defn group-by 
  120.69 +  "DEPRECATED. Prefer clojure.core version.
  120.70 +   Returns a sorted map of the elements of coll keyed by the result of
  120.71 +  f on each element. The value at each key will be a vector of the
  120.72 +  corresponding elements, in the order they appeared in coll."
  120.73 +  {:deprecated "1.2"}
  120.74 +  [f coll]
  120.75 +  (reduce
  120.76 +   (fn [ret x]
  120.77 +     (let [k (f x)]
  120.78 +       (assoc ret k (conj (get ret k []) x))))
  120.79 +   (sorted-map) coll))
  120.80 +
  120.81 +;; partition-by originally written by Rich Hickey;
  120.82 +;; modified by Stuart Sierra
  120.83 +(defn partition-by
  120.84 +  "DEPRECATED. Prefer clojure.core version.
  120.85 +   Applies f to each value in coll, splitting it each time f returns
  120.86 +   a new value.  Returns a lazy seq of lazy seqs."
  120.87 +  {:deprecated "1.2"}
  120.88 +  [f coll]
  120.89 +  (when-let [s (seq coll)]
  120.90 +    (let [fst (first s)
  120.91 +          fv (f fst)
  120.92 +          run (cons fst (take-while #(= fv (f %)) (rest s)))]
  120.93 +      (lazy-seq
  120.94 +       (cons run (partition-by f (drop (count run) s)))))))
  120.95 +
  120.96 +(defn frequencies
  120.97 +  "DEPRECATED. Prefer clojure.core version.
  120.98 +  Returns a map from distinct items in coll to the number of times
  120.99 +  they appear."
 120.100 +  {:deprecated "1.2"}
 120.101 +  [coll]
 120.102 +  (reduce (fn [counts x]
 120.103 +              (assoc counts x (inc (get counts x 0))))
 120.104 +          {} coll))
 120.105 +
 120.106 +;; recursive sequence helpers by Christophe Grand
 120.107 +;; see http://clj-me.blogspot.com/2009/01/recursive-seqs.html
 120.108 +(defmacro rec-seq 
 120.109 + "Similar to lazy-seq but binds the resulting seq to the supplied 
 120.110 +  binding-name, allowing for recursive expressions."
 120.111 + [binding-name & body]
 120.112 +  `(let [s# (atom nil)]
 120.113 +     (reset! s# (lazy-seq (let [~binding-name @s#] ~@body)))))
 120.114 +             
 120.115 +(defmacro rec-cat 
 120.116 + "Similar to lazy-cat but binds the resulting sequence to the supplied 
 120.117 +  binding-name, allowing for recursive expressions."
 120.118 + [binding-name & exprs]
 120.119 +  `(rec-seq ~binding-name (lazy-cat ~@exprs)))
 120.120 +         
 120.121 +     
 120.122 +;; reductions by Chris Houser
 120.123 +;; see http://groups.google.com/group/clojure/browse_thread/thread/3edf6e82617e18e0/58d9e319ad92aa5f?#58d9e319ad92aa5f
 120.124 +(defn reductions
 120.125 +  "DEPRECATED. Prefer clojure.core version.
 120.126 +  Returns a lazy seq of the intermediate values of the reduction (as
 120.127 +  per reduce) of coll by f, starting with init."
 120.128 +  {:deprecated "1.2"}
 120.129 +  ([f coll]
 120.130 +   (if (seq coll)
 120.131 +     (rec-seq self (cons (first coll) (map f self (rest coll))))
 120.132 +     (cons (f) nil)))
 120.133 +  ([f init coll]
 120.134 +   (rec-seq self (cons init (map f self coll)))))
 120.135 +
 120.136 +(defn rotations
 120.137 +  "Returns a lazy seq of all rotations of a seq"
 120.138 +  [x]
 120.139 +  (if (seq x)
 120.140 +    (map
 120.141 +     (fn [n _]
 120.142 +       (lazy-cat (drop n x) (take n x)))
 120.143 +     (iterate inc 0) x)
 120.144 +    (list nil)))
 120.145 +
 120.146 +(defn partition-all
 120.147 +  "DEPRECATED. Prefer clojure.core version.
 120.148 +  Returns a lazy sequence of lists like clojure.core/partition, but may
 120.149 +  include lists with fewer than n items at the end."
 120.150 +  {:deprecated "1.2"}
 120.151 +  ([n coll]
 120.152 +     (partition-all n n coll))
 120.153 +  ([n step coll]
 120.154 +     (lazy-seq
 120.155 +      (when-let [s (seq coll)]
 120.156 +        (cons (take n s) (partition-all n step (drop step s)))))))
 120.157 +  
 120.158 +(defn shuffle
 120.159 +  "DEPRECATED. Prefer clojure.core version.
 120.160 +  Return a random permutation of coll"
 120.161 +  {:deprecated "1.2"}
 120.162 +  [coll]
 120.163 +  (let [l (java.util.ArrayList. coll)]
 120.164 +    (java.util.Collections/shuffle l)
 120.165 +    (seq l)))
 120.166 +
 120.167 +(defn rand-elt
 120.168 +  "DEPRECATED. Prefer clojure.core/rand-nth.
 120.169 +   Return a random element of this seq"
 120.170 +  {:deprecated "1.2"}
 120.171 +  [s]
 120.172 +  (nth s (rand-int (count s))))
 120.173 +
 120.174 +
 120.175 +;; seq-on written by Konrad Hinsen
 120.176 +(defmulti seq-on
 120.177 +  "Returns a seq on the object s. Works like the built-in seq but as
 120.178 +   a multimethod that can have implementations for new classes and types."
 120.179 +  {:arglists '([s])}
 120.180 +  type)
 120.181 +
 120.182 +(defmethod seq-on :default
 120.183 +  [s]
 120.184 +  (seq s))
 120.185 +
 120.186 +
 120.187 +(defn find-first
 120.188 +  "Returns the first item of coll for which (pred item) returns logical true.
 120.189 +  Consumes sequences up to the first match, will consume the entire sequence
 120.190 +  and return nil if no match is found."
 120.191 +  [pred coll]
 120.192 +  (first (filter pred coll)))
 120.193 +
 120.194 +; based on work related to Rich Hickey's seque.
 120.195 +; blame Chouser for anything broken or ugly.
 120.196 +(defn fill-queue
 120.197 +  "filler-func will be called in another thread with a single arg
 120.198 +  'fill'.  filler-func may call fill repeatedly with one arg each
 120.199 +  time which will be pushed onto a queue, blocking if needed until
 120.200 +  this is possible.  fill-queue will return a lazy seq of the values
 120.201 +  filler-func has pushed onto the queue, blocking if needed until each
 120.202 +  next element becomes available.  filler-func's return value is ignored."
 120.203 +  ([filler-func & optseq]
 120.204 +    (let [opts (apply array-map optseq)
 120.205 +          apoll (:alive-poll opts 1)
 120.206 +          q (LinkedBlockingQueue. (:queue-size opts 1))
 120.207 +          NIL (Object.) ;nil sentinel since LBQ doesn't support nils
 120.208 +          weak-target (Object.)
 120.209 +          alive? (WeakReference. weak-target)
 120.210 +          fill (fn fill [x]
 120.211 +                 (if (.get alive?)
 120.212 +                   (if (.offer q (if (nil? x) NIL x) apoll TimeUnit/SECONDS)
 120.213 +                     x
 120.214 +                     (recur x))
 120.215 +                   (throw (Exception. "abandoned"))))
 120.216 +          f (future
 120.217 +              (try
 120.218 +                (filler-func fill)
 120.219 +                (finally
 120.220 +                  (.put q q))) ;q itself is eos sentinel
 120.221 +              nil)] ; set future's value to nil
 120.222 +      ((fn drain []
 120.223 +         weak-target ; force closing over this object
 120.224 +         (lazy-seq
 120.225 +           (let [x (.take q)]
 120.226 +             (if (identical? x q)
 120.227 +               @f  ;will be nil, touch just to propagate errors
 120.228 +               (cons (if (identical? x NIL) nil x)
 120.229 +                     (drain))))))))))
 120.230 +
 120.231 +(defn positions
 120.232 +  "Returns a lazy sequence containing the positions at which pred
 120.233 +   is true for items in coll."
 120.234 +  [pred coll]
 120.235 +  (for [[idx elt] (indexed coll) :when (pred elt)] idx))
 120.236 +
 120.237 +(defn includes?
 120.238 +  "Returns true if coll contains something equal (with =) to x,
 120.239 +  in linear time. Deprecated. Prefer 'contains?' for key testing,
 120.240 +  or 'some' for ad hoc linear searches."
 120.241 +  {:deprecated "1.2"}
 120.242 +  [coll x]
 120.243 +  (boolean (some (fn [y] (= y x)) coll)))
 120.244 +
 120.245 +
 120.246 +
 120.247 +
   121.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   121.2 +++ b/src/clojure/contrib/server_socket.clj	Sat Aug 21 06:25:44 2010 -0400
   121.3 @@ -0,0 +1,94 @@
   121.4 +;;  Copyright (c) Craig McDaniel, Jan 2009. All rights reserved.
   121.5 +;;  The use and distribution terms for this software are covered by the
   121.6 +;;  Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   121.7 +;;  which can be found in the file epl-v10.html at the root of this distribution.
   121.8 +;;  By using this software in any fashion, you are agreeing to be bound by
   121.9 +;;  the terms of this license.
  121.10 +;;  You must not remove this notice, or any other, from this software.
  121.11 +
  121.12 +;;  Server socket library - includes REPL on socket
  121.13 +
  121.14 +(ns 
  121.15 +  ^{:author "Craig McDaniel",
  121.16 +     :doc "Server socket library - includes REPL on socket"}
  121.17 +  clojure.contrib.server-socket
  121.18 +  (:import (java.net InetAddress ServerSocket Socket SocketException)
  121.19 +           (java.io InputStreamReader OutputStream OutputStreamWriter PrintWriter)
  121.20 +           (clojure.lang LineNumberingPushbackReader))
  121.21 +  (:use [clojure.main :only (repl)]))
  121.22 + 
  121.23 +(defn- on-thread [f]
  121.24 +  (doto (Thread. ^Runnable f) 
  121.25 +    (.start)))
  121.26 +
  121.27 +(defn- close-socket [^Socket s]
  121.28 +  (when-not (.isClosed s)    
  121.29 +    (doto s
  121.30 +      (.shutdownInput)
  121.31 +      (.shutdownOutput)
  121.32 +      (.close))))
  121.33 +
  121.34 +(defn- accept-fn [^Socket s connections fun]
  121.35 +  (let [ins (.getInputStream s)
  121.36 +        outs (.getOutputStream s)]
  121.37 +    (on-thread #(do
  121.38 +                  (dosync (commute connections conj s))
  121.39 +                  (try
  121.40 +                   (fun ins outs)
  121.41 +                   (catch SocketException e))
  121.42 +                  (close-socket s)
  121.43 +                  (dosync (commute connections disj s))))))
  121.44 +
  121.45 +(defstruct server-def :server-socket :connections)
  121.46 +
  121.47 +(defn- create-server-aux [fun ^ServerSocket ss]
  121.48 +  (let [connections (ref #{})]
  121.49 +    (on-thread #(when-not (.isClosed ss)
  121.50 +                  (try 
  121.51 +                   (accept-fn (.accept ss) connections fun)
  121.52 +                   (catch SocketException e))
  121.53 +                  (recur)))
  121.54 +    (struct-map server-def :server-socket ss :connections connections)))
  121.55 + 
  121.56 +(defn create-server 
  121.57 +  "Creates a server socket on port. Upon accept, a new thread is
  121.58 +  created which calls:
  121.59 +
  121.60 +  (fun input-stream output-stream)
  121.61 +
  121.62 +  Optional arguments support specifying a listen backlog and binding
  121.63 +  to a specific endpoint."
  121.64 +  ([port fun backlog ^InetAddress bind-addr] 
  121.65 +     (create-server-aux fun (ServerSocket. port backlog bind-addr)))
  121.66 +  ([port fun backlog]
  121.67 +     (create-server-aux fun (ServerSocket. port backlog)))
  121.68 +  ([port fun]
  121.69 +     (create-server-aux fun (ServerSocket. port))))
  121.70 +
  121.71 +(defn close-server [server]
  121.72 +  (doseq [s @(:connections server)]
  121.73 +    (close-socket s))
  121.74 +  (dosync (ref-set (:connections server) #{}))
  121.75 +  (.close ^ServerSocket (:server-socket server)))
  121.76 +
  121.77 +(defn connection-count [server]
  121.78 +  (count @(:connections server)))
  121.79 +
  121.80 +;;;; 
  121.81 +;;;; REPL on a socket
  121.82 +;;;; 
  121.83 +
  121.84 +(defn- socket-repl [ins outs]
  121.85 +  (binding [*in* (LineNumberingPushbackReader. (InputStreamReader. ins))
  121.86 +            *out* (OutputStreamWriter. outs)
  121.87 +            *err* (PrintWriter. ^OutputStream outs true)]
  121.88 +    (repl)))
  121.89 +
  121.90 +(defn create-repl-server 
  121.91 +  "create a repl on a socket"
  121.92 +  ([port backlog ^InetAddress bind-addr] 
  121.93 +     (create-server port socket-repl backlog bind-addr))
  121.94 +  ([port backlog] 
  121.95 +     (create-server port socket-repl backlog))
  121.96 +  ([port] 
  121.97 +     (create-server port socket-repl)))
   122.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   122.2 +++ b/src/clojure/contrib/set.clj	Sat Aug 21 06:25:44 2010 -0400
   122.3 @@ -0,0 +1,52 @@
   122.4 +;;  Copyright (c) Jason Wolfe. All rights reserved.  The use and
   122.5 +;;  distribution terms for this software are covered by the Eclipse Public
   122.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   122.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   122.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   122.9 +;;  terms of this license.  You must not remove this notice, or any other,
  122.10 +;;  from this software.
  122.11 +;;
  122.12 +;;  set.clj
  122.13 +;;
  122.14 +;;  Clojure functions for operating on sets (supplemental to clojure.set)
  122.15 +;;
  122.16 +;;  jason at w01fe dot com
  122.17 +;;  Created 2 Feb 2009
  122.18 +
  122.19 +;; Deprecations in 1.2: subset and superset have been promoted to
  122.20 +;; clojure.set
  122.21 +
  122.22 +(ns 
  122.23 +  ^{:author "Jason Wolfe",
  122.24 +    :doc "Clojure functions for operating on sets (supplemental to clojure.set)"}
  122.25 +  clojure.contrib.set)
  122.26 +
  122.27 +(defn subset? 
  122.28 +  "Is set1 a subset of set2?"
  122.29 +  {:deprecated "1.2"}
  122.30 +  [set1 set2]
  122.31 +  {:tag Boolean}
  122.32 +  (and (<= (count set1) (count set2))
  122.33 +       (every? set2 set1)))
  122.34 +
  122.35 +(defn superset? 
  122.36 +  "Is set1 a superset of set2?"
  122.37 +  {:deprecated "1.2"}
  122.38 +  [set1 set2]
  122.39 +  {:tag Boolean}
  122.40 +  (and (>= (count set1) (count set2))
  122.41 +       (every? set1 set2)))
  122.42 +
  122.43 +(defn proper-subset? 
  122.44 +  "Is s1 a proper subset of s2?"
  122.45 +  [set1 set2]
  122.46 +  {:tag Boolean}
  122.47 +  (and (< (count set1) (count set2))
  122.48 +       (every? set2 set1)))
  122.49 +
  122.50 +(defn proper-superset? 
  122.51 +  "Is s1 a proper superset of s2?"
  122.52 +  [set1 set2]
  122.53 +  {:tag Boolean}
  122.54 +  (and (> (count set1) (count set2))
  122.55 +       (every? set1 set2)))
   123.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   123.2 +++ b/src/clojure/contrib/shell.clj	Sat Aug 21 06:25:44 2010 -0400
   123.3 @@ -0,0 +1,149 @@
   123.4 +;   Copyright (c) Chris Houser, Jan 2009. All rights reserved.
   123.5 +;   The use and distribution terms for this software are covered by the
   123.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   123.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   123.8 +;   By using this software in any fashion, you are agreeing to be bound by
   123.9 +;   the terms of this license.
  123.10 +;   You must not remove this notice, or any other, from this software.
  123.11 +
  123.12 +; :dir and :env options added by Stuart Halloway
  123.13 +
  123.14 +; Conveniently launch a sub-process providing to its stdin and
  123.15 +; collecting its stdout
  123.16 +
  123.17 +;; DEPRECATED in 1.2: Promoted to clojure.java.shell
  123.18 +
  123.19 +(ns 
  123.20 +  ^{:author "Chris Houser",
  123.21 +    :deprecated "1.2"
  123.22 +    :doc "Conveniently launch a sub-process providing to its stdin and
  123.23 +collecting its stdout"}
  123.24 +  clojure.contrib.shell
  123.25 +  (:import (java.io InputStreamReader OutputStreamWriter)))
  123.26 +
  123.27 +(def *sh-dir* nil)
  123.28 +(def *sh-env* nil)
  123.29 +
  123.30 +(defmacro with-sh-dir [dir & forms]
  123.31 +  "Sets the directory for use with sh, see sh for details."
  123.32 +  `(binding [*sh-dir* ~dir]
  123.33 +     ~@forms))
  123.34 +
  123.35 +(defmacro with-sh-env [env & forms]
  123.36 +  "Sets the environment for use with sh, see sh for details."
  123.37 +  `(binding [*sh-env* ~env]
  123.38 +     ~@forms))
  123.39 +     
  123.40 +(defn- stream-seq
  123.41 +  "Takes an InputStream and returns a lazy seq of integers from the stream."
  123.42 +  [stream]
  123.43 +  (take-while #(>= % 0) (repeatedly #(.read stream))))
  123.44 +
  123.45 +(defn- aconcat
  123.46 +  "Concatenates arrays of given type."
  123.47 +  [type & xs]
  123.48 +  (let [target (make-array type (apply + (map count xs)))]
  123.49 +    (loop [i 0 idx 0]
  123.50 +      (when-let [a (nth xs i nil)]
  123.51 +        (System/arraycopy a 0 target idx (count a))
  123.52 +        (recur (inc i) (+ idx (count a)))))
  123.53 +    target))
  123.54 +
  123.55 +(defn- parse-args
  123.56 +  "Takes a seq of 'sh' arguments and returns a map of option keywords
  123.57 +  to option values."
  123.58 +  [args]
  123.59 +  (loop [[arg :as args] args opts {:cmd [] :out "UTF-8" :dir *sh-dir* :env *sh-env*}]
  123.60 +    (if-not args
  123.61 +      opts
  123.62 +      (if (keyword? arg)
  123.63 +        (recur (nnext args) (assoc opts arg (second args)))
  123.64 +        (recur (next args) (update-in opts [:cmd] conj arg))))))
  123.65 +
  123.66 +(defn- as-env-key [arg]
  123.67 +  "Helper so that callers can use symbols, keywords, or strings
  123.68 +   when building an environment map."
  123.69 +  (cond
  123.70 +   (symbol? arg) (name arg)
  123.71 +   (keyword? arg) (name arg)
  123.72 +   (string? arg) arg))
  123.73 +
  123.74 +(defn- as-file [arg]
  123.75 +  "Helper so that callers can pass a String for the :dir to sh."   
  123.76 +  (cond
  123.77 +   (string? arg) (java.io.File. arg)
  123.78 +   (nil? arg) nil
  123.79 +   (instance? java.io.File arg) arg))
  123.80 +   
  123.81 +(defn- as-env-string [arg]
  123.82 +  "Helper so that callers can pass a Clojure map for the :env to sh." 
  123.83 +  (cond
  123.84 +   (nil? arg) nil
  123.85 +   (map? arg) (into-array String (map (fn [[k v]] (str (as-env-key k) "=" v)) arg))
  123.86 +   true arg))
  123.87 +
  123.88 +
  123.89 +(defn sh
  123.90 +  "Passes the given strings to Runtime.exec() to launch a sub-process.
  123.91 +
  123.92 +  Options are
  123.93 +
  123.94 +  :in    may be given followed by a String specifying text to be fed to the 
  123.95 +         sub-process's stdin.  
  123.96 +  :out   option may be given followed by :bytes or a String. If a String 
  123.97 +         is given, it will be used as a character encoding name (for 
  123.98 +         example \"UTF-8\" or \"ISO-8859-1\") to convert the 
  123.99 +         sub-process's stdout to a String which is returned.
 123.100 +         If :bytes is given, the sub-process's stdout will be stored in 
 123.101 +         a byte array and returned.  Defaults to UTF-8.
 123.102 +  :return-map
 123.103 +         when followed by boolean true, sh returns a map of
 123.104 +           :exit => sub-process's exit code
 123.105 +           :out  => sub-process's stdout (as byte[] or String)
 123.106 +           :err  => sub-process's stderr (as byte[] or String)
 123.107 +         when not given or followed by false, sh returns a single
 123.108 +         array or String of the sub-process's stdout followed by its
 123.109 +         stderr
 123.110 +  :env   override the process env with a map (or the underlying Java
 123.111 +         String[] if you are a masochist).
 123.112 +  :dir   override the process dir with a String or java.io.File.
 123.113 +
 123.114 +  You can bind :env or :dir for multiple operations using with-sh-env
 123.115 +  and with-sh-dir."
 123.116 +  [& args]
 123.117 +  (let [opts (parse-args args)
 123.118 +        proc (.exec (Runtime/getRuntime) 
 123.119 +		    (into-array (:cmd opts)) 
 123.120 +		    (as-env-string (:env opts))
 123.121 +		    (as-file (:dir opts)))]
 123.122 +    (if (:in opts)
 123.123 +      (with-open [osw (OutputStreamWriter. (.getOutputStream proc))]
 123.124 +        (.write osw (:in opts)))
 123.125 +      (.close (.getOutputStream proc)))
 123.126 +    (with-open [stdout (.getInputStream proc)
 123.127 +                stderr (.getErrorStream proc)]
 123.128 +      (let [[[out err] combine-fn]
 123.129 +                (if (= (:out opts) :bytes)
 123.130 +                  [(for [strm [stdout stderr]]
 123.131 +                    (into-array Byte/TYPE (map byte (stream-seq strm))))
 123.132 +                  #(aconcat Byte/TYPE %1 %2)]
 123.133 +                  [(for [strm [stdout stderr]]
 123.134 +                    (apply str (map char (stream-seq 
 123.135 +                                            (InputStreamReader. strm (:out opts))))))
 123.136 +                  str])
 123.137 +              exit-code (.waitFor proc)]
 123.138 +        (if (:return-map opts)
 123.139 +          {:exit exit-code :out out :err err}
 123.140 +          (combine-fn out err))))))
 123.141 +
 123.142 +(comment
 123.143 +
 123.144 +(println (sh "ls" "-l"))
 123.145 +(println (sh "ls" "-l" "/no-such-thing"))
 123.146 +(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n"))
 123.147 +(println (sh "cat" :in "x\u25bax\n"))
 123.148 +(println (sh "echo" "x\u25bax"))
 123.149 +(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars
 123.150 +(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[]
 123.151 +
 123.152 +)
   124.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   124.2 +++ b/src/clojure/contrib/shell_out.clj	Sat Aug 21 06:25:44 2010 -0400
   124.3 @@ -0,0 +1,149 @@
   124.4 +;   Copyright (c) Chris Houser, Jan 2009. All rights reserved.
   124.5 +;   The use and distribution terms for this software are covered by the
   124.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   124.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   124.8 +;   By using this software in any fashion, you are agreeing to be bound by
   124.9 +;   the terms of this license.
  124.10 +;   You must not remove this notice, or any other, from this software.
  124.11 +
  124.12 +; :dir and :env options added by Stuart Halloway
  124.13 +
  124.14 +; Conveniently launch a sub-process providing to its stdin and
  124.15 +; collecting its stdout
  124.16 +
  124.17 +;; DEPRECATED in 1.2: Promoted to clojure.java.shell
  124.18 +
  124.19 +(ns 
  124.20 +  ^{:author "Chris Houser",
  124.21 +    :deprecated "1.2"
  124.22 +    :doc "Conveniently launch a sub-process providing to its stdin and
  124.23 +collecting its stdout"}
  124.24 +  clojure.contrib.shell-out
  124.25 +  (:import (java.io InputStreamReader OutputStreamWriter)))
  124.26 +
  124.27 +(def *sh-dir* nil)
  124.28 +(def *sh-env* nil)
  124.29 +
  124.30 +(defmacro with-sh-dir [dir & forms]
  124.31 +  "Sets the directory for use with sh, see sh for details."
  124.32 +  `(binding [*sh-dir* ~dir]
  124.33 +     ~@forms))
  124.34 +
  124.35 +(defmacro with-sh-env [env & forms]
  124.36 +  "Sets the environment for use with sh, see sh for details."
  124.37 +  `(binding [*sh-env* ~env]
  124.38 +     ~@forms))
  124.39 +     
  124.40 +(defn- stream-seq
  124.41 +  "Takes an InputStream and returns a lazy seq of integers from the stream."
  124.42 +  [stream]
  124.43 +  (take-while #(>= % 0) (repeatedly #(.read stream))))
  124.44 +
  124.45 +(defn- aconcat
  124.46 +  "Concatenates arrays of given type."
  124.47 +  [type & xs]
  124.48 +  (let [target (make-array type (apply + (map count xs)))]
  124.49 +    (loop [i 0 idx 0]
  124.50 +      (when-let [a (nth xs i nil)]
  124.51 +        (System/arraycopy a 0 target idx (count a))
  124.52 +        (recur (inc i) (+ idx (count a)))))
  124.53 +    target))
  124.54 +
  124.55 +(defn- parse-args
  124.56 +  "Takes a seq of 'sh' arguments and returns a map of option keywords
  124.57 +  to option values."
  124.58 +  [args]
  124.59 +  (loop [[arg :as args] args opts {:cmd [] :out "UTF-8" :dir *sh-dir* :env *sh-env*}]
  124.60 +    (if-not args
  124.61 +      opts
  124.62 +      (if (keyword? arg)
  124.63 +        (recur (nnext args) (assoc opts arg (second args)))
  124.64 +        (recur (next args) (update-in opts [:cmd] conj arg))))))
  124.65 +
  124.66 +(defn- as-env-key [arg]
  124.67 +  "Helper so that callers can use symbols, keywords, or strings
  124.68 +   when building an environment map."
  124.69 +  (cond
  124.70 +   (symbol? arg) (name arg)
  124.71 +   (keyword? arg) (name arg)
  124.72 +   (string? arg) arg))
  124.73 +
  124.74 +(defn- as-file [arg]
  124.75 +  "Helper so that callers can pass a String for the :dir to sh."   
  124.76 +  (cond
  124.77 +   (string? arg) (java.io.File. arg)
  124.78 +   (nil? arg) nil
  124.79 +   (instance? java.io.File arg) arg))
  124.80 +   
  124.81 +(defn- as-env-string [arg]
  124.82 +  "Helper so that callers can pass a Clojure map for the :env to sh." 
  124.83 +  (cond
  124.84 +   (nil? arg) nil
  124.85 +   (map? arg) (into-array String (map (fn [[k v]] (str (as-env-key k) "=" v)) arg))
  124.86 +   true arg))
  124.87 +
  124.88 +
  124.89 +(defn sh
  124.90 +  "Passes the given strings to Runtime.exec() to launch a sub-process.
  124.91 +
  124.92 +  Options are
  124.93 +
  124.94 +  :in    may be given followed by a String specifying text to be fed to the 
  124.95 +         sub-process's stdin.  
  124.96 +  :out   option may be given followed by :bytes or a String. If a String 
  124.97 +         is given, it will be used as a character encoding name (for 
  124.98 +         example \"UTF-8\" or \"ISO-8859-1\") to convert the 
  124.99 +         sub-process's stdout to a String which is returned.
 124.100 +         If :bytes is given, the sub-process's stdout will be stored in 
 124.101 +         a byte array and returned.  Defaults to UTF-8.
 124.102 +  :return-map
 124.103 +         when followed by boolean true, sh returns a map of
 124.104 +           :exit => sub-process's exit code
 124.105 +           :out  => sub-process's stdout (as byte[] or String)
 124.106 +           :err  => sub-process's stderr (as byte[] or String)
 124.107 +         when not given or followed by false, sh returns a single
 124.108 +         array or String of the sub-process's stdout followed by its
 124.109 +         stderr
 124.110 +  :env   override the process env with a map (or the underlying Java
 124.111 +         String[] if you are a masochist).
 124.112 +  :dir   override the process dir with a String or java.io.File.
 124.113 +
 124.114 +  You can bind :env or :dir for multiple operations using with-sh-env
 124.115 +  and with-sh-dir."
 124.116 +  [& args]
 124.117 +  (let [opts (parse-args args)
 124.118 +        proc (.exec (Runtime/getRuntime) 
 124.119 +		    (into-array (:cmd opts)) 
 124.120 +		    (as-env-string (:env opts))
 124.121 +		    (as-file (:dir opts)))]
 124.122 +    (if (:in opts)
 124.123 +      (with-open [osw (OutputStreamWriter. (.getOutputStream proc))]
 124.124 +        (.write osw (:in opts)))
 124.125 +      (.close (.getOutputStream proc)))
 124.126 +    (with-open [stdout (.getInputStream proc)
 124.127 +                stderr (.getErrorStream proc)]
 124.128 +      (let [[[out err] combine-fn]
 124.129 +                (if (= (:out opts) :bytes)
 124.130 +                  [(for [strm [stdout stderr]]
 124.131 +                    (into-array Byte/TYPE (map byte (stream-seq strm))))
 124.132 +                  #(aconcat Byte/TYPE %1 %2)]
 124.133 +                  [(for [strm [stdout stderr]]
 124.134 +                    (apply str (map char (stream-seq 
 124.135 +                                            (InputStreamReader. strm (:out opts))))))
 124.136 +                  str])
 124.137 +              exit-code (.waitFor proc)]
 124.138 +        (if (:return-map opts)
 124.139 +          {:exit exit-code :out out :err err}
 124.140 +          (combine-fn out err))))))
 124.141 +
 124.142 +(comment
 124.143 +
 124.144 +(println (sh "ls" "-l"))
 124.145 +(println (sh "ls" "-l" "/no-such-thing"))
 124.146 +(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n"))
 124.147 +(println (sh "cat" :in "x\u25bax\n"))
 124.148 +(println (sh "echo" "x\u25bax"))
 124.149 +(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars
 124.150 +(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[]
 124.151 +
 124.152 +)
   125.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   125.2 +++ b/src/clojure/contrib/singleton.clj	Sat Aug 21 06:25:44 2010 -0400
   125.3 @@ -0,0 +1,54 @@
   125.4 +;;; singleton.clj: singleton functions
   125.5 +
   125.6 +;; by Stuart Sierra, http://stuartsierra.com/
   125.7 +;; April 14, 2009
   125.8 +
   125.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
  125.10 +;; and distribution terms for this software are covered by the Eclipse
  125.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  125.12 +;; which can be found in the file epl-v10.html at the root of this
  125.13 +;; distribution.  By using this software in any fashion, you are
  125.14 +;; agreeing to be bound by the terms of this license.  You must not
  125.15 +;; remove this notice, or any other, from this software.
  125.16 +
  125.17 +
  125.18 +;; Change Log:
  125.19 +;;
  125.20 +;; April 14, 2009: added per-thread-singleton, renamed singleton to
  125.21 +;; global-singleton
  125.22 +;;
  125.23 +;; April 9, 2009: initial version
  125.24 +
  125.25 +
  125.26 +(ns 
  125.27 +  ^{:author "Stuart Sierra",
  125.28 +     :doc "Singleton functions"}
  125.29 +  clojure.contrib.singleton)
  125.30 +
  125.31 +(defn global-singleton
  125.32 +  "Returns a global singleton function.  f is a function of no
  125.33 +  arguments that creates and returns some object.  The singleton
  125.34 +  function will call f just once, the first time it is needed, and
  125.35 +  cache the value for all subsequent calls.
  125.36 +
  125.37 +  Warning: global singletons are often unsafe in multi-threaded code.
  125.38 +  Consider per-thread-singleton instead."
  125.39 +  [f]
  125.40 +  (let [instance (atom nil)
  125.41 +        make-instance (fn [_] (f))]
  125.42 +    (fn [] (or @instance (swap! instance make-instance)))))
  125.43 +
  125.44 +(defn per-thread-singleton
  125.45 +  "Returns a per-thread singleton function.  f is a function of no
  125.46 +  arguments that creates and returns some object.  The singleton
  125.47 +  function will call f only once for each thread, and cache its value
  125.48 +  for subsequent calls from the same thread.  This allows you to
  125.49 +  safely and lazily initialize shared objects on a per-thread basis.
  125.50 +
  125.51 +  Warning: due to a bug in JDK 5, it may not be safe to use a
  125.52 +  per-thread-singleton in the initialization function for another
  125.53 +  per-thread-singleton.  See
  125.54 +  http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=5025230"
  125.55 +  [f]
  125.56 +  (let [thread-local (proxy [ThreadLocal] [] (initialValue [] (f)))]
  125.57 +    (fn [] (.get thread-local))))
   126.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   126.2 +++ b/src/clojure/contrib/sql.clj	Sat Aug 21 06:25:44 2010 -0400
   126.3 @@ -0,0 +1,201 @@
   126.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   126.5 +;;  distribution terms for this software are covered by the Eclipse Public
   126.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   126.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   126.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   126.9 +;;  terms of this license.  You must not remove this notice, or any other,
  126.10 +;;  from this software.
  126.11 +;;
  126.12 +;;  sql.clj
  126.13 +;;
  126.14 +;;  A Clojure interface to sql databases via jdbc
  126.15 +;;
  126.16 +;;  See clojure.contrib.sql.test for an example
  126.17 +;;
  126.18 +;;  scgilardi (gmail)
  126.19 +;;  Created 2 April 2008
  126.20 +
  126.21 +(ns
  126.22 +  ^{:author "Stephen C. Gilardi",
  126.23 +     :doc "A Clojure interface to sql databases via jdbc."
  126.24 +     :see-also [["http://github.com/richhickey/clojure-contrib/blob/master/src/test/clojure/clojure/contrib/test_sql.clj"
  126.25 +                 "Example code"]]}
  126.26 +  clojure.contrib.sql
  126.27 +  (:use (clojure.contrib
  126.28 +         [def :only (defalias)]
  126.29 +         [string :only (as-str)])
  126.30 +        clojure.contrib.sql.internal))
  126.31 +
  126.32 +(defalias find-connection find-connection*)
  126.33 +(defalias connection connection*)
  126.34 +
  126.35 +(defmacro with-connection
  126.36 +  "Evaluates body in the context of a new connection to a database then
  126.37 +  closes the connection. db-spec is a map containing values for one of the
  126.38 +  following parameter sets:
  126.39 +
  126.40 +  Factory:
  126.41 +    :factory     (required) a function of one argument, a map of params
  126.42 +    (others)     (optional) passed to the factory function in a map
  126.43 +
  126.44 +  DriverManager:
  126.45 +    :classname   (required) a String, the jdbc driver class name
  126.46 +    :subprotocol (required) a String, the jdbc subprotocol
  126.47 +    :subname     (required) a String, the jdbc subname
  126.48 +    (others)     (optional) passed to the driver as properties.
  126.49 +
  126.50 +  DataSource:
  126.51 +    :datasource  (required) a javax.sql.DataSource
  126.52 +    :username    (optional) a String
  126.53 +    :password    (optional) a String, required if :username is supplied
  126.54 +
  126.55 +  JNDI:
  126.56 +    :name        (required) a String or javax.naming.Name
  126.57 +    :environment (optional) a java.util.Map"
  126.58 +  [db-spec & body]
  126.59 +  `(with-connection* ~db-spec (fn [] ~@body)))
  126.60 +
  126.61 +(defmacro transaction
  126.62 +  "Evaluates body as a transaction on the open database connection. Any
  126.63 +  nested transactions are absorbed into the outermost transaction. By
  126.64 +  default, all database updates are committed together as a group after
  126.65 +  evaluating the outermost body, or rolled back on any uncaught
  126.66 +  exception. If set-rollback-only is called within scope of the outermost
  126.67 +  transaction, the entire transaction will be rolled back rather than
  126.68 +  committed when complete."
  126.69 +  [& body]
  126.70 +  `(transaction* (fn [] ~@body)))
  126.71 +
  126.72 +(defn set-rollback-only
  126.73 +  "Marks the outermost transaction such that it will rollback rather than
  126.74 +  commit when complete"
  126.75 +  []
  126.76 +  (rollback true))
  126.77 +
  126.78 +(defn is-rollback-only
  126.79 +  "Returns true if the outermost transaction will rollback rather than
  126.80 +  commit when complete"
  126.81 +  []
  126.82 +  (rollback))
  126.83 +
  126.84 +(defn do-commands
  126.85 +  "Executes SQL commands on the open database connection."
  126.86 +  [& commands]
  126.87 +  (with-open [stmt (.createStatement (connection))]
  126.88 +    (doseq [cmd commands]
  126.89 +      (.addBatch stmt cmd))
  126.90 +    (transaction
  126.91 +     (seq (.executeBatch stmt)))))
  126.92 +
  126.93 +(defn do-prepared
  126.94 +  "Executes an (optionally parameterized) SQL prepared statement on the
  126.95 +  open database connection. Each param-group is a seq of values for all of
  126.96 +  the parameters."
  126.97 +  [sql & param-groups]
  126.98 +  (with-open [stmt (.prepareStatement (connection) sql)]
  126.99 +    (doseq [param-group param-groups]
 126.100 +      (doseq [[index value] (map vector (iterate inc 1) param-group)]
 126.101 +        (.setObject stmt index value))
 126.102 +      (.addBatch stmt))
 126.103 +    (transaction
 126.104 +     (seq (.executeBatch stmt)))))
 126.105 +
 126.106 +(defn create-table
 126.107 +  "Creates a table on the open database connection given a table name and
 126.108 +  specs. Each spec is either a column spec: a vector containing a column
 126.109 +  name and optionally a type and other constraints, or a table-level
 126.110 +  constraint: a vector containing words that express the constraint. All
 126.111 +  words used to describe the table may be supplied as strings or keywords."
 126.112 +  [name & specs]
 126.113 +  (do-commands
 126.114 +   (format "CREATE TABLE %s (%s)"
 126.115 +           (as-str name)
 126.116 +           (apply str
 126.117 +             (map as-str
 126.118 +              (apply concat
 126.119 +               (interpose [", "]
 126.120 +                (map (partial interpose " ") specs))))))))
 126.121 +
 126.122 +(defn drop-table
 126.123 +  "Drops a table on the open database connection given its name, a string
 126.124 +  or keyword"
 126.125 +  [name]
 126.126 +  (do-commands
 126.127 +   (format "DROP TABLE %s" (as-str name))))
 126.128 +
 126.129 +(defn insert-values
 126.130 +  "Inserts rows into a table with values for specified columns only.
 126.131 +  column-names is a vector of strings or keywords identifying columns. Each
 126.132 +  value-group is a vector containing a values for each column in
 126.133 +  order. When inserting complete rows (all columns), consider using
 126.134 +  insert-rows instead."
 126.135 +  [table column-names & value-groups]
 126.136 +  (let [column-strs (map as-str column-names)
 126.137 +        n (count (first value-groups))
 126.138 +        template (apply str (interpose "," (replicate n "?")))
 126.139 +        columns (if (seq column-names)
 126.140 +                  (format "(%s)" (apply str (interpose "," column-strs)))
 126.141 +                  "")]
 126.142 +    (apply do-prepared
 126.143 +           (format "INSERT INTO %s %s VALUES (%s)"
 126.144 +                   (as-str table) columns template)
 126.145 +           value-groups)))
 126.146 +
 126.147 +(defn insert-rows
 126.148 +  "Inserts complete rows into a table. Each row is a vector of values for
 126.149 +  each of the table's columns in order."
 126.150 +  [table & rows]
 126.151 +  (apply insert-values table nil rows))
 126.152 +
 126.153 +(defn insert-records
 126.154 +  "Inserts records into a table. records are maps from strings or
 126.155 +  keywords (identifying columns) to values."
 126.156 +  [table & records]
 126.157 +  (doseq [record records]
 126.158 +    (insert-values table (keys record) (vals record))))
 126.159 +
 126.160 +(defn delete-rows
 126.161 +  "Deletes rows from a table. where-params is a vector containing a string
 126.162 +  providing the (optionally parameterized) selection criteria followed by
 126.163 +  values for any parameters."
 126.164 +  [table where-params]
 126.165 +  (let [[where & params] where-params]
 126.166 +    (do-prepared
 126.167 +     (format "DELETE FROM %s WHERE %s"
 126.168 +             (as-str table) where)
 126.169 +     params)))
 126.170 +
 126.171 +(defn update-values
 126.172 +  "Updates values on selected rows in a table. where-params is a vector
 126.173 +  containing a string providing the (optionally parameterized) selection
 126.174 +  criteria followed by values for any parameters. record is a map from
 126.175 +  strings or keywords (identifying columns) to updated values."
 126.176 +  [table where-params record]
 126.177 +  (let [[where & params] where-params
 126.178 +        column-strs (map as-str (keys record))
 126.179 +        columns (apply str (concat (interpose "=?, " column-strs) "=?"))]
 126.180 +    (do-prepared
 126.181 +     (format "UPDATE %s SET %s WHERE %s"
 126.182 +             (as-str table) columns where)
 126.183 +     (concat (vals record) params))))
 126.184 +
 126.185 +(defn update-or-insert-values
 126.186 +  "Updates values on selected rows in a table, or inserts a new row when no
 126.187 +  existing row matches the selection criteria. where-params is a vector
 126.188 +  containing a string providing the (optionally parameterized) selection
 126.189 +  criteria followed by values for any parameters. record is a map from
 126.190 +  strings or keywords (identifying columns) to updated values."
 126.191 +  [table where-params record]
 126.192 +  (transaction
 126.193 +   (let [result (update-values table where-params record)]
 126.194 +     (if (zero? (first result))
 126.195 +       (insert-values table (keys record) (vals record))
 126.196 +       result))))
 126.197 +
 126.198 +(defmacro with-query-results
 126.199 +  "Executes a query, then evaluates body with results bound to a seq of the
 126.200 +  results. sql-params is a vector containing a string providing
 126.201 +  the (optionally parameterized) SQL query followed by values for any
 126.202 +  parameters."
 126.203 +  [results sql-params & body]
 126.204 +  `(with-query-results* ~sql-params (fn [~results] ~@body)))
   127.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   127.2 +++ b/src/clojure/contrib/sql/internal.clj	Sat Aug 21 06:25:44 2010 -0400
   127.3 @@ -0,0 +1,194 @@
   127.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   127.5 +;;  distribution terms for this software are covered by the Eclipse Public
   127.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   127.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   127.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   127.9 +;;  terms of this license.  You must not remove this notice, or any other,
  127.10 +;;  from this software.
  127.11 +;;
  127.12 +;;  internal definitions for clojure.contrib.sql
  127.13 +;;
  127.14 +;;  scgilardi (gmail)
  127.15 +;;  Created 3 October 2008
  127.16 +
  127.17 +(ns clojure.contrib.sql.internal
  127.18 +  (:use
  127.19 +   (clojure.contrib
  127.20 +    [except :only (throwf throw-arg)]
  127.21 +    [properties :only (as-properties)]
  127.22 +    [seq :only (indexed)]))
  127.23 +  (:import
  127.24 +   (clojure.lang RT)
  127.25 +   (java.sql BatchUpdateException DriverManager SQLException Statement)
  127.26 +   (java.util Hashtable Map)
  127.27 +   (javax.naming InitialContext Name)
  127.28 +   (javax.sql DataSource)))
  127.29 +
  127.30 +(def *db* {:connection nil :level 0})
  127.31 +
  127.32 +(def special-counts
  127.33 +     {Statement/EXECUTE_FAILED "EXECUTE_FAILED"
  127.34 +      Statement/SUCCESS_NO_INFO "SUCCESS_NO_INFO"})
  127.35 +
  127.36 +(defn find-connection*
  127.37 +  "Returns the current database connection (or nil if there is none)"
  127.38 +  []
  127.39 +  (:connection *db*))
  127.40 +
  127.41 +(defn connection*
  127.42 +  "Returns the current database connection (or throws if there is none)"
  127.43 +  []
  127.44 +  (or (find-connection*)
  127.45 +      (throwf "no current database connection")))
  127.46 +
  127.47 +(defn rollback
  127.48 +  "Accessor for the rollback flag on the current connection"
  127.49 +  ([]
  127.50 +     (deref (:rollback *db*)))
  127.51 +  ([val]
  127.52 +     (swap! (:rollback *db*) (fn [_] val))))
  127.53 +
  127.54 +(defn get-connection
  127.55 +  "Creates a connection to a database. db-spec is a map containing values
  127.56 +  for one of the following parameter sets:
  127.57 +
  127.58 +  Factory:
  127.59 +    :factory     (required) a function of one argument, a map of params
  127.60 +    (others)     (optional) passed to the factory function in a map
  127.61 +
  127.62 +  DriverManager:
  127.63 +    :classname   (required) a String, the jdbc driver class name
  127.64 +    :subprotocol (required) a String, the jdbc subprotocol
  127.65 +    :subname     (required) a String, the jdbc subname
  127.66 +    (others)     (optional) passed to the driver as properties.
  127.67 +
  127.68 +  DataSource:
  127.69 +    :datasource  (required) a javax.sql.DataSource
  127.70 +    :username    (optional) a String
  127.71 +    :password    (optional) a String, required if :username is supplied
  127.72 +
  127.73 +  JNDI:
  127.74 +    :name        (required) a String or javax.naming.Name
  127.75 +    :environment (optional) a java.util.Map"
  127.76 +  [{:keys [factory
  127.77 +           classname subprotocol subname
  127.78 +           datasource username password
  127.79 +           name environment]
  127.80 +    :as db-spec}]
  127.81 +  (cond
  127.82 +   factory
  127.83 +   (factory (dissoc db-spec :factory))
  127.84 +   (and classname subprotocol subname)
  127.85 +   (let [url (format "jdbc:%s:%s" subprotocol subname)
  127.86 +         etc (dissoc db-spec :classname :subprotocol :subname)]
  127.87 +     (RT/loadClassForName classname)
  127.88 +     (DriverManager/getConnection url (as-properties etc)))
  127.89 +   (and datasource username password)
  127.90 +   (.getConnection datasource username password)
  127.91 +   datasource
  127.92 +   (.getConnection datasource)
  127.93 +   name
  127.94 +   (let [env (and environment (Hashtable. environment))
  127.95 +         context (InitialContext. env)
  127.96 +         datasource (.lookup context name)]
  127.97 +     (.getConnection datasource))
  127.98 +   :else
  127.99 +   (throw-arg "db-spec %s is missing a required parameter" db-spec)))
 127.100 +
 127.101 +(defn with-connection*
 127.102 +  "Evaluates func in the context of a new connection to a database then
 127.103 +  closes the connection."
 127.104 +  [db-spec func]
 127.105 +  (with-open [con (get-connection db-spec)]
 127.106 +    (binding [*db* (assoc *db*
 127.107 +                     :connection con :level 0 :rollback (atom false))]
 127.108 +      (func))))
 127.109 +
 127.110 +(defn print-sql-exception
 127.111 +  "Prints the contents of an SQLException to stream"
 127.112 +  [stream exception]
 127.113 +  (.println
 127.114 +   stream
 127.115 +   (format (str "%s:" \newline
 127.116 +                " Message: %s" \newline
 127.117 +                " SQLState: %s" \newline
 127.118 +                " Error Code: %d")
 127.119 +           (.getSimpleName (class exception))
 127.120 +           (.getMessage exception)
 127.121 +           (.getSQLState exception)
 127.122 +           (.getErrorCode exception))))
 127.123 +
 127.124 +(defn print-sql-exception-chain
 127.125 +  "Prints a chain of SQLExceptions to stream"
 127.126 +  [stream exception]
 127.127 +  (loop [e exception]
 127.128 +    (when e
 127.129 +      (print-sql-exception stream e)
 127.130 +      (recur (.getNextException e)))))
 127.131 +
 127.132 +(defn print-update-counts
 127.133 +  "Prints the update counts from a BatchUpdateException to stream"
 127.134 +  [stream exception]
 127.135 +  (.println stream "Update counts:")
 127.136 +  (doseq [[index count] (indexed (.getUpdateCounts exception))]
 127.137 +    (.println stream (format " Statement %d: %s"
 127.138 +                             index
 127.139 +                             (get special-counts count count)))))
 127.140 +
 127.141 +(defn throw-rollback
 127.142 +  "Sets rollback and throws a wrapped exception"
 127.143 +  [e]
 127.144 +  (rollback true)
 127.145 +  (throwf e "transaction rolled back: %s" (.getMessage e)))
 127.146 +
 127.147 +(defn transaction*
 127.148 +  "Evaluates func as a transaction on the open database connection. Any
 127.149 +  nested transactions are absorbed into the outermost transaction. By
 127.150 +  default, all database updates are committed together as a group after
 127.151 +  evaluating the outermost body, or rolled back on any uncaught
 127.152 +  exception. If rollback is set within scope of the outermost transaction,
 127.153 +  the entire transaction will be rolled back rather than committed when
 127.154 +  complete."
 127.155 +  [func]
 127.156 +  (binding [*db* (update-in *db* [:level] inc)]
 127.157 +    (if (= (:level *db*) 1)
 127.158 +      (let [con (connection*)
 127.159 +            auto-commit (.getAutoCommit con)]
 127.160 +        (io!
 127.161 +         (.setAutoCommit con false)
 127.162 +         (try
 127.163 +          (func)
 127.164 +          (catch BatchUpdateException e
 127.165 +            (print-update-counts *err* e)
 127.166 +            (print-sql-exception-chain *err* e)
 127.167 +            (throw-rollback e))
 127.168 +          (catch SQLException e
 127.169 +            (print-sql-exception-chain *err* e)
 127.170 +            (throw-rollback e))
 127.171 +          (catch Exception e
 127.172 +            (throw-rollback e))
 127.173 +          (finally
 127.174 +           (if (rollback)
 127.175 +             (.rollback con)
 127.176 +             (.commit con))
 127.177 +           (rollback false)
 127.178 +           (.setAutoCommit con auto-commit)))))
 127.179 +      (func))))
 127.180 +
 127.181 +(defn with-query-results*
 127.182 +  "Executes a query, then evaluates func passing in a seq of the results as
 127.183 +  an argument. The first argument is a vector containing the (optionally
 127.184 +  parameterized) sql query string followed by values for any parameters."
 127.185 +  [[sql & params :as sql-params] func]
 127.186 +  (when-not (vector? sql-params)
 127.187 +    (throw-arg "\"%s\" expected %s %s, found %s %s"
 127.188 +               "sql-params"
 127.189 +               "vector"
 127.190 +               "[sql param*]"
 127.191 +               (.getName (class sql-params))
 127.192 +               (pr-str sql-params)))
 127.193 +  (with-open [stmt (.prepareStatement (connection*) sql)]
 127.194 +    (doseq [[index value] (map vector (iterate inc 1) params)]
 127.195 +      (.setObject stmt index value))
 127.196 +    (with-open [rset (.executeQuery stmt)]
 127.197 +      (func (resultset-seq rset)))))
   128.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   128.2 +++ b/src/clojure/contrib/str_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   128.3 @@ -0,0 +1,103 @@
   128.4 +;;; str_utils.clj -- string utilities for Clojure
   128.5 +
   128.6 +;; by Stuart Sierra <mail@stuartsierra.com>
   128.7 +;; April 8, 2008
   128.8 +
   128.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
  128.10 +;; and distribution terms for this software are covered by the Eclipse
  128.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  128.12 +;; which can be found in the file epl-v10.html at the root of this
  128.13 +;; distribution.  By using this software in any fashion, you are
  128.14 +;; agreeing to be bound by the terms of this license.  You must not
  128.15 +;; remove this notice, or any other, from this software.
  128.16 +
  128.17 +;; DEPRECATED in 1.2: Promoted to clojure.java.string. Note that
  128.18 +;; many function names and semantics have changed
  128.19 +
  128.20 +(ns 
  128.21 +  ^{:author "Stuart Sierra",
  128.22 +    :deprecated "1.2"
  128.23 +    :doc "String utilities for Clojure"}
  128.24 +  clojure.contrib.str-utils
  128.25 +  (:import (java.util.regex Pattern)))
  128.26 +
  128.27 +(defn re-split
  128.28 +  "Splits the string on instances of 'pattern'.  Returns a sequence of
  128.29 +  strings.  Optional 'limit' argument is the maximum number of
  128.30 +  splits.  Like Perl's 'split'."
  128.31 +  ([^Pattern pattern string] (seq (. pattern (split string))))
  128.32 +  ([^Pattern pattern string limit] (seq (. pattern (split string limit)))))
  128.33 +
  128.34 +(defn re-partition
  128.35 +  "Splits the string into a lazy sequence of substrings, alternating
  128.36 +  between substrings that match the patthern and the substrings
  128.37 +  between the matches.  The sequence always starts with the substring
  128.38 +  before the first match, or an empty string if the beginning of the
  128.39 +  string matches.
  128.40 +
  128.41 +  For example: (re-partition #\"[a-z]+\" \"abc123def\")
  128.42 +
  128.43 +  Returns: (\"\" \"abc\" \"123\" \"def\")"
  128.44 +  [^Pattern re string]
  128.45 +  (let [m (re-matcher re string)]
  128.46 +    ((fn step [prevend]
  128.47 +       (lazy-seq
  128.48 +        (if (.find m)
  128.49 +          (cons (.subSequence string prevend (.start m))
  128.50 +                (cons (re-groups m)
  128.51 +                      (step (+ (.start m) (count (.group m))))))
  128.52 +          (when (< prevend (.length string))
  128.53 +            (list (.subSequence string prevend (.length string)))))))
  128.54 +     0)))
  128.55 +
  128.56 +(defn re-gsub 
  128.57 +  "Replaces all instances of 'pattern' in 'string' with
  128.58 +  'replacement'.  Like Ruby's 'String#gsub'.
  128.59 +  
  128.60 +  If (ifn? replacment) is true, the replacement is called with the
  128.61 +  match.
  128.62 +  "
  128.63 +  [^java.util.regex.Pattern regex replacement ^String string]
  128.64 +  (if (ifn? replacement)
  128.65 +    (let [parts (vec (re-partition regex string))]
  128.66 +      (apply str
  128.67 +             (reduce (fn [parts match-idx]
  128.68 +                       (update-in parts [match-idx] replacement))
  128.69 +                     parts (range 1 (count parts) 2))))
  128.70 +    (.. regex (matcher string) (replaceAll replacement))))
  128.71 +
  128.72 +(defn re-sub
  128.73 +  "Replaces the first instance of 'pattern' in 'string' with
  128.74 +  'replacement'.  Like Ruby's 'String#sub'.
  128.75 +  
  128.76 +  If (ifn? replacement) is true, the replacement is called with
  128.77 +  the match.
  128.78 +  "
  128.79 +  [^Pattern regex replacement ^String string]
  128.80 +  (if (ifn? replacement)
  128.81 +    (let [m (re-matcher regex string)]
  128.82 +      (if (.find m)
  128.83 +        (str (.subSequence string 0 (.start m))
  128.84 +             (replacement (re-groups m))
  128.85 +             (.subSequence string (.end m) (.length string)))
  128.86 +        string))
  128.87 +    (.. regex (matcher string) (replaceFirst replacement))))
  128.88 +
  128.89 +
  128.90 +(defn str-join
  128.91 +  "Returns a string of all elements in 'sequence', separated by
  128.92 +  'separator'.  Like Perl's 'join'."
  128.93 +  [separator sequence]
  128.94 +  (apply str (interpose separator sequence)))
  128.95 +
  128.96 +
  128.97 +(defn chop
  128.98 +  "Removes the last character of string."
  128.99 +  [s]
 128.100 +  (subs s 0 (dec (count s))))
 128.101 +
 128.102 +(defn chomp
 128.103 +  "Removes all trailing newline \\n or return \\r characters from
 128.104 +  string.  Note: String.trim() is similar and faster."
 128.105 +  [s]
 128.106 +  (re-sub #"[\r\n]+$" "" s))
   129.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   129.2 +++ b/src/clojure/contrib/str_utils2.clj	Sat Aug 21 06:25:44 2010 -0400
   129.3 @@ -0,0 +1,376 @@
   129.4 +;;; str_utils2.clj -- functional string utilities for Clojure
   129.5 +
   129.6 +;; by Stuart Sierra, http://stuartsierra.com/
   129.7 +;; August 19, 2009
   129.8 +
   129.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
  129.10 +;; and distribution terms for this software are covered by the Eclipse
  129.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  129.12 +;; which can be found in the file epl-v10.html at the root of this
  129.13 +;; distribution.  By using this software in any fashion, you are
  129.14 +;; agreeing to be bound by the terms of this license.  You must not
  129.15 +;; remove this notice, or any other, from this software.
  129.16 +
  129.17 +;; DEPRECATED in 1.2: Promoted to clojure.java.string. Note that
  129.18 +;; many function names and semantics have changed
  129.19 +
  129.20 +(ns ^{:author "Stuart Sierra"
  129.21 +      :deprecated "1.2"
  129.22 +      :doc "This is a library of string manipulation functions.  It
  129.23 +    is intented as a replacement for clojure.contrib.str-utils.
  129.24 +
  129.25 +    You cannot (use 'clojure.contrib.str-utils2) because it defines
  129.26 +    functions with the same names as functions in clojure.core.
  129.27 +    Instead, do (require '[clojure.contrib.str-utils2 :as s]) 
  129.28 +    or something similar.
  129.29 +
  129.30 +    Goals:
  129.31 +      1. Be functional
  129.32 +      2. String argument first, to work with ->
  129.33 +      3. Performance linear in string length
  129.34 +
  129.35 +    Some ideas are borrowed from
  129.36 +    http://github.com/francoisdevlin/devlinsf-clojure-utils/"}
  129.37 + clojure.contrib.str-utils2
  129.38 + (:refer-clojure :exclude (take replace drop butlast partition
  129.39 +                           contains? get repeat reverse partial))
  129.40 + (:import (java.util.regex Pattern)))
  129.41 +
  129.42 +
  129.43 +(defmacro dochars 
  129.44 +  "bindings => [name string]
  129.45 +
  129.46 +  Repeatedly executes body, with name bound to each character in
  129.47 +  string.  Does NOT handle Unicode supplementary characters (above
  129.48 +  U+FFFF)."
  129.49 +  [bindings & body]
  129.50 +  (assert (vector bindings))
  129.51 +  (assert (= 2 (count bindings)))
  129.52 +  ;; This seems to be the fastest way to iterate over characters.
  129.53 +  `(let [^String s# ~(second bindings)]
  129.54 +     (dotimes [i# (.length s#)]
  129.55 +       (let [~(first bindings) (.charAt s# i#)]
  129.56 +         ~@body))))
  129.57 +
  129.58 +
  129.59 +(defmacro docodepoints
  129.60 +  "bindings => [name string]
  129.61 +
  129.62 +  Repeatedly executes body, with name bound to the integer code point
  129.63 +  of each Unicode character in the string.  Handles Unicode
  129.64 +  supplementary characters (above U+FFFF) correctly."
  129.65 +  [bindings & body]
  129.66 +  (assert (vector bindings))
  129.67 +  (assert (= 2 (count bindings)))
  129.68 +  (let [character (first bindings)
  129.69 +        string (second bindings)]
  129.70 +    `(let [^String s# ~string
  129.71 +           len# (.length s#)]
  129.72 +       (loop [i# 0]
  129.73 +         (when (< i# len#)
  129.74 +           (let [~character (.charAt s# i#)]
  129.75 +             (if (Character/isHighSurrogate ~character)
  129.76 +               (let [~character (.codePointAt s# i#)]
  129.77 +                 ~@body
  129.78 +                 (recur (+ 2 i#)))
  129.79 +               (let [~character (int ~character)]
  129.80 +                 ~@body
  129.81 +                 (recur (inc i#))))))))))
  129.82 +
  129.83 +(defn codepoints
  129.84 +  "Returns a sequence of integer Unicode code points in s.  Handles
  129.85 +  Unicode supplementary characters (above U+FFFF) correctly."
  129.86 +  [^String s]
  129.87 +  (let [len (.length s)
  129.88 +        f (fn thisfn [^String s i]
  129.89 +            (when (< i len)
  129.90 +              (let [c (.charAt s i)]
  129.91 +                (if (Character/isHighSurrogate c)
  129.92 +                  (cons (.codePointAt s i) (thisfn s (+ 2 i)))
  129.93 +                  (cons (int c) (thisfn s (inc i)))))))]
  129.94 +    (lazy-seq (f s 0))))
  129.95 +
  129.96 +(defn ^String escape
  129.97 +  "Returns a new String by applying cmap (a function or a map) to each
  129.98 +   character in s.  If cmap returns nil, the original character is
  129.99 +   added to the output unchanged."
 129.100 +  [^String s cmap]
 129.101 +  (let [buffer (StringBuilder. (.length s))]
 129.102 +    (dochars [c s]
 129.103 +      (if-let [r (cmap c)]
 129.104 +        (.append buffer r)
 129.105 +        (.append buffer c)))
 129.106 +    (.toString buffer)))
 129.107 +
 129.108 +(defn blank?
 129.109 +  "True if s is nil, empty, or contains only whitespace."
 129.110 +  [^String s]
 129.111 +  (every? (fn [^Character c] (Character/isWhitespace c)) s))
 129.112 +
 129.113 +(defn ^String take
 129.114 +  "Take first n characters from s, up to the length of s.
 129.115 +
 129.116 +  Note the argument order is the opposite of clojure.core/take; this
 129.117 +  is to keep the string as the first argument for use with ->"
 129.118 +  [^String s n]
 129.119 +  (if (< (count s) n)
 129.120 +    s
 129.121 +    (.substring s 0 n)))
 129.122 +
 129.123 +(defn ^String drop
 129.124 +  "Drops first n characters from s.  Returns an empty string if n is
 129.125 +  greater than the length of s.
 129.126 +
 129.127 +  Note the argument order is the opposite of clojure.core/drop; this
 129.128 +  is to keep the string as the first argument for use with ->"
 129.129 +  [^String s n]
 129.130 +  (if (< (count s) n)
 129.131 +    ""
 129.132 +    (.substring s n)))
 129.133 +
 129.134 +(defn ^String butlast
 129.135 +  "Returns s without the last n characters.  Returns an empty string
 129.136 +  if n is greater than the length of s.
 129.137 +
 129.138 +  Note the argument order is the opposite of clojure.core/butlast;
 129.139 +  this is to keep the string as the first argument for use with ->"
 129.140 +  [^String s n]
 129.141 +  (if (< (count s) n)
 129.142 +    ""
 129.143 +    (.substring s 0 (- (count s) n))))
 129.144 +
 129.145 +(defn ^String tail
 129.146 +  "Returns the last n characters of s."
 129.147 +  [^String s n]
 129.148 +  (if (< (count s) n)
 129.149 +    s
 129.150 +    (.substring s (- (count s) n))))
 129.151 +
 129.152 +(defn ^String repeat
 129.153 +  "Returns a new String containing s repeated n times."
 129.154 +  [^String s n]
 129.155 +  (apply str (clojure.core/repeat n s)))
 129.156 +
 129.157 +(defn ^String reverse
 129.158 +  "Returns s with its characters reversed."
 129.159 +  [^String s]
 129.160 +  (.toString (.reverse (StringBuilder. s))))
 129.161 +
 129.162 +(defmulti
 129.163 +  ^{:doc "Replaces all instances of pattern in string with replacement.  
 129.164 +  
 129.165 +  Allowed argument types for pattern and replacement are:
 129.166 +   1. String and String
 129.167 +   2. Character and Character
 129.168 +   3. regex Pattern and String
 129.169 +      (Uses java.util.regex.Matcher.replaceAll)
 129.170 +   4. regex Pattern and function
 129.171 +      (Calls function with re-groups of each match, uses return 
 129.172 +       value as replacement.)"
 129.173 +     :arglists '([string pattern replacement])
 129.174 +     :tag String}
 129.175 +  replace
 129.176 +  (fn [^String string pattern replacement]
 129.177 +    [(class pattern) (class replacement)]))
 129.178 +
 129.179 +(defmethod replace [String String] [^String s ^String a ^String b]
 129.180 +  (.replace s a b))
 129.181 +
 129.182 +(defmethod replace [Character Character] [^String s ^Character a ^Character b]
 129.183 +  (.replace s a b))
 129.184 +
 129.185 +(defmethod replace [Pattern String] [^String s re replacement]
 129.186 +  (.replaceAll (re-matcher re s) replacement))
 129.187 +
 129.188 +(defmethod replace [Pattern clojure.lang.IFn] [^String s re replacement]
 129.189 +  (let [m (re-matcher re s)]
 129.190 +    (let [buffer (StringBuffer. (.length s))]
 129.191 +      (loop []
 129.192 +        (if (.find m)
 129.193 +          (do (.appendReplacement m buffer (replacement (re-groups m)))
 129.194 +              (recur))
 129.195 +          (do (.appendTail m buffer)
 129.196 +              (.toString buffer)))))))
 129.197 +
 129.198 +(defmulti
 129.199 +  ^{:doc "Replaces the first instance of pattern in s with replacement.
 129.200 +
 129.201 +  Allowed argument types for pattern and replacement are:
 129.202 +   1. String and String
 129.203 +   2. regex Pattern and String
 129.204 +      (Uses java.util.regex.Matcher.replaceAll)
 129.205 +   3. regex Pattern and function
 129.206 +"
 129.207 +     :arglists '([s pattern replacement])
 129.208 +     :tag String}
 129.209 +  replace-first
 129.210 +  (fn [s pattern replacement]
 129.211 +    [(class pattern) (class replacement)]))
 129.212 +
 129.213 +(defmethod replace-first [String String] [^String s pattern replacement]
 129.214 +  (.replaceFirst (re-matcher (Pattern/quote pattern) s) replacement))
 129.215 +
 129.216 +(defmethod replace-first [Pattern String] [^String s re replacement]
 129.217 +  (.replaceFirst (re-matcher re s) replacement))
 129.218 +
 129.219 +(defmethod replace-first [Pattern clojure.lang.IFn] [^String s ^Pattern re f]
 129.220 +  (let [m (re-matcher re s)]
 129.221 +    (let [buffer (StringBuffer.)]
 129.222 +      (if (.find m)
 129.223 +        (let [rep (f (re-groups m))]
 129.224 +          (.appendReplacement m buffer rep)
 129.225 +          (.appendTail m buffer)
 129.226 +          (str buffer))))))
 129.227 +
 129.228 +(defn partition
 129.229 +  "Splits the string into a lazy sequence of substrings, alternating
 129.230 +  between substrings that match the patthern and the substrings
 129.231 +  between the matches.  The sequence always starts with the substring
 129.232 +  before the first match, or an empty string if the beginning of the
 129.233 +  string matches.
 129.234 +
 129.235 +  For example: (partition \"abc123def\" #\"[a-z]+\")
 129.236 +  returns: (\"\" \"abc\" \"123\" \"def\")"
 129.237 +  [^String s ^Pattern re]
 129.238 +  (let [m (re-matcher re s)]
 129.239 +    ((fn step [prevend]
 129.240 +       (lazy-seq
 129.241 +        (if (.find m)
 129.242 +          (cons (.subSequence s prevend (.start m))
 129.243 +                (cons (re-groups m)
 129.244 +                      (step (+ (.start m) (count (.group m))))))
 129.245 +          (when (< prevend (.length s))
 129.246 +            (list (.subSequence s prevend (.length s)))))))
 129.247 +     0)))
 129.248 +
 129.249 +(defn ^String join
 129.250 +  "Returns a string of all elements in coll, separated by
 129.251 +  separator.  Like Perl's join."
 129.252 +  [^String separator coll]
 129.253 +  (apply str (interpose separator coll)))
 129.254 +
 129.255 +(defn ^String chop
 129.256 +  "Removes the last character of string, does nothing on a zero-length
 129.257 +  string."
 129.258 +  [^String s]
 129.259 +  (let [size (count s)]
 129.260 +    (if (zero? size)
 129.261 +      s
 129.262 +      (subs s 0 (dec (count s))))))
 129.263 +
 129.264 +(defn ^String chomp
 129.265 +  "Removes all trailing newline \\n or return \\r characters from
 129.266 +  string.  Note: String.trim() is similar and faster."
 129.267 +  [^String s]
 129.268 +  (replace s #"[\r\n]+$" ""))
 129.269 +
 129.270 +(defn title-case [^String s]
 129.271 +  (throw (Exception. "title-case not implemeted yet")))
 129.272 +
 129.273 +(defn ^String swap-case
 129.274 +  "Changes upper case characters to lower case and vice-versa.
 129.275 +  Handles Unicode supplementary characters correctly.  Uses the
 129.276 +  locale-sensitive String.toUpperCase() and String.toLowerCase()
 129.277 +  methods."
 129.278 +  [^String s]
 129.279 +  (let [buffer (StringBuilder. (.length s))
 129.280 +        ;; array to make a String from one code point
 129.281 +        ^"[I" array (make-array Integer/TYPE 1)]
 129.282 +    (docodepoints [c s]
 129.283 +      (aset-int array 0 c)
 129.284 +      (if (Character/isLowerCase c)
 129.285 +        ;; Character.toUpperCase is not locale-sensitive, but
 129.286 +        ;; String.toUpperCase is; so we use a String.
 129.287 +        (.append buffer (.toUpperCase (String. array 0 1)))
 129.288 +        (.append buffer (.toLowerCase (String. array 0 1)))))
 129.289 +    (.toString buffer)))
 129.290 +
 129.291 +(defn ^String capitalize
 129.292 +  "Converts first character of the string to upper-case, all other
 129.293 +  characters to lower-case."
 129.294 +  [^String s]
 129.295 +  (if (< (count s) 2)
 129.296 +    (.toUpperCase s)
 129.297 +    (str (.toUpperCase ^String (subs s 0 1))
 129.298 +         (.toLowerCase ^String (subs s 1)))))
 129.299 +
 129.300 +(defn ^String ltrim
 129.301 +  "Removes whitespace from the left side of string."
 129.302 +  [^String s]
 129.303 +  (replace s #"^\s+" ""))
 129.304 +
 129.305 +(defn ^String rtrim
 129.306 +  "Removes whitespace from the right side of string."
 129.307 +  [^String s]
 129.308 +  (replace s #"\s+$" ""))
 129.309 +
 129.310 +(defn split-lines
 129.311 +  "Splits s on \\n or \\r\\n."
 129.312 +  [^String s]
 129.313 +  (seq (.split #"\r?\n" s)))
 129.314 +
 129.315 +;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0
 129.316 +(defn ^String map-str
 129.317 +  "Apply f to each element of coll, concatenate all results into a
 129.318 +  String."
 129.319 +  [f coll]
 129.320 +  (apply str (map f coll)))
 129.321 +
 129.322 +;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0
 129.323 +(defn grep
 129.324 +  "Filters elements of coll by a regular expression.  The String
 129.325 +  representation (with str) of each element is tested with re-find."
 129.326 +  [re coll]
 129.327 +  (filter (fn [x] (re-find re (str x))) coll))
 129.328 +
 129.329 +(defn partial
 129.330 +  "Like clojure.core/partial for functions that take their primary
 129.331 +  argument first.
 129.332 +
 129.333 +  Takes a function f and its arguments, NOT INCLUDING the first
 129.334 +  argument.  Returns a new function whose first argument will be the
 129.335 +  first argument to f.
 129.336 +
 129.337 +  Example: (str-utils2/partial str-utils2/take 2)
 129.338 +           ;;=> (fn [s] (str-utils2/take s 2))"
 129.339 +  [f & args]
 129.340 +  (fn [s & more] (apply f s (concat args more))))
 129.341 +
 129.342 +
 129.343 +;;; WRAPPERS
 129.344 +
 129.345 +;; The following functions are simple wrappers around java.lang.String
 129.346 +;; functions.  They are included here for completeness, and for use
 129.347 +;; when mapping over a collection of strings.
 129.348 +
 129.349 +(defn ^String upper-case
 129.350 +  "Converts string to all upper-case."
 129.351 +  [^String s]
 129.352 +  (.toUpperCase s))
 129.353 +
 129.354 +(defn ^String lower-case
 129.355 +  "Converts string to all lower-case."
 129.356 +  [^String s]
 129.357 +  (.toLowerCase s))
 129.358 +
 129.359 +(defn split
 129.360 +  "Splits string on a regular expression.  Optional argument limit is
 129.361 +  the maximum number of splits."
 129.362 +  ([^String s ^Pattern re] (seq (.split re s)))
 129.363 +  ([^String s ^Pattern re limit] (seq (.split re s limit))))
 129.364 +
 129.365 +(defn ^String trim
 129.366 +  "Removes whitespace from both ends of string."
 129.367 +  [^String s]
 129.368 +  (.trim s))
 129.369 +
 129.370 +(defn ^String contains?
 129.371 +  "True if s contains the substring."
 129.372 +  [^String s substring]
 129.373 +  (.contains s substring))
 129.374 +
 129.375 +(defn ^String get
 129.376 +  "Gets the i'th character in string."
 129.377 +  [^String s i]
 129.378 +  (.charAt s i))
 129.379 +
   130.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   130.2 +++ b/src/clojure/contrib/stream_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   130.3 @@ -0,0 +1,276 @@
   130.4 +;; Stream utilities
   130.5 +
   130.6 +;; by Konrad Hinsen
   130.7 +;; last updated May 3, 2009
   130.8 +
   130.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
  130.10 +;; and distribution terms for this software are covered by the Eclipse
  130.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  130.12 +;; which can be found in the file epl-v10.html at the root of this
  130.13 +;; distribution.  By using this software in any fashion, you are
  130.14 +;; agreeing to be bound by the terms of this license.  You must not
  130.15 +;; remove this notice, or any other, from this software.
  130.16 +
  130.17 +(ns
  130.18 +  ^{:author "Konrad Hinsen"
  130.19 +     :doc "Functions for setting up computational pipelines via data streams.
  130.20 +
  130.21 +           NOTE: This library is experimental. It may change significantly
  130.22 +                 with future release.
  130.23 +
  130.24 +           This library defines:
  130.25 +           - an abstract stream type, whose interface consists of the
  130.26 +             multimethod stream-next
  130.27 +           - a macro for implementing streams
  130.28 +           - implementations of stream for
  130.29 +             1) Clojure sequences, and vectors
  130.30 +             2) nil, representing an empty stream
  130.31 +           - tools for writing stream transformers, including the
  130.32 +             monad stream-m
  130.33 +           - various utility functions for working with streams
  130.34 +
  130.35 +           Streams are building blocks in the construction of computational
  130.36 +           pipelines. A stream is represented by its current state plus
  130.37 +           a function that takes a stream state and obtains the next item
  130.38 +           in the stream as well as the new stream state. The state is
  130.39 +           implemented as a Java class or a Clojure type (as defined by the
  130.40 +           function clojure.core/type), and the function is provided as an
  130.41 +           implementation of the multimethod stream-next for this class or type.
  130.42 +
  130.43 +           While setting up pipelines using this mechanism is somewhat more
  130.44 +           cumbersome than using Clojure's lazy seq mechanisms, there are a
  130.45 +           few advantages:
  130.46 +           - The state of a stream can be stored in any Clojure data structure,
  130.47 +             and the stream can be re-generated from it any number of times.
  130.48 +             Any number of states can be stored this way.
  130.49 +           - The elements of the stream are never cached, so keeping a reference
  130.50 +             to a stream state does not incur an uncontrollable memory penalty.
  130.51 +
  130.52 +           Note that the stream mechanism is thread-safe as long as the
  130.53 +           concrete stream implementations do not use any mutable state.
  130.54 +
  130.55 +           Stream transformers take any number of input streams and produce one
  130.56 +           output stream. They are typically written using the stream-m
  130.57 +           monad. In the definition of a stream transformer, (pick s) returns
  130.58 +           the next value of stream argument s, whereas pick-all returns the
  130.59 +           next value of all stream arguments in the form of a vector."}
  130.60 +  clojure.contrib.stream-utils
  130.61 +  (:refer-clojure :exclude (deftype))
  130.62 +  (:use [clojure.contrib.types :only (deftype deftype-)])
  130.63 +  (:use [clojure.contrib.monads :only (defmonad with-monad)])
  130.64 +  (:use [clojure.contrib.def :only (defvar defvar-)])
  130.65 +  (:require [clojure.contrib.seq])
  130.66 +  (:require [clojure.contrib.generic.collection]))
  130.67 +
  130.68 +
  130.69 +;
  130.70 +; Stream type and interface
  130.71 +;
  130.72 +(defvar stream-type ::stream
  130.73 +  "The root type for the stream hierarchy. For each stream type,
  130.74 +   add a derivation from this type.")
  130.75 +
  130.76 +(defmacro defstream
  130.77 +  "Define object of the given type as a stream whose implementation
  130.78 +   of stream-next is defined by args and body. This macro adds
  130.79 +   a type-specific method for stream-next and derives type
  130.80 +   from stream-type."
  130.81 +  [type-tag args & body]
  130.82 +  `(do
  130.83 +     (derive ~type-tag stream-type)
  130.84 +     (defmethod stream-next ~type-tag ~args ~@body)))
  130.85 +
  130.86 +(defvar- stream-skip ::skip
  130.87 +  "The skip-this-item value.")
  130.88 +
  130.89 +(defn- stream-skip?
  130.90 +  "Returns true if x is the stream-skip."
  130.91 +  [x]
  130.92 +  (identical? x stream-skip))
  130.93 +
  130.94 +(defmulti stream-next
  130.95 +  "Returns a vector [next-value new-state] where next-value is the next
  130.96 +   item in the data stream defined by stream-state and new-state
  130.97 +   is the new state of the stream. At the end of the stream,
  130.98 +   next-value and new-state are nil."
  130.99 +  {:arglists '([stream-state])}
 130.100 +  type)
 130.101 +
 130.102 +(defmethod stream-next nil
 130.103 +  [s]
 130.104 +  [nil nil])
 130.105 +
 130.106 +(defmethod stream-next clojure.lang.ISeq
 130.107 +  [s]
 130.108 +  (if (seq s)
 130.109 +    [(first s) (rest s)]
 130.110 +    [nil nil]))
 130.111 +
 130.112 +(defmethod stream-next clojure.lang.IPersistentVector
 130.113 +  [v]
 130.114 +  (stream-next (seq v)))
 130.115 +
 130.116 +(defn stream-seq
 130.117 +  "Return a lazy seq on the stream. Also accessible via
 130.118 +   clojure.contrib.seq/seq-on and
 130.119 +   clojure.contrib.generic.collection/seq for streams."
 130.120 +  [s]
 130.121 +  (lazy-seq
 130.122 +   (let [[v ns] (stream-next s)]
 130.123 +     (if (nil? ns)
 130.124 +       nil
 130.125 +       (cons v (stream-seq ns))))))
 130.126 +
 130.127 +(defmethod clojure.contrib.seq/seq-on stream-type
 130.128 +  [s]
 130.129 +  (stream-seq s))
 130.130 +
 130.131 +(defmethod clojure.contrib.generic.collection/seq stream-type
 130.132 +  [s]
 130.133 +  (stream-seq s))
 130.134 +
 130.135 +;
 130.136 +; Stream transformers
 130.137 +;
 130.138 +(defmonad stream-m
 130.139 +  "Monad describing stream computations. The monadic values can be
 130.140 +   of any type handled by stream-next."
 130.141 +  [m-result  (fn m-result-stream [v]
 130.142 +	       (fn [s] [v s]))
 130.143 +   m-bind    (fn m-bind-stream [mv f]
 130.144 +	       (fn [s]
 130.145 +		 (let [[v ss :as r] (mv s)]
 130.146 +		   (if (or (nil? ss) (stream-skip? v))
 130.147 +		     r
 130.148 +		     ((f v) ss)))))
 130.149 +   m-zero     (fn [s] [stream-skip s])
 130.150 +   ])
 130.151 +
 130.152 +(defn pick
 130.153 +  "Return the next value of stream argument n inside a stream
 130.154 +   transformer. When used inside of defst, the name of the stream
 130.155 +   argument can be used instead of its index n."
 130.156 +  [n]
 130.157 +  (fn [streams]
 130.158 +    (let [[v ns] (stream-next (streams n))]
 130.159 +      (if (nil? ns)
 130.160 +	[nil nil]
 130.161 +	[v (assoc streams n ns)]))))
 130.162 +
 130.163 +(defn pick-all
 130.164 +  "Return a vector containing the next value of each stream argument
 130.165 +   inside a stream transformer."
 130.166 +  [streams]
 130.167 +  (let [next    (map stream-next streams)
 130.168 +	values  (map first next)
 130.169 +	streams (vec (map second next))]
 130.170 +    (if (some nil? streams)
 130.171 +      [nil nil]
 130.172 +      [values streams])))
 130.173 +
 130.174 +(deftype ::stream-transformer st-as-stream
 130.175 +  (fn [st streams] [st streams])
 130.176 +  seq)
 130.177 +
 130.178 +(defstream ::stream-transformer
 130.179 +  [[st streams]]
 130.180 +  (loop [s streams]
 130.181 +    (let [[v ns] (st s)]
 130.182 +      (cond (nil? ns) [nil nil]
 130.183 +	    (stream-skip? v) (recur ns)
 130.184 +	    :else [v (st-as-stream st ns)]))))
 130.185 +
 130.186 +(defmacro defst
 130.187 +  "Define the stream transformer name by body.
 130.188 +   The non-stream arguments args and the stream arguments streams
 130.189 +   are given separately, with args being possibly empty."
 130.190 +  [name args streams & body]
 130.191 +  (if (= (first streams) '&)
 130.192 +    `(defn ~name ~(vec (concat args streams))
 130.193 +       (let [~'st (with-monad stream-m ~@body)]
 130.194 +	 (st-as-stream ~'st ~(second streams))))
 130.195 +    `(defn ~name ~(vec (concat args streams))
 130.196 +       (let [~'st (with-monad stream-m
 130.197 +		    (let [~streams (range ~(count streams))]
 130.198 +		      ~@body))]
 130.199 +	 (st-as-stream ~'st ~streams)))))
 130.200 +
 130.201 +;
 130.202 +; Stream utilities
 130.203 +;
 130.204 +(defn stream-drop
 130.205 +  "Return a stream containing all but the first n elements of stream."
 130.206 +  [n stream]
 130.207 +  (if (zero? n)
 130.208 +    stream
 130.209 +    (let [[_ s] (stream-next stream)]
 130.210 +      (recur (dec n) s))))
 130.211 +
 130.212 +; Map a function on a stream
 130.213 +(deftype- ::stream-map stream-map-state)
 130.214 +
 130.215 +(defstream ::stream-map
 130.216 +  [[f stream]]
 130.217 +  (let [[v ns] (stream-next stream)]
 130.218 +    (if (nil? ns)
 130.219 +      [nil nil]
 130.220 +      [(f v) (stream-map-state [f ns])])))
 130.221 +
 130.222 +(defmulti stream-map
 130.223 +  "Return a new stream by mapping the function f on the given stream."
 130.224 +  {:arglists '([f stream])}
 130.225 +  (fn [f stream] (type stream)))
 130.226 +
 130.227 +(defmethod stream-map :default
 130.228 +  [f stream]
 130.229 +  (stream-map-state [f stream]))
 130.230 +
 130.231 +(defmethod stream-map ::stream-map
 130.232 +  [f [g stream]]
 130.233 +  (stream-map-state [(comp f g) stream]))
 130.234 +
 130.235 +; Filter stream elements
 130.236 +(deftype- ::stream-filter stream-filter-state)
 130.237 +
 130.238 +(defstream ::stream-filter
 130.239 +  [[p stream]]
 130.240 +  (loop [stream stream]
 130.241 +    (let [[v ns] (stream-next stream)]
 130.242 +      (cond (nil? ns) [nil nil]
 130.243 +	    (p v) [v (stream-filter-state [p ns])]
 130.244 +	    :else (recur ns)))))
 130.245 +
 130.246 +(defmulti stream-filter
 130.247 +  "Return a new stream that contrains the elements of stream
 130.248 +   that satisfy the predicate p."
 130.249 +  {:arglists '([p stream])}
 130.250 +  (fn [p stream] (type stream)))
 130.251 +
 130.252 +(defmethod stream-filter :default
 130.253 +  [p stream]
 130.254 +  (stream-filter-state [p stream]))
 130.255 +
 130.256 +(defmethod stream-filter ::stream-filter
 130.257 +  [p [q stream]]
 130.258 +  (stream-filter-state [(fn [v] (and (q v) (p v))) stream]))
 130.259 +
 130.260 +; Flatten a stream of sequences
 130.261 +(deftype- ::stream-flatten stream-flatten-state)
 130.262 +
 130.263 +(defstream ::stream-flatten
 130.264 +  [[buffer stream]]
 130.265 +  (loop [buffer buffer
 130.266 +  	 stream stream]
 130.267 +    (if (nil? buffer)
 130.268 +      (let [[v new-stream] (stream-next stream)]
 130.269 +  	(cond (nil? new-stream) [nil nil]
 130.270 +  	      (empty? v) (recur nil new-stream)
 130.271 +  	      :else (recur v new-stream)))
 130.272 +      [(first buffer) (stream-flatten-state [(next buffer) stream])])))
 130.273 +
 130.274 +(defn stream-flatten
 130.275 +  "Converts a stream of sequences into a stream of the elements of the
 130.276 +   sequences. Flattening is not recursive, only one level of nesting
 130.277 +   will be removed."
 130.278 +  [s]
 130.279 +  (stream-flatten-state [nil s]))
   131.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   131.2 +++ b/src/clojure/contrib/string.clj	Sat Aug 21 06:25:44 2010 -0400
   131.3 @@ -0,0 +1,382 @@
   131.4 +;;; string.clj -- functional string utilities for Clojure
   131.5 +
   131.6 +;; by Stuart Sierra, http://stuartsierra.com/
   131.7 +;; January 26, 2010
   131.8 +
   131.9 +;; Copyright (c) Stuart Sierra, 2010. All rights reserved.  The use
  131.10 +;; and distribution terms for this software are covered by the Eclipse
  131.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  131.12 +;; which can be found in the file epl-v10.html at the root of this
  131.13 +;; distribution.  By using this software in any fashion, you are
  131.14 +;; agreeing to be bound by the terms of this license.  You must not
  131.15 +;; remove this notice, or any other, from this software.
  131.16 +
  131.17 +;; DEPRECATED in 1.2: Many functions have moved to clojure.string.
  131.18 +
  131.19 +(ns ^{:author "Stuart Sierra"
  131.20 +       :doc "This is a library of string manipulation functions.  It
  131.21 +    is intented as a replacement for clojure.contrib.string.
  131.22 +
  131.23 +    You cannot (use 'clojure.contrib.string) because it defines
  131.24 +    functions with the same names as functions in clojure.core.
  131.25 +    Instead, do (require '[clojure.contrib.string :as s]) 
  131.26 +    or something similar.
  131.27 +
  131.28 +    Goals:
  131.29 +      1. Be functional
  131.30 +      2. Most significant argument LAST, to work with ->>
  131.31 +      3. At least O(n) performance for Strings of length n
  131.32 +
  131.33 +    Some ideas are borrowed from
  131.34 +    http://github.com/francoisdevlin/devlinsf-clojure-utils/"}
  131.35 + clojure.contrib.string
  131.36 + (:refer-clojure :exclude (take replace drop butlast partition
  131.37 +                           contains? get repeat reverse partial))
  131.38 + (:import (java.util.regex Pattern)))
  131.39 +
  131.40 +
  131.41 +(defmacro dochars 
  131.42 +  "bindings => [name string]
  131.43 +
  131.44 +  Repeatedly executes body, with name bound to each character in
  131.45 +  string.  Does NOT handle Unicode supplementary characters (above
  131.46 +  U+FFFF)."
  131.47 +  [bindings & body]
  131.48 +  (assert (vector bindings))
  131.49 +  (assert (= 2 (count bindings)))
  131.50 +  ;; This seems to be the fastest way to iterate over characters.
  131.51 +  `(let [^String s# ~(second bindings)]
  131.52 +     (dotimes [i# (.length s#)]
  131.53 +       (let [~(first bindings) (.charAt s# i#)]
  131.54 +         ~@body))))
  131.55 +
  131.56 +
  131.57 +(defmacro docodepoints
  131.58 +  "bindings => [name string]
  131.59 +
  131.60 +  Repeatedly executes body, with name bound to the integer code point
  131.61 +  of each Unicode character in the string.  Handles Unicode
  131.62 +  supplementary characters (above U+FFFF) correctly."
  131.63 +  [bindings & body]
  131.64 +  (assert (vector bindings))
  131.65 +  (assert (= 2 (count bindings)))
  131.66 +  (let [character (first bindings)
  131.67 +        string (second bindings)]
  131.68 +    `(let [^String s# ~string
  131.69 +           len# (.length s#)]
  131.70 +       (loop [i# 0]
  131.71 +         (when (< i# len#)
  131.72 +           (let [~character (.charAt s# i#)]
  131.73 +             (if (Character/isHighSurrogate ~character)
  131.74 +               (let [~character (.codePointAt s# i#)]
  131.75 +                 ~@body
  131.76 +                 (recur (+ 2 i#)))
  131.77 +               (let [~character (int ~character)]
  131.78 +                 ~@body
  131.79 +                 (recur (inc i#))))))))))
  131.80 +
  131.81 +(defn codepoints
  131.82 +  "Returns a sequence of integer Unicode code points in s.  Handles
  131.83 +  Unicode supplementary characters (above U+FFFF) correctly."
  131.84 +  [^String s]
  131.85 +  (let [len (.length s)
  131.86 +        f (fn thisfn [^String s i]
  131.87 +            (when (< i len)
  131.88 +              (let [c (.charAt s i)]
  131.89 +                (if (Character/isHighSurrogate c)
  131.90 +                  (cons (.codePointAt s i) (thisfn s (+ 2 i)))
  131.91 +                  (cons (int c) (thisfn s (inc i)))))))]
  131.92 +    (lazy-seq (f s 0))))
  131.93 +
  131.94 +(defn ^String escape
  131.95 +  "Returns a new String by applying cmap (a function or a map) to each
  131.96 +   character in s.  If cmap returns nil, the original character is
  131.97 +   added to the output unchanged."
  131.98 +   {:deprecated "1.2"}
  131.99 +  [cmap ^String s]
 131.100 +  (let [buffer (StringBuilder. (.length s))]
 131.101 +    (dochars [c s]
 131.102 +      (if-let [r (cmap c)]
 131.103 +        (.append buffer r)
 131.104 +        (.append buffer c)))
 131.105 +    (.toString buffer)))
 131.106 +
 131.107 +(defn blank?
 131.108 +  "True if s is nil, empty, or contains only whitespace."
 131.109 +  {:deprecated "1.2"}
 131.110 +  [^String s]
 131.111 +  (every? (fn [^Character c] (Character/isWhitespace c)) s))
 131.112 +
 131.113 +(defn ^String take
 131.114 +  "Take first n characters from s, up to the length of s."
 131.115 +  [n ^String s]
 131.116 +  (if (< (count s) n)
 131.117 +    s
 131.118 +    (.substring s 0 n)))
 131.119 +
 131.120 +(defn ^String drop
 131.121 +  "Drops first n characters from s.  Returns an empty string if n is
 131.122 +  greater than the length of s."
 131.123 +  [n ^String s]
 131.124 +  (if (< (count s) n)
 131.125 +    ""
 131.126 +    (.substring s n)))
 131.127 +
 131.128 +(defn ^String butlast
 131.129 +  "Returns s without the last n characters.  Returns an empty string
 131.130 +  if n is greater than the length of s."
 131.131 +  [n ^String s]
 131.132 +  (if (< (count s) n)
 131.133 +    ""
 131.134 +    (.substring s 0 (- (count s) n))))
 131.135 +
 131.136 +(defn ^String tail
 131.137 +  "Returns the last n characters of s."
 131.138 +  [n ^String s]
 131.139 +  (if (< (count s) n)
 131.140 +    s
 131.141 +    (.substring s (- (count s) n))))
 131.142 +
 131.143 +(defn ^String repeat
 131.144 +  "Returns a new String containing s repeated n times."
 131.145 +  [n ^String s]
 131.146 +  (apply str (clojure.core/repeat n s)))
 131.147 +
 131.148 +(defn ^String reverse
 131.149 +  "Returns s with its characters reversed."
 131.150 +  {:deprecated "1.2"}
 131.151 +  [^String s]
 131.152 +  (.toString (.reverse (StringBuilder. s))))
 131.153 +
 131.154 +(defn replace-str
 131.155 +  "Replaces all instances of substring a with b in s."
 131.156 +  {:deprecated "1.2"}
 131.157 +  [^String a ^String b ^String s]
 131.158 +  (.replace s a b))
 131.159 +
 131.160 +(defn replace-char
 131.161 +  "Replaces all instances of character a with character b in s."
 131.162 +  {:deprecated "1.2"}
 131.163 +  [^Character a ^Character b ^String s]
 131.164 +  (.replace s a b))
 131.165 +
 131.166 +(defn replace-re
 131.167 +  "Replaces all matches of re with replacement in s."
 131.168 +  {:deprecated "1.2"}
 131.169 +  [re replacement ^String s]
 131.170 +  (.replaceAll (re-matcher re s) replacement))
 131.171 +
 131.172 +(defn replace-by
 131.173 +  "Replaces all matches of re in s with the result of 
 131.174 +  (f (re-groups the-match))."
 131.175 +  {:deprecated "1.2"}
 131.176 +  [re f ^String s]
 131.177 +  (let [m (re-matcher re s)]
 131.178 +    (let [buffer (StringBuffer. (.length s))]
 131.179 +      (loop []
 131.180 +        (if (.find m)
 131.181 +          (do (.appendReplacement m buffer (f (re-groups m)))
 131.182 +              (recur))
 131.183 +          (do (.appendTail m buffer)
 131.184 +              (.toString buffer)))))))
 131.185 +
 131.186 +(defn replace-first-str
 131.187 +  "Replace first occurance of substring a with b in s."
 131.188 +  {:deprecated "1.2"}
 131.189 +  [^String a ^String b ^String s]
 131.190 +  (.replaceFirst (re-matcher (Pattern/quote a) s) b))
 131.191 +
 131.192 +(defn replace-first-re
 131.193 +  "Replace first match of re in s."
 131.194 +  {:deprecated "1.2"}
 131.195 +  [^Pattern re ^String replacement ^String s]
 131.196 +  (.replaceFirst (re-matcher re s) replacement))
 131.197 +
 131.198 +(defn replace-first-by
 131.199 +  "Replace first match of re in s with the result of
 131.200 +  (f (re-groups the-match))."
 131.201 +  {:deprecated "1.2"}
 131.202 +  [^Pattern re f ^String s]
 131.203 +  (let [m (re-matcher re s)]
 131.204 +    (let [buffer (StringBuffer.)]
 131.205 +      (if (.find m)
 131.206 +        (let [rep (f (re-groups m))]
 131.207 +          (.appendReplacement m buffer rep)
 131.208 +          (.appendTail m buffer)
 131.209 +          (str buffer))))))
 131.210 +
 131.211 +(defn partition
 131.212 +  "Splits the string into a lazy sequence of substrings, alternating
 131.213 +  between substrings that match the patthern and the substrings
 131.214 +  between the matches.  The sequence always starts with the substring
 131.215 +  before the first match, or an empty string if the beginning of the
 131.216 +  string matches.
 131.217 +
 131.218 +  For example: (partition #\"[a-z]+\" \"abc123def\")
 131.219 +  returns: (\"\" \"abc\" \"123\" \"def\")"
 131.220 +  [^Pattern re ^String s]
 131.221 +  (let [m (re-matcher re s)]
 131.222 +    ((fn step [prevend]
 131.223 +       (lazy-seq
 131.224 +        (if (.find m)
 131.225 +          (cons (.subSequence s prevend (.start m))
 131.226 +                (cons (re-groups m)
 131.227 +                      (step (+ (.start m) (count (.group m))))))
 131.228 +          (when (< prevend (.length s))
 131.229 +            (list (.subSequence s prevend (.length s)))))))
 131.230 +     0)))
 131.231 +
 131.232 +(defn ^String join
 131.233 +  "Returns a string of all elements in coll, separated by
 131.234 +  separator.  Like Perl's join."
 131.235 +  {:deprecated "1.2"}
 131.236 +  [^String separator coll]
 131.237 +  (apply str (interpose separator coll)))
 131.238 +
 131.239 +(defn ^String chop
 131.240 +  "Removes the last character of string, does nothing on a zero-length
 131.241 +  string."
 131.242 +  [^String s]
 131.243 +  (let [size (count s)]
 131.244 +    (if (zero? size)
 131.245 +      s
 131.246 +      (subs s 0 (dec (count s))))))
 131.247 +
 131.248 +(defn ^String chomp
 131.249 +  "Removes all trailing newline \\n or return \\r characters from
 131.250 +  string.  Note: String.trim() is similar and faster.
 131.251 +  Deprecated in 1.2. Use clojure.string/trim-newline"
 131.252 +  {:deprecated "1.2"}
 131.253 +  [^String s]
 131.254 +  (replace-re #"[\r\n]+$" "" s))
 131.255 +
 131.256 +(defn ^String swap-case
 131.257 +  "Changes upper case characters to lower case and vice-versa.
 131.258 +  Handles Unicode supplementary characters correctly.  Uses the
 131.259 +  locale-sensitive String.toUpperCase() and String.toLowerCase()
 131.260 +  methods."
 131.261 +  [^String s]
 131.262 +  (let [buffer (StringBuilder. (.length s))
 131.263 +        ;; array to make a String from one code point
 131.264 +        ^"[I" array (make-array Integer/TYPE 1)]
 131.265 +    (docodepoints [c s]
 131.266 +      (aset-int array 0 c)
 131.267 +      (if (Character/isLowerCase c)
 131.268 +        ;; Character.toUpperCase is not locale-sensitive, but
 131.269 +        ;; String.toUpperCase is; so we use a String.
 131.270 +        (.append buffer (.toUpperCase (String. array 0 1)))
 131.271 +        (.append buffer (.toLowerCase (String. array 0 1)))))
 131.272 +    (.toString buffer)))
 131.273 +
 131.274 +(defn ^String capitalize
 131.275 +  "Converts first character of the string to upper-case, all other
 131.276 +  characters to lower-case."
 131.277 +  {:deprecated "1.2"}
 131.278 +  [^String s]
 131.279 +  (if (< (count s) 2)
 131.280 +    (.toUpperCase s)
 131.281 +    (str (.toUpperCase ^String (subs s 0 1))
 131.282 +         (.toLowerCase ^String (subs s 1)))))
 131.283 +
 131.284 +(defn ^String ltrim
 131.285 +  "Removes whitespace from the left side of string.
 131.286 +   Deprecated in 1.2. Use clojure.string/triml."
 131.287 +  {:deprecated "1.2"}
 131.288 +  [^String s]
 131.289 +  (replace-re #"^\s+" "" s))
 131.290 +
 131.291 +(defn ^String rtrim
 131.292 +  "Removes whitespace from the right side of string.
 131.293 +   Deprecated in 1.2. Use clojure.string/trimr."
 131.294 +  {:deprecated "1.2"}
 131.295 +  [^String s]
 131.296 +  (replace-re #"\s+$" "" s))
 131.297 +
 131.298 +(defn split-lines
 131.299 +  "Splits s on \\n or \\r\\n."
 131.300 +  {:deprecated "1.2"}
 131.301 +  [^String s]
 131.302 +  (seq (.split #"\r?\n" s)))
 131.303 +
 131.304 +;; borrowed from compojure.string, by James Reeves, EPL 1.0
 131.305 +(defn ^String map-str
 131.306 +  "Apply f to each element of coll, concatenate all results into a
 131.307 +  String."
 131.308 +  [f coll]
 131.309 +  (apply str (map f coll)))
 131.310 +
 131.311 +;; borrowed from compojure.string, by James Reeves, EPL 1.0
 131.312 +(defn grep
 131.313 +  "Filters elements of coll by a regular expression.  The String
 131.314 +  representation (with str) of each element is tested with re-find."
 131.315 +  [re coll]
 131.316 +  (filter (fn [x] (re-find re (str x))) coll))
 131.317 +
 131.318 +(defn as-str
 131.319 +  "Like clojure.core/str, but if an argument is a keyword or symbol,
 131.320 +  its name will be used instead of its literal representation.
 131.321 +
 131.322 +  Example:
 131.323 +     (str :foo :bar)     ;;=> \":foo:bar\"
 131.324 +     (as-str :foo :bar)  ;;=> \"foobar\" 
 131.325 +
 131.326 +  Note that this does not apply to keywords or symbols nested within
 131.327 +  data structures; they will be rendered as with str.
 131.328 +
 131.329 +  Example:
 131.330 +     (str {:foo :bar})     ;;=> \"{:foo :bar}\"
 131.331 +     (as-str {:foo :bar})  ;;=> \"{:foo :bar}\" "
 131.332 +  ([] "")
 131.333 +  ([x] (if (instance? clojure.lang.Named x)
 131.334 +         (name x)
 131.335 +         (str x)))
 131.336 +  ([x & ys]
 131.337 +     ((fn [^StringBuilder sb more]
 131.338 +        (if more
 131.339 +          (recur (. sb  (append (as-str (first more)))) (next more))
 131.340 +          (str sb)))
 131.341 +      (new StringBuilder ^String (as-str x)) ys)))
 131.342 +
 131.343 +
 131.344 +;;; WRAPPERS
 131.345 +
 131.346 +;; The following functions are simple wrappers around java.lang.String
 131.347 +;; functions.  They are included here for completeness, and for use
 131.348 +;; when mapping over a collection of strings.
 131.349 +
 131.350 +(defn ^String upper-case
 131.351 +  "Converts string to all upper-case."
 131.352 +  {:deprecated "1.2"}
 131.353 +  [^String s]
 131.354 +  (.toUpperCase s))
 131.355 +
 131.356 +(defn ^String lower-case
 131.357 +  "Converts string to all lower-case."
 131.358 +  {:deprecated "1.2"}
 131.359 +  [^String s]
 131.360 +  (.toLowerCase s))
 131.361 +
 131.362 +(defn split
 131.363 +  "Splits string on a regular expression.  Optional argument limit is
 131.364 +  the maximum number of splits."
 131.365 +  {:deprecated "1.2"}
 131.366 +  ([^Pattern re ^String s] (seq (.split re s)))
 131.367 +  ([^Pattern re limit ^String s] (seq (.split re s limit))))
 131.368 +
 131.369 +(defn ^String trim
 131.370 +  "Removes whitespace from both ends of string."
 131.371 +  {:deprecated "1.2"}
 131.372 +  [^String s]
 131.373 +  (.trim s))
 131.374 +
 131.375 +(defn ^String substring?
 131.376 +  "True if s contains the substring."
 131.377 +  [substring ^String s]
 131.378 +  (.contains s substring))
 131.379 +
 131.380 +(defn ^String get
 131.381 +  "Gets the i'th character in string."
 131.382 +  {:deprecated "1.2"}
 131.383 +  [^String s i]
 131.384 +  (.charAt s i))
 131.385 +
   132.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   132.2 +++ b/src/clojure/contrib/strint.clj	Sat Aug 21 06:25:44 2010 -0400
   132.3 @@ -0,0 +1,72 @@
   132.4 +;;; strint.clj -- String interpolation for Clojure
   132.5 +;; originally proposed/published at http://muckandbrass.com/web/x/AgBP
   132.6 +
   132.7 +;; by Chas Emerick <cemerick@snowtide.com>
   132.8 +;; December 4, 2009
   132.9 +
  132.10 +;; Copyright (c) Chas Emerick, 2009. All rights reserved.  The use
  132.11 +;; and distribution terms for this software are covered by the Eclipse
  132.12 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  132.13 +;; which can be found in the file epl-v10.html at the root of this
  132.14 +;; distribution.  By using this software in any fashion, you are
  132.15 +;; agreeing to be bound by the terms of this license.  You must not
  132.16 +;; remove this notice, or any other, from this software.
  132.17 +
  132.18 +(ns
  132.19 +  ^{:author "Chas Emerick",
  132.20 +     :doc "String interpolation for Clojure."}
  132.21 +  clojure.contrib.strint)
  132.22 +
  132.23 +(defn- silent-read
  132.24 +  "Attempts to clojure.core/read a single form from the provided String, returning
  132.25 +   a vector containing the read form and a String containing the unread remainder
  132.26 +   of the provided String.  Returns nil if no valid form can be read from the
  132.27 +   head of the String."
  132.28 +  [s]
  132.29 +  (try
  132.30 +    (let [r (-> s java.io.StringReader. java.io.PushbackReader.)]
  132.31 +      [(read r) (slurp r)])
  132.32 +    (catch Exception e))) ; this indicates an invalid form -- the head of s is just string data
  132.33 +
  132.34 +(defn- interpolate
  132.35 +  "Yields a seq of Strings and read forms."
  132.36 +  ([s atom?]
  132.37 +    (lazy-seq
  132.38 +      (if-let [[form rest] (silent-read (subs s (if atom? 2 1)))]
  132.39 +        (cons form (interpolate (if atom? (subs rest 1) rest)))
  132.40 +        (cons (subs s 0 2) (interpolate (subs s 2))))))
  132.41 +  ([^String s]
  132.42 +    (if-let [start (->> ["~{" "~("]
  132.43 +                     (map #(.indexOf s %))
  132.44 +                     (remove #(== -1 %))
  132.45 +                     sort
  132.46 +                     first)]
  132.47 +      (lazy-seq (cons
  132.48 +                  (subs s 0 start)
  132.49 +                  (interpolate (subs s start) (= \{ (.charAt s (inc start))))))
  132.50 +      [s])))
  132.51 +
  132.52 +(defmacro <<
  132.53 +  "Takes a single string argument and emits a str invocation that concatenates
  132.54 +   the string data and evaluated expressions contained within that argument.
  132.55 +   Evaluation is controlled using ~{} and ~() forms.  The former is used for
  132.56 +   simple value replacement using clojure.core/str; the latter can be used to
  132.57 +   embed the results of arbitrary function invocation into the produced string.
  132.58 +
  132.59 +   Examples:
  132.60 +   user=> (def v 30.5)
  132.61 +   #'user/v
  132.62 +   user=> (<< \"This trial required ~{v}ml of solution.\")
  132.63 +   \"This trial required 30.5ml of solution.\"
  132.64 +   user=> (<< \"There are ~(int v) days in November.\")
  132.65 +   \"There are 30 days in November.\"
  132.66 +   user=> (def m {:a [1 2 3]})
  132.67 +   #'user/m
  132.68 +   user=> (<< \"The total for your order is $~(->> m :a (apply +)).\")
  132.69 +   \"The total for your order is $6.\"
  132.70 +
  132.71 +   Note that quotes surrounding string literals within ~() forms must be
  132.72 +   escaped."
  132.73 +  [string]
  132.74 +  `(str ~@(interpolate string)))
  132.75 +
   133.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   133.2 +++ b/src/clojure/contrib/swing_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   133.3 @@ -0,0 +1,152 @@
   133.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   133.5 +;;  distribution terms for this software are covered by the Eclipse Public
   133.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   133.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   133.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   133.9 +;;  terms of this license.  You must not remove this notice, or any other,
  133.10 +;;  from this software.
  133.11 +;;
  133.12 +;;  clojure.contrib.swing-utils
  133.13 +;;
  133.14 +;;  Useful functions for interfacing Clojure to Swing
  133.15 +;;
  133.16 +;;  scgilardi (gmail)
  133.17 +;;  Created 31 May 2009
  133.18 +
  133.19 +(ns clojure.contrib.swing-utils
  133.20 +  (:import (java.awt.event ActionListener KeyAdapter)
  133.21 +           (javax.swing AbstractAction Action 
  133.22 +                        JMenu JMenuBar JMenuItem
  133.23 +                        SwingUtilities))
  133.24 +  (:use [clojure.contrib.def :only (defvar)]))
  133.25 +
  133.26 +(defn add-action-listener
  133.27 +  "Adds an ActionLister to component. When the action fires, f will be
  133.28 +  invoked with the event as its first argument followed by args.
  133.29 +  Returns the listener."
  133.30 +  [component f & args]
  133.31 +  (let [listener (proxy [ActionListener] []
  133.32 +                   (actionPerformed [event] (apply f event args)))]
  133.33 +    (.addActionListener component listener)
  133.34 +    listener))
  133.35 +
  133.36 +(defn add-key-typed-listener
  133.37 +  "Adds a KeyListener to component that only responds to KeyTyped events.
  133.38 +  When a key is typed, f is invoked with the KeyEvent as its first argument
  133.39 +  followed by args. Returns the listener."
  133.40 +  [component f & args]
  133.41 +  (let [listener (proxy [KeyAdapter] []
  133.42 +                   (keyTyped [event] (apply f event args)))]
  133.43 +    (.addKeyListener component listener)
  133.44 +    listener))
  133.45 +
  133.46 +;; ----------------------------------------------------------------------
  133.47 +;; Meikel Brandmeyer
  133.48 +
  133.49 +(defn do-swing*
  133.50 +  "Runs thunk in the Swing event thread according to schedule:
  133.51 +    - :later => schedule the execution and return immediately
  133.52 +    - :now   => wait until the execution completes."
  133.53 +  [schedule thunk]
  133.54 +  (cond
  133.55 +   (= schedule :later) (SwingUtilities/invokeLater thunk)
  133.56 +   (= schedule :now) (if (SwingUtilities/isEventDispatchThread)
  133.57 +                       (thunk)
  133.58 +                       (SwingUtilities/invokeAndWait thunk)))
  133.59 +  nil)
  133.60 +
  133.61 +(defmacro do-swing
  133.62 +  "Executes body in the Swing event thread asynchronously. Returns
  133.63 +  immediately after scheduling the execution."
  133.64 +  [& body]
  133.65 +  `(do-swing* :later (fn [] ~@body)))
  133.66 +
  133.67 +(defmacro do-swing-and-wait
  133.68 +  "Executes body in the Swing event thread synchronously. Returns
  133.69 +  after the execution is complete."
  133.70 +  [& body]
  133.71 +  `(do-swing* :now (fn [] ~@body)))
  133.72 +
  133.73 +(defvar action-translation-table
  133.74 +  (atom {:name        Action/NAME
  133.75 +         :accelerator Action/ACCELERATOR_KEY
  133.76 +         :command-key Action/ACTION_COMMAND_KEY
  133.77 +         :long-desc   Action/LONG_DESCRIPTION
  133.78 +         :short-desc  Action/SHORT_DESCRIPTION
  133.79 +         :mnemonic    Action/MNEMONIC_KEY
  133.80 +         :icon        Action/SMALL_ICON})
  133.81 +  "Translation table for the make-action constructor.")
  133.82 +
  133.83 +(defn make-action
  133.84 +  "Create an Action proxy from the given action spec. The standard keys
  133.85 +  recognised are: :name, :accelerator, :command-key, :long-desc,
  133.86 +  :short-desc, :mnemonic and :icon - corresponding to the similar named
  133.87 +  Action properties.  The :handler value is used in the actionPerformed
  133.88 +  method of the proxy to pass on the event."
  133.89 +  [spec]
  133.90 +  (let [t-table @action-translation-table
  133.91 +        handler (:handler spec)
  133.92 +        spec    (dissoc spec :handler)
  133.93 +        spec    (map (fn [[k v]] [(t-table k) v]) spec)
  133.94 +        action  (proxy [AbstractAction] []
  133.95 +                  (actionPerformed [evt] (handler evt)))]
  133.96 +    (doseq [[k v] spec]
  133.97 +      (.putValue action k v))
  133.98 +    action))
  133.99 +
 133.100 +(defvar menu-constructor-dispatch
 133.101 +  (atom #{:action :handler :items})
 133.102 +  "An atom containing the dispatch set for the add-menu-item method.")
 133.103 +
 133.104 +(defmulti add-menu-item
 133.105 +  "Adds a menu item to the parent according to the item description.
 133.106 +   The item description is a map of the following structure.
 133.107 +
 133.108 + Either:
 133.109 +   - one single :action specifying a javax.swing.Action to be associated
 133.110 +     with the item.
 133.111 +   - a specification suitable for make-action
 133.112 +   - a set of :name, :mnemonic and :items keys, specifying a submenu with
 133.113 +     the given sequence of item entries.
 133.114 +   - an empty map specifying a separator."
 133.115 +  {:arglists '([parent item])}
 133.116 +  (fn add-menu-item-dispatch [_ item]
 133.117 +    (some @menu-constructor-dispatch (keys item))))
 133.118 +
 133.119 +(defmethod add-menu-item :action
 133.120 +  add-menu-item-action
 133.121 +  [parent {:keys [action]}]
 133.122 +  (let [item (JMenuItem. action)]
 133.123 +    (.add parent item)))
 133.124 +
 133.125 +(defmethod add-menu-item :handler
 133.126 +  add-menu-item-handler
 133.127 +  [parent spec]
 133.128 +  (add-menu-item parent {:action (make-action spec)}))
 133.129 +
 133.130 +(defmethod add-menu-item :items
 133.131 +  add-menu-item-submenu
 133.132 +  [parent {:keys [items mnemonic name]}]
 133.133 +  (let [menu (JMenu. name)]
 133.134 +    (when mnemonic
 133.135 +      (.setMnemonic menu mnemonic))
 133.136 +    (doseq [item items]
 133.137 +      (add-menu-item menu item))
 133.138 +    (.add parent menu)))
 133.139 +
 133.140 +(defmethod add-menu-item nil ; nil meaning separator
 133.141 +  add-menu-item-separator
 133.142 +  [parent _]
 133.143 +  (.addSeparator parent))
 133.144 +
 133.145 +(defn make-menubar
 133.146 +  "Create a menubar containing the given sequence of menu items. The menu
 133.147 +  items are described by a map as is detailed in the docstring of the
 133.148 +  add-menu-item function."
 133.149 +  [menubar-items]
 133.150 +  (let [menubar (JMenuBar.)]
 133.151 +    (doseq [item menubar-items]
 133.152 +      (add-menu-item menubar item))
 133.153 +    menubar))
 133.154 +
 133.155 +;; ----------------------------------------------------------------------
   134.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   134.2 +++ b/src/clojure/contrib/test_contrib/accumulators/examples.clj	Sat Aug 21 06:25:44 2010 -0400
   134.3 @@ -0,0 +1,93 @@
   134.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   134.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   134.6 +;;
   134.7 +;; Accumulator application examples
   134.8 +;;
   134.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  134.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  134.11 +
  134.12 +(ns
  134.13 +  #^{:author "Konrad Hinsen"
  134.14 +     :skip-wiki true
  134.15 +     :doc "Examples for using accumulators"}
  134.16 +  clojure.contrib.accumulators.examples
  134.17 +  (:use [clojure.contrib.accumulators
  134.18 +	 :only (combine add add-items
  134.19 +		empty-vector empty-list empty-queue empty-set empty-map
  134.20 +		empty-counter empty-counter-with-total
  134.21 +		empty-sum empty-product empty-maximum empty-minimum
  134.22 +		empty-min-max empty-mean-variance empty-string empty-tuple)]))
  134.23 +
  134.24 +; Vector accumulator: combine is concat, add is conj
  134.25 +(combine [:a :b] [:c :d] [:x :y])
  134.26 +(add [:a :b] :c)
  134.27 +(add-items empty-vector [:a :b :a])
  134.28 +
  134.29 +; List accumulator: combine is concat, add is conj
  134.30 +(combine '(:a :b) '(:c :d) '(:x :y))
  134.31 +(add '(:a :b) :c)
  134.32 +(add-items empty-list [:a :b :a])
  134.33 +
  134.34 +; Queue accumulator
  134.35 +(let [q1 (add-items empty-queue [:a :b :a])
  134.36 +      q2 (add-items empty-queue [:x :y])]
  134.37 +  (combine q1 q2))
  134.38 +
  134.39 +; Set accumulator: combine is union, add is conj
  134.40 +(combine #{:a :b} #{:c :d} #{:a :d})
  134.41 +(add #{:a :b} :c)
  134.42 +(add-items empty-set [:a :b :a])
  134.43 +
  134.44 +; Map accumulator: combine is merge, add is conj
  134.45 +(combine {:a 1} {:b 2 :c 3} {})
  134.46 +(add {:a 1} [:b 2])
  134.47 +(add-items empty-map [[:a 1] [:b 2] [:a 0]])
  134.48 +
  134.49 +; Counter accumulator
  134.50 +(let [c1 (add-items empty-counter [:a :b :a])
  134.51 +      c2 (add-items empty-counter [:x :y])]
  134.52 +  (combine c1 c2))
  134.53 +
  134.54 +; Counter-with-total accumulator
  134.55 +(let [c1 (add-items empty-counter-with-total [:a :b :a])
  134.56 +      c2 (add-items empty-counter-with-total [:x :y])]
  134.57 +  (combine c1 c2))
  134.58 +
  134.59 +; Sum accumulator: combine is addition
  134.60 +(let [s1 (add-items empty-sum [1 2 3])
  134.61 +      s2 (add-items empty-sum [-1 -2 -3])]
  134.62 +  (combine s1 s2))
  134.63 +
  134.64 +; Product accumulator: combine is multiplication
  134.65 +(let [p1 (add-items empty-product [2 3])
  134.66 +      p2 (add-items empty-product [(/ 1 2)])]
  134.67 +  (combine p1 p2))
  134.68 +
  134.69 +; Maximum accumulator: combine is max
  134.70 +(let [m1 (add-items empty-maximum [2 3])
  134.71 +      m2 (add-items empty-maximum [(/ 1 2)])]
  134.72 +  (combine m1 m2))
  134.73 +
  134.74 +; Minimum accumulator: combine is min
  134.75 +(let [m1 (add-items empty-minimum [2 3])
  134.76 +      m2 (add-items empty-minimum [(/ 1 2)])]
  134.77 +  (combine m1 m2))
  134.78 +
  134.79 +; Min-max accumulator: combination of minimum and maximum
  134.80 +(let [m1 (add-items empty-min-max [2 3])
  134.81 +      m2 (add-items empty-min-max [(/ 1 2)])]
  134.82 +  (combine m1 m2))
  134.83 +
  134.84 +; Mean-variance accumulator: sample mean and sample variance
  134.85 +(let [m1 (add-items empty-mean-variance [2 4])
  134.86 +      m2 (add-items empty-mean-variance [6])]
  134.87 +  (combine m1 m2))
  134.88 +
  134.89 +; String accumulator: combine is concatenation
  134.90 +(combine "a" "b" "c" "def")
  134.91 +(add "a" (char 44))
  134.92 +(add-items empty-string [(char 55) (char 56) (char 57)])
  134.93 +
  134.94 +; Accumulator tuples permit to update several accumulators in parallel
  134.95 +(let [pair (empty-tuple [empty-vector empty-string])]
  134.96 +  (add-items pair [[1 "a"] [2 "b"]]))
   135.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   135.2 +++ b/src/clojure/contrib/test_contrib/condition/example.clj	Sat Aug 21 06:25:44 2010 -0400
   135.3 @@ -0,0 +1,66 @@
   135.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   135.5 +;;  distribution terms for this software are covered by the Eclipse Public
   135.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   135.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   135.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   135.9 +;;  terms of this license.  You must not remove this notice, or any other,
  135.10 +;;  from this software.
  135.11 +;;
  135.12 +;;  clojure.contrib.condition.example.clj
  135.13 +;;
  135.14 +;;  scgilardi (gmail)
  135.15 +;;  Created 09 June 2009
  135.16 +
  135.17 +(ns clojure.contrib.condition.example
  135.18 +  (:use (clojure.contrib
  135.19 +         [condition
  135.20 +          :only (handler-case print-stack-trace raise *condition*)])))
  135.21 +
  135.22 +(defn func [x y]
  135.23 +  "Raises an exception if x is negative"
  135.24 +  (when (neg? x)
  135.25 +    (raise :type :illegal-argument :arg 'x :value x))
  135.26 +  (+ x y))
  135.27 +
  135.28 +(defn main
  135.29 +  []
  135.30 +  
  135.31 +  ;; simple handler
  135.32 +  
  135.33 +  (handler-case :type
  135.34 +    (println (func 3 4))
  135.35 +    (println (func -5 10))
  135.36 +    (handle :illegal-argument
  135.37 +            (print-stack-trace *condition*))
  135.38 +    (println 3))
  135.39 +
  135.40 +  ;; multiple handlers
  135.41 +  
  135.42 +  (handler-case :type
  135.43 +    (println (func 4 1))
  135.44 +    (println (func -3 22))
  135.45 +    (handle :overflow
  135.46 +      (print-stack-trace *condition*))
  135.47 +    (handle :illegal-argument
  135.48 +      (print-stack-trace *condition*)))
  135.49 +
  135.50 +  ;; nested handlers
  135.51 +
  135.52 +  (handler-case :type
  135.53 +    (handler-case :type
  135.54 +      nil
  135.55 +      nil
  135.56 +      (println 1)
  135.57 +      (println 2)
  135.58 +      (println 3)
  135.59 +      (println (func 8 2))
  135.60 +      (println (func -6 17))
  135.61 +      ;; no handler for :illegal-argument
  135.62 +      (handle :overflow
  135.63 +        (println "nested")
  135.64 +        (print-stack-trace *condition*)))
  135.65 +    (println (func 3 4))
  135.66 +    (println (func -5 10))
  135.67 +    (handle :illegal-argument
  135.68 +      (println "outer")
  135.69 +      (print-stack-trace *condition*))))
   136.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   136.2 +++ b/src/clojure/contrib/test_contrib/datalog/example.clj	Sat Aug 21 06:25:44 2010 -0400
   136.3 @@ -0,0 +1,116 @@
   136.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   136.5 +;;  distribution terms for this software are covered by the Eclipse Public
   136.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   136.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   136.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   136.9 +;;  terms of this license.  You must not remove this notice, or any other,
  136.10 +;;  from this software.
  136.11 +;;
  136.12 +;;  example.clj
  136.13 +;;
  136.14 +;;  A Clojure implementation of Datalog - Example
  136.15 +;;
  136.16 +;;  straszheimjeffrey (gmail)
  136.17 +;;  Created 2 March 2009
  136.18 +
  136.19 +
  136.20 +(ns clojure.contrib.datalog.example
  136.21 +  (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)]
  136.22 +        [clojure.contrib.datalog.rules :only (<- ?- rules-set)]
  136.23 +        [clojure.contrib.datalog.database :only (make-database add-tuples)]
  136.24 +        [clojure.contrib.datalog.util :only (*trace-datalog*)]))
  136.25 +
  136.26 +
  136.27 +
  136.28 +
  136.29 +(def db-base
  136.30 +     (make-database
  136.31 +      (relation :employee [:id :name :position])
  136.32 +      (index :employee :name)
  136.33 +
  136.34 +      (relation :boss [:employee-id :boss-id])
  136.35 +      (index :boss :employee-id)
  136.36 +
  136.37 +      (relation :can-do-job [:position :job])
  136.38 +      (index :can-do-job :position)
  136.39 +
  136.40 +      (relation :job-replacement [:job :can-be-done-by])
  136.41 +      ;(index :job-replacement :can-be-done-by)
  136.42 +
  136.43 +      (relation :job-exceptions [:id :job])))
  136.44 +
  136.45 +(def db
  136.46 +     (add-tuples db-base
  136.47 +           [:employee :id 1  :name "Bob"    :position :boss]
  136.48 +           [:employee :id 2  :name "Mary"   :position :chief-accountant]
  136.49 +           [:employee :id 3  :name "John"   :position :accountant]
  136.50 +           [:employee :id 4  :name "Sameer" :position :chief-programmer]
  136.51 +           [:employee :id 5  :name "Lilian" :position :programmer]
  136.52 +           [:employee :id 6  :name "Li"     :position :technician]
  136.53 +           [:employee :id 7  :name "Fred"   :position :sales]
  136.54 +           [:employee :id 8  :name "Brenda" :position :sales]
  136.55 +           [:employee :id 9  :name "Miki"   :position :project-management]
  136.56 +           [:employee :id 10 :name "Albert" :position :technician]
  136.57 +           
  136.58 +           [:boss :employee-id 2  :boss-id 1]
  136.59 +           [:boss :employee-id 3  :boss-id 2]
  136.60 +           [:boss :employee-id 4  :boss-id 1]
  136.61 +           [:boss :employee-id 5  :boss-id 4]
  136.62 +           [:boss :employee-id 6  :boss-id 4]
  136.63 +           [:boss :employee-id 7  :boss-id 1]
  136.64 +           [:boss :employee-id 8  :boss-id 7]
  136.65 +           [:boss :employee-id 9  :boss-id 1]
  136.66 +           [:boss :employee-id 10 :boss-id 6]
  136.67 +
  136.68 +           [:can-do-job :position :boss               :job :management]
  136.69 +           [:can-do-job :position :accountant         :job :accounting]
  136.70 +           [:can-do-job :position :chief-accountant   :job :accounting]
  136.71 +           [:can-do-job :position :programmer         :job :programming]
  136.72 +           [:can-do-job :position :chief-programmer   :job :programming]           
  136.73 +           [:can-do-job :position :technician         :job :server-support]
  136.74 +           [:can-do-job :position :sales              :job :sales]
  136.75 +           [:can-do-job :position :project-management :job :project-management]
  136.76 +
  136.77 +           [:job-replacement :job :pc-support :can-be-done-by :server-support]
  136.78 +           [:job-replacement :job :pc-support :can-be-done-by :programming]
  136.79 +           [:job-replacement :job :payroll    :can-be-done-by :accounting]
  136.80 +
  136.81 +           [:job-exceptions :id 4 :job :pc-support]))
  136.82 +
  136.83 +(def rules
  136.84 +     (rules-set
  136.85 +        (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
  136.86 +                                               (:employee :id ?e-id :name ?x)
  136.87 +                                               (:employee :id ?b-id :name ?y))
  136.88 +        (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
  136.89 +                                               (:works-for :employee ?z :boss ?y))
  136.90 +        (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
  136.91 +                                                  (:can-do-job :position ?pos :job ?y))
  136.92 +        (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
  136.93 +                                                  (:employee-job* :employee ?x  :job ?z))
  136.94 +        (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
  136.95 +                                                  (:employee :name ?x :position ?z)
  136.96 +                                                  (if = ?z :boss))
  136.97 +        (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
  136.98 +                                                 (:employee :id ?id :name ?x)
  136.99 +                                                 (not! :job-exceptions :id ?id :job ?y))
 136.100 +        (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
 136.101 +                                    (not! :employee-job :employee ?y :job :pc-support))))
 136.102 +
 136.103 +
 136.104 +
 136.105 +(def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x)))
 136.106 +(run-work-plan wp-1 db {'??name "Albert"})
 136.107 +
 136.108 +(def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x)))
 136.109 +(binding [*trace-datalog* true]
 136.110 +  (run-work-plan wp-2 db {'??name "Li"}))
 136.111 +
 136.112 +(def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x)))
 136.113 +(run-work-plan wp-3 db {'??name "Albert"})
 136.114 +
 136.115 +(def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y)))
 136.116 +(run-work-plan wp-4 db {})
 136.117 +
 136.118 +
 136.119 +;; End of file
   137.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   137.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test.clj	Sat Aug 21 06:25:44 2010 -0400
   137.3 @@ -0,0 +1,45 @@
   137.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   137.5 +;;  distribution terms for this software are covered by the Eclipse Public
   137.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   137.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   137.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   137.9 +;;  terms of this license.  You must not remove this notice, or any other,
  137.10 +;;  from this software.
  137.11 +;;
  137.12 +;;  test.clj
  137.13 +;;
  137.14 +;;  A Clojure implementation of Datalog -- Tests
  137.15 +;;
  137.16 +;;  straszheimjeffrey (gmail)
  137.17 +;;  Created 11 Feburary 2009
  137.18 +
  137.19 +(ns clojure.contrib.datalog.tests.test
  137.20 +  (:use [clojure.test :only (run-tests)])
  137.21 +  (:gen-class))
  137.22 +
  137.23 +(def test-names [:test-util
  137.24 +                 :test-database
  137.25 +                 :test-literals
  137.26 +                 :test-rules
  137.27 +                 :test-magic
  137.28 +                 :test-softstrat])
  137.29 +
  137.30 +(def test-namespaces
  137.31 +     (map #(symbol (str "clojure.contrib.datalog.tests." (name %)))
  137.32 +          test-names))
  137.33 +
  137.34 +(defn run
  137.35 +  "Runs all defined tests"
  137.36 +  []
  137.37 +  (println "Loading tests...")
  137.38 +  (apply require :reload-all test-namespaces)
  137.39 +  (apply run-tests test-namespaces))
  137.40 +
  137.41 +(defn -main
  137.42 +  "Run all defined tests from the command line"
  137.43 +  [& args]
  137.44 +  (run)
  137.45 +  (System/exit 0))
  137.46 +
  137.47 +
  137.48 +;; End of file
   138.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   138.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_database.clj	Sat Aug 21 06:25:44 2010 -0400
   138.3 @@ -0,0 +1,153 @@
   138.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   138.5 +;;  distribution terms for this software are covered by the Eclipse Public
   138.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   138.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   138.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   138.9 +;;  terms of this license.  You must not remove this notice, or any other,
  138.10 +;;  from this software.
  138.11 +;;
  138.12 +;;  test-database.clj
  138.13 +;;
  138.14 +;;  A Clojure implementation of Datalog -- Database
  138.15 +;;
  138.16 +;;  straszheimjeffrey (gmail)
  138.17 +;;  Created 12 Feburary 2009
  138.18 +
  138.19 +
  138.20 +(ns clojure.contrib.datalog.tests.test-database
  138.21 +  (:use clojure.test
  138.22 +	clojure.contrib.datalog.database))
  138.23 +
  138.24 +
  138.25 +(def test-db
  138.26 +     (make-database
  138.27 +      (relation :fred [:mary :sue])
  138.28 +      (index :fred :mary)
  138.29 +      (relation :sally [:jen :becky :joan])
  138.30 +      (index :sally :jen)
  138.31 +      (index :sally :becky)))
  138.32 +
  138.33 +(deftest test-make-database
  138.34 +  (is (= test-db
  138.35 +         (datalog-database
  138.36 +          {:sally (datalog-relation
  138.37 +                   #{:jen :joan :becky}
  138.38 +                   #{}
  138.39 +                   {:becky {}
  138.40 +                    :jen {}})
  138.41 +           :fred (datalog-relation
  138.42 +                  #{:sue :mary}
  138.43 +                  #{}
  138.44 +                  {:mary {}})}))))
  138.45 +
  138.46 +
  138.47 +(deftest test-ensure-relation
  138.48 +  (is (contains? (ensure-relation test-db :bob [:sam :george] [:sam]) :bob))
  138.49 +  (is (contains? (ensure-relation test-db :fred [:mary :sue] [:mary]) :fred))
  138.50 +  (is (thrown? AssertionError (ensure-relation test-db :fred [:bob :joe] []))))
  138.51 +
  138.52 +(deftest test-add-tuple
  138.53 +  (let [new-db (add-tuple test-db :fred {:mary 1 :sue 2})]
  138.54 +    (is (= (select new-db :fred {:mary 1}) [{:mary 1 :sue 2}])))
  138.55 +  (is (thrown? AssertionError (add-tuple test-db :fred {:mary 1}))))
  138.56 +
  138.57 +(def test-db-1
  138.58 +     (add-tuples test-db
  138.59 +                 [:fred :mary 1 :sue 2]
  138.60 +                 [:fred :mary 2 :sue 3]
  138.61 +                 [:sally :jen 1 :becky 2 :joan 0]
  138.62 +                 [:sally :jen 1 :becky 4 :joan 3]
  138.63 +                 [:sally :jen 1 :becky 3 :joan 0]
  138.64 +                 [:sally :jen 1 :becky 2 :joan 3]
  138.65 +                 [:fred :mary 1 :sue 1]
  138.66 +                 [:fred :mary 3 :sue 1]))
  138.67 +
  138.68 +(deftest test-add-tuples
  138.69 +  (is (= test-db-1
  138.70 +         (datalog-database
  138.71 +          {:sally (datalog-relation
  138.72 +                   #{:jen :joan :becky}
  138.73 +                   #{{:jen 1, :joan 0, :becky 3}
  138.74 +                     {:jen 1, :joan 0, :becky 2}
  138.75 +                     {:jen 1, :joan 3, :becky 2}
  138.76 +                     {:jen 1, :joan 3, :becky 4}}
  138.77 +                   {:becky {3
  138.78 +                            #{{:jen 1, :joan 0, :becky 3}}
  138.79 +                            4
  138.80 +                            #{{:jen 1, :joan 3, :becky 4}}
  138.81 +                            2
  138.82 +                            #{{:jen 1, :joan 0, :becky 2}
  138.83 +                              {:jen 1, :joan 3, :becky 2}}}
  138.84 +                    :jen {1
  138.85 +                          #{{:jen 1, :joan 0, :becky 3}
  138.86 +                            {:jen 1, :joan 0, :becky 2}
  138.87 +                            {:jen 1, :joan 3, :becky 2}
  138.88 +                            {:jen 1, :joan 3, :becky 4}}}})
  138.89 +           :fred (datalog-relation
  138.90 +                  #{:sue :mary}
  138.91 +                  #{{:sue 2, :mary 1}
  138.92 +                    {:sue 1, :mary 1}
  138.93 +                    {:sue 3, :mary 2}
  138.94 +                    {:sue 1, :mary 3}}
  138.95 +                  {:mary {3
  138.96 +                          #{{:sue 1, :mary 3}}
  138.97 +                          2
  138.98 +                          #{{:sue 3, :mary 2}}
  138.99 +                          1
 138.100 +                          #{{:sue 2, :mary 1}
 138.101 +                            {:sue 1, :mary 1}}}})}))))
 138.102 +
 138.103 +(deftest test-remove-tuples
 138.104 +  (let [db (reduce #(apply remove-tuple %1 (first %2) (next %2))
 138.105 +                   test-db-1
 138.106 +                   [[:fred {:mary 1 :sue 1}]
 138.107 +                    [:fred {:mary 3 :sue 1}]
 138.108 +                    [:sally {:jen 1 :becky 2 :joan 0}]
 138.109 +                    [:sally {:jen 1 :becky 4 :joan 3}]])]
 138.110 +    (is (= db
 138.111 +           (datalog-database
 138.112 +            {:sally (datalog-relation
 138.113 +                     #{:jen :joan :becky}
 138.114 +                     #{{:jen 1, :joan 0, :becky 3}
 138.115 +                       {:jen 1, :joan 3, :becky 2}}
 138.116 +                     {:becky
 138.117 +                      {3
 138.118 +                       #{{:jen 1, :joan 0, :becky 3}}
 138.119 +                       2
 138.120 +                       #{{:jen 1, :joan 3, :becky 2}}}
 138.121 +                      :jen
 138.122 +                      {1
 138.123 +                       #{{:jen 1, :joan 0, :becky 3}
 138.124 +                         {:jen 1, :joan 3, :becky 2}}}})
 138.125 +             :fred (datalog-relation
 138.126 +                    #{:sue :mary}
 138.127 +                    #{{:sue 2, :mary 1}
 138.128 +                      {:sue 3, :mary 2}}
 138.129 +                    {:mary
 138.130 +                     {2
 138.131 +                      #{{:sue 3, :mary 2}}
 138.132 +                      1
 138.133 +                      #{{:sue 2, :mary 1}}}})})))))
 138.134 +
 138.135 +
 138.136 +
 138.137 +(deftest test-select
 138.138 +  (is (= (set (select test-db-1 :sally {:jen 1 :becky 2}))
 138.139 +         #{{:jen 1 :joan 0 :becky 2} {:jen 1 :joan 3 :becky 2}}))
 138.140 +  (is (= (set (select test-db-1 :fred {:sue 1})))
 138.141 +      #{{:mary 3 :sue 1} {:mary 1 :sue 1}})
 138.142 +  (is (empty? (select test-db-1 :sally {:joan 5 :jen 1}))))
 138.143 +         
 138.144 +(deftest test-any-match?
 138.145 +  (is (any-match? test-db-1 :fred {:mary 3}))
 138.146 +  (is (any-match? test-db-1 :sally {:jen 1 :becky 2 :joan 3}))
 138.147 +  (is (not (any-match? test-db-1 :sally {:jen 5})))
 138.148 +  (is (not (any-match? test-db-1 :fred {:mary 1 :sue 5}))))
 138.149 +
 138.150 +
 138.151 +(comment
 138.152 +  (run-tests)
 138.153 +)
 138.154 +
 138.155 +;; End of file
 138.156 +
   139.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   139.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_literals.clj	Sat Aug 21 06:25:44 2010 -0400
   139.3 @@ -0,0 +1,187 @@
   139.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   139.5 +;;  distribution terms for this software are covered by the Eclipse Public
   139.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   139.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   139.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   139.9 +;;  terms of this license.  You must not remove this notice, or any other,
  139.10 +;;  from this software.
  139.11 +;;
  139.12 +;;  test-literals.clj
  139.13 +;;
  139.14 +;;  A Clojure implementation of Datalog -- Literals tests
  139.15 +;;
  139.16 +;;  straszheimjeffrey (gmail)
  139.17 +;;  Created 25 Feburary 2009
  139.18 +
  139.19 +
  139.20 +(ns clojure.contrib.datalog.tests.test-literals
  139.21 +  (:use clojure.test)
  139.22 +  (:use clojure.contrib.datalog.literals
  139.23 +        clojure.contrib.datalog.database))
  139.24 +
  139.25 +
  139.26 +(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3))))
  139.27 +(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3))))
  139.28 +(def cl (eval (build-literal '(if > ?x 3))))
  139.29 +
  139.30 +(def bl (eval (build-literal '(:fred))))
  139.31 +
  139.32 +(def bns {:x '?x :y '?y :z 3})
  139.33 +
  139.34 +(deftest test-build-literal
  139.35 +  (is (= (:predicate pl) :fred))
  139.36 +  (is (= (:term-bindings pl) bns))
  139.37 +  (is (= (:predicate nl) :fred))
  139.38 +  (is (= (:term-bindings nl) bns))
  139.39 +  (is (= (:symbol cl) '>))
  139.40 +  (is (= (:terms cl) '(?x 3)))
  139.41 +  (is ((:fun cl) [4 3]))
  139.42 +  (is (not ((:fun cl) [2 4])))
  139.43 +  (is (= (:predicate bl) :fred)))
  139.44 +
  139.45 +(deftest test-literal-predicate
  139.46 +  (is (= (literal-predicate pl) :fred))
  139.47 +  (is (= (literal-predicate nl) :fred))
  139.48 +  (is (nil? (literal-predicate cl)))
  139.49 +  (is (= (literal-predicate bl) :fred)))
  139.50 +
  139.51 +(deftest test-literal-columns
  139.52 +  (is (= (literal-columns pl) #{:x :y :z}))
  139.53 +  (is (= (literal-columns nl) #{:x :y :z}))
  139.54 +  (is (nil? (literal-columns cl)))
  139.55 +  (is (empty? (literal-columns bl))))
  139.56 +
  139.57 +(deftest test-literal-vars
  139.58 +  (is (= (literal-vars pl) #{'?x '?y}))
  139.59 +  (is (= (literal-vars nl) #{'?x '?y}))
  139.60 +  (is (= (literal-vars cl) #{'?x}))
  139.61 +  (is (empty? (literal-vars bl))))
  139.62 +
  139.63 +(deftest test-positive-vars
  139.64 +  (is (= (positive-vars pl) (literal-vars pl)))
  139.65 +  (is (nil? (positive-vars nl)))
  139.66 +  (is (nil? (positive-vars cl)))
  139.67 +  (is (empty? (positive-vars bl))))
  139.68 +
  139.69 +(deftest test-negative-vars
  139.70 +  (is (nil? (negative-vars pl)))
  139.71 +  (is (= (negative-vars nl) (literal-vars nl)))
  139.72 +  (is (= (negative-vars cl) (literal-vars cl)))
  139.73 +  (is (empty? (negative-vars bl))))
  139.74 +
  139.75 +(deftest test-negated?
  139.76 +  (is (not (negated? pl)))
  139.77 +  (is (negated? nl))
  139.78 +  (is (not (negated? cl))))
  139.79 +
  139.80 +(deftest test-vs-from-cs
  139.81 +  (is (= (get-vs-from-cs pl #{:x}) #{'?x}))
  139.82 +  (is (empty? (get-vs-from-cs pl #{:z})))
  139.83 +  (is (= (get-vs-from-cs pl #{:x :r}) #{'?x}))
  139.84 +  (is (empty? (get-vs-from-cs pl #{}))))
  139.85 +
  139.86 +(deftest test-cs-from-vs
  139.87 +  (is (= (get-cs-from-vs pl #{'?x}) #{:x}))
  139.88 +  (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x}))
  139.89 +  (is (empty? (get-cs-from-vs pl #{}))))
  139.90 +
  139.91 +(deftest test-literal-appropriate?
  139.92 +  (is (not (literal-appropriate? #{} pl)))
  139.93 +  (is (literal-appropriate? #{'?x} pl))
  139.94 +  (is (not (literal-appropriate? #{'?x} nl)))
  139.95 +  (is (literal-appropriate? #{'?x '?y} nl))
  139.96 +  (is (not (literal-appropriate? #{'?z} cl)))
  139.97 +  (is (literal-appropriate? #{'?x} cl)))
  139.98 +
  139.99 +(deftest test-adorned-literal
 139.100 +  (is (= (literal-predicate (adorned-literal pl #{:x}))
 139.101 +         {:pred :fred :bound #{:x}}))
 139.102 +  (is (= (literal-predicate (adorned-literal nl #{:x :y :q}))
 139.103 +         {:pred :fred :bound #{:x :y}}))
 139.104 +  (is (= (:term-bindings (adorned-literal nl #{:x}))
 139.105 +         {:x '?x :y '?y :z 3}))
 139.106 +  (is (= (adorned-literal cl #{})
 139.107 +         cl)))
 139.108 +
 139.109 +(deftest test-get-adorned-bindings
 139.110 +  (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x})))
 139.111 +         #{:x}))
 139.112 +  (is (= (get-adorned-bindings (literal-predicate pl))
 139.113 +         nil)))
 139.114 +
 139.115 +(deftest test-get-base-predicate
 139.116 +  (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x})))
 139.117 +         :fred))
 139.118 +  (is (= (get-base-predicate (literal-predicate pl))
 139.119 +         :fred)))
 139.120 +
 139.121 +(deftest test-magic-literal
 139.122 +  (is (= (magic-literal pl)
 139.123 +         {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
 139.124 +  (is (= (magic-literal (adorned-literal pl #{:x}))
 139.125 +         {:predicate {:pred :fred :magic true :bound #{:x}},
 139.126 +          :term-bindings {:x '?x},
 139.127 +          :literal-type :clojure.contrib.datalog.literals/literal})))
 139.128 +
 139.129 +(comment
 139.130 +  (use 'clojure.contrib.stacktrace) (e)
 139.131 +  (use :reload 'clojure.contrib.datalog.literals)
 139.132 +)
 139.133 +
 139.134 +
 139.135 +(def db1 (make-database
 139.136 +           (relation :fred [:x :y])
 139.137 +           (index :fred :x)
 139.138 +           (relation :sally [:x])))
 139.139 +
 139.140 +(def db2 (add-tuples db1
 139.141 +             [:fred :x 1 :y :mary]
 139.142 +             [:fred :x 1 :y :becky]
 139.143 +             [:fred :x 3 :y :sally]
 139.144 +             [:fred :x 4 :y :joe]
 139.145 +             [:sally :x 1]
 139.146 +             [:sally :x 2]))
 139.147 +
 139.148 +(def lit1 (eval (build-literal '(:fred :x ?x :y ?y))))
 139.149 +(def lit2 (eval (build-literal '(not! :fred :x ?x))))
 139.150 +(def lit3 (eval (build-literal '(if > ?x ?y))))
 139.151 +(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x}))
 139.152 +
 139.153 +(deftest test-join-literal
 139.154 +  (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}]))
 139.155 +         #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}}))
 139.156 +  (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}])
 139.157 +         [{'?x 2}]))
 139.158 +  (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}])
 139.159 +         [{'?x 3 '?y 1}])))
 139.160 +         
 139.161 +(deftest test-project-literal
 139.162 +  (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}})
 139.163 +         (datalog-relation
 139.164 +          ;; Schema
 139.165 +          #{:y :x}
 139.166 +
 139.167 +          ;; Data
 139.168 +          #{
 139.169 +            {:x 1, :y 3}
 139.170 +            {:x 4, :y 2}
 139.171 +            }
 139.172 +          
 139.173 +          ;; Indexes
 139.174 +          {
 139.175 +           :x
 139.176 +           {
 139.177 +            4
 139.178 +            #{{:x 4, :y 2}}
 139.179 +            1
 139.180 +            #{{:x 1, :y 3}}
 139.181 +            }
 139.182 +           }))))
 139.183 +
 139.184 +
 139.185 +
 139.186 +(comment
 139.187 +  (run-tests)
 139.188 +)
 139.189 +
 139.190 +;; End of file
   140.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   140.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_magic.clj	Sat Aug 21 06:25:44 2010 -0400
   140.3 @@ -0,0 +1,72 @@
   140.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   140.5 +;;  distribution terms for this software are covered by the Eclipse Public
   140.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   140.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   140.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   140.9 +;;  terms of this license.  You must not remove this notice, or any other,
  140.10 +;;  from this software.
  140.11 +;;
  140.12 +;;  test-magic.clj
  140.13 +;;
  140.14 +;;  A Clojure implementation of Datalog -- Magic Tests
  140.15 +;;
  140.16 +;;  straszheimjeffrey (gmail)
  140.17 +;;  Created 18 Feburary 2009
  140.18 +
  140.19 +(ns clojure.contrib.datalog.tests.test-magic
  140.20 +  (:use clojure.test)
  140.21 +  (:use clojure.contrib.datalog.magic
  140.22 +        clojure.contrib.datalog.rules))
  140.23 +
  140.24 +
  140.25 +
  140.26 +(def rs (rules-set
  140.27 +             (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y))
  140.28 +             (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y))
  140.29 +             (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y))
  140.30 +             (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y))))
  140.31 +
  140.32 +(def q (adorn-query (?- :p :x 1 :y ?y)))
  140.33 +
  140.34 +(def ars (adorn-rules-set rs q))
  140.35 +
  140.36 +(deftest test-adorn-rules-set
  140.37 +  (is (= ars
  140.38 +         (rules-set
  140.39 +          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x))
  140.40 +          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x)
  140.41 +                                                    ({:pred :p :bound #{:x}} :y ?y :x ?z))
  140.42 +          (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x))
  140.43 +          (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x))))))
  140.44 +
  140.45 +
  140.46 +(def m (magic-transform ars))
  140.47 +
  140.48 +(deftest test-magic-transform
  140.49 +  (is (= m
  140.50 +         (rules-set
  140.51 +          (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x))
  140.52 +
  140.53 +          (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x))
  140.54 +
  140.55 +          (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
  140.56 +                                                          ({:pred :e :bound #{:x}} :y ?z :x ?x))
  140.57 +
  140.58 +          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
  140.59 +                                                    ({:pred :e :bound #{:x}} :y ?z :x ?x)
  140.60 +                                                    ({:pred :p :bound #{:x}} :y ?y :x ?z))
  140.61 +
  140.62 +          (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x))
  140.63 +
  140.64 +          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
  140.65 +                                                    ({:pred :e :bound #{:x}} :y ?y :x ?x))))))
  140.66 +
  140.67 +
  140.68 +
  140.69 +
  140.70 +(comment
  140.71 +  (run-tests)
  140.72 +)
  140.73 +
  140.74 +;; End of file
  140.75 +
   141.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   141.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_rules.clj	Sat Aug 21 06:25:44 2010 -0400
   141.3 @@ -0,0 +1,130 @@
   141.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   141.5 +;;  distribution terms for this software are covered by the Eclipse Public
   141.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   141.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   141.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   141.9 +;;  terms of this license.  You must not remove this notice, or any other,
  141.10 +;;  from this software.
  141.11 +;;
  141.12 +;;  test-rules.clj
  141.13 +;;
  141.14 +;;  A Clojure implementation of Datalog -- Rule Tests
  141.15 +;;
  141.16 +;;  straszheimjeffrey (gmail)
  141.17 +;;  Created 12 Feburary 2009
  141.18 +
  141.19 +
  141.20 +(ns clojure.contrib.datalog.tests.test-rules
  141.21 +  (:use clojure.test
  141.22 +        clojure.contrib.datalog.rules
  141.23 +        clojure.contrib.datalog.literals
  141.24 +        clojure.contrib.datalog.database))
  141.25 +
  141.26 +
  141.27 +(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y)))
  141.28 +(def tr-2 (<- (:fred) (not! :mary :x 3)))
  141.29 +(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y)))
  141.30 +
  141.31 +
  141.32 +
  141.33 +(deftest test-rule-safety
  141.34 +  (is (thrown-with-msg? Exception #".*Head vars.*not bound.*"
  141.35 +         (<- (:fred :x ?x) (:sally :y ?y))))
  141.36 +  (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
  141.37 +         (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y))))
  141.38 +  (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
  141.39 +         (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y)))))
  141.40 +
  141.41 +
  141.42 +(deftest test-sip
  141.43 +  (is (= (compute-sip #{:x} #{:mary :sally} tr-1)
  141.44 +         (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
  141.45 +                      ({:pred :mary :bound #{:x}} :z ?z :x ?x)
  141.46 +                      ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
  141.47 +
  141.48 +  (is (= (compute-sip #{} #{:mary :sally} tr-1)
  141.49 +         (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
  141.50 +
  141.51 +  (is (= (compute-sip #{} #{:mary} tr-2)
  141.52 +         (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3))))
  141.53 +  
  141.54 +  (is (= (compute-sip #{} #{} tr-2)
  141.55 +         tr-2))
  141.56 +
  141.57 +  (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3))
  141.58 +         (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
  141.59 +                               ({:pred :mary :bound #{:x}} :x ?x)
  141.60 +                               (:sally :y ?y)
  141.61 +                               (if > ?x ?y))))))
  141.62 +                   ; Display rule is used because = does not work on
  141.63 +                   ; (if > ?x ?y) because it contains a closure
  141.64 +
  141.65 +
  141.66 +(def rs
  141.67 +     (rules-set
  141.68 +        (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
  141.69 +        (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))
  141.70 +        (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y))))
  141.71 +
  141.72 +(deftest test-rules-set
  141.73 +  (is (= (count rs) 3))
  141.74 +  (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)))))
  141.75 +  
  141.76 +(deftest test-predicate-map
  141.77 +  (let [pm (predicate-map rs)]
  141.78 +    (is (= (pm :path)
  141.79 +           #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
  141.80 +             (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))}))
  141.81 +    (is (= (-> :edge pm count) 1))))
  141.82 +
  141.83 +
  141.84 +(def db1 (make-database
  141.85 +           (relation :fred [:x :y])
  141.86 +           (index :fred :x)
  141.87 +           (relation :sally [:x])
  141.88 +           (relation :ben [:y])))
  141.89 +
  141.90 +(def db2 (add-tuples db1
  141.91 +             [:fred :x 1 :y :mary]
  141.92 +             [:fred :x 1 :y :becky]
  141.93 +             [:fred :x 3 :y :sally]
  141.94 +             [:fred :x 4 :y :joe]
  141.95 +             [:fred :x 4 :y :bob]
  141.96 +             [:sally :x 1]
  141.97 +             [:sally :x 2]
  141.98 +             [:sally :x 3]
  141.99 +             [:sally :x 4]
 141.100 +             [:ben :y :bob]))
 141.101 +
 141.102 +
 141.103 +(deftest test-apply-rule
 141.104 +  (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x)
 141.105 +                                                           (:fred :x ?x :y ?y)
 141.106 +                                                           (not! :ben :y ?y)
 141.107 +                                                           (if not= ?x 3)))
 141.108 +         (datalog-database
 141.109 +          {
 141.110 +           :becky
 141.111 +           (datalog-relation
 141.112 +            ;; Schema
 141.113 +            #{:y}
 141.114 +            ;; Data
 141.115 +            #{
 141.116 +              {:y :joe}
 141.117 +              {:y :mary}
 141.118 +              {:y :becky}
 141.119 +              }
 141.120 +            ;; Indexes
 141.121 +            {
 141.122 +             })
 141.123 +           }))))
 141.124 +
 141.125 +
 141.126 +
 141.127 +
 141.128 +(comment
 141.129 +  (run-tests)
 141.130 +)
 141.131 +
 141.132 +;; End of file
 141.133 +
   142.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   142.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_softstrat.clj	Sat Aug 21 06:25:44 2010 -0400
   142.3 @@ -0,0 +1,233 @@
   142.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   142.5 +;;  distribution terms for this software are covered by the Eclipse Public
   142.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   142.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   142.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   142.9 +;;  terms of this license.  You must not remove this notice, or any other,
  142.10 +;;  from this software.
  142.11 +;;
  142.12 +;;  test-softstrat.clj
  142.13 +;;
  142.14 +;;  A Clojure implementation of Datalog -- Soft Stratification Tests
  142.15 +;;
  142.16 +;;  straszheimjeffrey (gmail)
  142.17 +;;  Created 28 Feburary 2009
  142.18 +
  142.19 +(ns clojure.contrib.datalog.tests.test-softstrat
  142.20 +  (:use clojure.test)
  142.21 +  (:use clojure.contrib.datalog.softstrat
  142.22 +        clojure.contrib.datalog.magic
  142.23 +        clojure.contrib.datalog.rules
  142.24 +        clojure.contrib.datalog.database)
  142.25 +  (:use [clojure.contrib.set :only (subset?)]))
  142.26 +
  142.27 +
  142.28 +
  142.29 +(def rs1 (rules-set
  142.30 +            (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z))
  142.31 +            (<- (:q :x ?x) (:d :x ?x))))
  142.32 +
  142.33 +(def q1 (?- :p :x 1))
  142.34 +
  142.35 +(def ws (build-soft-strat-work-plan rs1 q1))
  142.36 +
  142.37 +(deftest test-soft-stratification
  142.38 +  (let [soft (:stratification ws)
  142.39 +        q (:query ws)]
  142.40 +    (is (= q (?- {:pred :p :bound #{:x}} :x 1)))
  142.41 +    (is (= (count soft) 4))
  142.42 +    (is (subset? (rules-set
  142.43 +                  (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x)
  142.44 +                                                      (:d :x ?x))
  142.45 +
  142.46 +                  (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
  142.47 +                                                                  (:b :z ?z :y ?y :x ?x)))
  142.48 +                 (nth soft 0)))
  142.49 +    (is (= (nth soft 1)
  142.50 +           (rules-set
  142.51 +            (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x)
  142.52 +                                                            (:b :z ?z :y ?y :x ?x)
  142.53 +                                                            (not! {:pred :q :bound #{:x}} :x ?x)))))
  142.54 +    (is (= (nth soft 2)
  142.55 +           (rules-set
  142.56 +            (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
  142.57 +                                                            (:b :z ?z :y ?y :x ?x)
  142.58 +                                                            (not! {:pred :q :bound #{:x}} :x ?x)
  142.59 +                                                            (not! {:pred :q :bound #{:x}} :x ?y)))))
  142.60 +    (is (= (nth soft 3)
  142.61 +           (rules-set
  142.62 +            (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
  142.63 +                                                (:b :z ?z :y ?y :x ?x)
  142.64 +                                                (not! {:pred :q :bound #{:x}} :x ?x)
  142.65 +                                                (not! {:pred :q :bound #{:x}} :x ?y)
  142.66 +                                                (not! {:pred :q :bound #{:x}} :x ?z)))))))
  142.67 +
  142.68 +
  142.69 +(def tdb-1
  142.70 +     (make-database
  142.71 +       (relation :b [:x :y :z])
  142.72 +       (relation :d [:x])))
  142.73 +
  142.74 +(def tdb-2
  142.75 +     (add-tuples tdb-1
  142.76 +                 [:b :x 1 :y 2 :z 3]))
  142.77 +
  142.78 +(deftest test-tdb-2
  142.79 +  (is (= (evaluate-soft-work-set ws tdb-2 {})
  142.80 +         [{:x 1}])))
  142.81 +
  142.82 +
  142.83 +
  142.84 +(def tdb-3
  142.85 +     (add-tuples tdb-2
  142.86 +                 [:d :x 2]
  142.87 +                 [:d :x 3]))
  142.88 +
  142.89 +(deftest test-tdb-3
  142.90 +  (is (empty? (evaluate-soft-work-set ws tdb-3 {}))))
  142.91 +         
  142.92 +
  142.93 +
  142.94 +;;;;;;;;;;;
  142.95 +
  142.96 +
  142.97 +
  142.98 +(def db-base
  142.99 +     (make-database
 142.100 +      (relation :employee [:id :name :position])
 142.101 +      (index :employee :name)
 142.102 +
 142.103 +      (relation :boss [:employee-id :boss-id])
 142.104 +      (index :boss :employee-id)
 142.105 +
 142.106 +      (relation :can-do-job [:position :job])
 142.107 +      (index :can-do-job :position)
 142.108 +
 142.109 +      (relation :job-replacement [:job :can-be-done-by])
 142.110 +
 142.111 +      (relation :job-exceptions [:id :job])))
 142.112 +
 142.113 +(def db
 142.114 +     (add-tuples db-base
 142.115 +           [:employee :id 1  :name "Bob"    :position :boss]
 142.116 +           [:employee :id 2  :name "Mary"   :position :chief-accountant]
 142.117 +           [:employee :id 3  :name "John"   :position :accountant]
 142.118 +           [:employee :id 4  :name "Sameer" :position :chief-programmer]
 142.119 +           [:employee :id 5  :name "Lilian" :position :programmer]
 142.120 +           [:employee :id 6  :name "Li"     :position :technician]
 142.121 +           [:employee :id 7  :name "Fred"   :position :sales]
 142.122 +           [:employee :id 8  :name "Brenda" :position :sales]
 142.123 +           [:employee :id 9  :name "Miki"   :position :project-management]
 142.124 +           [:employee :id 10 :name "Albert" :position :technician]
 142.125 +           
 142.126 +           [:boss :employee-id 2  :boss-id 1]
 142.127 +           [:boss :employee-id 3  :boss-id 2]
 142.128 +           [:boss :employee-id 4  :boss-id 1]
 142.129 +           [:boss :employee-id 5  :boss-id 4]
 142.130 +           [:boss :employee-id 6  :boss-id 4]
 142.131 +           [:boss :employee-id 7  :boss-id 1]
 142.132 +           [:boss :employee-id 8  :boss-id 7]
 142.133 +           [:boss :employee-id 9  :boss-id 1]
 142.134 +           [:boss :employee-id 10 :boss-id 6]
 142.135 +
 142.136 +           [:can-do-job :position :boss               :job :management]
 142.137 +           [:can-do-job :position :accountant         :job :accounting]
 142.138 +           [:can-do-job :position :chief-accountant   :job :accounting]
 142.139 +           [:can-do-job :position :programmer         :job :programming]
 142.140 +           [:can-do-job :position :chief-programmer   :job :programming]           
 142.141 +           [:can-do-job :position :technician         :job :server-support]
 142.142 +           [:can-do-job :position :sales              :job :sales]
 142.143 +           [:can-do-job :position :project-management :job :project-management]
 142.144 +
 142.145 +           [:job-replacement :job :pc-support :can-be-done-by :server-support]
 142.146 +           [:job-replacement :job :pc-support :can-be-done-by :programming]
 142.147 +           [:job-replacement :job :payroll    :can-be-done-by :accounting]
 142.148 +
 142.149 +           [:job-exceptions :id 4 :job :pc-support]))
 142.150 +
 142.151 +(def rules
 142.152 +     (rules-set
 142.153 +        (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
 142.154 +                                               (:employee :id ?e-id :name ?x)
 142.155 +                                               (:employee :id ?b-id :name ?y))
 142.156 +        (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
 142.157 +                                               (:works-for :employee ?z :boss ?y))
 142.158 +        (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
 142.159 +                                                  (:can-do-job :position ?pos :job ?y))
 142.160 +        (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
 142.161 +                                                  (:employee-job* :employee ?x  :job ?z))
 142.162 +        (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
 142.163 +                                                  (:employee :name ?x :position ?z)
 142.164 +                                                  (if = ?z :boss))
 142.165 +        (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
 142.166 +                                                 (:employee :id ?id :name ?x)
 142.167 +                                                 (not! :job-exceptions :id ?id :job ?y))
 142.168 +        (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
 142.169 +                                    (not! :employee-job :employee ?y :job :pc-support))))
 142.170 +
 142.171 +
 142.172 +(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x)))
 142.173 +(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name})))
 142.174 +
 142.175 +(deftest test-ws-1
 142.176 +  (is (= (evaluate-1 "Albert")
 142.177 +         #{{:employee "Albert", :boss "Li"}
 142.178 +           {:employee "Albert", :boss "Sameer"}
 142.179 +           {:employee "Albert", :boss "Bob"}}))
 142.180 +  (is (empty? (evaluate-1 "Bob")))
 142.181 +  (is (= (evaluate-1 "John")
 142.182 +         #{{:employee "John", :boss "Bob"}
 142.183 +           {:employee "John", :boss "Mary"}})))
 142.184 +         
 142.185 +
 142.186 +(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x)))
 142.187 +(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name})))
 142.188 +
 142.189 +(deftest test-ws-2
 142.190 +  (is (= (evaluate-2 "Albert")
 142.191 +         #{{:employee "Albert", :job :pc-support}
 142.192 +           {:employee "Albert", :job :server-support}}))
 142.193 +  (is (= (evaluate-2 "Sameer")
 142.194 +         #{{:employee "Sameer", :job :programming}}))
 142.195 +  (is (= (evaluate-2 "Bob")
 142.196 +         #{{:employee "Bob", :job :accounting}
 142.197 +           {:employee "Bob", :job :management}
 142.198 +           {:employee "Bob", :job :payroll}
 142.199 +           {:employee "Bob", :job :pc-support}
 142.200 +           {:employee "Bob", :job :project-management}
 142.201 +           {:employee "Bob", :job :programming}
 142.202 +           {:employee "Bob", :job :server-support}
 142.203 +           {:employee "Bob", :job :sales}})))
 142.204 +
 142.205 +(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x)))
 142.206 +(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name})))
 142.207 +
 142.208 +(deftest test-ws-3
 142.209 +  (is (= (evaluate-3 "Albert")
 142.210 +         #{{:name "Albert", :boss "Sameer"}})))
 142.211 +
 142.212 +(def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x)))
 142.213 +
 142.214 +(deftest test-ws-4
 142.215 +  (is (= (set (evaluate-soft-work-set ws-4 db {}))
 142.216 +         #{{:employee "Miki", :boss "Bob"}
 142.217 +           {:employee "Albert", :boss "Li"}
 142.218 +           {:employee "Lilian", :boss "Sameer"}
 142.219 +           {:employee "Li", :boss "Bob"}
 142.220 +           {:employee "Lilian", :boss "Bob"}
 142.221 +           {:employee "Brenda", :boss "Fred"}
 142.222 +           {:employee "Fred", :boss "Bob"}
 142.223 +           {:employee "John", :boss "Bob"}
 142.224 +           {:employee "John", :boss "Mary"}
 142.225 +           {:employee "Albert", :boss "Sameer"}
 142.226 +           {:employee "Sameer", :boss "Bob"}
 142.227 +           {:employee "Albert", :boss "Bob"}
 142.228 +           {:employee "Brenda", :boss "Bob"}
 142.229 +           {:employee "Mary", :boss "Bob"}
 142.230 +           {:employee "Li", :boss "Sameer"}})))
 142.231 +
 142.232 +(comment
 142.233 +  (run-tests)
 142.234 +)
 142.235 +
 142.236 +;; End of file
   143.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   143.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_util.clj	Sat Aug 21 06:25:44 2010 -0400
   143.3 @@ -0,0 +1,69 @@
   143.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   143.5 +;;  distribution terms for this software are covered by the Eclipse Public
   143.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   143.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   143.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   143.9 +;;  terms of this license.  You must not remove this notice, or any other,
  143.10 +;;  from this software.
  143.11 +;;
  143.12 +;;  test-util.clj
  143.13 +;;
  143.14 +;;  A Clojure implementation of Datalog -- Utilities Tests
  143.15 +;;
  143.16 +;;  straszheimjeffrey (gmail)
  143.17 +;;  Created 11 Feburary 2009
  143.18 +
  143.19 +(ns clojure.contrib.datalog.tests.test-util
  143.20 +  (:use clojure.test
  143.21 +	clojure.contrib.datalog.util)
  143.22 +  (:use [clojure.contrib.except :only (throwf)]))
  143.23 +
  143.24 +(deftest test-is-var?
  143.25 +  (is (is-var? '?x))
  143.26 +  (is (is-var? '?))
  143.27 +  (is (not (is-var? '??x)))
  143.28 +  (is (not (is-var? '??)))
  143.29 +  (is (not (is-var? 'x)))
  143.30 +  (is (not (is-var? "fred")))
  143.31 +  (is (not (is-var? :q))))
  143.32 +
  143.33 +(deftest test-map-values
  143.34 +  (let [map {:fred 1 :sally 2}]
  143.35 +    (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4}))
  143.36 +    (is (= (map-values identity {}) {}))))
  143.37 +
  143.38 +(deftest test-keys-to-vals
  143.39 +  (let [map {:fred 1 :sally 2 :joey 3}]
  143.40 +    (is (= (set (keys-to-vals map [:fred :sally])) #{1 2}))
  143.41 +    (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2}))
  143.42 +    (is (empty? (keys-to-vals map [])))
  143.43 +    (is (empty? (keys-to-vals {} [:fred])))))
  143.44 +
  143.45 +(deftest test-reverse-map
  143.46 +  (let [map {:fred 1 :sally 2 :joey 3}
  143.47 +        map-1 (assoc map :mary 3)]
  143.48 +    (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey}))
  143.49 +    (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey})
  143.50 +            (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary})))))
  143.51 +
  143.52 +(def some-maps
  143.53 +     [
  143.54 +      { :a 1 :b 2 }
  143.55 +      { :c 3 :b 3 }
  143.56 +      { :d 4 :a 1 }
  143.57 +      { :g 4 :b 4 }
  143.58 +      { :a 2 :b 1 }
  143.59 +      { :e 1 :f 1 }
  143.60 +      ])
  143.61 +
  143.62 +(def reduced (preduce + some-maps))
  143.63 +(def merged (apply merge-with + some-maps))
  143.64 +
  143.65 +(deftest test-preduce
  143.66 +  (is (= reduced merged)))
  143.67 +
  143.68 +(comment
  143.69 + (run-tests)
  143.70 +)
  143.71 +
  143.72 +; End of file
   144.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   144.2 +++ b/src/clojure/contrib/test_contrib/miglayout/example.clj	Sat Aug 21 06:25:44 2010 -0400
   144.3 @@ -0,0 +1,60 @@
   144.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   144.5 +;;  distribution terms for this software are covered by the Eclipse Public
   144.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   144.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   144.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   144.9 +;;  terms of this license.  You must not remove this notice, or any other,
  144.10 +;;  from this software.
  144.11 +;;
  144.12 +;;  clojure.contrib.miglayout.example
  144.13 +;;
  144.14 +;;  A temperature converter using miglayout. Demonstrates accessing
  144.15 +;;  components by their id constraint.
  144.16 +;;
  144.17 +;;  scgilardi (gmail)
  144.18 +;;  Created 31 May 2009
  144.19 +
  144.20 +(ns clojure.contrib.miglayout.example
  144.21 +  (:import (javax.swing JButton JFrame JLabel JPanel JTextField
  144.22 +                        SwingUtilities))
  144.23 +  (:use (clojure.contrib
  144.24 +         [miglayout :only (miglayout components)]
  144.25 +         [swing-utils :only (add-key-typed-listener)])))
  144.26 +
  144.27 +(defn fahrenheit
  144.28 +  "Converts a Celsius temperature to Fahrenheit. Input and output are
  144.29 +  strings. Returns \"input?\" if the input can't be parsed as a Double."
  144.30 +  [celsius]
  144.31 +  (try
  144.32 +   (format "%.2f" (+ 32 (* 1.8 (Double/parseDouble celsius))))
  144.33 +   (catch NumberFormatException _ "input?")))
  144.34 +
  144.35 +(defn- handle-key
  144.36 +  "Clears output on most keys, shows conversion on \"Enter\""
  144.37 +  [event out]
  144.38 +  (.setText out
  144.39 +    (if (= (.getKeyChar event) \newline)
  144.40 +      (fahrenheit (-> event .getComponent .getText))
  144.41 +      "")))
  144.42 +
  144.43 +(defn converter-ui
  144.44 +  "Lays out and shows a Temperature Converter UI"
  144.45 +  []
  144.46 +  (let [panel
  144.47 +        (miglayout (JPanel.)
  144.48 +         (JTextField. 6) {:id :input}
  144.49 +         (JLabel. "\u00b0Celsius") :wrap
  144.50 +         (JLabel.) {:id :output}
  144.51 +         (JLabel. "\u00b0Fahrenheit"))
  144.52 +        {:keys [input output]} (components panel)]
  144.53 +    (add-key-typed-listener input handle-key output)
  144.54 +    (doto (JFrame. "Temperature Converter")
  144.55 +      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
  144.56 +      (.add panel)
  144.57 +      (.pack)
  144.58 +      (.setVisible true))))
  144.59 +
  144.60 +(defn main
  144.61 +  "Invokes converter-ui in the AWT Event thread"
  144.62 +  []
  144.63 +  (SwingUtilities/invokeLater converter-ui))
   145.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   145.2 +++ b/src/clojure/contrib/test_contrib/mock/test_adapter.clj	Sat Aug 21 06:25:44 2010 -0400
   145.3 @@ -0,0 +1,18 @@
   145.4 +(ns clojure.contrib.test-contrib.mock-test.test-adapter-test
   145.5 + (:use clojure.contrib.mock.test-adapter
   145.6 +   [clojure.contrib.test-contrib.mock-test :only (assert-called)]
   145.7 +   clojure.test))
   145.8 +
   145.9 +(deftest test-report-problem-called
  145.10 +  (def #^{:private true :dynamic true} fn1 (fn [x] "dummy code"))
  145.11 +  (def #^{:private true :dynamic true} fn2 (fn [x y] "dummy code2"))
  145.12 +  (let [under-test (fn [x] (fn1 x))]
  145.13 +    (assert-called clojure.contrib.mock.test-adapter/report-problem
  145.14 +      true (expect [fn1 (times 5)] (under-test "hi")))))
  145.15 +
  145.16 +(deftest test-is-report-called
  145.17 +  (assert-called clojure.test/report true
  145.18 +    (clojure.contrib.mock.test-adapter/report-problem
  145.19 +      'fn-name 5 6 "fake problem")))
  145.20 +
  145.21 +
   146.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   146.2 +++ b/src/clojure/contrib/test_contrib/monads/examples.clj	Sat Aug 21 06:25:44 2010 -0400
   146.3 @@ -0,0 +1,425 @@
   146.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   146.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   146.6 +;;
   146.7 +;; Monad application examples
   146.8 +;;
   146.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146.11 +
  146.12 +(ns
  146.13 +  #^{:author "Konrad Hinsen"
  146.14 +     :skip-wiki true
  146.15 +     :doc "Examples for using monads"}
  146.16 +  clojure.contrib.monads.examples
  146.17 +  (:use [clojure.contrib.monads
  146.18 +	 :only (domonad with-monad m-lift m-seq m-reduce m-when
  146.19 +		sequence-m
  146.20 +		maybe-m
  146.21 +		state-m fetch-state set-state 
  146.22 +		writer-m write
  146.23 +		cont-m run-cont call-cc
  146.24 +		maybe-t)])
  146.25 +  (:require (clojure.contrib [accumulators :as accu])))
  146.26 +
  146.27 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146.28 +;;
  146.29 +;;  Sequence manipulations with the sequence monad
  146.30 +;;
  146.31 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146.32 +
  146.33 +; Note: in the Haskell world, this monad is called the list monad.
  146.34 +; The Clojure equivalent to Haskell's lists are (possibly lazy)
  146.35 +; sequences. This is why I call this monad "sequence". All sequences
  146.36 +; created by sequence monad operations are lazy.
  146.37 +
  146.38 +; Monad comprehensions in the sequence monad work exactly the same
  146.39 +; as Clojure's 'for' construct, except that :while clauses are not
  146.40 +; available.
  146.41 +(domonad sequence-m
  146.42 +   [x (range 5)
  146.43 +    y (range 3)]
  146.44 +    (+ x y))
  146.45 +
  146.46 +; Inside a with-monad block, domonad is used without the monad name.
  146.47 +(with-monad sequence-m
  146.48 +  (domonad
  146.49 +     [x (range 5)
  146.50 +      y (range 3)]
  146.51 +     (+ x y)))
  146.52 +
  146.53 +; Conditions are written with :when, as in Clojure's for form:
  146.54 +(domonad sequence-m
  146.55 +   [x  (range 5)
  146.56 +    y  (range (+ 1 x))
  146.57 +    :when (= (+ x y) 2)]
  146.58 +   (list x y))
  146.59 +
  146.60 +; :let is also supported like in for:
  146.61 +(domonad sequence-m
  146.62 +   [x  (range 5)
  146.63 +    y  (range (+ 1 x))
  146.64 +    :let [sum (+ x y)
  146.65 +	  diff (- x y)]
  146.66 +    :when  (= sum 2)]
  146.67 +   (list diff))
  146.68 +
  146.69 +; An example of a sequence function defined in terms of a lift operation.
  146.70 +(with-monad sequence-m
  146.71 +   (defn pairs [xs]
  146.72 +      ((m-lift 2 #(list %1 %2)) xs xs)))
  146.73 +
  146.74 +(pairs (range 5))
  146.75 +
  146.76 +; Another way to define pairs is through the m-seq operation. It takes
  146.77 +; a sequence of monadic values and returns a monadic value containing
  146.78 +; the sequence of the underlying values, obtained from chaining together
  146.79 +; from left to right the monadic values in the sequence.
  146.80 +(with-monad sequence-m
  146.81 +   (defn pairs [xs]
  146.82 +      (m-seq (list xs xs))))
  146.83 +
  146.84 +(pairs (range 5))
  146.85 +
  146.86 +; This definition suggests a generalization:
  146.87 +(with-monad sequence-m
  146.88 +   (defn ntuples [n xs]
  146.89 +      (m-seq (replicate n xs))))
  146.90 +
  146.91 +(ntuples 2 (range 5))
  146.92 +(ntuples 3 (range 5))
  146.93 +
  146.94 +; Lift operations can also be used inside a monad comprehension:
  146.95 +(domonad sequence-m
  146.96 +   [x  ((m-lift 1 (partial * 2)) (range 5))
  146.97 +    y  (range 2)]
  146.98 +    [x y])
  146.99 +
 146.100 +; The m-plus operation does concatenation in the sequence monad.
 146.101 +(domonad sequence-m
 146.102 +   [x  ((m-lift 2 +) (range 5) (range 3))
 146.103 +    y  (m-plus (range 2) '(10 11))]
 146.104 +   [x y])
 146.105 +
 146.106 +
 146.107 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.108 +;;
 146.109 +;; Handling failures with the maybe monad
 146.110 +;;
 146.111 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.112 +
 146.113 +; Maybe monad versions of basic arithmetic
 146.114 +(with-monad maybe-m
 146.115 +   (def m+ (m-lift 2 +))
 146.116 +   (def m- (m-lift 2 -))
 146.117 +   (def m* (m-lift 2 *)))
 146.118 +
 146.119 +; Division is special for two reasons: we can't call it m/ because that's
 146.120 +; not a legal Clojure symbol, and we want it to fail if a division by zero
 146.121 +; is attempted. It is best defined by a monad comprehension with a
 146.122 +; :when clause:
 146.123 +(defn safe-div [x y]
 146.124 +  (domonad maybe-m
 146.125 +     [a x
 146.126 +      b y
 146.127 +      :when (not (zero? b))]
 146.128 +     (/ a b)))
 146.129 +
 146.130 +; Now do some non-trivial computation with division
 146.131 +; It fails for (1) x = 0, (2) y = 0 or (3) y = -x.
 146.132 +(with-monad maybe-m
 146.133 +   (defn some-function [x y]
 146.134 +      (let [one (m-result 1)]
 146.135 + 	   (safe-div one (m+ (safe-div one (m-result x))
 146.136 +			     (safe-div one (m-result y)))))))
 146.137 +
 146.138 +; An example that doesn't fail:
 146.139 +(some-function 2 3)
 146.140 +; And two that do fail, at different places:
 146.141 +(some-function 2 0)
 146.142 +(some-function 2 -2)
 146.143 +
 146.144 +; In the maybe monad, m-plus selects the first monadic value that
 146.145 +; holds a valid value.
 146.146 +(with-monad maybe-m
 146.147 +   (m-plus (some-function 2 0) (some-function 2 -2) (some-function 2 3)))
 146.148 +
 146.149 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.150 +;;
 146.151 +;;  Random numbers with the state monad
 146.152 +;;
 146.153 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.154 +
 146.155 +; A state monad item represents a computation that changes a state and
 146.156 +; returns a value. Its structure is a function that takes a state argument
 146.157 +; and returns a two-item list containing the value and the updated state.
 146.158 +; It is important to realize that everything you put into a state monad
 146.159 +; expression is a state monad item (thus a function), and everything you
 146.160 +; get out as well. A state monad does not perform a calculation, it
 146.161 +; constructs a function that does the computation when called.
 146.162 +
 146.163 +; First, we define a simple random number generator with explicit state.
 146.164 +; rng is a function of its state (an integer) that returns the
 146.165 +; pseudo-random value derived from this state and the updated state 
 146.166 +; for the next iteration. This is exactly the structure of a state
 146.167 +;  monad item.
 146.168 +(defn rng [seed]
 146.169 +  (let [m      259200
 146.170 +	value  (/ (float seed) (float m))
 146.171 +	next   (rem (+ 54773 (* 7141 seed)) m)]
 146.172 +    [value next]))
 146.173 +
 146.174 +; We define a convenience function that creates an infinite lazy seq
 146.175 +; of values obtained from iteratively applying a state monad value.
 146.176 +(defn value-seq [f seed]
 146.177 +  (lazy-seq
 146.178 +    (let [[value next] (f seed)]
 146.179 +      (cons value (value-seq f next)))))
 146.180 +
 146.181 +; Next, we define basic statistics functions to check our random numbers
 146.182 +(defn sum [xs]  (apply + xs))
 146.183 +(defn mean [xs]  (/ (sum xs) (count xs)))
 146.184 +(defn variance [xs]
 146.185 +  (let [m (mean xs)
 146.186 +	sq #(* % %)]
 146.187 +    (mean (for [x xs] (sq (- x m))))))
 146.188 +
 146.189 +; rng implements a uniform distribution in the interval [0., 1.), so
 146.190 +; ideally, the mean would be 1/2 (0.5) and the variance 1/12 (0.8333).
 146.191 +(mean (take 1000 (value-seq rng 1)))
 146.192 +(variance (take 1000 (value-seq rng 1)))
 146.193 +
 146.194 +; We make use of the state monad to implement a simple (but often sufficient)
 146.195 +; approximation to a Gaussian distribution: the sum of 12 random numbers
 146.196 +; from rng's distribution, shifted by -6, has a distribution that is
 146.197 +; approximately Gaussian with 0 mean and variance 1, by virtue of the central
 146.198 +; limit theorem.
 146.199 +; In the first version, we call rng 12 times explicitly and calculate the
 146.200 +; shifted sum in a monad comprehension:
 146.201 +(def gaussian1
 146.202 +   (domonad state-m
 146.203 +      [x1  rng
 146.204 +       x2  rng
 146.205 +       x3  rng
 146.206 +       x4  rng
 146.207 +       x5  rng
 146.208 +       x6  rng
 146.209 +       x7  rng
 146.210 +       x8  rng
 146.211 +       x9  rng
 146.212 +       x10 rng
 146.213 +       x11 rng
 146.214 +       x12 rng]
 146.215 +      (- (+ x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12) 6.)))
 146.216 +
 146.217 +; Let's test it:
 146.218 +(mean (take 1000 (value-seq gaussian1 1)))
 146.219 +(variance (take 1000 (value-seq gaussian1 1)))
 146.220 +
 146.221 +; Of course, we'd rather have a loop construct for creating the 12
 146.222 +; random numbers. This would be easy if we could define a summation
 146.223 +; operation on random-number generators, which would then be used in
 146.224 +; combination with reduce. The lift operation gives us exactly that.
 146.225 +; More precisely, we need (m-lift 2 +), because we want both arguments
 146.226 +; of + to be lifted to the state monad:
 146.227 +(def gaussian2
 146.228 +   (domonad state-m
 146.229 +      [sum12 (reduce (m-lift 2 +) (replicate 12 rng))]
 146.230 +      (- sum12 6.)))
 146.231 +
 146.232 +; Such a reduction is often quite useful, so there's m-reduce predefined
 146.233 +; to simplify it:
 146.234 +(def gaussian2
 146.235 +   (domonad state-m
 146.236 +      [sum12 (m-reduce + (replicate 12 rng))]
 146.237 +      (- sum12 6.)))
 146.238 +
 146.239 +; The statistics should be strictly the same as above, as long as
 146.240 +; we use the same seed:
 146.241 +(mean (take 1000 (value-seq gaussian2 1)))
 146.242 +(variance (take 1000 (value-seq gaussian2 1)))
 146.243 +
 146.244 +; We can also do the subtraction of 6 in a lifted function, and get rid
 146.245 +; of the monad comprehension altogether:
 146.246 +(with-monad state-m
 146.247 +   (def gaussian3
 146.248 +        ((m-lift 1 #(- % 6.))
 146.249 +           (m-reduce + (replicate 12 rng)))))
 146.250 +
 146.251 +; Again, the statistics are the same:
 146.252 +(mean (take 1000 (value-seq gaussian3 1)))
 146.253 +(variance (take 1000 (value-seq gaussian3 1)))
 146.254 +
 146.255 +; For a random point in two dimensions, we'd like a random number generator
 146.256 +; that yields a list of two random numbers. The m-seq operation can easily
 146.257 +; provide it:
 146.258 +(with-monad state-m
 146.259 +   (def rng2 (m-seq (list rng rng))))
 146.260 +
 146.261 +; Let's test it:
 146.262 +(rng2 1)
 146.263 +
 146.264 +; fetch-state and get-state can be used to save the seed of the random
 146.265 +; number generator and go back to that saved seed later on:
 146.266 +(def identical-random-seqs
 146.267 +  (domonad state-m
 146.268 +    [seed (fetch-state)
 146.269 +     x1   rng
 146.270 +     x2   rng
 146.271 +     _    (set-state seed)
 146.272 +     y1   rng
 146.273 +     y2   rng]
 146.274 +    (list [x1 x2] [y1 y2])))
 146.275 +
 146.276 +(identical-random-seqs 1)
 146.277 +
 146.278 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.279 +;;
 146.280 +;;  Logging with the writer monad
 146.281 +;;
 146.282 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.283 +
 146.284 +; A basic logging example
 146.285 +(domonad (writer-m accu/empty-string)
 146.286 +  [x (m-result 1)
 146.287 +   _ (write "first step\n")
 146.288 +   y (m-result 2)
 146.289 +   _ (write "second step\n")]
 146.290 +  (+ x y))
 146.291 +
 146.292 +; For a more elaborate application, let's trace the recursive calls of
 146.293 +; a naive implementation of a Fibonacci function. The starting point is:
 146.294 +(defn fib [n]
 146.295 +  (if (< n 2)
 146.296 +    n
 146.297 +    (let [n1 (dec n)
 146.298 +	  n2 (dec n1)]
 146.299 +      (+ (fib n1) (fib n2)))))
 146.300 +
 146.301 +; First we rewrite it to make every computational step explicit
 146.302 +; in a let expression:
 146.303 +(defn fib [n]
 146.304 +  (if (< n 2)
 146.305 +    n
 146.306 +    (let [n1 (dec n)
 146.307 +	  n2 (dec n1)
 146.308 +	  f1 (fib n1)
 146.309 +	  f2 (fib n2)]
 146.310 +      (+ f1 f2))))
 146.311 +
 146.312 +; Next, we replace the let by a domonad in a writer monad that uses a
 146.313 +; vector accumulator. We can then place calls to write in between the
 146.314 +; steps, and obtain as a result both the return value of the function
 146.315 +; and the accumulated trace values.
 146.316 +(with-monad (writer-m accu/empty-vector)
 146.317 +
 146.318 +  (defn fib-trace [n]
 146.319 +    (if (< n 2)
 146.320 +      (m-result n)
 146.321 +      (domonad
 146.322 +        [n1 (m-result (dec n))
 146.323 +	 n2 (m-result (dec n1))
 146.324 +	 f1 (fib-trace n1)
 146.325 +	 _  (write [n1 f1])
 146.326 +	 f2 (fib-trace n2)
 146.327 +	 _  (write [n2 f2])
 146.328 +	 ]
 146.329 +	(+ f1 f2))))
 146.330 +
 146.331 +)
 146.332 +
 146.333 +(fib-trace 5)
 146.334 +
 146.335 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.336 +;;
 146.337 +;; Sequences with undefined value: the maybe-t monad transformer
 146.338 +;;
 146.339 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.340 +
 146.341 +; A monad transformer is a function that takes a monad argument and
 146.342 +; returns a monad as its result. The resulting monad adds some
 146.343 +; specific behaviour aspect to the input monad.
 146.344 +
 146.345 +; The simplest monad transformer is maybe-t. It adds the functionality
 146.346 +; of the maybe monad (handling failures or undefined values) to any other
 146.347 +; monad. We illustrate this by applying maybe-t to the sequence monad.
 146.348 +; The result is an enhanced sequence monad in which undefined values
 146.349 +; (represented by nil) are not subjected to any transformation, but
 146.350 +; lead immediately to a nil result in the output.
 146.351 +
 146.352 +; First we define the combined monad:
 146.353 +(def seq-maybe-m (maybe-t sequence-m))
 146.354 +
 146.355 +; As a first illustration, we create a range of integers and replace
 146.356 +; all even values by nil, using a simple when expression. We use this
 146.357 +; sequence in a monad comprehension that yields (inc x). The result
 146.358 +; is a sequence in which inc has been applied to all non-nil values,
 146.359 +; whereas the nil values appear unmodified in the output:
 146.360 +(domonad seq-maybe-m
 146.361 +  [x  (for [n (range 10)] (when (odd? n) n))]
 146.362 +  (inc x))
 146.363 +
 146.364 +; Next we repeat the definition of the function pairs (see above), but
 146.365 +; using the seq-maybe monad:
 146.366 +(with-monad seq-maybe-m
 146.367 +   (defn pairs-maybe [xs]
 146.368 +      (m-seq (list xs xs))))
 146.369 +
 146.370 +; Applying this to a sequence containing nils yields the pairs of all
 146.371 +; non-nil values interspersed with nils that result from any combination
 146.372 +; in which one or both of the values is nil:
 146.373 +(pairs-maybe (for [n (range 5)] (when (odd? n) n)))
 146.374 +
 146.375 +; It is important to realize that undefined values (nil) are not eliminated
 146.376 +; from the iterations. They are simply not passed on to any operations.
 146.377 +; The outcome of any function applied to arguments of which at least one
 146.378 +; is nil is supposed to be nil as well, and the function is never called.
 146.379 +
 146.380 +
 146.381 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.382 +;;
 146.383 +;; Continuation-passing style in the cont monad
 146.384 +;;
 146.385 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 146.386 +
 146.387 +; A simple computation performed in continuation-passing style.
 146.388 +; (m-result 1) returns a function that, when called with a single
 146.389 +; argument f, calls (f 1). The result of the domonad-computation is
 146.390 +; a function that behaves in the same way, passing 3 to its function
 146.391 +; argument. run-cont executes a continuation by calling it on identity.
 146.392 +(run-cont
 146.393 +  (domonad cont-m
 146.394 +    [x (m-result 1)
 146.395 +     y (m-result 2)]
 146.396 +    (+ x y)))
 146.397 +
 146.398 +; Let's capture a continuation using call-cc. We store it in a global
 146.399 +; variable so that we can do with it whatever we want. The computation
 146.400 +; is the same one as in the first example, but it has the side effect
 146.401 +; of storing the continuation at (m-result 2).
 146.402 +(def continuation nil)
 146.403 +
 146.404 +(run-cont
 146.405 +  (domonad cont-m
 146.406 +    [x (m-result 1)
 146.407 +     y (call-cc (fn [c] (def continuation c) (c 2)))]
 146.408 +    (+ x y)))
 146.409 +
 146.410 +; Now we can call the continuation with whatever argument we want. The
 146.411 +; supplied argument takes the place of 2 in the above computation:
 146.412 +(run-cont (continuation 5))
 146.413 +(run-cont (continuation 42))
 146.414 +(run-cont (continuation -1))
 146.415 +
 146.416 +; Next, a function that illustrates how a captured continuation can be
 146.417 +; used as an "emergency exit" out of a computation:
 146.418 +(defn sqrt-as-str [x]
 146.419 +  (call-cc
 146.420 +   (fn [k]
 146.421 +     (domonad cont-m
 146.422 +       [_ (m-when (< x 0) (k (str "negative argument " x)))]
 146.423 +       (str (. Math sqrt x))))))
 146.424 +
 146.425 +(run-cont (sqrt-as-str 2))
 146.426 +(run-cont (sqrt-as-str -2))
 146.427 +
 146.428 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   147.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   147.2 +++ b/src/clojure/contrib/test_contrib/pprint/examples/hexdump.clj	Sat Aug 21 06:25:44 2010 -0400
   147.3 @@ -0,0 +1,63 @@
   147.4 +;;; hexdump.clj -- part of the pretty printer for Clojure
   147.5 +
   147.6 +;; by Tom Faulhaber
   147.7 +;; April 3, 2009
   147.8 +
   147.9 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  147.10 +;   The use and distribution terms for this software are covered by the
  147.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  147.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  147.13 +;   By using this software in any fashion, you are agreeing to be bound by
  147.14 +;   the terms of this license.
  147.15 +;   You must not remove this notice, or any other, from this software.
  147.16 +
  147.17 +;; This example is a classic hexdump program written using cl-format.
  147.18 +
  147.19 +;; For some local color, it was written in Dulles Airport while waiting for a flight
  147.20 +;; home to San Francisco.
  147.21 +
  147.22 +(ns clojure.contrib.pprint.examples.hexdump
  147.23 +  (:use clojure.contrib.pprint
  147.24 +        clojure.contrib.pprint.utilities)
  147.25 +  (:gen-class (:main true)))
  147.26 +
  147.27 +(def *buffer-length* 1024)
  147.28 +
  147.29 +(defn zip-array [base-offset arr]
  147.30 +  (let [grouped (partition 16 arr)]
  147.31 +    (first (map-passing-context
  147.32 +            (fn [line offset]
  147.33 +              [[offset 
  147.34 +                (map #(if (neg? %) (+ % 256) %) line)
  147.35 +                (- 16 (count line))
  147.36 +                (map #(if (<= 32 % 126) (char %) \.) line)]
  147.37 +               (+ 16 offset)])
  147.38 +            base-offset grouped))))
  147.39 +
  147.40 +
  147.41 +(defn hexdump 
  147.42 +  ([in-stream] (hexdump in-stream true 0))
  147.43 +  ([in-stream out-stream] (hexdump [in-stream out-stream 0]))
  147.44 +  ([in-stream out-stream offset] 
  147.45 +     (let [buf (make-array Byte/TYPE *buffer-length*)]
  147.46 +       (loop [offset offset
  147.47 +              count (.read in-stream buf)]
  147.48 +         (if (neg? count)
  147.49 +           nil
  147.50 +           (let [bytes (take count buf)
  147.51 +                 zipped (zip-array offset bytes)]
  147.52 +             (cl-format out-stream 
  147.53 +                        "~:{~8,'0X: ~2{~8@{~#[   ~:;~2,'0X ~]~}  ~}~v@{   ~}~2{~8@{~A~} ~}~%~}" 
  147.54 +                        zipped) 
  147.55 +             (recur (+ offset *buffer-length*) (.read in-stream buf))))))))
  147.56 +
  147.57 +(defn hexdump-file 
  147.58 +  ([file-name] (hexdump-file file-name true))
  147.59 +  ([file-name stream] 
  147.60 +     (with-open [s (java.io.FileInputStream. file-name)] 
  147.61 +       (hexdump s))))
  147.62 +
  147.63 +;; I don't quite understand how to invoke main funcs w/o AOT yet
  147.64 +(defn -main [& args]
  147.65 +  (hexdump-file (first args)))
  147.66 +
   148.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   148.2 +++ b/src/clojure/contrib/test_contrib/pprint/examples/json.clj	Sat Aug 21 06:25:44 2010 -0400
   148.3 @@ -0,0 +1,142 @@
   148.4 +;;; json.clj: A pretty printing version of the JavaScript Object Notation (JSON) generator
   148.5 +
   148.6 +;; by Tom Faulhaber, based on the version by Stuart Sierra (clojure.contrib.json.write)
   148.7 +;; May 9, 2009
   148.8 +
   148.9 +;; Copyright (c) Tom Faulhaber/Stuart Sierra, 2009. All rights reserved.  The use
  148.10 +;; and distribution terms for this software are covered by the Eclipse
  148.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  148.12 +;; which can be found in the file epl-v10.html at the root of this
  148.13 +;; distribution.  By using this software in any fashion, you are
  148.14 +;; agreeing to be bound by the terms of this license.  You must not
  148.15 +;; remove this notice, or any other, from this software.
  148.16 +
  148.17 +
  148.18 +(ns 
  148.19 +  #^{:author "Tom Faulhaber (based on the version by Stuart Sierra)",
  148.20 +     :doc "Pretty printing JavaScript Object Notation (JSON) generator.
  148.21 +
  148.22 +This is an example of using a pretty printer dispatch function to generate JSON output",
  148.23 +     :see-also [["http://json.org/", "JSON Home Page"]]}
  148.24 +  clojure.contrib.pprint.examples.json
  148.25 +  (:use [clojure.test :only (deftest- is)]
  148.26 +        [clojure.contrib.string :only (as-str)]
  148.27 +        [clojure.contrib.pprint :only (write formatter-out)]))
  148.28 +
  148.29 +
  148.30 +
  148.31 +(defmulti dispatch-json
  148.32 +  "The dispatch function for printing objects as JSON"
  148.33 +  {:arglists '[[x]]} 
  148.34 +  (fn [x] (cond
  148.35 +            (nil? x) nil ;; prevent NullPointerException on next line
  148.36 +            (.isArray (class x)) ::array
  148.37 +            :else (type x))))
  148.38 +
  148.39 +;; Primitive types can be printed with Clojure's pr function.
  148.40 +(derive java.lang.Boolean ::pr)
  148.41 +(derive java.lang.Byte ::pr)
  148.42 +(derive java.lang.Short ::pr)
  148.43 +(derive java.lang.Integer ::pr)
  148.44 +(derive java.lang.Long ::pr)
  148.45 +(derive java.lang.Float ::pr)
  148.46 +(derive java.lang.Double ::pr)
  148.47 +
  148.48 +;; Collection types can be printed as JSON objects or arrays.
  148.49 +(derive java.util.Map ::object)
  148.50 +(derive java.util.Collection ::array)
  148.51 +
  148.52 +;; Symbols and keywords are converted to strings.
  148.53 +(derive clojure.lang.Symbol ::symbol)
  148.54 +(derive clojure.lang.Keyword ::symbol)
  148.55 +
  148.56 +
  148.57 +(defmethod dispatch-json ::pr [x] (pr x))
  148.58 +
  148.59 +(defmethod dispatch-json nil [x] (print "null"))
  148.60 +
  148.61 +(defmethod dispatch-json ::symbol [x] (pr (name x)))
  148.62 +
  148.63 +(defmethod dispatch-json ::array [s] 
  148.64 +  ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s))
  148.65 +
  148.66 +(defmethod dispatch-json ::object [m]
  148.67 +  ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 
  148.68 +   (for [[k v] m] [(as-str k) v])))
  148.69 +
  148.70 +(defmethod dispatch-json java.lang.CharSequence [s]
  148.71 +  (print \")
  148.72 +  (dotimes [i (count s)]
  148.73 +    (let [cp (Character/codePointAt s i)]
  148.74 +      (cond
  148.75 +        ;; Handle printable JSON escapes before ASCII
  148.76 +        (= cp 34) (print "\\\"")
  148.77 +        (= cp 92) (print "\\\\")
  148.78 +        ;; Print simple ASCII characters
  148.79 +        (< 31 cp 127) (print (.charAt s i))
  148.80 +        ;; Handle non-printable JSON escapes
  148.81 +        (= cp 8) (print "\\b")
  148.82 +        (= cp 12) (print "\\f")
  148.83 +        (= cp 10) (print "\\n")
  148.84 +        (= cp 13) (print "\\r")
  148.85 +        (= cp 9) (print "\\t")
  148.86 +        ;; Any other character is printed as Hexadecimal escape
  148.87 +        :else (printf "\\u%04x" cp))))
  148.88 +  (print \"))
  148.89 +
  148.90 +(defn print-json 
  148.91 +  "Prints x as JSON.  Nil becomes JSON null.  Keywords become
  148.92 +  strings, without the leading colon.  Maps become JSON objects, all
  148.93 +  other collection types become JSON arrays.  Java arrays become JSON
  148.94 +  arrays.  Unicode characters in strings are escaped as \\uXXXX.
  148.95 +  Numbers print as with pr."
  148.96 +  [x] 
  148.97 +  (write x :dispatch dispatch-json))
  148.98 +
  148.99 +(defn json-str
 148.100 +  "Converts x to a JSON-formatted string."
 148.101 +  [x]
 148.102 +  (with-out-str (print-json x)))
 148.103 +
 148.104 +
 148.105 +
 148.106 +;;; TESTS
 148.107 +
 148.108 +;; Run these tests with
 148.109 +;; (clojure.test/run-tests 'clojure.contrib.print-json)
 148.110 +
 148.111 +;; Bind clojure.test/*load-tests* to false to omit these
 148.112 +;; tests from production code.
 148.113 +
 148.114 +(deftest- can-print-json-strings
 148.115 +  (is (= "\"Hello, World!\"" (json-str "Hello, World!")))
 148.116 +  (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes"))))
 148.117 +
 148.118 +(deftest- can-print-unicode
 148.119 +  (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567"))))
 148.120 +
 148.121 +(deftest- can-print-json-null
 148.122 +  (is (= "null" (json-str nil))))
 148.123 +
 148.124 +(deftest- can-print-json-arrays
 148.125 +  (is (= "[1, 2, 3]" (json-str [1 2 3])))
 148.126 +  (is (= "[1, 2, 3]" (json-str (list 1 2 3))))
 148.127 +  (is (= "[1, 2, 3]" (json-str (sorted-set 1 2 3))))
 148.128 +  (is (= "[1, 2, 3]" (json-str (seq [1 2 3])))))
 148.129 +
 148.130 +(deftest- can-print-java-arrays
 148.131 +  (is (= "[1, 2, 3]" (json-str (into-array [1 2 3])))))
 148.132 +
 148.133 +(deftest- can-print-empty-arrays
 148.134 +  (is (= "[]" (json-str [])))
 148.135 +  (is (= "[]" (json-str (list))))
 148.136 +  (is (= "[]" (json-str #{}))))
 148.137 +
 148.138 +(deftest- can-print-json-objects
 148.139 +  (is (= "{\"a\":1, \"b\":2}" (json-str (sorted-map :a 1 :b 2)))))
 148.140 +
 148.141 +(deftest- object-keys-must-be-strings
 148.142 +  (is (= "{\"1\":1, \"2\":2}" (json-str (sorted-map 1 1 2 2)))))
 148.143 +
 148.144 +(deftest- can-print-empty-objects
 148.145 +  (is (= "{}" (json-str {}))))
   149.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   149.2 +++ b/src/clojure/contrib/test_contrib/pprint/examples/multiply.clj	Sat Aug 21 06:25:44 2010 -0400
   149.3 @@ -0,0 +1,23 @@
   149.4 +;;; multiply.clj -- part of the pretty printer for Clojure
   149.5 +
   149.6 +;; by Tom Faulhaber
   149.7 +;; April 3, 2009
   149.8 +
   149.9 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  149.10 +;   The use and distribution terms for this software are covered by the
  149.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  149.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  149.13 +;   By using this software in any fashion, you are agreeing to be bound by
  149.14 +;   the terms of this license.
  149.15 +;   You must not remove this notice, or any other, from this software.
  149.16 +
  149.17 +;; This example prints a multiplication table using cl-format.
  149.18 +
  149.19 +(ns clojure.contrib.pprint.examples.multiply
  149.20 +  (:use clojure.contrib.pprint))
  149.21 +
  149.22 +(defn multiplication-table [limit]
  149.23 +  (let [nums (range 1 (inc limit))]
  149.24 +    (cl-format true "~{~{~4d~}~%~}" 
  149.25 +             (map #(map % nums) 
  149.26 +                  (map #(partial * %) nums)))))
   150.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   150.2 +++ b/src/clojure/contrib/test_contrib/pprint/examples/props.clj	Sat Aug 21 06:25:44 2010 -0400
   150.3 @@ -0,0 +1,25 @@
   150.4 +;;; props.clj -- part of the pretty printer for Clojure
   150.5 +
   150.6 +;; by Tom Faulhaber
   150.7 +;; April 3, 2009
   150.8 +
   150.9 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  150.10 +;   The use and distribution terms for this software are covered by the
  150.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  150.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  150.13 +;   By using this software in any fashion, you are agreeing to be bound by
  150.14 +;   the terms of this license.
  150.15 +;   You must not remove this notice, or any other, from this software.
  150.16 +
  150.17 +;; This example displays a nicely formatted table of the java properties using
  150.18 +;; cl-format
  150.19 +
  150.20 +(ns clojure.contrib.pprint.examples.props
  150.21 +  (:use clojure.contrib.pprint))
  150.22 +
  150.23 +(defn show-props [stream]
  150.24 +  (let [p (mapcat 
  150.25 +           #(vector (key %) (val %)) 
  150.26 +           (sort-by key (System/getProperties)))]
  150.27 +    (cl-format true "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}" 
  150.28 +               "Property" "Value" ["" "" "" ""] p)))
   151.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   151.2 +++ b/src/clojure/contrib/test_contrib/pprint/examples/show_doc.clj	Sat Aug 21 06:25:44 2010 -0400
   151.3 @@ -0,0 +1,50 @@
   151.4 +;;; show_doc.clj -- part of the pretty printer for Clojure
   151.5 +
   151.6 +;; by Tom Faulhaber
   151.7 +;; April 3, 2009
   151.8 +
   151.9 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  151.10 +;   The use and distribution terms for this software are covered by the
  151.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  151.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  151.13 +;   By using this software in any fashion, you are agreeing to be bound by
  151.14 +;   the terms of this license.
  151.15 +;   You must not remove this notice, or any other, from this software.
  151.16 +
  151.17 +;; This example uses cl-format as part of a routine to display all the doc
  151.18 +;; strings and function arguments from one or more namespaces.
  151.19 +
  151.20 +(ns clojure.contrib.pprint.examples.show-doc
  151.21 +  (:use clojure.contrib.pprint))
  151.22 +
  151.23 +(defn ns-list
  151.24 +  ([] (ns-list nil))
  151.25 +  ([pattern] 
  151.26 +     (filter 
  151.27 +      (if pattern
  151.28 +        (comp (partial re-find pattern) name ns-name)
  151.29 +        (constantly true))
  151.30 +      (sort-by ns-name (all-ns)))))
  151.31 +
  151.32 +(defn show-doc 
  151.33 +  ([] (show-doc nil)) 
  151.34 +  ([pattern] 
  151.35 +     (cl-format 
  151.36 +      true 
  151.37 +      "~:{~A: ===============================================~
  151.38 +       ~%~{~{~a: ~{~a~^, ~}~%~a~%~}~^~%~}~2%~}" 
  151.39 +      (map 
  151.40 +       #(vector (ns-name %) 
  151.41 +                (map
  151.42 +                 (fn [f] 
  151.43 +                   (let [f-meta (meta (find-var (symbol (str (ns-name %)) (str f))))] 
  151.44 +                     [f (:arglists f-meta) (:doc f-meta)]))
  151.45 +                 (filter 
  151.46 +                  (fn [a] (instance? clojure.lang.IFn a)) 
  151.47 +                  (sort (map key (ns-publics %))))))
  151.48 +       (ns-list pattern)))))
  151.49 +
  151.50 +(defn create-api-file [pattern out-file]
  151.51 +  (with-open [f (java.io.FileWriter. out-file)]
  151.52 +    (binding [*out* f]
  151.53 +      (show-doc pattern))))
   152.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   152.2 +++ b/src/clojure/contrib/test_contrib/pprint/examples/xml.clj	Sat Aug 21 06:25:44 2010 -0400
   152.3 @@ -0,0 +1,121 @@
   152.4 +;;; xml.clj -- a pretty print dispatch version of prxml.clj -- a compact syntax for generating XML
   152.5 +
   152.6 +;; by Tom Faulhaber, based on the original by Stuart Sierra, http://stuartsierra.com/
   152.7 +;; May 13, 2009
   152.8 +
   152.9 +;; Copyright (c) 2009 Tom Faulhaber/Stuart Sierra. All rights reserved.  The use and
  152.10 +;; distribution terms for this software are covered by the Eclipse
  152.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  152.12 +;; which can be found in the file epl-v10.html at the root of this
  152.13 +;; distribution.  By using this software in any fashion, you are
  152.14 +;; agreeing to be bound by the terms of this license.  You must not
  152.15 +;; remove this notice, or any other, from this software.
  152.16 +
  152.17 +
  152.18 +;; See function "prxml" at the bottom of this file for documentation.
  152.19 +
  152.20 +
  152.21 +(ns 
  152.22 +  #^{:author "Tom Faulhaber, based on the original by Stuart Sierra",
  152.23 +     :doc "A version of prxml that uses a pretty print dispatch function."}
  152.24 +  clojure.contrib.pprint.examples.xml
  152.25 +  (:use [clojure.contrib.string :only (as-str escape)]
  152.26 +        [clojure.contrib.pprint :only (formatter-out write)]
  152.27 +        [clojure.contrib.pprint.utilities :only (prlabel)]))
  152.28 +
  152.29 +(def
  152.30 + #^{:doc "If true, empty tags will have a space before the closing />"}
  152.31 + *html-compatible* false)
  152.32 +
  152.33 +(def
  152.34 + #^{:doc "The number of spaces to indent sub-tags."}
  152.35 + *prxml-indent* 2)
  152.36 +
  152.37 +(defmulti #^{:private true} print-xml-tag (fn [tag attrs content] tag))
  152.38 +
  152.39 +(defmethod print-xml-tag :raw! [tag attrs contents]
  152.40 +  (doseq [c contents] (print c)))
  152.41 +
  152.42 +(defmethod print-xml-tag :comment! [tag attrs contents]
  152.43 +  (print "<!-- ")
  152.44 +  (doseq [c contents] (print c))
  152.45 +  (print " -->"))
  152.46 +
  152.47 +(defmethod print-xml-tag :decl! [tag attrs contents]
  152.48 +  (let [attrs (merge {:version "1.0" :encoding "UTF-8"}
  152.49 +                     attrs)]
  152.50 +    ;; Must enforce ordering of pseudo-attributes:
  152.51 +    ((formatter-out "<?xml version=\"~a\" encoding=\"~a\"~@[ standalone=\"~a\"~]?>") 
  152.52 +     (:version attrs) (:encoding attrs) (:standalone attrs))))
  152.53 +
  152.54 +(defmethod print-xml-tag :cdata! [tag attrs contents]
  152.55 +  ((formatter-out "<[!CDATA[~{~a~}]]>") contents))
  152.56 +
  152.57 +(defmethod print-xml-tag :doctype! [tag attrs contents]
  152.58 +  ((formatter-out "<[!DOCTYPE [~{~a~}]]>") contents))
  152.59 +
  152.60 +(defmethod print-xml-tag :default [tag attrs contents]
  152.61 +  (let [tag-name (as-str tag)
  152.62 +        xlated-attrs (map #(vector (as-str (key %)) (as-str (val %))) attrs)]
  152.63 +    (if (seq contents)
  152.64 +      ((formatter-out "~<~<<~a~1:i~{ ~:_~{~a=\"~a\"~}~}>~:>~vi~{~_~w~}~0i~_</~a>~:>")
  152.65 +       [[tag-name xlated-attrs] *prxml-indent* contents tag-name])
  152.66 +      ((formatter-out "~<<~a~1:i~{~:_ ~{~a=\"~a\"~}~}/>~:>") [tag-name xlated-attrs]))))
  152.67 +
  152.68 +
  152.69 +(defmulti xml-dispatch class)
  152.70 +
  152.71 +(defmethod xml-dispatch clojure.lang.IPersistentVector [x]
  152.72 +  (let [[tag & contents] x
  152.73 +        [attrs content] (if (map? (first contents))
  152.74 +                          [(first contents) (rest contents)]
  152.75 +                          [{} contents])]
  152.76 +    (print-xml-tag tag attrs content)))
  152.77 +
  152.78 +(defmethod xml-dispatch clojure.lang.ISeq [x]
  152.79 +  ;; Recurse into sequences, so we can use (map ...) inside prxml.
  152.80 +  (doseq [c x] (xml-dispatch c)))
  152.81 +
  152.82 +(defmethod xml-dispatch clojure.lang.Keyword [x]
  152.83 +  (print-xml-tag x {} nil))
  152.84 +
  152.85 +
  152.86 +(defmethod xml-dispatch String [x]
  152.87 +  (print (escape {\< "&lt;"
  152.88 +                  \> "&gt;"
  152.89 +                  \& "&amp;"
  152.90 +                  \' "&apos;"
  152.91 +                  \" "&quot;"} x)))
  152.92 +
  152.93 +(defmethod xml-dispatch nil [x])
  152.94 +
  152.95 +(defmethod xml-dispatch :default [x]
  152.96 +  (print x))
  152.97 +
  152.98 +
  152.99 +(defn prxml
 152.100 +  "Print XML to *out*.  Vectors become XML tags: the first item is the
 152.101 +  tag name; optional second item is a map of attributes.
 152.102 +
 152.103 +  Sequences are processed recursively, so you can use map and other
 152.104 +  sequence functions inside prxml.
 152.105 +
 152.106 +    (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]])
 152.107 +    ; => <p class=\"greet\"><i>Ladies &amp; gentlemen</i></p>
 152.108 +
 152.109 +  PSEUDO-TAGS: some keywords have special meaning:
 152.110 +
 152.111 +    :raw!      do not XML-escape contents
 152.112 +    :comment!  create an XML comment
 152.113 +    :decl!     create an XML declaration, with attributes
 152.114 +    :cdata!    create a CDATA section
 152.115 +    :doctype!  create a DOCTYPE!
 152.116 +
 152.117 +    (prxml [:p [:raw! \"<i>here & gone</i>\"]])
 152.118 +    ; => <p><i>here & gone</i></p>
 152.119 +
 152.120 +    (prxml [:decl! {:version \"1.1\"}])
 152.121 +    ; => <?xml version=\"1.1\" encoding=\"UTF-8\"?>"
 152.122 +  [& args]
 152.123 +  (doseq [arg args] (write arg :dispatch xml-dispatch))
 152.124 +  (when (pos? (count args)) (newline)))
   153.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   153.2 +++ b/src/clojure/contrib/test_contrib/pprint/test_cl_format.clj	Sat Aug 21 06:25:44 2010 -0400
   153.3 @@ -0,0 +1,691 @@
   153.4 +;;; cl_format.clj -- part of the pretty printer for Clojure
   153.5 +
   153.6 +;; by Tom Faulhaber
   153.7 +;; April 3, 2009
   153.8 +
   153.9 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
  153.10 +;   The use and distribution terms for this software are covered by the
  153.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  153.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  153.13 +;   By using this software in any fashion, you are agreeing to be bound by
  153.14 +;   the terms of this license.
  153.15 +;   You must not remove this notice, or any other, from this software.
  153.16 +
  153.17 +;; This test set tests the basic cl-format functionality
  153.18 +
  153.19 +(ns clojure.contrib.pprint.test-cl-format
  153.20 +  (:refer-clojure :exclude [format])
  153.21 +  (:use [clojure.test :only (deftest are run-tests)]
  153.22 +        clojure.contrib.pprint.test-helper
  153.23 +        clojure.contrib.pprint))
  153.24 +
  153.25 +(def format cl-format)
  153.26 +
  153.27 +;; TODO tests for ~A, ~D, etc.
  153.28 +;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding
  153.29 +
  153.30 +(simple-tests d-tests
  153.31 +  (cl-format nil "~D" 0) "0"
  153.32 +  (cl-format nil "~D" 2e6) "2000000"
  153.33 +  (cl-format nil "~D" 2000000) "2000000"
  153.34 +  (cl-format nil "~:D" 2000000) "2,000,000"
  153.35 +  (cl-format nil "~D" 1/2) "1/2"
  153.36 +  (cl-format nil "~D" 'fred) "fred"
  153.37 +)
  153.38 +
  153.39 +(simple-tests base-tests
  153.40 +  (cl-format nil "~{~2r~^ ~}~%" (range 10))
  153.41 +  "0 1 10 11 100 101 110 111 1000 1001\n"
  153.42 +  (with-out-str
  153.43 +    (dotimes [i 35]
  153.44 +      (binding [*print-base* (+ i 2)]       ;print the decimal number 40 
  153.45 +        (write 40)                          ;in each base from 2 to 36
  153.46 +        (if (zero? (mod i 10)) (prn) (cl-format true " ")))))
  153.47 +  "101000
  153.48 +1111 220 130 104 55 50 44 40 37 34
  153.49 +31 2c 2a 28 26 24 22 20 1j 1i
  153.50 +1h 1g 1f 1e 1d 1c 1b 1a 19 18
  153.51 +17 16 15 14 "
  153.52 +  (with-out-str
  153.53 +    (doseq [pb [2 3 8 10 16]]               
  153.54 +      (binding [*print-radix* true      ;print the integer 10 and 
  153.55 +            *print-base* pb]            ;the ratio 1/10 in bases 2, 
  153.56 +        (cl-format true "~&~S  ~S~%" 10 1/10))))        ;3, 8, 10, 16
  153.57 +  "#b1010  #b1/1010
  153.58 +#3r101  #3r1/101
  153.59 +#o12  #o1/12
  153.60 +10.  #10r1/10
  153.61 +#xa  #x1/a
  153.62 +")
  153.63 +
  153.64 +
  153.65 +
  153.66 +(simple-tests cardinal-tests
  153.67 +  (cl-format nil "~R" 0) "zero"
  153.68 +  (cl-format nil "~R" 4) "four"
  153.69 +  (cl-format nil "~R" 15) "fifteen"
  153.70 +  (cl-format nil "~R" -15) "minus fifteen"
  153.71 +  (cl-format nil "~R" 25) "twenty-five"
  153.72 +  (cl-format nil "~R" 20) "twenty"
  153.73 +  (cl-format nil "~R" 200) "two hundred"
  153.74 +  (cl-format nil "~R" 203) "two hundred three"
  153.75 +
  153.76 +  (cl-format nil "~R" 44879032)
  153.77 +  "forty-four million, eight hundred seventy-nine thousand, thirty-two"
  153.78 +
  153.79 +  (cl-format nil "~R" -44879032)
  153.80 +  "minus forty-four million, eight hundred seventy-nine thousand, thirty-two"
  153.81 +  
  153.82 +  (cl-format nil "~R = ~:*~:D" 44000032)
  153.83 +  "forty-four million, thirty-two = 44,000,032"
  153.84 +
  153.85 +  (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
  153.86 +  "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"
  153.87 +
  153.88 +  (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
  153.89 +  "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"
  153.90 +
  153.91 +  (cl-format nil "~R = ~:*~:D" 2e6)
  153.92 +  "two million = 2,000,000"
  153.93 +
  153.94 +  (cl-format nil "~R = ~:*~:D" 200000200000)
  153.95 +  "two hundred billion, two hundred thousand = 200,000,200,000")
  153.96 +
  153.97 +(simple-tests ordinal-tests
  153.98 +  (cl-format nil "~:R" 0) "zeroth"
  153.99 +  (cl-format nil "~:R" 4) "fourth"
 153.100 +  (cl-format nil "~:R" 15) "fifteenth"
 153.101 +  (cl-format nil "~:R" -15) "minus fifteenth"
 153.102 +  (cl-format nil "~:R" 25) "twenty-fifth"
 153.103 +  (cl-format nil "~:R" 20) "twentieth"
 153.104 +  (cl-format nil "~:R" 200) "two hundredth"
 153.105 +  (cl-format nil "~:R" 203) "two hundred third"
 153.106 +
 153.107 +  (cl-format nil "~:R" 44879032)
 153.108 +  "forty-four million, eight hundred seventy-nine thousand, thirty-second"
 153.109 +
 153.110 +  (cl-format nil "~:R" -44879032)
 153.111 +  "minus forty-four million, eight hundred seventy-nine thousand, thirty-second"
 153.112 +  
 153.113 +  (cl-format nil "~:R = ~:*~:D" 44000032)
 153.114 +  "forty-four million, thirty-second = 44,000,032"
 153.115 +
 153.116 +  (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
 153.117 +  "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"
 153.118 +  (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
 153.119 +  "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"
 153.120 +  (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471)
 153.121 +  "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"
 153.122 +  (cl-format nil "~:R = ~:*~:D" 2e6)
 153.123 +  "two millionth = 2,000,000")
 153.124 +
 153.125 +(simple-tests ordinal1-tests
 153.126 +  (cl-format nil "~:R" 1) "first"
 153.127 +  (cl-format nil "~:R" 11) "eleventh"
 153.128 +  (cl-format nil "~:R" 21) "twenty-first"
 153.129 +  (cl-format nil "~:R" 20) "twentieth"
 153.130 +  (cl-format nil "~:R" 220) "two hundred twentieth"
 153.131 +  (cl-format nil "~:R" 200) "two hundredth"
 153.132 +  (cl-format nil "~:R" 999) "nine hundred ninety-ninth"
 153.133 +  )
 153.134 +
 153.135 +(simple-tests roman-tests
 153.136 +  (cl-format nil "~@R" 3) "III"
 153.137 +  (cl-format nil "~@R" 4) "IV"
 153.138 +  (cl-format nil "~@R" 9) "IX"
 153.139 +  (cl-format nil "~@R" 29) "XXIX"
 153.140 +  (cl-format nil "~@R" 429) "CDXXIX"
 153.141 +  (cl-format nil "~@:R" 429) "CCCCXXVIIII"
 153.142 +  (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII"
 153.143 +  (cl-format nil "~@R" 3429) "MMMCDXXIX"
 153.144 +  (cl-format nil "~@R" 3479) "MMMCDLXXIX"
 153.145 +  (cl-format nil "~@R" 3409) "MMMCDIX"
 153.146 +  (cl-format nil "~@R" 300) "CCC"
 153.147 +  (cl-format nil "~@R ~D" 300 20) "CCC 20"
 153.148 +  (cl-format nil "~@R" 5000) "5,000"
 153.149 +  (cl-format nil "~@R ~D" 5000 20) "5,000 20"
 153.150 +  (cl-format nil "~@R" "the quick") "the quick")
 153.151 +
 153.152 +(simple-tests c-tests
 153.153 +  (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n"
 153.154 +  (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n"
 153.155 +  (cl-format nil "~@C~%" \m) "\\m\n"
 153.156 +  (cl-format nil "~@C~%" (char 222)) "\\Þ\n"
 153.157 +  (cl-format nil "~@C~%" (char 8)) "\\backspace\n"
 153.158 +  (cl-format nil "~@C~%" (char 3)) "\\\n")
 153.159 +
 153.160 +(simple-tests e-tests
 153.161 +  (cl-format nil "*~E*" 0.0) "*0.0E+0*"
 153.162 +  (cl-format nil "*~6E*" 0.0) "*0.0E+0*"
 153.163 +  (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*"
 153.164 +  (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*"
 153.165 +  (cl-format nil "*~5E*" 0.0) "*0.E+0*"
 153.166 +  (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*"
 153.167 +  (cl-format nil "*~10,2E*" 9.99999) "*   1.00E+1*"
 153.168 +  (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*"
 153.169 +  (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*"
 153.170 +  (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*"
 153.171 +  )
 153.172 +  
 153.173 +(simple-tests $-tests
 153.174 +  (cl-format nil "~$" 22.3) "22.30"
 153.175 +  (cl-format nil "~$" 22.375) "22.38"
 153.176 +  (cl-format nil "~3,5$" 22.375) "00022.375"
 153.177 +  (cl-format nil "~3,5,8$" 22.375) "00022.375"
 153.178 +  (cl-format nil "~3,5,10$" 22.375) " 00022.375"
 153.179 +  (cl-format nil "~3,5,14@$" 22.375) "    +00022.375"
 153.180 +  (cl-format nil "~3,5,14@$" 22.375) "    +00022.375"
 153.181 +  (cl-format nil "~3,5,14@:$" 22.375) "+    00022.375"
 153.182 +  (cl-format nil "~3,,14@:$" 0.375) "+        0.375"
 153.183 +  (cl-format nil "~1,1$" -12.0) "-12.0"
 153.184 +  (cl-format nil "~1,1$" 12.0) "12.0"
 153.185 +  (cl-format nil "~1,1$" 12.0) "12.0"
 153.186 +  (cl-format nil "~1,1@$" 12.0) "+12.0"
 153.187 +  (cl-format nil "~1,1,8,' @:$" 12.0) "+   12.0"
 153.188 +  (cl-format nil "~1,1,8,' @$" 12.0) "   +12.0"
 153.189 +  (cl-format nil "~1,1,8,' :$" 12.0) "    12.0"
 153.190 +  (cl-format nil "~1,1,8,' $" 12.0) "    12.0"
 153.191 +  (cl-format nil "~1,1,8,' @:$" -12.0) "-   12.0"
 153.192 +  (cl-format nil "~1,1,8,' @$" -12.0) "   -12.0"
 153.193 +  (cl-format nil "~1,1,8,' :$" -12.0) "-   12.0"
 153.194 +  (cl-format nil "~1,1,8,' $" -12.0) "   -12.0"
 153.195 +  (cl-format nil "~1,1$" 0.001) "0.0"
 153.196 +  (cl-format nil "~2,1$" 0.001) "0.00"
 153.197 +  (cl-format nil "~1,1,6$" 0.001) "   0.0"
 153.198 +  (cl-format nil "~1,1,6$" 0.0015) "   0.0"
 153.199 +  (cl-format nil "~2,1,6$" 0.005) "  0.01"
 153.200 +  (cl-format nil "~2,1,6$" 0.01) "  0.01"
 153.201 +  (cl-format nil "~$" 0.099) "0.10"
 153.202 +  (cl-format nil "~1$" 0.099) "0.1"
 153.203 +  (cl-format nil "~1$" 0.1) "0.1"
 153.204 +  (cl-format nil "~1$" 0.99) "1.0"
 153.205 +  (cl-format nil "~1$" -0.99) "-1.0")
 153.206 +
 153.207 +(simple-tests f-tests
 153.208 +  (cl-format nil "~,1f" -12.0) "-12.0"
 153.209 +  (cl-format nil "~,0f" 9.4) "9."
 153.210 +  (cl-format nil "~,0f" 9.5) "10."
 153.211 +  (cl-format nil "~,0f" -0.99) "-1."
 153.212 +  (cl-format nil "~,1f" -0.99) "-1.0"
 153.213 +  (cl-format nil "~,2f" -0.99) "-0.99"
 153.214 +  (cl-format nil "~,3f" -0.99) "-0.990"
 153.215 +  (cl-format nil "~,0f" 0.99) "1."
 153.216 +  (cl-format nil "~,1f" 0.99) "1.0"
 153.217 +  (cl-format nil "~,2f" 0.99) "0.99"
 153.218 +  (cl-format nil "~,3f" 0.99) "0.990"
 153.219 +  (cl-format nil "~f" -1) "-1.0"
 153.220 +  (cl-format nil "~2f" -1) "-1."
 153.221 +  (cl-format nil "~3f" -1) "-1."
 153.222 +  (cl-format nil "~4f" -1) "-1.0"
 153.223 +  (cl-format nil "~8f" -1) "    -1.0"
 153.224 +  (cl-format nil "~1,1f" 0.1) ".1")
 153.225 +
 153.226 +(simple-tests ampersand-tests
 153.227 +  (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5)
 153.228 +  "The quick brown elephant jumped over 5 lazy dogs"
 153.229 +  (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5)
 153.230 +  "The quick brown \nelephant jumped over 5 lazy dogs"
 153.231 +  (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
 153.232 +  "The quick brown \nelephant jumped\n over 5 lazy dogs"
 153.233 +  (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
 153.234 +  "The quick brown \nelephant jumped\n over 5 lazy dogs"
 153.235 +  (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
 153.236 +  "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs"
 153.237 +  (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10)
 153.238 +  "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs"
 153.239 +  (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n"
 153.240 +  (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n")
 153.241 +
 153.242 +(simple-tests t-tests
 153.243 +  (cl-format nil "~@{~&~A~8,4T~:*~A~}" 
 153.244 +             'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
 153.245 +  "a       a\naa      aa\naaa     aaa\naaaa    aaaa\naaaaa   aaaaa\naaaaaa  aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa    aaaaaaaa\naaaaaaaaa   aaaaaaaaa\naaaaaaaaaa  aaaaaaaaaa"
 153.246 +  (cl-format nil "~@{~&~A~,4T~:*~A~}" 
 153.247 +             'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
 153.248 +  "a    a\naa   aa\naaa  aaa\naaaa aaaa\naaaaa    aaaaa\naaaaaa   aaaaaa\naaaaaaa  aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa    aaaaaaaaa\naaaaaaaaaa   aaaaaaaaaa"
 153.249 +  (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
 153.250 +  "a     a\naa    aa\naaa   aaa\naaaa  aaaa\naaaaa       aaaaa\naaaaaa      aaaaaa\naaaaaaa     aaaaaaa\naaaaaaaa    aaaaaaaa\naaaaaaaaa   aaaaaaaaa\naaaaaaaaaa  aaaaaaaaaa"
 153.251 +)
 153.252 +
 153.253 +(simple-tests paren-tests
 153.254 +  (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here"
 153.255 +  (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here"
 153.256 +  (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT"
 153.257 +  (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!"
 153.258 +  ;; Test cases from CLtL 18.3 - string-upcase, et al.
 153.259 +  (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" 
 153.260 +  (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" 
 153.261 +  (cl-format nil "~:(~A~)" " hello ") " Hello " 
 153.262 +  (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") 
 153.263 +  "Occluded Casements Forestall Inadvertent Defenestration" 
 153.264 +  (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" 
 153.265 +  (cl-format nil "~:(~A~)" "DON'T!") "Don'T!"     ;not "Don't!" 
 153.266 +  (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c"
 153.267 +)
 153.268 +
 153.269 +(simple-tests square-bracket-tests
 153.270 +  ;; Tests for format without modifiers
 153.271 +  (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n"
 153.272 +  (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n"
 153.273 +  (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n"
 153.274 +  (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n"
 153.275 +  (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n"
 153.276 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n"
 153.277 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n"
 153.278 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n"
 153.279 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n"
 153.280 +
 153.281 +  ;; Tests for format with a colon 
 153.282 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n"
 153.283 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n"
 153.284 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n"
 153.285 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n"
 153.286 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n"
 153.287 +
 153.288 +  ;; Tests for format with an at sign
 153.289 +  (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n"
 153.290 +  (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17)
 153.291 +  "We had 15 wins (out of 17 tries).\n"
 153.292 +
 153.293 +  ;; Format tests with directives
 153.294 +  (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7)
 153.295 +  "Max 15: Blue team 7.\n"
 153.296 +  (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12)
 153.297 +  "Max 15: Red team 12.\n"
 153.298 +  (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 
 153.299 +             15, -1, "(system failure)")
 153.300 +  "Max 15: No team (system failure).\n"
 153.301 +
 153.302 +  ;; Nested format tests
 153.303 +  (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" 
 153.304 +             15, 0, 7, true)
 153.305 +  "Max 15: Blue team 7 (complete success).\n"
 153.306 +  (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" 
 153.307 +             15, 0, 7, false)
 153.308 +  "Max 15: Blue team 7.\n"
 153.309 +
 153.310 +  ;; Test the selector as part of the argument
 153.311 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].")
 153.312 +  "The answer is nothing."
 153.313 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4)
 153.314 +  "The answer is 4."
 153.315 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22)
 153.316 +  "The answer is 7 out of 22."
 153.317 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4)
 153.318 +  "The answer is something crazy."
 153.319 +)
 153.320 +
 153.321 +(simple-tests curly-brace-plain-tests
 153.322 +  ;; Iteration from sublist
 153.323 +  (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
 153.324 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 153.325 +
 153.326 +  (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
 153.327 +  "Coordinates are [0,1] [1,0]\n"
 153.328 +
 153.329 +  (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
 153.330 +  "Coordinates are\n"
 153.331 +
 153.332 +  (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
 153.333 +  "Coordinates are none\n"
 153.334 +
 153.335 +  (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1])
 153.336 +  "Coordinates are [2,3] <1>\n"
 153.337 +
 153.338 +  (cl-format nil "Coordinates are~{~:}~%" "" [])
 153.339 +  "Coordinates are\n"
 153.340 +
 153.341 +  (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1])
 153.342 +  "Coordinates are [2,3] <1>\n"
 153.343 +
 153.344 +  (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
 153.345 +  "Coordinates are none\n"
 153.346 +)
 153.347 +
 153.348 +
 153.349 +(simple-tests curly-brace-colon-tests
 153.350 +  ;; Iteration from list of sublists
 153.351 +  (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
 153.352 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 153.353 +
 153.354 +  (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ])
 153.355 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 153.356 +
 153.357 +  (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
 153.358 +  "Coordinates are [0,1] [1,0]\n"
 153.359 +
 153.360 +  (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
 153.361 +  "Coordinates are\n"
 153.362 +
 153.363 +  (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
 153.364 +  "Coordinates are none\n"
 153.365 +
 153.366 +  (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]])
 153.367 +  "Coordinates are [2,3] <1>\n"
 153.368 +
 153.369 +  (cl-format nil "Coordinates are~:{~:}~%" "" [])
 153.370 +  "Coordinates are\n"
 153.371 +
 153.372 +  (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]])
 153.373 +  "Coordinates are [2,3] <1>\n"
 153.374 +
 153.375 +  (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
 153.376 +  "Coordinates are none\n"
 153.377 +)
 153.378 +
 153.379 +(simple-tests curly-brace-at-tests
 153.380 +  ;; Iteration from main list
 153.381 +  (cl-format nil "Coordinates are~@{ [~D,~D]~}~%"  0, 1, 1, 0, 3, 5, 2, 1)
 153.382 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 153.383 +
 153.384 +  (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1)
 153.385 +  "Coordinates are [0,1] [1,0]\n"
 153.386 +
 153.387 +  (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
 153.388 +  "Coordinates are\n"
 153.389 +
 153.390 +  (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
 153.391 +  "Coordinates are none\n"
 153.392 +
 153.393 +  (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1)
 153.394 +  "Coordinates are [2,3] <1>\n"
 153.395 +
 153.396 +  (cl-format nil "Coordinates are~@{~:}~%" "")
 153.397 +  "Coordinates are\n"
 153.398 +
 153.399 +  (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1)
 153.400 +  "Coordinates are [2,3] <1>\n"
 153.401 +
 153.402 +  (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
 153.403 +  "Coordinates are none\n"
 153.404 +)
 153.405 +
 153.406 +(simple-tests curly-brace-colon-at-tests
 153.407 +  ;; Iteration from sublists on the main arg list
 153.408 +  (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%"  [0, 1], [1, 0], [3, 5], [2, 1] )
 153.409 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 153.410 +
 153.411 +  (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] )
 153.412 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 153.413 +
 153.414 +  (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1])
 153.415 +  "Coordinates are [0,1] [1,0]\n"
 153.416 +
 153.417 +  (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
 153.418 +  "Coordinates are\n"
 153.419 +
 153.420 +  (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
 153.421 +  "Coordinates are none\n"
 153.422 +
 153.423 +  (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1])
 153.424 +  "Coordinates are [2,3] <1>\n"
 153.425 +
 153.426 +  (cl-format nil "Coordinates are~@:{~:}~%" "")
 153.427 +  "Coordinates are\n"
 153.428 +
 153.429 +  (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1])
 153.430 +  "Coordinates are [2,3] <1>\n"
 153.431 +
 153.432 +  (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
 153.433 +  "Coordinates are none\n"
 153.434 +)
 153.435 +
 153.436 +;; TODO tests for ~^ in ~[ constructs and other brackets
 153.437 +;; TODO test ~:^ generates an error when used improperly
 153.438 +;; TODO test ~:^ works in ~@:{...~}
 153.439 +(let [aseq '(a quick brown fox jumped over the lazy dog)
 153.440 +      lseq (mapcat identity (for [x aseq] [x (.length (name x))]))]
 153.441 +  (simple-tests up-tests
 153.442 +    (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog"
 153.443 +    (cl-format nil "~{~a~0^, ~}" aseq) "a"
 153.444 +    (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over"
 153.445 +    (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox"
 153.446 +    (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox"
 153.447 +))
 153.448 +
 153.449 +(simple-tests angle-bracket-tests
 153.450 +  (cl-format nil "~<foo~;bar~;baz~>") "foobarbaz"
 153.451 +  (cl-format nil "~20<foo~;bar~;baz~>") "foo      bar     baz"
 153.452 +  (cl-format nil "~,,2<foo~;bar~;baz~>") "foo  bar  baz"
 153.453 +  (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo      bar     baz"
 153.454 +  (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") "    foo    bar   baz"
 153.455 +  (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo    bar    baz   "
 153.456 +  (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") "   foo   bar   baz  "
 153.457 +  (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo  bar  baz"
 153.458 +  (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo      bar     baz"
 153.459 +  (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz"
 153.460 +  (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo      bar     baz"
 153.461 +  (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo              bar"
 153.462 +  (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo                 "
 153.463 +  (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") "                 foo"
 153.464 +)
 153.465 +
 153.466 +(simple-tests angle-bracket-max-column-tests
 153.467 +  (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")))
 153.468 +  "\n;;  This function computes the circular\n;;  thermodynamic coefficient of the thrombulator\n;;  angle for use in determining the reaction\n;;  distance.\n"
 153.469 +(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"))))
 153.470 +
 153.471 +(defn list-to-table [aseq column-width]
 153.472 +  (let [stream (get-pretty-writer (java.io.StringWriter.))]
 153.473 +    (binding [*out* stream]
 153.474 +     (doseq [row aseq]
 153.475 +       (doseq [col row]
 153.476 +         (cl-format true "~4D~7,vT" col column-width))
 153.477 +       (prn)))
 153.478 +    (.flush stream)
 153.479 +    (.toString (:base @@(:base @@stream)))))
 153.480 +
 153.481 +(simple-tests column-writer-test
 153.482 +  (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8)
 153.483 +  "   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")
 153.484 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 153.485 +;; The following tests are the various examples from the format
 153.486 +;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3
 153.487 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 153.488 +
 153.489 +(defn expt [base pow] (reduce * (repeat pow base)))
 153.490 +
 153.491 +(let [x 5, y "elephant", n 3]
 153.492 +  (simple-tests cltl-intro-tests
 153.493 +   (format nil "foo")  "foo" 
 153.494 +   (format nil "The answer is ~D." x)  "The answer is 5." 
 153.495 +   (format nil "The answer is ~3D." x)  "The answer is   5." 
 153.496 +   (format nil "The answer is ~3,'0D." x)  "The answer is 005." 
 153.497 +   (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007."
 153.498 +   (format nil "Look at the ~A!" y)  "Look at the elephant!" 
 153.499 +   (format nil "Type ~:C to ~A." (char 4) "delete all your files") 
 153.500 +   "Type Control-D to delete all your files."
 153.501 +   (format nil "~D item~:P found." n)  "3 items found."
 153.502 +   (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here."
 153.503 +   (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here."
 153.504 +   (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies."))
 153.505 + 
 153.506 +(simple-tests cltl-B-tests
 153.507 +  ;; CLtL didn't have the colons here, but the spec requires them
 153.508 +  (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" 
 153.509 +  (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" 
 153.510 +  (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" 
 153.511 +  ;; This one was a nice idea, but nothing in the spec supports it working this way
 153.512 +  ;; (and SBCL doesn't work this way either)
 153.513 +  ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110")
 153.514 +  )
 153.515 +
 153.516 +(simple-tests cltl-P-tests
 153.517 +  (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" 
 153.518 +  (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" 
 153.519 +  (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins")
 153.520 +
 153.521 +(defn foo [x] 
 153.522 +  (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" 
 153.523 +          x x x x x x))
 153.524 +
 153.525 +(simple-tests cltl-F-tests
 153.526 +  (foo 3.14159)  "  3.14| 31.42|  3.14|3.1416|3.14|3.14159" 
 153.527 +  (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" 
 153.528 +  (foo 100.0)    "100.00|******|100.00| 100.0|100.00|100.0" 
 153.529 +  (foo 1234.0)   "1234.00|******|??????|1234.0|1234.00|1234.0" 
 153.530 +  (foo 0.006)    "  0.01|  0.06|  0.01| 0.006|0.01|0.006")
 153.531 +
 153.532 +(defn foo-e [x] 
 153.533 +  (format nil 
 153.534 +          "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" 
 153.535 +          x x x x)) 
 153.536 +
 153.537 +;; Clojure doesn't support float/double differences in representation
 153.538 +(simple-tests cltl-E-tests
 153.539 +  (foo-e 0.0314159) "  3.14E-2| 31.42$-03|+.003E+01|  3.14E-2"  ; Added this one 
 153.540 +  (foo-e 3.14159)  "  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0" 
 153.541 +  (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
 153.542 +  (foo-e 1100.0)   "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3" 
 153.543 +; In Clojure, this is identical to the above
 153.544 +;  (foo-e 1100.0L0) "  1.10L+3| 11.00$+02|+.001L+06|  1.10L+3" 
 153.545 +  (foo-e 1.1E13)   "*********| 11.00$+12|+.001E+16| 1.10E+13" 
 153.546 +  (foo-e 1.1E120)  "*********|??????????|%%%%%%%%%|1.10E+120" 
 153.547 +; Clojure doesn't support real numbers this large
 153.548 +;  (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200"
 153.549 +)
 153.550 +
 153.551 +(simple-tests cltl-E-scale-tests
 153.552 +  (map
 153.553 +    (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" 
 153.554 +                    (- k 5) 3.14159))              ;Prints 13 lines 
 153.555 +    (range 13))
 153.556 +  '("Scale factor -5: | 0.000003E+06|"
 153.557 +    "Scale factor -4: | 0.000031E+05|"
 153.558 +    "Scale factor -3: | 0.000314E+04|"
 153.559 +    "Scale factor -2: | 0.003142E+03|"
 153.560 +    "Scale factor -1: | 0.031416E+02|"
 153.561 +    "Scale factor  0: | 0.314159E+01|"
 153.562 +    "Scale factor  1: | 3.141590E+00|"
 153.563 +    "Scale factor  2: | 31.41590E-01|"
 153.564 +    "Scale factor  3: | 314.1590E-02|"
 153.565 +    "Scale factor  4: | 3141.590E-03|"
 153.566 +    "Scale factor  5: | 31415.90E-04|"
 153.567 +    "Scale factor  6: | 314159.0E-05|"
 153.568 +    "Scale factor  7: | 3141590.E-06|"))
 153.569 +
 153.570 +(defn foo-g [x] 
 153.571 +  (format nil 
 153.572 +          "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" 
 153.573 +          x x x x)) 
 153.574 +
 153.575 +;; Clojure doesn't support float/double differences in representation
 153.576 +(simple-tests cltl-G-tests
 153.577 +  (foo-g 0.0314159) "  3.14E-2|314.2$-04|0.314E-01|  3.14E-2" 
 153.578 +  (foo-g 0.314159)  "  0.31   |0.314    |0.314    | 0.31    " 
 153.579 +  (foo-g 3.14159)   "   3.1   | 3.14    | 3.14    |  3.1    " 
 153.580 +  (foo-g 31.4159)   "   31.   | 31.4    | 31.4    |  31.    " 
 153.581 +  (foo-g 314.159)   "  3.14E+2| 314.    | 314.    |  3.14E+2" 
 153.582 +  (foo-g 3141.59)   "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3" 
 153.583 +; In Clojure, this is identical to the above
 153.584 +;  (foo-g 3141.59L0) "  3.14L+3|314.2$+01|0.314L+04|  3.14L+3" 
 153.585 +  (foo-g 3.14E12)   "*********|314.0$+10|0.314E+13| 3.14E+12" 
 153.586 +  (foo-g 3.14E120)  "*********|?????????|%%%%%%%%%|3.14E+120" 
 153.587 +; Clojure doesn't support real numbers this large
 153.588 +;  (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200"
 153.589 +)
 153.590 +
 153.591 +(defn type-clash-error [fun nargs argnum right-type wrong-type]
 153.592 +  (format nil ;; CLtL has this format string slightly wrong
 153.593 +          "~&Function ~S requires its ~:[~:R ~;~*~]~
 153.594 +           argument to be of type ~S,~%but it was called ~
 153.595 +           with an argument of type ~S.~%" 
 153.596 +          fun (= nargs 1) argnum right-type wrong-type)) 
 153.597 +
 153.598 +(simple-tests cltl-Newline-tests
 153.599 +  (type-clash-error 'aref nil 2 'integer 'vector)
 153.600 +"Function aref requires its second argument to be of type integer,
 153.601 +but it was called with an argument of type vector.\n"
 153.602 +  (type-clash-error 'car 1 1 'list 'short-float)
 153.603 +"Function car requires its argument to be of type list,
 153.604 +but it was called with an argument of type short-float.\n")
 153.605 +
 153.606 +(simple-tests cltl-?-tests
 153.607 +  (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) "<Foo 5> 7" 
 153.608 +  (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) "<Foo 5> 7"
 153.609 +  (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) "<Foo 5> 7" 
 153.610 +  (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) "<Foo 5> 14")
 153.611 +
 153.612 +(defn f [n] (format nil "~@(~R~) error~:P detected." n)) 
 153.613 +
 153.614 +(simple-tests cltl-paren-tests
 153.615 +  (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" 
 153.616 +  (f 0) "Zero errors detected." 
 153.617 +  (f 1) "One error detected." 
 153.618 +  (f 23) "Twenty-three errors detected.")
 153.619 +
 153.620 +(let [*print-level* nil *print-length* 5] 
 153.621 +  (simple-tests cltl-bracket-tests
 153.622 +    (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" 
 153.623 +            *print-level* *print-length*) 
 153.624 +    " print length = 5"))
 153.625 +
 153.626 +(let [foo "Items:~#[ none~; ~S~; ~S and ~S~
 153.627 +           ~:;~@{~#[~; and~] ~
 153.628 +           ~S~^,~}~]."]
 153.629 +  (simple-tests cltl-bracket1-tests
 153.630 +    (format nil foo) "Items: none." 
 153.631 +    (format nil foo 'foo) "Items: foo." 
 153.632 +    (format nil foo 'foo 'bar) "Items: foo and bar." 
 153.633 +    (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." 
 153.634 +    (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux."))
 153.635 +
 153.636 +(simple-tests cltl-curly-bracket-tests
 153.637 +  (format nil 
 153.638 +        "The winners are:~{ ~S~}." 
 153.639 +        '(fred harry jill)) 
 153.640 +  "The winners are: fred harry jill." 
 153.641 +
 153.642 +  (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) 
 153.643 +  "Pairs: <a,1> <b,2> <c,3>."
 153.644 +
 153.645 +  (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) 
 153.646 +  "Pairs: <a,1> <b,2> <c,3>."
 153.647 +
 153.648 +  (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) 
 153.649 +  "Pairs: <a,1> <b,2> <c,3>."
 153.650 +
 153.651 +  (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) 
 153.652 +  "Pairs: <a,1> <b,2> <c,3>.")
 153.653 +
 153.654 +(simple-tests cltl-angle-bracket-tests
 153.655 +  (format nil "~10<foo~;bar~>")           "foo    bar" 
 153.656 +  (format nil "~10:<foo~;bar~>")          "  foo  bar" 
 153.657 +  (format nil "~10:@<foo~;bar~>")         "  foo bar " 
 153.658 +  (format nil "~10<foobar~>")             "    foobar" 
 153.659 +  (format nil "~10:<foobar~>")            "    foobar" 
 153.660 +  (format nil "~10@<foobar~>")            "foobar    " 
 153.661 +  (format nil "~10:@<foobar~>")           "  foobar  ")
 153.662 +
 153.663 +(let [donestr "Done.~^  ~D warning~:P.~^  ~D error~:P."
 153.664 +      tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here
 153.665 +
 153.666 +  (simple-tests cltl-up-tests
 153.667 +    (format nil donestr) "Done." 
 153.668 +    (format nil donestr 3) "Done.  3 warnings." 
 153.669 +    (format nil donestr 1 5) "Done.  1 warning.  5 errors."
 153.670 +    (format nil tellstr 23) "Twenty-three." 
 153.671 +    (format nil tellstr nil "losers") "Losers." 
 153.672 +    (format nil tellstr 23 "losers") "Twenty-three losers."
 153.673 +    (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) 
 153.674 +    "            foo" 
 153.675 +    (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) 
 153.676 +    "foo         bar" 
 153.677 +    (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) 
 153.678 +    "foo   bar   baz"))
 153.679 +
 153.680 +(simple-tests cltl-up-x3j13-tests
 153.681 +  (format nil 
 153.682 +          "~:{/~S~^ ...~}" 
 153.683 +          '((hot dog) (hamburger) (ice cream) (french fries))) 
 153.684 +  "/hot .../hamburger/ice .../french ..."
 153.685 +  (format nil 
 153.686 +          "~:{/~S~:^ ...~}" 
 153.687 +          '((hot dog) (hamburger) (ice cream) (french fries))) 
 153.688 +  "/hot .../hamburger .../ice .../french"
 153.689 +
 153.690 +  (format nil 
 153.691 +          "~:{/~S~#:^ ...~}"  ;; This is wrong in CLtL
 153.692 +          '((hot dog) (hamburger) (ice cream) (french fries))) 
 153.693 +  "/hot .../hamburger")
 153.694 +
   154.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   154.2 +++ b/src/clojure/contrib/test_contrib/pprint/test_helper.clj	Sat Aug 21 06:25:44 2010 -0400
   154.3 @@ -0,0 +1,21 @@
   154.4 +;;; helper.clj -- part of the pretty printer for Clojure
   154.5 +
   154.6 +;; by Tom Faulhaber
   154.7 +;; April 3, 2009
   154.8 +
   154.9 +;   Copyright (c) Tom Faulhaber, April 2009. All rights reserved.
  154.10 +;   The use and distribution terms for this software are covered by the
  154.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  154.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  154.13 +;   By using this software in any fashion, you are agreeing to be bound by
  154.14 +;   the terms of this license.
  154.15 +;   You must not remove this notice, or any other, from this software.
  154.16 +
  154.17 +;; This is just a macro to make my tests a little cleaner
  154.18 +
  154.19 +(ns clojure.contrib.pprint.test-helper
  154.20 +  (:use [clojure.test :only (deftest are run-tests)]))
  154.21 +
  154.22 +(defmacro simple-tests [name & test-pairs]
  154.23 +  `(deftest ~name (are [x y] (= x y) ~@test-pairs)))
  154.24 +
   155.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   155.2 +++ b/src/clojure/contrib/test_contrib/pprint/test_pretty.clj	Sat Aug 21 06:25:44 2010 -0400
   155.3 @@ -0,0 +1,127 @@
   155.4 +;;; pretty.clj -- part of the pretty printer for Clojure
   155.5 +
   155.6 +;; by Tom Faulhaber
   155.7 +;; April 3, 2009
   155.8 +
   155.9 +;   Copyright (c) Tom Faulhaber, Feb 2009. All rights reserved.
  155.10 +;   The use and distribution terms for this software are covered by the
  155.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  155.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
  155.13 +;   By using this software in any fashion, you are agreeing to be bound by
  155.14 +;   the terms of this license.
  155.15 +;   You must not remove this notice, or any other, from this software.
  155.16 +
  155.17 +(ns clojure.contrib.pprint.test-pretty
  155.18 +  (:use [clojure.test :only (deftest are run-tests)]
  155.19 +        clojure.contrib.pprint.test-helper
  155.20 +        clojure.contrib.pprint))
  155.21 +
  155.22 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  155.23 +;;;
  155.24 +;;; Unit tests for the pretty printer
  155.25 +;;;
  155.26 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  155.27 +
  155.28 +(simple-tests xp-fill-test
  155.29 +  (binding [*print-pprint-dispatch* *simple-dispatch*
  155.30 +            *print-right-margin* 38
  155.31 +            *print-miser-width* nil]
  155.32 +    (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
  155.33 +               '((x 4) (*print-length* nil) (z 2) (list nil))))
  155.34 +  "(let ((x 4) (*print-length* nil)\n      (z 2) (list nil))\n ...)\n"
  155.35 +
  155.36 +  (binding [*print-pprint-dispatch* *simple-dispatch*
  155.37 +            *print-right-margin* 22]
  155.38 +    (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
  155.39 +               '((x 4) (*print-length* nil) (z 2) (list nil))))
  155.40 +  "(let ((x 4)\n      (*print-length*\n       nil)\n      (z 2)\n      (list nil))\n ...)\n")
  155.41 +
  155.42 +(simple-tests xp-miser-test
  155.43 +  (binding [*print-pprint-dispatch* *simple-dispatch*
  155.44 +            *print-right-margin* 10, *print-miser-width* 9]
  155.45 +    (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
  155.46 +  "(LIST\n first\n second\n third)"
  155.47 +
  155.48 +  (binding [*print-pprint-dispatch* *simple-dispatch*
  155.49 +            *print-right-margin* 10, *print-miser-width* 8]
  155.50 +    (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
  155.51 +  "(LIST first second third)")
  155.52 +
  155.53 +(simple-tests mandatory-fill-test
  155.54 +  (cl-format nil
  155.55 +             "<pre>~%~<Usage: ~:I~@{*~a*~^~:@_~}~:>~%</pre>~%"
  155.56 +             [ "hello" "gooodbye" ])
  155.57 +  "<pre>
  155.58 +Usage: *hello*
  155.59 +       *gooodbye*
  155.60 +</pre>
  155.61 +")
  155.62 +
  155.63 +(simple-tests prefix-suffix-test
  155.64 +  (binding [*print-pprint-dispatch* *simple-dispatch*
  155.65 +            *print-right-margin* 10, *print-miser-width* 10]
  155.66 +    (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third)))
  155.67 +  "{LIST\n first\n second\n third}")
  155.68 +
  155.69 +(simple-tests pprint-test
  155.70 +  (binding [*print-pprint-dispatch* *simple-dispatch*]
  155.71 +    (write '(defn foo [x y] 
  155.72 +              (let [result (* x y)] 
  155.73 +                (if (> result 400) 
  155.74 +                  (cl-format true "That number is too big")
  155.75 +                  (cl-format true "The  result of ~d x ~d is ~d" x y result))))
  155.76 +           :stream nil))
  155.77 +  "(defn
  155.78 + foo
  155.79 + [x y]
  155.80 + (let
  155.81 +  [result (* x y)]
  155.82 +  (if
  155.83 +   (> result 400)
  155.84 +   (cl-format true \"That number is too big\")
  155.85 +   (cl-format true \"The  result of ~d x ~d is ~d\" x y result))))"
  155.86 +
  155.87 +  (with-pprint-dispatch *code-dispatch*
  155.88 +    (write '(defn foo [x y] 
  155.89 +              (let [result (* x y)] 
  155.90 +                (if (> result 400) 
  155.91 +                  (cl-format true "That number is too big")
  155.92 +                  (cl-format true "The  result of ~d x ~d is ~d" x y result))))
  155.93 +           :stream nil))
  155.94 +  "(defn foo [x y]
  155.95 +  (let [result (* x y)]
  155.96 +    (if (> result 400)
  155.97 +      (cl-format true \"That number is too big\")
  155.98 +      (cl-format true \"The  result of ~d x ~d is ~d\" x y result))))"
  155.99 +
 155.100 +  (binding [*print-pprint-dispatch* *simple-dispatch*
 155.101 +            *print-right-margin* 15] 
 155.102 +    (write '(fn (cons (car x) (cdr y))) :stream nil))
 155.103 +  "(fn\n (cons\n  (car x)\n  (cdr y)))"
 155.104 +
 155.105 +  (with-pprint-dispatch *code-dispatch*
 155.106 +    (binding [*print-right-margin* 52] 
 155.107 +      (write 
 155.108 +       '(add-to-buffer this (make-buffer-blob (str (char c)) nil))
 155.109 +       :stream nil)))
 155.110 +  "(add-to-buffer\n  this\n  (make-buffer-blob (str (char c)) nil))"
 155.111 +  )
 155.112 +
 155.113 +
 155.114 +
 155.115 +(simple-tests pprint-reader-macro-test
 155.116 +  (with-pprint-dispatch *code-dispatch*
 155.117 +    (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])")
 155.118 +	   :stream nil))
 155.119 +  "(map #(first %) [[1 2 3] [4 5 6] [7]])"
 155.120 +
 155.121 +  (with-pprint-dispatch *code-dispatch*
 155.122 +    (write (read-string "@@(ref (ref 1))")
 155.123 +	   :stream nil))
 155.124 +  "@@(ref (ref 1))"
 155.125 +
 155.126 +  (with-pprint-dispatch *code-dispatch*
 155.127 +    (write (read-string "'foo")
 155.128 +	   :stream nil))
 155.129 +  "'foo"
 155.130 +)
   156.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   156.2 +++ b/src/clojure/contrib/test_contrib/probabilities/examples_finite_distributions.clj	Sat Aug 21 06:25:44 2010 -0400
   156.3 @@ -0,0 +1,209 @@
   156.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   156.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   156.6 +;;
   156.7 +;; Probability distribution application examples
   156.8 +;;
   156.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  156.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  156.11 +
  156.12 +(ns
  156.13 +  #^{:author "Konrad Hinsen"
  156.14 +     :skip-wiki true
  156.15 +     :doc "Examples for finite probability distribution"}
  156.16 +  clojure.contrib.probabilities.examples-finite-distributions
  156.17 +  (:use [clojure.contrib.probabilities.finite-distributions
  156.18 +	 :only (uniform prob cond-prob join-with dist-m choose
  156.19 +	        normalize certainly cond-dist-m normalize-cond)])
  156.20 +  (:use [clojure.contrib.monads
  156.21 +	 :only (domonad with-monad m-seq m-chain m-lift)])
  156.22 +  (:require clojure.contrib.accumulators))
  156.23 +
  156.24 +;; Simple examples using dice
  156.25 +
  156.26 +; A single die is represented by a uniform distribution over the
  156.27 +; six possible outcomes.
  156.28 +(def die (uniform #{1 2 3 4 5 6}))
  156.29 +
  156.30 +; The probability that the result is odd...
  156.31 +(prob odd? die)
  156.32 +; ... or greater than four.
  156.33 +(prob #(> % 4) die)
  156.34 +
  156.35 +; The sum of two dice
  156.36 +(def two-dice (join-with + die die))
  156.37 +(prob #(> % 6) two-dice)
  156.38 +
  156.39 +; The sum of two dice using a monad comprehension
  156.40 +(assert (= two-dice
  156.41 +	   (domonad dist-m
  156.42 +		    [d1 die
  156.43 +		     d2 die]
  156.44 +		    (+ d1 d2))))
  156.45 +
  156.46 +; The two values separately, but as an ordered pair
  156.47 +(domonad dist-m
  156.48 +  [d1 die
  156.49 +   d2 die]
  156.50 +  (if (< d1 d2) (list d1 d2) (list d2 d1)))
  156.51 +
  156.52 +; The conditional probability for two dice yielding X if X is odd:
  156.53 +(cond-prob odd? two-dice)
  156.54 +
  156.55 +; A two-step experiment: throw a die, and then add 1 with probability 1/2
  156.56 +(domonad dist-m
  156.57 +  [d die
  156.58 +   x (choose (/ 1 2)  d
  156.59 +	     :else    (inc d))]
  156.60 +  x)
  156.61 +
  156.62 +; The sum of n dice
  156.63 +(defn dice [n]
  156.64 +   (domonad dist-m
  156.65 +      [ds (m-seq (replicate n die))]
  156.66 +      (apply + ds)))
  156.67 +
  156.68 +(assert (= two-dice (dice 2)))
  156.69 +
  156.70 +(dice 3)
  156.71 +
  156.72 +
  156.73 +;; Construct an empirical distribution from counters
  156.74 +
  156.75 +; Using an ordinary counter:
  156.76 +(def dist1
  156.77 +  (normalize
  156.78 +    (clojure.contrib.accumulators/add-items
  156.79 +      clojure.contrib.accumulators/empty-counter
  156.80 +      (for [_ (range 1000)] (rand-int 5)))))
  156.81 +
  156.82 +; Or, more efficiently, using a counter that already keeps track of its total:
  156.83 +(def dist2
  156.84 +  (normalize
  156.85 +    (clojure.contrib.accumulators/add-items
  156.86 +      clojure.contrib.accumulators/empty-counter-with-total
  156.87 +      (for [_ (range 1000)] (rand-int 5)))))
  156.88 +
  156.89 +
  156.90 +;; The Monty Hall game
  156.91 +;; (see http://en.wikipedia.org/wiki/Monty_Hall_problem for a description)
  156.92 +
  156.93 +; The set of doors. In the classical variant, there are three doors,
  156.94 +; but the code can also work with more than three doors.
  156.95 +(def doors #{:A :B :C})
  156.96 +
  156.97 +; A simulation of the game, step by step:
  156.98 +(domonad dist-m
  156.99 +  [; The prize is hidden behind one of the doors.
 156.100 +   prize  (uniform doors)
 156.101 +   ; The player make his initial choice.
 156.102 +   choice (uniform doors)
 156.103 +   ; The host opens a door which is neither the prize door nor the
 156.104 +   ; one chosen by the player.
 156.105 +   opened (uniform (disj doors prize choice))
 156.106 +   ; If the player stays with his initial choice, the game ends and the
 156.107 +   ; following line should be commented out. It describes the switch from
 156.108 +   ; the initial choice to a door that is neither the opened one nor
 156.109 +   ; his original choice.
 156.110 +   choice (uniform (disj doors opened choice))
 156.111 +   ]
 156.112 +  ; If the chosen door has the prize behind it, the player wins.
 156.113 +  (if (= choice prize) :win :loose))
 156.114 +
 156.115 +
 156.116 +;; Tree growth simulation
 156.117 +;; Adapted from the code in:
 156.118 +;; Martin Erwig and Steve Kollmansberger,
 156.119 +;; "Probabilistic Functional Programming in Haskell",
 156.120 +;; Journal of Functional Programming, Vol. 16, No. 1, 21-34, 2006
 156.121 +;; http://web.engr.oregonstate.edu/~erwig/papers/abstracts.html#JFP06a
 156.122 +
 156.123 +; A tree is represented by two attributes: its state (alive, hit, fallen),
 156.124 +; and its height (an integer). A new tree starts out alive and with zero height.
 156.125 +(def new-tree {:state :alive, :height 0})
 156.126 +
 156.127 +; An evolution step in the simulation modifies alive trees only. They can
 156.128 +; either grow by one (90% probability), be hit by lightning and then stop
 156.129 +; growing (4% probability), or fall down (6% probability).
 156.130 +(defn evolve-1 [tree]
 156.131 +  (let [{s :state h :height} tree]
 156.132 +    (if (= s :alive)
 156.133 +      (choose 0.9   (assoc tree :height (inc (:height tree)))
 156.134 +	      0.04  (assoc tree :state :hit) 
 156.135 +	      :else {:state :fallen, :height 0})
 156.136 +      (certainly tree))))
 156.137 +
 156.138 +; Multiple evolution steps can be chained together with m-chain,
 156.139 +; since each step's input is the output of the previous step.
 156.140 +(with-monad dist-m
 156.141 +  (defn evolve [n tree]
 156.142 +    ((m-chain (replicate n evolve-1)) tree)))
 156.143 +
 156.144 +; Try it for zero, one, or two steps.
 156.145 +(evolve 0 new-tree)
 156.146 +(evolve 1 new-tree)
 156.147 +(evolve 2 new-tree)
 156.148 +
 156.149 +; We can also get a distribution of the height only:
 156.150 +(with-monad dist-m
 156.151 +  ((m-lift 1 :height) (evolve 2 new-tree)))
 156.152 +
 156.153 +
 156.154 +
 156.155 +;; Bayesian inference
 156.156 +;;
 156.157 +;; Suppose someone has three dice, one with six faces, one with eight, and
 156.158 +;; one with twelve. This person throws one die and gives us the number,
 156.159 +;; but doesn't tell us which die it was. What are the Bayesian probabilities
 156.160 +;; for each of the three dice, given the observation we have?
 156.161 +
 156.162 +; A function that returns the distribution of a dice with n faces.
 156.163 +(defn die-n [n] (uniform (range 1 (inc n))))
 156.164 +
 156.165 +; The three dice in the game with their distributions. With this map, we
 156.166 +; can easily calculate the probability for an observation under the
 156.167 +; condition that a particular die was used.
 156.168 +(def dice {:six     (die-n 6)
 156.169 +	   :eight   (die-n 8)
 156.170 +	   :twelve  (die-n 12)})
 156.171 +
 156.172 +; The only prior knowledge is that one of the three dice is used, so we
 156.173 +; have no better than a uniform distribution to start with.
 156.174 +(def prior (uniform (keys dice)))
 156.175 +
 156.176 +; Add a single observation to the information contained in the
 156.177 +; distribution. Adding an observation consists of
 156.178 +; 1) Draw a die from the prior distribution.
 156.179 +; 2) Draw an observation from the distribution of that die.
 156.180 +; 3) Eliminate (replace by nil) the trials that do not match the observation.
 156.181 +; 4) Normalize the distribution for the non-nil values.
 156.182 +(defn add-observation [prior observation]
 156.183 +  (normalize-cond
 156.184 +    (domonad cond-dist-m
 156.185 +      [die    prior
 156.186 +       number (get dice die)
 156.187 +       :when  (= number observation) ]
 156.188 +      die)))
 156.189 +
 156.190 +; Add one observation.
 156.191 +(add-observation prior 1)
 156.192 +
 156.193 +; Add three consecutive observations.
 156.194 +(-> prior (add-observation 1)
 156.195 +          (add-observation 3)
 156.196 +	  (add-observation 7))
 156.197 +
 156.198 +; We can also add multiple observations in a single trial, but this
 156.199 +; is slower because more combinations have to be taken into account.
 156.200 +; With Bayesian inference, it is most efficient to eliminate choices
 156.201 +; as early as possible.
 156.202 +(defn add-observations [prior observations]
 156.203 +  (with-monad cond-dist-m
 156.204 +    (let [n-nums #(m-seq (replicate (count observations) (get dice %)))]
 156.205 +      (normalize-cond
 156.206 +        (domonad
 156.207 +          [die    prior
 156.208 +           nums   (n-nums die)
 156.209 +	   :when  (= nums observations)]
 156.210 +	  die)))))
 156.211 +
 156.212 +(add-observations prior [1 3 7])
   157.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   157.2 +++ b/src/clojure/contrib/test_contrib/probabilities/examples_monte_carlo.clj	Sat Aug 21 06:25:44 2010 -0400
   157.3 @@ -0,0 +1,73 @@
   157.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   157.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   157.6 +;;
   157.7 +;; Monte-Carlo application examples
   157.8 +;;
   157.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  157.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  157.11 +
  157.12 +(ns
  157.13 +  #^{:author "Konrad Hinsen"
  157.14 +     :skip-wiki true
  157.15 +     :doc "Examples for monte carlo methods"}
  157.16 +  clojure.contrib.probabilities.random.examples-monte-carlo
  157.17 +  (:require [clojure.contrib.generic.collection :as gc])
  157.18 +  (:use [clojure.contrib.probabilities.random-numbers
  157.19 +	 :only (lcg rand-stream)])
  157.20 +  (:use [clojure.contrib.probabilities.finite-distributions
  157.21 +	 :only (uniform)])
  157.22 +  (:use [clojure.contrib.probabilities.monte-carlo
  157.23 +	 :only (random-stream discrete interval normal lognormal exponential
  157.24 +		n-sphere
  157.25 +		sample sample-sum sample-mean sample-mean-variance)]
  157.26 +	:reload)
  157.27 +  (:use [clojure.contrib.monads
  157.28 +	:only (domonad state-m)]))
  157.29 +
  157.30 +; Create a linear congruential generator
  157.31 +(def urng (lcg 259200 7141 54773 1))
  157.32 +
  157.33 +;; Use Clojure's built-in random number generator
  157.34 +;(def urng rand-stream)
  157.35 +
  157.36 +; Sample transformed distributions
  157.37 +(defn sample-distribution
  157.38 +  [n rt]
  157.39 +  (take n (gc/seq (random-stream rt urng))))
  157.40 +
  157.41 +; Interval [-2, 2)
  157.42 +(sample-distribution 10 (interval -2 2))
  157.43 +; Compare with a direct transformation
  157.44 +(= (sample-distribution 10 (interval -2 2))
  157.45 +   (map (fn [x] (- (* 4 x) 2)) (take 10 (gc/seq urng))))
  157.46 +
  157.47 +; Normal distribution
  157.48 +(sample-distribution 10 (normal 0 1))
  157.49 +
  157.50 +; Log-Normal distribution
  157.51 +(sample-distribution 10 (lognormal 0 1))
  157.52 +
  157.53 +; Exponential distribution
  157.54 +(sample-distribution 10 (exponential 1))
  157.55 +
  157.56 +; n-sphere distribution
  157.57 +(sample-distribution 10 (n-sphere 2 1))
  157.58 +
  157.59 +; Discrete distribution
  157.60 +(sample-distribution 10 (discrete (uniform (range 1 7))))
  157.61 +
  157.62 +; Compose distributions in the state monad
  157.63 +(def sum-two-dists
  157.64 +  (domonad state-m
  157.65 +    [r1 (interval -2 2)
  157.66 +     r2 (normal 0 1)]
  157.67 +    (+ r1 r2)))
  157.68 +
  157.69 +(sample-distribution 10 sum-two-dists)
  157.70 +
  157.71 +; Distribution transformations
  157.72 +(sample-distribution  5 (sample 2 (interval -2 2)))
  157.73 +(sample-distribution 10 (sample-sum 10 (interval -2 2)))
  157.74 +(sample-distribution 10 (sample-mean 10 (interval -2 2)))
  157.75 +(sample-distribution 10 (sample-mean-variance 10 (interval -2 2)))
  157.76 +
   158.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   158.2 +++ b/src/clojure/contrib/test_contrib/stream_utils/examples.clj	Sat Aug 21 06:25:44 2010 -0400
   158.3 @@ -0,0 +1,117 @@
   158.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   158.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   158.6 +;;
   158.7 +;; Stream application examples
   158.8 +;;
   158.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  158.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  158.11 +
  158.12 +(ns
  158.13 +  #^{:author "Konrad Hinsen"
  158.14 +     :skip-wiki true
  158.15 +     :doc "Examples for data streams"}
  158.16 +  clojure.contrib.stream-utils.examples
  158.17 +  (:refer-clojure :exclude (deftype))
  158.18 +  (:use [clojure.contrib.stream-utils
  158.19 +	 :only (defst stream-next
  158.20 +		pick pick-all
  158.21 +		stream-type defstream
  158.22 +		stream-drop stream-map stream-filter stream-flatten)])
  158.23 +  (:use [clojure.contrib.monads :only (domonad)])
  158.24 +  (:use [clojure.contrib.types :only (deftype)])
  158.25 +  (:require [clojure.contrib.generic.collection :as gc]))
  158.26 +
  158.27 +;
  158.28 +; Define a stream of Fibonacci numbers
  158.29 +;
  158.30 +(deftype ::fib-stream last-two-fib)
  158.31 +
  158.32 +(defstream ::fib-stream
  158.33 +  [fs]
  158.34 +  (let [[n1 n2] fs]
  158.35 +    [n1 (last-two-fib [n2 (+ n1 n2)])]))
  158.36 +
  158.37 +(def fib-stream (last-two-fib [0 1]))
  158.38 +
  158.39 +(take 10 (gc/seq fib-stream))
  158.40 +
  158.41 +;
  158.42 +; A simple random number generator, implemented as a stream
  158.43 +;
  158.44 +(deftype ::random-seed rng-seed vector seq)
  158.45 +
  158.46 +(defstream ::random-seed
  158.47 +  [seed]
  158.48 +  (let [[seed] seed
  158.49 +	m      259200
  158.50 +	value  (/ (float seed) (float m))
  158.51 +	next   (rem (+ 54773 (* 7141 seed)) m)]
  158.52 +    [value (rng-seed next)]))
  158.53 +
  158.54 +(take 10 (gc/seq (rng-seed 1)))
  158.55 +
  158.56 +;
  158.57 +; Various stream utilities
  158.58 +;
  158.59 +(take 10 (gc/seq (stream-drop 10 (rng-seed 1))))
  158.60 +(gc/seq (stream-map inc (range 5)))
  158.61 +(gc/seq (stream-filter odd? (range 10)))
  158.62 +(gc/seq (stream-flatten (partition 3 (range 9))))
  158.63 +
  158.64 +;
  158.65 +; Stream transformers
  158.66 +;
  158.67 +
  158.68 +; Transform a stream of numbers into a stream of sums of two
  158.69 +; consecutive numbers.
  158.70 +(defst sum-two [] [xs]
  158.71 +  (domonad
  158.72 +    [x1 (pick xs)
  158.73 +     x2 (pick xs)]
  158.74 +    (+ x1 x2)))
  158.75 +
  158.76 +(def s (sum-two '(1 2 3 4 5 6 7 8)))
  158.77 +
  158.78 +(let [[v1 s] (stream-next s)]
  158.79 +  (let [[v2 s] (stream-next s)]
  158.80 +    (let [[v3 s] (stream-next s)]
  158.81 +      (let [[v4 s] (stream-next s)]
  158.82 +	(let [[v5 s] (stream-next s)]
  158.83 +	  [v1 v2 v3 v4 v5])))))
  158.84 +
  158.85 +(gc/seq s)
  158.86 +
  158.87 +; Map (for a single stream) written as a stream transformer
  158.88 +(defst my-map-1 [f] [xs]
  158.89 +  (domonad
  158.90 +   [x (pick xs)]
  158.91 +   (f x)))
  158.92 +
  158.93 +(gc/seq (my-map-1 inc [1 2 3]))
  158.94 +
  158.95 +; Map for two stream arguments
  158.96 +(defst my-map-2 [f] [xs ys]
  158.97 +  (domonad
  158.98 +    [x (pick xs)
  158.99 +     y (pick ys)]
 158.100 +    (f x y)))
 158.101 +
 158.102 +(gc/seq (my-map-2 + '(1 2 3 4) '(10 20 30 40)))
 158.103 +
 158.104 +; Map for any number of stream arguments
 158.105 +(defst my-map [f] [& streams]
 158.106 +  (domonad
 158.107 +    [vs pick-all]
 158.108 +    (apply f vs)))
 158.109 +
 158.110 +(gc/seq (my-map inc [1 2 3]))
 158.111 +(gc/seq (my-map + '(1 2 3 4) '(10 20 30 40)))
 158.112 +
 158.113 +; Filter written as a stream transformer
 158.114 +(defst my-filter [p] [xs]
 158.115 +  (domonad
 158.116 +   [x (pick xs) :when (p x)]
 158.117 +   x))
 158.118 +
 158.119 +(gc/seq (my-filter odd? [1 2 3]))
 158.120 +
   159.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   159.2 +++ b/src/clojure/contrib/test_contrib/test_complex_numbers.clj	Sat Aug 21 06:25:44 2010 -0400
   159.3 @@ -0,0 +1,313 @@
   159.4 +;; Test routines for complex-numbers.clj
   159.5 +
   159.6 +;; by Konrad Hinsen
   159.7 +;; last updated April 2, 2009
   159.8 +
   159.9 +;; Copyright (c) Konrad Hinsen, 2008. All rights reserved.  The use
  159.10 +;; and distribution terms for this software are covered by the Eclipse
  159.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  159.12 +;; which can be found in the file epl-v10.html at the root of this
  159.13 +;; distribution.  By using this software in any fashion, you are
  159.14 +;; agreeing to be bound by the terms of this license.  You must not
  159.15 +;; remove this notice, or any other, from this software.
  159.16 +
  159.17 +(ns clojure.contrib.test-complex-numbers
  159.18 +  (:refer-clojure :exclude [+ - * / = < > <= >=])
  159.19 +  (:use [clojure.test
  159.20 +	 :only (deftest is are run-tests)]
  159.21 +	[clojure.contrib.generic.arithmetic
  159.22 +	 :only (+ - * /)]
  159.23 +	[clojure.contrib.generic.comparison
  159.24 +	 :only (= < > <= >=)]
  159.25 +	[clojure.contrib.generic.math-functions
  159.26 +	 :only (abs approx= conjugate exp sqr sqrt)]
  159.27 +	[clojure.contrib.complex-numbers
  159.28 +	 :only (complex imaginary real imag)]))
  159.29 +
  159.30 +(deftest complex-addition
  159.31 +  (is (= (+ (complex 1 2) (complex 1 2)) (complex 2 4)))
  159.32 +  (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5)))
  159.33 +  (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5)))
  159.34 +  (is (= (+ (complex 1 2) 3) (complex 4 2)))
  159.35 +  (is (= (+ 3 (complex 1 2)) (complex 4 2)))
  159.36 +  (is (= (+ (complex 1 2) -1) (imaginary 2)))
  159.37 +  (is (= (+ -1 (complex 1 2)) (imaginary 2)))
  159.38 +  (is (= (+ (complex 1 2) (imaginary -2)) 1))
  159.39 +  (is (= (+ (imaginary -2) (complex 1 2)) 1))
  159.40 +  (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7)))
  159.41 +  (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7)))
  159.42 +  (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5)))
  159.43 +  (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5)))
  159.44 +  (is (= (+ (complex -3 -7) (complex -3 -7)) (complex -6 -14)))
  159.45 +  (is (= (+ (complex -3 -7) 3) (imaginary -7)))
  159.46 +  (is (= (+ 3 (complex -3 -7)) (imaginary -7)))
  159.47 +  (is (= (+ (complex -3 -7) -1) (complex -4 -7)))
  159.48 +  (is (= (+ -1 (complex -3 -7)) (complex -4 -7)))
  159.49 +  (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9)))
  159.50 +  (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9)))
  159.51 +  (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2)))
  159.52 +  (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2)))
  159.53 +  (is (= (+ 3 (complex 1 2)) (complex 4 2)))
  159.54 +  (is (= (+ (complex 1 2) 3) (complex 4 2)))
  159.55 +  (is (= (+ 3 (complex -3 -7)) (imaginary -7)))
  159.56 +  (is (= (+ (complex -3 -7) 3) (imaginary -7)))
  159.57 +  (is (= (+ 3 (imaginary -2)) (complex 3 -2)))
  159.58 +  (is (= (+ (imaginary -2) 3) (complex 3 -2)))
  159.59 +  (is (= (+ 3 (imaginary 5)) (complex 3 5)))
  159.60 +  (is (= (+ (imaginary 5) 3) (complex 3 5)))
  159.61 +  (is (= (+ -1 (complex 1 2)) (imaginary 2)))
  159.62 +  (is (= (+ (complex 1 2) -1) (imaginary 2)))
  159.63 +  (is (= (+ -1 (complex -3 -7)) (complex -4 -7)))
  159.64 +  (is (= (+ (complex -3 -7) -1) (complex -4 -7)))
  159.65 +  (is (= (+ -1 (imaginary -2)) (complex -1 -2)))
  159.66 +  (is (= (+ (imaginary -2) -1) (complex -1 -2)))
  159.67 +  (is (= (+ -1 (imaginary 5)) (complex -1 5)))
  159.68 +  (is (= (+ (imaginary 5) -1) (complex -1 5)))
  159.69 +  (is (= (+ (imaginary -2) (complex 1 2)) 1))
  159.70 +  (is (= (+ (complex 1 2) (imaginary -2)) 1))
  159.71 +  (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9)))
  159.72 +  (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9)))
  159.73 +  (is (= (+ (imaginary -2) 3) (complex 3 -2)))
  159.74 +  (is (= (+ 3 (imaginary -2)) (complex 3 -2)))
  159.75 +  (is (= (+ (imaginary -2) -1) (complex -1 -2)))
  159.76 +  (is (= (+ -1 (imaginary -2)) (complex -1 -2)))
  159.77 +  (is (= (+ (imaginary -2) (imaginary -2)) (imaginary -4)))
  159.78 +  (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3)))
  159.79 +  (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3)))
  159.80 +  (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7)))
  159.81 +  (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7)))
  159.82 +  (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2)))
  159.83 +  (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2)))
  159.84 +  (is (= (+ (imaginary 5) 3) (complex 3 5)))
  159.85 +  (is (= (+ 3 (imaginary 5)) (complex 3 5)))
  159.86 +  (is (= (+ (imaginary 5) -1) (complex -1 5)))
  159.87 +  (is (= (+ -1 (imaginary 5)) (complex -1 5)))
  159.88 +  (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3)))
  159.89 +  (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3)))
  159.90 +  (is (= (+ (imaginary 5) (imaginary 5)) (imaginary 10))))
  159.91 +
  159.92 +(deftest complex-subtraction
  159.93 +  (is (= (- (complex 1 2) (complex 1 2)) 0))
  159.94 +  (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9)))
  159.95 +  (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9)))
  159.96 +  (is (= (- (complex 1 2) 3) (complex -2 2)))
  159.97 +  (is (= (- 3 (complex 1 2)) (complex 2 -2)))
  159.98 +  (is (= (- (complex 1 2) -1) (complex 2 2)))
  159.99 +  (is (= (- -1 (complex 1 2)) (complex -2 -2)))
 159.100 +  (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4)))
 159.101 +  (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4)))
 159.102 +  (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3)))
 159.103 +  (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3)))
 159.104 +  (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9)))
 159.105 +  (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9)))
 159.106 +  (is (= (- (complex -3 -7) (complex -3 -7)) 0))
 159.107 +  (is (= (- (complex -3 -7) 3) (complex -6 -7)))
 159.108 +  (is (= (- 3 (complex -3 -7)) (complex 6 7)))
 159.109 +  (is (= (- (complex -3 -7) -1) (complex -2 -7)))
 159.110 +  (is (= (- -1 (complex -3 -7)) (complex 2 7)))
 159.111 +  (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5)))
 159.112 +  (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5)))
 159.113 +  (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12)))
 159.114 +  (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12)))
 159.115 +  (is (= (- 3 (complex 1 2)) (complex 2 -2)))
 159.116 +  (is (= (- (complex 1 2) 3) (complex -2 2)))
 159.117 +  (is (= (- 3 (complex -3 -7)) (complex 6 7)))
 159.118 +  (is (= (- (complex -3 -7) 3) (complex -6 -7)))
 159.119 +  (is (= (- 3 (imaginary -2)) (complex 3 2)))
 159.120 +  (is (= (- (imaginary -2) 3) (complex -3 -2)))
 159.121 +  (is (= (- 3 (imaginary 5)) (complex 3 -5)))
 159.122 +  (is (= (- (imaginary 5) 3) (complex -3 5)))
 159.123 +  (is (= (- -1 (complex 1 2)) (complex -2 -2)))
 159.124 +  (is (= (- (complex 1 2) -1) (complex 2 2)))
 159.125 +  (is (= (- -1 (complex -3 -7)) (complex 2 7)))
 159.126 +  (is (= (- (complex -3 -7) -1) (complex -2 -7)))
 159.127 +  (is (= (- -1 (imaginary -2)) (complex -1 2)))
 159.128 +  (is (= (- (imaginary -2) -1) (complex 1 -2)))
 159.129 +  (is (= (- -1 (imaginary 5)) (complex -1 -5)))
 159.130 +  (is (= (- (imaginary 5) -1) (complex 1 5)))
 159.131 +  (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4)))
 159.132 +  (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4)))
 159.133 +  (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5)))
 159.134 +  (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5)))
 159.135 +  (is (= (- (imaginary -2) 3) (complex -3 -2)))
 159.136 +  (is (= (- 3 (imaginary -2)) (complex 3 2)))
 159.137 +  (is (= (- (imaginary -2) -1) (complex 1 -2)))
 159.138 +  (is (= (- -1 (imaginary -2)) (complex -1 2)))
 159.139 +  (is (= (- (imaginary -2) (imaginary -2)) 0))
 159.140 +  (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7)))
 159.141 +  (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7)))
 159.142 +  (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3)))
 159.143 +  (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3)))
 159.144 +  (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12)))
 159.145 +  (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12)))
 159.146 +  (is (= (- (imaginary 5) 3) (complex -3 5)))
 159.147 +  (is (= (- 3 (imaginary 5)) (complex 3 -5)))
 159.148 +  (is (= (- (imaginary 5) -1) (complex 1 5)))
 159.149 +  (is (= (- -1 (imaginary 5)) (complex -1 -5)))
 159.150 +  (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7)))
 159.151 +  (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7)))
 159.152 +  (is (= (- (imaginary 5) (imaginary 5)) 0)))
 159.153 +
 159.154 +(deftest complex-multiplication
 159.155 +  (is (= (* (complex 1 2) (complex 1 2)) (complex -3 4)))
 159.156 +  (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13)))
 159.157 +  (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13)))
 159.158 +  (is (= (* (complex 1 2) 3) (complex 3 6)))
 159.159 +  (is (= (* 3 (complex 1 2)) (complex 3 6)))
 159.160 +  (is (= (* (complex 1 2) -1) (complex -1 -2)))
 159.161 +  (is (= (* -1 (complex 1 2)) (complex -1 -2)))
 159.162 +  (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2)))
 159.163 +  (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2)))
 159.164 +  (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5)))
 159.165 +  (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5)))
 159.166 +  (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13)))
 159.167 +  (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13)))
 159.168 +  (is (= (* (complex -3 -7) (complex -3 -7)) (complex -40 42)))
 159.169 +  (is (= (* (complex -3 -7) 3) (complex -9 -21)))
 159.170 +  (is (= (* 3 (complex -3 -7)) (complex -9 -21)))
 159.171 +  (is (= (* (complex -3 -7) -1) (complex 3 7)))
 159.172 +  (is (= (* -1 (complex -3 -7)) (complex 3 7)))
 159.173 +  (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6)))
 159.174 +  (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6)))
 159.175 +  (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15)))
 159.176 +  (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15)))
 159.177 +  (is (= (* 3 (complex 1 2)) (complex 3 6)))
 159.178 +  (is (= (* (complex 1 2) 3) (complex 3 6)))
 159.179 +  (is (= (* 3 (complex -3 -7)) (complex -9 -21)))
 159.180 +  (is (= (* (complex -3 -7) 3) (complex -9 -21)))
 159.181 +  (is (= (* 3 (imaginary -2)) (imaginary -6)))
 159.182 +  (is (= (* (imaginary -2) 3) (imaginary -6)))
 159.183 +  (is (= (* 3 (imaginary 5)) (imaginary 15)))
 159.184 +  (is (= (* (imaginary 5) 3) (imaginary 15)))
 159.185 +  (is (= (* -1 (complex 1 2)) (complex -1 -2)))
 159.186 +  (is (= (* (complex 1 2) -1) (complex -1 -2)))
 159.187 +  (is (= (* -1 (complex -3 -7)) (complex 3 7)))
 159.188 +  (is (= (* (complex -3 -7) -1) (complex 3 7)))
 159.189 +  (is (= (* -1 (imaginary -2)) (imaginary 2)))
 159.190 +  (is (= (* (imaginary -2) -1) (imaginary 2)))
 159.191 +  (is (= (* -1 (imaginary 5)) (imaginary -5)))
 159.192 +  (is (= (* (imaginary 5) -1) (imaginary -5)))
 159.193 +  (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2)))
 159.194 +  (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2)))
 159.195 +  (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6)))
 159.196 +  (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6)))
 159.197 +  (is (= (* (imaginary -2) 3) (imaginary -6)))
 159.198 +  (is (= (* 3 (imaginary -2)) (imaginary -6)))
 159.199 +  (is (= (* (imaginary -2) -1) (imaginary 2)))
 159.200 +  (is (= (* -1 (imaginary -2)) (imaginary 2)))
 159.201 +  (is (= (* (imaginary -2) (imaginary -2)) -4))
 159.202 +  (is (= (* (imaginary -2) (imaginary 5)) 10))
 159.203 +  (is (= (* (imaginary 5) (imaginary -2)) 10))
 159.204 +  (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5)))
 159.205 +  (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5)))
 159.206 +  (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15)))
 159.207 +  (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15)))
 159.208 +  (is (= (* (imaginary 5) 3) (imaginary 15)))
 159.209 +  (is (= (* 3 (imaginary 5)) (imaginary 15)))
 159.210 +  (is (= (* (imaginary 5) -1) (imaginary -5)))
 159.211 +  (is (= (* -1 (imaginary 5)) (imaginary -5)))
 159.212 +  (is (= (* (imaginary 5) (imaginary -2)) 10))
 159.213 +  (is (= (* (imaginary -2) (imaginary 5)) 10))
 159.214 +  (is (= (* (imaginary 5) (imaginary 5)) -25)))
 159.215 +
 159.216 +(deftest complex-division
 159.217 +  (is (= (/ (complex 1 2) (complex 1 2)) 1))
 159.218 +  (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58)))
 159.219 +  (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5)))
 159.220 +  (is (= (/ (complex 1 2) 3) (complex 1/3 2/3)))
 159.221 +  (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5)))
 159.222 +  (is (= (/ (complex 1 2) -1) (complex -1 -2)))
 159.223 +  (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5)))
 159.224 +  (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2)))
 159.225 +  (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5)))
 159.226 +  (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5)))
 159.227 +  (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1)))
 159.228 +  (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5)))
 159.229 +  (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58)))
 159.230 +  (is (= (/ (complex -3 -7) (complex -3 -7)) 1))
 159.231 +  (is (= (/ (complex -3 -7) 3) (complex -1 -7/3)))
 159.232 +  (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58)))
 159.233 +  (is (= (/ (complex -3 -7) -1) (complex 3 7)))
 159.234 +  (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58)))
 159.235 +  (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2)))
 159.236 +  (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29)))
 159.237 +  (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5)))
 159.238 +  (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58)))
 159.239 +  (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5)))
 159.240 +  (is (= (/ (complex 1 2) 3) (complex 1/3 2/3)))
 159.241 +  (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58)))
 159.242 +  (is (= (/ (complex -3 -7) 3) (complex -1 -7/3)))
 159.243 +  #_(is (= (/ 3 (imaginary -2)) (imaginary 1.5)))
 159.244 +  (is (= (/ (imaginary -2) 3) (imaginary -2/3)))
 159.245 +  (is (= (/ 3 (imaginary 5)) (imaginary -3/5)))
 159.246 +  (is (= (/ (imaginary 5) 3) (imaginary 5/3)))
 159.247 +  (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5)))
 159.248 +  (is (= (/ (complex 1 2) -1) (complex -1 -2)))
 159.249 +  (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58)))
 159.250 +  (is (= (/ (complex -3 -7) -1) (complex 3 7)))
 159.251 +  (is (= (/ -1 (imaginary -2)) (imaginary -1/2)))
 159.252 +  (is (= (/ (imaginary -2) -1) (imaginary 2)))
 159.253 +  (is (= (/ -1 (imaginary 5)) (imaginary 1/5)))
 159.254 +  (is (= (/ (imaginary 5) -1) (imaginary -5)))
 159.255 +  (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5)))
 159.256 +  (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2)))
 159.257 +  (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29)))
 159.258 +  (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2)))
 159.259 +  (is (= (/ (imaginary -2) 3) (imaginary -2/3)))
 159.260 +  (is (= (/ 3 (imaginary -2)) (imaginary 3/2)))
 159.261 +  (is (= (/ (imaginary -2) -1) (imaginary 2)))
 159.262 +  (is (= (/ -1 (imaginary -2)) (imaginary -1/2)))
 159.263 +  (is (= (/ (imaginary -2) (imaginary -2)) 1))
 159.264 +  (is (= (/ (imaginary -2) (imaginary 5)) -2/5))
 159.265 +  (is (= (/ (imaginary 5) (imaginary -2)) -5/2))
 159.266 +  (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1)))
 159.267 +  (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5)))
 159.268 +  (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58)))
 159.269 +  (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5)))
 159.270 +  (is (= (/ (imaginary 5) 3) (imaginary 5/3)))
 159.271 +  (is (= (/ 3 (imaginary 5)) (imaginary -3/5)))
 159.272 +  (is (= (/ (imaginary 5) -1) (imaginary -5)))
 159.273 +  (is (= (/ -1 (imaginary 5)) (imaginary 1/5)))
 159.274 +  (is (= (/ (imaginary 5) (imaginary -2)) -5/2))
 159.275 +  (is (= (/ (imaginary -2) (imaginary 5)) -2/5))
 159.276 +  (is (= (/ (imaginary 5) (imaginary 5)) 1)))
 159.277 +
 159.278 +(deftest complex-conjugate
 159.279 +  (is (= (conjugate (complex 1 2)) (complex 1 -2)))
 159.280 +  (is (= (conjugate (complex -3 -7)) (complex -3 7)))
 159.281 +  (is (= (conjugate (imaginary -2)) (imaginary 2)))
 159.282 +  (is (= (conjugate (imaginary 5)) (imaginary -5))))
 159.283 +
 159.284 +(deftest complex-abs
 159.285 +  (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2)
 159.286 +	     (complex -3 -7) (imaginary -2) (imaginary 5)]]
 159.287 +    (is (approx= (* c (conjugate c))
 159.288 +		 (sqr (abs c))
 159.289 +		 1e-14))))
 159.290 +
 159.291 +(deftest complex-sqrt
 159.292 +  (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2)
 159.293 +	     (complex -3 -7) (imaginary -2) (imaginary 5)]]
 159.294 +    (let [r (sqrt c)]
 159.295 +      (is (approx= c (sqr r) 1e-14))
 159.296 +      (is (>= (real r) 0)))))
 159.297 +
 159.298 +(deftest complex-exp
 159.299 +  (is (approx= (exp (complex 1 2))
 159.300 +	       (complex -1.1312043837568135 2.4717266720048188)
 159.301 +	       1e-14))
 159.302 +  (is (approx= (exp (complex 2 3))
 159.303 +	       (complex -7.3151100949011028 1.0427436562359045)
 159.304 +	       1e-14))
 159.305 +  (is (approx= (exp (complex 4 -2))
 159.306 +	       (complex -22.720847417619233 -49.645957334580565)
 159.307 +	       1e-14))
 159.308 +  (is (approx= (exp (complex 3 -7))
 159.309 +	       (complex 15.142531566086868 -13.195928586605717)
 159.310 +	       1e-14))
 159.311 +  (is (approx= (exp (imaginary -2))
 159.312 +	       (complex -0.41614683654714241 -0.90929742682568171)
 159.313 +	       1e-14))
 159.314 +  (is (approx= (exp (imaginary 5))
 159.315 +	       (complex 0.2836621854632263 -0.95892427466313845)
 159.316 +	       1e-14)))
   160.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   160.2 +++ b/src/clojure/contrib/test_contrib/test_core.clj	Sat Aug 21 06:25:44 2010 -0400
   160.3 @@ -0,0 +1,42 @@
   160.4 +;   Copyright (c) Laurent Petit, March 2009. All rights reserved.
   160.5 +
   160.6 +;   The use and distribution terms for this software are covered by the
   160.7 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   160.8 +;   which can be found in the file epl-v10.html at the root of this 
   160.9 +;   distribution.
  160.10 +;   By using this software in any fashion, you are agreeing to be bound by
  160.11 +;   the terms of this license.
  160.12 +;   You must not remove this notice, or any other, from this software.
  160.13 +
  160.14 +;; test namespace for clojure.contrib.core
  160.15 +
  160.16 +;; note to other contrib members: feel free to add to this lib
  160.17 +
  160.18 +(ns clojure.contrib.test-core
  160.19 +  (:use clojure.test)
  160.20 +  (:use clojure.contrib.core))
  160.21 +
  160.22 +(deftest test-classic-versions
  160.23 +  (testing "Classic -> throws NPE if passed nil"
  160.24 +    (is (thrown? NullPointerException (-> nil .toString)))
  160.25 +    (is (thrown? NullPointerException (-> "foo" seq next next next .toString))))
  160.26 +  (testing "Classic .. throws NPE if one of the intermediate threaded values is nil"
  160.27 +    (is (thrown? NullPointerException (.. nil toString)))
  160.28 +    (is (thrown? NullPointerException (.. [nil] (get 0) toString)))))
  160.29 +
  160.30 +(deftest test-new-versions
  160.31 +  (testing "Version -?>> falls out on nil"
  160.32 +    (is (nil? (-?>> nil .toString)))
  160.33 +    (is (nil? (-?>> [] seq (map inc))))
  160.34 +    (is (= [] (->> [] seq (map inc)))))
  160.35 +  (testing "Version -?>> completes for non-nil"
  160.36 +    (is (= [3 4] (-?>> [1 2] (map inc) (map inc)))))
  160.37 +  (testing "Version -?> falls out on nil"
  160.38 +    (is (nil? (-?> nil .toString)))
  160.39 +    (is (nil? (-?> "foo" seq next next next .toString))))
  160.40 +  (testing "Version -?> completes for non-nil"
  160.41 +    (is (= [\O \O] (-?> "foo" .toUpperCase rest))))
  160.42 +  (testing "Version .?. returns nil if one of the intermediate threaded values is nil"
  160.43 +    (is (nil? (.?. nil toString)))
  160.44 +    (is (nil? (.?. [nil] (get 0) toString)))))
  160.45 +    
   161.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   161.2 +++ b/src/clojure/contrib/test_contrib/test_dataflow.clj	Sat Aug 21 06:25:44 2010 -0400
   161.3 @@ -0,0 +1,90 @@
   161.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   161.5 +;;  distribution terms for this software are covered by the Eclipse Public
   161.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   161.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   161.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   161.9 +;;  terms of this license.  You must not remove this notice, or any other,
  161.10 +;;  from this software.
  161.11 +;;
  161.12 +;;  test-dataflow
  161.13 +;;
  161.14 +;;  A Library to Support a Dataflow Model of State - Tests
  161.15 +;;
  161.16 +;;  straszheimjeffrey (gmail)
  161.17 +;;  Created 11 March 2009
  161.18 +
  161.19 +
  161.20 +(ns clojure.contrib.test-dataflow
  161.21 +  (:use clojure.test)
  161.22 +  (:use clojure.contrib.dataflow))
  161.23 +
  161.24 +(def df-1
  161.25 +     (build-dataflow
  161.26 +      [(cell :source base 0)
  161.27 +       (cell :source items ())
  161.28 +       (cell product (* ?base (apply + ?items)))
  161.29 +       (cell :validator (when (number? ?-product)
  161.30 +                          (assert (>= ?product ?-product))))]))
  161.31 +
  161.32 +(deftest test-df-1
  161.33 +  (is (= (get-value df-1 'product) 0))
  161.34 +  (is (do (update-values df-1 {'items [4 5]})
  161.35 +          (= (get-value df-1 'product) 0)))
  161.36 +  (is (do (update-values df-1 {'base 2})
  161.37 +          (= (get-value df-1 'product) 18)))
  161.38 +  (is (thrown? AssertionError (update-values df-1 {'base 0})))
  161.39 +  (is (= (get-value df-1 'product) 18)))
  161.40 +
  161.41 +(def df-2
  161.42 +     (build-dataflow
  161.43 +      [(cell :source strength 10)
  161.44 +       (cell :source agility 10)
  161.45 +       (cell :source magic 10)
  161.46 +
  161.47 +       (cell total-cost (apply + ?*cost))
  161.48 +
  161.49 +       (cell cost (- ?strength 10))
  161.50 +       (cell cost (- ?agility 10))
  161.51 +       (cell cost (- ?magic 10))
  161.52 +
  161.53 +       (cell combat (+ ?strength ?agility ?combat-mod))
  161.54 +       (cell speed (+ ?agility (/ ?strength 10.0) ?speed-mod))
  161.55 +       (cell casting (+ ?agility ?magic ?magic-mod))
  161.56 +
  161.57 +       (cell combat-mod (apply + ?*combat-mods))
  161.58 +       (cell speed-mod (apply + ?*speed-mods))
  161.59 +       (cell magic-mod (apply + ?*magic-mods))]))
  161.60 +
  161.61 +(def magic-skill
  161.62 +     [(cell cost 5)
  161.63 +      (cell speed-mods 1)
  161.64 +      (cell magic-mods 2)])
  161.65 +
  161.66 +(defn gv [n] (get-value df-2 n))
  161.67 +
  161.68 +(deftest test-df-2
  161.69 +  (is (and (= (gv 'total-cost) 0)
  161.70 +           (= (gv 'strength) 10)
  161.71 +           (= (gv 'casting) 20)))
  161.72 +  (is (do (update-values df-2 {'magic 12})
  161.73 +          (and (= (gv 'total-cost) 2)
  161.74 +               (= (gv 'casting) 22))))
  161.75 +  (is (do (add-cells df-2 magic-skill)
  161.76 +          (and (= (gv 'total-cost) 7)
  161.77 +               (= (gv 'casting) 24))))
  161.78 +  (is (do (remove-cells df-2 magic-skill)
  161.79 +          (and (= (gv 'total-cost) 2)
  161.80 +               (= (gv 'casting) 22)))))
  161.81 +               
  161.82 +
  161.83 +(comment
  161.84 +  (run-tests)
  161.85 +
  161.86 +  (use :reload 'clojure.contrib.dataflow)
  161.87 +  (use 'clojure.contrib.stacktrace) (e)
  161.88 +  (use 'clojure.contrib.trace)
  161.89 +
  161.90 +)
  161.91 +
  161.92 +
  161.93 +;; End of file
   162.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   162.2 +++ b/src/clojure/contrib/test_contrib/test_def.clj	Sat Aug 21 06:25:44 2010 -0400
   162.3 @@ -0,0 +1,27 @@
   162.4 +;; Tests for def.clj
   162.5 +
   162.6 +;; by Stuart Halloway
   162.7 +
   162.8 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
   162.9 +;; and distribution terms for this software are covered by the Eclipse
  162.10 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  162.11 +;; which can be found in the file epl-v10.html at the root of this
  162.12 +;; distribution.  By using this software in any fashion, you are
  162.13 +;; agreeing to be bound by the terms of this license.  You must not
  162.14 +;; remove this notice, or any other, from this software.
  162.15 +
  162.16 +(ns clojure.contrib.test-def
  162.17 +  (:use clojure.test)
  162.18 +  (:require [clojure.contrib.def :as d]))
  162.19 +
  162.20 +(defn sample-fn "sample-fn docstring" [])
  162.21 +(d/defalias aliased-fn sample-fn)
  162.22 +(defmacro sample-macro "sample-macro-docstring" [])
  162.23 +(d/defalias aliased-macro sample-macro)
  162.24 +
  162.25 +(deftest defalias-preserves-metadata
  162.26 +  (let [preserved-meta #(-> % (meta) (select-keys [:doc :arglists :ns :file :macro]))]
  162.27 +    (are [x y] (= (preserved-meta (var x)) (preserved-meta (var y)))
  162.28 +         aliased-fn sample-fn
  162.29 +         aliased-macro sample-macro)))
  162.30 +
   163.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   163.2 +++ b/src/clojure/contrib/test_contrib/test_fnmap.clj	Sat Aug 21 06:25:44 2010 -0400
   163.3 @@ -0,0 +1,39 @@
   163.4 +(ns clojure.contrib.test-fnmap
   163.5 +  (:use clojure.contrib.fnmap
   163.6 +        clojure.test))
   163.7 +
   163.8 +(deftest acts-like-map
   163.9 +  (let [m1 (fnmap get assoc :key1 1 :key2 2)]
  163.10 +    (are [k v] (= v (get m1 k))
  163.11 +         :key1 1
  163.12 +         :key2 2
  163.13 +         :nonexistent-key nil)
  163.14 +    (are [k v] (= v (k m1))
  163.15 +         :key1 1
  163.16 +         :key2 2
  163.17 +         :nonexistent-key nil)
  163.18 +    (let [m2 (assoc m1 :key3 3 :key4 4)]
  163.19 +      (are [k v] (= v (get m2 k))
  163.20 +           :key1 1
  163.21 +           :key2 2
  163.22 +           :key3 3
  163.23 +           :key4 4
  163.24 +           :nonexistent-key nil))))
  163.25 +
  163.26 +(defn assoc-validate [m key value]
  163.27 +  (if (integer? value)
  163.28 +    (assoc m key value)
  163.29 +    (throw (Exception. "Only integers allowed in this map!"))))
  163.30 +
  163.31 +(deftest validators
  163.32 +  (let [m (fnmap get assoc-validate)]
  163.33 +    (is (= 2 (:key2 (assoc m :key2 2))))
  163.34 +    (is (thrown? Exception (assoc m :key3 3.14)))))
  163.35 +
  163.36 +(defn get-transform [m key]
  163.37 +  (when-let [value (m key)]
  163.38 +    (- value)))
  163.39 +
  163.40 +(deftest transforms
  163.41 +  (let [m (fnmap get-transform assoc)]
  163.42 +    (is (= -2 (:key2 (assoc m :key2 2))))))
   164.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   164.2 +++ b/src/clojure/contrib/test_contrib/test_graph.clj	Sat Aug 21 06:25:44 2010 -0400
   164.3 @@ -0,0 +1,187 @@
   164.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
   164.5 +;;  distribution terms for this software are covered by the Eclipse Public
   164.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   164.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   164.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   164.9 +;;  terms of this license.  You must not remove this notice, or any other,
  164.10 +;;  from this software.
  164.11 +;;
  164.12 +;;  test-graph
  164.13 +;;
  164.14 +;;  Basic Graph Theory Algorithms Tests
  164.15 +;;
  164.16 +;;  straszheimjeffrey (gmail)
  164.17 +;;  Created 23 June 2009
  164.18 +
  164.19 +(ns clojure.contrib.test-graph
  164.20 +  (use clojure.test
  164.21 +       clojure.contrib.graph))
  164.22 +
  164.23 +
  164.24 +(def empty-graph (struct directed-graph #{} {}))
  164.25 +
  164.26 +(def test-graph-1
  164.27 +     (struct directed-graph
  164.28 +             #{:a :b :c :d :e}
  164.29 +             {:a #{:b :c}
  164.30 +              :b #{:a :c}
  164.31 +              :c #{:d :e}
  164.32 +              :d #{:a :b}
  164.33 +              :e #{:d}}))
  164.34 +
  164.35 +(deftest test-reverse-graph
  164.36 +  (is (= (reverse-graph test-graph-1)
  164.37 +         (struct directed-graph
  164.38 +                 #{:a :b :c :d :e}
  164.39 +                 {:c #{:b :a}
  164.40 +                  :e #{:c}
  164.41 +                  :d #{:c :e}
  164.42 +                  :b #{:d :a}
  164.43 +                  :a #{:d :b}})))
  164.44 +  (is (= (reverse-graph (reverse-graph test-graph-1))
  164.45 +         test-graph-1))
  164.46 +  (is (= (reverse-graph empty-graph) empty-graph)))
  164.47 +
  164.48 +(deftest test-add-loops
  164.49 +  (let [tg1 (add-loops test-graph-1)]
  164.50 +    (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
  164.51 +  (is (= (add-loops empty-graph) empty-graph)))
  164.52 +
  164.53 +(deftest test-remove-loops
  164.54 +  (let [tg1 (remove-loops (add-loops test-graph-1))]
  164.55 +    (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
  164.56 +  (is (= (remove-loops empty-graph) empty-graph)))
  164.57 +
  164.58 +
  164.59 +(def test-graph-2
  164.60 +     (struct directed-graph
  164.61 +             #{:a :b :c :d :e :f :g :h :i :j}
  164.62 +             {:a #{:b :c}
  164.63 +              :b #{:a :c} 
  164.64 +              :c #{:d :e}
  164.65 +              :d #{:a :b}
  164.66 +              :e #{:d}
  164.67 +              :f #{:f}
  164.68 +              :g #{:a :f}
  164.69 +              :h #{}
  164.70 +              :i #{:j}
  164.71 +              :j #{:i}}))
  164.72 +
  164.73 +
  164.74 +(deftest test-lazy-walk
  164.75 +  (is (= (lazy-walk test-graph-2 :h) [:h]))
  164.76 +  (is (= (lazy-walk test-graph-2 :j) [:j :i])))
  164.77 +
  164.78 +(deftest test-transitive-closure
  164.79 +  (let [tc-1 (transitive-closure test-graph-1)
  164.80 +        tc-2 (transitive-closure test-graph-2)
  164.81 +        get (fn [n] (set (get-neighbors tc-2 n)))]
  164.82 +    (is (every? #(= #{:a :b :c :d :e} (set %))
  164.83 +                (map (partial get-neighbors tc-1) (:nodes tc-1))))
  164.84 +    (is (= (get :a) #{:a :b :c :d :e}))
  164.85 +    (is (= (get :h) #{}))
  164.86 +    (is (= (get :j) #{:i :j}))
  164.87 +    (is (= (get :g) #{:a :b :c :d :e :f}))))
  164.88 +
  164.89 +
  164.90 +(deftest test-post-ordered-nodes
  164.91 +  (is (= (set (post-ordered-nodes test-graph-2))
  164.92 +         #{:a :b :c :d :e :f :g :h :i :j}))
  164.93 +  (is (empty? (post-ordered-nodes empty-graph))))
  164.94 +
  164.95 +
  164.96 +(deftest test-scc
  164.97 +  (is (= (set (scc test-graph-2))
  164.98 +         #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}}))
  164.99 +  (is (empty? (scc empty-graph))))
 164.100 +
 164.101 +(deftest test-component-graph
 164.102 +  (let [cg (component-graph test-graph-2)
 164.103 +        ecg (component-graph empty-graph)]
 164.104 +    (is (= (:nodes cg) (set (scc test-graph-2))))
 164.105 +    (is (= (get-neighbors cg #{:a :b :c :d :e})
 164.106 +           #{#{:a :b :c :d :e}}))
 164.107 +    (is (= (get-neighbors cg #{:g})
 164.108 +           #{#{:a :b :c :d :e} #{:f}}))
 164.109 +    (is (= (get-neighbors cg #{:i :j})
 164.110 +           #{#{:i :j}}))
 164.111 +    (is (= (get-neighbors cg #{:h})
 164.112 +           #{}))
 164.113 +    (is (= (apply max (map count (self-recursive-sets cg))) 1))
 164.114 +    (is (= ecg empty-graph))))
 164.115 +
 164.116 +
 164.117 +(deftest test-recursive-component?
 164.118 +  (let [sccs (scc test-graph-2)]
 164.119 +    (is (= (set (filter (partial recursive-component? test-graph-2) sccs))
 164.120 +           #{#{:i :j} #{:b :c :a :d :e} #{:f}}))))
 164.121 +
 164.122 +
 164.123 +(deftest test-self-recursive-sets
 164.124 +  (is (= (set (self-recursive-sets test-graph-2))
 164.125 +         (set (filter
 164.126 +               (partial recursive-component? test-graph-2)
 164.127 +               (scc test-graph-2)))))
 164.128 +  (is (empty? (self-recursive-sets empty-graph))))
 164.129 +
 164.130 +
 164.131 +(def test-graph-3
 164.132 +     (struct directed-graph
 164.133 +             #{:a :b :c :d :e :f}
 164.134 +             {:a #{:b}
 164.135 +              :b #{:c}
 164.136 +              :c #{:d}
 164.137 +              :d #{:e}
 164.138 +              :e #{:f}
 164.139 +              :f #{}}))
 164.140 +
 164.141 +(def test-graph-4
 164.142 +     (struct directed-graph
 164.143 +             #{:a :b :c :d :e :f :g :h}
 164.144 +             {:a #{}
 164.145 +              :b #{:a}
 164.146 +              :c #{:a}
 164.147 +              :d #{:a :b}
 164.148 +              :e #{:d :c}
 164.149 +              :f #{:e}
 164.150 +              :g #{:d}
 164.151 +              :h #{:f}}))
 164.152 +
 164.153 +(def test-graph-5
 164.154 +     (struct directed-graph
 164.155 +             #{:a :b :c :d :e :f :g :h}
 164.156 +             {:a #{}
 164.157 +              :b #{}
 164.158 +              :c #{:b}
 164.159 +              :d #{}
 164.160 +              :e #{}
 164.161 +              :f #{}
 164.162 +              :g #{:f}
 164.163 +              :h #{}}))
 164.164 +
 164.165 +(deftest test-dependency-list
 164.166 +  (is (thrown-with-msg? Exception #".*Fixed point overflow.*"
 164.167 +                        (dependency-list test-graph-2)))
 164.168 +  (is (= (dependency-list test-graph-3)
 164.169 +         [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}]))
 164.170 +  (is (= (dependency-list test-graph-4)
 164.171 +         [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}]))
 164.172 +  (is (= (dependency-list test-graph-5)
 164.173 +         [#{:f :b :a :d :h :e} #{:g :c}]))
 164.174 +  (is (= (dependency-list empty-graph)
 164.175 +         [#{}])))
 164.176 +
 164.177 +(deftest test-stratification-list
 164.178 +  (is (thrown-with-msg? Exception #".*Fixed point overflow.*"
 164.179 +                        (stratification-list test-graph-2 test-graph-2)))
 164.180 +  (is (= (stratification-list test-graph-4 test-graph-5)
 164.181 +         [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}]))
 164.182 +  (is (= (stratification-list empty-graph empty-graph)
 164.183 +         [#{}])))
 164.184 +
 164.185 +(comment
 164.186 +  (run-tests)
 164.187 +)
 164.188 +
 164.189 +
 164.190 +;; End of file
   165.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   165.2 +++ b/src/clojure/contrib/test_contrib/test_greatest_least.clj	Sat Aug 21 06:25:44 2010 -0400
   165.3 @@ -0,0 +1,65 @@
   165.4 +(ns clojure.contrib.test-greatest-least
   165.5 +  (:use clojure.contrib.greatest-least
   165.6 +        [clojure.test :only (is deftest run-tests)]))
   165.7 +
   165.8 +(deftest test-greatest
   165.9 +  (is (nil? (greatest)) "greatest with no arguments is nil")
  165.10 +  (is (= 1 (greatest 1)))
  165.11 +  (is (= 2 (greatest 1 2)))
  165.12 +  (is (= 2 (greatest 2 1)))
  165.13 +  (is (= "b" (greatest "aa" "b"))))
  165.14 +
  165.15 +(deftest test-greatest-by
  165.16 +  (is (nil? (greatest-by identity)) "greatest-by with no arguments is nil")
  165.17 +  (is (= "" (greatest-by count "")))
  165.18 +  (is (= "a" (greatest-by count "a" "")))
  165.19 +  (is (= "a" (greatest-by count "" "a")))
  165.20 +  (is (= "aa" (greatest-by count "aa" "b"))))
  165.21 +
  165.22 +(deftest test-least
  165.23 +  (is (nil? (least)) "least with no arguments is nil")
  165.24 +  (is (= 1 (least 1)))
  165.25 +  (is (= 1 (least 1 2)))
  165.26 +  (is (= 1 (least 2 1)))
  165.27 +  (is (= "aa" (least "aa" "b"))))
  165.28 +
  165.29 +(deftest test-least-by
  165.30 +  (is (nil? (least-by identity)) "least-by with no arguments is nil")
  165.31 +  (is (= "" (least-by count "")))
  165.32 +  (is (= "" (least-by count "a" "")))
  165.33 +  (is (= "" (least-by count "" "a")))
  165.34 +  (is (= "b" (least-by count "aa" "b"))))
  165.35 +
  165.36 +(deftest test-all-greatest
  165.37 +  (is (nil? (all-greatest)) "all-greatest with no arguments is nil")
  165.38 +  (is (= (list 1) (all-greatest 1)))
  165.39 +  (is (= (list 1 1) (all-greatest 1 1)))
  165.40 +  (is (= (list 2) (all-greatest 2 1 1)))
  165.41 +  (is (= (list 2) (all-greatest 1 2 1)))
  165.42 +  (is (= (list 2) (all-greatest 1 1 2)))
  165.43 +  (is (= (list :c) (all-greatest :b :c :a))))
  165.44 +
  165.45 +(deftest test-all-greatest-by
  165.46 +  (is (nil? (all-greatest-by identity)) "all-greatest-by with no arguments is nil")
  165.47 +  (is (= (list "a")) (all-greatest-by count "a"))
  165.48 +  (is (= (list "a" "a")) (all-greatest-by count "a" "a"))
  165.49 +  (is (= (list "aa")) (all-greatest-by count "aa" "b"))
  165.50 +  (is (= (list "aa")) (all-greatest-by count "b" "aa" "c"))
  165.51 +  (is (= (list "cc" "aa")) (all-greatest-by count "aa" "b" "cc")))
  165.52 +
  165.53 +(deftest test-all-least
  165.54 +  (is (nil? (all-least)) "all-least with no arguments is nil")
  165.55 +  (is (= (list 1) (all-least 1)))
  165.56 +  (is (= (list 1 1) (all-least 1 1)))
  165.57 +  (is (= (list 1 1) (all-least 2 1 1)))
  165.58 +  (is (= (list 1 1) (all-least 1 2 1)))
  165.59 +  (is (= (list 1 1) (all-least 1 1 2)))
  165.60 +  (is (= (list :a) (all-least :b :c :a))))
  165.61 +
  165.62 +(deftest test-all-least-by
  165.63 +  (is (nil? (all-least-by identity)) "all-least-by with no arguments is nil")
  165.64 +  (is (= (list "a")) (all-least-by count "a"))
  165.65 +  (is (= (list "a" "a")) (all-least-by count "a" "a"))
  165.66 +  (is (= (list "b")) (all-least-by count "aa" "b"))
  165.67 +  (is (= (list "c" "b")) (all-least-by count "b" "aa" "c"))
  165.68 +  (is (= (list "b")) (all-least-by count "aa" "b" "cc")))
   166.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   166.2 +++ b/src/clojure/contrib/test_contrib/test_io.clj	Sat Aug 21 06:25:44 2010 -0400
   166.3 @@ -0,0 +1,96 @@
   166.4 +(ns clojure.contrib.test-io
   166.5 +  (:refer-clojure :exclude (spit))
   166.6 +  (:use clojure.test clojure.contrib.io)
   166.7 +  (:import (java.io File FileInputStream BufferedInputStream)
   166.8 +           (java.net URL URI)))
   166.9 +
  166.10 +(deftest file-str-backslash
  166.11 +  (is (= (java.io.File.
  166.12 +          (str "C:" java.io.File/separator
  166.13 +               "Documents" java.io.File/separator
  166.14 +               "file.txt"))
  166.15 +         (file-str "C:\\Documents\\file.txt"))))
  166.16 +
  166.17 +(deftest test-as-file
  166.18 +  (testing "strings"
  166.19 +    (is (= (File. "foo") (as-file "foo"))))
  166.20 +  (testing "Files"
  166.21 +    (is (= (File. "bar") (as-file (File. "bar"))))))
  166.22 +
  166.23 +(deftest test-as-url
  166.24 +  (are [result expr] (= result expr)
  166.25 +       (URL. "http://foo") (as-url (URL. "http://foo"))
  166.26 +       (URL. "http://foo") (as-url "http://foo")
  166.27 +       (URL. "http://foo") (as-url (URI. "http://foo"))
  166.28 +       (URL. "file:/foo") (as-url (File. "/foo"))))
  166.29 +
  166.30 +(deftest test-delete-file
  166.31 +  (let [file (File/createTempFile "test" "deletion")
  166.32 +        not-file (File. (str (java.util.UUID/randomUUID)))]
  166.33 +    (delete-file (.getAbsolutePath file))
  166.34 +    (is (not (.exists file)))
  166.35 +    (is (thrown? ArithmeticException (/ 1 0)))
  166.36 +    (is (thrown? java.io.IOException (delete-file not-file)))
  166.37 +    (is (delete-file not-file :silently))))
  166.38 +
  166.39 +(deftest test-relative-path-string
  166.40 +  (testing "strings"
  166.41 +    (is (= "foo" (relative-path-string "foo"))))
  166.42 +  (testing "absolute path strings are forbidden"
  166.43 +    (is (thrown? IllegalArgumentException (relative-path-string (str File/separator "baz")))))
  166.44 +  (testing "relative File paths"
  166.45 +    (is (= "bar" (relative-path-string (File. "bar")))))
  166.46 +  (testing "absolute File paths are forbidden"
  166.47 +    (is (thrown? IllegalArgumentException (relative-path-string (File. (str File/separator "quux")))))))
  166.48 +
  166.49 +(defn stream-should-have [stream expected-bytes msg]
  166.50 +  (let [actual-bytes (byte-array (alength expected-bytes))]
  166.51 +    (.read stream actual-bytes)
  166.52 +    (is (= -1 (.read stream)) (str msg " : should be end of stream"))
  166.53 +    (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match"))))
  166.54 +
  166.55 +(deftest test-input-stream
  166.56 +  (let [file (File/createTempFile "test-input-stream" "txt")
  166.57 +        bytes (.getBytes "foobar")]
  166.58 +    (spit file "foobar")
  166.59 +    (doseq [[expr msg]
  166.60 +            [[file File]
  166.61 +             [(FileInputStream. file) FileInputStream]
  166.62 +             [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream]
  166.63 +             [(.. file toURI) URI]
  166.64 +             [(.. file toURI toURL) URL]
  166.65 +             [(.. file toURI toURL toString) "URL as String"]
  166.66 +             [(.. file toString) "File as String"]]]
  166.67 +      (with-open [s (input-stream expr)]
  166.68 +        (stream-should-have s bytes msg)))))
  166.69 +
  166.70 +(deftest test-streams-buffering
  166.71 +  (let [data (.getBytes "")]
  166.72 +    (is (instance? java.io.BufferedReader (reader data)))
  166.73 +    (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.))))
  166.74 +    (is (instance? java.io.BufferedInputStream (input-stream data)))
  166.75 +    (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.))))))
  166.76 +
  166.77 +(deftest test-streams-defaults
  166.78 +  (let [f (File/createTempFile "clojure.contrib" "test-reader-writer")
  166.79 +        content "test\u2099ing"]
  166.80 +    (try
  166.81 +      (is (thrown? Exception (reader (Object.))))
  166.82 +      (is (thrown? Exception (writer (Object.))))
  166.83 +
  166.84 +      (are [write-to read-from] (= content (do
  166.85 +                                             (spit write-to content)
  166.86 +                                             (slurp* (or read-from write-to))))
  166.87 +        f nil
  166.88 +        (.getAbsolutePath f) nil
  166.89 +        (.toURL f) nil
  166.90 +        (.toURI f) nil
  166.91 +        (java.io.FileOutputStream. f) f
  166.92 +        (java.io.OutputStreamWriter. (java.io.FileOutputStream. f) "UTF-8") f
  166.93 +        f (java.io.FileInputStream. f)
  166.94 +        f (java.io.InputStreamReader. (java.io.FileInputStream. f) "UTF-8"))
  166.95 +
  166.96 +      (is (= content (slurp* (.getBytes content "UTF-8"))))
  166.97 +      (is (= content (slurp* (.toCharArray content))))
  166.98 +      (finally
  166.99 +        (.delete f)))))
   167.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   167.2 +++ b/src/clojure/contrib/test_contrib/test_jmx.clj	Sat Aug 21 06:25:44 2010 -0400
   167.3 @@ -0,0 +1,178 @@
   167.4 +;; Tests for JMX support for Clojure (see also clojure/contrib/jmx.clj)
   167.5 +
   167.6 +;; by Stuart Halloway
   167.7 +
   167.8 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
   167.9 +;; and distribution terms for this software are covered by the Eclipse
  167.10 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  167.11 +;; which can be found in the file epl-v10.html at the root of this
  167.12 +;; distribution.  By using this software in any fashion, you are
  167.13 +;; agreeing to be bound by the terms of this license.  You must not
  167.14 +;; remove this notice, or any other, from this software.
  167.15 +
  167.16 +(ns clojure.contrib.test-jmx
  167.17 +  (:import javax.management.openmbean.CompositeDataSupport
  167.18 +           [javax.management MBeanAttributeInfo AttributeList]
  167.19 +           [java.util.logging LogManager Logger]
  167.20 +           clojure.contrib.jmx.Bean)
  167.21 +  (:use clojure.test)
  167.22 +  (:require [clojure.contrib [jmx :as jmx]]))
  167.23 +
  167.24 +
  167.25 +(defn =set [a b]
  167.26 +  (= (set a) (set b)))
  167.27 +
  167.28 +(defn seq-contains-all?
  167.29 +  "Does container contain every item in containee?
  167.30 +   Not fast. Testing use only"
  167.31 +  [container containee]
  167.32 +  (let [container (set container)]
  167.33 +    (every? #(contains? container %) containee)))
  167.34 +
  167.35 +(deftest finding-mbeans
  167.36 +  (testing "as-object-name"
  167.37 +           (are [cname object-name]
  167.38 +                (= cname (.getCanonicalName object-name))
  167.39 +                "java.lang:type=Memory" (jmx/as-object-name "java.lang:type=Memory")))
  167.40 +  (testing "mbean-names"
  167.41 +           (are [cnames object-name]
  167.42 +                (= cnames (map #(.getCanonicalName %) object-name))
  167.43 +                ["java.lang:type=Memory"] (jmx/mbean-names "java.lang:type=Memory"))))
  167.44 +
  167.45 +; These actual beans may differ on different JVM platforms.
  167.46 +; Tested April 2010 to work on Sun and IBM JDKs.
  167.47 +(deftest testing-actual-beans
  167.48 +  (testing "reflecting on capabilities"
  167.49 +    (are [attr-list mbean-name]
  167.50 +         (seq-contains-all? (jmx/attribute-names mbean-name) attr-list)
  167.51 +         [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory")
  167.52 +    (are [op-list mbean-name]
  167.53 +         (seq-contains-all? (jmx/operation-names mbean-name) op-list)
  167.54 +         [:gc] "java.lang:type=Memory"))
  167.55 +  (testing "mbean-from-oname"
  167.56 +    (are [key-names oname]
  167.57 +         (seq-contains-all? (keys (jmx/mbean oname)) key-names)
  167.58 +         [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage]  "java.lang:type=Memory")))
  167.59 +
  167.60 +(deftest raw-reading-attributes
  167.61 +  (let [mem "java.lang:type=Memory"
  167.62 +        log "java.util.logging:type=Logging"]
  167.63 +    (testing "simple scalar attributes"
  167.64 +             (are [a b] (= a b)
  167.65 +                  false (jmx/raw-read mem :Verbose))
  167.66 +             (are [type attr] (instance? type attr)
  167.67 +                  Number (jmx/raw-read mem :ObjectPendingFinalizationCount)))))
  167.68 +
  167.69 +(deftest reading-attributes
  167.70 +  (testing "simple scalar attributes"
  167.71 +           (are [type attr] (instance? type attr)
  167.72 +                Number (jmx/read "java.lang:type=Memory" :ObjectPendingFinalizationCount)))
  167.73 +  (testing "composite attributes"
  167.74 +           (are [ks attr] (=set ks (keys attr))
  167.75 +                [:used :max :init :committed] (jmx/read "java.lang:type=Memory" :HeapMemoryUsage)))
  167.76 +  (testing "tabular attributes"
  167.77 +           (is (map? (jmx/read "java.lang:type=Runtime" :SystemProperties)))))
  167.78 +
  167.79 +(deftest writing-attributes
  167.80 +  (let [mem "java.lang:type=Memory"]
  167.81 +    (jmx/write! mem :Verbose true)
  167.82 +    (is (true? (jmx/raw-read mem :Verbose)))
  167.83 +    (jmx/write! mem :Verbose false)))
  167.84 +
  167.85 +(deftest test-invoke-operations
  167.86 +  (testing "without arguments"
  167.87 +           (jmx/invoke "java.lang:type=Memory" :gc))
  167.88 +  (testing "with arguments"
  167.89 +           (.addLogger (LogManager/getLogManager) (Logger/getLogger "clojure.contrib.test_contrib.test_jmx"))
  167.90 +           (jmx/invoke "java.util.logging:type=Logging" :setLoggerLevel "clojure.contrib.test_contrib.test_jmx" "WARNING")))
  167.91 +
  167.92 +(deftest test-jmx->clj
  167.93 +  (testing "it works recursively on maps"
  167.94 +           (let [some-map {:foo (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage)}]
  167.95 +             (is (map? (:foo (jmx/jmx->clj some-map))))))
  167.96 +  (testing "it leaves everything else untouched"
  167.97 +           (is (= "foo" (jmx/jmx->clj "foo")))))
  167.98 +  
  167.99 +  
 167.100 +(deftest test-composite-data->map
 167.101 +  (let [data (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage)
 167.102 +        prox (jmx/composite-data->map data)]
 167.103 +    (testing "returns a map with keyword keys"
 167.104 +             (is (= (set [:committed :init :max :used]) (set (keys prox)))))))
 167.105 +
 167.106 +(deftest test-tabular-data->map
 167.107 +  (let [raw-props (jmx/raw-read "java.lang:type=Runtime" :SystemProperties)
 167.108 +        props (jmx/tabular-data->map raw-props)]
 167.109 +    (are [k] (contains? props k)
 167.110 +         :java.class.path
 167.111 +         :path.separator)))
 167.112 +
 167.113 +(deftest test-creating-attribute-infos
 167.114 +  (let [infos (jmx/map->attribute-infos [[:a 1] [:b 2]])
 167.115 +        info (first infos)]
 167.116 +    (testing "generates the right class"
 167.117 +             (is (= (class (into-array MBeanAttributeInfo [])) (class infos))))
 167.118 +    (testing "generates the right instance data"
 167.119 +             (are [result expr] (= result expr)
 167.120 +                  "a" (.getName info)
 167.121 +                  "a" (.getDescription info)))))
 167.122 +
 167.123 +(deftest various-beans-are-readable
 167.124 +  (testing "that all java.lang beans can be read without error"
 167.125 +           (doseq [mb (jmx/mbean-names "*:*")]
 167.126 +             (is (map? (jmx/mbean mb)) mb))))
 167.127 +
 167.128 +(deftest test-jmx-url
 167.129 +  (testing "creates default url"
 167.130 +    (is (= "service:jmx:rmi:///jndi/rmi://localhost:3000/jmxrmi"
 167.131 +           (jmx/jmx-url))))
 167.132 +  (testing "creates custom url"
 167.133 +    (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxrmi"
 167.134 +           (jmx/jmx-url {:host "example.com" :port 4000}))))
 167.135 +  (testing "creates custom jndi path"
 167.136 +    (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxconnector"
 167.137 +           (jmx/jmx-url {:host "example.com" :port 4000 :jndi-path "jmxconnector"})))))
 167.138 +
 167.139 +;; ----------------------------------------------------------------------
 167.140 +;; tests for clojure.contrib.jmx.Bean.
 167.141 +
 167.142 +(deftest dynamic-mbean-from-compiled-class
 167.143 +  (let [mbean-name "clojure.contrib.test_contrib.test_jmx:name=Foo"]
 167.144 +    (jmx/register-mbean
 167.145 +     (Bean.
 167.146 +      (ref {:string-attribute "a-string"}))
 167.147 +     mbean-name)
 167.148 +    (are [result expr] (= result expr)
 167.149 +         "a-string" (jmx/read mbean-name :string-attribute)
 167.150 +         {:string-attribute "a-string"} (jmx/mbean mbean-name)
 167.151 +         )))
 167.152 +
 167.153 +(deftest test-getAttribute
 167.154 +  (doseq [reftype [ref atom agent]]
 167.155 +    (let [state (reftype {:a 1 :b 2})
 167.156 +          bean (Bean. state)]
 167.157 +      (testing (str "accessing values from a " (class state))
 167.158 +               (are [result expr] (= result expr)
 167.159 +                    1 (.getAttribute bean "a"))))))
 167.160 +
 167.161 +(deftest test-bean-info
 167.162 +  (let [state (ref {:a 1 :b 2})
 167.163 +        bean (Bean. state)
 167.164 +        info (.getMBeanInfo bean)]
 167.165 +    (testing "accessing info"
 167.166 +             (are [result expr] (= result expr)
 167.167 +                  "clojure.contrib.jmx.Bean" (.getClassName info)))))
 167.168 +
 167.169 +(deftest test-getAttributes
 167.170 +  (let [bean (Bean. (ref {:r 5 :d 4}))
 167.171 +        atts (.getAttributes bean (into-array ["r" "d"]))]
 167.172 +    (are [x y] (= x y)
 167.173 +         AttributeList (class atts)
 167.174 +         [5 4] (seq atts))))
 167.175 +
 167.176 +(deftest test-guess-attribute-typename
 167.177 +  (are [x y] (= x (jmx/guess-attribute-typename y))
 167.178 +;       "long" 10
 167.179 +       "boolean" false
 167.180 +       "java.lang.String" "foo"
 167.181 +       "long" (Long/valueOf (long 10))))
   168.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   168.2 +++ b/src/clojure/contrib/test_contrib/test_json.clj	Sat Aug 21 06:25:44 2010 -0400
   168.3 @@ -0,0 +1,186 @@
   168.4 +(ns clojure.contrib.test-json
   168.5 +  (:use clojure.test clojure.contrib.json))
   168.6 +
   168.7 +(deftest can-read-from-pushback-reader
   168.8 +  (let [s (java.io.PushbackReader. (java.io.StringReader. "42"))]
   168.9 +    (is (= 42 (read-json s)))))
  168.10 +
  168.11 +(deftest can-read-from-reader
  168.12 +  (let [s (java.io.StringReader. "42")]
  168.13 +    (is (= 42 (read-json s)))))
  168.14 +
  168.15 +(deftest can-read-numbers
  168.16 +  (is (= 42 (read-json "42")))
  168.17 +  (is (= -3 (read-json "-3")))
  168.18 +  (is (= 3.14159 (read-json "3.14159")))
  168.19 +  (is (= 6.022e23 (read-json "6.022e23"))))
  168.20 +
  168.21 +(deftest can-read-null
  168.22 +  (is (= nil (read-json "null"))))
  168.23 +
  168.24 +(deftest can-read-strings
  168.25 +  (is (= "Hello, World!" (read-json "\"Hello, World!\""))))
  168.26 +
  168.27 +(deftest handles-escaped-slashes-in-strings
  168.28 +  (is (= "/foo/bar" (read-json "\"\\/foo\\/bar\""))))
  168.29 +
  168.30 +(deftest handles-unicode-escapes
  168.31 +  (is (= " \u0beb " (read-json "\" \\u0bEb \""))))
  168.32 +
  168.33 +(deftest handles-escaped-whitespace
  168.34 +  (is (= "foo\nbar" (read-json "\"foo\\nbar\"")))
  168.35 +  (is (= "foo\rbar" (read-json "\"foo\\rbar\"")))
  168.36 +  (is (= "foo\tbar" (read-json "\"foo\\tbar\""))))
  168.37 +
  168.38 +(deftest can-read-booleans
  168.39 +  (is (= true (read-json "true")))
  168.40 +  (is (= false (read-json "false"))))
  168.41 +
  168.42 +(deftest can-ignore-whitespace
  168.43 +  (is (= nil (read-json "\r\n   null"))))
  168.44 +
  168.45 +(deftest can-read-arrays
  168.46 +  (is (= [1 2 3] (read-json "[1,2,3]")))
  168.47 +  (is (= ["Ole" "Lena"] (read-json "[\"Ole\", \r\n \"Lena\"]"))))
  168.48 +
  168.49 +(deftest can-read-objects
  168.50 +  (is (= {:a 1, :b 2} (read-json "{\"a\": 1, \"b\": 2}"))))
  168.51 +
  168.52 +(deftest can-read-nested-structures
  168.53 +  (is (= {:a [1 2 {:b [3 "four"]} 5.5]}
  168.54 +         (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}"))))
  168.55 +
  168.56 +(deftest disallows-non-string-keys
  168.57 +  (is (thrown? Exception (read-json "{26:\"z\""))))
  168.58 +
  168.59 +(deftest disallows-barewords
  168.60 +  (is (thrown? Exception (read-json "  foo  "))))
  168.61 +
  168.62 +(deftest disallows-unclosed-arrays
  168.63 +  (is (thrown? Exception (read-json "[1, 2,  "))))
  168.64 +
  168.65 +(deftest disallows-unclosed-objects
  168.66 +  (is (thrown? Exception (read-json "{\"a\":1,  "))))
  168.67 +
  168.68 +(deftest can-get-string-keys
  168.69 +  (is (= {"a" [1 2 {"b" [3 "four"]} 5.5]}
  168.70 +         (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}" false true nil))))
  168.71 +
  168.72 +(declare *pass1-string*)
  168.73 +
  168.74 +(deftest pass1-test
  168.75 +  (let [input (read-json *pass1-string* false true nil)]
  168.76 +    (is (= "JSON Test Pattern pass1" (first input)))
  168.77 +    (is (= "array with 1 element" (get-in input [1 "object with 1 member" 0])))
  168.78 +    (is (= 1234567890 (get-in input [8 "integer"])))
  168.79 +    (is (= "rosebud" (last input)))))
  168.80 +
  168.81 +; from http://www.json.org/JSON_checker/test/pass1.json
  168.82 +(def *pass1-string*
  168.83 +     "[
  168.84 +    \"JSON Test Pattern pass1\",
  168.85 +    {\"object with 1 member\":[\"array with 1 element\"]},
  168.86 +    {},
  168.87 +    [],
  168.88 +    -42,
  168.89 +    true,
  168.90 +    false,
  168.91 +    null,
  168.92 +    {
  168.93 +        \"integer\": 1234567890,
  168.94 +        \"real\": -9876.543210,
  168.95 +        \"e\": 0.123456789e-12,
  168.96 +        \"E\": 1.234567890E+34,
  168.97 +        \"\":  23456789012E66,
  168.98 +        \"zero\": 0,
  168.99 +        \"one\": 1,
 168.100 +        \"space\": \" \",
 168.101 +        \"quote\": \"\\\"\",
 168.102 +        \"backslash\": \"\\\\\",
 168.103 +        \"controls\": \"\\b\\f\\n\\r\\t\",
 168.104 +        \"slash\": \"/ & \\/\",
 168.105 +        \"alpha\": \"abcdefghijklmnopqrstuvwyz\",
 168.106 +        \"ALPHA\": \"ABCDEFGHIJKLMNOPQRSTUVWYZ\",
 168.107 +        \"digit\": \"0123456789\",
 168.108 +        \"0123456789\": \"digit\",
 168.109 +        \"special\": \"`1~!@#$%^&*()_+-={':[,]}|;.</>?\",
 168.110 +        \"hex\": \"\\u0123\\u4567\\u89AB\\uCDEF\\uabcd\\uef4A\",
 168.111 +        \"true\": true,
 168.112 +        \"false\": false,
 168.113 +        \"null\": null,
 168.114 +        \"array\":[  ],
 168.115 +        \"object\":{  },
 168.116 +        \"address\": \"50 St. James Street\",
 168.117 +        \"url\": \"http://www.JSON.org/\",
 168.118 +        \"comment\": \"// /* <!-- --\",
 168.119 +        \"# -- --> */\": \" \",
 168.120 +        \" s p a c e d \" :[1,2 , 3
 168.121 +
 168.122 +,
 168.123 +
 168.124 +4 , 5        ,          6           ,7        ],\"compact\":[1,2,3,4,5,6,7],
 168.125 +        \"jsontext\": \"{\\\"object with 1 member\\\":[\\\"array with 1 element\\\"]}\",
 168.126 +        \"quotes\": \"&#34; \\u0022 %22 0x22 034 &#x22;\",
 168.127 +        \"\\/\\\\\\\"\\uCAFE\\uBABE\\uAB98\\uFCDE\\ubcda\\uef4A\\b\\f\\n\\r\\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?\"
 168.128 +: \"A key can be any string\"
 168.129 +    },
 168.130 +    0.5 ,98.6
 168.131 +,
 168.132 +99.44
 168.133 +,
 168.134 +
 168.135 +1066,
 168.136 +1e1,
 168.137 +0.1e1,
 168.138 +1e-1,
 168.139 +1e00,2e+00,2e-00
 168.140 +,\"rosebud\"]")
 168.141 +
 168.142 +
 168.143 +(deftest can-print-json-strings
 168.144 +  (is (= "\"Hello, World!\"" (json-str "Hello, World!")))
 168.145 +  (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes"))))
 168.146 +
 168.147 +(deftest can-print-unicode
 168.148 +  (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567"))))
 168.149 +
 168.150 +(deftest can-print-json-null
 168.151 +  (is (= "null" (json-str nil))))
 168.152 +
 168.153 +(deftest can-print-json-arrays
 168.154 +  (is (= "[1,2,3]" (json-str [1 2 3])))
 168.155 +  (is (= "[1,2,3]" (json-str (list 1 2 3))))
 168.156 +  (is (= "[1,2,3]" (json-str (sorted-set 1 2 3))))
 168.157 +  (is (= "[1,2,3]" (json-str (seq [1 2 3])))))
 168.158 +
 168.159 +(deftest can-print-java-arrays
 168.160 + (is (= "[1,2,3]" (json-str (into-array [1 2 3])))))
 168.161 +
 168.162 +(deftest can-print-empty-arrays
 168.163 +  (is (= "[]" (json-str [])))
 168.164 +  (is (= "[]" (json-str (list))))
 168.165 +  (is (= "[]" (json-str #{}))))
 168.166 +
 168.167 +(deftest can-print-json-objects
 168.168 +  (is (= "{\"a\":1,\"b\":2}" (json-str (sorted-map :a 1 :b 2)))))
 168.169 +
 168.170 +(deftest object-keys-must-be-strings
 168.171 +  (is (= "{\"1\":1,\"2\":2") (json-str (sorted-map 1 1 2 2))))
 168.172 +
 168.173 +(deftest can-print-empty-objects
 168.174 +  (is (= "{}" (json-str {}))))
 168.175 +
 168.176 +(deftest accept-sequence-of-nils
 168.177 +  (is (= "[null,null,null]" (json-str [nil nil nil]))))
 168.178 +
 168.179 +(deftest error-on-nil-keys
 168.180 +  (is (thrown? Exception (json-str {nil 1}))))
 168.181 +
 168.182 +(deftest characters-in-symbols-are-escaped
 168.183 +  (is (= "\"foo\\u1b1b\"" (json-str (symbol "foo\u1b1b")))))
 168.184 +
 168.185 +;;; Pretty-printer
 168.186 +
 168.187 +(deftest pretty-printing
 168.188 +  (let [x (read-json *pass1-string* false)]
 168.189 +    (is (= x (read-json (with-out-str (pprint-json x)) false)))))
   169.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   169.2 +++ b/src/clojure/contrib/test_contrib/test_lazy_seqs.clj	Sat Aug 21 06:25:44 2010 -0400
   169.3 @@ -0,0 +1,21 @@
   169.4 +(ns clojure.contrib.test-lazy-seqs
   169.5 +  (:use clojure.test
   169.6 +	clojure.contrib.lazy-seqs))
   169.7 +
   169.8 +(deftest test-fibs
   169.9 +  (is (= [0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 
  169.10 +	    17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 
  169.11 +	    3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 
  169.12 +	    165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 
  169.13 +	    4807526976 7778742049]
  169.14 +	 (take 50 (fibs)))))
  169.15 +
  169.16 +(deftest test-powers-of-2
  169.17 +  (is (= [1 2 4 8 16 32 64 128 256 512]
  169.18 +	 (take 10 (powers-of-2)))))
  169.19 +
  169.20 +(deftest test-primes
  169.21 +  (is (= [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 
  169.22 +	  103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 
  169.23 +	  199 211 223 227 229]
  169.24 +	 (take 50 primes))))
   170.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   170.2 +++ b/src/clojure/contrib/test_contrib/test_load_all.clj	Sat Aug 21 06:25:44 2010 -0400
   170.3 @@ -0,0 +1,53 @@
   170.4 +;;; test_load_all.clj - loads all contrib libraries for testing purposes
   170.5 +
   170.6 +;; by Stuart Halloway, http://blog.thinkrelevance.com
   170.7 +
   170.8 +;; Copyright (c) Stuart Halloway, 2009. All rights reserved.  The use
   170.9 +;; and distribution terms for this software are covered by the Eclipse
  170.10 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  170.11 +;; which can be found in the file epl-v10.html at the root of this
  170.12 +;; distribution.  By using this software in any fashion, you are
  170.13 +;; agreeing to be bound by the terms of this license.  You must not
  170.14 +;; remove this notice, or any other, from this software.
  170.15 +
  170.16 +;; This is only intended to check that the libraries will load without
  170.17 +;; errors, not that they work correctly.
  170.18 +
  170.19 +;; The code includes several design choices I don't love, but find
  170.20 +;; tolerable in a test-only lib:
  170.21 +;; 
  170.22 +;;   * namespaces that blow up to document deprecation
  170.23 +;;   * using directory paths to find contrib
  170.24 +;;   * using a macro to reflectively write tests
  170.25 +;;
  170.26 +;; I *am* happy that code that won't even load now breaks the build.
  170.27 +
  170.28 +(ns clojure.contrib.test-load-all
  170.29 +  (:use clojure.test clojure.contrib.find-namespaces))
  170.30 +
  170.31 +(def deprecated-contrib-namespaces
  170.32 +  '[clojure.contrib.javadoc])
  170.33 +
  170.34 +(defn loadable-contrib-namespaces
  170.35 +  "Contrib namespaces that can be loaded (everything except
  170.36 +   deprecated nses that throw on load.)"
  170.37 +  []
  170.38 +  (apply disj
  170.39 +         (into #{} (find-namespaces-in-dir (java.io.File. "src/main")))
  170.40 +         deprecated-contrib-namespaces))
  170.41 +
  170.42 +(defn emit-test-load
  170.43 +  []
  170.44 +  `(do
  170.45 +     ~@(map
  170.46 +        (fn [ns]
  170.47 +          `(deftest ~(symbol (str "test-loading-" (.replace (str ns) "." "-")))
  170.48 +             (require :reload '~ns)))
  170.49 +        (loadable-contrib-namespaces))))
  170.50 +
  170.51 +(defmacro test-load
  170.52 +  []
  170.53 +  (emit-test-load))
  170.54 +
  170.55 +(test-load)
  170.56 +
   171.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   171.2 +++ b/src/clojure/contrib/test_contrib/test_macro_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   171.3 @@ -0,0 +1,67 @@
   171.4 +;; Test routines for macro_utils.clj
   171.5 +
   171.6 +;; by Konrad Hinsen
   171.7 +;; last updated May 6, 2009
   171.8 +
   171.9 +;; Copyright (c) Konrad Hinsen, 2008. All rights reserved.  The use
  171.10 +;; and distribution terms for this software are covered by the Eclipse
  171.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  171.12 +;; which can be found in the file epl-v10.html at the root of this
  171.13 +;; distribution.  By using this software in any fashion, you are
  171.14 +;; agreeing to be bound by the terms of this license.  You must not
  171.15 +;; remove this notice, or any other, from this software.
  171.16 +
  171.17 +(ns clojure.contrib.test-macro-utils
  171.18 +  (:use [clojure.test :only (deftest is are run-tests use-fixtures)]
  171.19 +	[clojure.contrib.macro-utils
  171.20 +	 :only (macrolet symbol-macrolet defsymbolmacro with-symbol-macros
  171.21 +		mexpand-1 mexpand mexpand-all)]
  171.22 +	[clojure.contrib.monads
  171.23 +	 :only (with-monad domonad)]))
  171.24 +
  171.25 +(use-fixtures :each
  171.26 +  (fn [f] (binding [*ns* (the-ns 'clojure.contrib.test-macro-utils)]
  171.27 +	    (f))))
  171.28 +
  171.29 +(deftest macrolet-test
  171.30 +  (is (= (macroexpand-1
  171.31 +	   '(macrolet [(foo [form] `(~form ~form))]  (foo x)))
  171.32 +	 '(do (x x)))))
  171.33 +
  171.34 +(deftest symbol-macrolet-test
  171.35 +  (is (= (macroexpand-1
  171.36 +	   '(symbol-macrolet [x xx y yy]
  171.37 +              (exp [a y] (x y))))
  171.38 +	 '(do (exp [a yy] (xx yy)))))
  171.39 +  (is (= (macroexpand-1
  171.40 +	   '(symbol-macrolet [def foo]
  171.41 +              (def def def)))
  171.42 +	 '(do (def def foo))))
  171.43 +  (is (= (macroexpand-1
  171.44 +	   '(symbol-macrolet [x foo z bar]
  171.45 +	      (let [a x b y x b] [a b x z])))
  171.46 +	 '(do (let* [a foo b y x b] [a b x bar]))))
  171.47 +  (is (= (macroexpand-1
  171.48 +	   '(symbol-macrolet [x foo z bar]
  171.49 +	      (fn ([x y] [x y z]) ([x y z] [x y z]))))
  171.50 +	 '(do (fn* ([x y] [x y bar]) ([x y z] [x y z])))))
  171.51 +  (is (= (macroexpand-1
  171.52 +	   '(symbol-macrolet [x foo z bar]
  171.53 +	      (fn f ([x y] [x y z]) ([x y z] [x y z]))))
  171.54 +	 '(do (fn* f ([x y] [x y bar]) ([x y z] [x y z])))))
  171.55 +  (is (= (nth (second (macroexpand-1
  171.56 +		       '(symbol-macrolet [x xx y yy z zz]
  171.57 +			  (domonad m [a x b y x z] [a b x z])))) 2)
  171.58 +	 '(do (m-bind xx (fn* ([a]
  171.59 +	      (m-bind yy (fn* ([b]
  171.60 +	      (m-bind zz (fn* ([x]
  171.61 +	      (m-result [a b x zz]))))))))))))))
  171.62 +
  171.63 +(deftest symbol-test
  171.64 +  (defsymbolmacro sum-2-3 (plus 2 3))
  171.65 +  (is (= (macroexpand '(with-symbol-macros (+ 1 sum-2-3)))
  171.66 +	 '(do (+ 1 (plus 2 3)))))
  171.67 +  (is (= (macroexpand '(macrolet [(plus [a b] `(+ ~a ~b))] (+ 1 sum-2-3)))
  171.68 +	 '(do (+ 1 (clojure.core/+ 2 3)))))
  171.69 +  (ns-unmap *ns* 'sum-2-3))
  171.70 +
   172.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   172.2 +++ b/src/clojure/contrib/test_contrib/test_math.clj	Sat Aug 21 06:25:44 2010 -0400
   172.3 @@ -0,0 +1,118 @@
   172.4 +(ns clojure.contrib.test-math
   172.5 +  (:use clojure.test
   172.6 +	clojure.contrib.math))
   172.7 +
   172.8 +(deftest test-expt
   172.9 +  (are [x y] (= x y)
  172.10 +      (expt 2 3) 8
  172.11 +      (expt (expt 2 16) 2) (expt 2 32)
  172.12 +      (expt 4/3 2) 16/9
  172.13 +      (expt 2 -10) 1/1024
  172.14 +      (expt 0.5M 2) 0.25M
  172.15 +      (expt 5 4.2) (Math/pow 5 4.2)
  172.16 +      (expt 5.3 4) (Math/pow 5.3 4)))
  172.17 +
  172.18 +(deftest test-abs
  172.19 +  (are [x y] (= x y)
  172.20 +      (abs -2) 2
  172.21 +      (abs 0) 0
  172.22 +      (abs 5) 5
  172.23 +      (abs 123456789123456789) 123456789123456789
  172.24 +      (abs -123456789123456789) 123456789123456789
  172.25 +      (abs 5/3) 5/3
  172.26 +      (abs -4/3) 4/3
  172.27 +      (abs 4.3M) 4.3M
  172.28 +      (abs -4.3M) 4.3M
  172.29 +      (abs 2.8) 2.8
  172.30 +      (abs -2.8) 2.8))
  172.31 +
  172.32 +(deftest test-gcd
  172.33 +  (are [x y] (= x y)
  172.34 +      (gcd 4 3) 1
  172.35 +      (gcd 24 12) 12
  172.36 +      (gcd 24 27) 3
  172.37 +      (gcd 1 0) 1
  172.38 +      (gcd 0 1) 1
  172.39 +      (gcd 0 0) 0)
  172.40 +  (is (thrown? IllegalArgumentException (gcd nil 0)))
  172.41 +  (is (thrown? IllegalArgumentException (gcd 0 nil)))
  172.42 +  (is (thrown? IllegalArgumentException (gcd 7.0 0))))
  172.43 +
  172.44 +(deftest test-lcm
  172.45 +  (are [x y] (= x y)
  172.46 +       (lcm 2 3) 6
  172.47 +       (lcm 3 2) 6
  172.48 +       (lcm -2 3) 6
  172.49 +       (lcm 2 -3) 6
  172.50 +       (lcm -2 -3) 6
  172.51 +       (lcm 4 10) 20
  172.52 +       (lcm 1 0) 0
  172.53 +       (lcm 0 1) 0
  172.54 +       (lcm 0 0))
  172.55 +  (is (thrown? IllegalArgumentException (lcm nil 0)))
  172.56 +  (is (thrown? IllegalArgumentException (lcm 0 nil)))
  172.57 +  (is (thrown? IllegalArgumentException (lcm 7.0 0))))
  172.58 +
  172.59 +(deftest test-floor
  172.60 +  (are [x y] (== x y)
  172.61 +      (floor 6) 6
  172.62 +      (floor -6) -6
  172.63 +      (floor 123456789123456789) 123456789123456789
  172.64 +      (floor -123456789123456789) -123456789123456789
  172.65 +      (floor 4/3) 1
  172.66 +      (floor -4/3) -2
  172.67 +      (floor 4.3M) 4
  172.68 +      (floor -4.3M) -5
  172.69 +      (floor 4.3) 4.0
  172.70 +      (floor -4.3) -5.0))
  172.71 +
  172.72 +(deftest test-ceil
  172.73 +  (are [x y] (== x y)
  172.74 +      (ceil 6) 6
  172.75 +      (ceil -6) -6
  172.76 +      (ceil 123456789123456789) 123456789123456789
  172.77 +      (ceil -123456789123456789) -123456789123456789
  172.78 +      (ceil 4/3) 2
  172.79 +      (ceil -4/3) -1
  172.80 +      (ceil 4.3M) 5
  172.81 +      (ceil -4.3M) -4
  172.82 +      (ceil 4.3) 5.0
  172.83 +      (ceil -4.3) -4.0))
  172.84 +
  172.85 +(deftest test-round
  172.86 +  (are [x y] (== x y)
  172.87 +      (round 6) 6
  172.88 +      (round -6) -6
  172.89 +      (round 123456789123456789) 123456789123456789
  172.90 +      (round -123456789123456789) -123456789123456789
  172.91 +      (round 4/3) 1
  172.92 +      (round 5/3) 2
  172.93 +      (round 5/2) 3
  172.94 +      (round -4/3) -1
  172.95 +      (round -5/3) -2
  172.96 +      (round -5/2) -2
  172.97 +      (round 4.3M) 4
  172.98 +      (round 4.7M) 5
  172.99 +      (round -4.3M) -4
 172.100 +      (round -4.7M) -5
 172.101 +      (round 4.5M) 5
 172.102 +      (round -4.5M) -4
 172.103 +      (round 4.3) 4
 172.104 +      (round 4.7) 5
 172.105 +      (round -4.3) -4
 172.106 +      (round -4.7) -5
 172.107 +      (round 4.5) 5
 172.108 +      (round -4.5) -4))
 172.109 +
 172.110 +(deftest test-sqrt
 172.111 +  (are [x y] (= x y)
 172.112 +      (sqrt 9) 3
 172.113 +      (sqrt 16/9) 4/3
 172.114 +      (sqrt 0.25M) 0.5M
 172.115 +      (sqrt 2) (Math/sqrt 2)))
 172.116 +
 172.117 +(deftest test-exact-integer-sqrt
 172.118 +  (are [x y] (= x y)
 172.119 +   (exact-integer-sqrt 15) [3 6]
 172.120 +   (exact-integer-sqrt (inc (expt 2 32))) [(expt 2 16) 1]
 172.121 +   (exact-integer-sqrt 1000000000000) [1000000 0]))
   173.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   173.2 +++ b/src/clojure/contrib/test_contrib/test_miglayout.clj	Sat Aug 21 06:25:44 2010 -0400
   173.3 @@ -0,0 +1,145 @@
   173.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   173.5 +;;  distribution terms for this software are covered by the Eclipse Public
   173.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   173.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   173.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   173.9 +;;  terms of this license.  You must not remove this notice, or any other,
  173.10 +;;  from this software.
  173.11 +;;
  173.12 +;;  clojure.contrib.miglayout.test
  173.13 +;;
  173.14 +;;  Test/example for clojure.contrib.miglayout
  173.15 +;;
  173.16 +;;  scgilardi (gmail)
  173.17 +;;  Created 5 October 2008
  173.18 +
  173.19 +(ns clojure.contrib.test-miglayout
  173.20 +  (:import (javax.swing JButton JFrame JLabel JList JPanel
  173.21 +                        JScrollPane JTabbedPane JTextField JSeparator))
  173.22 +  (:use clojure.contrib.miglayout))
  173.23 +
  173.24 +(def tests)
  173.25 +
  173.26 +(defn run-test
  173.27 +  [index]
  173.28 +  (let [panel ((tests index) (JPanel.))]
  173.29 +    (println index (components panel))
  173.30 +    (doto (JFrame. (format "MigLayout Test %d" index))
  173.31 +      (.add panel)
  173.32 +      (.pack)
  173.33 +      (.setVisible true))))
  173.34 +
  173.35 +(defn label
  173.36 +  "Returns a swing label"
  173.37 +  [text]
  173.38 +  (JLabel. text))
  173.39 +
  173.40 +(defn text-field
  173.41 +  "Returns a swing text field"
  173.42 +  ([] (text-field 10))
  173.43 +  ([width]
  173.44 +     (JTextField. width)))
  173.45 +
  173.46 +(defn sep
  173.47 +  "Returns a swing separator"
  173.48 +  []
  173.49 +  (JSeparator.))
  173.50 +
  173.51 +(def tests [
  173.52 +
  173.53 +  (fn test0
  173.54 +    [panel]
  173.55 +    (miglayout panel
  173.56 +      (label "Hello")
  173.57 +      (label "World") {:gap :unrelated}
  173.58 +      (text-field) :wrap
  173.59 +      (label "Bonus!")
  173.60 +      (JButton. "Bang it") {:wmin :button :grow :x :span 2} :center))
  173.61 +
  173.62 +  ;; test1 and test2 are based on code from
  173.63 +  ;; http://www.devx.com/java/Article/38017/1954
  173.64 +
  173.65 +  ;; constraints as strings exclusively
  173.66 +  (fn test1
  173.67 +    [panel]
  173.68 +    (miglayout panel
  173.69 +      :column             "[right]"
  173.70 +      (label "General")   "split, span"
  173.71 +      (sep)               "growx, wrap"
  173.72 +      (label "Company")   "gap 10"
  173.73 +      (text-field "")     "span, growx"
  173.74 +      (label "Contact")   "gap 10"
  173.75 +      (text-field "")     "span, growx, wrap"
  173.76 +      (label "Propeller") "split, span, gaptop 10"
  173.77 +      (sep)               "growx, wrap, gaptop 10"
  173.78 +      (label "PTI/kW")    "gapx 10, gapy 15"
  173.79 +      (text-field)
  173.80 +      (label "Power/kW")  "gap 10"
  173.81 +      (text-field)        "wrap"
  173.82 +      (label "R/mm")      "gap 10"
  173.83 +      (text-field)
  173.84 +      (label "D/mm")      "gap 10"
  173.85 +      (text-field)))
  173.86 +
  173.87 +  ;; the same constraints as strings, keywords, vectors, and maps
  173.88 +  (fn test2
  173.89 +    [panel]
  173.90 +    (miglayout panel
  173.91 +      :column             "[right]"
  173.92 +      (label "General")   "split, span"
  173.93 +      (sep)               :growx :wrap
  173.94 +      (label "Company")   [:gap 10]
  173.95 +      (text-field "")     :span :growx
  173.96 +      (label "Contact")   [:gap 10]
  173.97 +      (text-field "")     :span :growx :wrap
  173.98 +      (label "Propeller") :split :span [:gaptop 10]
  173.99 +      (sep)               :growx :wrap [:gaptop 10]
 173.100 +      (label "PTI/kW")    {:gapx 10 :gapy 15}
 173.101 +      (text-field)
 173.102 +      (label "Power/kW")  [:gap 10]
 173.103 +      (text-field)        :wrap
 173.104 +      (label "R/mm")      [:gap 10]
 173.105 +      (text-field)
 173.106 +      (label "D/mm")      [:gap 10]
 173.107 +      (text-field)))
 173.108 +
 173.109 +  ;; the same constraints using symbols to name groups of constraints
 173.110 +  (fn test3
 173.111 +    [panel]
 173.112 +    (let [g [:gap 10]
 173.113 +          gt [:gaptop 10]
 173.114 +          gxs #{:growx :span}
 173.115 +          gxw #{:growx :wrap}
 173.116 +          gxy {:gapx 10 :gapy 15}
 173.117 +          right "[right]"
 173.118 +          ss #{:split :span}
 173.119 +          w :wrap]
 173.120 +      (miglayout panel
 173.121 +        :column             right
 173.122 +        (label "General")   ss
 173.123 +        (sep)               gxw
 173.124 +        (label "Company")   g
 173.125 +        (text-field "")     gxs
 173.126 +        (label "Contact")   g
 173.127 +        (text-field "")     gxs
 173.128 +        (label "Propeller") ss gt
 173.129 +        (sep)               gxw g
 173.130 +        (label "PTI/kW")    gxy
 173.131 +        (text-field)
 173.132 +        (label "Power/kW")  g
 173.133 +        (text-field)        w
 173.134 +        (label "R/mm")      g
 173.135 +        (text-field)
 173.136 +        (label "D/mm")      g
 173.137 +        (text-field))))
 173.138 +
 173.139 +  (fn test4
 173.140 +    [panel]
 173.141 +    (miglayout panel
 173.142 +      (label "First Name") 
 173.143 +      (text-field)        {:id :firstname}
 173.144 +      (label "Surname")   [:gap :unrelated]
 173.145 +      (text-field)        {:id :surname} :wrap
 173.146 +      (label "Address")
 173.147 +      (text-field)        {:id :address} :span :grow))
 173.148 +])
   174.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   174.2 +++ b/src/clojure/contrib/test_contrib/test_mock.clj	Sat Aug 21 06:25:44 2010 -0400
   174.3 @@ -0,0 +1,131 @@
   174.4 +(ns clojure.contrib.test-mock
   174.5 + (:use clojure.test)
   174.6 + (:require [clojure.contrib.mock :as mock]))
   174.7 +
   174.8 +; Used as dummy dependency functions
   174.9 +(defn fn1 {:dynamic true} [x] :ignore)
  174.10 +(defn fn2 {:dynamic true} [x y] :ignore)
  174.11 +(defn fn3 {:dynamic true} ([x] :ignore)
  174.12 +  ([x y z] :ignore))
  174.13 +(defn fn4 {:dynamic true} [x y & r] :ignore)
  174.14 +
  174.15 +;functions created using fn directly lack the argslist meta data
  174.16 +(def #^{:dynamic true} deffed-differently (fn [x] :ignore))
  174.17 +
  174.18 +(defmacro assert-called [fn-name called? & body]
  174.19 +  `(let [called-status?# (atom false)]
  174.20 +     (binding [~fn-name (fn [& args#] (reset! called-status?# true))] ~@body)
  174.21 +     (is (= ~called? @called-status?#))))
  174.22 +
  174.23 +(deftest test-convenience
  174.24 +  (testing "once"
  174.25 +    (is (false? (mock/once 0)))
  174.26 +    (is (false? (mock/once 123)))
  174.27 +    (is (true? (mock/once 1))))
  174.28 +
  174.29 +  (testing "never"
  174.30 +    (is (false? (mock/never 4)))
  174.31 +    (is (true? (mock/never 0))))
  174.32 +
  174.33 +  (testing "more-than"
  174.34 +    (is (false? ((mock/more-than 5) 3)))
  174.35 +    (is (true? ((mock/more-than 5) 9))))
  174.36 +
  174.37 +  (testing "less-than"
  174.38 +    (is (true? ((mock/less-than 5) 3)))
  174.39 +    (is (false? ((mock/less-than 5) 9))))
  174.40 +
  174.41 +  (testing "between"
  174.42 +    (is (true? ((mock/between 5 8) 6)))
  174.43 +    (is (false? ((mock/between 5 8) 5)))))
  174.44 +
  174.45 +
  174.46 +(deftest test-returns
  174.47 +  (is (= {:returns 5} (mock/returns 5)))
  174.48 +  (is (= {:other-key "test" :returns nil} (mock/returns nil {:other-key "test"}))))
  174.49 +
  174.50 +
  174.51 +(deftest test-has-args
  174.52 +  (let [ex (:has-args (mock/has-args [1]))]
  174.53 +    (is (fn? ex))
  174.54 +    (is (ex 'fn1 1))
  174.55 +    (is (ex 'fn1 1 5 6))
  174.56 +    (assert-called mock/unexpected-args true (ex 'fn1 5)))
  174.57 +  (is (contains? (mock/has-args [] {:pre-existing-key "test"}) :pre-existing-key))
  174.58 +  (is (true? (((mock/has-args [5]) :has-args)'fn1 5))))
  174.59 +
  174.60 +
  174.61 +(deftest test-has-matching-signature
  174.62 +  (assert-called mock/no-matching-function-signature true
  174.63 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/fn2 [1]))
  174.64 +  (assert-called mock/no-matching-function-signature true
  174.65 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3]))
  174.66 +  (assert-called mock/no-matching-function-signature false
  174.67 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3 5]))
  174.68 +  (assert-called mock/no-matching-function-signature false
  174.69 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3 5 7 9]))
  174.70 +  (assert-called mock/no-matching-function-signature false
  174.71 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3]))
  174.72 +  (assert-called mock/no-matching-function-signature true
  174.73 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1]))
  174.74 +  (assert-called mock/no-matching-function-signature false
  174.75 +    (mock/has-matching-signature? 'clojure.contrib.test-mock/deffed-differently [1])))
  174.76 +
  174.77 +
  174.78 +(deftest test-times
  174.79 +  (is (fn? ((mock/times #(= 1 %)) :times)))
  174.80 +  (is (contains? (mock/times #(= 1 %) {:existing-key "test"}) :existing-key)))
  174.81 +
  174.82 +(deftest test-make-mock
  174.83 +  (testing "invalid arguments"
  174.84 +    (is (thrown? IllegalArgumentException (mock/make-mock [5]))))
  174.85 +
  174.86 +  (testing "valid counter and unevaluated returns"
  174.87 +    (let [[mock counter count-checker] (mock/make-mock 'fn1 (mock/returns 5 (mock/times 1)))]
  174.88 +      (is (fn? mock))
  174.89 +      (is (= 0 @counter))
  174.90 +      (is (= 5 (mock :ignore-me)))
  174.91 +      (is (= 1 @counter))))
  174.92 +
  174.93 +  (testing "returns as expected"
  174.94 +    (let [[mock] (mock/make-mock 'fn1 (mock/returns 5))]
  174.95 +      (is (= 5 (mock :ignore))))
  174.96 +    (let [[mock] (mock/make-mock 'fn1 (mock/returns #(* 2 %)))]
  174.97 +      (is (= 10 ((mock :ignore) 5)) ":returns a function should not automatically
  174.98 +                                     evaluate it.")))
  174.99 +
 174.100 +  (testing "calls replacement-fn and returns the result"
 174.101 +    (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 3 %)))]
 174.102 +      (is (= 15 (mock 5))))
 174.103 +    (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 2 %) (mock/returns 3)))]
 174.104 +      (is (= 10 (mock 5)))))
 174.105 +
 174.106 +  (testing "argument validation"
 174.107 +    (let [[mock] (mock/make-mock 'fn1 (mock/has-args [#(= 5 %)]))]
 174.108 +      (assert-called mock/unexpected-args true (mock "test"))
 174.109 +      (is (nil? (mock 5))))))
 174.110 +
 174.111 +
 174.112 +(deftest test-make-count-checker
 174.113 +  (let [checker (mock/make-count-checker 5 5)]
 174.114 +    (assert-called mock/incorrect-invocation-count false (checker 'fn1 5))
 174.115 +    (assert-called mock/incorrect-invocation-count true (checker 'fn1 3))))
 174.116 +
 174.117 +
 174.118 +(deftest test-validate-counts
 174.119 +  (assert-called mock/incorrect-invocation-count false
 174.120 +    (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker #(< % 6) '#(< % 6)) 'fn1])))
 174.121 +  (assert-called mock/incorrect-invocation-count true
 174.122 +    (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker 4 4) 'fn1]))))
 174.123 +
 174.124 +
 174.125 +(deftest test-expect-macro
 174.126 +  (let [under-test (fn [x] (fn1 x))]
 174.127 +    (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 3 %)]))]
 174.128 +                 (under-test 3))))
 174.129 +    (assert-called mock/unexpected-args true (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 4 %)]))]
 174.130 +                             (under-test 3))))
 174.131 +  (let [under-test (fn [] (fn2 (fn1 1) 3))]
 174.132 +    (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 1 %)] (mock/returns 2)))
 174.133 +                        fn2 (mock/times 1 (mock/has-args [#(= 2 %) #(= 3 %)] (mock/returns 5)))]
 174.134 +                 (under-test))))))
 174.135 \ No newline at end of file
   175.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   175.2 +++ b/src/clojure/contrib/test_contrib/test_monads.clj	Sat Aug 21 06:25:44 2010 -0400
   175.3 @@ -0,0 +1,78 @@
   175.4 +;; Test routines for monads.clj
   175.5 +
   175.6 +;; by Konrad Hinsen
   175.7 +;; last updated March 28, 2009
   175.8 +
   175.9 +;; Copyright (c) Konrad Hinsen, 2008. All rights reserved.  The use
  175.10 +;; and distribution terms for this software are covered by the Eclipse
  175.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  175.12 +;; which can be found in the file epl-v10.html at the root of this
  175.13 +;; distribution.  By using this software in any fashion, you are
  175.14 +;; agreeing to be bound by the terms of this license.  You must not
  175.15 +;; remove this notice, or any other, from this software.
  175.16 +
  175.17 +(ns clojure.contrib.test-monads
  175.18 +  (:use [clojure.test :only (deftest is are run-tests)]
  175.19 +	[clojure.contrib.monads
  175.20 +	 :only (with-monad domonad m-lift m-seq m-chain
  175.21 +		sequence-m maybe-m state-m maybe-t sequence-t)]))
  175.22 +
  175.23 +(deftest sequence-monad
  175.24 +  (with-monad sequence-m
  175.25 +    (are [a b] (= a b)
  175.26 +      (domonad [x (range 3) y (range 2)] (+ x y))
  175.27 +        '(0 1 1 2 2 3)
  175.28 +      (domonad [x (range 5) y (range (+ 1 x)) :when  (= (+ x y) 2)] (list x y))
  175.29 +        '((1 1) (2 0))
  175.30 +      ((m-lift 2 #(list %1 %2)) (range 3) (range 2))
  175.31 +        '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1))
  175.32 +      (m-seq (replicate 3 (range 2)))
  175.33 +        '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
  175.34 +      ((m-chain (replicate 3 range)) 5)
  175.35 +        '(0 0 0 1 0 0 1 0 1 2)
  175.36 +      (m-plus (range 3) (range 2))
  175.37 +        '(0 1 2 0 1))))
  175.38 +
  175.39 +(deftest maybe-monad
  175.40 +  (with-monad maybe-m
  175.41 +    (let [m+ (m-lift 2 +)
  175.42 +          mdiv (fn [x y] (domonad [a x  b y  :when (not (zero? b))] (/ a b)))]
  175.43 +      (are [a b] (= a b)
  175.44 +        (m+ (m-result 1) (m-result 3))
  175.45 +	  (m-result 4)
  175.46 +        (mdiv (m-result 1) (m-result 3))
  175.47 +	  (m-result (/ 1 3))
  175.48 +        (m+ 1 (mdiv (m-result 1) (m-result 0)))
  175.49 +	  m-zero
  175.50 +	(m-plus m-zero (m-result 1) m-zero (m-result 2))
  175.51 +	  (m-result 1)))))
  175.52 +
  175.53 +(deftest seq-maybe-monad
  175.54 +  (with-monad (maybe-t sequence-m)
  175.55 +    (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))]
  175.56 +      (are [a b] (= a b)
  175.57 +        ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n)))
  175.58 +          '(nil 2 nil 4 nil 6 nil 8 nil 10)
  175.59 +        (pairs (for [n (range 5)] (when (odd? n) n)))
  175.60 +          '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil)))))
  175.61 +
  175.62 +(deftest state-maybe-monad
  175.63 +  (with-monad (maybe-t state-m)
  175.64 +    (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4]
  175.65 +				 [nil nil 3 4] [1 2 nil nil])]
  175.66 +	     (let [f (domonad
  175.67 +		       [x (m-plus (m-result a) (m-result b))
  175.68 +			y (m-plus (m-result c) (m-result d))]
  175.69 +		       (+ x y))]
  175.70 +	       (f :state)))
  175.71 +	   (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state])))))
  175.72 +
  175.73 +(deftest state-seq-monad
  175.74 +  (with-monad (sequence-t state-m)
  175.75 +    (is (= (let [[a b c d] [1 2 10 20]
  175.76 +		 f (domonad
  175.77 +		     [x (m-plus (m-result a) (m-result b))
  175.78 +		      y (m-plus (m-result c) (m-result d))]
  175.79 +		     (+ x y))]
  175.80 +	     (f :state)))
  175.81 +	(list [(list 11 21 12 22) :state]))))
   176.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   176.2 +++ b/src/clojure/contrib/test_contrib/test_profile.clj	Sat Aug 21 06:25:44 2010 -0400
   176.3 @@ -0,0 +1,8 @@
   176.4 +(ns clojure.contrib.test-profile
   176.5 +  (:use clojure.test
   176.6 +	clojure.contrib.profile))
   176.7 +
   176.8 +(deftest test-print-summary
   176.9 +  (testing "doesn't blow up with no data (assembla #31)"
  176.10 +    (is (= "Name      mean       min       max     count       sum\n"
  176.11 +           (with-out-str (print-summary {}))))))
   177.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   177.2 +++ b/src/clojure/contrib/test_contrib/test_properties.clj	Sat Aug 21 06:25:44 2010 -0400
   177.3 @@ -0,0 +1,63 @@
   177.4 +(ns clojure.contrib.test-properties
   177.5 +  (:refer-clojure :exclude (spit))
   177.6 +  (:use clojure.test clojure.contrib.properties
   177.7 +        [clojure.contrib.io :only (spit)])
   177.8 +  (:import (java.util Properties)
   177.9 +           (java.io File)))
  177.10 +
  177.11 +(deftest test-get-system-property
  177.12 +  (testing "works the same with keywords, symbols, and strings"
  177.13 +    (is (= (get-system-property "java.home") (get-system-property 'java.home)))
  177.14 +    (is (= (get-system-property "java.home") (get-system-property :java.home))))
  177.15 +  (testing "treats second arg as default"
  177.16 +    (is (= "default" (get-system-property "testing.test-system-property" "default"))))
  177.17 +  (testing "returns nil for missing properties"
  177.18 +    (is (nil? (get-system-property "testing.test-system-property")))))
  177.19 +
  177.20 +(deftest test-set-system-properties 
  177.21 +  (testing "set and then unset a property using keywords"
  177.22 +           (let [propname :clojure.contrib.java.test-set-system-properties]
  177.23 +             (is (nil? (get-system-property propname)))
  177.24 +             (set-system-properties {propname :foo})
  177.25 +             (is (= "foo") (get-system-property propname))
  177.26 +             (set-system-properties {propname nil})
  177.27 +             (is (nil? (get-system-property propname))))))
  177.28 +
  177.29 +(deftest test-with-system-properties
  177.30 +  (let [propname :clojure.contrib.java.test-with-system-properties]
  177.31 +    (testing "sets a property only for the duration of a block"
  177.32 +      (is (= "foo" 
  177.33 +	     (with-system-properties {propname "foo"}
  177.34 +	       (get-system-property propname))))
  177.35 +      (is (nil? (get-system-property propname)))))
  177.36 +  (testing "leaves other properties alone"
  177.37 +    ; TODO: write this test better, using a properties -> map function
  177.38 +    (let [propname :clojure.contrib.java.test-with-system-properties
  177.39 +          propcount (count (System/getProperties))]
  177.40 +      (with-system-properties {propname "foo"}
  177.41 +        (is (= (inc propcount) (count (System/getProperties)))))
  177.42 +      (is (= propcount (count (System/getProperties)))))))
  177.43 +
  177.44 +(deftest test-as-properties
  177.45 +  (let [expected (doto (Properties.)
  177.46 +		   (.setProperty "a" "b")
  177.47 +		   (.setProperty "c" "d"))]
  177.48 +    (testing "with a map"
  177.49 +      (is (= expected
  177.50 +	     (as-properties {:a "b" :c "d"}))))
  177.51 +    (testing "with a sequence of pairs"
  177.52 +      (is (= expected
  177.53 +	     (as-properties [[:a :b] [:c :d]]))))))
  177.54 +
  177.55 +(deftest test-read-properties
  177.56 +  (let [f (File/createTempFile "test" "properties")]
  177.57 +    (spit f "a=b\nc=d")
  177.58 +    (is (= {"a" "b" "c" "d"}
  177.59 +	   (read-properties f)))))
  177.60 +	   
  177.61 +(deftest test-write-properties
  177.62 +  (let [f (File/createTempFile "test" "properties")]
  177.63 +    (write-properties [['a 'b] ['c 'd]] f)
  177.64 +    (is (= {"a" "b" "c" "d"}
  177.65 +	   (read-properties f)))))
  177.66 +	   
   178.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   178.2 +++ b/src/clojure/contrib/test_contrib/test_prxml.clj	Sat Aug 21 06:25:44 2010 -0400
   178.3 @@ -0,0 +1,10 @@
   178.4 +(ns clojure.contrib.test-prxml
   178.5 +  (:use clojure.test clojure.contrib.prxml))
   178.6 +
   178.7 +(deftest prxml-basic
   178.8 +  (is (= "<p>Hello, World!</p>"
   178.9 +         (with-out-str (prxml [:p "Hello, World!"])))))
  178.10 +
  178.11 +(deftest prxml-escaping
  178.12 +  (is (= "<a href=\"foo&amp;bar\">foo&lt;bar</a>"
  178.13 +         (with-out-str (prxml [:a {:href "foo&bar"} "foo<bar"])))))
   179.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   179.2 +++ b/src/clojure/contrib/test_contrib/test_repl_utils.clj	Sat Aug 21 06:25:44 2010 -0400
   179.3 @@ -0,0 +1,20 @@
   179.4 +(ns clojure.contrib.test-repl-utils
   179.5 +  (:use clojure.test
   179.6 +	clojure.contrib.repl-utils))
   179.7 +
   179.8 +(deftest test-apropos
   179.9 +  (testing "with a regular expression"
  179.10 +    (is (= '[defmacro] (apropos #"^defmacro$")))
  179.11 +    (is (some '#{defmacro} (apropos #"def.acr.")))
  179.12 +    (is (= [] (apropos #"nothing-has-this-name"))))
  179.13 +  
  179.14 +
  179.15 +  (testing "with a string"
  179.16 +    (is (some '#{defmacro} (apropos "defmacro")))
  179.17 +    (is (some '#{defmacro} (apropos "efmac")))
  179.18 +    (is (= [] (apropos "nothing-has-this-name"))))
  179.19 +
  179.20 +  (testing "with a symbol"
  179.21 +    (is (some '#{defmacro} (apropos 'defmacro)))
  179.22 +    (is (some '#{defmacro} (apropos 'efmac)))
  179.23 +    (is (= [] (apropos 'nothing-has-this-name)))))
   180.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   180.2 +++ b/src/clojure/contrib/test_contrib/test_seq.clj	Sat Aug 21 06:25:44 2010 -0400
   180.3 @@ -0,0 +1,128 @@
   180.4 +(ns clojure.contrib.test-seq
   180.5 +  (:use clojure.test)
   180.6 +  (:require [clojure.contrib.seq :as seq]))
   180.7 +
   180.8 +
   180.9 +(deftest test-positions
  180.10 +  (are [expected pred coll] (= expected (seq/positions pred coll))
  180.11 +       [2] string? [:a :b "c"]
  180.12 +       () :d [:a :b :c]
  180.13 +       [0 2] #{:d} [:d :a :d :a]))
  180.14 +
  180.15 +;Upon further inspection, flatten behaves... wierd.
  180.16 +;These tests are what passes on August 7, 2009
  180.17 +(deftest test-flatten-present
  180.18 +  (are [expected nested-val] (= (seq/flatten nested-val) expected)
  180.19 +       ;simple literals
  180.20 +       [] nil
  180.21 +       [] 1
  180.22 +       [] 'test
  180.23 +       [] :keyword
  180.24 +       [] 1/2
  180.25 +       [] #"[\r\n]"
  180.26 +       [] true
  180.27 +       [] false
  180.28 +       ;vectors
  180.29 +       [1 2 3 4 5] [[1 2] [3 4 [5]]]
  180.30 +       [1 2 3 4 5] [1 2 3 4 5]
  180.31 +       [#{1 2} 3 4 5] [#{1 2} 3 4 5]
  180.32 +       ;sets
  180.33 +       [] #{}
  180.34 +       [] #{#{1 2} 3 4 5}
  180.35 +       [] #{1 2 3 4 5}
  180.36 +       [] #{#{1 2} 3 4 5}
  180.37 +       ;lists
  180.38 +       [] '()
  180.39 +       [1 2 3 4 5] `(1 2 3 4 5)
  180.40 +       ;maps
  180.41 +       [] {:a 1 :b 2}
  180.42 +       [:a 1 :b 2] (seq {:a 1 :b 2})
  180.43 +       [] {[:a :b] 1 :c 2}
  180.44 +       [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2})
  180.45 +       [:a 1 2 :b 3] (seq {:a [1 2] :b 3})
  180.46 +       ;Strings
  180.47 +       [] "12345"
  180.48 +       [\1 \2 \3 \4 \5] (seq "12345")
  180.49 +       ;fns
  180.50 +       [] count
  180.51 +       [count even? odd?] [count even? odd?]))
  180.52 +
  180.53 +(deftest test-separate
  180.54 +  (are [test-seq] (= (seq/separate even? test-seq) [[2 4] [1 3 5]])
  180.55 +       [1 2 3 4 5]
  180.56 +       #{1 2 3 4 5}
  180.57 +       '(1 2 3 4 5)))
  180.58 +
  180.59 +;Note - this does not make sense for maps and sets, because order is expected
  180.60 +(deftest test-indexed
  180.61 +  (are [expected test-seq] (= (seq/indexed test-seq) expected)
  180.62 +       [[0 :a] [1 :b] [2 :c] [3 :d]] [:a :b :c :d]
  180.63 +       [[0 :a] [1 :b] [2 :c] [3 :d]] '(:a :b :c :d)
  180.64 +       [[0 \1] [1 \2] [2 \3] [3 \4]] "1234"))
  180.65 +
  180.66 +(deftest test-group-by
  180.67 +  (is (= (seq/group-by even? [1 2 3 4 5]) 
  180.68 +	 {false [1 3 5], true [2 4]})))
  180.69 +
  180.70 +;Note - this does not make sense for maps and sets, because order is expected
  180.71 +(deftest test-partition-by
  180.72 +  (are [test-seq] (= (seq/partition-by (comp even? count) test-seq)
  180.73 +		     [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]])
  180.74 +       ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"]
  180.75 +       '("a" "bb" "cccc" "dd" "eee" "f" "" "hh"))
  180.76 +  (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm")
  180.77 +       [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]])))
  180.78 +
  180.79 +(deftest test-frequencies
  180.80 +  (are [expected test-seq] (= (seq/frequencies test-seq) expected)
  180.81 +       {\p 2, \s 4, \i 4, \m 1} "mississippi"
  180.82 +       {1 4 2 2 3 1} [1 1 1 1 2 2 3]
  180.83 +       {1 4 2 2 3 1} '(1 1 1 1 2 2 3)))
  180.84 +
  180.85 +;Note - this does not make sense for maps and sets, because order is expected
  180.86 +;This is a key differnce between reductions and reduce.
  180.87 +(deftest test-reductions
  180.88 +  (is (= (seq/reductions + [1 2 3 4 5])
  180.89 +	 [1 3 6 10 15]))
  180.90 +  (is (= (reductions + 10 [1 2 3 4 5])
  180.91 +	 [10 11 13 16 20 25])))
  180.92 +
  180.93 +;Note - this does not make sense for maps and sets, because order is expected
  180.94 +(deftest test-rotations
  180.95 +  (is (= (seq/rotations [1 2 3 4])
  180.96 +	 [[1 2 3 4] 
  180.97 +	  [2 3 4 1]
  180.98 +	  [3 4 1 2]
  180.99 +	  [4 1 2 3]])))
 180.100 +
 180.101 +;Note - this does not make sense for maps and sets, because order is expected
 180.102 +(deftest test-partition-all
 180.103 +  (is (= (seq/partition-all 4 [1 2 3 4 5 6 7 8 9])
 180.104 +	 [[1 2 3 4] [5 6 7 8] [9]]))
 180.105 +  (is (= (seq/partition-all 4 2 [1 2 3 4 5 6 7 8 9])
 180.106 +	 [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]])))
 180.107 +
 180.108 +;Thanks to Andy Fingerhut for the idea of testing invariants
 180.109 +(deftest test-shuffle-invariants
 180.110 +  (is (= (count (seq/shuffle [1 2 3 4])) 4))
 180.111 +  (let [shuffled-seq (seq/shuffle [1 2 3 4])]
 180.112 +    (is (every? #{1 2 3 4} shuffled-seq))))
 180.113 +
 180.114 +;Thanks to Andy Fingerhut for the idea of testing invariants
 180.115 +(deftest test-rand-elt-invariants
 180.116 +  (let [elt (seq/rand-elt [:a :b :c :d])]
 180.117 +    (is (#{:a :b :c :d} elt))))
 180.118 +
 180.119 +;Note - this does not make sense for maps and sets, because order is expected
 180.120 +(deftest test-find-first
 180.121 +  (is (= (seq/find-first even? [1 2 3 4 5]) 2))
 180.122 +  (is (= (seq/find-first even? '(1 2 3 4 5)) 2)))
 180.123 +
 180.124 +(deftest test-includes
 180.125 +  (are [coll k] (false? (seq/includes? coll k))
 180.126 +       [1 2 3] 0
 180.127 +       [] nil
 180.128 +       [:a :b] :c)
 180.129 +  (are [coll k] (true? (seq/includes? coll k))
 180.130 +       [1 2 3] 1
 180.131 +       [:a :b] :b))
   181.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   181.2 +++ b/src/clojure/contrib/test_contrib/test_shell.clj	Sat Aug 21 06:25:44 2010 -0400
   181.3 @@ -0,0 +1,41 @@
   181.4 +(ns clojure.contrib.test-shell
   181.5 +  (:use clojure.test
   181.6 +	clojure.contrib.shell)
   181.7 +  (:import (java.io File)))
   181.8 +
   181.9 +; workaroung to access private parse-args. Better way?
  181.10 +(def parse-args ((ns-interns 'clojure.contrib.shell) 'parse-args))
  181.11 +(def as-file ((ns-interns 'clojure.contrib.shell) 'as-file))
  181.12 +(def as-env-string ((ns-interns 'clojure.contrib.shell) 'as-env-string))
  181.13 +
  181.14 +(deftest test-parse-args
  181.15 +  (are [x y] (= x y)
  181.16 +    {:cmd [nil] :out "UTF-8" :dir nil :env nil} (parse-args [])
  181.17 +    {:cmd ["ls"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls"])
  181.18 +    {:cmd ["ls" "-l"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls" "-l"])
  181.19 +    {:cmd ["ls"] :out "ISO-8859-1" :dir nil :env nil} (parse-args ["ls" :out "ISO-8859-1"])
  181.20 +))
  181.21 +  
  181.22 +(deftest test-with-sh-dir
  181.23 +  (are [x y] (= x y)
  181.24 +    nil *sh-dir*
  181.25 +    "foo" (with-sh-dir "foo" *sh-dir*)))
  181.26 +
  181.27 +(deftest test-with-sh-env
  181.28 +  (are [x y] (= x y)
  181.29 +    nil *sh-env*
  181.30 +    {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*)))
  181.31 +
  181.32 +(deftest test-as-env-string
  181.33 +  (are [x y] (= x y)
  181.34 +    nil (as-env-string nil)
  181.35 +    ["FOO=BAR"] (seq (as-env-string {"FOO" "BAR"}))
  181.36 +    ["FOO_SYMBOL=BAR"] (seq (as-env-string {'FOO_SYMBOL "BAR"}))
  181.37 +    ["FOO_KEYWORD=BAR"] (seq (as-env-string {:FOO_KEYWORD "BAR"}))))
  181.38 +
  181.39 +
  181.40 +(deftest test-as-file
  181.41 +  (are [x y] (= x y)
  181.42 +    (File. "foo") (as-file "foo")
  181.43 +    nil (as-file nil)
  181.44 +    (File. "bar") (as-file (File. "bar"))))
  181.45 \ No newline at end of file
   182.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   182.2 +++ b/src/clojure/contrib/test_contrib/test_sql.clj	Sat Aug 21 06:25:44 2010 -0400
   182.3 @@ -0,0 +1,207 @@
   182.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
   182.5 +;;  distribution terms for this software are covered by the Eclipse Public
   182.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
   182.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
   182.8 +;;  using this software in any fashion, you are agreeing to be bound by the
   182.9 +;;  terms of this license.  You must not remove this notice, or any other,
  182.10 +;;  from this software.
  182.11 +;;
  182.12 +;;  test.clj
  182.13 +;;
  182.14 +;;  test/example for clojure.contrib.sql
  182.15 +;;
  182.16 +;;  scgilardi (gmail)
  182.17 +;;  Created 13 September 2008
  182.18 +
  182.19 +(ns clojure.contrib.test-sql
  182.20 +  (:use [clojure.contrib.sql :as sql :only ()]))
  182.21 +
  182.22 +(def db {:classname "org.apache.derby.jdbc.EmbeddedDriver"
  182.23 +         :subprotocol "derby"
  182.24 +         :subname "/tmp/clojure.contrib.sql.test.db"
  182.25 +         :create true})
  182.26 +
  182.27 +(defn create-fruit
  182.28 +  "Create a table"
  182.29 +  []
  182.30 +  (sql/create-table
  182.31 +   :fruit
  182.32 +   [:name "varchar(32)" "PRIMARY KEY"]
  182.33 +   [:appearance "varchar(32)"]
  182.34 +   [:cost :int]
  182.35 +   [:grade :real]))
  182.36 +
  182.37 +(defn drop-fruit
  182.38 +  "Drop a table"
  182.39 +  []
  182.40 +  (try
  182.41 +   (sql/drop-table :fruit)
  182.42 +   (catch Exception _)))
  182.43 +
  182.44 +(defn insert-rows-fruit
  182.45 +  "Insert complete rows"
  182.46 +  []
  182.47 +  (sql/insert-rows
  182.48 +   :fruit
  182.49 +   ["Apple" "red" 59 87]
  182.50 +   ["Banana" "yellow" 29 92.2]
  182.51 +   ["Peach" "fuzzy" 139 90.0]
  182.52 +   ["Orange" "juicy" 89 88.6]))
  182.53 +
  182.54 +(defn insert-values-fruit
  182.55 +  "Insert rows with values for only specific columns"
  182.56 +  []
  182.57 +  (sql/insert-values
  182.58 +   :fruit
  182.59 +   [:name :cost]
  182.60 +   ["Mango" 722]
  182.61 +   ["Feijoa" 441]))
  182.62 +
  182.63 +(defn insert-records-fruit
  182.64 +  "Insert records, maps from keys specifying columns to values"
  182.65 +  []
  182.66 +  (sql/insert-records
  182.67 +   :fruit
  182.68 +   {:name "Pomegranate" :appearance "fresh" :cost 585}
  182.69 +   {:name "Kiwifruit" :grade 93}))
  182.70 +
  182.71 +(defn db-write
  182.72 +  "Write initial values to the database as a transaction"
  182.73 +  []
  182.74 +  (sql/with-connection db
  182.75 +    (sql/transaction
  182.76 +     (drop-fruit)
  182.77 +     (create-fruit)
  182.78 +     (insert-rows-fruit)
  182.79 +     (insert-values-fruit)
  182.80 +     (insert-records-fruit)))
  182.81 +  nil)
  182.82 +
  182.83 +(defn db-read
  182.84 +  "Read the entire fruit table"
  182.85 +  []
  182.86 +  (sql/with-connection db
  182.87 +    (sql/with-query-results res
  182.88 +      ["SELECT * FROM fruit"]
  182.89 +      (doseq [rec res]
  182.90 +        (println rec)))))
  182.91 +
  182.92 +(defn db-update-appearance-cost
  182.93 +  "Update the appearance and cost of the named fruit"
  182.94 +  [name appearance cost]
  182.95 +  (sql/update-values
  182.96 +   :fruit
  182.97 +   ["name=?" name]
  182.98 +   {:appearance appearance :cost cost}))
  182.99 +
 182.100 +(defn db-update
 182.101 +  "Update two fruits as a transaction"
 182.102 +  []
 182.103 +  (sql/with-connection db
 182.104 +    (sql/transaction
 182.105 +     (db-update-appearance-cost "Banana" "bruised" 14)
 182.106 +     (db-update-appearance-cost "Feijoa" "green" 400)))
 182.107 +  nil)
 182.108 +
 182.109 +(defn db-update-or-insert
 182.110 +  "Updates or inserts a fruit"
 182.111 +  [record]
 182.112 +  (sql/with-connection db
 182.113 +    (sql/update-or-insert-values
 182.114 +     :fruit
 182.115 +     ["name=?" (:name record)]
 182.116 +     record)))
 182.117 +
 182.118 +(defn db-read-all
 182.119 +  "Return all the rows of the fruit table as a vector"
 182.120 +  []
 182.121 +  (sql/with-connection db
 182.122 +    (sql/with-query-results res
 182.123 +      ["SELECT * FROM fruit"]
 182.124 +      (into [] res))))
 182.125 +
 182.126 +(defn db-grade-range
 182.127 +  "Print rows describing fruit that are within a grade range"
 182.128 +  [min max]
 182.129 +  (sql/with-connection db
 182.130 +    (sql/with-query-results res
 182.131 +      [(str "SELECT name, cost, grade "
 182.132 +            "FROM fruit "
 182.133 +            "WHERE grade >= ? AND grade <= ?")
 182.134 +       min max]
 182.135 +      (doseq [rec res]
 182.136 +        (println rec)))))
 182.137 +
 182.138 +(defn db-grade-a 
 182.139 +  "Print rows describing all grade a fruit (grade between 90 and 100)"
 182.140 +  []
 182.141 +  (db-grade-range 90 100))
 182.142 +
 182.143 +(defn db-get-tables
 182.144 +  "Demonstrate getting table info"
 182.145 +  []
 182.146 +  (sql/with-connection db
 182.147 +    (into []
 182.148 +          (resultset-seq
 182.149 +           (-> (sql/connection)
 182.150 +               (.getMetaData)
 182.151 +               (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
 182.152 +
 182.153 +(defn db-exception
 182.154 +  "Demonstrate rolling back a partially completed transaction on exception"
 182.155 +  []
 182.156 +  (sql/with-connection db
 182.157 +    (sql/transaction
 182.158 +     (sql/insert-values
 182.159 +      :fruit
 182.160 +      [:name :appearance]
 182.161 +      ["Grape" "yummy"]
 182.162 +      ["Pear" "bruised"])
 182.163 +     ;; at this point the insert-values call is complete, but the transaction
 182.164 +     ;; is not. the exception will cause it to roll back leaving the database
 182.165 +     ;; untouched.
 182.166 +     (throw (Exception. "sql/test exception")))))
 182.167 +
 182.168 +(defn db-sql-exception
 182.169 +  "Demonstrate an sql exception"
 182.170 +  []
 182.171 +  (sql/with-connection db
 182.172 +    (sql/transaction
 182.173 +     (sql/insert-values
 182.174 +      :fruit
 182.175 +      [:name :appearance]
 182.176 +      ["Grape" "yummy"]
 182.177 +      ["Pear" "bruised"]
 182.178 +      ["Apple" "strange" "whoops"]))))
 182.179 +
 182.180 +(defn db-batchupdate-exception
 182.181 +  "Demonstrate a batch update exception"
 182.182 +  []
 182.183 +  (sql/with-connection db
 182.184 +    (sql/transaction
 182.185 +     (sql/do-commands
 182.186 +      "DROP TABLE fruit"
 182.187 +      "DROP TABLE fruit"))))
 182.188 +
 182.189 +(defn db-rollback
 182.190 +  "Demonstrate a rollback-only trasaction"
 182.191 +  []
 182.192 +  (sql/with-connection db
 182.193 +    (sql/transaction
 182.194 +     (prn "is-rollback-only" (sql/is-rollback-only))
 182.195 +     (sql/set-rollback-only)
 182.196 +     (sql/insert-values
 182.197 +      :fruit
 182.198 +      [:name :appearance]
 182.199 +      ["Grape" "yummy"]
 182.200 +      ["Pear" "bruised"])
 182.201 +     (prn "is-rollback-only" (sql/is-rollback-only))
 182.202 +     (sql/with-query-results res
 182.203 +       ["SELECT * FROM fruit"]
 182.204 +       (doseq [rec res]
 182.205 +         (println rec))))
 182.206 +    (prn)
 182.207 +    (sql/with-query-results res
 182.208 +      ["SELECT * FROM fruit"]
 182.209 +      (doseq [rec res]
 182.210 +        (println rec)))))
   183.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   183.2 +++ b/src/clojure/contrib/test_contrib/test_string.clj	Sat Aug 21 06:25:44 2010 -0400
   183.3 @@ -0,0 +1,124 @@
   183.4 +(ns clojure.contrib.test-string
   183.5 +  (:require [clojure.contrib.string :as s])
   183.6 +  (:use clojure.test))
   183.7 +
   183.8 +(deftest t-codepoints
   183.9 +  (is (= (list 102 111 111 65536 98 97 114)
  183.10 +         (s/codepoints "foo\uD800\uDC00bar"))
  183.11 +      "Handles Unicode supplementary characters"))
  183.12 +
  183.13 +(deftest t-escape
  183.14 +  (is (= "&lt;foo&amp;bar&gt;"
  183.15 +         (s/escape {\& "&amp;" \< "&lt;" \> "&gt;"} "<foo&bar>")))
  183.16 +  (is (= " \\\"foo\\\" "
  183.17 +         (s/escape {\" "\\\""} " \"foo\" " )))
  183.18 +  (is (= "faabor" (s/escape {\a \o, \o \a} "foobar"))))
  183.19 +
  183.20 +(deftest t-blank
  183.21 +  (is (s/blank? nil))
  183.22 +  (is (s/blank? ""))
  183.23 +  (is (s/blank? " "))
  183.24 +  (is (s/blank? " \t \n  \r "))
  183.25 +  (is (not (s/blank? "  foo  "))))
  183.26 +
  183.27 +(deftest t-take
  183.28 +  (is (= "foo" (s/take 3 "foobar")))
  183.29 +  (is (= "foobar" (s/take 7 "foobar")))
  183.30 +  (is (= "" (s/take 0 "foo"))))
  183.31 +
  183.32 +(deftest t-drop
  183.33 +  (is (= "bar" (s/drop 3 "foobar")))
  183.34 +  (is (= "" (s/drop 9 "foobar")))
  183.35 +  (is (= "foobar" (s/drop 0 "foobar"))))
  183.36 +
  183.37 +(deftest t-butlast
  183.38 +  (is (= "foob" (s/butlast 2 "foobar")))
  183.39 +  (is (= "" (s/butlast 9 "foobar")))
  183.40 +  (is (= "foobar" (s/butlast 0 "foobar"))))
  183.41 +
  183.42 +(deftest t-tail
  183.43 +  (is (= "ar" (s/tail 2 "foobar")))
  183.44 +  (is (= "foobar" (s/tail 9 "foobar")))
  183.45 +  (is (= "" (s/tail 0 "foobar"))))
  183.46 +
  183.47 +(deftest t-repeat
  183.48 +  (is (= "foofoofoo" (s/repeat 3 "foo"))))
  183.49 +
  183.50 +(deftest t-reverse
  183.51 +  (is (= "tab" (s/reverse "bat"))))
  183.52 +
  183.53 +(deftest t-replace
  183.54 +  (is (= "faabar" (s/replace-char \o \a "foobar")))
  183.55 +  (is (= "barbarbar" (s/replace-str "foo" "bar" "foobarfoo")))
  183.56 +  (is (= "FOObarFOO" (s/replace-by #"foo" s/upper-case  "foobarfoo"))))
  183.57 +
  183.58 +(deftest t-replace-first
  183.59 +  (is (= "barbarfoo" (s/replace-first-re #"foo" "bar" "foobarfoo")))
  183.60 +  (is (= "FOObarfoo" (s/replace-first-by #"foo" s/upper-case "foobarfoo"))))
  183.61 +
  183.62 +(deftest t-partition
  183.63 +  (is (= (list "" "abc" "123" "def")
  183.64 +         (s/partition #"[a-z]+" "abc123def"))))
  183.65 +
  183.66 +(deftest t-join
  183.67 +  (is (= "1,2,3" (s/join \, [1 2 3])))
  183.68 +  (is (= "" (s/join \, [])))
  183.69 +  (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3]))))
  183.70 +
  183.71 +(deftest t-chop
  183.72 +  (is (= "fo" (s/chop "foo")))
  183.73 +  (is (= "") (s/chop "f"))
  183.74 +  (is (= "") (s/chop "")))
  183.75 +
  183.76 +(deftest t-chomp
  183.77 +  (is (= "foo" (s/chomp "foo\n")))
  183.78 +  (is (= "foo" (s/chomp "foo\r\n")))
  183.79 +  (is (= "foo" (s/chomp "foo")))
  183.80 +  (is (= "" (s/chomp ""))))
  183.81 +
  183.82 +(deftest t-swap-case
  183.83 +  (is (= "fOO!bAR" (s/swap-case "Foo!Bar")))
  183.84 +  (is (= "" (s/swap-case ""))))
  183.85 +
  183.86 +(deftest t-capitalize
  183.87 +  (is (= "Foobar" (s/capitalize "foobar")))
  183.88 +  (is (= "Foobar" (s/capitalize "FOOBAR"))))
  183.89 +
  183.90 +(deftest t-ltrim
  183.91 +  (is (= "foo " (s/ltrim " foo ")))
  183.92 +  (is (= "" (s/ltrim "   "))))
  183.93 +
  183.94 +(deftest t-rtrim
  183.95 +  (is (= " foo" (s/rtrim " foo ")))
  183.96 +  (is (= "" (s/rtrim "   "))))
  183.97 +
  183.98 +(deftest t-split-lines
  183.99 +  (is (= (list "one" "two" "three")
 183.100 +         (s/split-lines "one\ntwo\r\nthree")))
 183.101 +  (is (= (list "foo") (s/split-lines "foo"))))
 183.102 +
 183.103 +(deftest t-upper-case
 183.104 +  (is (= "FOOBAR" (s/upper-case "Foobar"))))
 183.105 +
 183.106 +(deftest t-lower-case
 183.107 +  (is (= "foobar" (s/lower-case "FooBar"))))
 183.108 +
 183.109 +(deftest t-trim
 183.110 +  (is (= "foo" (s/trim "  foo  \r\n"))))
 183.111 +
 183.112 +(deftest t-substring
 183.113 +  (is (s/substring? "foo" "foobar"))
 183.114 +  (is (not (s/substring? "baz" "foobar"))))
 183.115 +
 183.116 +(deftest t-get
 183.117 +  (is (= \o (s/get "foo" 1))))
 183.118 +
 183.119 +(deftest t-as-str
 183.120 +  (testing "keyword to string"
 183.121 +    (is (= "foo") (s/as-str :foo)))
 183.122 +  (testing "symbol to string"
 183.123 +    (is (= "foo") (s/as-str 'foo)))
 183.124 +  (testing "string to string"
 183.125 +    (is (= "foo") (s/as-str "foo")))
 183.126 +  (testing "stringifying non-namish things"
 183.127 +    (is (= "42") (s/as-str 42))))
   184.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   184.2 +++ b/src/clojure/contrib/test_contrib/test_strint.clj	Sat Aug 21 06:25:44 2010 -0400
   184.3 @@ -0,0 +1,41 @@
   184.4 +;   Copyright (c) Stuart Halloway, 2010-. All rights reserved.
   184.5 +
   184.6 +;   The use and distribution terms for this software are covered by the
   184.7 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   184.8 +;   which can be found in the file epl-v10.html at the root of this 
   184.9 +;   distribution.
  184.10 +;   By using this software in any fashion, you are agreeing to be bound by
  184.11 +;   the terms of this license.
  184.12 +;   You must not remove this notice, or any other, from this software.
  184.13 +
  184.14 +(ns clojure.contrib.test-strint
  184.15 +  (:use clojure.test)
  184.16 +  (:use [clojure.contrib strint with-ns]))
  184.17 +
  184.18 +(def silent-read (with-ns 'clojure.contrib.strint silent-read))
  184.19 +(def interpolate (with-ns 'clojure.contrib.strint interpolate))
  184.20 +      
  184.21 +(deftest test-silent-read
  184.22 +  (testing "reading a valid form returns [read form, rest of string]"
  184.23 +    (is (= [[1] "[2]"] (silent-read "[1][2]"))))
  184.24 +  (testing "reading an invalid form returns nil"
  184.25 +    (is (= nil (silent-read "[")))))
  184.26 +
  184.27 +(deftest test-interpolate
  184.28 +  (testing "a plain old string"
  184.29 +    (is (= ["a plain old string"] (interpolate "a plain old string"))))
  184.30 +  (testing "some value replacement forms"
  184.31 +    (is (= '["" foo " and " bar ""] (interpolate "~{foo} and ~{bar}"))))
  184.32 +  (testing "some fn-calling forms"
  184.33 +    (is (= '["" (+ 1 2) " and " (vector 3) ""] (interpolate "~(+ 1 2) and ~(vector 3)")))))
  184.34 +
  184.35 +(deftest test-<<
  184.36 +  (testing "docstring examples"
  184.37 +    (let [v 30.5
  184.38 +          m {:a [1 2 3]}]
  184.39 +      (is (= "This trial required 30.5ml of solution."
  184.40 +             (<< "This trial required ~{v}ml of solution.")))
  184.41 +      (is (= "There are 30 days in November."
  184.42 +             (<< "There are ~(int v) days in November.")))
  184.43 +      (is (= "The total for your order is $6."
  184.44 +             (<< "The total for your order is $~(->> m :a (apply +))."))))))
   185.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   185.2 +++ b/src/clojure/contrib/test_contrib/test_trace.clj	Sat Aug 21 06:25:44 2010 -0400
   185.3 @@ -0,0 +1,16 @@
   185.4 +(ns clojure.contrib.test-trace
   185.5 +  (:use clojure.test
   185.6 +        clojure.contrib.trace))
   185.7 +
   185.8 +(deftrace call-myself [n]
   185.9 +  (when-not (< n 1)
  185.10 +    (call-myself (dec n))))
  185.11 +
  185.12 +(deftest test-tracing-a-function-that-calls-itself
  185.13 +  (let [output (with-out-str (call-myself 1))]
  185.14 +    (is (re-find #"^TRACE t\d+: (call-myself 1)\nTRACE t\d+: |    (call-myself 0)\nTRACE t\d+: |    => nil\nTRACE t\d+: => nil$"
  185.15 +                 output))))
  185.16 +
  185.17 +;(deftest dotrace-on-core
  185.18 +;  (let [output (with-out-str (dotrace [mod] (mod 11 5)))]
  185.19 +;    (is (re-find #"\(mod 11 5\)" output))))
   186.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   186.2 +++ b/src/clojure/contrib/test_contrib/test_with_ns.clj	Sat Aug 21 06:25:44 2010 -0400
   186.3 @@ -0,0 +1,18 @@
   186.4 +(ns clojure.contrib.test-with-ns
   186.5 +  (:use clojure.test
   186.6 +	clojure.contrib.with-ns))
   186.7 +
   186.8 +(deftest test-namespace-gets-removed
   186.9 +  (let [all-ns-names (fn [] (map #(.name %) (all-ns)))]
  186.10 +    (testing "unexceptional return"
  186.11 +      (let [ns-name (with-temp-ns (ns-name *ns*))]
  186.12 +        (is (not (some #{ns-name} (all-ns-names))))))
  186.13 +    (testing "when an exception is thrown"
  186.14 +      (let [ns-name-str
  186.15 +            (try
  186.16 +             (with-temp-ns
  186.17 +               (throw (RuntimeException. (str (ns-name *ns*)))))
  186.18 +             (catch clojure.lang.Compiler$CompilerException e
  186.19 +               (-> e .getCause .getMessage)))]
  186.20 +        (is (re-find #"^sym.*$" ns-name-str))
  186.21 +        (is (not (some #{(symbol ns-name-str)} (all-ns-names))))))))
   187.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   187.2 +++ b/src/clojure/contrib/test_contrib/types/examples.clj	Sat Aug 21 06:25:44 2010 -0400
   187.3 @@ -0,0 +1,152 @@
   187.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   187.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   187.6 +;;
   187.7 +;; Application examples for data types
   187.8 +;;
   187.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  187.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  187.11 +
  187.12 +(ns
  187.13 +  #^{:author "Konrad Hinsen"
  187.14 +     :skip-wiki true
  187.15 +     :doc "Examples for data type definitions"}
  187.16 +  clojure.contrib.types.examples
  187.17 +  (:refer-clojure :exclude (deftype))
  187.18 +  (:use [clojure.contrib.types
  187.19 +	 :only (deftype defadt match)])
  187.20 +  (:require [clojure.contrib.generic.collection :as gc])
  187.21 +  (:require [clojure.contrib.generic.functor :as gf]))
  187.22 +
  187.23 +;
  187.24 +; Multisets implemented as maps to integers
  187.25 +;
  187.26 +
  187.27 +; The most basic type definition. A more elaborate version could add
  187.28 +; a constructor that verifies that its argument is a map with integer values.
  187.29 +(deftype ::multiset multiset
  187.30 +  "Multiset (demo implementation)")
  187.31 +
  187.32 +; Some set operations generalized to multisets
  187.33 +; Note that the multiset constructor is nowhere called explicitly, as the
  187.34 +; map operations all preserve the metadata.
  187.35 +(defmethod gc/conj ::multiset
  187.36 +  ([ms x]
  187.37 +   (assoc ms x (inc (get ms x 0))))
  187.38 +  ([ms x & xs]
  187.39 +    (reduce gc/conj (gc/conj ms x) xs)))
  187.40 +
  187.41 +(defmulti union (fn [& sets] (type (first sets))))
  187.42 +
  187.43 +(defmethod union clojure.lang.IPersistentSet
  187.44 +  [& sets]
  187.45 +  (apply clojure.set/union sets))
  187.46 +
  187.47 +; Note: a production-quality implementation should accept standard sets
  187.48 +; and perhaps other collections for its second argument.
  187.49 +(defmethod union ::multiset
  187.50 +  ([ms] ms)
  187.51 +  ([ms1 ms2]
  187.52 +     (letfn [(add-item [ms [item n]]
  187.53 +		       (assoc ms item (+ n (get ms item 0))))]
  187.54 +       (reduce add-item ms1 ms2)))
  187.55 +  ([ms1 ms2 & mss]
  187.56 +     (reduce union (union ms1 ms2) mss)))
  187.57 +
  187.58 +; Let's use it:
  187.59 +(gc/conj #{} :a :a :b :c)
  187.60 +(gc/conj (multiset {}) :a :a :b :c)
  187.61 +
  187.62 +(union #{:a :b} #{:b :c})
  187.63 +(union (multiset {:a 1 :b 1}) (multiset {:b 1 :c 2}))
  187.64 +
  187.65 +;
  187.66 +; A simple tree structure defined as an algebraic data type
  187.67 +;
  187.68 +(defadt ::tree
  187.69 +  empty-tree
  187.70 +  (leaf value)
  187.71 +  (node left-tree right-tree))
  187.72 +
  187.73 +(def a-tree (node (leaf :a) 
  187.74 +		  (node (leaf :b)
  187.75 +			(leaf :c))))
  187.76 +
  187.77 +(defn depth
  187.78 +  [t]
  187.79 +  (match t
  187.80 +    empty-tree  0
  187.81 +    (leaf _)    1
  187.82 +    (node l r)  (inc (max (depth l) (depth r)))))
  187.83 +
  187.84 +(depth empty-tree)
  187.85 +(depth (leaf 42))
  187.86 +(depth a-tree)
  187.87 +
  187.88 +; Algebraic data types with multimethods: fmap on a tree
  187.89 +(defmethod gf/fmap ::tree
  187.90 +  [f t]
  187.91 +  (match t
  187.92 +    empty-tree  empty-tree
  187.93 +    (leaf v)    (leaf (f v))
  187.94 +    (node l r)  (node (gf/fmap f l) (gf/fmap f r))))
  187.95 +
  187.96 +(gf/fmap str a-tree)
  187.97 +
  187.98 +;
  187.99 +; Nonsense examples to illustrate all the features of match
 187.100 +; for type constructors.
 187.101 +;
 187.102 +(defadt ::foo
 187.103 +  (bar a b c))
 187.104 +
 187.105 +(defn foo-to-int
 187.106 +  [a-foo]
 187.107 +  (match a-foo
 187.108 +    (bar x x x)  x
 187.109 +    (bar 0 x y)  (+ x y)
 187.110 +    (bar 1 2 3)  -1
 187.111 +    (bar a b 1)  (* a b)
 187.112 +    :else        42))
 187.113 +
 187.114 +(foo-to-int (bar 0 0 0))    ; 0
 187.115 +(foo-to-int (bar 0 5 6))    ; 11
 187.116 +(foo-to-int (bar 1 2 3))    ; -1
 187.117 +(foo-to-int (bar 3 3 1))    ; 9
 187.118 +(foo-to-int (bar 0 3 1))    ; 4
 187.119 +(foo-to-int (bar 10 20 30)) ; 42
 187.120 +
 187.121 +;
 187.122 +; Match can also be used for lists, vectors, and maps. Note that since
 187.123 +; algebraic data types are represented as maps, they can be matched
 187.124 +; either with their type constructor and positional arguments, or
 187.125 +; with a map template.
 187.126 +;
 187.127 +
 187.128 +; Tree depth once again with map templates
 187.129 +(defn depth
 187.130 +  [t]
 187.131 +  (match t
 187.132 +    empty-tree  0
 187.133 +    {:value _}  1
 187.134 +    {:left-tree l :right-tree r}  (inc (max (depth l) (depth r)))))
 187.135 +
 187.136 +(depth empty-tree)
 187.137 +(depth (leaf 42))
 187.138 +(depth a-tree)
 187.139 +
 187.140 +; Match for lists, vectors, and maps:
 187.141 +
 187.142 +(for [x ['(1 2 3)
 187.143 +	 [1 2 3]
 187.144 +	 {:x 1 :y 2 :z 3}
 187.145 +	 '(1 1 1)
 187.146 +	 [2 1 2]
 187.147 +	 {:x 1 :y 1 :z 2}]]
 187.148 +  (match x
 187.149 +    '(a a a)  	 'list-of-three-equal-values
 187.150 +    '(a b c)  	 'list
 187.151 +    [a a a]   	 'vector-of-three-equal-values
 187.152 +    [a b a]   	 'vector-of-three-with-first-and-last-equal
 187.153 +    [a b c]      'vector
 187.154 +    {:x a :y z}  'map-with-x-equal-y
 187.155 +    {}           'any-map))
   188.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   188.2 +++ b/src/clojure/contrib/test_is.clj	Sat Aug 21 06:25:44 2010 -0400
   188.3 @@ -0,0 +1,119 @@
   188.4 +;;; test_is.clj: Compatibility layer for old clojure.contrib.test-is
   188.5 +
   188.6 +;; by Stuart Sierra, http://stuartsierra.com/
   188.7 +;; August 28, 2009
   188.8 +
   188.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
  188.10 +;; and distribution terms for this software are covered by the Eclipse
  188.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  188.12 +;; which can be found in the file epl-v10.html at the root of this
  188.13 +;; distribution.  By using this software in any fashion, you are
  188.14 +;; agreeing to be bound by the terms of this license.  You must not
  188.15 +;; remove this notice, or any other, from this software.
  188.16 +
  188.17 +;; DEPRECATED in 1.2: Moved to clojure.test
  188.18 +
  188.19 +(ns ^{:deprecated "1.2"
  188.20 +      :doc "Backwards-compatibility for clojure.contrib.test-is
  188.21 +
  188.22 +  The clojure.contrib.test-is library moved from Contrib into the
  188.23 +  Clojure distribution as clojure.test.
  188.24 +
  188.25 +  This happened on or around clojure-contrib Git commit
  188.26 +  82cf0409d0fcb71be477ebfc4da18ee2128a2ad1 on June 25, 2009.
  188.27 +
  188.28 +  This file makes the clojure.test interface available under the old
  188.29 +  namespace clojure.contrib.test-is.
  188.30 +
  188.31 +  This includes support for the old syntax of the 'are' macro.
  188.32 +
  188.33 +  This was suggested by Howard Lewis Ship in ticket #26, 
  188.34 +  http://www.assembla.com/spaces/clojure-contrib/tickets/26"
  188.35 +       :author "Stuart Sierra"}
  188.36 +    clojure.contrib.test-is
  188.37 +    (:require clojure.test
  188.38 +              [clojure.walk :as walk]))
  188.39 +
  188.40 +
  188.41 +;;; COPY INTERNED VARS (EXCEPT are) FROM clojure.test
  188.42 +
  188.43 +(doseq [v (disj (set (vals (ns-interns 'clojure.test)))
  188.44 +                #'clojure.test/are)]
  188.45 +  (intern *ns* (with-meta (:name (meta v)) (meta v)) (var-get v)))
  188.46 +
  188.47 +
  188.48 +;;; REDEFINE OLD clojure.contrib.template 
  188.49 +
  188.50 +(defn find-symbols
  188.51 +  "Recursively finds all symbols in form."
  188.52 +  [form]
  188.53 +  (distinct (filter symbol? (tree-seq coll? seq form))))
  188.54 +
  188.55 +(defn find-holes
  188.56 +  "Recursively finds all symbols starting with _ in form."
  188.57 +  [form]
  188.58 +  (sort (distinct (filter #(.startsWith (name %) "_")
  188.59 +                          (find-symbols form)))))
  188.60 +
  188.61 +(defn find-pure-exprs
  188.62 +  "Recursively finds all sub-expressions in form that do not contain
  188.63 +  any symbols starting with _"
  188.64 +  [form]
  188.65 +  (filter #(and (list? %)
  188.66 +                (empty? (find-holes %)))
  188.67 +          (tree-seq seq? seq form)))
  188.68 +
  188.69 +(defn flatten-map
  188.70 +  "Transforms a map into a vector like [key value key value]."
  188.71 +  [m]
  188.72 +  (reduce (fn [coll [k v]] (conj coll k v))
  188.73 +          [] m))
  188.74 +
  188.75 +(defn template?
  188.76 +  "Returns true if form is a valid template expression."
  188.77 +  [form]
  188.78 +  (if (seq (find-holes form)) true false))
  188.79 +
  188.80 +(defn apply-template
  188.81 +  "Replaces _1, _2, _3, etc. in expr with corresponding elements of
  188.82 +  values.  Returns the modified expression.  For use in macros."
  188.83 +  [expr values]
  188.84 +  (when-not (template? expr)
  188.85 +    (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template."))))
  188.86 +  (let [expr (walk/postwalk-replace {'_ '_1} expr)
  188.87 +        holes (find-holes expr)
  188.88 +        smap (zipmap holes values)]
  188.89 +    (walk/prewalk-replace smap expr)))
  188.90 +
  188.91 +(defmacro do-template
  188.92 +  "Repeatedly evaluates template expr (in a do block) using values in
  188.93 +  args.  args are grouped by the number of holes in the template.
  188.94 +  Example: (do-template (check _1 _2) :a :b :c :d)
  188.95 +  expands to (do (check :a :b) (check :c :d))"
  188.96 +  [expr & args]
  188.97 +  (when-not (template? expr)
  188.98 +    (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template."))))
  188.99 +  (let [expr (walk/postwalk-replace {'_ '_1} expr)
 188.100 +        argcount (count (find-holes expr))]
 188.101 +    `(do ~@(map (fn [a] (apply-template expr a))
 188.102 +                (partition argcount args)))))
 188.103 +
 188.104 +
 188.105 +
 188.106 +;;; REDEFINE are MACRO TO MATCH OLD TEMPLATE BEHAVIOR
 188.107 +
 188.108 +(defmacro are
 188.109 +  "Checks multiple assertions with a template expression.
 188.110 +  See clojure.contrib.template/do-template for an explanation of
 188.111 +  templates.
 188.112 +
 188.113 +  Example: (are (= _1 _2)  
 188.114 +                2 (+ 1 1)
 188.115 +                4 (* 2 2))
 188.116 +  Expands to: 
 188.117 +           (do (is (= 2 (+ 1 1)))
 188.118 +               (is (= 4 (* 2 2))))
 188.119 +
 188.120 +  Note: This breaks some reporting features, such as line numbers."
 188.121 +  [expr & args]
 188.122 +  `(do-template (is ~expr) ~@args))
   189.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   189.2 +++ b/src/clojure/contrib/trace.clj	Sat Aug 21 06:25:44 2010 -0400
   189.3 @@ -0,0 +1,97 @@
   189.4 +;;; trace.clj -- simple call-tracing macros for Clojure
   189.5 +
   189.6 +;; by Stuart Sierra, http://stuartsierra.com/
   189.7 +;; December 3, 2008
   189.8 +
   189.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
  189.10 +;; and distribution terms for this software are covered by the Eclipse
  189.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  189.12 +;; which can be found in the file epl-v10.html at the root of this
  189.13 +;; distribution.  By using this software in any fashion, you are
  189.14 +;; agreeing to be bound by the terms of this license.  You must not
  189.15 +;; remove this notice, or any other, from this software.
  189.16 +
  189.17 +
  189.18 +;; This file defines simple "tracing" macros to help you see what your
  189.19 +;; code is doing.
  189.20 +
  189.21 +
  189.22 +;; CHANGE LOG
  189.23 +;;
  189.24 +;; December 3, 2008:
  189.25 +;;
  189.26 +;;   * replaced *trace-out* with tracer
  189.27 +;;
  189.28 +;;   * made trace a function instead of a macro 
  189.29 +;;     (suggestion from Stuart Halloway)
  189.30 +;;
  189.31 +;;   * added trace-fn-call
  189.32 +;;
  189.33 +;; June 9, 2008: first version
  189.34 +
  189.35 +
  189.36 +
  189.37 +(ns 
  189.38 +  ^{:author "Stuart Sierra, Michel Salim",
  189.39 +     :doc "This file defines simple \"tracing\" macros to help you see what your
  189.40 +code is doing."}
  189.41 +  clojure.contrib.trace)
  189.42 +
  189.43 +(def
  189.44 + ^{:doc "Current stack depth of traced function calls."}
  189.45 + *trace-depth* 0)
  189.46 +
  189.47 +(defn tracer
  189.48 +  "This function is called by trace.  Prints to standard output, but
  189.49 +  may be rebound to do anything you like.  'name' is optional."
  189.50 +  [name value]
  189.51 +  (println (str "TRACE" (when name (str " " name)) ": " value)))
  189.52 +
  189.53 +(defn trace
  189.54 +  "Sends name (optional) and value to the tracer function, then
  189.55 +  returns value.  May be wrapped around any expression without
  189.56 +  affecting the result."
  189.57 +  ([value] (trace nil value))
  189.58 +  ([name value]
  189.59 +     (tracer name (pr-str value))
  189.60 +     value))
  189.61 +
  189.62 +(defn trace-indent
  189.63 +  "Returns an indentation string based on *trace-depth*"
  189.64 +  []
  189.65 +  (apply str (take *trace-depth* (repeat "|    "))))
  189.66 +
  189.67 +(defn trace-fn-call
  189.68 +  "Traces a single call to a function f with args.  'name' is the
  189.69 +  symbol name of the function."
  189.70 +  [name f args]
  189.71 +  (let [id (gensym "t")]
  189.72 +    (tracer id (str (trace-indent) (pr-str (cons name args))))
  189.73 +    (let [value (binding [*trace-depth* (inc *trace-depth*)]
  189.74 +                  (apply f args))]
  189.75 +      (tracer id (str (trace-indent) "=> " (pr-str value)))
  189.76 +      value)))
  189.77 +
  189.78 +(defmacro deftrace
  189.79 +  "Use in place of defn; traces each call/return of this fn, including
  189.80 +  arguments.  Nested calls to deftrace'd functions will print a
  189.81 +  tree-like structure."
  189.82 +  [name & definition]
  189.83 +  `(do
  189.84 +     (def ~name)
  189.85 +     (let [f# (fn ~@definition)]
  189.86 +       (defn ~name [& args#]
  189.87 +         (trace-fn-call '~name f# args#)))))
  189.88 +
  189.89 +(defmacro dotrace
  189.90 +  "Given a sequence of function identifiers, evaluate the body
  189.91 +   expressions in an environment in which the identifiers are bound to
  189.92 +   the traced functions.  Does not work on inlined functions,
  189.93 +   such as clojure.core/+"
  189.94 +  [fnames & exprs]
  189.95 +  `(binding [~@(interleave fnames
  189.96 +                           (for [fname fnames]
  189.97 +                             `(let [f# @(var ~fname)]
  189.98 +                                (fn [& args#]
  189.99 +                                  (trace-fn-call '~fname f# args#)))))]
 189.100 +     ~@exprs))
   190.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   190.2 +++ b/src/clojure/contrib/types.clj	Sat Aug 21 06:25:44 2010 -0400
   190.3 @@ -0,0 +1,275 @@
   190.4 +;; Data types
   190.5 +
   190.6 +;; by Konrad Hinsen
   190.7 +;; last updated May 3, 2009
   190.8 +
   190.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
  190.10 +;; and distribution terms for this software are covered by the Eclipse
  190.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  190.12 +;; which can be found in the file epl-v10.html at the root of this
  190.13 +;; distribution.  By using this software in any fashion, you are
  190.14 +;; agreeing to be bound by the terms of this license.  You must not
  190.15 +;; remove this notice, or any other, from this software.
  190.16 +
  190.17 +(ns
  190.18 +  ^{:author "Konrad Hinsen"
  190.19 +     :doc "General and algebraic data types"}
  190.20 +  clojure.contrib.types
  190.21 +  (:refer-clojure :exclude (deftype))
  190.22 +  (:use [clojure.contrib.def :only (name-with-attributes)]))
  190.23 +
  190.24 +;
  190.25 +; Utility functions
  190.26 +;
  190.27 +(defn- qualified-symbol
  190.28 +  [s]
  190.29 +  (symbol (str *ns*) (str s)))
  190.30 +
  190.31 +(defn- qualified-keyword
  190.32 +  [s]
  190.33 +  (keyword (str *ns*) (str s)))
  190.34 +
  190.35 +(defn- unqualified-symbol
  190.36 +  [s]
  190.37 +  (let [s-str (str s)]
  190.38 +    (symbol (subs s-str (inc (.indexOf s-str (int \/)))))))
  190.39 +
  190.40 +(defn- resolve-symbol
  190.41 +  [s]
  190.42 +  (if-let [var (resolve s)]
  190.43 +    (symbol (str (.ns var)) (str (.sym var)))
  190.44 +    s))
  190.45 +
  190.46 +;
  190.47 +; Data type definition
  190.48 +;
  190.49 +(defmulti deconstruct type)
  190.50 +
  190.51 +(defmulti constructor-form type)
  190.52 +(defmethod constructor-form :default
  190.53 +  [o] nil)
  190.54 +(defmethod constructor-form ::type
  190.55 +  [o] (cons (::constructor (meta o)) (deconstruct o)))
  190.56 +
  190.57 +(defmacro deftype
  190.58 +  "Define a data type by a type tag (a namespace-qualified keyword)
  190.59 +   and a symbol naming the constructor function. Optionally, a
  190.60 +   constructor and a deconstructor function can be given as well,
  190.61 +   the defaults being clojure.core/identity and clojure.core/list.
  190.62 +   The full constructor associated with constructor-name calls the
  190.63 +   constructor function and attaches the type tag to its result
  190.64 +   as metadata. The deconstructor function must return the arguments
  190.65 +   to be passed to the constructor in order to create an equivalent
  190.66 +   object. It is used for printing and matching."
  190.67 +  {:arglists
  190.68 +  '([type-tag constructor-name docstring? attr-map?]
  190.69 +    [type-tag constructor-name docstring? attr-map? constructor]
  190.70 +    [type-tag constructor-name docstring? attr-map? constructor deconstructor])}
  190.71 +  [type-tag constructor-name & options]
  190.72 +  (let [[constructor-name options]  (name-with-attributes
  190.73 +				      constructor-name options)
  190.74 +	[constructor deconstructor] options
  190.75 +	constructor   		    (if (nil? constructor)
  190.76 +		      		      'clojure.core/identity
  190.77 +		      		      constructor)
  190.78 +	deconstructor 		    (if (nil? deconstructor)
  190.79 +		      		     'clojure.core/list
  190.80 +		      		     deconstructor)]
  190.81 +    `(do
  190.82 +       (derive ~type-tag ::type)
  190.83 +       (let [meta-map# {:type ~type-tag
  190.84 +			::constructor
  190.85 +			    (quote ~(qualified-symbol constructor-name))}]
  190.86 +	 (def ~constructor-name
  190.87 +	      (comp (fn [~'x] (with-meta ~'x meta-map#)) ~constructor))
  190.88 +	 (defmethod deconstruct ~type-tag [~'x]
  190.89 +	   (~deconstructor (with-meta ~'x {})))))))
  190.90 +
  190.91 +(defmacro deftype-
  190.92 +  "Same as deftype but the constructor is private."
  190.93 +  [type-tag constructor-name & optional]
  190.94 +  `(deftype ~type-tag
  190.95 +     ~(vary-meta constructor-name assoc :private true)
  190.96 +     ~@optional))
  190.97 +
  190.98 +(defmethod print-method ::type [o w]
  190.99 +  (let [cf (constructor-form o)]
 190.100 +    (if (symbol? cf)
 190.101 +      (print-method (unqualified-symbol cf) w)
 190.102 +      (print-method (cons (unqualified-symbol (first cf)) (rest cf)) w))))
 190.103 +
 190.104 +;
 190.105 +; Algebraic types
 190.106 +;
 190.107 +(derive ::adt ::type)
 190.108 +
 190.109 +(defmethod constructor-form ::adt
 190.110 +  [o]
 190.111 +  (let [v (vals o)]
 190.112 +    (if (= 1 (count v))
 190.113 +      (first v)
 190.114 +      v)))
 190.115 +
 190.116 +(defn- constructor-code
 190.117 +  [meta-map-symbol constructor]
 190.118 +  (if (symbol? constructor)
 190.119 +    `(def ~constructor
 190.120 +	  (with-meta {::tag (quote ~(qualified-symbol constructor))}
 190.121 +		     ~meta-map-symbol))
 190.122 +    (let [[name & args] constructor
 190.123 +	  keys (cons ::tag (map (comp keyword str) args))]
 190.124 +      (if (empty? args)
 190.125 +	(throw (IllegalArgumentException. "zero argument constructor"))
 190.126 +	`(let [~'basis (create-struct ~@keys)]
 190.127 +	   (defn ~name ~(vec args)
 190.128 +	     (with-meta (struct ~'basis (quote ~(qualified-symbol name)) ~@args)
 190.129 +			~meta-map-symbol)))))))
 190.130 +
 190.131 +(defmacro defadt
 190.132 +  "Define an algebraic data type name by an exhaustive list of constructors.
 190.133 +   Each constructor can be a symbol (argument-free constructor) or a
 190.134 +   list consisting of a tag symbol followed by the argument symbols.
 190.135 +   The data type tag must be a keyword."
 190.136 +  [type-tag & constructors]
 190.137 +  (let [meta-map-symbol (gensym "mm")]
 190.138 +    `(let [~meta-map-symbol {:type ~type-tag}]
 190.139 +       (derive ~type-tag ::adt)
 190.140 +       ~@(map (partial constructor-code meta-map-symbol) constructors)
 190.141 +       )))
 190.142 +
 190.143 +;
 190.144 +;  Matching templates
 190.145 +;
 190.146 +(defn- symbol-tests-and-bindings
 190.147 +  [template vsymbol]
 190.148 +  [`(= (quote ~(resolve-symbol template)) ~vsymbol)
 190.149 +   []])
 190.150 +
 190.151 +(defn- sequential-tests-and-bindings
 190.152 +  [template vsymbol]
 190.153 +  (let [enum-values (map list template (range (count template)))
 190.154 +        ; Non-symbols in the template create an equality test with the
 190.155 +	; corresponding value in the object's value list
 190.156 +	tests (map (fn [[v i]] `(= ~v (nth ~vsymbol ~i)))
 190.157 +		   (filter (complement #(symbol? (first %))) enum-values))
 190.158 +        ; Symbols in the template become bindings to the corresponding
 190.159 +        ; value in the object. However, if a symbol occurs more than once,
 190.160 +        ; only one binding is generated, and equality tests are added
 190.161 +        ; for the other values.
 190.162 +	bindings (reduce (fn [map [symbol index]]
 190.163 +			   (assoc map symbol
 190.164 +				  (conj (get map symbol []) index)))
 190.165 +			 {}
 190.166 +			 (filter #(symbol? (first %)) enum-values))
 190.167 +	tests (concat tests
 190.168 +		      (map (fn [[symbol indices]]
 190.169 +			     (cons `= (map #(list `nth vsymbol %) indices)))
 190.170 +			   (filter #(> (count (second %)) 1) bindings)))
 190.171 +	bindings (mapcat (fn [[symbol indices]]
 190.172 +			   [symbol (list `nth vsymbol (first indices))])
 190.173 +			 bindings)]
 190.174 +    [tests (vec bindings)]))
 190.175 +
 190.176 +(defn- constr-tests-and-bindings
 190.177 +  [template cfsymbol]
 190.178 +  (let [[tag & values] template
 190.179 +	cfasymbol (gensym)
 190.180 +	[tests bindings] (sequential-tests-and-bindings values cfasymbol)
 190.181 +	argtests (if (empty? tests)
 190.182 +		   tests
 190.183 +		   `((let [~cfasymbol (rest ~cfsymbol)] ~@tests)))]
 190.184 +    [`(and (seq? ~cfsymbol)
 190.185 +	   (= (quote ~(resolve-symbol tag)) (first ~cfsymbol))
 190.186 +	   ~@argtests)
 190.187 +     `[~cfasymbol (rest ~cfsymbol) ~@bindings]]))
 190.188 +
 190.189 +(defn- list-tests-and-bindings
 190.190 +  [template vsymbol]
 190.191 +  (let [[tests bindings] (sequential-tests-and-bindings template vsymbol)]
 190.192 +    [`(and (list? ~vsymbol) ~@tests)
 190.193 +     bindings]))
 190.194 +
 190.195 +(defn- vector-tests-and-bindings
 190.196 +  [template vsymbol]
 190.197 +  (let [[tests bindings] (sequential-tests-and-bindings template vsymbol)]
 190.198 +    [`(and (vector? ~vsymbol) ~@tests)
 190.199 +     bindings]))
 190.200 +
 190.201 +(defn- map-tests-and-bindings
 190.202 +  [template vsymbol]
 190.203 +  (let [; First test if the given keys are all present.
 190.204 +	tests (map (fn [[k v]] `(contains? ~vsymbol ~k)) template)
 190.205 +        ; Non-symbols in the template create an equality test with the
 190.206 +	; corresponding value in the object's value list.
 190.207 +	tests (concat tests
 190.208 +	        (map (fn [[k v]] `(= ~v (~k ~vsymbol)))
 190.209 +		     (filter (complement #(symbol? (second %))) template)))
 190.210 +        ; Symbols in the template become bindings to the corresponding
 190.211 +        ; value in the object. However, if a symbol occurs more than once,
 190.212 +        ; only one binding is generated, and equality tests are added
 190.213 +        ; for the other values.
 190.214 +	bindings (reduce (fn [map [key symbol]]
 190.215 +			   (assoc map symbol
 190.216 +				  (conj (get map symbol []) key)))
 190.217 +			 {}
 190.218 +			 (filter #(symbol? (second %)) template))
 190.219 +	tests (concat tests
 190.220 +	        (map (fn [[symbol keys]]
 190.221 +		       (cons `= (map #(list % vsymbol) keys)))
 190.222 +		     (filter #(> (count (second %)) 1) bindings)))
 190.223 +	bindings (mapcat (fn [[symbol keys]]
 190.224 +			   [symbol (list (first keys) vsymbol)])
 190.225 +			 bindings)]
 190.226 +    [`(and (map? ~vsymbol) ~@tests)
 190.227 +     (vec bindings)]))
 190.228 +
 190.229 +(defn- tests-and-bindings
 190.230 +  [template vsymbol cfsymbol]
 190.231 +  (cond (symbol? template)
 190.232 +	  (symbol-tests-and-bindings template cfsymbol)
 190.233 +	(seq? template)
 190.234 +	  (if (= (first template) 'quote)
 190.235 +	    (list-tests-and-bindings (second template) vsymbol)
 190.236 +	    (constr-tests-and-bindings template cfsymbol))
 190.237 +	(vector? template)
 190.238 +	  (vector-tests-and-bindings template vsymbol)
 190.239 +	(map? template)
 190.240 +	  (map-tests-and-bindings template vsymbol)
 190.241 +	:else
 190.242 +	  (throw (IllegalArgumentException. "illegal template for match"))))
 190.243 +
 190.244 +(defmacro match
 190.245 +  "Given a value and a list of template-expr clauses, evaluate the first
 190.246 +   expr whose template matches the value. There are four kinds of templates:
 190.247 +   1) Lists of the form (tag x1 x2 ...) match instances of types
 190.248 +      whose constructor has the same form as the list.
 190.249 +   2) Quoted lists of the form '(x1 x2 ...) match lists of the same
 190.250 +      length.
 190.251 +   3) Vectors of the form [x1 x2 ...] match vectors of the same length.
 190.252 +   4) Maps of the form {:key1 x1 :key2 x2 ...} match maps that have
 190.253 +      the same keys as the template, but which can have additional keys
 190.254 +      that are not part of the template.
 190.255 +   The values x1, x2, ... can be symbols or non-symbol values. Non-symbols
 190.256 +   must be equal to the corresponding values in the object to be matched.
 190.257 +   Symbols will be bound to the corresponding value in the object in the
 190.258 +   evaluation of expr. If the same symbol occurs more than once in a,
 190.259 +   template the corresponding elements of the object must be equal
 190.260 +   for the template to match."
 190.261 +  [value & clauses]
 190.262 +   (when (odd? (count clauses))
 190.263 +     (throw (Exception. "Odd number of elements in match expression")))
 190.264 +  (let [vsymbol (gensym)
 190.265 +	cfsymbol (gensym)
 190.266 +	terms (mapcat (fn [[template expr]]
 190.267 +			(if (= template :else)
 190.268 +			  [template expr]
 190.269 +			  (let [[tests bindings]
 190.270 +				(tests-and-bindings template vsymbol cfsymbol)]
 190.271 +			    [tests
 190.272 +			     (if (empty? bindings)
 190.273 +			       expr
 190.274 +			       `(let ~bindings ~expr))])))
 190.275 +		      (partition 2 clauses))]
 190.276 +    `(let [~vsymbol ~value
 190.277 +	   ~cfsymbol (constructor-form ~vsymbol)]
 190.278 +       (cond ~@terms))))
   191.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   191.2 +++ b/src/clojure/contrib/with_ns.clj	Sat Aug 21 06:25:44 2010 -0400
   191.3 @@ -0,0 +1,38 @@
   191.4 +;;; with_ns.clj -- temporary namespace macro
   191.5 +
   191.6 +;; by Stuart Sierra, http://stuartsierra.com/
   191.7 +;; March 28, 2009
   191.8 +
   191.9 +;; Copyright (c) Stuart Sierra, 2009. All rights reserved.  The use
  191.10 +;; and distribution terms for this software are covered by the Eclipse
  191.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  191.12 +;; which can be found in the file epl-v10.html at the root of this
  191.13 +;; distribution.  By using this software in any fashion, you are
  191.14 +;; agreeing to be bound by the terms of this license.  You must not
  191.15 +;; remove this notice, or any other, from this software.
  191.16 +
  191.17 +
  191.18 +(ns 
  191.19 +  ^{:author "Stuart Sierra",
  191.20 +     :doc "Temporary namespace macro"}
  191.21 +  clojure.contrib.with-ns)
  191.22 +
  191.23 +(defmacro with-ns
  191.24 +  "Evaluates body in another namespace.  ns is either a namespace
  191.25 +  object or a symbol.  This makes it possible to define functions in
  191.26 +  namespaces other than the current one."
  191.27 +  [ns & body]
  191.28 +  `(binding [*ns* (the-ns ~ns)]
  191.29 +     ~@(map (fn [form] `(eval '~form)) body)))
  191.30 +
  191.31 +(defmacro with-temp-ns
  191.32 +  "Evaluates body in an anonymous namespace, which is then immediately
  191.33 +  removed.  The temporary namespace will 'refer' clojure.core."
  191.34 +  [& body]
  191.35 +  `(try
  191.36 +    (create-ns 'sym#)
  191.37 +    (let [result# (with-ns 'sym#
  191.38 +                    (clojure.core/refer-clojure)
  191.39 +                    ~@body)]
  191.40 +      result#)
  191.41 +    (finally (remove-ns 'sym#))))
   192.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   192.2 +++ b/src/clojure/contrib/zip_filter.clj	Sat Aug 21 06:25:44 2010 -0400
   192.3 @@ -0,0 +1,92 @@
   192.4 +;   Copyright (c) Chris Houser, April 2008. All rights reserved.
   192.5 +;   The use and distribution terms for this software are covered by the
   192.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   192.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   192.8 +;   By using this software in any fashion, you are agreeing to be bound by
   192.9 +;   the terms of this license.
  192.10 +;   You must not remove this notice, or any other, from this software.
  192.11 +
  192.12 +; System for filtering trees and nodes generated by zip.clj in
  192.13 +; general, and xml trees in particular.
  192.14 +
  192.15 +(ns 
  192.16 +  ^{:author "Chris Houser",
  192.17 +     :doc "System for filtering trees and nodes generated by zip.clj in
  192.18 +general, and xml trees in particular.
  192.19 +"}
  192.20 +  clojure.contrib.zip-filter
  192.21 +  (:refer-clojure :exclude (descendants ancestors))
  192.22 +  (:require [clojure.zip :as zip]))
  192.23 +
  192.24 +; This uses the negative form (no-auto) so that the result from any
  192.25 +; naive function, including user functions, defaults to "auto".
  192.26 +(defn auto
  192.27 +  [v x] (with-meta x ((if v dissoc assoc) (meta x) :zip-filter/no-auto? true)))
  192.28 +
  192.29 +(defn auto?
  192.30 +  [x] (not (:zip-filter/no-auto? (meta x))))
  192.31 +
  192.32 +(defn right-locs
  192.33 +  "Returns a lazy sequence of locations to the right of loc, starting with loc."
  192.34 +  [loc] (lazy-seq (when loc (cons (auto false loc) (right-locs (zip/right loc))))))
  192.35 +
  192.36 +(defn left-locs
  192.37 +  "Returns a lazy sequence of locations to the left of loc, starting with loc."
  192.38 +  [loc] (lazy-seq (when loc (cons (auto false loc) (left-locs (zip/left loc))))))
  192.39 +
  192.40 +(defn leftmost?
  192.41 +  "Returns true if there are no more nodes to the left of location loc."
  192.42 +  [loc] (nil? (zip/left loc)))
  192.43 +
  192.44 +(defn rightmost?
  192.45 +  "Returns true if there are no more nodes to the right of location loc."
  192.46 +  [loc] (nil? (zip/right loc)))
  192.47 +
  192.48 +(defn children
  192.49 +  "Returns a lazy sequence of all immediate children of location loc,
  192.50 +  left-to-right."
  192.51 +  [loc]
  192.52 +    (when (zip/branch? loc)
  192.53 +      (map #(auto false %) (right-locs (zip/down loc)))))
  192.54 +
  192.55 +(defn children-auto
  192.56 +  "Returns a lazy sequence of all immediate children of location loc,
  192.57 +  left-to-right, marked so that a following tag= predicate will auto-descend."
  192.58 +  ^{:private true}
  192.59 +  [loc]
  192.60 +    (when (zip/branch? loc)
  192.61 +      (map #(auto true %) (right-locs (zip/down loc)))))
  192.62 +
  192.63 +(defn descendants
  192.64 +  "Returns a lazy sequence of all descendants of location loc, in
  192.65 +  depth-first order, left-to-right, starting with loc."
  192.66 +  [loc] (lazy-seq (cons (auto false loc) (mapcat descendants (children loc)))))
  192.67 +
  192.68 +(defn ancestors
  192.69 +  "Returns a lazy sequence of all ancestors of location loc, starting
  192.70 +  with loc and proceeding to loc's parent node and on through to the
  192.71 +  root of the tree."
  192.72 +  [loc] (lazy-seq (when loc (cons (auto false loc) (ancestors (zip/up loc))))))
  192.73 +
  192.74 +(defn- fixup-apply
  192.75 +  "Calls (pred loc), and then converts the result to the 'appropriate'
  192.76 +  sequence."
  192.77 +  ^{:private true}
  192.78 +  [pred loc]
  192.79 +      (let [rtn (pred loc)]
  192.80 +        (cond (and (map? (meta rtn)) (:zip-filter/is-node? (meta rtn))) (list rtn)
  192.81 +              (= rtn true)                (list loc)
  192.82 +              (= rtn false)               nil
  192.83 +              (nil? rtn)                  nil
  192.84 +              (sequential? rtn)           rtn
  192.85 +              :else                       (list rtn))))
  192.86 +
  192.87 +(defn mapcat-chain
  192.88 +  ^{:private true}
  192.89 +  [loc preds mkpred]
  192.90 +    (reduce (fn [prevseq expr]
  192.91 +                (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq))
  192.92 +            (list (with-meta loc (assoc (meta loc) :zip-filter/is-node? true)))
  192.93 +            preds))
  192.94 +
  192.95 +; see clojure.contrib.zip-filter.xml for examples
   193.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   193.2 +++ b/src/clojure/contrib/zip_filter/xml.clj	Sat Aug 21 06:25:44 2010 -0400
   193.3 @@ -0,0 +1,170 @@
   193.4 +;   Copyright (c) Chris Houser, April 2008. All rights reserved.
   193.5 +;   The use and distribution terms for this software are covered by the
   193.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   193.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   193.8 +;   By using this software in any fashion, you are agreeing to be bound by
   193.9 +;   the terms of this license.
  193.10 +;   You must not remove this notice, or any other, from this software.
  193.11 +
  193.12 +; Specialization of zip-filter for xml trees.
  193.13 +
  193.14 +(ns clojure.contrib.zip-filter.xml
  193.15 +    (:require [clojure.contrib.zip-filter :as zf]
  193.16 +              [clojure.zip :as zip]
  193.17 +              [clojure.xml :as xml]))
  193.18 +
  193.19 +(declare xml->)
  193.20 +
  193.21 +(defn attr
  193.22 +  "Returns the xml attribute named attrname, of the xml node at location loc."
  193.23 +  ([attrname]     (fn [loc] (attr loc attrname)))
  193.24 +  ([loc attrname] (when (zip/branch? loc) (-> loc zip/node :attrs attrname))))
  193.25 +
  193.26 +(defn attr=
  193.27 +  "Returns a query predicate that matches a node when it has an
  193.28 +  attribute named attrname whose value is attrval."
  193.29 +  [attrname attrval] (fn [loc] (= attrval (attr loc attrname))))
  193.30 +
  193.31 +(defn tag=
  193.32 +  "Returns a query predicate that matches a node when its is a tag
  193.33 +  named tagname."
  193.34 +  [tagname]
  193.35 +    (fn [loc]
  193.36 +      (filter #(and (zip/branch? %) (= tagname ((zip/node %) :tag)))
  193.37 +              (if (zf/auto? loc)
  193.38 +                (zf/children-auto loc)
  193.39 +                (list (zf/auto true loc))))))
  193.40 +
  193.41 +(defn text
  193.42 +  "Returns the textual contents of the given location, similar to
  193.43 +  xpaths's value-of"
  193.44 +  [loc]
  193.45 +    (.replaceAll
  193.46 +      ^String (apply str (xml-> loc zf/descendants zip/node string?))
  193.47 +      (str "[\\s" (char 160) "]+") " "))
  193.48 +
  193.49 +(defn text=
  193.50 +  "Returns a query predicate that matches a node when its textual
  193.51 +  content equals s."
  193.52 +  [s] (fn [loc] (= (text loc) s)))
  193.53 +
  193.54 +(defn seq-test
  193.55 +  "Returns a query predicate that matches a node when its xml content
  193.56 +  matches the query expresions given."
  193.57 +  ^{:private true}
  193.58 +  [preds] (fn [loc] (and (seq (apply xml-> loc preds)) (list loc))))
  193.59 +
  193.60 +(defn xml->
  193.61 +  "The loc is passed to the first predicate.  If the predicate returns
  193.62 +  a collection, each value of the collection is passed to the next
  193.63 +  predicate.  If it returns a location, the location is passed to the
  193.64 +  next predicate.  If it returns true, the input location is passed to
  193.65 +  the next predicate.  If it returns false or nil, the next predicate
  193.66 +  is not called.
  193.67 +
  193.68 +  This process is repeated, passing the processed results of each
  193.69 +  predicate to the next predicate.  xml-> returns the final sequence.
  193.70 +  The entire chain is evaluated lazily.
  193.71 +
  193.72 +  There are also special predicates: keywords are converted to tag=,
  193.73 +  strings to text=, and vectors to sub-queries that return true if
  193.74 +  they match.
  193.75 +
  193.76 +  See the footer of zip-query.clj for examples."
  193.77 +  [loc & preds]
  193.78 +    (zf/mapcat-chain loc preds
  193.79 +                     #(cond (keyword? %) (tag= %)
  193.80 +                            (string?  %) (text= %)
  193.81 +                            (vector?  %) (seq-test %))))
  193.82 +
  193.83 +(defn xml1->
  193.84 +  "Returns the first item from loc based on the query predicates
  193.85 +  given.  See xml->"
  193.86 +  [loc & preds] (first (apply xml-> loc preds)))
  193.87 +
  193.88 +
  193.89 +; === examples ===
  193.90 +
  193.91 +(comment
  193.92 +
  193.93 +(defn parse-str [s]
  193.94 +  (zip/xml-zip (xml/parse (new org.xml.sax.InputSource
  193.95 +                               (new java.io.StringReader s)))))
  193.96 +
  193.97 +(def atom1 (parse-str "<?xml version='1.0' encoding='UTF-8'?>
  193.98 +<feed xmlns='http://www.w3.org/2005/Atom'>
  193.99 +  <id>tag:blogger.com,1999:blog-28403206</id>
 193.100 +  <updated>2008-02-14T08:00:58.567-08:00</updated>
 193.101 +  <title type='text'>n01senet</title>
 193.102 +  <link rel='alternate' type='text/html' href='http://n01senet.blogspot.com/'/>
 193.103 +  <entry>
 193.104 +    <id>1</id>
 193.105 +    <published>2008-02-13</published>
 193.106 +    <title type='text'>clojure is the best lisp yet</title>
 193.107 +    <author><name>Chouser</name></author>
 193.108 +  </entry>
 193.109 +  <entry>
 193.110 +    <id>2</id>
 193.111 +    <published>2008-02-07</published>
 193.112 +    <title type='text'>experimenting with vnc</title>
 193.113 +    <author><name>agriffis</name></author>
 193.114 +  </entry>
 193.115 +</feed>
 193.116 +"))
 193.117 +
 193.118 +; simple single-function filter
 193.119 +(assert (= (xml-> atom1 #((zip/node %) :tag))
 193.120 +           '(:feed)))
 193.121 +
 193.122 +; two-stage filter using helpful query prediates
 193.123 +(assert (= (xml-> atom1 (tag= :title) text)
 193.124 +           '("n01senet")))
 193.125 +
 193.126 +; same filter as above, this time using keyword shortcut
 193.127 +(assert (= (xml-> atom1 :title text)
 193.128 +           '("n01senet")))
 193.129 +
 193.130 +; multi-stage filter
 193.131 +(assert (= (xml-> atom1 :entry :author :name text)
 193.132 +           '("Chouser" "agriffis")))
 193.133 +
 193.134 +; test xml1->
 193.135 +(assert (= (xml1-> atom1 :entry :author :name text)
 193.136 +           "Chouser"))
 193.137 +
 193.138 +; multi-stage filter with subquery specified using a vector
 193.139 +(assert (= (xml-> atom1 :entry [:author :name (text= "agriffis")]
 193.140 +                        :id text)
 193.141 +           '("2")))
 193.142 +
 193.143 +; same filter as above, this time using a string shortcut
 193.144 +(assert (= (xml-> atom1 :entry [:author :name "agriffis"] :id text)
 193.145 +           '("2")))
 193.146 +
 193.147 +; attribute access
 193.148 +(assert (= (xml-> atom1 :title (attr :type))
 193.149 +           '("text")))
 193.150 +
 193.151 +; attribute filtering
 193.152 +(assert (= (xml-> atom1 :link [(attr= :rel "alternate")] (attr :type))
 193.153 +           '("text/html")))
 193.154 +
 193.155 +; ancestors
 193.156 +(assert (= (xml-> atom1 zf/descendants :id "2" zf/ancestors zip/node #(:tag %))
 193.157 +           '(:id :entry :feed)))
 193.158 +
 193.159 +; ancestors with non-auto tag= (:entry), followed by auto tag= (:id)
 193.160 +(assert (= (xml-> atom1 zf/descendants :name "Chouser" zf/ancestors
 193.161 +                  :entry :id text)
 193.162 +           '("1")))
 193.163 +
 193.164 +; left-locs and detection of returning a single loc (zip/up)
 193.165 +(assert (= (xml-> atom1 zf/descendants :name "Chouser" zip/up
 193.166 +                  zf/left-locs :id text)
 193.167 +           '("1")))
 193.168 +
 193.169 +; right-locs
 193.170 +(assert (= (xml-> atom1 zf/descendants :id zf/right-locs :author text)
 193.171 +           '("Chouser" "agriffis")))
 193.172 +
 193.173 +)
   194.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   194.2 +++ b/src/clojure/core.clj	Sat Aug 21 06:25:44 2010 -0400
   194.3 @@ -0,0 +1,5710 @@
   194.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   194.5 +;   The use and distribution terms for this software are covered by the
   194.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   194.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   194.8 +;   By using this software in any fashion, you are agreeing to be bound by
   194.9 +;   the terms of this license.
  194.10 +;   You must not remove this notice, or any other, from this software.
  194.11 +
  194.12 +(ns clojure.core)
  194.13 +
  194.14 +(def unquote)
  194.15 +(def unquote-splicing)
  194.16 +
  194.17 +(def
  194.18 + ^{:arglists '([& items])
  194.19 +   :doc "Creates a new list containing the items."
  194.20 +   :added "1.0"}
  194.21 +  list (. clojure.lang.PersistentList creator))
  194.22 +
  194.23 +(def
  194.24 + ^{:arglists '([x seq])
  194.25 +    :doc "Returns a new seq where x is the first element and seq is
  194.26 +    the rest."
  194.27 +   :added "1.0"}
  194.28 +
  194.29 + cons (fn* cons [x seq] (. clojure.lang.RT (cons x seq))))
  194.30 +
  194.31 +;during bootstrap we don't have destructuring let, loop or fn, will redefine later
  194.32 +(def
  194.33 +  ^{:macro true
  194.34 +    :added "1.0"}
  194.35 +  let (fn* let [&form &env & decl] (cons 'let* decl)))
  194.36 +
  194.37 +(def
  194.38 + ^{:macro true
  194.39 +   :added "1.0"}
  194.40 + loop (fn* loop [&form &env & decl] (cons 'loop* decl)))
  194.41 +
  194.42 +(def
  194.43 + ^{:macro true
  194.44 +   :added "1.0"}
  194.45 + fn (fn* fn [&form &env & decl] 
  194.46 +         (.withMeta ^clojure.lang.IObj (cons 'fn* decl) 
  194.47 +                    (.meta ^clojure.lang.IMeta &form))))
  194.48 +
  194.49 +(def
  194.50 + ^{:arglists '([coll])
  194.51 +   :doc "Returns the first item in the collection. Calls seq on its
  194.52 +    argument. If coll is nil, returns nil."
  194.53 +   :added "1.0"}
  194.54 + first (fn first [coll] (. clojure.lang.RT (first coll))))
  194.55 +
  194.56 +(def
  194.57 + ^{:arglists '([coll])
  194.58 +   :tag clojure.lang.ISeq
  194.59 +   :doc "Returns a seq of the items after the first. Calls seq on its
  194.60 +  argument.  If there are no more items, returns nil."
  194.61 +   :added "1.0"}  
  194.62 + next (fn next [x] (. clojure.lang.RT (next x))))
  194.63 +
  194.64 +(def
  194.65 + ^{:arglists '([coll])
  194.66 +   :tag clojure.lang.ISeq
  194.67 +   :doc "Returns a possibly empty seq of the items after the first. Calls seq on its
  194.68 +  argument."
  194.69 +   :added "1.0"}  
  194.70 + rest (fn rest [x] (. clojure.lang.RT (more x))))
  194.71 +
  194.72 +(def
  194.73 + ^{:arglists '([coll x] [coll x & xs])
  194.74 +   :doc "conj[oin]. Returns a new collection with the xs
  194.75 +    'added'. (conj nil item) returns (item).  The 'addition' may
  194.76 +    happen at different 'places' depending on the concrete type."
  194.77 +   :added "1.0"}
  194.78 + conj (fn conj 
  194.79 +        ([coll x] (. clojure.lang.RT (conj coll x)))
  194.80 +        ([coll x & xs]
  194.81 +         (if xs
  194.82 +           (recur (conj coll x) (first xs) (next xs))
  194.83 +           (conj coll x)))))
  194.84 +
  194.85 +(def
  194.86 + ^{:doc "Same as (first (next x))"
  194.87 +   :arglists '([x])
  194.88 +   :added "1.0"}
  194.89 + second (fn second [x] (first (next x))))
  194.90 +
  194.91 +(def
  194.92 + ^{:doc "Same as (first (first x))"
  194.93 +   :arglists '([x])
  194.94 +   :added "1.0"}
  194.95 + ffirst (fn ffirst [x] (first (first x))))
  194.96 +
  194.97 +(def
  194.98 + ^{:doc "Same as (next (first x))"
  194.99 +   :arglists '([x])
 194.100 +   :added "1.0"}
 194.101 + nfirst (fn nfirst [x] (next (first x))))
 194.102 +
 194.103 +(def
 194.104 + ^{:doc "Same as (first (next x))"
 194.105 +   :arglists '([x])
 194.106 +   :added "1.0"}
 194.107 + fnext (fn fnext [x] (first (next x))))
 194.108 +
 194.109 +(def
 194.110 + ^{:doc "Same as (next (next x))"
 194.111 +   :arglists '([x])
 194.112 +   :added "1.0"}
 194.113 + nnext (fn nnext [x] (next (next x))))
 194.114 +
 194.115 +(def
 194.116 + ^{:arglists '([coll])
 194.117 +   :doc "Returns a seq on the collection. If the collection is
 194.118 +    empty, returns nil.  (seq nil) returns nil. seq also works on
 194.119 +    Strings, native Java arrays (of reference types) and any objects
 194.120 +    that implement Iterable."
 194.121 +   :tag clojure.lang.ISeq
 194.122 +   :added "1.0"}
 194.123 + seq (fn seq [coll] (. clojure.lang.RT (seq coll))))
 194.124 +
 194.125 +(def
 194.126 + ^{:arglists '([^Class c x])
 194.127 +   :doc "Evaluates x and tests if it is an instance of the class
 194.128 +    c. Returns true or false"
 194.129 +   :added "1.0"}
 194.130 + instance? (fn instance? [^Class c x] (. c (isInstance x))))
 194.131 +
 194.132 +(def
 194.133 + ^{:arglists '([x])
 194.134 +   :doc "Return true if x implements ISeq"
 194.135 +   :added "1.0"}
 194.136 + seq? (fn seq? [x] (instance? clojure.lang.ISeq x)))
 194.137 +
 194.138 +(def
 194.139 + ^{:arglists '([x])
 194.140 +   :doc "Return true if x is a Character"
 194.141 +   :added "1.0"}
 194.142 + char? (fn char? [x] (instance? Character x)))
 194.143 +
 194.144 +(def
 194.145 + ^{:arglists '([x])
 194.146 +   :doc "Return true if x is a String"
 194.147 +   :added "1.0"}
 194.148 + string? (fn string? [x] (instance? String x)))
 194.149 +
 194.150 +(def
 194.151 + ^{:arglists '([x])
 194.152 +   :doc "Return true if x implements IPersistentMap"
 194.153 +   :added "1.0"}
 194.154 + map? (fn map? [x] (instance? clojure.lang.IPersistentMap x)))
 194.155 +
 194.156 +(def
 194.157 + ^{:arglists '([x])
 194.158 +   :doc "Return true if x implements IPersistentVector"
 194.159 +   :added "1.0"}
 194.160 + vector? (fn vector? [x] (instance? clojure.lang.IPersistentVector x)))
 194.161 +
 194.162 +(def
 194.163 + ^{:arglists '([map key val] [map key val & kvs])
 194.164 +   :doc "assoc[iate]. When applied to a map, returns a new map of the
 194.165 +    same (hashed/sorted) type, that contains the mapping of key(s) to
 194.166 +    val(s). When applied to a vector, returns a new vector that
 194.167 +    contains val at index. Note - index must be <= (count vector)."
 194.168 +   :added "1.0"}
 194.169 + assoc
 194.170 + (fn assoc
 194.171 +   ([map key val] (. clojure.lang.RT (assoc map key val)))
 194.172 +   ([map key val & kvs]
 194.173 +    (let [ret (assoc map key val)]
 194.174 +      (if kvs
 194.175 +        (recur ret (first kvs) (second kvs) (nnext kvs))
 194.176 +        ret)))))
 194.177 +
 194.178 +;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 194.179 +(def
 194.180 + ^{:arglists '([obj])
 194.181 +   :doc "Returns the metadata of obj, returns nil if there is no metadata."
 194.182 +   :added "1.0"}
 194.183 + meta (fn meta [x]
 194.184 +        (if (instance? clojure.lang.IMeta x)
 194.185 +          (. ^clojure.lang.IMeta x (meta)))))
 194.186 +
 194.187 +(def
 194.188 + ^{:arglists '([^clojure.lang.IObj obj m])
 194.189 +   :doc "Returns an object of the same type and value as obj, with
 194.190 +    map m as its metadata."
 194.191 +   :added "1.0"}
 194.192 + with-meta (fn with-meta [^clojure.lang.IObj x m]
 194.193 +             (. x (withMeta m))))
 194.194 +
 194.195 +(def ^{:private true :dynamic true}
 194.196 +  assert-valid-fdecl (fn [fdecl]))
 194.197 +
 194.198 +(def
 194.199 + ^{:private true}
 194.200 + sigs
 194.201 + (fn [fdecl]
 194.202 +   (assert-valid-fdecl fdecl)
 194.203 +   (let [asig 
 194.204 +         (fn [fdecl]
 194.205 +           (let [arglist (first fdecl)
 194.206 +                 ;elide implicit macro args
 194.207 +                 arglist (if (clojure.lang.Util/equals '&form (first arglist)) 
 194.208 +                           (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist))
 194.209 +                           arglist)
 194.210 +                 body (next fdecl)]
 194.211 +             (if (map? (first body))
 194.212 +               (if (next body)
 194.213 +                 (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body)))
 194.214 +                 arglist)
 194.215 +               arglist)))]
 194.216 +     (if (seq? (first fdecl))
 194.217 +       (loop [ret [] fdecls fdecl]
 194.218 +         (if fdecls
 194.219 +           (recur (conj ret (asig (first fdecls))) (next fdecls))
 194.220 +           (seq ret)))
 194.221 +       (list (asig fdecl))))))
 194.222 +
 194.223 +
 194.224 +(def 
 194.225 + ^{:arglists '([coll])
 194.226 +   :doc "Return the last item in coll, in linear time"
 194.227 +   :added "1.0"}
 194.228 + last (fn last [s]
 194.229 +        (if (next s)
 194.230 +          (recur (next s))
 194.231 +          (first s))))
 194.232 +
 194.233 +(def 
 194.234 + ^{:arglists '([coll])
 194.235 +   :doc "Return a seq of all but the last item in coll, in linear time"
 194.236 +   :added "1.0"}
 194.237 + butlast (fn butlast [s]
 194.238 +           (loop [ret [] s s]
 194.239 +             (if (next s)
 194.240 +               (recur (conj ret (first s)) (next s))
 194.241 +               (seq ret)))))
 194.242 +
 194.243 +(def 
 194.244 +
 194.245 + ^{:doc "Same as (def name (fn [params* ] exprs*)) or (def
 194.246 +    name (fn ([params* ] exprs*)+)) with any doc-string or attrs added
 194.247 +    to the var metadata"
 194.248 +   :arglists '([name doc-string? attr-map? [params*] body]
 194.249 +                [name doc-string? attr-map? ([params*] body)+ attr-map?])
 194.250 +   :added "1.0"}
 194.251 + defn (fn defn [&form &env name & fdecl]
 194.252 +        (let [m (if (string? (first fdecl))
 194.253 +                  {:doc (first fdecl)}
 194.254 +                  {})
 194.255 +              fdecl (if (string? (first fdecl))
 194.256 +                      (next fdecl)
 194.257 +                      fdecl)
 194.258 +              m (if (map? (first fdecl))
 194.259 +                  (conj m (first fdecl))
 194.260 +                  m)
 194.261 +              fdecl (if (map? (first fdecl))
 194.262 +                      (next fdecl)
 194.263 +                      fdecl)
 194.264 +              fdecl (if (vector? (first fdecl))
 194.265 +                      (list fdecl)
 194.266 +                      fdecl)
 194.267 +              m (if (map? (last fdecl))
 194.268 +                  (conj m (last fdecl))
 194.269 +                  m)
 194.270 +              fdecl (if (map? (last fdecl))
 194.271 +                      (butlast fdecl)
 194.272 +                      fdecl)
 194.273 +              m (conj {:arglists (list 'quote (sigs fdecl))} m)
 194.274 +              m (let [inline (:inline m)
 194.275 +                      ifn (first inline)
 194.276 +                      iname (second inline)]
 194.277 +                  ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
 194.278 +                  (if (if (clojure.lang.Util/equiv 'fn ifn)
 194.279 +                        (if (instance? clojure.lang.Symbol iname) false true))
 194.280 +                    ;; inserts the same fn name to the inline fn if it does not have one
 194.281 +                    (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName name) "__inliner"))
 194.282 +                                                     (next inline))))
 194.283 +                    m))
 194.284 +              m (conj (if (meta name) (meta name) {}) m)]
 194.285 +          (list 'def (with-meta name m)
 194.286 +                (list '.withMeta (cons `fn (cons name fdecl)) (list '.meta (list 'var name)))))))
 194.287 +
 194.288 +(. (var defn) (setMacro))
 194.289 +
 194.290 +(defn cast
 194.291 +  "Throws a ClassCastException if x is not a c, else returns x."
 194.292 +  {:added "1.0"}
 194.293 +  [^Class c x] 
 194.294 +  (. c (cast x)))
 194.295 +
 194.296 +(defn to-array
 194.297 +  "Returns an array of Objects containing the contents of coll, which
 194.298 +  can be any Collection.  Maps to java.util.Collection.toArray()."
 194.299 +  {:tag "[Ljava.lang.Object;"
 194.300 +   :added "1.0"}
 194.301 +  [coll] (. clojure.lang.RT (toArray coll)))
 194.302 + 
 194.303 +(defn vector
 194.304 +  "Creates a new vector containing the args."
 194.305 +  {:added "1.0"}
 194.306 +  ([] [])
 194.307 +  ([a] [a])
 194.308 +  ([a b] [a b])
 194.309 +  ([a b c] [a b c])
 194.310 +  ([a b c d] [a b c d])
 194.311 +  ([a b c d & args]
 194.312 +     (. clojure.lang.LazilyPersistentVector (create (cons a (cons b (cons c (cons d args))))))))
 194.313 +
 194.314 +(defn vec
 194.315 +  "Creates a new vector containing the contents of coll."
 194.316 +  {:added "1.0"}
 194.317 +  ([coll]
 194.318 +   (if (instance? java.util.Collection coll)
 194.319 +     (clojure.lang.LazilyPersistentVector/create coll)
 194.320 +     (. clojure.lang.LazilyPersistentVector (createOwning (to-array coll))))))
 194.321 +
 194.322 +(defn hash-map
 194.323 +  "keyval => key val
 194.324 +  Returns a new hash map with supplied mappings."
 194.325 +  {:added "1.0"}
 194.326 +  ([] {})
 194.327 +  ([& keyvals]
 194.328 +   (. clojure.lang.PersistentHashMap (createWithCheck keyvals))))
 194.329 +
 194.330 +(defn hash-set
 194.331 +  "Returns a new hash set with supplied keys."
 194.332 +  {:added "1.0"}
 194.333 +  ([] #{})
 194.334 +  ([& keys]
 194.335 +   (clojure.lang.PersistentHashSet/createWithCheck keys)))
 194.336 +
 194.337 +(defn sorted-map
 194.338 +  "keyval => key val
 194.339 +  Returns a new sorted map with supplied mappings."
 194.340 +  {:added "1.0"}
 194.341 +  ([& keyvals]
 194.342 +   (clojure.lang.PersistentTreeMap/create keyvals)))
 194.343 +
 194.344 +(defn sorted-map-by
 194.345 +  "keyval => key val
 194.346 +  Returns a new sorted map with supplied mappings, using the supplied comparator."
 194.347 +  {:added "1.0"}
 194.348 +  ([comparator & keyvals]
 194.349 +   (clojure.lang.PersistentTreeMap/create comparator keyvals)))
 194.350 +
 194.351 +(defn sorted-set
 194.352 +  "Returns a new sorted set with supplied keys."
 194.353 +  {:added "1.0"}
 194.354 +  ([& keys]
 194.355 +   (clojure.lang.PersistentTreeSet/create keys)))
 194.356 +
 194.357 +(defn sorted-set-by
 194.358 +  "Returns a new sorted set with supplied keys, using the supplied comparator."
 194.359 +  {:added "1.1"} 
 194.360 +  ([comparator & keys]
 194.361 +   (clojure.lang.PersistentTreeSet/create comparator keys)))
 194.362 +
 194.363 + 
 194.364 +;;;;;;;;;;;;;;;;;;;;
 194.365 +(defn nil?
 194.366 +  "Returns true if x is nil, false otherwise."
 194.367 +  {:tag Boolean
 194.368 +   :added "1.0"}
 194.369 +  [x] (clojure.lang.Util/identical x nil))
 194.370 +
 194.371 +(def
 194.372 +
 194.373 + ^{:doc "Like defn, but the resulting function name is declared as a
 194.374 +  macro and will be used as a macro by the compiler when it is
 194.375 +  called."
 194.376 +   :arglists '([name doc-string? attr-map? [params*] body]
 194.377 +                 [name doc-string? attr-map? ([params*] body)+ attr-map?])
 194.378 +   :added "1.0"}
 194.379 + defmacro (fn [&form &env 
 194.380 +                name & args]
 194.381 +             (let [prefix (loop [p (list name) args args]
 194.382 +                            (let [f (first args)]
 194.383 +                              (if (string? f)
 194.384 +                                (recur (cons f p) (next args))
 194.385 +                                (if (map? f)
 194.386 +                                  (recur (cons f p) (next args))
 194.387 +                                  p))))
 194.388 +                   fdecl (loop [fd args]
 194.389 +                           (if (string? (first fd))
 194.390 +                             (recur (next fd))
 194.391 +                             (if (map? (first fd))
 194.392 +                               (recur (next fd))
 194.393 +                               fd)))
 194.394 +                   fdecl (if (vector? (first fdecl))
 194.395 +                           (list fdecl)
 194.396 +                           fdecl)
 194.397 +                   add-implicit-args (fn [fd]
 194.398 +                             (let [args (first fd)]
 194.399 +                               (cons (vec (cons '&form (cons '&env args))) (next fd))))
 194.400 +                   add-args (fn [acc ds]
 194.401 +                              (if (nil? ds)
 194.402 +                                acc
 194.403 +                                (let [d (first ds)]
 194.404 +                                  (if (map? d)
 194.405 +                                    (conj acc d)
 194.406 +                                    (recur (conj acc (add-implicit-args d)) (next ds))))))
 194.407 +                   fdecl (seq (add-args [] fdecl))
 194.408 +                   decl (loop [p prefix d fdecl]
 194.409 +                          (if p
 194.410 +                            (recur (next p) (cons (first p) d))
 194.411 +                            d))]
 194.412 +               (list 'do
 194.413 +                     (cons `defn decl)
 194.414 +                     (list '. (list 'var name) '(setMacro))
 194.415 +                     (list 'var name)))))
 194.416 +
 194.417 +
 194.418 +(. (var defmacro) (setMacro))
 194.419 +
 194.420 +(defmacro when
 194.421 +  "Evaluates test. If logical true, evaluates body in an implicit do."
 194.422 +  {:added "1.0"}
 194.423 +  [test & body]
 194.424 +  (list 'if test (cons 'do body)))
 194.425 +
 194.426 +(defmacro when-not
 194.427 +  "Evaluates test. If logical false, evaluates body in an implicit do."
 194.428 +  {:added "1.0"}
 194.429 +  [test & body]
 194.430 +    (list 'if test nil (cons 'do body)))
 194.431 +
 194.432 +(defn false?
 194.433 +  "Returns true if x is the value false, false otherwise."
 194.434 +  {:tag Boolean,
 194.435 +   :added "1.0"}
 194.436 +  [x] (clojure.lang.Util/identical x false))
 194.437 +
 194.438 +(defn true?
 194.439 +  "Returns true if x is the value true, false otherwise."
 194.440 +  {:tag Boolean,
 194.441 +   :added "1.0"}
 194.442 +  [x] (clojure.lang.Util/identical x true))
 194.443 +
 194.444 +(defn not
 194.445 +  "Returns true if x is logical false, false otherwise."
 194.446 +  {:tag Boolean
 194.447 +   :added "1.0"}
 194.448 +  [x] (if x false true))
 194.449 +
 194.450 +(defn str
 194.451 +  "With no args, returns the empty string. With one arg x, returns
 194.452 +  x.toString().  (str nil) returns the empty string. With more than
 194.453 +  one arg, returns the concatenation of the str values of the args."
 194.454 +  {:tag String
 194.455 +   :added "1.0"}
 194.456 +  ([] "")
 194.457 +  ([^Object x]
 194.458 +   (if (nil? x) "" (. x (toString))))
 194.459 +  ([x & ys]
 194.460 +     ((fn [^StringBuilder sb more]
 194.461 +          (if more
 194.462 +            (recur (. sb  (append (str (first more)))) (next more))
 194.463 +            (str sb)))
 194.464 +      (new StringBuilder ^String (str x)) ys)))
 194.465 +
 194.466 +
 194.467 +(defn symbol?
 194.468 +  "Return true if x is a Symbol"
 194.469 +  {:added "1.0"}
 194.470 +  [x] (instance? clojure.lang.Symbol x))
 194.471 +
 194.472 +(defn keyword?
 194.473 +  "Return true if x is a Keyword"
 194.474 +  {:added "1.0"}
 194.475 +  [x] (instance? clojure.lang.Keyword x))
 194.476 +
 194.477 +(defn symbol
 194.478 +  "Returns a Symbol with the given namespace and name."
 194.479 +  {:tag clojure.lang.Symbol
 194.480 +   :added "1.0"}
 194.481 +  ([name] (if (symbol? name) name (clojure.lang.Symbol/intern name)))
 194.482 +  ([ns name] (clojure.lang.Symbol/intern ns name)))
 194.483 +
 194.484 +(defn gensym
 194.485 +  "Returns a new symbol with a unique name. If a prefix string is
 194.486 +  supplied, the name is prefix# where # is some unique number. If
 194.487 +  prefix is not supplied, the prefix is 'G__'."
 194.488 +  {:added "1.0"}
 194.489 +  ([] (gensym "G__"))
 194.490 +  ([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID))))))))
 194.491 +
 194.492 +(defmacro cond
 194.493 +  "Takes a set of test/expr pairs. It evaluates each test one at a
 194.494 +  time.  If a test returns logical true, cond evaluates and returns
 194.495 +  the value of the corresponding expr and doesn't evaluate any of the
 194.496 +  other tests or exprs. (cond) returns nil."
 194.497 +  {:added "1.0"}
 194.498 +  [& clauses]
 194.499 +    (when clauses
 194.500 +      (list 'if (first clauses)
 194.501 +            (if (next clauses)
 194.502 +                (second clauses)
 194.503 +                (throw (IllegalArgumentException.
 194.504 +                         "cond requires an even number of forms")))
 194.505 +            (cons 'clojure.core/cond (next (next clauses))))))
 194.506 +
 194.507 +(defn keyword
 194.508 +  "Returns a Keyword with the given namespace and name.  Do not use :
 194.509 +  in the keyword strings, it will be added automatically."
 194.510 +  {:tag clojure.lang.Keyword
 194.511 +   :added "1.0"}
 194.512 +  ([name] (cond (keyword? name) name
 194.513 +                (symbol? name) (clojure.lang.Keyword/intern ^clojure.lang.Symbol name)
 194.514 +                (string? name) (clojure.lang.Keyword/intern ^String name)))
 194.515 +  ([ns name] (clojure.lang.Keyword/intern ns name)))
 194.516 +
 194.517 +(defn spread
 194.518 +  {:private true}
 194.519 +  [arglist]
 194.520 +  (cond
 194.521 +   (nil? arglist) nil
 194.522 +   (nil? (next arglist)) (seq (first arglist))
 194.523 +   :else (cons (first arglist) (spread (next arglist)))))
 194.524 +
 194.525 +(defn list*
 194.526 +  "Creates a new list containing the items prepended to the rest, the
 194.527 +  last of which will be treated as a sequence."
 194.528 +  {:added "1.0"}
 194.529 +  ([args] (seq args))
 194.530 +  ([a args] (cons a args))
 194.531 +  ([a b args] (cons a (cons b args)))
 194.532 +  ([a b c args] (cons a (cons b (cons c args))))
 194.533 +  ([a b c d & more]
 194.534 +     (cons a (cons b (cons c (cons d (spread more)))))))
 194.535 +
 194.536 +(defn apply
 194.537 +  "Applies fn f to the argument list formed by prepending args to argseq."
 194.538 +  {:arglists '([f args* argseq])
 194.539 +   :added "1.0"}
 194.540 +  ([^clojure.lang.IFn f args]
 194.541 +     (. f (applyTo (seq args))))
 194.542 +  ([^clojure.lang.IFn f x args]
 194.543 +     (. f (applyTo (list* x args))))
 194.544 +  ([^clojure.lang.IFn f x y args]
 194.545 +     (. f (applyTo (list* x y args))))
 194.546 +  ([^clojure.lang.IFn f x y z args]
 194.547 +     (. f (applyTo (list* x y z args))))
 194.548 +  ([^clojure.lang.IFn f a b c d & args]
 194.549 +     (. f (applyTo (cons a (cons b (cons c (cons d (spread args)))))))))
 194.550 +
 194.551 +(defn vary-meta
 194.552 + "Returns an object of the same type and value as obj, with
 194.553 +  (apply f (meta obj) args) as its metadata."
 194.554 + {:added "1.0"}
 194.555 + [obj f & args]
 194.556 +  (with-meta obj (apply f (meta obj) args)))
 194.557 +
 194.558 +(defmacro lazy-seq
 194.559 +  "Takes a body of expressions that returns an ISeq or nil, and yields
 194.560 +  a Seqable object that will invoke the body only the first time seq
 194.561 +  is called, and will cache the result and return it on all subsequent
 194.562 +  seq calls."
 194.563 +  {:added "1.0"}
 194.564 +  [& body]
 194.565 +  (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body)))    
 194.566 +
 194.567 +(defn ^clojure.lang.ChunkBuffer chunk-buffer [capacity]
 194.568 +  (clojure.lang.ChunkBuffer. capacity))
 194.569 +
 194.570 +(defn chunk-append [^clojure.lang.ChunkBuffer b x]
 194.571 +  (.add b x))
 194.572 +
 194.573 +(defn chunk [^clojure.lang.ChunkBuffer b]
 194.574 +  (.chunk b))
 194.575 +
 194.576 +(defn ^clojure.lang.IChunk chunk-first [^clojure.lang.IChunkedSeq s]
 194.577 +  (.chunkedFirst s))
 194.578 +
 194.579 +(defn ^clojure.lang.ISeq chunk-rest [^clojure.lang.IChunkedSeq s]
 194.580 +  (.chunkedMore s))
 194.581 +
 194.582 +(defn ^clojure.lang.ISeq chunk-next [^clojure.lang.IChunkedSeq s]
 194.583 +  (.chunkedNext s))
 194.584 +
 194.585 +(defn chunk-cons [chunk rest]
 194.586 +  (if (clojure.lang.Numbers/isZero (clojure.lang.RT/count chunk))
 194.587 +    rest
 194.588 +    (clojure.lang.ChunkedCons. chunk rest)))
 194.589 +  
 194.590 +(defn chunked-seq? [s]
 194.591 +  (instance? clojure.lang.IChunkedSeq s))
 194.592 +
 194.593 +(defn concat
 194.594 +  "Returns a lazy seq representing the concatenation of the elements in the supplied colls."
 194.595 +  {:added "1.0"}
 194.596 +  ([] (lazy-seq nil))
 194.597 +  ([x] (lazy-seq x))
 194.598 +  ([x y]
 194.599 +    (lazy-seq
 194.600 +      (let [s (seq x)]
 194.601 +        (if s
 194.602 +          (if (chunked-seq? s)
 194.603 +            (chunk-cons (chunk-first s) (concat (chunk-rest s) y))
 194.604 +            (cons (first s) (concat (rest s) y)))
 194.605 +          y))))
 194.606 +  ([x y & zs]
 194.607 +     (let [cat (fn cat [xys zs]
 194.608 +                 (lazy-seq
 194.609 +                   (let [xys (seq xys)]
 194.610 +                     (if xys
 194.611 +                       (if (chunked-seq? xys)
 194.612 +                         (chunk-cons (chunk-first xys)
 194.613 +                                     (cat (chunk-rest xys) zs))
 194.614 +                         (cons (first xys) (cat (rest xys) zs)))
 194.615 +                       (when zs
 194.616 +                         (cat (first zs) (next zs)))))))]
 194.617 +       (cat (concat x y) zs))))
 194.618 +
 194.619 +;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;;
 194.620 +(defmacro delay
 194.621 +  "Takes a body of expressions and yields a Delay object that will
 194.622 +  invoke the body only the first time it is forced (with force or deref/@), and
 194.623 +  will cache the result and return it on all subsequent force
 194.624 +  calls."
 194.625 +  {:added "1.0"}
 194.626 +  [& body]
 194.627 +    (list 'new 'clojure.lang.Delay (list* `^{:once true} fn* [] body)))
 194.628 +
 194.629 +(defn delay?
 194.630 +  "returns true if x is a Delay created with delay"
 194.631 +  {:added "1.0"}
 194.632 +  [x] (instance? clojure.lang.Delay x))
 194.633 +
 194.634 +(defn force
 194.635 +  "If x is a Delay, returns the (possibly cached) value of its expression, else returns x"
 194.636 +  {:added "1.0"}
 194.637 +  [x] (. clojure.lang.Delay (force x)))
 194.638 +
 194.639 +(defmacro if-not
 194.640 +  "Evaluates test. If logical false, evaluates and returns then expr, 
 194.641 +  otherwise else expr, if supplied, else nil."
 194.642 +  {:added "1.0"}
 194.643 +  ([test then] `(if-not ~test ~then nil))
 194.644 +  ([test then else]
 194.645 +   `(if (not ~test) ~then ~else)))
 194.646 +
 194.647 +(defn identical?
 194.648 +  "Tests if 2 arguments are the same object"
 194.649 +  {:inline (fn [x y] `(. clojure.lang.Util identical ~x ~y))
 194.650 +   :inline-arities #{2}
 194.651 +   :added "1.0"}
 194.652 +  ([x y] (clojure.lang.Util/identical x y)))
 194.653 +
 194.654 +(defn =
 194.655 +  "Equality. Returns true if x equals y, false if not. Same as
 194.656 +  Java x.equals(y) except it also works for nil, and compares
 194.657 +  numbers and collections in a type-independent manner.  Clojure's immutable data
 194.658 +  structures define equals() (and thus =) as a value, not an identity,
 194.659 +  comparison."
 194.660 +  {:inline (fn [x y] `(. clojure.lang.Util equiv ~x ~y))
 194.661 +   :inline-arities #{2}
 194.662 +   :added "1.0"}
 194.663 +  ([x] true)
 194.664 +  ([x y] (clojure.lang.Util/equiv x y))
 194.665 +  ([x y & more]
 194.666 +   (if (= x y)
 194.667 +     (if (next more)
 194.668 +       (recur y (first more) (next more))
 194.669 +       (= y (first more)))
 194.670 +     false)))
 194.671 +
 194.672 +(defn not=
 194.673 +  "Same as (not (= obj1 obj2))"
 194.674 +  {:tag Boolean
 194.675 +   :added "1.0"}
 194.676 +  ([x] false)
 194.677 +  ([x y] (not (= x y)))
 194.678 +  ([x y & more]
 194.679 +   (not (apply = x y more))))
 194.680 +
 194.681 +
 194.682 +
 194.683 +(defn compare
 194.684 +  "Comparator. Returns a negative number, zero, or a positive number
 194.685 +  when x is logically 'less than', 'equal to', or 'greater than'
 194.686 +  y. Same as Java x.compareTo(y) except it also works for nil, and
 194.687 +  compares numbers and collections in a type-independent manner. x
 194.688 +  must implement Comparable"
 194.689 +  {
 194.690 +   :inline (fn [x y] `(. clojure.lang.Util compare ~x ~y))
 194.691 +   :added "1.0"}
 194.692 +  [x y] (. clojure.lang.Util (compare x y)))
 194.693 +
 194.694 +(defmacro and
 194.695 +  "Evaluates exprs one at a time, from left to right. If a form
 194.696 +  returns logical false (nil or false), and returns that value and
 194.697 +  doesn't evaluate any of the other expressions, otherwise it returns
 194.698 +  the value of the last expr. (and) returns true."
 194.699 +  {:added "1.0"}
 194.700 +  ([] true)
 194.701 +  ([x] x)
 194.702 +  ([x & next]
 194.703 +   `(let [and# ~x]
 194.704 +      (if and# (and ~@next) and#))))
 194.705 +
 194.706 +(defmacro or
 194.707 +  "Evaluates exprs one at a time, from left to right. If a form
 194.708 +  returns a logical true value, or returns that value and doesn't
 194.709 +  evaluate any of the other expressions, otherwise it returns the
 194.710 +  value of the last expression. (or) returns nil."
 194.711 +  {:added "1.0"}
 194.712 +  ([] nil)
 194.713 +  ([x] x)
 194.714 +  ([x & next]
 194.715 +      `(let [or# ~x]
 194.716 +         (if or# or# (or ~@next)))))
 194.717 +
 194.718 +;;;;;;;;;;;;;;;;;;; sequence fns  ;;;;;;;;;;;;;;;;;;;;;;;
 194.719 +(defn zero?
 194.720 +  "Returns true if num is zero, else false"
 194.721 +  {
 194.722 +   :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x)))
 194.723 +   :added "1.0"}
 194.724 +  [x] (. clojure.lang.Numbers (isZero x)))
 194.725 +
 194.726 +(defn count
 194.727 +  "Returns the number of items in the collection. (count nil) returns
 194.728 +  0.  Also works on strings, arrays, and Java Collections and Maps"
 194.729 +  {
 194.730 +   :inline (fn  [x] `(. clojure.lang.RT (count ~x)))
 194.731 +   :added "1.0"}
 194.732 +  [coll] (clojure.lang.RT/count coll))
 194.733 +
 194.734 +(defn int
 194.735 +  "Coerce to int"
 194.736 +  {
 194.737 +   :inline (fn  [x] `(. clojure.lang.RT (intCast ~x)))
 194.738 +   :added "1.0"}
 194.739 +  [x] (. clojure.lang.RT (intCast x)))
 194.740 +
 194.741 +(defn nth
 194.742 +  "Returns the value at the index. get returns nil if index out of
 194.743 +  bounds, nth throws an exception unless not-found is supplied.  nth
 194.744 +  also works for strings, Java arrays, regex Matchers and Lists, and,
 194.745 +  in O(n) time, for sequences."
 194.746 +  {:inline (fn  [c i & nf] `(. clojure.lang.RT (nth ~c ~i ~@nf)))
 194.747 +   :inline-arities #{2 3}
 194.748 +   :added "1.0"}
 194.749 +  ([coll index] (. clojure.lang.RT (nth coll index)))
 194.750 +  ([coll index not-found] (. clojure.lang.RT (nth coll index not-found))))
 194.751 +
 194.752 +(defn <
 194.753 +  "Returns non-nil if nums are in monotonically increasing order,
 194.754 +  otherwise false."
 194.755 +  {:inline (fn [x y] `(. clojure.lang.Numbers (lt ~x ~y)))
 194.756 +   :inline-arities #{2}
 194.757 +   :added "1.0"}
 194.758 +  ([x] true)
 194.759 +  ([x y] (. clojure.lang.Numbers (lt x y)))
 194.760 +  ([x y & more]
 194.761 +   (if (< x y)
 194.762 +     (if (next more)
 194.763 +       (recur y (first more) (next more))
 194.764 +       (< y (first more)))
 194.765 +     false)))
 194.766 +
 194.767 +(defn inc
 194.768 +  "Returns a number one greater than num."
 194.769 +  {:inline (fn [x] `(. clojure.lang.Numbers (inc ~x)))
 194.770 +   :added "1.0"}
 194.771 +  [x] (. clojure.lang.Numbers (inc x)))
 194.772 +
 194.773 +;; reduce is defined again later after InternalReduce loads
 194.774 +(def
 194.775 +    ^{:arglists '([f coll] [f val coll])
 194.776 +      :doc "f should be a function of 2 arguments. If val is not supplied,
 194.777 +  returns the result of applying f to the first 2 items in coll, then
 194.778 +  applying f to that result and the 3rd item, etc. If coll contains no
 194.779 +  items, f must accept no arguments as well, and reduce returns the
 194.780 +  result of calling f with no arguments.  If coll has only 1 item, it
 194.781 +  is returned and f is not called.  If val is supplied, returns the
 194.782 +  result of applying f to val and the first item in coll, then
 194.783 +  applying f to that result and the 2nd item, etc. If coll contains no
 194.784 +  items, returns val and f is not called."
 194.785 +      :added "1.0"}    
 194.786 +    reduce
 194.787 +     (fn r
 194.788 +       ([f coll]
 194.789 +             (let [s (seq coll)]
 194.790 +               (if s
 194.791 +                 (r f (first s) (next s))
 194.792 +                 (f))))
 194.793 +       ([f val coll]
 194.794 +          (let [s (seq coll)]
 194.795 +            (if s
 194.796 +              (if (chunked-seq? s)
 194.797 +                (recur f 
 194.798 +                       (.reduce (chunk-first s) f val)
 194.799 +                       (chunk-next s))
 194.800 +                (recur f (f val (first s)) (next s)))
 194.801 +              val)))))
 194.802 +
 194.803 +(defn reverse
 194.804 +  "Returns a seq of the items in coll in reverse order. Not lazy."
 194.805 +  {:added "1.0"}
 194.806 +  [coll]
 194.807 +    (reduce conj () coll))
 194.808 +
 194.809 +;;math stuff
 194.810 +(defn +
 194.811 +  "Returns the sum of nums. (+) returns 0."
 194.812 +  {:inline (fn [x y] `(. clojure.lang.Numbers (add ~x ~y)))
 194.813 +   :inline-arities #{2}
 194.814 +   :added "1.0"}
 194.815 +  ([] 0)
 194.816 +  ([x] (cast Number x))
 194.817 +  ([x y] (. clojure.lang.Numbers (add x y)))
 194.818 +  ([x y & more]
 194.819 +   (reduce + (+ x y) more)))
 194.820 +
 194.821 +(defn *
 194.822 +  "Returns the product of nums. (*) returns 1."
 194.823 +  {:inline (fn [x y] `(. clojure.lang.Numbers (multiply ~x ~y)))
 194.824 +   :inline-arities #{2}
 194.825 +   :added "1.0"}
 194.826 +  ([] 1)
 194.827 +  ([x] (cast Number x))
 194.828 +  ([x y] (. clojure.lang.Numbers (multiply x y)))
 194.829 +  ([x y & more]
 194.830 +   (reduce * (* x y) more)))
 194.831 +
 194.832 +(defn /
 194.833 +  "If no denominators are supplied, returns 1/numerator,
 194.834 +  else returns numerator divided by all of the denominators."
 194.835 +  {:inline (fn [x y] `(. clojure.lang.Numbers (divide ~x ~y)))
 194.836 +   :inline-arities #{2}
 194.837 +   :added "1.0"}
 194.838 +  ([x] (/ 1 x))
 194.839 +  ([x y] (. clojure.lang.Numbers (divide x y)))
 194.840 +  ([x y & more]
 194.841 +   (reduce / (/ x y) more)))
 194.842 +
 194.843 +(defn -
 194.844 +  "If no ys are supplied, returns the negation of x, else subtracts
 194.845 +  the ys from x and returns the result."
 194.846 +  {:inline (fn [& args] `(. clojure.lang.Numbers (minus ~@args)))
 194.847 +   :inline-arities #{1 2}
 194.848 +   :added "1.0"}
 194.849 +  ([x] (. clojure.lang.Numbers (minus x)))
 194.850 +  ([x y] (. clojure.lang.Numbers (minus x y)))
 194.851 +  ([x y & more]
 194.852 +   (reduce - (- x y) more)))
 194.853 +
 194.854 +(defn <=
 194.855 +  "Returns non-nil if nums are in monotonically non-decreasing order,
 194.856 +  otherwise false."
 194.857 +  {:inline (fn [x y] `(. clojure.lang.Numbers (lte ~x ~y)))
 194.858 +   :inline-arities #{2}
 194.859 +   :added "1.0"}
 194.860 +  ([x] true)
 194.861 +  ([x y] (. clojure.lang.Numbers (lte x y)))
 194.862 +  ([x y & more]
 194.863 +   (if (<= x y)
 194.864 +     (if (next more)
 194.865 +       (recur y (first more) (next more))
 194.866 +       (<= y (first more)))
 194.867 +     false)))
 194.868 +
 194.869 +(defn >
 194.870 +  "Returns non-nil if nums are in monotonically decreasing order,
 194.871 +  otherwise false."
 194.872 +  {:inline (fn [x y] `(. clojure.lang.Numbers (gt ~x ~y)))
 194.873 +   :inline-arities #{2}
 194.874 +   :added "1.0"}
 194.875 +  ([x] true)
 194.876 +  ([x y] (. clojure.lang.Numbers (gt x y)))
 194.877 +  ([x y & more]
 194.878 +   (if (> x y)
 194.879 +     (if (next more)
 194.880 +       (recur y (first more) (next more))
 194.881 +       (> y (first more)))
 194.882 +     false)))
 194.883 +
 194.884 +(defn >=
 194.885 +  "Returns non-nil if nums are in monotonically non-increasing order,
 194.886 +  otherwise false."
 194.887 +  {:inline (fn [x y] `(. clojure.lang.Numbers (gte ~x ~y)))
 194.888 +   :inline-arities #{2}
 194.889 +   :added "1.0"}
 194.890 +  ([x] true)
 194.891 +  ([x y] (. clojure.lang.Numbers (gte x y)))
 194.892 +  ([x y & more]
 194.893 +   (if (>= x y)
 194.894 +     (if (next more)
 194.895 +       (recur y (first more) (next more))
 194.896 +       (>= y (first more)))
 194.897 +     false)))
 194.898 +
 194.899 +(defn ==
 194.900 +  "Returns non-nil if nums all have the same value, otherwise false"
 194.901 +  {:inline (fn [x y] `(. clojure.lang.Numbers (equiv ~x ~y)))
 194.902 +   :inline-arities #{2}
 194.903 +   :added "1.0"}
 194.904 +  ([x] true)
 194.905 +  ([x y] (. clojure.lang.Numbers (equiv x y)))
 194.906 +  ([x y & more]
 194.907 +   (if (== x y)
 194.908 +     (if (next more)
 194.909 +       (recur y (first more) (next more))
 194.910 +       (== y (first more)))
 194.911 +     false)))
 194.912 +
 194.913 +(defn max
 194.914 +  "Returns the greatest of the nums."
 194.915 +  {:added "1.0"}
 194.916 +  ([x] x)
 194.917 +  ([x y] (if (> x y) x y))
 194.918 +  ([x y & more]
 194.919 +   (reduce max (max x y) more)))
 194.920 +
 194.921 +(defn min
 194.922 +  "Returns the least of the nums."
 194.923 +  {:added "1.0"}
 194.924 +  ([x] x)
 194.925 +  ([x y] (if (< x y) x y))
 194.926 +  ([x y & more]
 194.927 +   (reduce min (min x y) more)))
 194.928 +
 194.929 +(defn dec
 194.930 +  "Returns a number one less than num."
 194.931 +  {:inline (fn [x] `(. clojure.lang.Numbers (dec ~x)))
 194.932 +   :added "1.0"}
 194.933 +  [x] (. clojure.lang.Numbers (dec x)))
 194.934 +
 194.935 +(defn unchecked-inc
 194.936 +  "Returns a number one greater than x, an int or long.
 194.937 +  Note - uses a primitive operator subject to overflow."
 194.938 +  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x)))
 194.939 +   :added "1.0"}
 194.940 +  [x] (. clojure.lang.Numbers (unchecked_inc x)))
 194.941 +
 194.942 +(defn unchecked-dec
 194.943 +  "Returns a number one less than x, an int or long.
 194.944 +  Note - uses a primitive operator subject to overflow."
 194.945 +  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x)))
 194.946 +   :added "1.0"}
 194.947 +  [x] (. clojure.lang.Numbers (unchecked_dec x)))
 194.948 +
 194.949 +(defn unchecked-negate
 194.950 +  "Returns the negation of x, an int or long.
 194.951 +  Note - uses a primitive operator subject to overflow."
 194.952 +  {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_negate ~x)))
 194.953 +   :added "1.0"}
 194.954 +  [x] (. clojure.lang.Numbers (unchecked_negate x)))
 194.955 +
 194.956 +(defn unchecked-add
 194.957 +  "Returns the sum of x and y, both int or long.
 194.958 +  Note - uses a primitive operator subject to overflow."
 194.959 +  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y)))
 194.960 +   :added "1.0"}
 194.961 +  [x y] (. clojure.lang.Numbers (unchecked_add x y)))
 194.962 +
 194.963 +(defn unchecked-subtract
 194.964 +  "Returns the difference of x and y, both int or long.
 194.965 +  Note - uses a primitive operator subject to overflow."
 194.966 +  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_subtract ~x ~y)))
 194.967 +   :added "1.0"}
 194.968 +  [x y] (. clojure.lang.Numbers (unchecked_subtract x y)))
 194.969 +
 194.970 +(defn unchecked-multiply
 194.971 +  "Returns the product of x and y, both int or long.
 194.972 +  Note - uses a primitive operator subject to overflow."
 194.973 +  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y)))
 194.974 +   :added "1.0"}
 194.975 +  [x y] (. clojure.lang.Numbers (unchecked_multiply x y)))
 194.976 +
 194.977 +(defn unchecked-divide
 194.978 +  "Returns the division of x by y, both int or long.
 194.979 +  Note - uses a primitive operator subject to truncation."
 194.980 +  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_divide ~x ~y)))
 194.981 +   :added "1.0"}
 194.982 +  [x y] (. clojure.lang.Numbers (unchecked_divide x y)))
 194.983 +
 194.984 +(defn unchecked-remainder
 194.985 +  "Returns the remainder of division of x by y, both int or long.
 194.986 +  Note - uses a primitive operator subject to truncation."
 194.987 +  {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_remainder ~x ~y)))
 194.988 +   :added "1.0"}
 194.989 +  [x y] (. clojure.lang.Numbers (unchecked_remainder x y)))
 194.990 +
 194.991 +(defn pos?
 194.992 +  "Returns true if num is greater than zero, else false"
 194.993 +  {
 194.994 +   :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x)))
 194.995 +   :added "1.0"}
 194.996 +  [x] (. clojure.lang.Numbers (isPos x)))
 194.997 +
 194.998 +(defn neg?
 194.999 +  "Returns true if num is less than zero, else false"
194.1000 +  {
194.1001 +   :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x)))
194.1002 +   :added "1.0"}
194.1003 +  [x] (. clojure.lang.Numbers (isNeg x)))
194.1004 +
194.1005 +(defn quot
194.1006 +  "quot[ient] of dividing numerator by denominator."
194.1007 +  {:added "1.0"}
194.1008 +  [num div]
194.1009 +    (. clojure.lang.Numbers (quotient num div)))
194.1010 +
194.1011 +(defn rem
194.1012 +  "remainder of dividing numerator by denominator."
194.1013 +  {:added "1.0"}
194.1014 +  [num div]
194.1015 +    (. clojure.lang.Numbers (remainder num div)))
194.1016 +
194.1017 +(defn rationalize
194.1018 +  "returns the rational value of num"
194.1019 +  {:added "1.0"}
194.1020 +  [num]
194.1021 +  (. clojure.lang.Numbers (rationalize num)))
194.1022 +
194.1023 +;;Bit ops
194.1024 +
194.1025 +(defn bit-not
194.1026 +  "Bitwise complement"
194.1027 +  {:inline (fn [x] `(. clojure.lang.Numbers (not ~x)))
194.1028 +   :added "1.0"}
194.1029 +  [x] (. clojure.lang.Numbers not x))
194.1030 +
194.1031 +
194.1032 +(defn bit-and
194.1033 +  "Bitwise and"
194.1034 +   {:inline (fn [x y] `(. clojure.lang.Numbers (and ~x ~y)))
194.1035 +    :added "1.0"}
194.1036 +  [x y] (. clojure.lang.Numbers and x y))
194.1037 +
194.1038 +(defn bit-or
194.1039 +  "Bitwise or"
194.1040 +  {:inline (fn [x y] `(. clojure.lang.Numbers (or ~x ~y)))
194.1041 +   :added "1.0"}
194.1042 +  [x y] (. clojure.lang.Numbers or x y))
194.1043 +
194.1044 +(defn bit-xor
194.1045 +  "Bitwise exclusive or"
194.1046 +  {:inline (fn [x y] `(. clojure.lang.Numbers (xor ~x ~y)))
194.1047 +   :added "1.0"}
194.1048 +  [x y] (. clojure.lang.Numbers xor x y))
194.1049 +
194.1050 +(defn bit-and-not
194.1051 +  "Bitwise and with complement"
194.1052 +  {:added "1.0"}
194.1053 +  [x y] (. clojure.lang.Numbers andNot x y))
194.1054 +
194.1055 +
194.1056 +(defn bit-clear
194.1057 +  "Clear bit at index n"
194.1058 +  {:added "1.0"}
194.1059 +  [x n] (. clojure.lang.Numbers clearBit x n))
194.1060 +
194.1061 +(defn bit-set
194.1062 +  "Set bit at index n"
194.1063 +  {:added "1.0"}
194.1064 +  [x n] (. clojure.lang.Numbers setBit x n))
194.1065 +
194.1066 +(defn bit-flip
194.1067 +  "Flip bit at index n"
194.1068 +  {:added "1.0"}
194.1069 +  [x n] (. clojure.lang.Numbers flipBit x n))
194.1070 +
194.1071 +(defn bit-test
194.1072 +  "Test bit at index n"
194.1073 +  {:added "1.0"}
194.1074 +  [x n] (. clojure.lang.Numbers testBit x n))
194.1075 +
194.1076 +
194.1077 +(defn bit-shift-left
194.1078 +  "Bitwise shift left"
194.1079 +  {:inline (fn [x n] `(. clojure.lang.Numbers (shiftLeft ~x ~n)))
194.1080 +   :added "1.0"}
194.1081 +  [x n] (. clojure.lang.Numbers shiftLeft x n))
194.1082 +
194.1083 +(defn bit-shift-right
194.1084 +  "Bitwise shift right"
194.1085 +  {:inline (fn [x n] `(. clojure.lang.Numbers (shiftRight ~x ~n)))
194.1086 +   :added "1.0"}
194.1087 +  [x n] (. clojure.lang.Numbers shiftRight x n))
194.1088 +
194.1089 +(defn even?
194.1090 +  "Returns true if n is even, throws an exception if n is not an integer"
194.1091 +  {:added "1.0"}
194.1092 +  [n] (zero? (bit-and n 1)))
194.1093 +
194.1094 +(defn odd?
194.1095 +  "Returns true if n is odd, throws an exception if n is not an integer"
194.1096 +  {:added "1.0"}
194.1097 +  [n] (not (even? n)))
194.1098 +
194.1099 +
194.1100 +;;
194.1101 +
194.1102 +(defn complement
194.1103 +  "Takes a fn f and returns a fn that takes the same arguments as f,
194.1104 +  has the same effects, if any, and returns the opposite truth value."
194.1105 +  {:added "1.0"}
194.1106 +  [f] 
194.1107 +  (fn 
194.1108 +    ([] (not (f)))
194.1109 +    ([x] (not (f x)))
194.1110 +    ([x y] (not (f x y)))
194.1111 +    ([x y & zs] (not (apply f x y zs)))))
194.1112 +
194.1113 +(defn constantly
194.1114 +  "Returns a function that takes any number of arguments and returns x."
194.1115 +  {:added "1.0"}
194.1116 +  [x] (fn [& args] x))
194.1117 +
194.1118 +(defn identity
194.1119 +  "Returns its argument."
194.1120 +  {:added "1.0"}
194.1121 +  [x] x)
194.1122 +
194.1123 +;;Collection stuff
194.1124 +
194.1125 +
194.1126 +
194.1127 +
194.1128 +
194.1129 +;;list stuff
194.1130 +(defn peek
194.1131 +  "For a list or queue, same as first, for a vector, same as, but much
194.1132 +  more efficient than, last. If the collection is empty, returns nil."
194.1133 +  {:added "1.0"}
194.1134 +  [coll] (. clojure.lang.RT (peek coll)))
194.1135 +
194.1136 +(defn pop
194.1137 +  "For a list or queue, returns a new list/queue without the first
194.1138 +  item, for a vector, returns a new vector without the last item. If
194.1139 +  the collection is empty, throws an exception.  Note - not the same
194.1140 +  as next/butlast."
194.1141 +  {:added "1.0"}
194.1142 +  [coll] (. clojure.lang.RT (pop coll)))
194.1143 +
194.1144 +;;map stuff
194.1145 +
194.1146 +(defn contains?
194.1147 +  "Returns true if key is present in the given collection, otherwise
194.1148 +  returns false.  Note that for numerically indexed collections like
194.1149 +  vectors and Java arrays, this tests if the numeric key is within the
194.1150 +  range of indexes. 'contains?' operates constant or logarithmic time;
194.1151 +  it will not perform a linear search for a value.  See also 'some'."
194.1152 +  {:added "1.0"}
194.1153 +  [coll key] (. clojure.lang.RT (contains coll key)))
194.1154 +
194.1155 +(defn get
194.1156 +  "Returns the value mapped to key, not-found or nil if key not present."
194.1157 +  {:inline (fn  [m k & nf] `(. clojure.lang.RT (get ~m ~k ~@nf)))
194.1158 +   :inline-arities #{2 3}
194.1159 +   :added "1.0"}
194.1160 +  ([map key]
194.1161 +   (. clojure.lang.RT (get map key)))
194.1162 +  ([map key not-found]
194.1163 +   (. clojure.lang.RT (get map key not-found))))
194.1164 +
194.1165 +(defn dissoc
194.1166 +  "dissoc[iate]. Returns a new map of the same (hashed/sorted) type,
194.1167 +  that does not contain a mapping for key(s)."
194.1168 +  {:added "1.0"}
194.1169 +  ([map] map)
194.1170 +  ([map key]
194.1171 +   (. clojure.lang.RT (dissoc map key)))
194.1172 +  ([map key & ks]
194.1173 +   (let [ret (dissoc map key)]
194.1174 +     (if ks
194.1175 +       (recur ret (first ks) (next ks))
194.1176 +       ret))))
194.1177 +
194.1178 +(defn disj
194.1179 +  "disj[oin]. Returns a new set of the same (hashed/sorted) type, that
194.1180 +  does not contain key(s)."
194.1181 +  {:added "1.0"}
194.1182 +  ([set] set)
194.1183 +  ([^clojure.lang.IPersistentSet set key]
194.1184 +   (when set
194.1185 +     (. set (disjoin key))))
194.1186 +  ([set key & ks]
194.1187 +   (when set
194.1188 +     (let [ret (disj set key)]
194.1189 +       (if ks
194.1190 +         (recur ret (first ks) (next ks))
194.1191 +         ret)))))
194.1192 +
194.1193 +(defn find
194.1194 +  "Returns the map entry for key, or nil if key not present."
194.1195 +  {:added "1.0"}
194.1196 +  [map key] (. clojure.lang.RT (find map key)))
194.1197 +
194.1198 +(defn select-keys
194.1199 +  "Returns a map containing only those entries in map whose key is in keys"
194.1200 +  {:added "1.0"}
194.1201 +  [map keyseq]
194.1202 +    (loop [ret {} keys (seq keyseq)]
194.1203 +      (if keys
194.1204 +        (let [entry (. clojure.lang.RT (find map (first keys)))]
194.1205 +          (recur
194.1206 +           (if entry
194.1207 +             (conj ret entry)
194.1208 +             ret)
194.1209 +           (next keys)))
194.1210 +        ret)))
194.1211 +
194.1212 +(defn keys
194.1213 +  "Returns a sequence of the map's keys."
194.1214 +  {:added "1.0"}
194.1215 +  [map] (. clojure.lang.RT (keys map)))
194.1216 +
194.1217 +(defn vals
194.1218 +  "Returns a sequence of the map's values."
194.1219 +  {:added "1.0"}
194.1220 +  [map] (. clojure.lang.RT (vals map)))
194.1221 +
194.1222 +(defn key
194.1223 +  "Returns the key of the map entry."
194.1224 +  {:added "1.0"}
194.1225 +  [^java.util.Map$Entry e]
194.1226 +    (. e (getKey)))
194.1227 +
194.1228 +(defn val
194.1229 +  "Returns the value in the map entry."
194.1230 +  {:added "1.0"}
194.1231 +  [^java.util.Map$Entry e]
194.1232 +    (. e (getValue)))
194.1233 +
194.1234 +(defn rseq
194.1235 +  "Returns, in constant time, a seq of the items in rev (which
194.1236 +  can be a vector or sorted-map), in reverse order. If rev is empty returns nil"
194.1237 +  {:added "1.0"}
194.1238 +  [^clojure.lang.Reversible rev]
194.1239 +    (. rev (rseq)))
194.1240 +
194.1241 +(defn name
194.1242 +  "Returns the name String of a string, symbol or keyword."
194.1243 +  {:tag String
194.1244 +   :added "1.0"}
194.1245 +  [^clojure.lang.Named x]
194.1246 +  (if (string? x) x (. x (getName))))
194.1247 +
194.1248 +(defn namespace
194.1249 +  "Returns the namespace String of a symbol or keyword, or nil if not present."
194.1250 +  {:tag String
194.1251 +   :added "1.0"}
194.1252 +  [^clojure.lang.Named x]
194.1253 +    (. x (getNamespace)))
194.1254 +
194.1255 +(defmacro locking
194.1256 +  "Executes exprs in an implicit do, while holding the monitor of x.
194.1257 +  Will release the monitor of x in all circumstances."
194.1258 +  {:added "1.0"}
194.1259 +  [x & body]
194.1260 +  `(let [lockee# ~x]
194.1261 +     (try
194.1262 +      (monitor-enter lockee#)
194.1263 +      ~@body
194.1264 +      (finally
194.1265 +       (monitor-exit lockee#)))))
194.1266 +
194.1267 +(defmacro ..
194.1268 +  "form => fieldName-symbol or (instanceMethodName-symbol args*)
194.1269 +
194.1270 +  Expands into a member access (.) of the first member on the first
194.1271 +  argument, followed by the next member on the result, etc. For
194.1272 +  instance:
194.1273 +
194.1274 +  (.. System (getProperties) (get \"os.name\"))
194.1275 +
194.1276 +  expands to:
194.1277 +
194.1278 +  (. (. System (getProperties)) (get \"os.name\"))
194.1279 +
194.1280 +  but is easier to write, read, and understand."
194.1281 +  {:added "1.0"}
194.1282 +  ([x form] `(. ~x ~form))
194.1283 +  ([x form & more] `(.. (. ~x ~form) ~@more)))
194.1284 +
194.1285 +(defmacro ->
194.1286 +  "Threads the expr through the forms. Inserts x as the
194.1287 +  second item in the first form, making a list of it if it is not a
194.1288 +  list already. If there are more forms, inserts the first form as the
194.1289 +  second item in second form, etc."
194.1290 +  {:added "1.0"}
194.1291 +  ([x] x)
194.1292 +  ([x form] (if (seq? form)
194.1293 +              (with-meta `(~(first form) ~x ~@(next form)) (meta form))
194.1294 +              (list form x)))
194.1295 +  ([x form & more] `(-> (-> ~x ~form) ~@more)))
194.1296 +
194.1297 +(defmacro ->>
194.1298 +  "Threads the expr through the forms. Inserts x as the
194.1299 +  last item in the first form, making a list of it if it is not a
194.1300 +  list already. If there are more forms, inserts the first form as the
194.1301 +  last item in second form, etc."
194.1302 +  {:added "1.1"} 
194.1303 +  ([x form] (if (seq? form)
194.1304 +              (with-meta `(~(first form) ~@(next form)  ~x) (meta form))
194.1305 +              (list form x)))
194.1306 +  ([x form & more] `(->> (->> ~x ~form) ~@more)))
194.1307 +
194.1308 +;;multimethods
194.1309 +(def global-hierarchy)
194.1310 +
194.1311 +(defmacro defmulti
194.1312 +  "Creates a new multimethod with the associated dispatch function.
194.1313 +  The docstring and attribute-map are optional.
194.1314 +
194.1315 +  Options are key-value pairs and may be one of:
194.1316 +    :default    the default dispatch value, defaults to :default
194.1317 +    :hierarchy  the isa? hierarchy to use for dispatching
194.1318 +                defaults to the global hierarchy"
194.1319 +  {:arglists '([name docstring? attr-map? dispatch-fn & options])
194.1320 +   :added "1.0"}
194.1321 +  [mm-name & options]
194.1322 +  (let [docstring   (if (string? (first options))
194.1323 +                      (first options)
194.1324 +                      nil)
194.1325 +        options     (if (string? (first options))
194.1326 +                      (next options)
194.1327 +                      options)
194.1328 +        m           (if (map? (first options))
194.1329 +                      (first options)
194.1330 +                      {})
194.1331 +        options     (if (map? (first options))
194.1332 +                      (next options)
194.1333 +                      options)
194.1334 +        dispatch-fn (first options)
194.1335 +        options     (next options)
194.1336 +        m           (assoc m :tag 'clojure.lang.MultiFn)
194.1337 +        m           (if docstring
194.1338 +                      (assoc m :doc docstring)
194.1339 +                      m)
194.1340 +        m           (if (meta mm-name)
194.1341 +                      (conj (meta mm-name) m)
194.1342 +                      m)]
194.1343 +    (when (= (count options) 1)
194.1344 +      (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")))
194.1345 +    (let [options   (apply hash-map options)
194.1346 +          default   (get options :default :default)
194.1347 +          hierarchy (get options :hierarchy #'global-hierarchy)]
194.1348 +      `(let [v# (def ~mm-name)]
194.1349 +         (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#)))
194.1350 +           (def ~(with-meta mm-name m)
194.1351 +                (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy)))))))
194.1352 +
194.1353 +(defmacro defmethod
194.1354 +  "Creates and installs a new method of multimethod associated with dispatch-value. "
194.1355 +  {:added "1.0"}
194.1356 +  [multifn dispatch-val & fn-tail]
194.1357 +  `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail)))
194.1358 +
194.1359 +(defn remove-all-methods
194.1360 +  "Removes all of the methods of multimethod."
194.1361 +  {:added "1.2"} 
194.1362 + [^clojure.lang.MultiFn multifn]
194.1363 + (.reset multifn))
194.1364 +
194.1365 +(defn remove-method
194.1366 +  "Removes the method of multimethod associated with dispatch-value."
194.1367 +  {:added "1.0"}
194.1368 + [^clojure.lang.MultiFn multifn dispatch-val]
194.1369 + (. multifn removeMethod dispatch-val))
194.1370 +
194.1371 +(defn prefer-method
194.1372 +  "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y 
194.1373 +   when there is a conflict"
194.1374 +  {:added "1.0"}
194.1375 +  [^clojure.lang.MultiFn multifn dispatch-val-x dispatch-val-y]
194.1376 +  (. multifn preferMethod dispatch-val-x dispatch-val-y))
194.1377 +
194.1378 +(defn methods
194.1379 +  "Given a multimethod, returns a map of dispatch values -> dispatch fns"
194.1380 +  {:added "1.0"}
194.1381 +  [^clojure.lang.MultiFn multifn] (.getMethodTable multifn))
194.1382 +
194.1383 +(defn get-method
194.1384 +  "Given a multimethod and a dispatch value, returns the dispatch fn
194.1385 +  that would apply to that value, or nil if none apply and no default"
194.1386 +  {:added "1.0"}
194.1387 +  [^clojure.lang.MultiFn multifn dispatch-val] (.getMethod multifn dispatch-val))
194.1388 +
194.1389 +(defn prefers
194.1390 +  "Given a multimethod, returns a map of preferred value -> set of other values"
194.1391 +  {:added "1.0"}
194.1392 +  [^clojure.lang.MultiFn multifn] (.getPreferTable multifn))
194.1393 +
194.1394 +;;;;;;;;; var stuff
194.1395 +
194.1396 +(defmacro ^{:private true} assert-args [fnname & pairs]
194.1397 +  `(do (when-not ~(first pairs)
194.1398 +         (throw (IllegalArgumentException.
194.1399 +                  ~(str fnname " requires " (second pairs)))))
194.1400 +     ~(let [more (nnext pairs)]
194.1401 +        (when more
194.1402 +          (list* `assert-args fnname more)))))
194.1403 +
194.1404 +(defmacro if-let
194.1405 +  "bindings => binding-form test
194.1406 +
194.1407 +  If test is true, evaluates then with binding-form bound to the value of 
194.1408 +  test, if not, yields else"
194.1409 +  {:added "1.0"}
194.1410 +  ([bindings then]
194.1411 +   `(if-let ~bindings ~then nil))
194.1412 +  ([bindings then else & oldform]
194.1413 +   (assert-args if-let
194.1414 +     (and (vector? bindings) (nil? oldform)) "a vector for its binding"
194.1415 +     (= 2 (count bindings)) "exactly 2 forms in binding vector")
194.1416 +   (let [form (bindings 0) tst (bindings 1)]
194.1417 +     `(let [temp# ~tst]
194.1418 +        (if temp#
194.1419 +          (let [~form temp#]
194.1420 +            ~then)
194.1421 +          ~else)))))
194.1422 +
194.1423 +(defmacro when-let
194.1424 +  "bindings => binding-form test
194.1425 +
194.1426 +  When test is true, evaluates body with binding-form bound to the value of test"
194.1427 +  {:added "1.0"}
194.1428 +  [bindings & body]
194.1429 +  (assert-args when-let
194.1430 +     (vector? bindings) "a vector for its binding"
194.1431 +     (= 2 (count bindings)) "exactly 2 forms in binding vector")
194.1432 +   (let [form (bindings 0) tst (bindings 1)]
194.1433 +    `(let [temp# ~tst]
194.1434 +       (when temp#
194.1435 +         (let [~form temp#]
194.1436 +           ~@body)))))
194.1437 +
194.1438 +(defn push-thread-bindings
194.1439 +  "WARNING: This is a low-level function. Prefer high-level macros like
194.1440 +  binding where ever possible.
194.1441 +
194.1442 +  Takes a map of Var/value pairs. Binds each Var to the associated value for
194.1443 +  the current thread. Each call *MUST* be accompanied by a matching call to
194.1444 +  pop-thread-bindings wrapped in a try-finally!
194.1445 +  
194.1446 +      (push-thread-bindings bindings)
194.1447 +      (try
194.1448 +        ...
194.1449 +        (finally
194.1450 +          (pop-thread-bindings)))"
194.1451 +  {:added "1.1"} 
194.1452 +  [bindings]
194.1453 +  (clojure.lang.Var/pushThreadBindings bindings))
194.1454 +
194.1455 +(defn pop-thread-bindings
194.1456 +  "Pop one set of bindings pushed with push-binding before. It is an error to
194.1457 +  pop bindings without pushing before."
194.1458 +  {:added "1.1"}
194.1459 +  []
194.1460 +  (clojure.lang.Var/popThreadBindings))
194.1461 +
194.1462 +(defn get-thread-bindings
194.1463 +  "Get a map with the Var/value pairs which is currently in effect for the
194.1464 +  current thread."
194.1465 +  {:added "1.1"}
194.1466 +  []
194.1467 +  (clojure.lang.Var/getThreadBindings))
194.1468 +
194.1469 +(defmacro binding
194.1470 +  "binding => var-symbol init-expr
194.1471 +
194.1472 +  Creates new bindings for the (already-existing) vars, with the
194.1473 +  supplied initial values, executes the exprs in an implicit do, then
194.1474 +  re-establishes the bindings that existed before.  The new bindings
194.1475 +  are made in parallel (unlike let); all init-exprs are evaluated
194.1476 +  before the vars are bound to their new values."
194.1477 +  {:added "1.0"}
194.1478 +  [bindings & body]
194.1479 +  (assert-args binding
194.1480 +    (vector? bindings) "a vector for its binding"
194.1481 +    (even? (count bindings)) "an even number of forms in binding vector")
194.1482 +  (let [var-ize (fn [var-vals]
194.1483 +                  (loop [ret [] vvs (seq var-vals)]
194.1484 +                    (if vvs
194.1485 +                      (recur  (conj (conj ret `(var ~(first vvs))) (second vvs))
194.1486 +                             (next (next vvs)))
194.1487 +                      (seq ret))))]
194.1488 +    `(let []
194.1489 +       (push-thread-bindings (hash-map ~@(var-ize bindings)))
194.1490 +       (try
194.1491 +         ~@body
194.1492 +         (finally
194.1493 +           (pop-thread-bindings))))))
194.1494 +
194.1495 +(defn with-bindings*
194.1496 +  "Takes a map of Var/value pairs. Installs for the given Vars the associated
194.1497 +  values as thread-local bindings. Then calls f with the supplied arguments.
194.1498 +  Pops the installed bindings after f returned. Returns whatever f returns."
194.1499 +  {:added "1.1"}
194.1500 +  [binding-map f & args]
194.1501 +  (push-thread-bindings binding-map)
194.1502 +  (try
194.1503 +    (apply f args)
194.1504 +    (finally
194.1505 +      (pop-thread-bindings))))
194.1506 +
194.1507 +(defmacro with-bindings
194.1508 +  "Takes a map of Var/value pairs. Installs for the given Vars the associated
194.1509 +  values as thread-local bindings. The executes body. Pops the installed
194.1510 +  bindings after body was evaluated. Returns the value of body."
194.1511 +  {:added "1.1"}
194.1512 +  [binding-map & body]
194.1513 +  `(with-bindings* ~binding-map (fn [] ~@body)))
194.1514 +
194.1515 +(defn bound-fn*
194.1516 +  "Returns a function, which will install the same bindings in effect as in
194.1517 +  the thread at the time bound-fn* was called and then call f with any given
194.1518 +  arguments. This may be used to define a helper function which runs on a
194.1519 +  different thread, but needs the same bindings in place."
194.1520 +  {:added "1.1"}
194.1521 +  [f]
194.1522 +  (let [bindings (get-thread-bindings)]
194.1523 +    (fn [& args]
194.1524 +      (apply with-bindings* bindings f args))))
194.1525 +
194.1526 +(defmacro bound-fn
194.1527 +  "Returns a function defined by the given fntail, which will install the
194.1528 +  same bindings in effect as in the thread at the time bound-fn was called.
194.1529 +  This may be used to define a helper function which runs on a different
194.1530 +  thread, but needs the same bindings in place."
194.1531 +  {:added "1.1"}
194.1532 +  [& fntail]
194.1533 +  `(bound-fn* (fn ~@fntail)))
194.1534 +
194.1535 +(defn find-var
194.1536 +  "Returns the global var named by the namespace-qualified symbol, or
194.1537 +  nil if no var with that name."
194.1538 +  {:added "1.0"}
194.1539 + [sym] (. clojure.lang.Var (find sym)))
194.1540 +
194.1541 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Refs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
194.1542 +(defn ^{:private true}
194.1543 +  setup-reference [^clojure.lang.ARef r options]
194.1544 +  (let [opts (apply hash-map options)]
194.1545 +    (when (:meta opts)
194.1546 +      (.resetMeta r (:meta opts)))
194.1547 +    (when (:validator opts)
194.1548 +      (.setValidator r (:validator opts)))
194.1549 +    r))
194.1550 +
194.1551 +(defn agent
194.1552 +  "Creates and returns an agent with an initial value of state and
194.1553 +  zero or more options (in any order):
194.1554 +
194.1555 +  :meta metadata-map
194.1556 +
194.1557 +  :validator validate-fn
194.1558 +
194.1559 +  :error-handler handler-fn
194.1560 +
194.1561 +  :error-mode mode-keyword
194.1562 +
194.1563 +  If metadata-map is supplied, it will be come the metadata on the
194.1564 +  agent. validate-fn must be nil or a side-effect-free fn of one
194.1565 +  argument, which will be passed the intended new state on any state
194.1566 +  change. If the new state is unacceptable, the validate-fn should
194.1567 +  return false or throw an exception.  handler-fn is called if an
194.1568 +  action throws an exception or if validate-fn rejects a new state --
194.1569 +  see set-error-handler! for details.  The mode-keyword may be either
194.1570 +  :continue (the default if an error-handler is given) or :fail (the
194.1571 +  default if no error-handler is given) -- see set-error-mode! for
194.1572 +  details."
194.1573 +  {:added "1.0"}
194.1574 +  ([state & options]
194.1575 +     (let [a (new clojure.lang.Agent state)
194.1576 +           opts (apply hash-map options)]
194.1577 +       (setup-reference a options)
194.1578 +       (when (:error-handler opts)
194.1579 +         (.setErrorHandler a (:error-handler opts)))
194.1580 +       (.setErrorMode a (or (:error-mode opts)
194.1581 +                            (if (:error-handler opts) :continue :fail)))
194.1582 +       a)))
194.1583 +
194.1584 +(defn send
194.1585 +  "Dispatch an action to an agent. Returns the agent immediately.
194.1586 +  Subsequently, in a thread from a thread pool, the state of the agent
194.1587 +  will be set to the value of:
194.1588 +
194.1589 +  (apply action-fn state-of-agent args)"
194.1590 +  {:added "1.0"}
194.1591 +  [^clojure.lang.Agent a f & args]
194.1592 +    (. a (dispatch f args false)))
194.1593 +
194.1594 +(defn send-off
194.1595 +  "Dispatch a potentially blocking action to an agent. Returns the
194.1596 +  agent immediately. Subsequently, in a separate thread, the state of
194.1597 +  the agent will be set to the value of:
194.1598 +
194.1599 +  (apply action-fn state-of-agent args)"
194.1600 +  {:added "1.0"}
194.1601 +  [^clojure.lang.Agent a f & args]
194.1602 +    (. a (dispatch f args true)))
194.1603 +
194.1604 +(defn release-pending-sends
194.1605 +  "Normally, actions sent directly or indirectly during another action
194.1606 +  are held until the action completes (changes the agent's
194.1607 +  state). This function can be used to dispatch any pending sent
194.1608 +  actions immediately. This has no impact on actions sent during a
194.1609 +  transaction, which are still held until commit. If no action is
194.1610 +  occurring, does nothing. Returns the number of actions dispatched."
194.1611 +  {:added "1.0"}
194.1612 +  [] (clojure.lang.Agent/releasePendingSends))
194.1613 +
194.1614 +(defn add-watch
194.1615 +  "Alpha - subject to change.
194.1616 +  Adds a watch function to an agent/atom/var/ref reference. The watch
194.1617 +  fn must be a fn of 4 args: a key, the reference, its old-state, its
194.1618 +  new-state. Whenever the reference's state might have been changed,
194.1619 +  any registered watches will have their functions called. The watch fn
194.1620 +  will be called synchronously, on the agent's thread if an agent,
194.1621 +  before any pending sends if agent or ref. Note that an atom's or
194.1622 +  ref's state may have changed again prior to the fn call, so use
194.1623 +  old/new-state rather than derefing the reference. Note also that watch
194.1624 +  fns may be called from multiple threads simultaneously. Var watchers
194.1625 +  are triggered only by root binding changes, not thread-local
194.1626 +  set!s. Keys must be unique per reference, and can be used to remove
194.1627 +  the watch with remove-watch, but are otherwise considered opaque by
194.1628 +  the watch mechanism."
194.1629 +  {:added "1.0"}
194.1630 +  [^clojure.lang.IRef reference key fn] (.addWatch reference key fn))
194.1631 +
194.1632 +(defn remove-watch
194.1633 +  "Alpha - subject to change.
194.1634 +  Removes a watch (set by add-watch) from a reference"
194.1635 +  {:added "1.0"}
194.1636 +  [^clojure.lang.IRef reference key]
194.1637 +  (.removeWatch reference key))
194.1638 +
194.1639 +(defn agent-error
194.1640 +  "Returns the exception thrown during an asynchronous action of the
194.1641 +  agent if the agent is failed.  Returns nil if the agent is not
194.1642 +  failed."
194.1643 +  {:added "1.2"}
194.1644 +  [^clojure.lang.Agent a] (.getError a))
194.1645 +
194.1646 +(defn restart-agent
194.1647 +  "When an agent is failed, changes the agent state to new-state and
194.1648 +  then un-fails the agent so that sends are allowed again.  If
194.1649 +  a :clear-actions true option is given, any actions queued on the
194.1650 +  agent that were being held while it was failed will be discarded,
194.1651 +  otherwise those held actions will proceed.  The new-state must pass
194.1652 +  the validator if any, or restart will throw an exception and the
194.1653 +  agent will remain failed with its old state and error.  Watchers, if
194.1654 +  any, will NOT be notified of the new state.  Throws an exception if
194.1655 +  the agent is not failed."
194.1656 +  {:added "1.2"}
194.1657 +  [^clojure.lang.Agent a, new-state & options]
194.1658 +  (let [opts (apply hash-map options)]
194.1659 +    (.restart a new-state (if (:clear-actions opts) true false))))
194.1660 +
194.1661 +(defn set-error-handler!
194.1662 +  "Sets the error-handler of agent a to handler-fn.  If an action
194.1663 +  being run by the agent throws an exception or doesn't pass the
194.1664 +  validator fn, handler-fn will be called with two arguments: the
194.1665 +  agent and the exception."
194.1666 +  {:added "1.2"}
194.1667 +  [^clojure.lang.Agent a, handler-fn]
194.1668 +  (.setErrorHandler a handler-fn))
194.1669 +
194.1670 +(defn error-handler
194.1671 +  "Returns the error-handler of agent a, or nil if there is none.
194.1672 +  See set-error-handler!"
194.1673 +  {:added "1.2"}
194.1674 +  [^clojure.lang.Agent a]
194.1675 +  (.getErrorHandler a))
194.1676 +
194.1677 +(defn set-error-mode!
194.1678 +  "Sets the error-mode of agent a to mode-keyword, which must be
194.1679 +  either :fail or :continue.  If an action being run by the agent
194.1680 +  throws an exception or doesn't pass the validator fn, an
194.1681 +  error-handler may be called (see set-error-handler!), after which,
194.1682 +  if the mode is :continue, the agent will continue as if neither the
194.1683 +  action that caused the error nor the error itself ever happened.
194.1684 +  
194.1685 +  If the mode is :fail, the agent will become failed and will stop
194.1686 +  accepting new 'send' and 'send-off' actions, and any previously
194.1687 +  queued actions will be held until a 'restart-agent'.  Deref will
194.1688 +  still work, returning the state of the agent before the error."
194.1689 +  {:added "1.2"}
194.1690 +  [^clojure.lang.Agent a, mode-keyword]
194.1691 +  (.setErrorMode a mode-keyword))
194.1692 +
194.1693 +(defn error-mode
194.1694 +  "Returns the error-mode of agent a.  See set-error-mode!"
194.1695 +  {:added "1.2"}
194.1696 +  [^clojure.lang.Agent a]
194.1697 +  (.getErrorMode a))
194.1698 +
194.1699 +(defn agent-errors
194.1700 +  "DEPRECATED: Use 'agent-error' instead.
194.1701 +  Returns a sequence of the exceptions thrown during asynchronous
194.1702 +  actions of the agent."
194.1703 +  {:added "1.0"
194.1704 +   :deprecated "1.2"}
194.1705 +  [a]
194.1706 +  (when-let [e (agent-error a)]
194.1707 +    (list e)))
194.1708 +
194.1709 +(defn clear-agent-errors
194.1710 +  "DEPRECATED: Use 'restart-agent' instead.
194.1711 +  Clears any exceptions thrown during asynchronous actions of the
194.1712 +  agent, allowing subsequent actions to occur."
194.1713 +  {:added "1.0"
194.1714 +   :deprecated "1.2"}
194.1715 +  [^clojure.lang.Agent a] (restart-agent a (.deref a)))
194.1716 +
194.1717 +(defn shutdown-agents
194.1718 +  "Initiates a shutdown of the thread pools that back the agent
194.1719 +  system. Running actions will complete, but no new actions will be
194.1720 +  accepted"
194.1721 +  {:added "1.0"}
194.1722 +  [] (. clojure.lang.Agent shutdown))
194.1723 +
194.1724 +(defn ref
194.1725 +  "Creates and returns a Ref with an initial value of x and zero or
194.1726 +  more options (in any order):
194.1727 +
194.1728 +  :meta metadata-map
194.1729 +
194.1730 +  :validator validate-fn
194.1731 +
194.1732 +  :min-history (default 0)
194.1733 +  :max-history (default 10)
194.1734 +
194.1735 +  If metadata-map is supplied, it will be come the metadata on the
194.1736 +  ref. validate-fn must be nil or a side-effect-free fn of one
194.1737 +  argument, which will be passed the intended new state on any state
194.1738 +  change. If the new state is unacceptable, the validate-fn should
194.1739 +  return false or throw an exception. validate-fn will be called on
194.1740 +  transaction commit, when all refs have their final values.
194.1741 +
194.1742 +  Normally refs accumulate history dynamically as needed to deal with
194.1743 +  read demands. If you know in advance you will need history you can
194.1744 +  set :min-history to ensure it will be available when first needed (instead
194.1745 +  of after a read fault). History is limited, and the limit can be set
194.1746 +  with :max-history."
194.1747 +  {:added "1.0"}
194.1748 +  ([x] (new clojure.lang.Ref x))
194.1749 +  ([x & options] 
194.1750 +   (let [r  ^clojure.lang.Ref (setup-reference (ref x) options)
194.1751 +         opts (apply hash-map options)]
194.1752 +    (when (:max-history opts)
194.1753 +      (.setMaxHistory r (:max-history opts)))
194.1754 +    (when (:min-history opts)
194.1755 +      (.setMinHistory r (:min-history opts)))
194.1756 +    r)))
194.1757 +
194.1758 +(defn deref
194.1759 +  "Also reader macro: @ref/@agent/@var/@atom/@delay/@future. Within a transaction,
194.1760 +  returns the in-transaction-value of ref, else returns the
194.1761 +  most-recently-committed value of ref. When applied to a var, agent
194.1762 +  or atom, returns its current state. When applied to a delay, forces
194.1763 +  it if not already forced. When applied to a future, will block if
194.1764 +  computation not complete"
194.1765 +  {:added "1.0"}
194.1766 +  [^clojure.lang.IDeref ref] (.deref ref))
194.1767 +
194.1768 +(defn atom
194.1769 +  "Creates and returns an Atom with an initial value of x and zero or
194.1770 +  more options (in any order):
194.1771 +
194.1772 +  :meta metadata-map
194.1773 +
194.1774 +  :validator validate-fn
194.1775 +
194.1776 +  If metadata-map is supplied, it will be come the metadata on the
194.1777 +  atom. validate-fn must be nil or a side-effect-free fn of one
194.1778 +  argument, which will be passed the intended new state on any state
194.1779 +  change. If the new state is unacceptable, the validate-fn should
194.1780 +  return false or throw an exception."
194.1781 +  {:added "1.0"}
194.1782 +  ([x] (new clojure.lang.Atom x))
194.1783 +  ([x & options] (setup-reference (atom x) options)))
194.1784 +
194.1785 +(defn swap!
194.1786 +  "Atomically swaps the value of atom to be:
194.1787 +  (apply f current-value-of-atom args). Note that f may be called
194.1788 +  multiple times, and thus should be free of side effects.  Returns
194.1789 +  the value that was swapped in."
194.1790 +  {:added "1.0"}
194.1791 +  ([^clojure.lang.Atom atom f] (.swap atom f))
194.1792 +  ([^clojure.lang.Atom atom f x] (.swap atom f x))
194.1793 +  ([^clojure.lang.Atom atom f x y] (.swap atom f x y))
194.1794 +  ([^clojure.lang.Atom atom f x y & args] (.swap atom f x y args)))
194.1795 +
194.1796 +(defn compare-and-set!
194.1797 +  "Atomically sets the value of atom to newval if and only if the
194.1798 +  current value of the atom is identical to oldval. Returns true if
194.1799 +  set happened, else false"
194.1800 +  {:added "1.0"}
194.1801 +  [^clojure.lang.Atom atom oldval newval] (.compareAndSet atom oldval newval))
194.1802 +
194.1803 +(defn reset!
194.1804 +  "Sets the value of atom to newval without regard for the
194.1805 +  current value. Returns newval."
194.1806 +  {:added "1.0"}
194.1807 +  [^clojure.lang.Atom atom newval] (.reset atom newval))
194.1808 +
194.1809 +(defn set-validator!
194.1810 +  "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a
194.1811 +  side-effect-free fn of one argument, which will be passed the intended
194.1812 +  new state on any state change. If the new state is unacceptable, the
194.1813 +  validator-fn should return false or throw an exception. If the current state (root
194.1814 +  value if var) is not acceptable to the new validator, an exception
194.1815 +  will be thrown and the validator will not be changed."
194.1816 +  {:added "1.0"}
194.1817 +  [^clojure.lang.IRef iref validator-fn] (. iref (setValidator validator-fn)))
194.1818 +
194.1819 +(defn get-validator
194.1820 +  "Gets the validator-fn for a var/ref/agent/atom."
194.1821 +  {:added "1.0"}
194.1822 + [^clojure.lang.IRef iref] (. iref (getValidator)))
194.1823 +
194.1824 +(defn alter-meta!
194.1825 +  "Atomically sets the metadata for a namespace/var/ref/agent/atom to be:
194.1826 +
194.1827 +  (apply f its-current-meta args)
194.1828 +
194.1829 +  f must be free of side-effects"
194.1830 +  {:added "1.0"}
194.1831 + [^clojure.lang.IReference iref f & args] (.alterMeta iref f args))
194.1832 +
194.1833 +(defn reset-meta!
194.1834 +  "Atomically resets the metadata for a namespace/var/ref/agent/atom"
194.1835 +  {:added "1.0"}
194.1836 + [^clojure.lang.IReference iref metadata-map] (.resetMeta iref metadata-map))
194.1837 +
194.1838 +(defn commute
194.1839 +  "Must be called in a transaction. Sets the in-transaction-value of
194.1840 +  ref to:
194.1841 +
194.1842 +  (apply fun in-transaction-value-of-ref args)
194.1843 +
194.1844 +  and returns the in-transaction-value of ref.
194.1845 +
194.1846 +  At the commit point of the transaction, sets the value of ref to be:
194.1847 +
194.1848 +  (apply fun most-recently-committed-value-of-ref args)
194.1849 +
194.1850 +  Thus fun should be commutative, or, failing that, you must accept
194.1851 +  last-one-in-wins behavior.  commute allows for more concurrency than
194.1852 +  ref-set."
194.1853 +  {:added "1.0"}
194.1854 +
194.1855 +  [^clojure.lang.Ref ref fun & args]
194.1856 +    (. ref (commute fun args)))
194.1857 +
194.1858 +(defn alter
194.1859 +  "Must be called in a transaction. Sets the in-transaction-value of
194.1860 +  ref to:
194.1861 +
194.1862 +  (apply fun in-transaction-value-of-ref args)
194.1863 +
194.1864 +  and returns the in-transaction-value of ref."
194.1865 +  {:added "1.0"}
194.1866 +  [^clojure.lang.Ref ref fun & args]
194.1867 +    (. ref (alter fun args)))
194.1868 +
194.1869 +(defn ref-set
194.1870 +  "Must be called in a transaction. Sets the value of ref.
194.1871 +  Returns val."
194.1872 +  {:added "1.0"}
194.1873 +  [^clojure.lang.Ref ref val]
194.1874 +    (. ref (set val)))
194.1875 +
194.1876 +(defn ref-history-count
194.1877 +  "Returns the history count of a ref"
194.1878 +  {:added "1.1"}
194.1879 +  [^clojure.lang.Ref ref]
194.1880 +    (.getHistoryCount ref))
194.1881 +
194.1882 +(defn ref-min-history
194.1883 +  "Gets the min-history of a ref, or sets it and returns the ref"
194.1884 +  {:added "1.1"}
194.1885 +  ([^clojure.lang.Ref ref]
194.1886 +    (.getMinHistory ref))
194.1887 +  ([^clojure.lang.Ref ref n]
194.1888 +    (.setMinHistory ref n)))
194.1889 +
194.1890 +(defn ref-max-history
194.1891 +  "Gets the max-history of a ref, or sets it and returns the ref"
194.1892 +  {:added "1.1"}
194.1893 +  ([^clojure.lang.Ref ref]
194.1894 +    (.getMaxHistory ref))
194.1895 +  ([^clojure.lang.Ref ref n]
194.1896 +    (.setMaxHistory ref n)))
194.1897 +
194.1898 +(defn ensure
194.1899 +  "Must be called in a transaction. Protects the ref from modification
194.1900 +  by other transactions.  Returns the in-transaction-value of
194.1901 +  ref. Allows for more concurrency than (ref-set ref @ref)"
194.1902 +  {:added "1.0"}
194.1903 +  [^clojure.lang.Ref ref]
194.1904 +    (. ref (touch))
194.1905 +    (. ref (deref)))
194.1906 +
194.1907 +(defmacro sync
194.1908 +  "transaction-flags => TBD, pass nil for now
194.1909 +
194.1910 +  Runs the exprs (in an implicit do) in a transaction that encompasses
194.1911 +  exprs and any nested calls.  Starts a transaction if none is already
194.1912 +  running on this thread. Any uncaught exception will abort the
194.1913 +  transaction and flow out of sync. The exprs may be run more than
194.1914 +  once, but any effects on Refs will be atomic."
194.1915 +  {:added "1.0"}
194.1916 +  [flags-ignored-for-now & body]
194.1917 +  `(. clojure.lang.LockingTransaction
194.1918 +      (runInTransaction (fn [] ~@body))))
194.1919 +
194.1920 +
194.1921 +(defmacro io!
194.1922 +  "If an io! block occurs in a transaction, throws an
194.1923 +  IllegalStateException, else runs body in an implicit do. If the
194.1924 +  first expression in body is a literal string, will use that as the
194.1925 +  exception message."
194.1926 +  {:added "1.0"}
194.1927 +  [& body]
194.1928 +  (let [message (when (string? (first body)) (first body))
194.1929 +        body (if message (next body) body)]
194.1930 +    `(if (clojure.lang.LockingTransaction/isRunning)
194.1931 +       (throw (new IllegalStateException ~(or message "I/O in transaction")))
194.1932 +       (do ~@body))))
194.1933 +
194.1934 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn stuff ;;;;;;;;;;;;;;;;
194.1935 +
194.1936 +
194.1937 +(defn comp
194.1938 +  "Takes a set of functions and returns a fn that is the composition
194.1939 +  of those fns.  The returned fn takes a variable number of args,
194.1940 +  applies the rightmost of fns to the args, the next
194.1941 +  fn (right-to-left) to the result, etc."
194.1942 +  {:added "1.0"}
194.1943 +  ([f] f)
194.1944 +  ([f g] 
194.1945 +     (fn 
194.1946 +       ([] (f (g)))
194.1947 +       ([x] (f (g x)))
194.1948 +       ([x y] (f (g x y)))
194.1949 +       ([x y z] (f (g x y z)))
194.1950 +       ([x y z & args] (f (apply g x y z args)))))
194.1951 +  ([f g h] 
194.1952 +     (fn 
194.1953 +       ([] (f (g (h))))
194.1954 +       ([x] (f (g (h x))))
194.1955 +       ([x y] (f (g (h x y))))
194.1956 +       ([x y z] (f (g (h x y z))))
194.1957 +       ([x y z & args] (f (g (apply h x y z args))))))
194.1958 +  ([f1 f2 f3 & fs]
194.1959 +    (let [fs (reverse (list* f1 f2 f3 fs))]
194.1960 +      (fn [& args]
194.1961 +        (loop [ret (apply (first fs) args) fs (next fs)]
194.1962 +          (if fs
194.1963 +            (recur ((first fs) ret) (next fs))
194.1964 +            ret))))))
194.1965 +
194.1966 +(defn juxt 
194.1967 +  "Alpha - name subject to change.
194.1968 +  Takes a set of functions and returns a fn that is the juxtaposition
194.1969 +  of those fns.  The returned fn takes a variable number of args, and
194.1970 +  returns a vector containing the result of applying each fn to the
194.1971 +  args (left-to-right).
194.1972 +  ((juxt a b c) x) => [(a x) (b x) (c x)]"
194.1973 +  {:added "1.1"}
194.1974 +  ([f] 
194.1975 +     (fn
194.1976 +       ([] [(f)])
194.1977 +       ([x] [(f x)])
194.1978 +       ([x y] [(f x y)])
194.1979 +       ([x y z] [(f x y z)])
194.1980 +       ([x y z & args] [(apply f x y z args)])))
194.1981 +  ([f g] 
194.1982 +     (fn
194.1983 +       ([] [(f) (g)])
194.1984 +       ([x] [(f x) (g x)])
194.1985 +       ([x y] [(f x y) (g x y)])
194.1986 +       ([x y z] [(f x y z) (g x y z)])
194.1987 +       ([x y z & args] [(apply f x y z args) (apply g x y z args)])))
194.1988 +  ([f g h] 
194.1989 +     (fn
194.1990 +       ([] [(f) (g) (h)])
194.1991 +       ([x] [(f x) (g x) (h x)])
194.1992 +       ([x y] [(f x y) (g x y) (h x y)])
194.1993 +       ([x y z] [(f x y z) (g x y z) (h x y z)])
194.1994 +       ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)])))
194.1995 +  ([f g h & fs]
194.1996 +     (let [fs (list* f g h fs)]
194.1997 +       (fn
194.1998 +         ([] (reduce #(conj %1 (%2)) [] fs))
194.1999 +         ([x] (reduce #(conj %1 (%2 x)) [] fs))
194.2000 +         ([x y] (reduce #(conj %1 (%2 x y)) [] fs))
194.2001 +         ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs))
194.2002 +         ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs))))))
194.2003 +
194.2004 +(defn partial
194.2005 +  "Takes a function f and fewer than the normal arguments to f, and
194.2006 +  returns a fn that takes a variable number of additional args. When
194.2007 +  called, the returned function calls f with args + additional args."
194.2008 +  {:added "1.0"}
194.2009 +  ([f arg1]
194.2010 +   (fn [& args] (apply f arg1 args)))
194.2011 +  ([f arg1 arg2]
194.2012 +   (fn [& args] (apply f arg1 arg2 args)))
194.2013 +  ([f arg1 arg2 arg3]
194.2014 +   (fn [& args] (apply f arg1 arg2 arg3 args)))
194.2015 +  ([f arg1 arg2 arg3 & more]
194.2016 +   (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))
194.2017 +
194.2018 +;;;;;;;;;;;;;;;;;;; sequence fns  ;;;;;;;;;;;;;;;;;;;;;;;
194.2019 +(defn sequence
194.2020 +  "Coerces coll to a (possibly empty) sequence, if it is not already
194.2021 +  one. Will not force a lazy seq. (sequence nil) yields ()"
194.2022 +  {:added "1.0"}
194.2023 +  [coll]
194.2024 +   (if (seq? coll) coll
194.2025 +    (or (seq coll) ())))
194.2026 +
194.2027 +(defn every?
194.2028 +  "Returns true if (pred x) is logical true for every x in coll, else
194.2029 +  false."
194.2030 +  {:tag Boolean
194.2031 +   :added "1.0"}
194.2032 +  [pred coll]
194.2033 +  (cond
194.2034 +   (nil? (seq coll)) true
194.2035 +   (pred (first coll)) (recur pred (next coll))
194.2036 +   :else false))
194.2037 +
194.2038 +(def
194.2039 + ^{:tag Boolean
194.2040 +   :doc "Returns false if (pred x) is logical true for every x in
194.2041 +  coll, else true."
194.2042 +   :arglists '([pred coll])
194.2043 +   :added "1.0"}
194.2044 + not-every? (comp not every?))
194.2045 +
194.2046 +(defn some
194.2047 +  "Returns the first logical true value of (pred x) for any x in coll,
194.2048 +  else nil.  One common idiom is to use a set as pred, for example
194.2049 +  this will return :fred if :fred is in the sequence, otherwise nil:
194.2050 +  (some #{:fred} coll)"
194.2051 +  {:added "1.0"}
194.2052 +  [pred coll]
194.2053 +    (when (seq coll)
194.2054 +      (or (pred (first coll)) (recur pred (next coll)))))
194.2055 +
194.2056 +(def
194.2057 + ^{:tag Boolean
194.2058 +   :doc "Returns false if (pred x) is logical true for any x in coll,
194.2059 +  else true."
194.2060 +   :arglists '([pred coll])
194.2061 +   :added "1.0"}
194.2062 + not-any? (comp not some))
194.2063 +
194.2064 +;will be redefed later with arg checks
194.2065 +(defmacro dotimes
194.2066 +  "bindings => name n
194.2067 +
194.2068 +  Repeatedly executes body (presumably for side-effects) with name
194.2069 +  bound to integers from 0 through n-1."
194.2070 +  {:added "1.0"}
194.2071 +  [bindings & body]
194.2072 +  (let [i (first bindings)
194.2073 +        n (second bindings)]
194.2074 +    `(let [n# (int ~n)]
194.2075 +       (loop [~i (int 0)]
194.2076 +         (when (< ~i n#)
194.2077 +           ~@body
194.2078 +           (recur (inc ~i)))))))
194.2079 +
194.2080 +(defn map
194.2081 +  "Returns a lazy sequence consisting of the result of applying f to the
194.2082 +  set of first items of each coll, followed by applying f to the set
194.2083 +  of second items in each coll, until any one of the colls is
194.2084 +  exhausted.  Any remaining items in other colls are ignored. Function
194.2085 +  f should accept number-of-colls arguments."
194.2086 +  {:added "1.0"}
194.2087 +  ([f coll]
194.2088 +   (lazy-seq
194.2089 +    (when-let [s (seq coll)]
194.2090 +      (if (chunked-seq? s)
194.2091 +        (let [c (chunk-first s)
194.2092 +              size (int (count c))
194.2093 +              b (chunk-buffer size)]
194.2094 +          (dotimes [i size]
194.2095 +              (chunk-append b (f (.nth c i))))
194.2096 +          (chunk-cons (chunk b) (map f (chunk-rest s))))
194.2097 +        (cons (f (first s)) (map f (rest s)))))))
194.2098 +  ([f c1 c2]
194.2099 +   (lazy-seq
194.2100 +    (let [s1 (seq c1) s2 (seq c2)]
194.2101 +      (when (and s1 s2)
194.2102 +        (cons (f (first s1) (first s2))
194.2103 +              (map f (rest s1) (rest s2)))))))
194.2104 +  ([f c1 c2 c3]
194.2105 +   (lazy-seq
194.2106 +    (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)]
194.2107 +      (when (and  s1 s2 s3)
194.2108 +        (cons (f (first s1) (first s2) (first s3))
194.2109 +              (map f (rest s1) (rest s2) (rest s3)))))))
194.2110 +  ([f c1 c2 c3 & colls]
194.2111 +   (let [step (fn step [cs]
194.2112 +                 (lazy-seq
194.2113 +                  (let [ss (map seq cs)]
194.2114 +                    (when (every? identity ss)
194.2115 +                      (cons (map first ss) (step (map rest ss)))))))]
194.2116 +     (map #(apply f %) (step (conj colls c3 c2 c1))))))
194.2117 +
194.2118 +(defn mapcat
194.2119 +  "Returns the result of applying concat to the result of applying map
194.2120 +  to f and colls.  Thus function f should return a collection."
194.2121 +  {:added "1.0"}
194.2122 +  [f & colls]
194.2123 +    (apply concat (apply map f colls)))
194.2124 +
194.2125 +(defn filter
194.2126 +  "Returns a lazy sequence of the items in coll for which
194.2127 +  (pred item) returns true. pred must be free of side-effects."
194.2128 +  {:added "1.0"}
194.2129 +  ([pred coll]
194.2130 +   (lazy-seq
194.2131 +    (when-let [s (seq coll)]
194.2132 +      (if (chunked-seq? s)
194.2133 +        (let [c (chunk-first s)
194.2134 +              size (count c)
194.2135 +              b (chunk-buffer size)]
194.2136 +          (dotimes [i size]
194.2137 +              (when (pred (.nth c i))
194.2138 +                (chunk-append b (.nth c i))))
194.2139 +          (chunk-cons (chunk b) (filter pred (chunk-rest s))))
194.2140 +        (let [f (first s) r (rest s)]
194.2141 +          (if (pred f)
194.2142 +            (cons f (filter pred r))
194.2143 +            (filter pred r))))))))
194.2144 +
194.2145 +
194.2146 +(defn remove
194.2147 +  "Returns a lazy sequence of the items in coll for which
194.2148 +  (pred item) returns false. pred must be free of side-effects."
194.2149 +  {:added "1.0"}
194.2150 +  [pred coll]
194.2151 +  (filter (complement pred) coll))
194.2152 +
194.2153 +(defn take
194.2154 +  "Returns a lazy sequence of the first n items in coll, or all items if
194.2155 +  there are fewer than n."
194.2156 +  {:added "1.0"}
194.2157 +  [n coll]
194.2158 +  (lazy-seq
194.2159 +   (when (pos? n) 
194.2160 +     (when-let [s (seq coll)]
194.2161 +      (cons (first s) (take (dec n) (rest s)))))))
194.2162 +
194.2163 +(defn take-while
194.2164 +  "Returns a lazy sequence of successive items from coll while
194.2165 +  (pred item) returns true. pred must be free of side-effects."
194.2166 +  {:added "1.0"}
194.2167 +  [pred coll]
194.2168 +  (lazy-seq
194.2169 +   (when-let [s (seq coll)]
194.2170 +       (when (pred (first s))
194.2171 +         (cons (first s) (take-while pred (rest s)))))))
194.2172 +
194.2173 +(defn drop
194.2174 +  "Returns a lazy sequence of all but the first n items in coll."
194.2175 +  {:added "1.0"}
194.2176 +  [n coll]
194.2177 +  (let [step (fn [n coll]
194.2178 +               (let [s (seq coll)]
194.2179 +                 (if (and (pos? n) s)
194.2180 +                   (recur (dec n) (rest s))
194.2181 +                   s)))]
194.2182 +    (lazy-seq (step n coll))))
194.2183 +
194.2184 +(defn drop-last
194.2185 +  "Return a lazy sequence of all but the last n (default 1) items in coll"
194.2186 +  {:added "1.0"}
194.2187 +  ([s] (drop-last 1 s))
194.2188 +  ([n s] (map (fn [x _] x) s (drop n s))))
194.2189 +
194.2190 +(defn take-last
194.2191 +  "Returns a seq of the last n items in coll.  Depending on the type
194.2192 +  of coll may be no better than linear time.  For vectors, see also subvec."
194.2193 +  {:added "1.1"}
194.2194 +  [n coll]
194.2195 +  (loop [s (seq coll), lead (seq (drop n coll))]
194.2196 +    (if lead
194.2197 +      (recur (next s) (next lead))
194.2198 +      s)))
194.2199 +
194.2200 +(defn drop-while
194.2201 +  "Returns a lazy sequence of the items in coll starting from the first
194.2202 +  item for which (pred item) returns nil."
194.2203 +  {:added "1.0"}
194.2204 +  [pred coll]
194.2205 +  (let [step (fn [pred coll]
194.2206 +               (let [s (seq coll)]
194.2207 +                 (if (and s (pred (first s)))
194.2208 +                   (recur pred (rest s))
194.2209 +                   s)))]
194.2210 +    (lazy-seq (step pred coll))))
194.2211 +
194.2212 +(defn cycle
194.2213 +  "Returns a lazy (infinite!) sequence of repetitions of the items in coll."
194.2214 +  {:added "1.0"}
194.2215 +  [coll] (lazy-seq 
194.2216 +          (when-let [s (seq coll)] 
194.2217 +              (concat s (cycle s)))))
194.2218 +
194.2219 +(defn split-at
194.2220 +  "Returns a vector of [(take n coll) (drop n coll)]"
194.2221 +  {:added "1.0"}
194.2222 +  [n coll]
194.2223 +    [(take n coll) (drop n coll)])
194.2224 +
194.2225 +(defn split-with
194.2226 +  "Returns a vector of [(take-while pred coll) (drop-while pred coll)]"
194.2227 +  {:added "1.0"}
194.2228 +  [pred coll]
194.2229 +    [(take-while pred coll) (drop-while pred coll)])
194.2230 +
194.2231 +(defn repeat
194.2232 +  "Returns a lazy (infinite!, or length n if supplied) sequence of xs."
194.2233 +  {:added "1.0"}
194.2234 +  ([x] (lazy-seq (cons x (repeat x))))
194.2235 +  ([n x] (take n (repeat x))))
194.2236 +
194.2237 +(defn replicate
194.2238 +  "Returns a lazy seq of n xs."
194.2239 +  {:added "1.0"}
194.2240 +  [n x] (take n (repeat x)))
194.2241 +
194.2242 +(defn iterate
194.2243 +  "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"
194.2244 +  {:added "1.0"}
194.2245 +  [f x] (cons x (lazy-seq (iterate f (f x)))))
194.2246 +
194.2247 +(defn range 
194.2248 +  "Returns a lazy seq of nums from start (inclusive) to end
194.2249 +  (exclusive), by step, where start defaults to 0, step to 1, and end
194.2250 +  to infinity."
194.2251 +  {:added "1.0"}
194.2252 +  ([] (range 0 Double/POSITIVE_INFINITY 1))
194.2253 +  ([end] (range 0 end 1))
194.2254 +  ([start end] (range start end 1))
194.2255 +  ([start end step]
194.2256 +   (lazy-seq
194.2257 +    (let [b (chunk-buffer 32)
194.2258 +          comp (if (pos? step) < >)]
194.2259 +      (loop [i start]
194.2260 +        (if (and (< (count b) 32)
194.2261 +                 (comp i end))
194.2262 +          (do
194.2263 +            (chunk-append b i)
194.2264 +            (recur (+ i step)))
194.2265 +          (chunk-cons (chunk b) 
194.2266 +                      (when (comp i end) 
194.2267 +                        (range i end step)))))))))
194.2268 +
194.2269 +(defn merge
194.2270 +  "Returns a map that consists of the rest of the maps conj-ed onto
194.2271 +  the first.  If a key occurs in more than one map, the mapping from
194.2272 +  the latter (left-to-right) will be the mapping in the result."
194.2273 +  {:added "1.0"}
194.2274 +  [& maps]
194.2275 +  (when (some identity maps)
194.2276 +    (reduce #(conj (or %1 {}) %2) maps)))
194.2277 +
194.2278 +(defn merge-with
194.2279 +  "Returns a map that consists of the rest of the maps conj-ed onto
194.2280 +  the first.  If a key occurs in more than one map, the mapping(s)
194.2281 +  from the latter (left-to-right) will be combined with the mapping in
194.2282 +  the result by calling (f val-in-result val-in-latter)."
194.2283 +  {:added "1.0"}
194.2284 +  [f & maps]
194.2285 +  (when (some identity maps)
194.2286 +    (let [merge-entry (fn [m e]
194.2287 +			(let [k (key e) v (val e)]
194.2288 +			  (if (contains? m k)
194.2289 +			    (assoc m k (f (get m k) v))
194.2290 +			    (assoc m k v))))
194.2291 +          merge2 (fn [m1 m2]
194.2292 +		   (reduce merge-entry (or m1 {}) (seq m2)))]
194.2293 +      (reduce merge2 maps))))
194.2294 +
194.2295 +
194.2296 +
194.2297 +(defn zipmap
194.2298 +  "Returns a map with the keys mapped to the corresponding vals."
194.2299 +  {:added "1.0"}
194.2300 +  [keys vals]
194.2301 +    (loop [map {}
194.2302 +           ks (seq keys)
194.2303 +           vs (seq vals)]
194.2304 +      (if (and ks vs)
194.2305 +        (recur (assoc map (first ks) (first vs))
194.2306 +               (next ks)
194.2307 +               (next vs))
194.2308 +        map)))
194.2309 +
194.2310 +(defmacro declare
194.2311 +  "defs the supplied var names with no bindings, useful for making forward declarations."
194.2312 +  {:added "1.0"}
194.2313 +  [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names)))
194.2314 +
194.2315 +(defn line-seq
194.2316 +  "Returns the lines of text from rdr as a lazy sequence of strings.
194.2317 +  rdr must implement java.io.BufferedReader."
194.2318 +  {:added "1.0"}
194.2319 +  [^java.io.BufferedReader rdr]
194.2320 +  (when-let [line (.readLine rdr)]
194.2321 +    (cons line (lazy-seq (line-seq rdr)))))
194.2322 +
194.2323 +(defn comparator
194.2324 +  "Returns an implementation of java.util.Comparator based upon pred."
194.2325 +  {:added "1.0"}
194.2326 +  [pred]
194.2327 +    (fn [x y]
194.2328 +      (cond (pred x y) -1 (pred y x) 1 :else 0)))
194.2329 +
194.2330 +(defn sort
194.2331 +  "Returns a sorted sequence of the items in coll. If no comparator is
194.2332 +  supplied, uses compare. comparator must
194.2333 +  implement java.util.Comparator."
194.2334 +  {:added "1.0"}
194.2335 +  ([coll]
194.2336 +   (sort compare coll))
194.2337 +  ([^java.util.Comparator comp coll]
194.2338 +   (if (seq coll)
194.2339 +     (let [a (to-array coll)]
194.2340 +       (. java.util.Arrays (sort a comp))
194.2341 +       (seq a))
194.2342 +     ())))
194.2343 +
194.2344 +(defn sort-by
194.2345 +  "Returns a sorted sequence of the items in coll, where the sort
194.2346 +  order is determined by comparing (keyfn item).  If no comparator is
194.2347 +  supplied, uses compare. comparator must
194.2348 +  implement java.util.Comparator."
194.2349 +  {:added "1.0"}
194.2350 +  ([keyfn coll]
194.2351 +   (sort-by keyfn compare coll))
194.2352 +  ([keyfn ^java.util.Comparator comp coll]
194.2353 +   (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll)))
194.2354 +
194.2355 +(defn partition
194.2356 +  "Returns a lazy sequence of lists of n items each, at offsets step
194.2357 +  apart. If step is not supplied, defaults to n, i.e. the partitions
194.2358 +  do not overlap. If a pad collection is supplied, use its elements as
194.2359 +  necessary to complete last partition upto n items. In case there are
194.2360 +  not enough padding elements, return a partition with less than n items."
194.2361 +  {:added "1.0"}
194.2362 +  ([n coll]
194.2363 +     (partition n n coll))
194.2364 +  ([n step coll]
194.2365 +     (lazy-seq
194.2366 +       (when-let [s (seq coll)]
194.2367 +         (let [p (take n s)]
194.2368 +           (when (= n (count p))
194.2369 +             (cons p (partition n step (drop step s))))))))
194.2370 +  ([n step pad coll]
194.2371 +     (lazy-seq
194.2372 +       (when-let [s (seq coll)]
194.2373 +         (let [p (take n s)]
194.2374 +           (if (= n (count p))
194.2375 +             (cons p (partition n step pad (drop step s)))
194.2376 +             (list (take n (concat p pad)))))))))
194.2377 +
194.2378 +;; evaluation
194.2379 +
194.2380 +(defn eval
194.2381 +  "Evaluates the form data structure (not text!) and returns the result."
194.2382 +  {:added "1.0"}
194.2383 +  [form] (. clojure.lang.Compiler (eval form)))
194.2384 +
194.2385 +(defmacro doseq
194.2386 +  "Repeatedly executes body (presumably for side-effects) with
194.2387 +  bindings and filtering as provided by \"for\".  Does not retain
194.2388 +  the head of the sequence. Returns nil."
194.2389 +  {:added "1.0"}
194.2390 +  [seq-exprs & body]
194.2391 +  (assert-args doseq
194.2392 +     (vector? seq-exprs) "a vector for its binding"
194.2393 +     (even? (count seq-exprs)) "an even number of forms in binding vector")
194.2394 +  (let [step (fn step [recform exprs]
194.2395 +               (if-not exprs
194.2396 +                 [true `(do ~@body)]
194.2397 +                 (let [k (first exprs)
194.2398 +                       v (second exprs)]
194.2399 +                   (if (keyword? k)
194.2400 +                     (let [steppair (step recform (nnext exprs))
194.2401 +                           needrec (steppair 0)
194.2402 +                           subform (steppair 1)]
194.2403 +                       (cond
194.2404 +                         (= k :let) [needrec `(let ~v ~subform)]
194.2405 +                         (= k :while) [false `(when ~v
194.2406 +                                                ~subform
194.2407 +                                                ~@(when needrec [recform]))]
194.2408 +                         (= k :when) [false `(if ~v
194.2409 +                                               (do
194.2410 +                                                 ~subform
194.2411 +                                                 ~@(when needrec [recform]))
194.2412 +                                               ~recform)]))
194.2413 +                     (let [seq- (gensym "seq_")
194.2414 +                           chunk- (with-meta (gensym "chunk_")
194.2415 +                                             {:tag 'clojure.lang.IChunk})
194.2416 +                           count- (gensym "count_")
194.2417 +                           i- (gensym "i_")
194.2418 +                           recform `(recur (next ~seq-) nil (int 0) (int 0))
194.2419 +                           steppair (step recform (nnext exprs))
194.2420 +                           needrec (steppair 0)
194.2421 +                           subform (steppair 1)
194.2422 +                           recform-chunk 
194.2423 +                             `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-))
194.2424 +                           steppair-chunk (step recform-chunk (nnext exprs))
194.2425 +                           subform-chunk (steppair-chunk 1)]
194.2426 +                       [true
194.2427 +                        `(loop [~seq- (seq ~v), ~chunk- nil,
194.2428 +                                ~count- (int 0), ~i- (int 0)]
194.2429 +                           (if (< ~i- ~count-)
194.2430 +                             (let [~k (.nth ~chunk- ~i-)]
194.2431 +                               ~subform-chunk
194.2432 +                               ~@(when needrec [recform-chunk]))
194.2433 +                             (when-let [~seq- (seq ~seq-)]
194.2434 +                               (if (chunked-seq? ~seq-)
194.2435 +                                 (let [c# (chunk-first ~seq-)]
194.2436 +                                   (recur (chunk-rest ~seq-) c#
194.2437 +                                          (int (count c#)) (int 0)))
194.2438 +                                 (let [~k (first ~seq-)]
194.2439 +                                   ~subform
194.2440 +                                   ~@(when needrec [recform]))))))])))))]
194.2441 +    (nth (step nil (seq seq-exprs)) 1)))
194.2442 +
194.2443 +(defn dorun
194.2444 +  "When lazy sequences are produced via functions that have side
194.2445 +  effects, any effects other than those needed to produce the first
194.2446 +  element in the seq do not occur until the seq is consumed. dorun can
194.2447 +  be used to force any effects. Walks through the successive nexts of
194.2448 +  the seq, does not retain the head and returns nil."
194.2449 +  {:added "1.0"}
194.2450 +  ([coll]
194.2451 +   (when (seq coll)
194.2452 +     (recur (next coll))))
194.2453 +  ([n coll]
194.2454 +   (when (and (seq coll) (pos? n))
194.2455 +     (recur (dec n) (next coll)))))
194.2456 +
194.2457 +(defn doall
194.2458 +  "When lazy sequences are produced via functions that have side
194.2459 +  effects, any effects other than those needed to produce the first
194.2460 +  element in the seq do not occur until the seq is consumed. doall can
194.2461 +  be used to force any effects. Walks through the successive nexts of
194.2462 +  the seq, retains the head and returns it, thus causing the entire
194.2463 +  seq to reside in memory at one time."
194.2464 +  {:added "1.0"}
194.2465 +  ([coll]
194.2466 +   (dorun coll)
194.2467 +   coll)
194.2468 +  ([n coll]
194.2469 +   (dorun n coll)
194.2470 +   coll))
194.2471 +
194.2472 +(defn await
194.2473 +  "Blocks the current thread (indefinitely!) until all actions
194.2474 +  dispatched thus far, from this thread or agent, to the agent(s) have
194.2475 +  occurred.  Will block on failed agents.  Will never return if
194.2476 +  a failed agent is restarted with :clear-actions true."
194.2477 +  {:added "1.0"}
194.2478 +  [& agents]
194.2479 +  (io! "await in transaction"
194.2480 +    (when *agent*
194.2481 +      (throw (new Exception "Can't await in agent action")))
194.2482 +    (let [latch (new java.util.concurrent.CountDownLatch (count agents))
194.2483 +          count-down (fn [agent] (. latch (countDown)) agent)]
194.2484 +      (doseq [agent agents]
194.2485 +        (send agent count-down))
194.2486 +      (. latch (await)))))
194.2487 +
194.2488 +(defn await1 [^clojure.lang.Agent a]
194.2489 +  (when (pos? (.getQueueCount a))
194.2490 +    (await a))
194.2491 +    a)
194.2492 +
194.2493 +(defn await-for
194.2494 +  "Blocks the current thread until all actions dispatched thus
194.2495 +  far (from this thread or agent) to the agents have occurred, or the
194.2496 +  timeout (in milliseconds) has elapsed. Returns nil if returning due
194.2497 +  to timeout, non-nil otherwise."
194.2498 +  {:added "1.0"}
194.2499 +  [timeout-ms & agents]
194.2500 +    (io! "await-for in transaction"
194.2501 +     (when *agent*
194.2502 +       (throw (new Exception "Can't await in agent action")))
194.2503 +     (let [latch (new java.util.concurrent.CountDownLatch (count agents))
194.2504 +           count-down (fn [agent] (. latch (countDown)) agent)]
194.2505 +       (doseq [agent agents]
194.2506 +           (send agent count-down))
194.2507 +       (. latch (await  timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS))))))
194.2508 +
194.2509 +(defmacro dotimes
194.2510 +  "bindings => name n
194.2511 +
194.2512 +  Repeatedly executes body (presumably for side-effects) with name
194.2513 +  bound to integers from 0 through n-1."
194.2514 +  {:added "1.0"}
194.2515 +  [bindings & body]
194.2516 +  (assert-args dotimes
194.2517 +     (vector? bindings) "a vector for its binding"
194.2518 +     (= 2 (count bindings)) "exactly 2 forms in binding vector")
194.2519 +  (let [i (first bindings)
194.2520 +        n (second bindings)]
194.2521 +    `(let [n# (int ~n)]
194.2522 +       (loop [~i (int 0)]
194.2523 +         (when (< ~i n#)
194.2524 +           ~@body
194.2525 +           (recur (unchecked-inc ~i)))))))
194.2526 +
194.2527 +#_(defn into
194.2528 +  "Returns a new coll consisting of to-coll with all of the items of
194.2529 +  from-coll conjoined."
194.2530 +  {:added "1.0"}
194.2531 +  [to from]
194.2532 +    (let [ret to items (seq from)]
194.2533 +      (if items
194.2534 +        (recur (conj ret (first items)) (next items))
194.2535 +        ret)))
194.2536 +
194.2537 +;;;;;;;;;;;;;;;;;;;;; editable collections ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
194.2538 +(defn transient 
194.2539 +  "Alpha - subject to change.
194.2540 +  Returns a new, transient version of the collection, in constant time."
194.2541 +  {:added "1.1"}
194.2542 +  [^clojure.lang.IEditableCollection coll] 
194.2543 +  (.asTransient coll))
194.2544 +
194.2545 +(defn persistent! 
194.2546 +  "Alpha - subject to change.
194.2547 +  Returns a new, persistent version of the transient collection, in
194.2548 +  constant time. The transient collection cannot be used after this
194.2549 +  call, any such use will throw an exception."
194.2550 +  {:added "1.1"}
194.2551 +  [^clojure.lang.ITransientCollection coll]
194.2552 +  (.persistent coll))
194.2553 +
194.2554 +(defn conj!
194.2555 +  "Alpha - subject to change.
194.2556 +  Adds x to the transient collection, and return coll. The 'addition'
194.2557 +  may happen at different 'places' depending on the concrete type."
194.2558 +  {:added "1.1"}
194.2559 +  [^clojure.lang.ITransientCollection coll x]
194.2560 +  (.conj coll x))
194.2561 +
194.2562 +(defn assoc!
194.2563 +  "Alpha - subject to change.
194.2564 +  When applied to a transient map, adds mapping of key(s) to
194.2565 +  val(s). When applied to a transient vector, sets the val at index.
194.2566 +  Note - index must be <= (count vector). Returns coll."
194.2567 +  {:added "1.1"}
194.2568 +  ([^clojure.lang.ITransientAssociative coll key val] (.assoc coll key val))
194.2569 +  ([^clojure.lang.ITransientAssociative coll key val & kvs]
194.2570 +   (let [ret (.assoc coll key val)]
194.2571 +     (if kvs
194.2572 +       (recur ret (first kvs) (second kvs) (nnext kvs))
194.2573 +       ret))))
194.2574 +
194.2575 +(defn dissoc!
194.2576 +  "Alpha - subject to change.
194.2577 +  Returns a transient map that doesn't contain a mapping for key(s)."
194.2578 +  {:added "1.1"}
194.2579 +  ([^clojure.lang.ITransientMap map key] (.without map key))
194.2580 +  ([^clojure.lang.ITransientMap map key & ks]
194.2581 +   (let [ret (.without map key)]
194.2582 +     (if ks
194.2583 +       (recur ret (first ks) (next ks))
194.2584 +       ret))))
194.2585 +
194.2586 +(defn pop!
194.2587 +  "Alpha - subject to change.
194.2588 +  Removes the last item from a transient vector. If
194.2589 +  the collection is empty, throws an exception. Returns coll"
194.2590 +  {:added "1.1"}
194.2591 +  [^clojure.lang.ITransientVector coll] 
194.2592 +  (.pop coll)) 
194.2593 +
194.2594 +(defn disj!
194.2595 +  "Alpha - subject to change.
194.2596 +  disj[oin]. Returns a transient set of the same (hashed/sorted) type, that
194.2597 +  does not contain key(s)."
194.2598 +  {:added "1.1"}
194.2599 +  ([set] set)
194.2600 +  ([^clojure.lang.ITransientSet set key]
194.2601 +   (. set (disjoin key)))
194.2602 +  ([set key & ks]
194.2603 +   (let [ret (disj set key)]
194.2604 +     (if ks
194.2605 +       (recur ret (first ks) (next ks))
194.2606 +       ret))))
194.2607 +
194.2608 +;redef into with batch support
194.2609 +(defn into
194.2610 +  "Returns a new coll consisting of to-coll with all of the items of
194.2611 +  from-coll conjoined."
194.2612 +  {:added "1.0"}
194.2613 +  [to from]
194.2614 +  (if (instance? clojure.lang.IEditableCollection to)
194.2615 +    (persistent! (reduce conj! (transient to) from))
194.2616 +    (reduce conj to from)))
194.2617 +
194.2618 +(defmacro import 
194.2619 +  "import-list => (package-symbol class-name-symbols*)
194.2620 +
194.2621 +  For each name in class-name-symbols, adds a mapping from name to the
194.2622 +  class named by package.name to the current namespace. Use :import in the ns
194.2623 +  macro in preference to calling this directly."
194.2624 +  {:added "1.0"}
194.2625 +  [& import-symbols-or-lists]
194.2626 +  (let [specs (map #(if (and (seq? %) (= 'quote (first %))) (second %) %) 
194.2627 +                   import-symbols-or-lists)]
194.2628 +    `(do ~@(map #(list 'clojure.core/import* %)
194.2629 +                (reduce (fn [v spec] 
194.2630 +                          (if (symbol? spec)
194.2631 +                            (conj v (name spec))
194.2632 +                            (let [p (first spec) cs (rest spec)]
194.2633 +                              (into v (map #(str p "." %) cs)))))
194.2634 +                        [] specs)))))
194.2635 +
194.2636 +(defn into-array
194.2637 +  "Returns an array with components set to the values in aseq. The array's
194.2638 +  component type is type if provided, or the type of the first value in
194.2639 +  aseq if present, or Object. All values in aseq must be compatible with
194.2640 +  the component type. Class objects for the primitive types can be obtained
194.2641 +  using, e.g., Integer/TYPE."
194.2642 +  {:added "1.0"}
194.2643 +  ([aseq]
194.2644 +     (clojure.lang.RT/seqToTypedArray (seq aseq)))
194.2645 +  ([type aseq]
194.2646 +     (clojure.lang.RT/seqToTypedArray type (seq aseq))))
194.2647 +
194.2648 +(defn ^{:private true}
194.2649 +  array [& items]
194.2650 +    (into-array items))
194.2651 +
194.2652 +(defn ^Class class
194.2653 +  "Returns the Class of x"
194.2654 +  {:added "1.0"}
194.2655 +  [^Object x] (if (nil? x) x (. x (getClass))))
194.2656 +
194.2657 +(defn type 
194.2658 +  "Returns the :type metadata of x, or its Class if none"
194.2659 +  {:added "1.0"}
194.2660 +  [x]
194.2661 +  (or (:type (meta x)) (class x)))
194.2662 +
194.2663 +(defn num
194.2664 +  "Coerce to Number"
194.2665 +  {:tag Number
194.2666 +   :inline (fn  [x] `(. clojure.lang.Numbers (num ~x)))
194.2667 +   :added "1.0"}
194.2668 +  [x] (. clojure.lang.Numbers (num x)))
194.2669 +
194.2670 +(defn long
194.2671 +  "Coerce to long"
194.2672 +  {:tag Long
194.2673 +   :inline (fn  [x] `(. clojure.lang.RT (longCast ~x)))
194.2674 +   :added "1.0"}
194.2675 +  [^Number x] (clojure.lang.RT/longCast x))
194.2676 +
194.2677 +(defn float
194.2678 +  "Coerce to float"
194.2679 +  {:tag Float
194.2680 +   :inline (fn  [x] `(. clojure.lang.RT (floatCast ~x)))
194.2681 +   :added "1.0"}
194.2682 +  [^Number x] (clojure.lang.RT/floatCast x))
194.2683 +
194.2684 +(defn double
194.2685 +  "Coerce to double"
194.2686 +  {:tag Double
194.2687 +   :inline (fn  [x] `(. clojure.lang.RT (doubleCast ~x)))
194.2688 +   :added "1.0"}
194.2689 +  [^Number x] (clojure.lang.RT/doubleCast x))
194.2690 +
194.2691 +(defn short
194.2692 +  "Coerce to short"
194.2693 +  {:tag Short
194.2694 +   :inline (fn  [x] `(. clojure.lang.RT (shortCast ~x)))
194.2695 +   :added "1.0"}
194.2696 +  [^Number x] (clojure.lang.RT/shortCast x))
194.2697 +
194.2698 +(defn byte
194.2699 +  "Coerce to byte"
194.2700 +  {:tag Byte
194.2701 +   :inline (fn  [x] `(. clojure.lang.RT (byteCast ~x)))
194.2702 +   :added "1.0"}
194.2703 +  [^Number x] (clojure.lang.RT/byteCast x))
194.2704 +
194.2705 +(defn char
194.2706 +  "Coerce to char"
194.2707 +  {:tag Character
194.2708 +   :inline (fn  [x] `(. clojure.lang.RT (charCast ~x)))
194.2709 +   :added "1.1"}
194.2710 +  [x] (. clojure.lang.RT (charCast x)))
194.2711 +
194.2712 +(defn boolean
194.2713 +  "Coerce to boolean"
194.2714 +  {
194.2715 +   :inline (fn  [x] `(. clojure.lang.RT (booleanCast ~x)))
194.2716 +   :added "1.0"}
194.2717 +  [x] (clojure.lang.RT/booleanCast x))
194.2718 +
194.2719 +(defn number?
194.2720 +  "Returns true if x is a Number"
194.2721 +  {:added "1.0"}
194.2722 +  [x]
194.2723 +  (instance? Number x))
194.2724 +
194.2725 +(defn integer?
194.2726 +  "Returns true if n is an integer"
194.2727 +  {:added "1.0"}
194.2728 +  [n]
194.2729 +  (or (instance? Integer n)
194.2730 +      (instance? Long n)
194.2731 +      (instance? BigInteger n)
194.2732 +      (instance? Short n)
194.2733 +      (instance? Byte n)))
194.2734 +
194.2735 +(defn mod
194.2736 +  "Modulus of num and div. Truncates toward negative infinity."
194.2737 +  {:added "1.0"}
194.2738 +  [num div] 
194.2739 +  (let [m (rem num div)] 
194.2740 +    (if (or (zero? m) (pos? (* num div))) 
194.2741 +      m 
194.2742 +      (+ m div))))
194.2743 +
194.2744 +(defn ratio?
194.2745 +  "Returns true if n is a Ratio"
194.2746 +  {:added "1.0"}
194.2747 +  [n] (instance? clojure.lang.Ratio n))
194.2748 +
194.2749 +(defn numerator
194.2750 +  "Returns the numerator part of a Ratio."
194.2751 +  {:tag BigInteger
194.2752 +   :added "1.2"}
194.2753 +  [r]
194.2754 +  (.numerator ^clojure.lang.Ratio r))
194.2755 +
194.2756 +(defn denominator
194.2757 +  "Returns the denominator part of a Ratio."
194.2758 +  {:tag BigInteger
194.2759 +   :added "1.2"}
194.2760 +  [r]
194.2761 +  (.denominator ^clojure.lang.Ratio r))
194.2762 +
194.2763 +(defn decimal?
194.2764 +  "Returns true if n is a BigDecimal"
194.2765 +  {:added "1.0"}
194.2766 +  [n] (instance? BigDecimal n))
194.2767 +
194.2768 +(defn float?
194.2769 +  "Returns true if n is a floating point number"
194.2770 +  {:added "1.0"}
194.2771 +  [n]
194.2772 +  (or (instance? Double n)
194.2773 +      (instance? Float n)))
194.2774 +
194.2775 +(defn rational? [n]
194.2776 +  "Returns true if n is a rational number"
194.2777 +  {:added "1.0"}
194.2778 +  (or (integer? n) (ratio? n) (decimal? n)))
194.2779 +
194.2780 +(defn bigint
194.2781 +  "Coerce to BigInteger"
194.2782 +  {:tag BigInteger
194.2783 +   :added "1.0"}
194.2784 +  [x] (cond
194.2785 +       (instance? BigInteger x) x
194.2786 +       (decimal? x) (.toBigInteger ^BigDecimal x)
194.2787 +       (ratio? x) (.bigIntegerValue ^clojure.lang.Ratio x)
194.2788 +       (number? x) (BigInteger/valueOf (long x))
194.2789 +       :else (BigInteger. x)))
194.2790 +
194.2791 +(defn bigdec
194.2792 +  "Coerce to BigDecimal"
194.2793 +  {:tag BigDecimal
194.2794 +   :added "1.0"}
194.2795 +  [x] (cond
194.2796 +       (decimal? x) x
194.2797 +       (float? x) (. BigDecimal valueOf (double x))
194.2798 +       (ratio? x) (/ (BigDecimal. (.numerator x)) (.denominator x))
194.2799 +       (instance? BigInteger x) (BigDecimal. ^BigInteger x)
194.2800 +       (number? x) (BigDecimal/valueOf (long x))
194.2801 +       :else (BigDecimal. x)))
194.2802 +
194.2803 +(def ^{:private true} print-initialized false)
194.2804 +
194.2805 +(defmulti print-method (fn [x writer] (type x)))
194.2806 +(defmulti print-dup (fn [x writer] (class x)))
194.2807 +
194.2808 +(defn pr-on
194.2809 +  {:private true}
194.2810 +  [x w]
194.2811 +  (if *print-dup*
194.2812 +    (print-dup x w)
194.2813 +    (print-method x w))
194.2814 +  nil)
194.2815 +
194.2816 +(defn pr
194.2817 +  "Prints the object(s) to the output stream that is the current value
194.2818 +  of *out*.  Prints the object(s), separated by spaces if there is
194.2819 +  more than one.  By default, pr and prn print in a way that objects
194.2820 +  can be read by the reader"
194.2821 +  {:dynamic true
194.2822 +   :added "1.0"}
194.2823 +  ([] nil)
194.2824 +  ([x]
194.2825 +     (pr-on x *out*))
194.2826 +  ([x & more]
194.2827 +   (pr x)
194.2828 +   (. *out* (append \space))
194.2829 +   (if-let [nmore (next more)]
194.2830 +     (recur (first more) nmore)
194.2831 +     (apply pr more))))
194.2832 +
194.2833 +(defn newline
194.2834 +  "Writes a newline to the output stream that is the current value of
194.2835 +  *out*"
194.2836 +  {:added "1.0"}
194.2837 +  []
194.2838 +    (. *out* (append \newline))
194.2839 +    nil)
194.2840 +
194.2841 +(defn flush
194.2842 +  "Flushes the output stream that is the current value of
194.2843 +  *out*"
194.2844 +  {:added "1.0"}
194.2845 +  []
194.2846 +    (. *out* (flush))
194.2847 +    nil)
194.2848 +
194.2849 +(defn prn
194.2850 +  "Same as pr followed by (newline). Observes *flush-on-newline*"
194.2851 +  {:added "1.0"}
194.2852 +  [& more]
194.2853 +    (apply pr more)
194.2854 +    (newline)
194.2855 +    (when *flush-on-newline*
194.2856 +      (flush)))
194.2857 +
194.2858 +(defn print
194.2859 +  "Prints the object(s) to the output stream that is the current value
194.2860 +  of *out*.  print and println produce output for human consumption."
194.2861 +  {:added "1.0"}
194.2862 +  [& more]
194.2863 +    (binding [*print-readably* nil]
194.2864 +      (apply pr more)))
194.2865 +
194.2866 +(defn println
194.2867 +  "Same as print followed by (newline)"
194.2868 +  {:added "1.0"}
194.2869 +  [& more]
194.2870 +    (binding [*print-readably* nil]
194.2871 +      (apply prn more)))
194.2872 +
194.2873 +(defn read
194.2874 +  "Reads the next object from stream, which must be an instance of
194.2875 +  java.io.PushbackReader or some derivee.  stream defaults to the
194.2876 +  current value of *in* ."
194.2877 +  {:added "1.0"}
194.2878 +  ([]
194.2879 +   (read *in*))
194.2880 +  ([stream]
194.2881 +   (read stream true nil))
194.2882 +  ([stream eof-error? eof-value]
194.2883 +   (read stream eof-error? eof-value false))
194.2884 +  ([stream eof-error? eof-value recursive?]
194.2885 +   (. clojure.lang.LispReader (read stream (boolean eof-error?) eof-value recursive?))))
194.2886 +
194.2887 +(defn read-line
194.2888 +  "Reads the next line from stream that is the current value of *in* ."
194.2889 +  {:added "1.0"}
194.2890 +  []
194.2891 +  (if (instance? clojure.lang.LineNumberingPushbackReader *in*)
194.2892 +    (.readLine ^clojure.lang.LineNumberingPushbackReader *in*)
194.2893 +    (.readLine ^java.io.BufferedReader *in*)))
194.2894 +
194.2895 +(defn read-string
194.2896 +  "Reads one object from the string s"
194.2897 +  {:added "1.0"}
194.2898 +  [s] (clojure.lang.RT/readString s))
194.2899 +
194.2900 +(defn subvec
194.2901 +  "Returns a persistent vector of the items in vector from
194.2902 +  start (inclusive) to end (exclusive).  If end is not supplied,
194.2903 +  defaults to (count vector). This operation is O(1) and very fast, as
194.2904 +  the resulting vector shares structure with the original and no
194.2905 +  trimming is done."
194.2906 +  {:added "1.0"}
194.2907 +  ([v start]
194.2908 +   (subvec v start (count v)))
194.2909 +  ([v start end]
194.2910 +   (. clojure.lang.RT (subvec v start end))))
194.2911 +
194.2912 +(defmacro with-open
194.2913 +  "bindings => [name init ...]
194.2914 +
194.2915 +  Evaluates body in a try expression with names bound to the values
194.2916 +  of the inits, and a finally clause that calls (.close name) on each
194.2917 +  name in reverse order."
194.2918 +  {:added "1.0"}
194.2919 +  [bindings & body]
194.2920 +  (assert-args with-open
194.2921 +     (vector? bindings) "a vector for its binding"
194.2922 +     (even? (count bindings)) "an even number of forms in binding vector")
194.2923 +  (cond
194.2924 +    (= (count bindings) 0) `(do ~@body)
194.2925 +    (symbol? (bindings 0)) `(let ~(subvec bindings 0 2)
194.2926 +                              (try
194.2927 +                                (with-open ~(subvec bindings 2) ~@body)
194.2928 +                                (finally
194.2929 +                                  (. ~(bindings 0) close))))
194.2930 +    :else (throw (IllegalArgumentException.
194.2931 +                   "with-open only allows Symbols in bindings"))))
194.2932 +
194.2933 +(defmacro doto
194.2934 +  "Evaluates x then calls all of the methods and functions with the
194.2935 +  value of x supplied at the front of the given arguments.  The forms
194.2936 +  are evaluated in order.  Returns x.
194.2937 +
194.2938 +  (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))"
194.2939 +  {:added "1.0"}
194.2940 +  [x & forms]
194.2941 +    (let [gx (gensym)]
194.2942 +      `(let [~gx ~x]
194.2943 +         ~@(map (fn [f]
194.2944 +                  (if (seq? f)
194.2945 +                    `(~(first f) ~gx ~@(next f))
194.2946 +                    `(~f ~gx)))
194.2947 +                forms)
194.2948 +         ~gx)))
194.2949 +
194.2950 +(defmacro memfn
194.2951 +  "Expands into code that creates a fn that expects to be passed an
194.2952 +  object and any args and calls the named instance method on the
194.2953 +  object passing the args. Use when you want to treat a Java method as
194.2954 +  a first-class fn."
194.2955 +  {:added "1.0"}
194.2956 +  [name & args]
194.2957 +  `(fn [target# ~@args]
194.2958 +     (. target# (~name ~@args))))
194.2959 +
194.2960 +(defmacro time
194.2961 +  "Evaluates expr and prints the time it took.  Returns the value of
194.2962 + expr."
194.2963 +  {:added "1.0"}
194.2964 +  [expr]
194.2965 +  `(let [start# (. System (nanoTime))
194.2966 +         ret# ~expr]
194.2967 +     (prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs"))
194.2968 +     ret#))
194.2969 +
194.2970 +
194.2971 +
194.2972 +(import '(java.lang.reflect Array))
194.2973 +
194.2974 +(defn alength
194.2975 +  "Returns the length of the Java array. Works on arrays of all
194.2976 +  types."
194.2977 +  {:inline (fn [a] `(. clojure.lang.RT (alength ~a)))
194.2978 +   :added "1.0"}
194.2979 +  [array] (. clojure.lang.RT (alength array)))
194.2980 +
194.2981 +(defn aclone
194.2982 +  "Returns a clone of the Java array. Works on arrays of known
194.2983 +  types."
194.2984 +  {:inline (fn [a] `(. clojure.lang.RT (aclone ~a)))
194.2985 +   :added "1.0"}
194.2986 +  [array] (. clojure.lang.RT (aclone array)))
194.2987 +
194.2988 +(defn aget
194.2989 +  "Returns the value at the index/indices. Works on Java arrays of all
194.2990 +  types."
194.2991 +  {:inline (fn [a i] `(. clojure.lang.RT (aget ~a (int ~i))))
194.2992 +   :inline-arities #{2}
194.2993 +   :added "1.0"}
194.2994 +  ([array idx]
194.2995 +   (clojure.lang.Reflector/prepRet (. Array (get array idx))))
194.2996 +  ([array idx & idxs]
194.2997 +   (apply aget (aget array idx) idxs)))
194.2998 +
194.2999 +(defn aset
194.3000 +  "Sets the value at the index/indices. Works on Java arrays of
194.3001 +  reference types. Returns val."
194.3002 +  {:inline (fn [a i v] `(. clojure.lang.RT (aset ~a (int ~i) ~v)))
194.3003 +   :inline-arities #{3}
194.3004 +   :added "1.0"}
194.3005 +  ([array idx val]
194.3006 +   (. Array (set array idx val))
194.3007 +   val)
194.3008 +  ([array idx idx2 & idxv]
194.3009 +   (apply aset (aget array idx) idx2 idxv)))
194.3010 +
194.3011 +(defmacro
194.3012 +  ^{:private true}
194.3013 +  def-aset [name method coerce]
194.3014 +    `(defn ~name
194.3015 +       {:arglists '([~'array ~'idx ~'val] [~'array ~'idx ~'idx2 & ~'idxv])}
194.3016 +       ([array# idx# val#]
194.3017 +        (. Array (~method array# idx# (~coerce val#)))
194.3018 +        val#)
194.3019 +       ([array# idx# idx2# & idxv#]
194.3020 +        (apply ~name (aget array# idx#) idx2# idxv#))))
194.3021 +
194.3022 +(def-aset
194.3023 +  ^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val."
194.3024 +    :added "1.0"}
194.3025 +  aset-int setInt int)
194.3026 +
194.3027 +(def-aset
194.3028 +  ^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val."
194.3029 +    :added "1.0"}
194.3030 +  aset-long setLong long)
194.3031 +
194.3032 +(def-aset
194.3033 +  ^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val."
194.3034 +    :added "1.0"}
194.3035 +  aset-boolean setBoolean boolean)
194.3036 +
194.3037 +(def-aset
194.3038 +  ^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val."
194.3039 +    :added "1.0"}
194.3040 +  aset-float setFloat float)
194.3041 +
194.3042 +(def-aset
194.3043 +  ^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val."
194.3044 +    :added "1.0"}
194.3045 +  aset-double setDouble double)
194.3046 +
194.3047 +(def-aset
194.3048 +  ^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val."
194.3049 +    :added "1.0"}
194.3050 +  aset-short setShort short)
194.3051 +
194.3052 +(def-aset
194.3053 +  ^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val."
194.3054 +    :added "1.0"}
194.3055 +  aset-byte setByte byte)
194.3056 +
194.3057 +(def-aset
194.3058 +  ^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val."
194.3059 +    :added "1.0"}
194.3060 +  aset-char setChar char)
194.3061 +
194.3062 +(defn make-array
194.3063 +  "Creates and returns an array of instances of the specified class of
194.3064 +  the specified dimension(s).  Note that a class object is required.
194.3065 +  Class objects can be obtained by using their imported or
194.3066 +  fully-qualified name.  Class objects for the primitive types can be
194.3067 +  obtained using, e.g., Integer/TYPE."
194.3068 +  {:added "1.0"}
194.3069 +  ([^Class type len]
194.3070 +   (. Array (newInstance type (int len))))
194.3071 +  ([^Class type dim & more-dims]
194.3072 +   (let [dims (cons dim more-dims)
194.3073 +         ^"[I" dimarray (make-array (. Integer TYPE)  (count dims))]
194.3074 +     (dotimes [i (alength dimarray)]
194.3075 +       (aset-int dimarray i (nth dims i)))
194.3076 +     (. Array (newInstance type dimarray)))))
194.3077 +
194.3078 +(defn to-array-2d
194.3079 +  "Returns a (potentially-ragged) 2-dimensional array of Objects
194.3080 +  containing the contents of coll, which can be any Collection of any
194.3081 +  Collection."
194.3082 +  {:tag "[[Ljava.lang.Object;"
194.3083 +   :added "1.0"}
194.3084 +  [^java.util.Collection coll]
194.3085 +    (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))]
194.3086 +      (loop [i 0 xs (seq coll)]
194.3087 +        (when xs
194.3088 +          (aset ret i (to-array (first xs)))
194.3089 +          (recur (inc i) (next xs))))
194.3090 +      ret))
194.3091 +
194.3092 +(defn macroexpand-1
194.3093 +  "If form represents a macro form, returns its expansion,
194.3094 +  else returns form."
194.3095 +  {:added "1.0"}
194.3096 +  [form]
194.3097 +    (. clojure.lang.Compiler (macroexpand1 form)))
194.3098 +
194.3099 +(defn macroexpand
194.3100 +  "Repeatedly calls macroexpand-1 on form until it no longer
194.3101 +  represents a macro form, then returns it.  Note neither
194.3102 +  macroexpand-1 nor macroexpand expand macros in subforms."
194.3103 +  {:added "1.0"}
194.3104 +  [form]
194.3105 +    (let [ex (macroexpand-1 form)]
194.3106 +      (if (identical? ex form)
194.3107 +        form
194.3108 +        (macroexpand ex))))
194.3109 +
194.3110 +(defn create-struct
194.3111 +  "Returns a structure basis object."
194.3112 +  {:added "1.0"}
194.3113 +  [& keys]
194.3114 +    (. clojure.lang.PersistentStructMap (createSlotMap keys)))
194.3115 +
194.3116 +(defmacro defstruct
194.3117 +  "Same as (def name (create-struct keys...))"
194.3118 +  {:added "1.0"}
194.3119 +  [name & keys]
194.3120 +  `(def ~name (create-struct ~@keys)))
194.3121 +
194.3122 +(defn struct-map
194.3123 +  "Returns a new structmap instance with the keys of the
194.3124 +  structure-basis. keyvals may contain all, some or none of the basis
194.3125 +  keys - where values are not supplied they will default to nil.
194.3126 +  keyvals can also contain keys not in the basis."
194.3127 +  {:added "1.0"}
194.3128 +  [s & inits]
194.3129 +    (. clojure.lang.PersistentStructMap (create s inits)))
194.3130 +
194.3131 +(defn struct
194.3132 +  "Returns a new structmap instance with the keys of the
194.3133 +  structure-basis. vals must be supplied for basis keys in order -
194.3134 +  where values are not supplied they will default to nil."
194.3135 +  {:added "1.0"}
194.3136 +  [s & vals]
194.3137 +    (. clojure.lang.PersistentStructMap (construct s vals)))
194.3138 +
194.3139 +(defn accessor
194.3140 +  "Returns a fn that, given an instance of a structmap with the basis,
194.3141 +  returns the value at the key.  The key must be in the basis. The
194.3142 +  returned function should be (slightly) more efficient than using
194.3143 +  get, but such use of accessors should be limited to known
194.3144 +  performance-critical areas."
194.3145 +  {:added "1.0"}
194.3146 +  [s key]
194.3147 +    (. clojure.lang.PersistentStructMap (getAccessor s key)))
194.3148 +
194.3149 +(defn load-reader
194.3150 +  "Sequentially read and evaluate the set of forms contained in the
194.3151 +  stream/file"
194.3152 +  {:added "1.0"}
194.3153 +  [rdr] (. clojure.lang.Compiler (load rdr)))
194.3154 +
194.3155 +(defn load-string
194.3156 +  "Sequentially read and evaluate the set of forms contained in the
194.3157 +  string"
194.3158 +  {:added "1.0"}
194.3159 +  [s]
194.3160 +  (let [rdr (-> (java.io.StringReader. s)
194.3161 +                (clojure.lang.LineNumberingPushbackReader.))]
194.3162 +    (load-reader rdr)))
194.3163 +
194.3164 +(defn set
194.3165 +  "Returns a set of the distinct elements of coll."
194.3166 +  {:added "1.0"}
194.3167 +  [coll] (clojure.lang.PersistentHashSet/create ^clojure.lang.ISeq (seq coll)))
194.3168 +
194.3169 +(defn ^{:private true}
194.3170 +  filter-key [keyfn pred amap]
194.3171 +    (loop [ret {} es (seq amap)]
194.3172 +      (if es
194.3173 +        (if (pred (keyfn (first es)))
194.3174 +          (recur (assoc ret (key (first es)) (val (first es))) (next es))
194.3175 +          (recur ret (next es)))
194.3176 +        ret)))
194.3177 +
194.3178 +(defn find-ns
194.3179 +  "Returns the namespace named by the symbol or nil if it doesn't exist."
194.3180 +  {:added "1.0"}
194.3181 +  [sym] (clojure.lang.Namespace/find sym))
194.3182 +
194.3183 +(defn create-ns
194.3184 +  "Create a new namespace named by the symbol if one doesn't already
194.3185 +  exist, returns it or the already-existing namespace of the same
194.3186 +  name."
194.3187 +  {:added "1.0"}
194.3188 +  [sym] (clojure.lang.Namespace/findOrCreate sym))
194.3189 +
194.3190 +(defn remove-ns
194.3191 +  "Removes the namespace named by the symbol. Use with caution.
194.3192 +  Cannot be used to remove the clojure namespace."
194.3193 +  {:added "1.0"}
194.3194 +  [sym] (clojure.lang.Namespace/remove sym))
194.3195 +
194.3196 +(defn all-ns
194.3197 +  "Returns a sequence of all namespaces."
194.3198 +  {:added "1.0"}
194.3199 +  [] (clojure.lang.Namespace/all))
194.3200 +
194.3201 +(defn ^clojure.lang.Namespace the-ns
194.3202 +  "If passed a namespace, returns it. Else, when passed a symbol,
194.3203 +  returns the namespace named by it, throwing an exception if not
194.3204 +  found."
194.3205 +  {:added "1.0"}
194.3206 +  [x]
194.3207 +  (if (instance? clojure.lang.Namespace x)
194.3208 +    x
194.3209 +    (or (find-ns x) (throw (Exception. (str "No namespace: " x " found"))))))
194.3210 +
194.3211 +(defn ns-name
194.3212 +  "Returns the name of the namespace, a symbol."
194.3213 +  {:added "1.0"}
194.3214 +  [ns]
194.3215 +  (.getName (the-ns ns)))
194.3216 +
194.3217 +(defn ns-map
194.3218 +  "Returns a map of all the mappings for the namespace."
194.3219 +  {:added "1.0"}
194.3220 +  [ns]
194.3221 +  (.getMappings (the-ns ns)))
194.3222 +
194.3223 +(defn ns-unmap
194.3224 +  "Removes the mappings for the symbol from the namespace."
194.3225 +  {:added "1.0"}
194.3226 +  [ns sym]
194.3227 +  (.unmap (the-ns ns) sym))
194.3228 +
194.3229 +;(defn export [syms]
194.3230 +;  (doseq [sym syms]
194.3231 +;   (.. *ns* (intern sym) (setExported true))))
194.3232 +
194.3233 +(defn ns-publics
194.3234 +  "Returns a map of the public intern mappings for the namespace."
194.3235 +  {:added "1.0"}
194.3236 +  [ns]
194.3237 +  (let [ns (the-ns ns)]
194.3238 +    (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)
194.3239 +                                 (= ns (.ns v))
194.3240 +                                 (.isPublic v)))
194.3241 +                (ns-map ns))))
194.3242 +
194.3243 +(defn ns-imports
194.3244 +  "Returns a map of the import mappings for the namespace."
194.3245 +  {:added "1.0"}
194.3246 +  [ns]
194.3247 +  (filter-key val (partial instance? Class) (ns-map ns)))
194.3248 +
194.3249 +(defn ns-interns
194.3250 +  "Returns a map of the intern mappings for the namespace."
194.3251 +  {:added "1.0"}
194.3252 +  [ns]
194.3253 +  (let [ns (the-ns ns)]
194.3254 +    (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)
194.3255 +                                 (= ns (.ns v))))
194.3256 +                (ns-map ns))))
194.3257 +
194.3258 +(defn refer
194.3259 +  "refers to all public vars of ns, subject to filters.
194.3260 +  filters can include at most one each of:
194.3261 +
194.3262 +  :exclude list-of-symbols
194.3263 +  :only list-of-symbols
194.3264 +  :rename map-of-fromsymbol-tosymbol
194.3265 +
194.3266 +  For each public interned var in the namespace named by the symbol,
194.3267 +  adds a mapping from the name of the var to the var to the current
194.3268 +  namespace.  Throws an exception if name is already mapped to
194.3269 +  something else in the current namespace. Filters can be used to
194.3270 +  select a subset, via inclusion or exclusion, or to provide a mapping
194.3271 +  to a symbol different from the var's name, in order to prevent
194.3272 +  clashes. Use :use in the ns macro in preference to calling this directly."
194.3273 +  {:added "1.0"}
194.3274 +  [ns-sym & filters]
194.3275 +    (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym))))
194.3276 +          fs (apply hash-map filters)
194.3277 +          nspublics (ns-publics ns)
194.3278 +          rename (or (:rename fs) {})
194.3279 +          exclude (set (:exclude fs))
194.3280 +          to-do (or (:only fs) (keys nspublics))]
194.3281 +      (doseq [sym to-do]
194.3282 +        (when-not (exclude sym)
194.3283 +          (let [v (nspublics sym)]
194.3284 +            (when-not v
194.3285 +              (throw (new java.lang.IllegalAccessError
194.3286 +                          (if (get (ns-interns ns) sym)
194.3287 +                            (str sym " is not public")
194.3288 +                            (str sym " does not exist")))))
194.3289 +            (. *ns* (refer (or (rename sym) sym) v)))))))
194.3290 +
194.3291 +(defn ns-refers
194.3292 +  "Returns a map of the refer mappings for the namespace."
194.3293 +  {:added "1.0"}
194.3294 +  [ns]
194.3295 +  (let [ns (the-ns ns)]
194.3296 +    (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v)
194.3297 +                                 (not= ns (.ns v))))
194.3298 +                (ns-map ns))))
194.3299 +
194.3300 +(defn alias
194.3301 +  "Add an alias in the current namespace to another
194.3302 +  namespace. Arguments are two symbols: the alias to be used, and
194.3303 +  the symbolic name of the target namespace. Use :as in the ns macro in preference
194.3304 +  to calling this directly."
194.3305 +  {:added "1.0"}
194.3306 +  [alias namespace-sym]
194.3307 +  (.addAlias *ns* alias (find-ns namespace-sym)))
194.3308 +
194.3309 +(defn ns-aliases
194.3310 +  "Returns a map of the aliases for the namespace."
194.3311 +  {:added "1.0"}
194.3312 +  [ns]
194.3313 +  (.getAliases (the-ns ns)))
194.3314 +
194.3315 +(defn ns-unalias
194.3316 +  "Removes the alias for the symbol from the namespace."
194.3317 +  {:added "1.0"}
194.3318 +  [ns sym]
194.3319 +  (.removeAlias (the-ns ns) sym))
194.3320 +
194.3321 +(defn take-nth
194.3322 +  "Returns a lazy seq of every nth item in coll."
194.3323 +  {:added "1.0"}
194.3324 +  [n coll]
194.3325 +    (lazy-seq
194.3326 +     (when-let [s (seq coll)]
194.3327 +       (cons (first s) (take-nth n (drop n s))))))
194.3328 +
194.3329 +(defn interleave
194.3330 +  "Returns a lazy seq of the first item in each coll, then the second etc."
194.3331 +  {:added "1.0"}
194.3332 +  ([c1 c2]
194.3333 +     (lazy-seq
194.3334 +      (let [s1 (seq c1) s2 (seq c2)]
194.3335 +        (when (and s1 s2)
194.3336 +          (cons (first s1) (cons (first s2) 
194.3337 +                                 (interleave (rest s1) (rest s2))))))))
194.3338 +  ([c1 c2 & colls] 
194.3339 +     (lazy-seq 
194.3340 +      (let [ss (map seq (conj colls c2 c1))]
194.3341 +        (when (every? identity ss)
194.3342 +          (concat (map first ss) (apply interleave (map rest ss))))))))
194.3343 +
194.3344 +(defn var-get
194.3345 +  "Gets the value in the var object"
194.3346 +  {:added "1.0"}
194.3347 +  [^clojure.lang.Var x] (. x (get)))
194.3348 +
194.3349 +(defn var-set
194.3350 +  "Sets the value in the var object to val. The var must be
194.3351 + thread-locally bound."
194.3352 +  {:added "1.0"}
194.3353 +  [^clojure.lang.Var x val] (. x (set val)))
194.3354 +
194.3355 +(defmacro with-local-vars
194.3356 +  "varbinding=> symbol init-expr
194.3357 +
194.3358 +  Executes the exprs in a context in which the symbols are bound to
194.3359 +  vars with per-thread bindings to the init-exprs.  The symbols refer
194.3360 +  to the var objects themselves, and must be accessed with var-get and
194.3361 +  var-set"
194.3362 +  {:added "1.0"}
194.3363 +  [name-vals-vec & body]
194.3364 +  (assert-args with-local-vars
194.3365 +     (vector? name-vals-vec) "a vector for its binding"
194.3366 +     (even? (count name-vals-vec)) "an even number of forms in binding vector")
194.3367 +  `(let [~@(interleave (take-nth 2 name-vals-vec)
194.3368 +                       (repeat '(. clojure.lang.Var (create))))]
194.3369 +     (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec)))
194.3370 +     (try
194.3371 +      ~@body
194.3372 +      (finally (. clojure.lang.Var (popThreadBindings))))))
194.3373 +
194.3374 +(defn ns-resolve
194.3375 +  "Returns the var or Class to which a symbol will be resolved in the
194.3376 +  namespace, else nil.  Note that if the symbol is fully qualified,
194.3377 +  the var/Class to which it resolves need not be present in the
194.3378 +  namespace."
194.3379 +  {:added "1.0"}
194.3380 +  [ns sym]
194.3381 +  (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym))
194.3382 +
194.3383 +(defn resolve
194.3384 +  "same as (ns-resolve *ns* symbol)"
194.3385 +  {:added "1.0"}
194.3386 +  [sym] (ns-resolve *ns* sym))
194.3387 +
194.3388 +(defn array-map
194.3389 +  "Constructs an array-map."
194.3390 +  {:added "1.0"}
194.3391 +  ([] (. clojure.lang.PersistentArrayMap EMPTY))
194.3392 +  ([& keyvals] (clojure.lang.PersistentArrayMap/createWithCheck (to-array keyvals))))
194.3393 +
194.3394 +(defn nthnext
194.3395 +  "Returns the nth next of coll, (seq coll) when n is 0."
194.3396 +  {:added "1.0"}
194.3397 +  [coll n]
194.3398 +    (loop [n n xs (seq coll)]
194.3399 +      (if (and xs (pos? n))
194.3400 +        (recur (dec n) (next xs))
194.3401 +        xs)))
194.3402 +
194.3403 +
194.3404 +;redefine let and loop  with destructuring
194.3405 +(defn destructure [bindings]
194.3406 +  (let [bents (partition 2 bindings)
194.3407 +        pb (fn pb [bvec b v]
194.3408 +               (let [pvec
194.3409 +                     (fn [bvec b val]
194.3410 +                       (let [gvec (gensym "vec__")]
194.3411 +                         (loop [ret (-> bvec (conj gvec) (conj val))
194.3412 +                                n 0
194.3413 +                                bs b
194.3414 +                                seen-rest? false]
194.3415 +                           (if (seq bs)
194.3416 +                             (let [firstb (first bs)]
194.3417 +                               (cond
194.3418 +                                (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n))
194.3419 +                                                     n
194.3420 +                                                     (nnext bs)
194.3421 +                                                     true)
194.3422 +                                (= firstb :as) (pb ret (second bs) gvec)
194.3423 +                                :else (if seen-rest?
194.3424 +                                        (throw (new Exception "Unsupported binding form, only :as can follow & parameter"))
194.3425 +                                        (recur (pb ret firstb  (list `nth gvec n nil))
194.3426 +                                               (inc n)
194.3427 +                                               (next bs)
194.3428 +                                               seen-rest?))))
194.3429 +                             ret))))
194.3430 +                     pmap
194.3431 +                     (fn [bvec b v]
194.3432 +                       (let [gmap (or (:as b) (gensym "map__"))
194.3433 +                             defaults (:or b)]
194.3434 +                         (loop [ret (-> bvec (conj gmap) (conj v)
194.3435 +                                        (conj gmap) (conj `(if (seq? ~gmap) (apply hash-map ~gmap) ~gmap)))
194.3436 +                                bes (reduce
194.3437 +                                     (fn [bes entry]
194.3438 +                                       (reduce #(assoc %1 %2 ((val entry) %2))
194.3439 +                                               (dissoc bes (key entry))
194.3440 +                                               ((key entry) bes)))
194.3441 +                                     (dissoc b :as :or)
194.3442 +                                     {:keys #(keyword (str %)), :strs str, :syms #(list `quote %)})]
194.3443 +                           (if (seq bes)
194.3444 +                             (let [bb (key (first bes))
194.3445 +                                   bk (val (first bes))
194.3446 +                                   has-default (contains? defaults bb)]
194.3447 +                               (recur (pb ret bb (if has-default
194.3448 +                                                   (list `get gmap bk (defaults bb))
194.3449 +                                                   (list `get gmap bk)))
194.3450 +                                      (next bes)))
194.3451 +                             ret))))]
194.3452 +                 (cond
194.3453 +                  (symbol? b) (-> bvec (conj b) (conj v))
194.3454 +                  (vector? b) (pvec bvec b v)
194.3455 +                  (map? b) (pmap bvec b v)
194.3456 +                  :else (throw (new Exception (str "Unsupported binding form: " b))))))
194.3457 +        process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
194.3458 +    (if (every? symbol? (map first bents))
194.3459 +      bindings
194.3460 +      (reduce process-entry [] bents))))
194.3461 +
194.3462 +(defmacro let
194.3463 +  "Evaluates the exprs in a lexical context in which the symbols in
194.3464 +  the binding-forms are bound to their respective init-exprs or parts
194.3465 +  therein."
194.3466 +  {:added "1.0"}
194.3467 +  [bindings & body]
194.3468 +  (assert-args let
194.3469 +     (vector? bindings) "a vector for its binding"
194.3470 +     (even? (count bindings)) "an even number of forms in binding vector")
194.3471 +  `(let* ~(destructure bindings) ~@body))
194.3472 +
194.3473 +(defn ^{:private true}
194.3474 +  maybe-destructured
194.3475 +  [params body]
194.3476 +  (if (every? symbol? params)
194.3477 +    (cons params body)
194.3478 +    (loop [params params
194.3479 +           new-params []
194.3480 +           lets []]
194.3481 +      (if params
194.3482 +        (if (symbol? (first params))
194.3483 +          (recur (next params) (conj new-params (first params)) lets)
194.3484 +          (let [gparam (gensym "p__")]
194.3485 +            (recur (next params) (conj new-params gparam)
194.3486 +                   (-> lets (conj (first params)) (conj gparam)))))
194.3487 +        `(~new-params
194.3488 +          (let ~lets
194.3489 +            ~@body))))))
194.3490 +
194.3491 +;redefine fn with destructuring and pre/post conditions
194.3492 +(defmacro fn
194.3493 +  "(fn name? [params* ] exprs*)
194.3494 +  (fn name? ([params* ] exprs*)+)
194.3495 +
194.3496 +  params => positional-params* , or positional-params* & next-param
194.3497 +  positional-param => binding-form
194.3498 +  next-param => binding-form
194.3499 +  name => symbol
194.3500 +
194.3501 +  Defines a function"
194.3502 +  {:added "1.0"}
194.3503 +  [& sigs]
194.3504 +    (let [name (if (symbol? (first sigs)) (first sigs) nil)
194.3505 +          sigs (if name (next sigs) sigs)
194.3506 +          sigs (if (vector? (first sigs)) (list sigs) sigs)
194.3507 +          psig (fn* [sig]
194.3508 +                 (let [[params & body] sig
194.3509 +                       conds (when (and (next body) (map? (first body))) 
194.3510 +                                           (first body))
194.3511 +                       body (if conds (next body) body)
194.3512 +                       conds (or conds (meta params))
194.3513 +                       pre (:pre conds)
194.3514 +                       post (:post conds)                       
194.3515 +                       body (if post
194.3516 +                              `((let [~'% ~(if (< 1 (count body)) 
194.3517 +                                            `(do ~@body) 
194.3518 +                                            (first body))]
194.3519 +                                 ~@(map (fn* [c] `(assert ~c)) post)
194.3520 +                                 ~'%))
194.3521 +                              body)
194.3522 +                       body (if pre
194.3523 +                              (concat (map (fn* [c] `(assert ~c)) pre) 
194.3524 +                                      body)
194.3525 +                              body)]
194.3526 +                   (maybe-destructured params body)))
194.3527 +          new-sigs (map psig sigs)]
194.3528 +      (with-meta
194.3529 +        (if name
194.3530 +          (list* 'fn* name new-sigs)
194.3531 +          (cons 'fn* new-sigs))
194.3532 +        (meta &form))))
194.3533 +
194.3534 +(defmacro loop
194.3535 +  "Evaluates the exprs in a lexical context in which the symbols in
194.3536 +  the binding-forms are bound to their respective init-exprs or parts
194.3537 +  therein. Acts as a recur target."
194.3538 +  {:added "1.0"}
194.3539 +  [bindings & body]
194.3540 +    (assert-args loop
194.3541 +      (vector? bindings) "a vector for its binding"
194.3542 +      (even? (count bindings)) "an even number of forms in binding vector")
194.3543 +    (let [db (destructure bindings)]
194.3544 +      (if (= db bindings)
194.3545 +        `(loop* ~bindings ~@body)
194.3546 +        (let [vs (take-nth 2 (drop 1 bindings))
194.3547 +              bs (take-nth 2 bindings)
194.3548 +              gs (map (fn [b] (if (symbol? b) b (gensym))) bs)
194.3549 +              bfs (reduce (fn [ret [b v g]]
194.3550 +                            (if (symbol? b)
194.3551 +                              (conj ret g v)
194.3552 +                              (conj ret g v b g)))
194.3553 +                          [] (map vector bs vs gs))]
194.3554 +          `(let ~bfs
194.3555 +             (loop* ~(vec (interleave gs gs))
194.3556 +               (let ~(vec (interleave bs gs))
194.3557 +                 ~@body)))))))
194.3558 +
194.3559 +(defmacro when-first
194.3560 +  "bindings => x xs
194.3561 +
194.3562 +  Same as (when (seq xs) (let [x (first xs)] body))"
194.3563 +  {:added "1.0"}
194.3564 +  [bindings & body]
194.3565 +  (assert-args when-first
194.3566 +     (vector? bindings) "a vector for its binding"
194.3567 +     (= 2 (count bindings)) "exactly 2 forms in binding vector")
194.3568 +  (let [[x xs] bindings]
194.3569 +    `(when (seq ~xs)
194.3570 +       (let [~x (first ~xs)]
194.3571 +         ~@body))))
194.3572 +
194.3573 +(defmacro lazy-cat
194.3574 +  "Expands to code which yields a lazy sequence of the concatenation
194.3575 +  of the supplied colls.  Each coll expr is not evaluated until it is
194.3576 +  needed. 
194.3577 +
194.3578 +  (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))"
194.3579 +  {:added "1.0"}
194.3580 +  [& colls]
194.3581 +  `(concat ~@(map #(list `lazy-seq %) colls)))
194.3582 +
194.3583 +(defmacro for
194.3584 +  "List comprehension. Takes a vector of one or more
194.3585 +   binding-form/collection-expr pairs, each followed by zero or more
194.3586 +   modifiers, and yields a lazy sequence of evaluations of expr.
194.3587 +   Collections are iterated in a nested fashion, rightmost fastest,
194.3588 +   and nested coll-exprs can refer to bindings created in prior
194.3589 +   binding-forms.  Supported modifiers are: :let [binding-form expr ...],
194.3590 +   :while test, :when test.
194.3591 +
194.3592 +  (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))"
194.3593 +  {:added "1.0"}
194.3594 +  [seq-exprs body-expr]
194.3595 +  (assert-args for
194.3596 +     (vector? seq-exprs) "a vector for its binding"
194.3597 +     (even? (count seq-exprs)) "an even number of forms in binding vector")
194.3598 +  (let [to-groups (fn [seq-exprs]
194.3599 +                    (reduce (fn [groups [k v]]
194.3600 +                              (if (keyword? k)
194.3601 +                                (conj (pop groups) (conj (peek groups) [k v]))
194.3602 +                                (conj groups [k v])))
194.3603 +                            [] (partition 2 seq-exprs)))
194.3604 +        err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg))))
194.3605 +        emit-bind (fn emit-bind [[[bind expr & mod-pairs]
194.3606 +                                  & [[_ next-expr] :as next-groups]]]
194.3607 +                    (let [giter (gensym "iter__")
194.3608 +                          gxs (gensym "s__")
194.3609 +                          do-mod (fn do-mod [[[k v :as pair] & etc]]
194.3610 +                                   (cond
194.3611 +                                     (= k :let) `(let ~v ~(do-mod etc))
194.3612 +                                     (= k :while) `(when ~v ~(do-mod etc))
194.3613 +                                     (= k :when) `(if ~v
194.3614 +                                                    ~(do-mod etc)
194.3615 +                                                    (recur (rest ~gxs)))
194.3616 +                                     (keyword? k) (err "Invalid 'for' keyword " k)
194.3617 +                                     next-groups
194.3618 +                                      `(let [iterys# ~(emit-bind next-groups)
194.3619 +                                             fs# (seq (iterys# ~next-expr))]
194.3620 +                                         (if fs#
194.3621 +                                           (concat fs# (~giter (rest ~gxs)))
194.3622 +                                           (recur (rest ~gxs))))
194.3623 +                                     :else `(cons ~body-expr
194.3624 +                                                  (~giter (rest ~gxs)))))]
194.3625 +                      (if next-groups
194.3626 +                        #_"not the inner-most loop"
194.3627 +                        `(fn ~giter [~gxs]
194.3628 +                           (lazy-seq
194.3629 +                             (loop [~gxs ~gxs]
194.3630 +                               (when-first [~bind ~gxs]
194.3631 +                                 ~(do-mod mod-pairs)))))
194.3632 +                        #_"inner-most loop"
194.3633 +                        (let [gi (gensym "i__")
194.3634 +                              gb (gensym "b__")
194.3635 +                              do-cmod (fn do-cmod [[[k v :as pair] & etc]]
194.3636 +                                        (cond
194.3637 +                                          (= k :let) `(let ~v ~(do-cmod etc))
194.3638 +                                          (= k :while) `(when ~v ~(do-cmod etc))
194.3639 +                                          (= k :when) `(if ~v
194.3640 +                                                         ~(do-cmod etc)
194.3641 +                                                         (recur
194.3642 +                                                           (unchecked-inc ~gi)))
194.3643 +                                          (keyword? k)
194.3644 +                                            (err "Invalid 'for' keyword " k)
194.3645 +                                          :else
194.3646 +                                            `(do (chunk-append ~gb ~body-expr)
194.3647 +                                                 (recur (unchecked-inc ~gi)))))]
194.3648 +                          `(fn ~giter [~gxs]
194.3649 +                             (lazy-seq
194.3650 +                               (loop [~gxs ~gxs]
194.3651 +                                 (when-let [~gxs (seq ~gxs)]
194.3652 +                                   (if (chunked-seq? ~gxs)
194.3653 +                                     (let [c# (chunk-first ~gxs)
194.3654 +                                           size# (int (count c#))
194.3655 +                                           ~gb (chunk-buffer size#)]
194.3656 +                                       (if (loop [~gi (int 0)]
194.3657 +                                             (if (< ~gi size#)
194.3658 +                                               (let [~bind (.nth c# ~gi)]
194.3659 +                                                 ~(do-cmod mod-pairs))
194.3660 +                                               true))
194.3661 +                                         (chunk-cons
194.3662 +                                           (chunk ~gb)
194.3663 +                                           (~giter (chunk-rest ~gxs)))
194.3664 +                                         (chunk-cons (chunk ~gb) nil)))
194.3665 +                                     (let [~bind (first ~gxs)]
194.3666 +                                       ~(do-mod mod-pairs)))))))))))]
194.3667 +    `(let [iter# ~(emit-bind (to-groups seq-exprs))]
194.3668 +        (iter# ~(second seq-exprs)))))
194.3669 +
194.3670 +(defmacro comment
194.3671 +  "Ignores body, yields nil"
194.3672 +  {:added "1.0"}
194.3673 +  [& body])
194.3674 +
194.3675 +(defmacro with-out-str
194.3676 +  "Evaluates exprs in a context in which *out* is bound to a fresh
194.3677 +  StringWriter.  Returns the string created by any nested printing
194.3678 +  calls."
194.3679 +  {:added "1.0"}
194.3680 +  [& body]
194.3681 +  `(let [s# (new java.io.StringWriter)]
194.3682 +     (binding [*out* s#]
194.3683 +       ~@body
194.3684 +       (str s#))))
194.3685 +
194.3686 +(defmacro with-in-str
194.3687 +  "Evaluates body in a context in which *in* is bound to a fresh
194.3688 +  StringReader initialized with the string s."
194.3689 +  {:added "1.0"}
194.3690 +  [s & body]
194.3691 +  `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)]
194.3692 +     (binding [*in* s#]
194.3693 +       ~@body)))
194.3694 +
194.3695 +(defn pr-str
194.3696 +  "pr to a string, returning it"
194.3697 +  {:tag String
194.3698 +   :added "1.0"}
194.3699 +  [& xs]
194.3700 +    (with-out-str
194.3701 +     (apply pr xs)))
194.3702 +
194.3703 +(defn prn-str
194.3704 +  "prn to a string, returning it"
194.3705 +  {:tag String
194.3706 +   :added "1.0"}
194.3707 +  [& xs]
194.3708 +  (with-out-str
194.3709 +   (apply prn xs)))
194.3710 +
194.3711 +(defn print-str
194.3712 +  "print to a string, returning it"
194.3713 +  {:tag String
194.3714 +   :added "1.0"}
194.3715 +  [& xs]
194.3716 +    (with-out-str
194.3717 +     (apply print xs)))
194.3718 +
194.3719 +(defn println-str
194.3720 +  "println to a string, returning it"
194.3721 +  {:tag String
194.3722 +   :added "1.0"}
194.3723 +  [& xs]
194.3724 +    (with-out-str
194.3725 +     (apply println xs)))
194.3726 +
194.3727 +(defmacro assert
194.3728 +  "Evaluates expr and throws an exception if it does not evaluate to
194.3729 + logical true."
194.3730 +  {:added "1.0"}
194.3731 +  [x]
194.3732 +  (when *assert*
194.3733 +    `(when-not ~x
194.3734 +       (throw (new AssertionError (str "Assert failed: " (pr-str '~x)))))))
194.3735 +
194.3736 +(defn test
194.3737 +  "test [v] finds fn at key :test in var metadata and calls it,
194.3738 +  presuming failure will throw exception"
194.3739 +  {:added "1.0"}
194.3740 +  [v]
194.3741 +    (let [f (:test (meta v))]
194.3742 +      (if f
194.3743 +        (do (f) :ok)
194.3744 +        :no-test)))
194.3745 +
194.3746 +(defn re-pattern
194.3747 +  "Returns an instance of java.util.regex.Pattern, for use, e.g. in
194.3748 +  re-matcher."
194.3749 +  {:tag java.util.regex.Pattern
194.3750 +   :added "1.0"}
194.3751 +  [s] (if (instance? java.util.regex.Pattern s)
194.3752 +        s
194.3753 +        (. java.util.regex.Pattern (compile s))))
194.3754 +
194.3755 +(defn re-matcher
194.3756 +  "Returns an instance of java.util.regex.Matcher, for use, e.g. in
194.3757 +  re-find."
194.3758 +  {:tag java.util.regex.Matcher
194.3759 +   :added "1.0"}
194.3760 +  [^java.util.regex.Pattern re s]
194.3761 +    (. re (matcher s)))
194.3762 +
194.3763 +(defn re-groups
194.3764 +  "Returns the groups from the most recent match/find. If there are no
194.3765 +  nested groups, returns a string of the entire match. If there are
194.3766 +  nested groups, returns a vector of the groups, the first element
194.3767 +  being the entire match."
194.3768 +  {:added "1.0"}
194.3769 +  [^java.util.regex.Matcher m]
194.3770 +    (let [gc  (. m (groupCount))]
194.3771 +      (if (zero? gc)
194.3772 +        (. m (group))
194.3773 +        (loop [ret [] c 0]
194.3774 +          (if (<= c gc)
194.3775 +            (recur (conj ret (. m (group c))) (inc c))
194.3776 +            ret)))))
194.3777 +
194.3778 +(defn re-seq
194.3779 +  "Returns a lazy sequence of successive matches of pattern in string,
194.3780 +  using java.util.regex.Matcher.find(), each such match processed with
194.3781 +  re-groups."
194.3782 +  {:added "1.0"}
194.3783 +  [^java.util.regex.Pattern re s]
194.3784 +  (let [m (re-matcher re s)]
194.3785 +    ((fn step []
194.3786 +       (when (. m (find))
194.3787 +         (cons (re-groups m) (lazy-seq (step))))))))
194.3788 +
194.3789 +(defn re-matches
194.3790 +  "Returns the match, if any, of string to pattern, using
194.3791 +  java.util.regex.Matcher.matches().  Uses re-groups to return the
194.3792 +  groups."
194.3793 +  {:added "1.0"}
194.3794 +  [^java.util.regex.Pattern re s]
194.3795 +    (let [m (re-matcher re s)]
194.3796 +      (when (. m (matches))
194.3797 +        (re-groups m))))
194.3798 +
194.3799 +
194.3800 +(defn re-find
194.3801 +  "Returns the next regex match, if any, of string to pattern, using
194.3802 +  java.util.regex.Matcher.find().  Uses re-groups to return the
194.3803 +  groups."
194.3804 +  {:added "1.0"}
194.3805 +  ([^java.util.regex.Matcher m]
194.3806 +   (when (. m (find))
194.3807 +     (re-groups m)))
194.3808 +  ([^java.util.regex.Pattern re s]
194.3809 +   (let [m (re-matcher re s)]
194.3810 +     (re-find m))))
194.3811 +
194.3812 +(defn rand
194.3813 +  "Returns a random floating point number between 0 (inclusive) and
194.3814 +  n (default 1) (exclusive)."
194.3815 +  {:added "1.0"}
194.3816 +  ([] (. Math (random)))
194.3817 +  ([n] (* n (rand))))
194.3818 +
194.3819 +(defn rand-int
194.3820 +  "Returns a random integer between 0 (inclusive) and n (exclusive)."
194.3821 +  {:added "1.0"}
194.3822 +  [n] (int (rand n)))
194.3823 +
194.3824 +(defmacro defn-
194.3825 +  "same as defn, yielding non-public def"
194.3826 +  {:added "1.0"}
194.3827 +  [name & decls]
194.3828 +    (list* `defn (with-meta name (assoc (meta name) :private true)) decls))
194.3829 +
194.3830 +(defn print-doc [v]
194.3831 +  (println "-------------------------")
194.3832 +  (println (str (ns-name (:ns (meta v))) "/" (:name (meta v))))
194.3833 +  (prn (:arglists (meta v)))
194.3834 +  (when (:macro (meta v))
194.3835 +    (println "Macro"))
194.3836 +  (println " " (:doc (meta v))))
194.3837 +
194.3838 +(defn find-doc
194.3839 +  "Prints documentation for any var whose documentation or name
194.3840 + contains a match for re-string-or-pattern"
194.3841 +  {:added "1.0"}
194.3842 +  [re-string-or-pattern]
194.3843 +    (let [re  (re-pattern re-string-or-pattern)]
194.3844 +      (doseq [ns (all-ns)
194.3845 +              v (sort-by (comp :name meta) (vals (ns-interns ns)))
194.3846 +              :when (and (:doc (meta v))
194.3847 +                         (or (re-find (re-matcher re (:doc (meta v))))
194.3848 +                             (re-find (re-matcher re (str (:name (meta v)))))))]
194.3849 +               (print-doc v))))
194.3850 +
194.3851 +(defn special-form-anchor
194.3852 +  "Returns the anchor tag on http://clojure.org/special_forms for the
194.3853 +  special form x, or nil"
194.3854 +  {:added "1.0"}
194.3855 +  [x]
194.3856 +  (#{'. 'def 'do 'fn 'if 'let 'loop 'monitor-enter 'monitor-exit 'new
194.3857 +  'quote 'recur 'set! 'throw 'try 'var} x))
194.3858 +
194.3859 +(defn syntax-symbol-anchor
194.3860 +  "Returns the anchor tag on http://clojure.org/special_forms for the
194.3861 +  special form that uses syntax symbol x, or nil"
194.3862 +  {:added "1.0"}
194.3863 +  [x]
194.3864 +  ({'& 'fn 'catch 'try 'finally 'try} x))
194.3865 +
194.3866 +(defn print-special-doc
194.3867 +  [name type anchor]
194.3868 +  (println "-------------------------")
194.3869 +  (println name)
194.3870 +  (println type)
194.3871 +  (println (str "  Please see http://clojure.org/special_forms#" anchor)))
194.3872 +
194.3873 +(defn print-namespace-doc
194.3874 +  "Print the documentation string of a Namespace."
194.3875 +  {:added "1.0"}
194.3876 +  [nspace]
194.3877 +  (println "-------------------------")
194.3878 +  (println (str (ns-name nspace)))
194.3879 +  (println " " (:doc (meta nspace))))
194.3880 +
194.3881 +(defmacro doc
194.3882 +  "Prints documentation for a var or special form given its name"
194.3883 +  {:added "1.0"}
194.3884 +  [name]
194.3885 +  (cond
194.3886 +   (special-form-anchor `~name)
194.3887 +   `(print-special-doc '~name "Special Form" (special-form-anchor '~name))
194.3888 +   (syntax-symbol-anchor `~name)
194.3889 +   `(print-special-doc '~name "Syntax Symbol" (syntax-symbol-anchor '~name))
194.3890 +   :else
194.3891 +    (let [nspace (find-ns name)]
194.3892 +      (if nspace
194.3893 +        `(print-namespace-doc ~nspace)
194.3894 +        `(print-doc (var ~name))))))
194.3895 +
194.3896 + (defn tree-seq
194.3897 +  "Returns a lazy sequence of the nodes in a tree, via a depth-first walk.
194.3898 +   branch? must be a fn of one arg that returns true if passed a node
194.3899 +   that can have children (but may not).  children must be a fn of one
194.3900 +   arg that returns a sequence of the children. Will only be called on
194.3901 +   nodes for which branch? returns true. Root is the root node of the
194.3902 +  tree."
194.3903 +  {:added "1.0"}
194.3904 +   [branch? children root]
194.3905 +   (let [walk (fn walk [node]
194.3906 +                (lazy-seq
194.3907 +                 (cons node
194.3908 +                  (when (branch? node)
194.3909 +                    (mapcat walk (children node))))))]
194.3910 +     (walk root)))
194.3911 +
194.3912 +(defn file-seq
194.3913 +  "A tree seq on java.io.Files"
194.3914 +  {:added "1.0"}
194.3915 +  [dir]
194.3916 +    (tree-seq
194.3917 +     (fn [^java.io.File f] (. f (isDirectory)))
194.3918 +     (fn [^java.io.File d] (seq (. d (listFiles))))
194.3919 +     dir))
194.3920 +
194.3921 +(defn xml-seq
194.3922 +  "A tree seq on the xml elements as per xml/parse"
194.3923 +  {:added "1.0"}
194.3924 +  [root]
194.3925 +    (tree-seq
194.3926 +     (complement string?)
194.3927 +     (comp seq :content)
194.3928 +     root))
194.3929 +
194.3930 +(defn special-symbol?
194.3931 +  "Returns true if s names a special form"
194.3932 +  {:added "1.0"}
194.3933 +  [s]
194.3934 +    (contains? (. clojure.lang.Compiler specials) s))
194.3935 +
194.3936 +(defn var?
194.3937 +  "Returns true if v is of type clojure.lang.Var"
194.3938 +  {:added "1.0"}
194.3939 +  [v] (instance? clojure.lang.Var v))
194.3940 +
194.3941 +(defn ^String subs
194.3942 +  "Returns the substring of s beginning at start inclusive, and ending
194.3943 +  at end (defaults to length of string), exclusive."
194.3944 +  {:added "1.0"}
194.3945 +  ([^String s start] (. s (substring start)))
194.3946 +  ([^String s start end] (. s (substring start end))))
194.3947 +
194.3948 +(defn max-key
194.3949 +  "Returns the x for which (k x), a number, is greatest."
194.3950 +  {:added "1.0"}
194.3951 +  ([k x] x)
194.3952 +  ([k x y] (if (> (k x) (k y)) x y))
194.3953 +  ([k x y & more]
194.3954 +   (reduce #(max-key k %1 %2) (max-key k x y) more)))
194.3955 +
194.3956 +(defn min-key
194.3957 +  "Returns the x for which (k x), a number, is least."
194.3958 +  {:added "1.0"}
194.3959 +  ([k x] x)
194.3960 +  ([k x y] (if (< (k x) (k y)) x y))
194.3961 +  ([k x y & more]
194.3962 +   (reduce #(min-key k %1 %2) (min-key k x y) more)))
194.3963 +
194.3964 +(defn distinct
194.3965 +  "Returns a lazy sequence of the elements of coll with duplicates removed"
194.3966 +  {:added "1.0"}
194.3967 +  [coll]
194.3968 +    (let [step (fn step [xs seen]
194.3969 +                   (lazy-seq
194.3970 +                    ((fn [[f :as xs] seen]
194.3971 +                      (when-let [s (seq xs)]
194.3972 +                        (if (contains? seen f) 
194.3973 +                          (recur (rest s) seen)
194.3974 +                          (cons f (step (rest s) (conj seen f))))))
194.3975 +                     xs seen)))]
194.3976 +      (step coll #{})))
194.3977 +
194.3978 +
194.3979 +
194.3980 +(defn replace
194.3981 +  "Given a map of replacement pairs and a vector/collection, returns a
194.3982 +  vector/seq with any elements = a key in smap replaced with the
194.3983 +  corresponding val in smap"
194.3984 +  {:added "1.0"}
194.3985 +  [smap coll]
194.3986 +    (if (vector? coll)
194.3987 +      (reduce (fn [v i]
194.3988 +                (if-let [e (find smap (nth v i))]
194.3989 +                        (assoc v i (val e))
194.3990 +                        v))
194.3991 +              coll (range (count coll)))
194.3992 +      (map #(if-let [e (find smap %)] (val e) %) coll)))
194.3993 +
194.3994 +(defmacro dosync
194.3995 +  "Runs the exprs (in an implicit do) in a transaction that encompasses
194.3996 +  exprs and any nested calls.  Starts a transaction if none is already
194.3997 +  running on this thread. Any uncaught exception will abort the
194.3998 +  transaction and flow out of dosync. The exprs may be run more than
194.3999 +  once, but any effects on Refs will be atomic."
194.4000 +  {:added "1.0"}
194.4001 +  [& exprs]
194.4002 +  `(sync nil ~@exprs))
194.4003 +
194.4004 +(defmacro with-precision
194.4005 +  "Sets the precision and rounding mode to be used for BigDecimal operations.
194.4006 +
194.4007 +  Usage: (with-precision 10 (/ 1M 3))
194.4008 +  or:    (with-precision 10 :rounding HALF_DOWN (/ 1M 3))
194.4009 +
194.4010 +  The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN,
194.4011 +  HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP."
194.4012 +  {:added "1.0"}
194.4013 +  [precision & exprs]
194.4014 +    (let [[body rm] (if (= (first exprs) :rounding)
194.4015 +                      [(next (next exprs))
194.4016 +                       `((. java.math.RoundingMode ~(second exprs)))]
194.4017 +                      [exprs nil])]
194.4018 +      `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)]
194.4019 +         ~@body)))
194.4020 +
194.4021 +(defn mk-bound-fn
194.4022 +  {:private true}
194.4023 +  [^clojure.lang.Sorted sc test key]
194.4024 +  (fn [e]
194.4025 +    (test (.. sc comparator (compare (. sc entryKey e) key)) 0)))
194.4026 +
194.4027 +(defn subseq
194.4028 +  "sc must be a sorted collection, test(s) one of <, <=, > or
194.4029 +  >=. Returns a seq of those entries with keys ek for
194.4030 +  which (test (.. sc comparator (compare ek key)) 0) is true"
194.4031 +  {:added "1.0"}
194.4032 +  ([^clojure.lang.Sorted sc test key]
194.4033 +   (let [include (mk-bound-fn sc test key)]
194.4034 +     (if (#{> >=} test)
194.4035 +       (when-let [[e :as s] (. sc seqFrom key true)]
194.4036 +         (if (include e) s (next s)))
194.4037 +       (take-while include (. sc seq true)))))
194.4038 +  ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
194.4039 +   (when-let [[e :as s] (. sc seqFrom start-key true)]
194.4040 +     (take-while (mk-bound-fn sc end-test end-key)
194.4041 +                 (if ((mk-bound-fn sc start-test start-key) e) s (next s))))))
194.4042 +
194.4043 +(defn rsubseq
194.4044 +  "sc must be a sorted collection, test(s) one of <, <=, > or
194.4045 +  >=. Returns a reverse seq of those entries with keys ek for
194.4046 +  which (test (.. sc comparator (compare ek key)) 0) is true"
194.4047 +  {:added "1.0"}
194.4048 +  ([^clojure.lang.Sorted sc test key]
194.4049 +   (let [include (mk-bound-fn sc test key)]
194.4050 +     (if (#{< <=} test)
194.4051 +       (when-let [[e :as s] (. sc seqFrom key false)]
194.4052 +         (if (include e) s (next s)))
194.4053 +       (take-while include (. sc seq false)))))
194.4054 +  ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
194.4055 +   (when-let [[e :as s] (. sc seqFrom end-key false)]
194.4056 +     (take-while (mk-bound-fn sc start-test start-key)
194.4057 +                 (if ((mk-bound-fn sc end-test end-key) e) s (next s))))))
194.4058 +
194.4059 +(defn repeatedly
194.4060 +  "Takes a function of no args, presumably with side effects, and
194.4061 +  returns an infinite (or length n if supplied) lazy sequence of calls
194.4062 +  to it"
194.4063 +  {:added "1.0"}
194.4064 +  ([f] (lazy-seq (cons (f) (repeatedly f))))
194.4065 +  ([n f] (take n (repeatedly f))))
194.4066 +
194.4067 +(defn add-classpath
194.4068 +  "DEPRECATED 
194.4069 +
194.4070 +  Adds the url (String or URL object) to the classpath per
194.4071 +  URLClassLoader.addURL"
194.4072 +  {:added "1.0"
194.4073 +   :deprecated "1.1"}
194.4074 +  [url]
194.4075 +  (println "WARNING: add-classpath is deprecated")
194.4076 +  (clojure.lang.RT/addURL url))
194.4077 +
194.4078 +
194.4079 +
194.4080 +(defn hash
194.4081 +  "Returns the hash code of its argument"
194.4082 +  {:added "1.0"}
194.4083 +  [x] (. clojure.lang.Util (hash x)))
194.4084 +
194.4085 +(defn interpose
194.4086 +  "Returns a lazy seq of the elements of coll separated by sep"
194.4087 +  {:added "1.0"}
194.4088 +  [sep coll] (drop 1 (interleave (repeat sep) coll)))
194.4089 +
194.4090 +(defmacro definline
194.4091 +  "Experimental - like defmacro, except defines a named function whose
194.4092 +  body is the expansion, calls to which may be expanded inline as if
194.4093 +  it were a macro. Cannot be used with variadic (&) args."
194.4094 +  {:added "1.0"}
194.4095 +  [name & decl]
194.4096 +  (let [[pre-args [args expr]] (split-with (comp not vector?) decl)]
194.4097 +    `(do
194.4098 +       (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args))
194.4099 +       (alter-meta! (var ~name) assoc :inline (fn ~name ~args ~expr))
194.4100 +       (var ~name))))
194.4101 +
194.4102 +(defn empty
194.4103 +  "Returns an empty collection of the same category as coll, or nil"
194.4104 +  {:added "1.0"}
194.4105 +  [coll]
194.4106 +  (when (instance? clojure.lang.IPersistentCollection coll)
194.4107 +    (.empty ^clojure.lang.IPersistentCollection coll)))
194.4108 +
194.4109 +(defmacro amap
194.4110 +  "Maps an expression across an array a, using an index named idx, and
194.4111 +  return value named ret, initialized to a clone of a, then setting 
194.4112 +  each element of ret to the evaluation of expr, returning the new 
194.4113 +  array ret."
194.4114 +  {:added "1.0"}
194.4115 +  [a idx ret expr]
194.4116 +  `(let [a# ~a
194.4117 +         ~ret (aclone a#)]
194.4118 +     (loop  [~idx (int 0)]
194.4119 +       (if (< ~idx  (alength a#))
194.4120 +         (do
194.4121 +           (aset ~ret ~idx ~expr)
194.4122 +           (recur (unchecked-inc ~idx)))
194.4123 +         ~ret))))
194.4124 +
194.4125 +(defmacro areduce
194.4126 +  "Reduces an expression across an array a, using an index named idx,
194.4127 +  and return value named ret, initialized to init, setting ret to the 
194.4128 +  evaluation of expr at each step, returning ret."
194.4129 +  {:added "1.0"}
194.4130 +  [a idx ret init expr]
194.4131 +  `(let [a# ~a]
194.4132 +     (loop  [~idx (int 0) ~ret ~init]
194.4133 +       (if (< ~idx  (alength a#))
194.4134 +         (recur (unchecked-inc ~idx) ~expr)
194.4135 +         ~ret))))
194.4136 +
194.4137 +(defn float-array
194.4138 +  "Creates an array of floats"
194.4139 +  {:inline (fn [& args] `(. clojure.lang.Numbers float_array ~@args))
194.4140 +   :inline-arities #{1 2}
194.4141 +   :added "1.0"}
194.4142 +  ([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq))
194.4143 +  ([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq)))
194.4144 +
194.4145 +(defn boolean-array
194.4146 +  "Creates an array of booleans"
194.4147 +  {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args))
194.4148 +   :inline-arities #{1 2}
194.4149 +   :added "1.1"}
194.4150 +  ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq))
194.4151 +  ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq)))
194.4152 +
194.4153 +(defn byte-array
194.4154 +  "Creates an array of bytes"
194.4155 +  {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args))
194.4156 +   :inline-arities #{1 2}
194.4157 +   :added "1.1"}
194.4158 +  ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq))
194.4159 +  ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq)))
194.4160 +
194.4161 +(defn char-array
194.4162 +  "Creates an array of chars"
194.4163 +  {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args))
194.4164 +   :inline-arities #{1 2}
194.4165 +   :added "1.1"}
194.4166 +  ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq))
194.4167 +  ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq)))
194.4168 +
194.4169 +(defn short-array
194.4170 +  "Creates an array of shorts"
194.4171 +  {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args))
194.4172 +   :inline-arities #{1 2}
194.4173 +   :added "1.1"}
194.4174 +  ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq))
194.4175 +  ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq)))
194.4176 +
194.4177 +(defn double-array
194.4178 +  "Creates an array of doubles"
194.4179 +  {:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args))
194.4180 +   :inline-arities #{1 2}
194.4181 +   :added "1.0"}
194.4182 +  ([size-or-seq] (. clojure.lang.Numbers double_array size-or-seq))
194.4183 +  ([size init-val-or-seq] (. clojure.lang.Numbers double_array size init-val-or-seq)))
194.4184 +
194.4185 +(defn object-array
194.4186 +  "Creates an array of objects"
194.4187 +  {:inline (fn [arg] `(. clojure.lang.RT object_array ~arg))
194.4188 +   :inline-arities #{1}
194.4189 +   :added "1.2"}
194.4190 +  ([size-or-seq] (. clojure.lang.RT object_array size-or-seq)))
194.4191 +
194.4192 +(defn int-array
194.4193 +  "Creates an array of ints"
194.4194 +  {:inline (fn [& args] `(. clojure.lang.Numbers int_array ~@args))
194.4195 +   :inline-arities #{1 2}
194.4196 +   :added "1.0"}
194.4197 +  ([size-or-seq] (. clojure.lang.Numbers int_array size-or-seq))
194.4198 +  ([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq)))
194.4199 +
194.4200 +(defn long-array
194.4201 +  "Creates an array of longs"
194.4202 +  {:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args))
194.4203 +   :inline-arities #{1 2}
194.4204 +   :added "1.0"}
194.4205 +  ([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq))
194.4206 +  ([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq)))
194.4207 +
194.4208 +(definline booleans
194.4209 +  "Casts to boolean[]"
194.4210 +  {:added "1.1"}
194.4211 +  [xs] `(. clojure.lang.Numbers booleans ~xs))
194.4212 +
194.4213 +(definline bytes
194.4214 +  "Casts to bytes[]"
194.4215 +  {:added "1.1"}
194.4216 +  [xs] `(. clojure.lang.Numbers bytes ~xs))
194.4217 +
194.4218 +(definline chars
194.4219 +  "Casts to chars[]"
194.4220 +  {:added "1.1"}
194.4221 +  [xs] `(. clojure.lang.Numbers chars ~xs))
194.4222 +
194.4223 +(definline shorts
194.4224 +  "Casts to shorts[]"
194.4225 +  {:added "1.1"}
194.4226 +  [xs] `(. clojure.lang.Numbers shorts ~xs))
194.4227 +
194.4228 +(definline floats
194.4229 +  "Casts to float[]"
194.4230 +  {:added "1.0"}
194.4231 +  [xs] `(. clojure.lang.Numbers floats ~xs))
194.4232 +
194.4233 +(definline ints
194.4234 +  "Casts to int[]"
194.4235 +  {:added "1.0"}
194.4236 +  [xs] `(. clojure.lang.Numbers ints ~xs))
194.4237 +
194.4238 +(definline doubles
194.4239 +  "Casts to double[]"
194.4240 +  {:added "1.0"}
194.4241 +  [xs] `(. clojure.lang.Numbers doubles ~xs))
194.4242 +
194.4243 +(definline longs
194.4244 +  "Casts to long[]"
194.4245 +  {:added "1.0"}
194.4246 +  [xs] `(. clojure.lang.Numbers longs ~xs))
194.4247 +
194.4248 +(import '(java.util.concurrent BlockingQueue LinkedBlockingQueue))
194.4249 +
194.4250 +(defn seque
194.4251 +  "Creates a queued seq on another (presumably lazy) seq s. The queued
194.4252 +  seq will produce a concrete seq in the background, and can get up to
194.4253 +  n items ahead of the consumer. n-or-q can be an integer n buffer
194.4254 +  size, or an instance of java.util.concurrent BlockingQueue. Note
194.4255 +  that reading from a seque can block if the reader gets ahead of the
194.4256 +  producer."
194.4257 +  {:added "1.0"}
194.4258 +  ([s] (seque 100 s))
194.4259 +  ([n-or-q s]
194.4260 +   (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q)
194.4261 +                             n-or-q
194.4262 +                             (LinkedBlockingQueue. (int n-or-q)))
194.4263 +         NIL (Object.) ;nil sentinel since LBQ doesn't support nils
194.4264 +         agt (agent (seq s))
194.4265 +         fill (fn [s]
194.4266 +                (try
194.4267 +                  (loop [[x & xs :as s] s]
194.4268 +                    (if s
194.4269 +                      (if (.offer q (if (nil? x) NIL x))
194.4270 +                        (recur xs)
194.4271 +                        s)
194.4272 +                      (.put q q))) ; q itself is eos sentinel
194.4273 +                  (catch Exception e
194.4274 +                    (.put q q)
194.4275 +                    (throw e))))
194.4276 +         drain (fn drain []
194.4277 +                 (lazy-seq
194.4278 +                  (let [x (.take q)]
194.4279 +                    (if (identical? x q) ;q itself is eos sentinel
194.4280 +                      (do @agt nil)  ;touch agent just to propagate errors
194.4281 +                      (do
194.4282 +                        (send-off agt fill)
194.4283 +                        (cons (if (identical? x NIL) nil x) (drain)))))))]
194.4284 +     (send-off agt fill)
194.4285 +     (drain))))
194.4286 +
194.4287 +(defn class?
194.4288 +  "Returns true if x is an instance of Class"
194.4289 +  {:added "1.0"}
194.4290 +  [x] (instance? Class x))
194.4291 +
194.4292 +(defn- is-annotation? [c]
194.4293 +  (and (class? c)
194.4294 +       (.isAssignableFrom java.lang.annotation.Annotation c)))
194.4295 +
194.4296 +(defn- is-runtime-annotation? [^Class c]
194.4297 +  (boolean 
194.4298 +   (and (is-annotation? c)
194.4299 +        (when-let [^java.lang.annotation.Retention r 
194.4300 +                   (.getAnnotation c java.lang.annotation.Retention)] 
194.4301 +          (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME)))))
194.4302 +
194.4303 +(defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c))
194.4304 +
194.4305 +(declare process-annotation)
194.4306 +(defn- add-annotation [^clojure.asm.AnnotationVisitor av name v]
194.4307 +  (cond
194.4308 +   (vector? v) (let [avec (.visitArray av name)]
194.4309 +                 (doseq [vval v]
194.4310 +                   (add-annotation avec "value" vval))
194.4311 +                 (.visitEnd avec))
194.4312 +   (symbol? v) (let [ev (eval v)]
194.4313 +                 (cond 
194.4314 +                  (instance? java.lang.Enum ev)
194.4315 +                  (.visitEnum av name (descriptor (class ev)) (str ev))
194.4316 +                  (class? ev) (.visit av name (clojure.asm.Type/getType ev))
194.4317 +                  :else (throw (IllegalArgumentException. 
194.4318 +                                (str "Unsupported annotation value: " v " of class " (class ev))))))
194.4319 +   (seq? v) (let [[nested nv] v
194.4320 +                  c (resolve nested)
194.4321 +                  nav (.visitAnnotation av name (descriptor c))]
194.4322 +              (process-annotation nav nv)
194.4323 +              (.visitEnd nav))
194.4324 +   :else (.visit av name v)))
194.4325 +
194.4326 +(defn- process-annotation [av v]
194.4327 +  (if (map? v) 
194.4328 +    (doseq [[k v] v]
194.4329 +      (add-annotation av (name k) v))
194.4330 +    (add-annotation av "value" v)))
194.4331 +
194.4332 +(defn- add-annotations
194.4333 +  ([visitor m] (add-annotations visitor m nil))
194.4334 +  ([visitor m i]
194.4335 +     (doseq [[k v] m]
194.4336 +       (when (symbol? k)
194.4337 +         (when-let [c (resolve k)]
194.4338 +           (when (is-annotation? c)
194.4339 +                                        ;this is known duck/reflective as no common base of ASM Visitors
194.4340 +             (let [av (if i
194.4341 +                        (.visitParameterAnnotation visitor i (descriptor c) 
194.4342 +                                                   (is-runtime-annotation? c))
194.4343 +                        (.visitAnnotation visitor (descriptor c) 
194.4344 +                                          (is-runtime-annotation? c)))]
194.4345 +               (process-annotation av v)
194.4346 +               (.visitEnd av))))))))
194.4347 +
194.4348 +(defn alter-var-root
194.4349 +  "Atomically alters the root binding of var v by applying f to its
194.4350 +  current value plus any args"
194.4351 +  {:added "1.0"}
194.4352 +  [^clojure.lang.Var v f & args] (.alterRoot v f args))
194.4353 +
194.4354 +(defn bound?
194.4355 +  "Returns true if all of the vars provided as arguments have any bound value, root or thread-local.
194.4356 +   Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided."
194.4357 +  {:added "1.2"}
194.4358 +  [& vars]
194.4359 +  (every? #(.isBound ^clojure.lang.Var %) vars))
194.4360 +
194.4361 +(defn thread-bound?
194.4362 +  "Returns true if all of the vars provided as arguments have thread-local bindings.
194.4363 +   Implies that set!'ing the provided vars will succeed.  Returns true if no vars are provided."
194.4364 +  {:added "1.2"}
194.4365 +  [& vars]
194.4366 +  (every? #(.getThreadBinding ^clojure.lang.Var %) vars))
194.4367 +
194.4368 +(defn make-hierarchy
194.4369 +  "Creates a hierarchy object for use with derive, isa? etc."
194.4370 +  {:added "1.0"}
194.4371 +  [] {:parents {} :descendants {} :ancestors {}})
194.4372 +
194.4373 +(def ^{:private true}
194.4374 +     global-hierarchy (make-hierarchy))
194.4375 +
194.4376 +(defn not-empty
194.4377 +  "If coll is empty, returns nil, else coll"
194.4378 +  {:added "1.0"}
194.4379 +  [coll] (when (seq coll) coll))
194.4380 +
194.4381 +(defn bases
194.4382 +  "Returns the immediate superclass and direct interfaces of c, if any"
194.4383 +  {:added "1.0"}
194.4384 +  [^Class c]
194.4385 +  (when c
194.4386 +    (let [i (.getInterfaces c)
194.4387 +          s (.getSuperclass c)]
194.4388 +      (not-empty
194.4389 +       (if s (cons s i) i)))))
194.4390 +
194.4391 +(defn supers
194.4392 +  "Returns the immediate and indirect superclasses and interfaces of c, if any"
194.4393 +  {:added "1.0"}
194.4394 +  [^Class class]
194.4395 +  (loop [ret (set (bases class)) cs ret]
194.4396 +    (if (seq cs)
194.4397 +      (let [c (first cs) bs (bases c)]
194.4398 +        (recur (into ret bs) (into (disj cs c) bs)))
194.4399 +      (not-empty ret))))
194.4400 +
194.4401 +(defn isa?
194.4402 +  "Returns true if (= child parent), or child is directly or indirectly derived from
194.4403 +  parent, either via a Java type inheritance relationship or a
194.4404 +  relationship established via derive. h must be a hierarchy obtained
194.4405 +  from make-hierarchy, if not supplied defaults to the global
194.4406 +  hierarchy"
194.4407 +  {:added "1.0"}
194.4408 +  ([child parent] (isa? global-hierarchy child parent))
194.4409 +  ([h child parent]
194.4410 +   (or (= child parent)
194.4411 +       (and (class? parent) (class? child)
194.4412 +            (. ^Class parent isAssignableFrom child))
194.4413 +       (contains? ((:ancestors h) child) parent)
194.4414 +       (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child)))
194.4415 +       (and (vector? parent) (vector? child)
194.4416 +            (= (count parent) (count child))
194.4417 +            (loop [ret true i 0]
194.4418 +              (if (or (not ret) (= i (count parent)))
194.4419 +                ret
194.4420 +                (recur (isa? h (child i) (parent i)) (inc i))))))))
194.4421 +
194.4422 +(defn parents
194.4423 +  "Returns the immediate parents of tag, either via a Java type
194.4424 +  inheritance relationship or a relationship established via derive. h
194.4425 +  must be a hierarchy obtained from make-hierarchy, if not supplied
194.4426 +  defaults to the global hierarchy"
194.4427 +  {:added "1.0"}
194.4428 +  ([tag] (parents global-hierarchy tag))
194.4429 +  ([h tag] (not-empty
194.4430 +            (let [tp (get (:parents h) tag)]
194.4431 +              (if (class? tag)
194.4432 +                (into (set (bases tag)) tp)
194.4433 +                tp)))))
194.4434 +
194.4435 +(defn ancestors
194.4436 +  "Returns the immediate and indirect parents of tag, either via a Java type
194.4437 +  inheritance relationship or a relationship established via derive. h
194.4438 +  must be a hierarchy obtained from make-hierarchy, if not supplied
194.4439 +  defaults to the global hierarchy"
194.4440 +  {:added "1.0"}
194.4441 +  ([tag] (ancestors global-hierarchy tag))
194.4442 +  ([h tag] (not-empty
194.4443 +            (let [ta (get (:ancestors h) tag)]
194.4444 +              (if (class? tag)
194.4445 +                (let [superclasses (set (supers tag))]
194.4446 +                  (reduce into superclasses
194.4447 +                    (cons ta
194.4448 +                          (map #(get (:ancestors h) %) superclasses))))
194.4449 +                ta)))))
194.4450 +
194.4451 +(defn descendants
194.4452 +  "Returns the immediate and indirect children of tag, through a
194.4453 +  relationship established via derive. h must be a hierarchy obtained
194.4454 +  from make-hierarchy, if not supplied defaults to the global
194.4455 +  hierarchy. Note: does not work on Java type inheritance
194.4456 +  relationships."
194.4457 +  {:added "1.0"}
194.4458 +  ([tag] (descendants global-hierarchy tag))
194.4459 +  ([h tag] (if (class? tag)
194.4460 +             (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes"))
194.4461 +             (not-empty (get (:descendants h) tag)))))
194.4462 +
194.4463 +(defn derive
194.4464 +  "Establishes a parent/child relationship between parent and
194.4465 +  tag. Parent must be a namespace-qualified symbol or keyword and
194.4466 +  child can be either a namespace-qualified symbol or keyword or a
194.4467 +  class. h must be a hierarchy obtained from make-hierarchy, if not
194.4468 +  supplied defaults to, and modifies, the global hierarchy."
194.4469 +  {:added "1.0"}
194.4470 +  ([tag parent]
194.4471 +   (assert (namespace parent))
194.4472 +   (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag))))
194.4473 +
194.4474 +   (alter-var-root #'global-hierarchy derive tag parent) nil)
194.4475 +  ([h tag parent]
194.4476 +   (assert (not= tag parent))
194.4477 +   (assert (or (class? tag) (instance? clojure.lang.Named tag)))
194.4478 +   (assert (instance? clojure.lang.Named parent))
194.4479 +
194.4480 +   (let [tp (:parents h)
194.4481 +         td (:descendants h)
194.4482 +         ta (:ancestors h)
194.4483 +         tf (fn [m source sources target targets]
194.4484 +              (reduce (fn [ret k]
194.4485 +                        (assoc ret k
194.4486 +                               (reduce conj (get targets k #{}) (cons target (targets target)))))
194.4487 +                      m (cons source (sources source))))]
194.4488 +     (or
194.4489 +      (when-not (contains? (tp tag) parent)
194.4490 +        (when (contains? (ta tag) parent)
194.4491 +          (throw (Exception. (print-str tag "already has" parent "as ancestor"))))
194.4492 +        (when (contains? (ta parent) tag)
194.4493 +          (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor"))))
194.4494 +        {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent))
194.4495 +         :ancestors (tf (:ancestors h) tag td parent ta)
194.4496 +         :descendants (tf (:descendants h) parent ta tag td)})
194.4497 +      h))))
194.4498 +
194.4499 +(declare flatten)
194.4500 +
194.4501 +(defn underive
194.4502 +  "Removes a parent/child relationship between parent and
194.4503 +  tag. h must be a hierarchy obtained from make-hierarchy, if not
194.4504 +  supplied defaults to, and modifies, the global hierarchy."
194.4505 +  {:added "1.0"}
194.4506 +  ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil)
194.4507 +  ([h tag parent]
194.4508 +    (let [parentMap (:parents h)
194.4509 +	  childsParents (if (parentMap tag)
194.4510 +			  (disj (parentMap tag) parent) #{})
194.4511 +	  newParents (if (not-empty childsParents)
194.4512 +		       (assoc parentMap tag childsParents)
194.4513 +		       (dissoc parentMap tag))
194.4514 +	  deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %)))
194.4515 +				       (seq newParents)))]
194.4516 +      (if (contains? (parentMap tag) parent)
194.4517 +	(reduce #(apply derive %1 %2) (make-hierarchy)
194.4518 +		(partition 2 deriv-seq))
194.4519 +	h))))
194.4520 +
194.4521 +
194.4522 +(defn distinct?
194.4523 +  "Returns true if no two of the arguments are ="
194.4524 +  {:tag Boolean
194.4525 +   :added "1.0"}
194.4526 +  ([x] true)
194.4527 +  ([x y] (not (= x y)))
194.4528 +  ([x y & more]
194.4529 +   (if (not= x y)
194.4530 +     (loop [s #{x y} [x & etc :as xs] more]
194.4531 +       (if xs
194.4532 +         (if (contains? s x)
194.4533 +           false
194.4534 +           (recur (conj s x) etc))
194.4535 +         true))
194.4536 +     false)))
194.4537 +
194.4538 +(defn resultset-seq
194.4539 +  "Creates and returns a lazy sequence of structmaps corresponding to
194.4540 +  the rows in the java.sql.ResultSet rs"
194.4541 +  {:added "1.0"}
194.4542 +  [^java.sql.ResultSet rs]
194.4543 +    (let [rsmeta (. rs (getMetaData))
194.4544 +          idxs (range 1 (inc (. rsmeta (getColumnCount))))
194.4545 +          keys (map (comp keyword #(.toLowerCase ^String %))
194.4546 +                    (map (fn [i] (. rsmeta (getColumnLabel i))) idxs))
194.4547 +          check-keys
194.4548 +                (or (apply distinct? keys)
194.4549 +                    (throw (Exception. "ResultSet must have unique column labels")))
194.4550 +          row-struct (apply create-struct keys)
194.4551 +          row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs))
194.4552 +          rows (fn thisfn []
194.4553 +                 (when (. rs (next))
194.4554 +                   (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))]
194.4555 +      (rows)))
194.4556 +
194.4557 +(defn iterator-seq
194.4558 +  "Returns a seq on a java.util.Iterator. Note that most collections
194.4559 +  providing iterators implement Iterable and thus support seq directly."
194.4560 +  {:added "1.0"}
194.4561 +  [iter]
194.4562 +  (clojure.lang.IteratorSeq/create iter))
194.4563 +
194.4564 +(defn enumeration-seq
194.4565 +  "Returns a seq on a java.util.Enumeration"
194.4566 +  {:added "1.0"}
194.4567 +  [e]
194.4568 +  (clojure.lang.EnumerationSeq/create e))
194.4569 +
194.4570 +(defn format
194.4571 +  "Formats a string using java.lang.String.format, see java.util.Formatter for format
194.4572 +  string syntax"
194.4573 +  {:tag String
194.4574 +   :added "1.0"}
194.4575 +  [fmt & args]
194.4576 +  (String/format fmt (to-array args)))
194.4577 +
194.4578 +(defn printf
194.4579 +  "Prints formatted output, as per format"
194.4580 +  {:added "1.0"}
194.4581 +  [fmt & args]
194.4582 +  (print (apply format fmt args)))
194.4583 +
194.4584 +(declare gen-class)
194.4585 +
194.4586 +(defmacro with-loading-context [& body]
194.4587 +  `((fn loading# [] 
194.4588 +        (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER  
194.4589 +                                                 (.getClassLoader (.getClass ^Object loading#))}))
194.4590 +        (try
194.4591 +         ~@body
194.4592 +         (finally
194.4593 +          (. clojure.lang.Var (popThreadBindings)))))))
194.4594 +
194.4595 +(defmacro ns
194.4596 +  "Sets *ns* to the namespace named by name (unevaluated), creating it
194.4597 +  if needed.  references can be zero or more of: (:refer-clojure ...)
194.4598 +  (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class)
194.4599 +  with the syntax of refer-clojure/require/use/import/load/gen-class
194.4600 +  respectively, except the arguments are unevaluated and need not be
194.4601 +  quoted. (:gen-class ...), when supplied, defaults to :name
194.4602 +  corresponding to the ns name, :main true, :impl-ns same as ns, and
194.4603 +  :init-impl-ns true. All options of gen-class are
194.4604 +  supported. The :gen-class directive is ignored when not
194.4605 +  compiling. If :gen-class is not supplied, when compiled only an
194.4606 +  nsname__init.class will be generated. If :refer-clojure is not used, a
194.4607 +  default (refer 'clojure) is used.  Use of ns is preferred to
194.4608 +  individual calls to in-ns/require/use/import:
194.4609 +
194.4610 +  (ns foo.bar
194.4611 +    (:refer-clojure :exclude [ancestors printf])
194.4612 +    (:require (clojure.contrib sql sql.tests))
194.4613 +    (:use (my.lib this that))
194.4614 +    (:import (java.util Date Timer Random)
194.4615 +             (java.sql Connection Statement)))"
194.4616 +  {:arglists '([name docstring? attr-map? references*])
194.4617 +   :added "1.0"}
194.4618 +  [name & references]
194.4619 +  (let [process-reference
194.4620 +        (fn [[kname & args]]
194.4621 +          `(~(symbol "clojure.core" (clojure.core/name kname))
194.4622 +             ~@(map #(list 'quote %) args)))
194.4623 +        docstring  (when (string? (first references)) (first references))
194.4624 +        references (if docstring (next references) references)
194.4625 +        name (if docstring
194.4626 +               (vary-meta name assoc :doc docstring)
194.4627 +               name)
194.4628 +        metadata   (when (map? (first references)) (first references))
194.4629 +        references (if metadata (next references) references)
194.4630 +        name (if metadata
194.4631 +               (vary-meta name merge metadata)
194.4632 +               name)
194.4633 +        gen-class-clause (first (filter #(= :gen-class (first %)) references))
194.4634 +        gen-class-call
194.4635 +          (when gen-class-clause
194.4636 +            (list* `gen-class :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause)))
194.4637 +        references (remove #(= :gen-class (first %)) references)
194.4638 +        ;ns-effect (clojure.core/in-ns name)
194.4639 +        ]
194.4640 +    `(do
194.4641 +       (clojure.core/in-ns '~name)
194.4642 +       (with-loading-context
194.4643 +        ~@(when gen-class-call (list gen-class-call))
194.4644 +        ~@(when (and (not= name 'clojure.core) (not-any? #(= :refer-clojure (first %)) references))
194.4645 +            `((clojure.core/refer '~'clojure.core)))
194.4646 +        ~@(map process-reference references)))))
194.4647 +
194.4648 +(defmacro refer-clojure
194.4649 +  "Same as (refer 'clojure.core <filters>)"
194.4650 +  {:added "1.0"}
194.4651 +  [& filters]
194.4652 +  `(clojure.core/refer '~'clojure.core ~@filters))
194.4653 +
194.4654 +(defmacro defonce
194.4655 +  "defs name to have the root value of the expr iff the named var has no root value,
194.4656 +  else expr is unevaluated"
194.4657 +  {:added "1.0"}
194.4658 +  [name expr]
194.4659 +  `(let [v# (def ~name)]
194.4660 +     (when-not (.hasRoot v#)
194.4661 +       (def ~name ~expr))))
194.4662 +
194.4663 +;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;;
194.4664 +
194.4665 +(defonce
194.4666 +  ^{:private true
194.4667 +     :doc "A ref to a sorted set of symbols representing loaded libs"}
194.4668 +  *loaded-libs* (ref (sorted-set)))
194.4669 +
194.4670 +(defonce
194.4671 +  ^{:private true
194.4672 +     :doc "the set of paths currently being loaded by this thread"}
194.4673 +  *pending-paths* #{})
194.4674 +
194.4675 +(defonce
194.4676 +  ^{:private true :doc
194.4677 +     "True while a verbose load is pending"}
194.4678 +  *loading-verbosely* false)
194.4679 +
194.4680 +(defn- throw-if
194.4681 +  "Throws an exception with a message if pred is true"
194.4682 +  [pred fmt & args]
194.4683 +  (when pred
194.4684 +    (let [^String message (apply format fmt args)
194.4685 +          exception (Exception. message)
194.4686 +          raw-trace (.getStackTrace exception)
194.4687 +          boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke")
194.4688 +          trace (into-array (drop 2 (drop-while boring? raw-trace)))]
194.4689 +      (.setStackTrace exception trace)
194.4690 +      (throw exception))))
194.4691 +
194.4692 +(defn- libspec?
194.4693 +  "Returns true if x is a libspec"
194.4694 +  [x]
194.4695 +  (or (symbol? x)
194.4696 +      (and (vector? x)
194.4697 +           (or
194.4698 +            (nil? (second x))
194.4699 +            (keyword? (second x))))))
194.4700 +
194.4701 +(defn- prependss
194.4702 +  "Prepends a symbol or a seq to coll"
194.4703 +  [x coll]
194.4704 +  (if (symbol? x)
194.4705 +    (cons x coll)
194.4706 +    (concat x coll)))
194.4707 +
194.4708 +(defn- root-resource
194.4709 +  "Returns the root directory path for a lib"
194.4710 +  {:tag String}
194.4711 +  [lib]
194.4712 +  (str \/
194.4713 +       (.. (name lib)
194.4714 +           (replace \- \_)
194.4715 +           (replace \. \/))))
194.4716 +
194.4717 +(defn- root-directory
194.4718 +  "Returns the root resource path for a lib"
194.4719 +  [lib]
194.4720 +  (let [d (root-resource lib)]
194.4721 +    (subs d 0 (.lastIndexOf d "/"))))
194.4722 +
194.4723 +(declare load)
194.4724 +
194.4725 +(defn- load-one
194.4726 +  "Loads a lib given its name. If need-ns, ensures that the associated
194.4727 +  namespace exists after loading. If require, records the load so any
194.4728 +  duplicate loads can be skipped."
194.4729 +  [lib need-ns require]
194.4730 +  (load (root-resource lib))
194.4731 +  (throw-if (and need-ns (not (find-ns lib)))
194.4732 +            "namespace '%s' not found after loading '%s'"
194.4733 +            lib (root-resource lib))
194.4734 +  (when require
194.4735 +    (dosync
194.4736 +     (commute *loaded-libs* conj lib))))
194.4737 +
194.4738 +(defn- load-all
194.4739 +  "Loads a lib given its name and forces a load of any libs it directly or
194.4740 +  indirectly loads. If need-ns, ensures that the associated namespace
194.4741 +  exists after loading. If require, records the load so any duplicate loads
194.4742 +  can be skipped."
194.4743 +  [lib need-ns require]
194.4744 +  (dosync
194.4745 +   (commute *loaded-libs* #(reduce conj %1 %2)
194.4746 +            (binding [*loaded-libs* (ref (sorted-set))]
194.4747 +              (load-one lib need-ns require)
194.4748 +              @*loaded-libs*))))
194.4749 +
194.4750 +(defn- load-lib
194.4751 +  "Loads a lib with options"
194.4752 +  [prefix lib & options]
194.4753 +  (throw-if (and prefix (pos? (.indexOf (name lib) (int \.))))
194.4754 +            "lib names inside prefix lists must not contain periods")
194.4755 +  (let [lib (if prefix (symbol (str prefix \. lib)) lib)
194.4756 +        opts (apply hash-map options)
194.4757 +        {:keys [as reload reload-all require use verbose]} opts
194.4758 +        loaded (contains? @*loaded-libs* lib)
194.4759 +        load (cond reload-all
194.4760 +                   load-all
194.4761 +                   (or reload (not require) (not loaded))
194.4762 +                   load-one)
194.4763 +        need-ns (or as use)
194.4764 +        filter-opts (select-keys opts '(:exclude :only :rename))]
194.4765 +    (binding [*loading-verbosely* (or *loading-verbosely* verbose)]
194.4766 +      (if load
194.4767 +        (load lib need-ns require)
194.4768 +        (throw-if (and need-ns (not (find-ns lib)))
194.4769 +                  "namespace '%s' not found" lib))
194.4770 +      (when (and need-ns *loading-verbosely*)
194.4771 +        (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*)))
194.4772 +      (when as
194.4773 +        (when *loading-verbosely*
194.4774 +          (printf "(clojure.core/alias '%s '%s)\n" as lib))
194.4775 +        (alias as lib))
194.4776 +      (when use
194.4777 +        (when *loading-verbosely*
194.4778 +          (printf "(clojure.core/refer '%s" lib)
194.4779 +          (doseq [opt filter-opts]
194.4780 +            (printf " %s '%s" (key opt) (print-str (val opt))))
194.4781 +          (printf ")\n"))
194.4782 +        (apply refer lib (mapcat seq filter-opts))))))
194.4783 +
194.4784 +(defn- load-libs
194.4785 +  "Loads libs, interpreting libspecs, prefix lists, and flags for
194.4786 +  forwarding to load-lib"
194.4787 +  [& args]
194.4788 +  (let [flags (filter keyword? args)
194.4789 +        opts (interleave flags (repeat true))
194.4790 +        args (filter (complement keyword?) args)]
194.4791 +    ; check for unsupported options
194.4792 +    (let [supported #{:as :reload :reload-all :require :use :verbose} 
194.4793 +          unsupported (seq (remove supported flags))]
194.4794 +      (throw-if unsupported
194.4795 +                (apply str "Unsupported option(s) supplied: "
194.4796 +                     (interpose \, unsupported))))
194.4797 +    ; check a load target was specified
194.4798 +    (throw-if (not (seq args)) "Nothing specified to load")
194.4799 +    (doseq [arg args]
194.4800 +      (if (libspec? arg)
194.4801 +        (apply load-lib nil (prependss arg opts))
194.4802 +        (let [[prefix & args] arg]
194.4803 +          (throw-if (nil? prefix) "prefix cannot be nil")
194.4804 +          (doseq [arg args]
194.4805 +            (apply load-lib prefix (prependss arg opts))))))))
194.4806 +
194.4807 +;; Public
194.4808 +
194.4809 +
194.4810 +(defn require
194.4811 +  "Loads libs, skipping any that are already loaded. Each argument is
194.4812 +  either a libspec that identifies a lib, a prefix list that identifies
194.4813 +  multiple libs whose names share a common prefix, or a flag that modifies
194.4814 +  how all the identified libs are loaded. Use :require in the ns macro
194.4815 +  in preference to calling this directly.
194.4816 +
194.4817 +  Libs
194.4818 +
194.4819 +  A 'lib' is a named set of resources in classpath whose contents define a
194.4820 +  library of Clojure code. Lib names are symbols and each lib is associated
194.4821 +  with a Clojure namespace and a Java package that share its name. A lib's
194.4822 +  name also locates its root directory within classpath using Java's
194.4823 +  package name to classpath-relative path mapping. All resources in a lib
194.4824 +  should be contained in the directory structure under its root directory.
194.4825 +  All definitions a lib makes should be in its associated namespace.
194.4826 +
194.4827 +  'require loads a lib by loading its root resource. The root resource path
194.4828 +  is derived from the lib name in the following manner:
194.4829 +  Consider a lib named by the symbol 'x.y.z; it has the root directory
194.4830 +  <classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root
194.4831 +  resource should contain code to create the lib's namespace (usually by using
194.4832 +  the ns macro) and load any additional lib resources.
194.4833 +
194.4834 +  Libspecs
194.4835 +
194.4836 +  A libspec is a lib name or a vector containing a lib name followed by
194.4837 +  options expressed as sequential keywords and arguments.
194.4838 +
194.4839 +  Recognized options: :as
194.4840 +  :as takes a symbol as its argument and makes that symbol an alias to the
194.4841 +    lib's namespace in the current namespace.
194.4842 +
194.4843 +  Prefix Lists
194.4844 +
194.4845 +  It's common for Clojure code to depend on several libs whose names have
194.4846 +  the same prefix. When specifying libs, prefix lists can be used to reduce
194.4847 +  repetition. A prefix list contains the shared prefix followed by libspecs
194.4848 +  with the shared prefix removed from the lib names. After removing the
194.4849 +  prefix, the names that remain must not contain any periods.
194.4850 +
194.4851 +  Flags
194.4852 +
194.4853 +  A flag is a keyword.
194.4854 +  Recognized flags: :reload, :reload-all, :verbose
194.4855 +  :reload forces loading of all the identified libs even if they are
194.4856 +    already loaded
194.4857 +  :reload-all implies :reload and also forces loading of all libs that the
194.4858 +    identified libs directly or indirectly load via require or use
194.4859 +  :verbose triggers printing information about each load, alias, and refer
194.4860 +
194.4861 +  Example:
194.4862 +
194.4863 +  The following would load the libraries clojure.zip and clojure.set
194.4864 +  abbreviated as 's'.
194.4865 +
194.4866 +  (require '(clojure zip [set :as s]))"
194.4867 +  {:added "1.0"}
194.4868 +
194.4869 +  [& args]
194.4870 +  (apply load-libs :require args))
194.4871 +
194.4872 +(defn use
194.4873 +  "Like 'require, but also refers to each lib's namespace using
194.4874 +  clojure.core/refer. Use :use in the ns macro in preference to calling
194.4875 +  this directly.
194.4876 +
194.4877 +  'use accepts additional options in libspecs: :exclude, :only, :rename.
194.4878 +  The arguments and semantics for :exclude, :only, and :rename are the same
194.4879 +  as those documented for clojure.core/refer."
194.4880 +  {:added "1.0"}
194.4881 +  [& args] (apply load-libs :require :use args))
194.4882 +
194.4883 +(defn loaded-libs
194.4884 +  "Returns a sorted set of symbols naming the currently loaded libs"
194.4885 +  {:added "1.0"}
194.4886 +  [] @*loaded-libs*)
194.4887 +
194.4888 +(defn load
194.4889 +  "Loads Clojure code from resources in classpath. A path is interpreted as
194.4890 +  classpath-relative if it begins with a slash or relative to the root
194.4891 +  directory for the current namespace otherwise."
194.4892 +  {:added "1.0"}
194.4893 +  [& paths]
194.4894 +  (doseq [^String path paths]
194.4895 +    (let [^String path (if (.startsWith path "/")
194.4896 +                          path
194.4897 +                          (str (root-directory (ns-name *ns*)) \/ path))]
194.4898 +      (when *loading-verbosely*
194.4899 +        (printf "(clojure.core/load \"%s\")\n" path)
194.4900 +        (flush))
194.4901 +;      (throw-if (*pending-paths* path)
194.4902 +;                "cannot load '%s' again while it is loading"
194.4903 +;                path)
194.4904 +      (when-not (*pending-paths* path)
194.4905 +        (binding [*pending-paths* (conj *pending-paths* path)]
194.4906 +          (clojure.lang.RT/load  (.substring path 1)))))))
194.4907 +
194.4908 +(defn compile
194.4909 +  "Compiles the namespace named by the symbol lib into a set of
194.4910 +  classfiles. The source for the lib must be in a proper
194.4911 +  classpath-relative directory. The output files will go into the
194.4912 +  directory specified by *compile-path*, and that directory too must
194.4913 +  be in the classpath."
194.4914 +  {:added "1.0"}
194.4915 +  [lib]
194.4916 +  (binding [*compile-files* true]
194.4917 +    (load-one lib true true))
194.4918 +  lib)
194.4919 +
194.4920 +;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;;
194.4921 +
194.4922 +(defn get-in
194.4923 +  "Returns the value in a nested associative structure,
194.4924 +  where ks is a sequence of ke(ys. Returns nil if the key is not present,
194.4925 +  or the not-found value if supplied."
194.4926 +  {:added "1.2"}
194.4927 +  ([m ks]
194.4928 +     (reduce get m ks))
194.4929 +  ([m ks not-found]
194.4930 +     (loop [sentinel (Object.)
194.4931 +            m m
194.4932 +            ks (seq ks)]
194.4933 +       (if ks
194.4934 +         (let [m (get m (first ks) sentinel)]
194.4935 +           (if (identical? sentinel m)
194.4936 +             not-found
194.4937 +             (recur sentinel m (next ks))))
194.4938 +         m))))
194.4939 +
194.4940 +(defn assoc-in
194.4941 +  "Associates a value in a nested associative structure, where ks is a
194.4942 +  sequence of keys and v is the new value and returns a new nested structure.
194.4943 +  If any levels do not exist, hash-maps will be created."
194.4944 +  {:added "1.0"}
194.4945 +  [m [k & ks] v]
194.4946 +  (if ks
194.4947 +    (assoc m k (assoc-in (get m k) ks v))
194.4948 +    (assoc m k v)))
194.4949 +
194.4950 +(defn update-in
194.4951 +  "'Updates' a value in a nested associative structure, where ks is a
194.4952 +  sequence of keys and f is a function that will take the old value
194.4953 +  and any supplied args and return the new value, and returns a new
194.4954 +  nested structure.  If any levels do not exist, hash-maps will be
194.4955 +  created."
194.4956 +  {:added "1.0"}
194.4957 +  ([m [k & ks] f & args]
194.4958 +   (if ks
194.4959 +     (assoc m k (apply update-in (get m k) ks f args))
194.4960 +     (assoc m k (apply f (get m k) args)))))
194.4961 +
194.4962 +
194.4963 +(defn empty?
194.4964 +  "Returns true if coll has no items - same as (not (seq coll)).
194.4965 +  Please use the idiom (seq x) rather than (not (empty? x))"
194.4966 +  {:added "1.0"}
194.4967 +  [coll] (not (seq coll)))
194.4968 +
194.4969 +(defn coll?
194.4970 +  "Returns true if x implements IPersistentCollection"
194.4971 +  {:added "1.0"}
194.4972 +  [x] (instance? clojure.lang.IPersistentCollection x))
194.4973 +
194.4974 +(defn list?
194.4975 +  "Returns true if x implements IPersistentList"
194.4976 +  {:added "1.0"}
194.4977 +  [x] (instance? clojure.lang.IPersistentList x))
194.4978 +
194.4979 +(defn set?
194.4980 +  "Returns true if x implements IPersistentSet"
194.4981 +  {:added "1.0"}
194.4982 +  [x] (instance? clojure.lang.IPersistentSet x))
194.4983 +
194.4984 +(defn ifn?
194.4985 +  "Returns true if x implements IFn. Note that many data structures
194.4986 +  (e.g. sets and maps) implement IFn"
194.4987 +  {:added "1.0"}
194.4988 +  [x] (instance? clojure.lang.IFn x))
194.4989 +
194.4990 +(defn fn?
194.4991 +  "Returns true if x implements Fn, i.e. is an object created via fn."
194.4992 +  {:added "1.0"}
194.4993 +  [x] (instance? clojure.lang.Fn x))
194.4994 +
194.4995 +
194.4996 +(defn associative?
194.4997 + "Returns true if coll implements Associative"
194.4998 + {:added "1.0"}
194.4999 +  [coll] (instance? clojure.lang.Associative coll))
194.5000 +
194.5001 +(defn sequential?
194.5002 + "Returns true if coll implements Sequential"
194.5003 + {:added "1.0"}
194.5004 +  [coll] (instance? clojure.lang.Sequential coll))
194.5005 +
194.5006 +(defn sorted?
194.5007 + "Returns true if coll implements Sorted"
194.5008 + {:added "1.0"}
194.5009 +  [coll] (instance? clojure.lang.Sorted coll))
194.5010 +
194.5011 +(defn counted?
194.5012 + "Returns true if coll implements count in constant time"
194.5013 + {:added "1.0"}
194.5014 +  [coll] (instance? clojure.lang.Counted coll))
194.5015 +
194.5016 +(defn reversible?
194.5017 + "Returns true if coll implements Reversible"
194.5018 + {:added "1.0"}
194.5019 +  [coll] (instance? clojure.lang.Reversible coll))
194.5020 +
194.5021 +(def
194.5022 + ^{:doc "bound in a repl thread to the most recent value printed"
194.5023 +   :added "1.0"}
194.5024 + *1)
194.5025 +
194.5026 +(def
194.5027 + ^{:doc "bound in a repl thread to the second most recent value printed"
194.5028 +   :added "1.0"}
194.5029 + *2)
194.5030 +
194.5031 +(def
194.5032 + ^{:doc "bound in a repl thread to the third most recent value printed"
194.5033 +   :added "1.0"}
194.5034 + *3)
194.5035 +
194.5036 +(def
194.5037 + ^{:doc "bound in a repl thread to the most recent exception caught by the repl"
194.5038 +   :added "1.0"}
194.5039 + *e)
194.5040 +
194.5041 +(defn trampoline
194.5042 +  "trampoline can be used to convert algorithms requiring mutual
194.5043 +  recursion without stack consumption. Calls f with supplied args, if
194.5044 +  any. If f returns a fn, calls that fn with no arguments, and
194.5045 +  continues to repeat, until the return value is not a fn, then
194.5046 +  returns that non-fn value. Note that if you want to return a fn as a
194.5047 +  final value, you must wrap it in some data structure and unpack it
194.5048 +  after trampoline returns."
194.5049 +  {:added "1.0"}
194.5050 +  ([f]
194.5051 +     (let [ret (f)]
194.5052 +       (if (fn? ret)
194.5053 +         (recur ret)
194.5054 +         ret)))
194.5055 +  ([f & args]
194.5056 +     (trampoline #(apply f args))))
194.5057 +
194.5058 +(defn intern
194.5059 +  "Finds or creates a var named by the symbol name in the namespace
194.5060 +  ns (which can be a symbol or a namespace), setting its root binding
194.5061 +  to val if supplied. The namespace must exist. The var will adopt any
194.5062 +  metadata from the name symbol.  Returns the var."
194.5063 +  {:added "1.0"}
194.5064 +  ([ns ^clojure.lang.Symbol name]
194.5065 +     (let [v (clojure.lang.Var/intern (the-ns ns) name)]
194.5066 +       (when (meta name) (.setMeta v (meta name)))
194.5067 +       v))
194.5068 +  ([ns name val]
194.5069 +     (let [v (clojure.lang.Var/intern (the-ns ns) name val)]
194.5070 +       (when (meta name) (.setMeta v (meta name)))
194.5071 +       v)))
194.5072 +
194.5073 +(defmacro while
194.5074 +  "Repeatedly executes body while test expression is true. Presumes
194.5075 +  some side-effect will cause test to become false/nil. Returns nil"
194.5076 +  {:added "1.0"}
194.5077 +  [test & body]
194.5078 +  `(loop []
194.5079 +     (when ~test
194.5080 +       ~@body
194.5081 +       (recur))))
194.5082 +
194.5083 +(defn memoize
194.5084 +  "Returns a memoized version of a referentially transparent function. The
194.5085 +  memoized version of the function keeps a cache of the mapping from arguments
194.5086 +  to results and, when calls with the same arguments are repeated often, has
194.5087 +  higher performance at the expense of higher memory use."
194.5088 +  {:added "1.0"}
194.5089 +  [f]
194.5090 +  (let [mem (atom {})]
194.5091 +    (fn [& args]
194.5092 +      (if-let [e (find @mem args)]
194.5093 +        (val e)
194.5094 +        (let [ret (apply f args)]
194.5095 +          (swap! mem assoc args ret)
194.5096 +          ret)))))
194.5097 +
194.5098 +(defmacro condp
194.5099 +  "Takes a binary predicate, an expression, and a set of clauses.
194.5100 +  Each clause can take the form of either:
194.5101 +
194.5102 +  test-expr result-expr
194.5103 +
194.5104 +  test-expr :>> result-fn
194.5105 +
194.5106 +  Note :>> is an ordinary keyword.
194.5107 +
194.5108 +  For each clause, (pred test-expr expr) is evaluated. If it returns
194.5109 +  logical true, the clause is a match. If a binary clause matches, the
194.5110 +  result-expr is returned, if a ternary clause matches, its result-fn,
194.5111 +  which must be a unary function, is called with the result of the
194.5112 +  predicate as its argument, the result of that call being the return
194.5113 +  value of condp. A single default expression can follow the clauses,
194.5114 +  and its value will be returned if no clause matches. If no default
194.5115 +  expression is provided and no clause matches, an
194.5116 +  IllegalArgumentException is thrown."
194.5117 +  {:added "1.0"}
194.5118 +
194.5119 +  [pred expr & clauses]
194.5120 +  (let [gpred (gensym "pred__")
194.5121 +        gexpr (gensym "expr__")
194.5122 +        emit (fn emit [pred expr args]
194.5123 +               (let [[[a b c :as clause] more]
194.5124 +                       (split-at (if (= :>> (second args)) 3 2) args)
194.5125 +                       n (count clause)]
194.5126 +                 (cond
194.5127 +                  (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr)))
194.5128 +                  (= 1 n) a
194.5129 +                  (= 2 n) `(if (~pred ~a ~expr)
194.5130 +                             ~b
194.5131 +                             ~(emit pred expr more))
194.5132 +                  :else `(if-let [p# (~pred ~a ~expr)]
194.5133 +                           (~c p#)
194.5134 +                           ~(emit pred expr more)))))
194.5135 +        gres (gensym "res__")]
194.5136 +    `(let [~gpred ~pred
194.5137 +           ~gexpr ~expr]
194.5138 +       ~(emit gpred gexpr clauses))))
194.5139 +
194.5140 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;;
194.5141 +
194.5142 +(alter-meta! #'*agent* assoc :added "1.0")
194.5143 +(alter-meta! #'in-ns assoc :added "1.0")
194.5144 +(alter-meta! #'load-file assoc :added "1.0")
194.5145 +
194.5146 +(defmacro add-doc-and-meta {:private true} [name docstring meta]
194.5147 +  `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring)))
194.5148 +
194.5149 +(add-doc-and-meta *file*
194.5150 +  "The path of the file being evaluated, as a String.
194.5151 +
194.5152 +  Evaluates to nil when there is no file, eg. in the REPL."
194.5153 +  {:added "1.0"})
194.5154 +
194.5155 +(add-doc-and-meta *command-line-args*
194.5156 +  "A sequence of the supplied command line arguments, or nil if
194.5157 +  none were supplied"
194.5158 +  {:added "1.0"})
194.5159 +
194.5160 +(add-doc-and-meta *warn-on-reflection*
194.5161 +  "When set to true, the compiler will emit warnings when reflection is
194.5162 +  needed to resolve Java method calls or field accesses.
194.5163 +
194.5164 +  Defaults to false."
194.5165 +  {:added "1.0"})
194.5166 +
194.5167 +(add-doc-and-meta *compile-path*
194.5168 +  "Specifies the directory where 'compile' will write out .class
194.5169 +  files. This directory must be in the classpath for 'compile' to
194.5170 +  work.
194.5171 +
194.5172 +  Defaults to \"classes\""
194.5173 +  {:added "1.0"})
194.5174 +
194.5175 +(add-doc-and-meta *compile-files*
194.5176 +  "Set to true when compiling files, false otherwise."
194.5177 +  {:added "1.0"})
194.5178 +
194.5179 +(add-doc-and-meta *ns*
194.5180 +  "A clojure.lang.Namespace object representing the current namespace."
194.5181 +  {:added "1.0"})
194.5182 +
194.5183 +(add-doc-and-meta *in*
194.5184 +  "A java.io.Reader object representing standard input for read operations.
194.5185 +
194.5186 +  Defaults to System/in, wrapped in a LineNumberingPushbackReader"
194.5187 +  {:added "1.0"})
194.5188 +
194.5189 +(add-doc-and-meta *out*
194.5190 +  "A java.io.Writer object representing standard output for print operations.
194.5191 +
194.5192 +  Defaults to System/out"
194.5193 +  {:added "1.0"})
194.5194 +
194.5195 +(add-doc-and-meta *err*
194.5196 +  "A java.io.Writer object representing standard error for print operations.
194.5197 +
194.5198 +  Defaults to System/err, wrapped in a PrintWriter"
194.5199 +  {:added "1.0"})
194.5200 +
194.5201 +(add-doc-and-meta *flush-on-newline*
194.5202 +  "When set to true, output will be flushed whenever a newline is printed.
194.5203 +
194.5204 +  Defaults to true."
194.5205 +  {:added "1.0"})
194.5206 +
194.5207 +(add-doc-and-meta *print-meta*
194.5208 +  "If set to logical true, when printing an object, its metadata will also
194.5209 +  be printed in a form that can be read back by the reader.
194.5210 +
194.5211 +  Defaults to false."
194.5212 +  {:added "1.0"})
194.5213 +
194.5214 +(add-doc-and-meta *print-dup*
194.5215 +  "When set to logical true, objects will be printed in a way that preserves
194.5216 +  their type when read in later.
194.5217 +
194.5218 +  Defaults to false."
194.5219 +  {:added "1.0"})
194.5220 +
194.5221 +(add-doc-and-meta *print-readably*
194.5222 +  "When set to logical false, strings and characters will be printed with
194.5223 +  non-alphanumeric characters converted to the appropriate escape sequences.
194.5224 +
194.5225 +  Defaults to true"
194.5226 +  {:added "1.0"})
194.5227 +
194.5228 +(add-doc-and-meta *read-eval*
194.5229 +  "When set to logical false, the EvalReader (#=(...)) is disabled in the 
194.5230 +  read/load in the thread-local binding.
194.5231 +  Example: (binding [*read-eval* false] (read-string \"#=(eval (def x 3))\"))
194.5232 +
194.5233 +  Defaults to true"
194.5234 +  {:added "1.0"})
194.5235 +
194.5236 +(defn future?
194.5237 +  "Returns true if x is a future"
194.5238 +  {:added "1.1"}
194.5239 +  [x] (instance? java.util.concurrent.Future x))
194.5240 +
194.5241 +(defn future-done?
194.5242 +  "Returns true if future f is done"
194.5243 +  {:added "1.1"}
194.5244 +  [^java.util.concurrent.Future f] (.isDone f))
194.5245 +
194.5246 +
194.5247 +(defmacro letfn 
194.5248 +  "Takes a vector of function specs and a body, and generates a set of
194.5249 +  bindings of functions to their names. All of the names are available
194.5250 +  in all of the definitions of the functions, as well as the body.
194.5251 +
194.5252 +  fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)"
194.5253 +  {:added "1.0"}
194.5254 +  [fnspecs & body] 
194.5255 +  `(letfn* ~(vec (interleave (map first fnspecs) 
194.5256 +                             (map #(cons `fn %) fnspecs)))
194.5257 +           ~@body))
194.5258 +
194.5259 +
194.5260 +;;;;;;; case ;;;;;;;;;;;;;
194.5261 +(defn- shift-mask [shift mask x]
194.5262 +  (-> x (bit-shift-right shift) (bit-and mask)))
194.5263 +
194.5264 +(defn- min-hash 
194.5265 +  "takes a collection of keys and returns [shift mask]"
194.5266 +  [keys]
194.5267 +  (let [hashes (map hash keys)
194.5268 +        cnt (count keys)]
194.5269 +    (when-not (apply distinct? hashes)
194.5270 +      (throw (IllegalArgumentException. "Hashes must be distinct")))
194.5271 +    (or (first 
194.5272 +         (filter (fn [[s m]]
194.5273 +                   (apply distinct? (map #(shift-mask s m %) hashes)))
194.5274 +                 (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 14))
194.5275 +                       shift (range 0 31)]
194.5276 +                   [shift mask])))
194.5277 +        (throw (IllegalArgumentException. "No distinct mapping found")))))
194.5278 +
194.5279 +(defmacro case 
194.5280 +  "Takes an expression, and a set of clauses.
194.5281 +
194.5282 +  Each clause can take the form of either:
194.5283 +
194.5284 +  test-constant result-expr
194.5285 +
194.5286 +  (test-constant1 ... test-constantN)  result-expr
194.5287 +
194.5288 +  The test-constants are not evaluated. They must be compile-time
194.5289 +  literals, and need not be quoted.  If the expression is equal to a
194.5290 +  test-constant, the corresponding result-expr is returned. A single
194.5291 +  default expression can follow the clauses, and its value will be
194.5292 +  returned if no clause matches. If no default expression is provided
194.5293 +  and no clause matches, an IllegalArgumentException is thrown.
194.5294 +
194.5295 +  Unlike cond and condp, case does a constant-time dispatch, the
194.5296 +  clauses are not considered sequentially.  All manner of constant
194.5297 +  expressions are acceptable in case, including numbers, strings,
194.5298 +  symbols, keywords, and (Clojure) composites thereof. Note that since
194.5299 +  lists are used to group multiple constants that map to the same
194.5300 +  expression, a vector can be used to match a list if needed. The
194.5301 +  test-constants need not be all of the same type."
194.5302 +  {:added "1.2"}
194.5303 +
194.5304 +  [e & clauses]
194.5305 +  (let [ge (with-meta (gensym) {:tag Object})
194.5306 +        default (if (odd? (count clauses)) 
194.5307 +                  (last clauses)
194.5308 +                  `(throw (IllegalArgumentException. (str "No matching clause: " ~ge))))
194.5309 +        cases (partition 2 clauses)
194.5310 +        case-map (reduce (fn [m [test expr]]
194.5311 +                           (if (seq? test)
194.5312 +                             (into m (zipmap test (repeat expr)))
194.5313 +                             (assoc m test expr))) 
194.5314 +                           {} cases)
194.5315 +        [shift mask] (if (seq case-map) (min-hash (keys case-map)) [0 0])
194.5316 +        
194.5317 +        hmap (reduce (fn [m [test expr :as te]]
194.5318 +                       (assoc m (shift-mask shift mask (hash test)) te))
194.5319 +                     (sorted-map) case-map)]
194.5320 +    `(let [~ge ~e]
194.5321 +       ~(condp = (count clauses)
194.5322 +          0 default
194.5323 +          1 default
194.5324 +          `(case* ~ge ~shift ~mask ~(key (first hmap)) ~(key (last hmap)) ~default ~hmap 
194.5325 +                        ~(every? keyword? (keys case-map)))))))
194.5326 +
194.5327 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
194.5328 +(alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")
194.5329 +(load "core_proxy")
194.5330 +(load "core_print")
194.5331 +(load "genclass")
194.5332 +(load "core_deftype")
194.5333 +(load "core/protocols")
194.5334 +(load "gvec")
194.5335 +
194.5336 +;; redefine reduce with internal-reduce
194.5337 +#_(defn reduce
194.5338 +  "f should be a function of 2 arguments. If val is not supplied,
194.5339 +  returns the result of applying f to the first 2 items in coll, then
194.5340 +  applying f to that result and the 3rd item, etc. If coll contains no
194.5341 +  items, f must accept no arguments as well, and reduce returns the
194.5342 +  result of calling f with no arguments.  If coll has only 1 item, it
194.5343 +  is returned and f is not called.  If val is supplied, returns the
194.5344 +  result of applying f to val and the first item in coll, then
194.5345 +  applying f to that result and the 2nd item, etc. If coll contains no
194.5346 +  items, returns val and f is not called."
194.5347 +  {:added "1.0"}
194.5348 +  ([f coll]
194.5349 +     (if-let [s (seq coll)]
194.5350 +       (reduce f (first s) (next s))
194.5351 +       (f)))
194.5352 +  ([f val coll]
194.5353 +     (let [s (seq coll)]
194.5354 +       (clojure.core.protocols/internal-reduce s f val))))
194.5355 +
194.5356 +(require '[clojure.java.io :as jio])
194.5357 +
194.5358 +(defn- normalize-slurp-opts
194.5359 +  [opts]
194.5360 +  (if (string? (first opts))
194.5361 +    (do
194.5362 +      (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).")
194.5363 +      [:encoding (first opts)])
194.5364 +    opts))
194.5365 +
194.5366 +(defn slurp
194.5367 +  "Reads the file named by f using the encoding enc into a string
194.5368 +  and returns it."
194.5369 +  {:added "1.0"}
194.5370 +  ([f & opts]
194.5371 +     (let [opts (normalize-slurp-opts opts)
194.5372 +           sb (StringBuilder.)]
194.5373 +       (with-open [#^java.io.Reader r (apply jio/reader f opts)]
194.5374 +         (loop [c (.read r)]
194.5375 +           (if (neg? c)
194.5376 +             (str sb)
194.5377 +             (do
194.5378 +               (.append sb (char c))
194.5379 +               (recur (.read r)))))))))
194.5380 +
194.5381 +(defn spit
194.5382 +  "Opposite of slurp.  Opens f with writer, writes content, then
194.5383 +  closes f. Options passed to clojure.java.io/writer."
194.5384 +  {:added "1.2"}
194.5385 +  [f content & options]
194.5386 +  (with-open [#^java.io.Writer w (apply jio/writer f options)]
194.5387 +    (.write w (str content))))
194.5388 +
194.5389 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;
194.5390 +(defn future-call 
194.5391 +  "Takes a function of no args and yields a future object that will
194.5392 +  invoke the function in another thread, and will cache the result and
194.5393 +  return it on all subsequent calls to deref/@. If the computation has
194.5394 +  not yet finished, calls to deref/@ will block."
194.5395 +  {:added "1.1"}
194.5396 +  [^Callable f]
194.5397 +  (let [fut (.submit clojure.lang.Agent/soloExecutor f)]
194.5398 +    (reify 
194.5399 +     clojure.lang.IDeref 
194.5400 +      (deref [_] (.get fut))
194.5401 +     java.util.concurrent.Future
194.5402 +      (get [_] (.get fut))
194.5403 +      (get [_ timeout unit] (.get fut timeout unit))
194.5404 +      (isCancelled [_] (.isCancelled fut))
194.5405 +      (isDone [_] (.isDone fut))
194.5406 +      (cancel [_ interrupt?] (.cancel fut interrupt?)))))
194.5407 +  
194.5408 +(defmacro future
194.5409 +  "Takes a body of expressions and yields a future object that will
194.5410 +  invoke the body in another thread, and will cache the result and
194.5411 +  return it on all subsequent calls to deref/@. If the computation has
194.5412 +  not yet finished, calls to deref/@ will block."
194.5413 +  {:added "1.1"}
194.5414 +  [& body] `(future-call (^{:once true} fn* [] ~@body)))
194.5415 +
194.5416 +
194.5417 +(defn future-cancel
194.5418 +  "Cancels the future, if possible."
194.5419 +  {:added "1.1"}
194.5420 +  [^java.util.concurrent.Future f] (.cancel f true))
194.5421 +
194.5422 +(defn future-cancelled?
194.5423 +  "Returns true if future f is cancelled"
194.5424 +  {:added "1.1"}
194.5425 +  [^java.util.concurrent.Future f] (.isCancelled f))
194.5426 +
194.5427 +(defn pmap
194.5428 +  "Like map, except f is applied in parallel. Semi-lazy in that the
194.5429 +  parallel computation stays ahead of the consumption, but doesn't
194.5430 +  realize the entire result unless required. Only useful for
194.5431 +  computationally intensive functions where the time of f dominates
194.5432 +  the coordination overhead."
194.5433 +  {:added "1.0"}
194.5434 +  ([f coll]
194.5435 +   (let [n (+ 2 (.. Runtime getRuntime availableProcessors))
194.5436 +         rets (map #(future (f %)) coll)
194.5437 +         step (fn step [[x & xs :as vs] fs]
194.5438 +                (lazy-seq
194.5439 +                 (if-let [s (seq fs)]
194.5440 +                   (cons (deref x) (step xs (rest s)))
194.5441 +                   (map deref vs))))]
194.5442 +     (step rets (drop n rets))))
194.5443 +  ([f coll & colls]
194.5444 +   (let [step (fn step [cs]
194.5445 +                (lazy-seq
194.5446 +                 (let [ss (map seq cs)]
194.5447 +                   (when (every? identity ss)
194.5448 +                     (cons (map first ss) (step (map rest ss)))))))]
194.5449 +     (pmap #(apply f %) (step (cons coll colls))))))
194.5450 +
194.5451 +(defn pcalls
194.5452 +  "Executes the no-arg fns in parallel, returning a lazy sequence of
194.5453 +  their values"
194.5454 +  {:added "1.0"}
194.5455 +  [& fns] (pmap #(%) fns))
194.5456 +
194.5457 +(defmacro pvalues
194.5458 +  "Returns a lazy sequence of the values of the exprs, which are
194.5459 +  evaluated in parallel"
194.5460 +  {:added "1.0"}
194.5461 +  [& exprs]
194.5462 +  `(pcalls ~@(map #(list `fn [] %) exprs)))
194.5463 +
194.5464 +
194.5465 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;;
194.5466 +
194.5467 +(let [version-stream (.getResourceAsStream (clojure.lang.RT/baseLoader) 
194.5468 +                                           "clojure/version.properties")
194.5469 +      properties     (doto (new java.util.Properties) (.load version-stream))
194.5470 +      prop (fn [k] (.getProperty properties (str "clojure.version." k)))
194.5471 +      clojure-version {:major       (Integer/valueOf ^String (prop "major"))
194.5472 +                       :minor       (Integer/valueOf ^String (prop "minor"))
194.5473 +                       :incremental (Integer/valueOf ^String (prop "incremental"))
194.5474 +                       :qualifier   (prop "qualifier")}]
194.5475 +  (def *clojure-version* 
194.5476 +    (if (not (= (prop "interim") "false"))
194.5477 +      (clojure.lang.RT/assoc clojure-version :interim true)
194.5478 +      clojure-version)))
194.5479 +      
194.5480 +(add-doc-and-meta *clojure-version*
194.5481 +  "The version info for Clojure core, as a map containing :major :minor 
194.5482 +  :incremental and :qualifier keys. Feature releases may increment 
194.5483 +  :minor and/or :major, bugfix releases will increment :incremental. 
194.5484 +  Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\""
194.5485 +  {:added "1.0"})
194.5486 +      
194.5487 +(defn
194.5488 +  clojure-version 
194.5489 +  "Returns clojure version as a printable string."
194.5490 +  {:added "1.0"}
194.5491 +  []
194.5492 +  (str (:major *clojure-version*)
194.5493 +       "."
194.5494 +       (:minor *clojure-version*)
194.5495 +       (when-let [i (:incremental *clojure-version*)]
194.5496 +         (str "." i))
194.5497 +       (when-let [q (:qualifier *clojure-version*)]
194.5498 +         (when (pos? (count q)) (str "-" q)))
194.5499 +       (when (:interim *clojure-version*)
194.5500 +         "-SNAPSHOT")))
194.5501 +
194.5502 +(defn promise
194.5503 +  "Alpha - subject to change.
194.5504 +  Returns a promise object that can be read with deref/@, and set,
194.5505 +  once only, with deliver. Calls to deref/@ prior to delivery will
194.5506 +  block. All subsequent derefs will return the same delivered value
194.5507 +  without blocking."
194.5508 +  {:added "1.1"}
194.5509 +  []
194.5510 +  (let [d (java.util.concurrent.CountDownLatch. 1)
194.5511 +        v (atom nil)]
194.5512 +    (reify 
194.5513 +     clojure.lang.IDeref
194.5514 +      (deref [_] (.await d) @v)
194.5515 +     clojure.lang.IFn
194.5516 +      (invoke [this x]
194.5517 +        (locking d
194.5518 +          (if (pos? (.getCount d))
194.5519 +            (do (reset! v x)
194.5520 +                (.countDown d)
194.5521 +                this)
194.5522 +            (throw (IllegalStateException. "Multiple deliver calls to a promise"))))))))
194.5523 +
194.5524 +(defn deliver
194.5525 +  "Alpha - subject to change.
194.5526 +  Delivers the supplied value to the promise, releasing any pending
194.5527 +  derefs. A subsequent call to deliver on a promise will throw an exception."
194.5528 +  {:added "1.1"}
194.5529 +  [promise val] (promise val))
194.5530 +
194.5531 +
194.5532 +
194.5533 +(defn flatten
194.5534 +  "Takes any nested combination of sequential things (lists, vectors,
194.5535 +  etc.) and returns their contents as a single, flat sequence.
194.5536 +  (flatten nil) returns nil."
194.5537 +  {:added "1.2"}
194.5538 +  [x]
194.5539 +  (filter (complement sequential?)
194.5540 +          (rest (tree-seq sequential? seq x))))
194.5541 +
194.5542 +(defn group-by 
194.5543 +  "Returns a map of the elements of coll keyed by the result of
194.5544 +  f on each element. The value at each key will be a vector of the
194.5545 +  corresponding elements, in the order they appeared in coll."
194.5546 +  {:added "1.2"}
194.5547 +  [f coll]  
194.5548 +  (persistent!
194.5549 +   (reduce
194.5550 +    (fn [ret x]
194.5551 +      (let [k (f x)]
194.5552 +        (assoc! ret k (conj (get ret k []) x))))
194.5553 +    (transient {}) coll)))
194.5554 +
194.5555 +(defn partition-by 
194.5556 +  "Applies f to each value in coll, splitting it each time f returns
194.5557 +   a new value.  Returns a lazy seq of partitions."
194.5558 +  {:added "1.2"}
194.5559 +  [f coll]
194.5560 +  (lazy-seq
194.5561 +   (when-let [s (seq coll)]
194.5562 +     (let [fst (first s)
194.5563 +           fv (f fst)
194.5564 +           run (cons fst (take-while #(= fv (f %)) (rest s)))]
194.5565 +       (cons run (partition-by f (drop (count run) s)))))))
194.5566 +
194.5567 +(defn frequencies
194.5568 +  "Returns a map from distinct items in coll to the number of times
194.5569 +  they appear."
194.5570 +  {:added "1.2"}
194.5571 +  [coll]
194.5572 +  (persistent!
194.5573 +   (reduce (fn [counts x]
194.5574 +             (assoc! counts x (inc (get counts x 0))))
194.5575 +           (transient {}) coll)))
194.5576 +
194.5577 +(defn reductions
194.5578 +  "Returns a lazy seq of the intermediate values of the reduction (as
194.5579 +  per reduce) of coll by f, starting with init."
194.5580 +  {:added "1.2"}
194.5581 +  ([f coll]
194.5582 +     (lazy-seq
194.5583 +      (if-let [s (seq coll)]
194.5584 +        (reductions f (first s) (rest s))
194.5585 +        (list (f)))))
194.5586 +  ([f init coll]
194.5587 +     (cons init
194.5588 +           (lazy-seq
194.5589 +            (when-let [s (seq coll)]
194.5590 +              (reductions f (f init (first s)) (rest s)))))))
194.5591 +
194.5592 +(defn rand-nth
194.5593 +  "Return a random element of the (sequential) collection. Will have
194.5594 +  the same performance characteristics as nth for the given
194.5595 +  collection."
194.5596 +  {:added "1.2"}
194.5597 +  [coll]
194.5598 +  (nth coll (rand-int (count coll))))
194.5599 +
194.5600 +(defn partition-all
194.5601 +  "Returns a lazy sequence of lists like partition, but may include
194.5602 +  partitions with fewer than n items at the end."
194.5603 +  {:added "1.2"}
194.5604 +  ([n coll]
194.5605 +     (partition-all n n coll))
194.5606 +  ([n step coll]
194.5607 +     (lazy-seq
194.5608 +      (when-let [s (seq coll)]
194.5609 +        (cons (take n s) (partition-all n step (drop step s)))))))
194.5610 +
194.5611 +(defn shuffle
194.5612 +  "Return a random permutation of coll"
194.5613 +  {:added "1.2"}
194.5614 +  [coll]
194.5615 +  (let [al (java.util.ArrayList. coll)]
194.5616 +    (java.util.Collections/shuffle al)
194.5617 +    (clojure.lang.RT/vector (.toArray al))))
194.5618 +
194.5619 +(defn map-indexed
194.5620 +  "Returns a lazy sequence consisting of the result of applying f to 0
194.5621 +  and the first item of coll, followed by applying f to 1 and the second
194.5622 +  item in coll, etc, until coll is exhausted. Thus function f should
194.5623 +  accept 2 arguments, index and item."
194.5624 +  {:added "1.2"}
194.5625 +  [f coll]
194.5626 +  (letfn [(mapi [idx coll]
194.5627 +            (lazy-seq
194.5628 +             (when-let [s (seq coll)]
194.5629 +               (if (chunked-seq? s)
194.5630 +                 (let [c (chunk-first s)
194.5631 +                       size (int (count c))
194.5632 +                       b (chunk-buffer size)]
194.5633 +                   (dotimes [i size]
194.5634 +                     (chunk-append b (f (+ idx i) (.nth c i))))
194.5635 +                   (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s))))
194.5636 +                 (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))]
194.5637 +    (mapi 0 coll)))
194.5638 +
194.5639 +(defn keep
194.5640 +  "Returns a lazy sequence of the non-nil results of (f item). Note,
194.5641 +  this means false return values will be included.  f must be free of
194.5642 +  side-effects."
194.5643 +  {:added "1.2"}
194.5644 +  ([f coll]
194.5645 +   (lazy-seq
194.5646 +    (when-let [s (seq coll)]
194.5647 +      (if (chunked-seq? s)
194.5648 +        (let [c (chunk-first s)
194.5649 +              size (count c)
194.5650 +              b (chunk-buffer size)]
194.5651 +          (dotimes [i size]
194.5652 +            (let [x (f (.nth c i))]
194.5653 +              (when-not (nil? x)
194.5654 +                (chunk-append b x))))
194.5655 +          (chunk-cons (chunk b) (keep f (chunk-rest s))))
194.5656 +        (let [x (f (first s))]
194.5657 +          (if (nil? x)
194.5658 +            (keep f (rest s))
194.5659 +            (cons x (keep f (rest s))))))))))
194.5660 +
194.5661 +(defn keep-indexed
194.5662 +  "Returns a lazy sequence of the non-nil results of (f index item). Note,
194.5663 +  this means false return values will be included.  f must be free of
194.5664 +  side-effects."
194.5665 +  {:added "1.2"}
194.5666 +  ([f coll]
194.5667 +     (letfn [(keepi [idx coll]
194.5668 +               (lazy-seq
194.5669 +                (when-let [s (seq coll)]
194.5670 +                  (if (chunked-seq? s)
194.5671 +                    (let [c (chunk-first s)
194.5672 +                          size (count c)
194.5673 +                          b (chunk-buffer size)]
194.5674 +                      (dotimes [i size]
194.5675 +                        (let [x (f (+ idx i) (.nth c i))]
194.5676 +                          (when-not (nil? x)
194.5677 +                            (chunk-append b x))))
194.5678 +                      (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s))))
194.5679 +                    (let [x (f idx (first s))]
194.5680 +                      (if (nil? x)
194.5681 +                        (keepi (inc idx) (rest s))
194.5682 +                        (cons x (keepi (inc idx) (rest s)))))))))]
194.5683 +       (keepi 0 coll))))
194.5684 +
194.5685 +(defn fnil
194.5686 +  "Takes a function f, and returns a function that calls f, replacing
194.5687 +  a nil first argument to f with the supplied value x. Higher arity
194.5688 +  versions can replace arguments in the second and third
194.5689 +  positions (y, z). Note that the function f can take any number of
194.5690 +  arguments, not just the one(s) being nil-patched."
194.5691 +  {:added "1.2"}
194.5692 +  ([f x]
194.5693 +   (fn
194.5694 +     ([a] (f (if (nil? a) x a)))
194.5695 +     ([a b] (f (if (nil? a) x a) b))
194.5696 +     ([a b c] (f (if (nil? a) x a) b c))
194.5697 +     ([a b c & ds] (apply f (if (nil? a) x a) b c ds))))
194.5698 +  ([f x y]
194.5699 +   (fn
194.5700 +     ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
194.5701 +     ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c))
194.5702 +     ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds))))
194.5703 +  ([f x y z]
194.5704 +   (fn
194.5705 +     ([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
194.5706 +     ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c)))
194.5707 +     ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds)))))
194.5708 +
194.5709 +(defn- ^{:dynamic true} assert-valid-fdecl
194.5710 +  "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn."
194.5711 +  [fdecl]
194.5712 +  (if-let [bad-args (seq (remove #(vector? %) (map first fdecl)))]
194.5713 +    (throw (IllegalArgumentException. (str "Parameter declaration " (first bad-args) " should be a vector")))))
   195.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   195.2 +++ b/src/clojure/core/protocols.clj	Sat Aug 21 06:25:44 2010 -0400
   195.3 @@ -0,0 +1,94 @@
   195.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   195.5 +;   The use and distribution terms for this software are covered by the
   195.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   195.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   195.8 +;   By using this software in any fashion, you are agreeing to be bound by
   195.9 +;   the terms of this license.
  195.10 +;   You must not remove this notice, or any other, from this software.
  195.11 +
  195.12 +(ns clojure.core.protocols)
  195.13 +
  195.14 +(defprotocol InternalReduce
  195.15 +  "Protocol for concrete seq types that can reduce themselves
  195.16 +   faster than first/next recursion. Called by clojure.core/reduce."
  195.17 +  (internal-reduce [seq f start]))
  195.18 +
  195.19 +(extend-protocol InternalReduce
  195.20 +  nil
  195.21 +  (internal-reduce
  195.22 +   [s f val]
  195.23 +   val)
  195.24 +  
  195.25 +  ;; handles vectors and ranges
  195.26 +  clojure.lang.IChunkedSeq
  195.27 +  (internal-reduce
  195.28 +   [s f val]
  195.29 +   (if-let [s (seq s)]
  195.30 +     (if (chunked-seq? s)
  195.31 +       (recur (chunk-next s)
  195.32 +              f
  195.33 +              (.reduce (chunk-first s) f val))
  195.34 +       (internal-reduce s f val))
  195.35 +     val))
  195.36 + 
  195.37 +  clojure.lang.StringSeq
  195.38 +  (internal-reduce
  195.39 +   [str-seq f val]
  195.40 +   (let [s (.s str-seq)]
  195.41 +     (loop [i (.i str-seq)
  195.42 +            val val]
  195.43 +       (if (< i (.length s))
  195.44 +         (recur (inc i) (f val (.charAt s i)))
  195.45 +         val))))
  195.46 +  
  195.47 +  clojure.lang.ArraySeq
  195.48 +  (internal-reduce
  195.49 +       [a-seq f val]
  195.50 +       (let [^objects arr (.array a-seq)]
  195.51 +         (loop [i (.index a-seq)
  195.52 +                val val]
  195.53 +           (if (< i (alength arr))
  195.54 +             (recur (inc i) (f val (aget arr i)))
  195.55 +             val))))
  195.56 +  
  195.57 +  java.lang.Object
  195.58 +  (internal-reduce
  195.59 +   [s f val]
  195.60 +   (loop [cls (class s)
  195.61 +          s s
  195.62 +          f f
  195.63 +          val val]
  195.64 +     (if-let [s (seq s)]
  195.65 +       ;; roll over to faster implementation if underlying seq changes type
  195.66 +       (if (identical? (class s) cls)
  195.67 +         (recur cls (next s) f (f val (first s)))
  195.68 +         (internal-reduce s f val))
  195.69 +       val))))
  195.70 +
  195.71 +(def arr-impl
  195.72 +  '(internal-reduce
  195.73 +       [a-seq f val]
  195.74 +       (let [arr (.array a-seq)]
  195.75 +         (loop [i (.index a-seq)
  195.76 +                val val]
  195.77 +           (if (< i (alength arr))
  195.78 +             (recur (inc i) (f val (aget arr i)))
  195.79 +             val)))))
  195.80 +
  195.81 +(defn- emit-array-impls*
  195.82 +  [syms]
  195.83 +  (apply
  195.84 +   concat
  195.85 +   (map
  195.86 +    (fn [s]
  195.87 +      [(symbol (str "clojure.lang.ArraySeq$ArraySeq_" s))
  195.88 +       arr-impl])
  195.89 +    syms)))
  195.90 +
  195.91 +(defmacro emit-array-impls
  195.92 +  [& syms]
  195.93 +  `(extend-protocol InternalReduce
  195.94 +     ~@(emit-array-impls* syms)))
  195.95 +
  195.96 +(emit-array-impls int long float double byte char boolean)
  195.97 +
   196.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   196.2 +++ b/src/clojure/core_deftype.clj	Sat Aug 21 06:25:44 2010 -0400
   196.3 @@ -0,0 +1,769 @@
   196.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   196.5 +;   The use and distribution terms for this software are covered by the
   196.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   196.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   196.8 +;   By using this software in any fashion, you are agreeing to be bound by
   196.9 +;   the terms of this license.
  196.10 +;   You must not remove this notice, or any other, from this software.
  196.11 +
  196.12 +(in-ns 'clojure.core)
  196.13 +
  196.14 +;;;;;;;;;;;;;;;;;;;;;;;;;;;; definterface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196.15 +
  196.16 +(defn namespace-munge
  196.17 +  "Convert a Clojure namespace name to a legal Java package name."
  196.18 +  {:added "1.2"}
  196.19 +  [ns]
  196.20 +  (.replace (str ns) \- \_))
  196.21 +
  196.22 +;for now, built on gen-interface
  196.23 +(defmacro definterface 
  196.24 +  [name & sigs]
  196.25 +  (let [tag (fn [x] (or (:tag (meta x)) Object))
  196.26 +        psig (fn [[name [& args]]]
  196.27 +               (vector name (vec (map tag args)) (tag name) (map meta args)))
  196.28 +        cname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))]
  196.29 +    `(let [] 
  196.30 +       (gen-interface :name ~cname :methods ~(vec (map psig sigs)))
  196.31 +       (import ~cname))))
  196.32 +
  196.33 +;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196.34 +
  196.35 +(defn- parse-opts [s]
  196.36 +  (loop [opts {} [k v & rs :as s] s]
  196.37 +    (if (keyword? k)
  196.38 +      (recur (assoc opts k v) rs)
  196.39 +      [opts s])))
  196.40 +
  196.41 +(defn- parse-impls [specs]
  196.42 +  (loop [ret {} s specs]
  196.43 +    (if (seq s)
  196.44 +      (recur (assoc ret (first s) (take-while seq? (next s)))
  196.45 +             (drop-while seq? (next s)))
  196.46 +      ret)))
  196.47 +
  196.48 +(defn- parse-opts+specs [opts+specs]
  196.49 +  (let [[opts specs] (parse-opts opts+specs)
  196.50 +        impls (parse-impls specs)
  196.51 +        interfaces (-> (map #(if (var? (resolve %)) 
  196.52 +                               (:on (deref (resolve %)))
  196.53 +                               %)
  196.54 +                            (keys impls))
  196.55 +                       set
  196.56 +                       (disj 'Object 'java.lang.Object)
  196.57 +                       vec)
  196.58 +        methods (map (fn [[name params & body]]
  196.59 +                       (cons name (maybe-destructured params body)))
  196.60 +                     (apply concat (vals impls)))]
  196.61 +    (when-let [bad-opts (seq (remove #{:no-print} (keys opts)))]
  196.62 +      (throw (IllegalArgumentException. (apply print-str "Unsupported option(s) -" bad-opts))))
  196.63 +    [interfaces methods opts]))
  196.64 +
  196.65 +(defmacro reify 
  196.66 +  "reify is a macro with the following structure:
  196.67 +
  196.68 + (reify options* specs*)
  196.69 +  
  196.70 +  Currently there are no options.
  196.71 +
  196.72 +  Each spec consists of the protocol or interface name followed by zero
  196.73 +  or more method bodies:
  196.74 +
  196.75 +  protocol-or-interface-or-Object
  196.76 +  (methodName [args+] body)*
  196.77 +
  196.78 +  Methods should be supplied for all methods of the desired
  196.79 +  protocol(s) and interface(s). You can also define overrides for
  196.80 +  methods of Object. Note that the first parameter must be supplied to
  196.81 +  correspond to the target object ('this' in Java parlance). Thus
  196.82 +  methods for interfaces will take one more argument than do the
  196.83 +  interface declarations.  Note also that recur calls to the method
  196.84 +  head should *not* pass the target object, it will be supplied
  196.85 +  automatically and can not be substituted.
  196.86 +
  196.87 +  The return type can be indicated by a type hint on the method name,
  196.88 +  and arg types can be indicated by a type hint on arg names. If you
  196.89 +  leave out all hints, reify will try to match on same name/arity
  196.90 +  method in the protocol(s)/interface(s) - this is preferred. If you
  196.91 +  supply any hints at all, no inference is done, so all hints (or
  196.92 +  default of Object) must be correct, for both arguments and return
  196.93 +  type. If a method is overloaded in a protocol/interface, multiple
  196.94 +  independent method definitions must be supplied.  If overloaded with
  196.95 +  same arity in an interface you must specify complete hints to
  196.96 +  disambiguate - a missing hint implies Object.
  196.97 +
  196.98 +  recur works to method heads The method bodies of reify are lexical
  196.99 +  closures, and can refer to the surrounding local scope:
 196.100 +  
 196.101 +  (str (let [f \"foo\"] 
 196.102 +       (reify Object 
 196.103 +         (toString [this] f))))
 196.104 +  == \"foo\"
 196.105 +
 196.106 +  (seq (let [f \"foo\"] 
 196.107 +       (reify clojure.lang.Seqable 
 196.108 +         (seq [this] (seq f)))))
 196.109 +  == (\\f \\o \\o))"
 196.110 +  {:added "1.2"} 
 196.111 +  [& opts+specs]
 196.112 +  (let [[interfaces methods] (parse-opts+specs opts+specs)]
 196.113 +    (with-meta `(reify* ~interfaces ~@methods) (meta &form))))
 196.114 +
 196.115 +(defn hash-combine [x y] 
 196.116 +  (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y)))
 196.117 +
 196.118 +(defn munge [s]
 196.119 +  ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s))))
 196.120 +
 196.121 +(defn- imap-cons
 196.122 +  [^IPersistentMap this o]
 196.123 +  (cond
 196.124 +   (instance? java.util.Map$Entry o)
 196.125 +     (let [^java.util.Map$Entry pair o]
 196.126 +       (.assoc this (.getKey pair) (.getValue pair)))
 196.127 +   (instance? clojure.lang.IPersistentVector o)
 196.128 +     (let [^clojure.lang.IPersistentVector vec o]
 196.129 +       (.assoc this (.nth vec 0) (.nth vec 1)))
 196.130 +   :else (loop [this this
 196.131 +                o o]
 196.132 +      (if (seq o)
 196.133 +        (let [^java.util.Map$Entry pair (first o)]
 196.134 +          (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o)))
 196.135 +        this))))
 196.136 +
 196.137 +(defn- emit-defrecord 
 196.138 +  "Do not use this directly - use defrecord"
 196.139 +  {:added "1.2"}
 196.140 +  [tagname name fields interfaces methods]
 196.141 +  (let [tag (keyword (str *ns*) (str tagname))
 196.142 +        classname (with-meta (symbol (str *ns* "." name)) (meta name))
 196.143 +        interfaces (vec interfaces)
 196.144 +        interface-set (set (map resolve interfaces))
 196.145 +        methodname-set (set (map first methods))
 196.146 +        hinted-fields fields
 196.147 +        fields (vec (map #(with-meta % nil) fields))
 196.148 +        base-fields fields
 196.149 +        fields (conj fields '__meta '__extmap)]
 196.150 +    (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields))
 196.151 +      (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields")))
 196.152 +    (let [gs (gensym)]
 196.153 +    (letfn 
 196.154 +     [(eqhash [[i m]] 
 196.155 +        [i
 196.156 +         (conj m 
 196.157 +               `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#))
 196.158 +               `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))])
 196.159 +      (iobj [[i m]] 
 196.160 +            [(conj i 'clojure.lang.IObj)
 196.161 +             (conj m `(meta [this#] ~'__meta)
 196.162 +                   `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))])
 196.163 +      (ilookup [[i m]] 
 196.164 +         [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup)
 196.165 +          (conj m `(valAt [this# k#] (.valAt this# k# nil))
 196.166 +                `(valAt [this# k# else#] 
 196.167 +                   (case k# ~@(mapcat (fn [fld] [(keyword fld) fld]) 
 196.168 +                                       base-fields)
 196.169 +                         (get ~'__extmap k# else#)))
 196.170 +                `(getLookupThunk [this# k#]
 196.171 +                   (let [~'gclass (class this#)]              
 196.172 +                     (case k#
 196.173 +                           ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})] 
 196.174 +                               (mapcat 
 196.175 +                                (fn [fld]
 196.176 +                                  [(keyword fld) 
 196.177 +                                   `(reify clojure.lang.ILookupThunk 
 196.178 +                                           (get [~'thunk ~'gtarget] 
 196.179 +                                                (if (identical? (class ~'gtarget) ~'gclass) 
 196.180 +                                                  (. ~hinted-target ~(keyword fld))
 196.181 +                                                  ~'thunk)))])
 196.182 +                                base-fields))
 196.183 +                           nil))))])
 196.184 +      (imap [[i m]] 
 196.185 +            [(conj i 'clojure.lang.IPersistentMap)
 196.186 +             (conj m 
 196.187 +                   `(count [this#] (+ ~(count base-fields) (count ~'__extmap)))
 196.188 +                   `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
 196.189 +                   `(cons [this# e#] ((var imap-cons) this# e#))
 196.190 +                   `(equiv [this# ~gs] 
 196.191 +                        (boolean 
 196.192 +                         (or (identical? this# ~gs)
 196.193 +                             (when (identical? (class this#) (class ~gs))
 196.194 +                               (let [~gs ~(with-meta gs {:tag tagname})]
 196.195 +                                 (and  ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields)
 196.196 +                                       (= ~'__extmap (. ~gs ~'__extmap))))))))
 196.197 +                   `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#))))
 196.198 +                   `(entryAt [this# k#] (let [v# (.valAt this# k# this#)]
 196.199 +                                            (when-not (identical? this# v#)
 196.200 +                                              (clojure.lang.MapEntry. k# v#))))
 196.201 +                   `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)] 
 196.202 +                                              ~'__extmap)))
 196.203 +                   `(assoc [this# k# ~gs]
 196.204 +                     (condp identical? k#
 196.205 +                       ~@(mapcat (fn [fld]
 196.206 +                                   [(keyword fld) (list* `new tagname (replace {fld gs} fields))])
 196.207 +                                 base-fields)
 196.208 +                       (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs))))
 196.209 +                   `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
 196.210 +                                            (dissoc (with-meta (into {} this#) ~'__meta) k#)
 196.211 +                                            (new ~tagname ~@(remove #{'__extmap} fields) 
 196.212 +                                                 (not-empty (dissoc ~'__extmap k#))))))])
 196.213 +      (ijavamap [[i m]]
 196.214 +                [(conj i 'java.util.Map 'java.io.Serializable)
 196.215 +                 (conj m
 196.216 +                       `(size [this#] (.count this#))
 196.217 +                       `(isEmpty [this#] (= 0 (.count this#)))
 196.218 +                       `(containsValue [this# v#] (boolean (some #{v#} (vals this#))))
 196.219 +                       `(get [this# k#] (.valAt this# k#))
 196.220 +                       `(put [this# k# v#] (throw (UnsupportedOperationException.)))
 196.221 +                       `(remove [this# k#] (throw (UnsupportedOperationException.)))
 196.222 +                       `(putAll [this# m#] (throw (UnsupportedOperationException.)))
 196.223 +                       `(clear [this#] (throw (UnsupportedOperationException.)))
 196.224 +                       `(keySet [this#] (set (keys this#)))
 196.225 +                       `(values [this#] (vals this#))
 196.226 +                       `(entrySet [this#] (set this#)))])
 196.227 +      ]
 196.228 +     (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap ijavamap)]
 196.229 +       `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap) 
 196.230 +          :implements ~(vec i) 
 196.231 +          ~@m))))))
 196.232 +
 196.233 +(defmacro defrecord
 196.234 +  "Alpha - subject to change
 196.235 +  
 196.236 +  (defrecord name [fields*]  options* specs*)
 196.237 +  
 196.238 +  Currently there are no options.
 196.239 +
 196.240 +  Each spec consists of a protocol or interface name followed by zero
 196.241 +  or more method bodies:
 196.242 +
 196.243 +  protocol-or-interface-or-Object
 196.244 +  (methodName [args*] body)*
 196.245 +
 196.246 +  Dynamically generates compiled bytecode for class with the given
 196.247 +  name, in a package with the same name as the current namespace, the
 196.248 +  given fields, and, optionally, methods for protocols and/or
 196.249 +  interfaces.
 196.250 +
 196.251 +  The class will have the (immutable) fields named by
 196.252 +  fields, which can have type hints. Protocols/interfaces and methods
 196.253 +  are optional. The only methods that can be supplied are those
 196.254 +  declared in the protocols/interfaces.  Note that method bodies are
 196.255 +  not closures, the local environment includes only the named fields,
 196.256 +  and those fields can be accessed directy.
 196.257 +
 196.258 +  Method definitions take the form:
 196.259 +
 196.260 +  (methodname [args*] body)
 196.261 +
 196.262 +  The argument and return types can be hinted on the arg and
 196.263 +  methodname symbols. If not supplied, they will be inferred, so type
 196.264 +  hints should be reserved for disambiguation.
 196.265 +
 196.266 +  Methods should be supplied for all methods of the desired
 196.267 +  protocol(s) and interface(s). You can also define overrides for
 196.268 +  methods of Object. Note that a parameter must be supplied to
 196.269 +  correspond to the target object ('this' in Java parlance). Thus
 196.270 +  methods for interfaces will take one more argument than do the
 196.271 +  interface declarations. Note also that recur calls to the method
 196.272 +  head should *not* pass the target object, it will be supplied
 196.273 +  automatically and can not be substituted.
 196.274 +
 196.275 +  In the method bodies, the (unqualified) name can be used to name the
 196.276 +  class (for calls to new, instance? etc).
 196.277 +
 196.278 +  The class will have implementations of several (clojure.lang)
 196.279 +  interfaces generated automatically: IObj (metadata support) and
 196.280 +  IPersistentMap, and all of their superinterfaces.
 196.281 +
 196.282 +  In addition, defrecord will define type-and-value-based equality and
 196.283 +  hashCode.
 196.284 +
 196.285 +  When AOT compiling, generates compiled bytecode for a class with the
 196.286 +  given name (a symbol), prepends the current ns as the package, and
 196.287 +  writes the .class file to the *compile-path* directory.
 196.288 +
 196.289 +  Two constructors will be defined, one taking the designated fields
 196.290 +  followed by a metadata map (nil for none) and an extension field
 196.291 +  map (nil for none), and one taking only the fields (using nil for
 196.292 +  meta and extension fields)."
 196.293 +  {:added "1.2"}
 196.294 +
 196.295 +  [name [& fields] & opts+specs]
 196.296 +  (let [gname name
 196.297 +        [interfaces methods opts] (parse-opts+specs opts+specs)
 196.298 +        classname (symbol (str *ns* "." gname))
 196.299 +        tag (keyword (str *ns*) (str name))
 196.300 +        hinted-fields fields
 196.301 +        fields (vec (map #(with-meta % nil) fields))]
 196.302 +    `(let []
 196.303 +       ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
 196.304 +       (defmethod print-method ~classname [o# w#]
 196.305 +           ((var print-defrecord) o# w#))
 196.306 +       (import ~classname)
 196.307 +       #_(defn ~name
 196.308 +         ([~@fields] (new ~classname ~@fields nil nil))
 196.309 +         ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#))))))
 196.310 +
 196.311 +(defn- print-defrecord [o ^Writer w]
 196.312 +  (print-meta o w)
 196.313 +  (.write w "#:")
 196.314 +  (.write w (.getName (class o)))
 196.315 +  (print-map
 196.316 +    o
 196.317 +    pr-on w))
 196.318 +
 196.319 +(defn- emit-deftype* 
 196.320 +  "Do not use this directly - use deftype"
 196.321 +  [tagname name fields interfaces methods]
 196.322 +  (let [classname (with-meta (symbol (str *ns* "." name)) (meta name))]
 196.323 +    `(deftype* ~tagname ~classname ~fields 
 196.324 +       :implements ~interfaces 
 196.325 +       ~@methods)))
 196.326 +
 196.327 +(defmacro deftype
 196.328 +  "Alpha - subject to change
 196.329 +  
 196.330 +  (deftype name [fields*]  options* specs*)
 196.331 +  
 196.332 +  Currently there are no options.
 196.333 +
 196.334 +  Each spec consists of a protocol or interface name followed by zero
 196.335 +  or more method bodies:
 196.336 +
 196.337 +  protocol-or-interface-or-Object
 196.338 +  (methodName [args*] body)*
 196.339 +
 196.340 +  Dynamically generates compiled bytecode for class with the given
 196.341 +  name, in a package with the same name as the current namespace, the
 196.342 +  given fields, and, optionally, methods for protocols and/or
 196.343 +  interfaces. 
 196.344 +
 196.345 +  The class will have the (by default, immutable) fields named by
 196.346 +  fields, which can have type hints. Protocols/interfaces and methods
 196.347 +  are optional. The only methods that can be supplied are those
 196.348 +  declared in the protocols/interfaces.  Note that method bodies are
 196.349 +  not closures, the local environment includes only the named fields,
 196.350 +  and those fields can be accessed directy. Fields can be qualified
 196.351 +  with the metadata :volatile-mutable true or :unsynchronized-mutable
 196.352 +  true, at which point (set! afield aval) will be supported in method
 196.353 +  bodies. Note well that mutable fields are extremely difficult to use
 196.354 +  correctly, and are present only to facilitate the building of higher
 196.355 +  level constructs, such as Clojure's reference types, in Clojure
 196.356 +  itself. They are for experts only - if the semantics and
 196.357 +  implications of :volatile-mutable or :unsynchronized-mutable are not
 196.358 +  immediately apparent to you, you should not be using them.
 196.359 +
 196.360 +  Method definitions take the form:
 196.361 +
 196.362 +  (methodname [args*] body)
 196.363 +
 196.364 +  The argument and return types can be hinted on the arg and
 196.365 +  methodname symbols. If not supplied, they will be inferred, so type
 196.366 +  hints should be reserved for disambiguation.
 196.367 +
 196.368 +  Methods should be supplied for all methods of the desired
 196.369 +  protocol(s) and interface(s). You can also define overrides for
 196.370 +  methods of Object. Note that a parameter must be supplied to
 196.371 +  correspond to the target object ('this' in Java parlance). Thus
 196.372 +  methods for interfaces will take one more argument than do the
 196.373 +  interface declarations. Note also that recur calls to the method
 196.374 +  head should *not* pass the target object, it will be supplied
 196.375 +  automatically and can not be substituted.
 196.376 +
 196.377 +  In the method bodies, the (unqualified) name can be used to name the
 196.378 +  class (for calls to new, instance? etc).
 196.379 +
 196.380 +  When AOT compiling, generates compiled bytecode for a class with the
 196.381 +  given name (a symbol), prepends the current ns as the package, and
 196.382 +  writes the .class file to the *compile-path* directory.
 196.383 +
 196.384 +  One constructors will be defined, taking the designated fields."
 196.385 +  {:added "1.2"}
 196.386 +
 196.387 +  [name [& fields] & opts+specs]
 196.388 +  (let [gname name
 196.389 +        [interfaces methods opts] (parse-opts+specs opts+specs)
 196.390 +        classname (symbol (str *ns* "." gname))
 196.391 +        tag (keyword (str *ns*) (str name))
 196.392 +        hinted-fields fields
 196.393 +        fields (vec (map #(with-meta % nil) fields))]
 196.394 +    `(let []
 196.395 +       ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
 196.396 +       (import ~classname))))
 196.397 +
 196.398 +
 196.399 +
 196.400 +
 196.401 +;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;
 196.402 +
 196.403 +(defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f]
 196.404 +  (let [cs (into {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache)))))
 196.405 +        cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f))
 196.406 +        [shift mask] (min-hash (keys cs))
 196.407 +        table (make-array Object (* 2 (inc mask)))
 196.408 +        table (reduce (fn [^objects t [c e]]
 196.409 +                        (let [i (* 2 (int (shift-mask shift mask (hash c))))]
 196.410 +                          (aset t i c)
 196.411 +                          (aset t (inc i) e)
 196.412 +                          t))
 196.413 +                      table cs)]
 196.414 +    (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table)))
 196.415 +
 196.416 +(defn- super-chain [^Class c]
 196.417 +  (when c
 196.418 +    (cons c (super-chain (.getSuperclass c)))))
 196.419 +
 196.420 +(defn- pref
 196.421 +  ([] nil)
 196.422 +  ([a] a) 
 196.423 +  ([^Class a ^Class b]
 196.424 +     (if (.isAssignableFrom a b) b a)))
 196.425 +
 196.426 +(defn find-protocol-impl [protocol x]
 196.427 +  (if (instance? (:on-interface protocol) x)
 196.428 +    x
 196.429 +    (let [c (class x)
 196.430 +          impl #(get (:impls protocol) %)]
 196.431 +      (or (impl c)
 196.432 +          (and c (or (first (remove nil? (map impl (butlast (super-chain c)))))
 196.433 +                     (when-let [t (reduce pref (filter impl (disj (supers c) Object)))]
 196.434 +                       (impl t))
 196.435 +                     (impl Object)))))))
 196.436 +
 196.437 +(defn find-protocol-method [protocol methodk x]
 196.438 +  (get (find-protocol-impl protocol x) methodk))
 196.439 +
 196.440 +(defn- protocol?
 196.441 +  [maybe-p]
 196.442 +  (boolean (:on-interface maybe-p)))
 196.443 +
 196.444 +(defn- implements? [protocol atype]
 196.445 +  (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype)))
 196.446 +
 196.447 +(defn extends? 
 196.448 +  "Returns true if atype extends protocol"
 196.449 +  {:added "1.2"}
 196.450 +  [protocol atype]
 196.451 +  (boolean (or (implements? protocol atype) 
 196.452 +               (get (:impls protocol) atype))))
 196.453 +
 196.454 +(defn extenders 
 196.455 +  "Returns a collection of the types explicitly extending protocol"
 196.456 +  {:added "1.2"}
 196.457 +  [protocol]
 196.458 +  (keys (:impls protocol)))
 196.459 +
 196.460 +(defn satisfies? 
 196.461 +  "Returns true if x satisfies the protocol"
 196.462 +  {:added "1.2"}
 196.463 +  [protocol x]
 196.464 +  (boolean (find-protocol-impl protocol x)))
 196.465 +
 196.466 +(defn -cache-protocol-fn [^clojure.lang.AFunction pf x ^Class c ^clojure.lang.IFn interf]
 196.467 +  (let [cache  (.__methodImplCache pf)
 196.468 +        f (if (.isInstance c x)
 196.469 +            interf 
 196.470 +            (find-protocol-method (.protocol cache) (.methodk cache) x))]
 196.471 +    (when-not f
 196.472 +      (throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache) 
 196.473 +                                             " of protocol: " (:var (.protocol cache)) 
 196.474 +                                             " found for class: " (if (nil? x) "nil" (.getName (class x)))))))
 196.475 +    (set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f))
 196.476 +    f))
 196.477 +
 196.478 +(defn- emit-method-builder [on-interface method on-method arglists]
 196.479 +  (let [methodk (keyword method)
 196.480 +        gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction})
 196.481 +        ginterf (gensym)]
 196.482 +    `(fn [cache#]
 196.483 +       (let [~ginterf
 196.484 +             (fn
 196.485 +               ~@(map 
 196.486 +                  (fn [args]
 196.487 +                    (let [gargs (map #(gensym (str "gf__" % "__")) args)
 196.488 +                          target (first gargs)]
 196.489 +                      `([~@gargs]
 196.490 +                          (. ~(with-meta target {:tag on-interface})  ~(or on-method method) ~@(rest gargs)))))
 196.491 +                  arglists))
 196.492 +             ^clojure.lang.AFunction f#
 196.493 +             (fn ~gthis
 196.494 +               ~@(map 
 196.495 +                  (fn [args]
 196.496 +                    (let [gargs (map #(gensym (str "gf__" % "__")) args)
 196.497 +                          target (first gargs)]
 196.498 +                      `([~@gargs]
 196.499 +                          (let [cache# (.__methodImplCache ~gthis)
 196.500 +                                f# (.fnFor cache# (clojure.lang.Util/classOf ~target))]
 196.501 +                            (if f# 
 196.502 +                              (f# ~@gargs)
 196.503 +                              ((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs))))))
 196.504 +                  arglists))]
 196.505 +         (set! (.__methodImplCache f#) cache#)
 196.506 +         f#))))
 196.507 +
 196.508 +(defn -reset-methods [protocol]
 196.509 +  (doseq [[^clojure.lang.Var v build] (:method-builders protocol)]
 196.510 +    (let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))]
 196.511 +      (.bindRoot v (build cache)))))
 196.512 +
 196.513 +(defn- assert-same-protocol [protocol-var method-syms]
 196.514 +  (doseq [m method-syms]
 196.515 +    (let [v (resolve m)
 196.516 +          p (:protocol (meta v))]
 196.517 +      (when (and v (bound? v) (not= protocol-var p))
 196.518 +        (binding [*out* *err*]
 196.519 +          (println "Warning: protocol" protocol-var "is overwriting"
 196.520 +                   (if p
 196.521 +                     (str "method " (.sym v) " of protocol " (.sym p))
 196.522 +                     (str "function " (.sym v)))))))))
 196.523 +
 196.524 +(defn- emit-protocol [name opts+sigs]
 196.525 +  (let [iname (symbol (str (munge *ns*) "." (munge name)))
 196.526 +        [opts sigs]
 196.527 +        (loop [opts {:on (list 'quote iname) :on-interface iname} sigs opts+sigs]
 196.528 +          (condp #(%1 %2) (first sigs) 
 196.529 +            string? (recur (assoc opts :doc (first sigs)) (next sigs))
 196.530 +            keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs))
 196.531 +            [opts sigs]))
 196.532 +        sigs (reduce (fn [m s]
 196.533 +                       (let [name-meta (meta (first s))
 196.534 +                             mname (with-meta (first s) nil)
 196.535 +                             [arglists doc]
 196.536 +                               (loop [as [] rs (rest s)]
 196.537 +                                 (if (vector? (first rs))
 196.538 +                                   (recur (conj as (first rs)) (next rs))
 196.539 +                                   [(seq as) (first rs)]))]
 196.540 +                         (when (some #{0} (map count arglists))
 196.541 +                           (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg"))))
 196.542 +                         (assoc m (keyword mname)
 196.543 +                                (merge name-meta
 196.544 +                                       {:name (vary-meta mname assoc :doc doc :arglists arglists)
 196.545 +                                        :arglists arglists
 196.546 +                                        :doc doc}))))
 196.547 +                     {} sigs)
 196.548 +        meths (mapcat (fn [sig]
 196.549 +                        (let [m (munge (:name sig))]
 196.550 +                          (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object) 
 196.551 +                               (:arglists sig))))
 196.552 +                      (vals sigs))]
 196.553 +  `(do
 196.554 +     (defonce ~name {})
 196.555 +     (gen-interface :name ~iname :methods ~meths)
 196.556 +     (alter-meta! (var ~name) assoc :doc ~(:doc opts))
 196.557 +     (#'assert-same-protocol (var ~name) '~(map :name (vals sigs)))
 196.558 +     (alter-var-root (var ~name) merge 
 196.559 +                     (assoc ~opts 
 196.560 +                       :sigs '~sigs 
 196.561 +                       :var (var ~name)
 196.562 +                       :method-map 
 196.563 +                         ~(and (:on opts)
 196.564 +                               (apply hash-map 
 196.565 +                                      (mapcat 
 196.566 +                                       (fn [s] 
 196.567 +                                         [(keyword (:name s)) (keyword (or (:on s) (:name s)))])
 196.568 +                                       (vals sigs))))
 196.569 +                       :method-builders 
 196.570 +                        ~(apply hash-map 
 196.571 +                                (mapcat 
 196.572 +                                 (fn [s]
 196.573 +                                   [`(intern *ns* (with-meta '~(:name s) (merge '~s {:protocol (var ~name)})))
 196.574 +                                    (emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))])
 196.575 +                                 (vals sigs)))))
 196.576 +     (-reset-methods ~name)
 196.577 +     '~name)))
 196.578 +
 196.579 +(defmacro defprotocol 
 196.580 +  "A protocol is a named set of named methods and their signatures:
 196.581 +  (defprotocol AProtocolName
 196.582 +
 196.583 +    ;optional doc string
 196.584 +    \"A doc string for AProtocol abstraction\"
 196.585 +
 196.586 +  ;method signatures
 196.587 +    (bar [this a b] \"bar docs\")
 196.588 +    (baz [this a] [this a b] [this a b c] \"baz docs\"))
 196.589 +
 196.590 +  No implementations are provided. Docs can be specified for the
 196.591 +  protocol overall and for each method. The above yields a set of
 196.592 +  polymorphic functions and a protocol object. All are
 196.593 +  namespace-qualified by the ns enclosing the definition The resulting
 196.594 +  functions dispatch on the type of their first argument, which is
 196.595 +  required and corresponds to the implicit target object ('this' in 
 196.596 +  Java parlance). defprotocol is dynamic, has no special compile-time 
 196.597 +  effect, and defines no new types or classes. Implementations of 
 196.598 +  the protocol methods can be provided using extend.
 196.599 +
 196.600 +  defprotocol will automatically generate a corresponding interface,
 196.601 +  with the same name as the protocol, i.e. given a protocol:
 196.602 +  my.ns/Protocol, an interface: my.ns.Protocol. The interface will
 196.603 +  have methods corresponding to the protocol functions, and the
 196.604 +  protocol will automatically work with instances of the interface.
 196.605 +
 196.606 +  Note that you should not use this interface with deftype or
 196.607 +  reify, as they support the protocol directly:
 196.608 +
 196.609 +  (defprotocol P 
 196.610 +    (foo [this]) 
 196.611 +    (bar-me [this] [this y]))
 196.612 +
 196.613 +  (deftype Foo [a b c] 
 196.614 +   P
 196.615 +    (foo [this] a)
 196.616 +    (bar-me [this] b)
 196.617 +    (bar-me [this y] (+ c y)))
 196.618 +  
 196.619 +  (bar-me (Foo. 1 2 3) 42)
 196.620 +  => 45
 196.621 +
 196.622 +  (foo 
 196.623 +    (let [x 42]
 196.624 +      (reify P 
 196.625 +        (foo [this] 17)
 196.626 +        (bar-me [this] x)
 196.627 +        (bar-me [this y] x))))
 196.628 +  => 17"
 196.629 +  {:added "1.2"} 
 196.630 +  [name & opts+sigs]
 196.631 +  (emit-protocol name opts+sigs))
 196.632 +
 196.633 +(defn extend 
 196.634 +  "Implementations of protocol methods can be provided using the extend construct:
 196.635 +
 196.636 +  (extend AType
 196.637 +    AProtocol
 196.638 +     {:foo an-existing-fn
 196.639 +      :bar (fn [a b] ...)
 196.640 +      :baz (fn ([a]...) ([a b] ...)...)}
 196.641 +    BProtocol 
 196.642 +      {...} 
 196.643 +    ...)
 196.644 + 
 196.645 +  extend takes a type/class (or interface, see below), and one or more
 196.646 +  protocol + method map pairs. It will extend the polymorphism of the
 196.647 +  protocol's methods to call the supplied methods when an AType is
 196.648 +  provided as the first argument. 
 196.649 +
 196.650 +  Method maps are maps of the keyword-ized method names to ordinary
 196.651 +  fns. This facilitates easy reuse of existing fns and fn maps, for
 196.652 +  code reuse/mixins without derivation or composition. You can extend
 196.653 +  an interface to a protocol. This is primarily to facilitate interop
 196.654 +  with the host (e.g. Java) but opens the door to incidental multiple
 196.655 +  inheritance of implementation since a class can inherit from more
 196.656 +  than one interface, both of which extend the protocol. It is TBD how
 196.657 +  to specify which impl to use. You can extend a protocol on nil.
 196.658 +
 196.659 +  If you are supplying the definitions explicitly (i.e. not reusing
 196.660 +  exsting functions or mixin maps), you may find it more convenient to
 196.661 +  use the extend-type or extend-protocol macros.
 196.662 +
 196.663 +  Note that multiple independent extend clauses can exist for the same
 196.664 +  type, not all protocols need be defined in a single extend call.
 196.665 +
 196.666 +  See also:
 196.667 +  extends?, satisfies?, extenders"
 196.668 +  {:added "1.2"} 
 196.669 +  [atype & proto+mmaps]
 196.670 +  (doseq [[proto mmap] (partition 2 proto+mmaps)]
 196.671 +    (when-not (protocol? proto)
 196.672 +      (throw (IllegalArgumentException.
 196.673 +              (str proto " is not a protocol"))))
 196.674 +    (when (implements? proto atype)
 196.675 +      (throw (IllegalArgumentException. 
 196.676 +              (str atype " already directly implements " (:on-interface proto) " for protocol:"  
 196.677 +                   (:var proto)))))
 196.678 +    (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap))))
 196.679 +
 196.680 +(defn- emit-impl [[p fs]]
 196.681 +  [p (zipmap (map #(-> % first keyword) fs)
 196.682 +             (map #(cons 'fn (drop 1 %)) fs))])
 196.683 +
 196.684 +(defn- emit-hinted-impl [c [p fs]]
 196.685 +  (let [hint (fn [specs]
 196.686 +               (let [specs (if (vector? (first specs)) 
 196.687 +                                        (list specs) 
 196.688 +                                        specs)]
 196.689 +                 (map (fn [[[target & args] & body]]
 196.690 +                        (cons (apply vector (vary-meta target assoc :tag c) args)
 196.691 +                              body))
 196.692 +                      specs)))]
 196.693 +    [p (zipmap (map #(-> % first keyword) fs)
 196.694 +               (map #(cons 'fn (hint (drop 1 %))) fs))]))
 196.695 +
 196.696 +(defn- emit-extend-type [c specs]
 196.697 +  (let [impls (parse-impls specs)]
 196.698 +    `(extend ~c
 196.699 +             ~@(mapcat (partial emit-hinted-impl c) impls))))
 196.700 +
 196.701 +(defmacro extend-type 
 196.702 +  "A macro that expands into an extend call. Useful when you are
 196.703 +  supplying the definitions explicitly inline, extend-type
 196.704 +  automatically creates the maps required by extend.  Propagates the
 196.705 +  class as a type hint on the first argument of all fns.
 196.706 +
 196.707 +  (extend-type MyType 
 196.708 +    Countable
 196.709 +      (cnt [c] ...)
 196.710 +    Foo
 196.711 +      (bar [x y] ...)
 196.712 +      (baz ([x] ...) ([x y & zs] ...)))
 196.713 +
 196.714 +  expands into:
 196.715 +
 196.716 +  (extend MyType
 196.717 +   Countable
 196.718 +     {:cnt (fn [c] ...)}
 196.719 +   Foo
 196.720 +     {:baz (fn ([x] ...) ([x y & zs] ...))
 196.721 +      :bar (fn [x y] ...)})"
 196.722 +  {:added "1.2"} 
 196.723 +  [t & specs]
 196.724 +  (emit-extend-type t specs))
 196.725 +
 196.726 +(defn- emit-extend-protocol [p specs]
 196.727 +  (let [impls (parse-impls specs)]
 196.728 +    `(do
 196.729 +       ~@(map (fn [[t fs]]
 196.730 +                `(extend-type ~t ~p ~@fs))
 196.731 +              impls))))
 196.732 +
 196.733 +(defmacro extend-protocol 
 196.734 +  "Useful when you want to provide several implementations of the same
 196.735 +  protocol all at once. Takes a single protocol and the implementation
 196.736 +  of that protocol for one or more types. Expands into calls to
 196.737 +  extend-type:
 196.738 +
 196.739 +  (extend-protocol Protocol
 196.740 +    AType
 196.741 +      (foo [x] ...)
 196.742 +      (bar [x y] ...)
 196.743 +    BType
 196.744 +      (foo [x] ...)
 196.745 +      (bar [x y] ...)
 196.746 +    AClass
 196.747 +      (foo [x] ...)
 196.748 +      (bar [x y] ...)
 196.749 +    nil
 196.750 +      (foo [x] ...)
 196.751 +      (bar [x y] ...))
 196.752 +
 196.753 +  expands into:
 196.754 +
 196.755 +  (do
 196.756 +   (clojure.core/extend-type AType Protocol 
 196.757 +     (foo [x] ...) 
 196.758 +     (bar [x y] ...))
 196.759 +   (clojure.core/extend-type BType Protocol 
 196.760 +     (foo [x] ...) 
 196.761 +     (bar [x y] ...))
 196.762 +   (clojure.core/extend-type AClass Protocol 
 196.763 +     (foo [x] ...) 
 196.764 +     (bar [x y] ...))
 196.765 +   (clojure.core/extend-type nil Protocol 
 196.766 +     (foo [x] ...) 
 196.767 +     (bar [x y] ...)))"
 196.768 +  {:added "1.2"}
 196.769 +
 196.770 +  [p & specs]
 196.771 +  (emit-extend-protocol p specs))
 196.772 +
   197.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   197.2 +++ b/src/clojure/core_print.clj	Sat Aug 21 06:25:44 2010 -0400
   197.3 @@ -0,0 +1,320 @@
   197.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   197.5 +;   The use and distribution terms for this software are covered by the
   197.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   197.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   197.8 +;   By using this software in any fashion, you are agreeing to be bound by
   197.9 +;   the terms of this license.
  197.10 +;   You must not remove this notice, or any other, from this software.
  197.11 +
  197.12 +(in-ns 'clojure.core)
  197.13 +
  197.14 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  197.15 +
  197.16 +(import '(java.io Writer))
  197.17 +
  197.18 +(def
  197.19 + ^{:doc "*print-length* controls how many items of each collection the
  197.20 +  printer will print. If it is bound to logical false, there is no
  197.21 +  limit. Otherwise, it must be bound to an integer indicating the maximum
  197.22 +  number of items of each collection to print. If a collection contains
  197.23 +  more items, the printer will print items up to the limit followed by
  197.24 +  '...' to represent the remaining items. The root binding is nil
  197.25 +  indicating no limit."
  197.26 +   :added "1.0"}
  197.27 + *print-length* nil)
  197.28 +
  197.29 +(def
  197.30 + ^{:doc "*print-level* controls how many levels deep the printer will
  197.31 +  print nested objects. If it is bound to logical false, there is no
  197.32 +  limit. Otherwise, it must be bound to an integer indicating the maximum
  197.33 +  level to print. Each argument to print is at level 0; if an argument is a
  197.34 +  collection, its items are at level 1; and so on. If an object is a
  197.35 +  collection and is at a level greater than or equal to the value bound to
  197.36 +  *print-level*, the printer prints '#' to represent it. The root binding
  197.37 +  is nil indicating no limit."
  197.38 +   :added "1.0"}
  197.39 +*print-level* nil)
  197.40 +
  197.41 +(defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]
  197.42 +  (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
  197.43 +    (if (and *print-level* (neg? *print-level*))
  197.44 +      (.write w "#")
  197.45 +      (do
  197.46 +        (.write w begin)
  197.47 +        (when-let [xs (seq sequence)]
  197.48 +          (if (and (not *print-dup*) *print-length*)
  197.49 +            (loop [[x & xs] xs
  197.50 +                   print-length *print-length*]
  197.51 +              (if (zero? print-length)
  197.52 +                (.write w "...")
  197.53 +                (do
  197.54 +                  (print-one x w)
  197.55 +                  (when xs
  197.56 +                    (.write w sep)
  197.57 +                    (recur xs (dec print-length))))))
  197.58 +            (loop [[x & xs] xs]
  197.59 +              (print-one x w)
  197.60 +              (when xs
  197.61 +                (.write w sep)
  197.62 +                (recur xs)))))
  197.63 +        (.write w end)))))
  197.64 +
  197.65 +(defn- print-meta [o, ^Writer w]
  197.66 +  (when-let [m (meta o)]
  197.67 +    (when (and (pos? (count m))
  197.68 +               (or *print-dup*
  197.69 +                   (and *print-meta* *print-readably*)))
  197.70 +      (.write w "^")
  197.71 +      (if (and (= (count m) 1) (:tag m))
  197.72 +          (pr-on (:tag m) w)
  197.73 +          (pr-on m w))
  197.74 +      (.write w " "))))
  197.75 +
  197.76 +(defmethod print-method :default [o, ^Writer w]
  197.77 +  (print-method (vary-meta o #(dissoc % :type)) w))
  197.78 +
  197.79 +(defmethod print-method nil [o, ^Writer w]
  197.80 +  (.write w "nil"))
  197.81 +
  197.82 +(defmethod print-dup nil [o w] (print-method o w))
  197.83 +
  197.84 +(defn print-ctor [o print-args ^Writer w]
  197.85 +  (.write w "#=(")
  197.86 +  (.write w (.getName ^Class (class o)))
  197.87 +  (.write w ". ")
  197.88 +  (print-args o w)
  197.89 +  (.write w ")"))
  197.90 +
  197.91 +(defmethod print-method Object [o, ^Writer w]
  197.92 +  (.write w "#<")
  197.93 +  (.write w (.getSimpleName (class o)))
  197.94 +  (.write w " ")
  197.95 +  (.write w (str o))
  197.96 +  (.write w ">"))
  197.97 +
  197.98 +(defmethod print-method clojure.lang.Keyword [o, ^Writer w]
  197.99 +  (.write w (str o)))
 197.100 +
 197.101 +(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))
 197.102 +
 197.103 +(defmethod print-method Number [o, ^Writer w]
 197.104 +  (.write w (str o)))
 197.105 +
 197.106 +(defmethod print-dup Number [o, ^Writer w]
 197.107 +  (print-ctor o
 197.108 +              (fn [o w]
 197.109 +                  (print-dup (str o) w))
 197.110 +              w))
 197.111 +
 197.112 +(defmethod print-dup clojure.lang.Fn [o, ^Writer w]
 197.113 +  (print-ctor o (fn [o w]) w))
 197.114 +
 197.115 +(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn)
 197.116 +(prefer-method print-dup java.util.Map clojure.lang.Fn)
 197.117 +(prefer-method print-dup java.util.Collection clojure.lang.Fn)
 197.118 +
 197.119 +(defmethod print-method Boolean [o, ^Writer w]
 197.120 +  (.write w (str o)))
 197.121 +
 197.122 +(defmethod print-dup Boolean [o w] (print-method o w))
 197.123 +
 197.124 +(defn print-simple [o, ^Writer w]
 197.125 +  (print-meta o w)
 197.126 +  (.write w (str o)))
 197.127 +
 197.128 +(defmethod print-method clojure.lang.Symbol [o, ^Writer w]
 197.129 +  (print-simple o w))
 197.130 +
 197.131 +(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))
 197.132 +
 197.133 +(defmethod print-method clojure.lang.Var [o, ^Writer w]
 197.134 +  (print-simple o w))
 197.135 +
 197.136 +(defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w]
 197.137 +  (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")")))
 197.138 +
 197.139 +(defmethod print-method clojure.lang.ISeq [o, ^Writer w]
 197.140 +  (print-meta o w)
 197.141 +  (print-sequential "(" pr-on " " ")" o w))
 197.142 +
 197.143 +(defmethod print-dup clojure.lang.ISeq [o w] (print-method o w))
 197.144 +(defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w))
 197.145 +(prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection)
 197.146 +(prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection)
 197.147 +(prefer-method print-method clojure.lang.ISeq java.util.Collection)
 197.148 +(prefer-method print-dup clojure.lang.ISeq java.util.Collection)
 197.149 +
 197.150 +
 197.151 +
 197.152 +(defmethod print-dup java.util.Collection [o, ^Writer w]
 197.153 + (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
 197.154 +
 197.155 +(defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]
 197.156 +  (print-meta o w)
 197.157 +  (.write w "#=(")
 197.158 +  (.write w (.getName ^Class (class o)))
 197.159 +  (.write w "/create ")
 197.160 +  (print-sequential "[" print-dup " " "]" o w)
 197.161 +  (.write w ")"))
 197.162 +
 197.163 +(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection)
 197.164 +
 197.165 +(def ^{:tag String 
 197.166 +       :doc "Returns escape string for char or nil if none"
 197.167 +       :added "1.0"}
 197.168 +  char-escape-string
 197.169 +    {\newline "\\n"
 197.170 +     \tab  "\\t"
 197.171 +     \return "\\r"
 197.172 +     \" "\\\""
 197.173 +     \\  "\\\\"
 197.174 +     \formfeed "\\f"
 197.175 +     \backspace "\\b"})
 197.176 +
 197.177 +(defmethod print-method String [^String s, ^Writer w]
 197.178 +  (if (or *print-dup* *print-readably*)
 197.179 +    (do (.append w \")
 197.180 +      (dotimes [n (count s)]
 197.181 +        (let [c (.charAt s n)
 197.182 +              e (char-escape-string c)]
 197.183 +          (if e (.write w e) (.append w c))))
 197.184 +      (.append w \"))
 197.185 +    (.write w s))
 197.186 +  nil)
 197.187 +
 197.188 +(defmethod print-dup String [s w] (print-method s w))
 197.189 +
 197.190 +(defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w]
 197.191 +  (print-meta v w)
 197.192 +  (print-sequential "[" pr-on " " "]" v w))
 197.193 +
 197.194 +(defn- print-map [m print-one w]
 197.195 +  (print-sequential 
 197.196 +   "{"
 197.197 +   (fn [e  ^Writer w] 
 197.198 +     (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
 197.199 +   ", "
 197.200 +   "}"
 197.201 +   (seq m) w))
 197.202 +
 197.203 +(defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w]
 197.204 +  (print-meta m w)
 197.205 +  (print-map m pr-on w))
 197.206 +
 197.207 +(defmethod print-dup java.util.Map [m, ^Writer w]
 197.208 +  (print-ctor m #(print-map (seq %1) print-dup %2) w))
 197.209 +
 197.210 +(defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w]
 197.211 +  (print-meta m w)
 197.212 +  (.write w "#=(")
 197.213 +  (.write w (.getName (class m)))
 197.214 +  (.write w "/create ")
 197.215 +  (print-map m print-dup w)
 197.216 +  (.write w ")"))
 197.217 +
 197.218 +(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
 197.219 +
 197.220 +(defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]
 197.221 +  (print-meta s w)
 197.222 +  (print-sequential "#{" pr-on " " "}" (seq s) w))
 197.223 +
 197.224 +(def ^{:tag String 
 197.225 +       :doc "Returns name string for char or nil if none"
 197.226 +       :added "1.0"} 
 197.227 + char-name-string
 197.228 +   {\newline "newline"
 197.229 +    \tab "tab"
 197.230 +    \space "space"
 197.231 +    \backspace "backspace"
 197.232 +    \formfeed "formfeed"
 197.233 +    \return "return"})
 197.234 +
 197.235 +(defmethod print-method java.lang.Character [^Character c, ^Writer w]
 197.236 +  (if (or *print-dup* *print-readably*)
 197.237 +    (do (.append w \\)
 197.238 +        (let [n (char-name-string c)]
 197.239 +          (if n (.write w n) (.append w c))))
 197.240 +    (.append w c))
 197.241 +  nil)
 197.242 +
 197.243 +(defmethod print-dup java.lang.Character [c w] (print-method c w))
 197.244 +(defmethod print-dup java.lang.Integer [o w] (print-method o w))
 197.245 +(defmethod print-dup java.lang.Double [o w] (print-method o w))
 197.246 +(defmethod print-dup clojure.lang.Ratio [o w] (print-method o w))
 197.247 +(defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
 197.248 +(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))
 197.249 +(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))
 197.250 +(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))
 197.251 +(defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))
 197.252 +
 197.253 +(def primitives-classnames
 197.254 +  {Float/TYPE "Float/TYPE"
 197.255 +   Integer/TYPE "Integer/TYPE"
 197.256 +   Long/TYPE "Long/TYPE"
 197.257 +   Boolean/TYPE "Boolean/TYPE"
 197.258 +   Character/TYPE "Character/TYPE"
 197.259 +   Double/TYPE "Double/TYPE"
 197.260 +   Byte/TYPE "Byte/TYPE"
 197.261 +   Short/TYPE "Short/TYPE"})
 197.262 +
 197.263 +(defmethod print-method Class [^Class c, ^Writer w]
 197.264 +  (.write w (.getName c)))
 197.265 +
 197.266 +(defmethod print-dup Class [^Class c, ^Writer w]
 197.267 +  (cond
 197.268 +    (.isPrimitive c) (do
 197.269 +                       (.write w "#=(identity ")
 197.270 +                       (.write w ^String (primitives-classnames c))
 197.271 +                       (.write w ")"))
 197.272 +    (.isArray c) (do
 197.273 +                   (.write w "#=(java.lang.Class/forName \"")
 197.274 +                   (.write w (.getName c))
 197.275 +                   (.write w "\")"))
 197.276 +    :else (do
 197.277 +            (.write w "#=")
 197.278 +            (.write w (.getName c)))))
 197.279 +
 197.280 +(defmethod print-method java.math.BigDecimal [b, ^Writer w]
 197.281 +  (.write w (str b))
 197.282 +  (.write w "M"))
 197.283 +
 197.284 +(defmethod print-method java.util.regex.Pattern [p ^Writer w]
 197.285 +  (.write w "#\"")
 197.286 +  (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p))
 197.287 +         qmode false]
 197.288 +    (when s
 197.289 +      (cond
 197.290 +        (= c \\) (let [[^Character c2 & r2] r]
 197.291 +                   (.append w \\)
 197.292 +                   (.append w c2)
 197.293 +                   (if qmode
 197.294 +                      (recur r2 (not= c2 \E))
 197.295 +                      (recur r2 (= c2 \Q))))
 197.296 +        (= c \") (do
 197.297 +                   (if qmode
 197.298 +                     (.write w "\\E\\\"\\Q")
 197.299 +                     (.write w "\\\""))
 197.300 +                   (recur r qmode))
 197.301 +        :else    (do
 197.302 +                   (.append w c)
 197.303 +                   (recur r qmode)))))
 197.304 +  (.append w \"))
 197.305 +
 197.306 +(defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w))
 197.307 +
 197.308 +(defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w]
 197.309 +  (.write w "#=(find-ns ")
 197.310 +  (print-dup (.name n) w)
 197.311 +  (.write w ")"))
 197.312 +
 197.313 +(defmethod print-method clojure.lang.IDeref [o ^Writer w]
 197.314 +  (print-sequential (format "#<%s@%x%s: "
 197.315 +                            (.getSimpleName (class o))
 197.316 +                            (System/identityHashCode o)
 197.317 +                            (if (and (instance? clojure.lang.Agent o)
 197.318 +                                     (agent-error o))
 197.319 +                              " FAILED"
 197.320 +                              ""))
 197.321 +                    pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w))
 197.322 +
 197.323 +(def ^{:private true} print-initialized true)
   198.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   198.2 +++ b/src/clojure/core_proxy.clj	Sat Aug 21 06:25:44 2010 -0400
   198.3 @@ -0,0 +1,407 @@
   198.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   198.5 +;   The use and distribution terms for this software are covered by the
   198.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   198.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   198.8 +;   By using this software in any fashion, you are agreeing to be bound by
   198.9 +;   the terms of this license.
  198.10 +;   You must not remove this notice, or any other, from this software.
  198.11 +
  198.12 +(in-ns 'clojure.core)
  198.13 +
  198.14 +;;;;;;;;;;;;;;;;;;;;;;;;;;;; proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  198.15 +
  198.16 +(import
  198.17 + '(clojure.asm ClassWriter ClassVisitor Opcodes Type) 
  198.18 + '(java.lang.reflect Modifier Constructor)
  198.19 + '(clojure.asm.commons Method GeneratorAdapter)
  198.20 + '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT))
  198.21 +
  198.22 +(defn method-sig [^java.lang.reflect.Method meth]
  198.23 +  [(. meth (getName)) (seq (. meth (getParameterTypes))) (. meth getReturnType)])
  198.24 +
  198.25 +(defn- most-specific [rtypes]
  198.26 +  (or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes)
  198.27 +    (throw (Exception. "Incompatible return types"))))
  198.28 +
  198.29 +(defn- group-by-sig [coll]
  198.30 + "takes a collection of [msig meth] and returns a seq of maps from return-types to meths."
  198.31 +  (vals (reduce (fn [m [msig meth]]
  198.32 +                  (let [rtype (peek msig)
  198.33 +                        argsig (pop msig)]
  198.34 +                    (assoc m argsig (assoc (m argsig {}) rtype meth))))
  198.35 +          {} coll)))
  198.36 +
  198.37 +(defn proxy-name
  198.38 + {:tag String} 
  198.39 + [^Class super interfaces]
  198.40 +  (let [inames (into (sorted-set) (map #(.getName ^Class %) interfaces))]
  198.41 +    (apply str (.replace (str *ns*) \- \_) ".proxy"
  198.42 +      (interleave (repeat "$")
  198.43 +        (concat
  198.44 +          [(.getName super)]
  198.45 +          (map #(subs % (inc (.lastIndexOf ^String % "."))) inames)
  198.46 +          [(Integer/toHexString (hash inames))])))))
  198.47 +
  198.48 +(defn- generate-proxy [^Class super interfaces]
  198.49 +  (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))
  198.50 +        cname (.replace (proxy-name super interfaces) \. \/) ;(str "clojure/lang/" (gensym "Proxy__"))
  198.51 +        ctype (. Type (getObjectType cname))
  198.52 +        iname (fn [^Class c] (.. Type (getType c) (getInternalName)))
  198.53 +        fmap "__clojureFnMap"
  198.54 +        totype (fn [^Class c] (. Type (getType c)))
  198.55 +        to-types (fn [cs] (if (pos? (count cs))
  198.56 +                            (into-array (map totype cs))
  198.57 +                            (make-array Type 0)))
  198.58 +        super-type ^Type (totype super)
  198.59 +        imap-type ^Type (totype IPersistentMap)
  198.60 +        ifn-type (totype clojure.lang.IFn)
  198.61 +        obj-type (totype Object)
  198.62 +        sym-type (totype clojure.lang.Symbol)
  198.63 +        rt-type  (totype clojure.lang.RT)
  198.64 +        ex-type  (totype java.lang.UnsupportedOperationException)
  198.65 +        gen-bridge 
  198.66 +        (fn [^java.lang.reflect.Method meth ^java.lang.reflect.Method dest]
  198.67 +            (let [pclasses (. meth (getParameterTypes))
  198.68 +                  ptypes (to-types pclasses)
  198.69 +                  rtype ^Type (totype (. meth (getReturnType)))
  198.70 +                  m (new Method (. meth (getName)) rtype ptypes)
  198.71 +                  dtype (totype (.getDeclaringClass dest))
  198.72 +                  dm (new Method (. dest (getName)) (totype (. dest (getReturnType))) (to-types (. dest (getParameterTypes))))
  198.73 +                  gen (new GeneratorAdapter (bit-or (. Opcodes ACC_PUBLIC) (. Opcodes ACC_BRIDGE)) m nil nil cv)]
  198.74 +              (. gen (visitCode))
  198.75 +              (. gen (loadThis))
  198.76 +              (dotimes [i (count ptypes)]
  198.77 +                  (. gen (loadArg i)))
  198.78 +              (if (-> dest .getDeclaringClass .isInterface)
  198.79 +                (. gen (invokeInterface dtype dm))
  198.80 +                (. gen (invokeVirtual dtype dm)))
  198.81 +              (. gen (returnValue))
  198.82 +              (. gen (endMethod))))
  198.83 +        gen-method
  198.84 +        (fn [^java.lang.reflect.Method meth else-gen]
  198.85 +            (let [pclasses (. meth (getParameterTypes))
  198.86 +                  ptypes (to-types pclasses)
  198.87 +                  rtype ^Type (totype (. meth (getReturnType)))
  198.88 +                  m (new Method (. meth (getName)) rtype ptypes)
  198.89 +                  gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)
  198.90 +                  else-label (. gen (newLabel))
  198.91 +                  end-label (. gen (newLabel))
  198.92 +                  decl-type (. Type (getType (. meth (getDeclaringClass))))]
  198.93 +              (. gen (visitCode))
  198.94 +              (if (> (count pclasses) 18)
  198.95 +                (else-gen gen m)
  198.96 +                (do
  198.97 +                  (. gen (loadThis))
  198.98 +                  (. gen (getField ctype fmap imap-type))
  198.99 +                  
 198.100 +                  (. gen (push (. meth (getName))))
 198.101 +                                        ;lookup fn in map
 198.102 +                  (. gen (invokeStatic rt-type (. Method (getMethod "Object get(Object, Object)"))))
 198.103 +                  (. gen (dup))
 198.104 +                  (. gen (ifNull else-label))
 198.105 +                                        ;if found
 198.106 +                  (.checkCast gen ifn-type)
 198.107 +                  (. gen (loadThis))
 198.108 +                                        ;box args
 198.109 +                  (dotimes [i (count ptypes)]
 198.110 +                      (. gen (loadArg i))
 198.111 +                    (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i))))
 198.112 +                                        ;call fn
 198.113 +                  (. gen (invokeInterface ifn-type (new Method "invoke" obj-type 
 198.114 +                                                        (into-array (cons obj-type 
 198.115 +                                                                          (replicate (count ptypes) obj-type))))))
 198.116 +                                        ;unbox return
 198.117 +                  (. gen (unbox rtype))
 198.118 +                  (when (= (. rtype (getSort)) (. Type VOID))
 198.119 +                    (. gen (pop)))
 198.120 +                  (. gen (goTo end-label))
 198.121 +                  
 198.122 +                                        ;else call supplied alternative generator
 198.123 +                  (. gen (mark else-label))
 198.124 +                  (. gen (pop))
 198.125 +                  
 198.126 +                  (else-gen gen m)
 198.127 +                  
 198.128 +                  (. gen (mark end-label))))
 198.129 +              (. gen (returnValue))
 198.130 +              (. gen (endMethod))))]
 198.131 +    
 198.132 +                                        ;start class definition
 198.133 +    (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER))
 198.134 +                 cname nil (iname super) 
 198.135 +                 (into-array (map iname (cons IProxy interfaces)))))
 198.136 +                                        ;add field for fn mappings
 198.137 +    (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_VOLATILE))
 198.138 +                      fmap (. imap-type (getDescriptor)) nil nil))          
 198.139 +                                        ;add ctors matching/calling super's
 198.140 +    (doseq [^Constructor ctor (. super (getDeclaredConstructors))]
 198.141 +        (when-not (. Modifier (isPrivate (. ctor (getModifiers))))
 198.142 +          (let [ptypes (to-types (. ctor (getParameterTypes)))
 198.143 +                m (new Method "<init>" (. Type VOID_TYPE) ptypes)
 198.144 +                gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]
 198.145 +            (. gen (visitCode))
 198.146 +                                        ;call super ctor
 198.147 +            (. gen (loadThis))
 198.148 +            (. gen (dup))
 198.149 +            (. gen (loadArgs))
 198.150 +            (. gen (invokeConstructor super-type m))
 198.151 +            
 198.152 +            (. gen (returnValue))
 198.153 +            (. gen (endMethod)))))
 198.154 +                                        ;add IProxy methods
 198.155 +    (let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)"))
 198.156 +          gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]
 198.157 +      (. gen (visitCode))
 198.158 +      (. gen (loadThis))
 198.159 +      (. gen (loadArgs))
 198.160 +      (. gen (putField ctype fmap imap-type))
 198.161 +      
 198.162 +      (. gen (returnValue))
 198.163 +      (. gen (endMethod)))
 198.164 +    (let [m (. Method (getMethod "void __updateClojureFnMappings(clojure.lang.IPersistentMap)"))
 198.165 +          gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]
 198.166 +      (. gen (visitCode))
 198.167 +      (. gen (loadThis))
 198.168 +      (. gen (dup))
 198.169 +      (. gen (getField ctype fmap imap-type))
 198.170 +      (.checkCast gen (totype clojure.lang.IPersistentCollection))
 198.171 +      (. gen (loadArgs))
 198.172 +      (. gen (invokeInterface (totype clojure.lang.IPersistentCollection)
 198.173 +                              (. Method (getMethod "clojure.lang.IPersistentCollection cons(Object)"))))
 198.174 +      (. gen (checkCast imap-type))
 198.175 +      (. gen (putField ctype fmap imap-type))
 198.176 +      
 198.177 +      (. gen (returnValue))
 198.178 +      (. gen (endMethod)))
 198.179 +    (let [m (. Method (getMethod "clojure.lang.IPersistentMap __getClojureFnMappings()"))
 198.180 +          gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]
 198.181 +      (. gen (visitCode))
 198.182 +      (. gen (loadThis))
 198.183 +      (. gen (getField ctype fmap imap-type))
 198.184 +      (. gen (returnValue))
 198.185 +      (. gen (endMethod)))
 198.186 +    
 198.187 +                                        ;calc set of supers' non-private instance methods
 198.188 +    (let [[mm considered]
 198.189 +            (loop [mm {} considered #{} c super]
 198.190 +              (if c
 198.191 +                (let [[mm considered]
 198.192 +                      (loop [mm mm 
 198.193 +                             considered considered 
 198.194 +                             meths (concat 
 198.195 +                                    (seq (. c (getDeclaredMethods)))
 198.196 +                                    (seq (. c (getMethods))))]
 198.197 +                        (if (seq meths)
 198.198 +                          (let [^java.lang.reflect.Method meth (first meths)
 198.199 +                                mods (. meth (getModifiers))
 198.200 +                                mk (method-sig meth)]
 198.201 +                            (if (or (considered mk)
 198.202 +                                    (not (or (Modifier/isPublic mods) (Modifier/isProtected mods)))
 198.203 +                                    ;(. Modifier (isPrivate mods)) 
 198.204 +                                    (. Modifier (isStatic mods))
 198.205 +                                    (. Modifier (isFinal mods))
 198.206 +                                    (= "finalize" (.getName meth)))
 198.207 +                              (recur mm (conj considered mk) (next meths))
 198.208 +                              (recur (assoc mm mk meth) (conj considered mk) (next meths))))
 198.209 +                          [mm considered]))]
 198.210 +                  (recur mm considered (. c (getSuperclass))))
 198.211 +                [mm considered]))
 198.212 +          ifaces-meths (into {} 
 198.213 +                         (for [^Class iface interfaces meth (. iface (getMethods))
 198.214 +                               :let [msig (method-sig meth)] :when (not (considered msig))]
 198.215 +                           {msig meth}))
 198.216 +          mgroups (group-by-sig (concat mm ifaces-meths))
 198.217 +          rtypes (map #(most-specific (keys %)) mgroups)
 198.218 +          mb (map #(vector (%1 %2) (vals (dissoc %1 %2))) mgroups rtypes)
 198.219 +          bridge? (reduce into #{} (map second mb))
 198.220 +          ifaces-meths (remove bridge? (vals ifaces-meths))
 198.221 +          mm (remove bridge? (vals mm))]
 198.222 +                                        ;add methods matching supers', if no mapping -> call super
 198.223 +      (doseq [[^java.lang.reflect.Method dest bridges] mb
 198.224 +              ^java.lang.reflect.Method meth bridges]
 198.225 +          (gen-bridge meth dest))
 198.226 +      (doseq [^java.lang.reflect.Method meth mm]
 198.227 +          (gen-method meth 
 198.228 +                      (fn [^GeneratorAdapter gen ^Method m]
 198.229 +                          (. gen (loadThis))
 198.230 +                                        ;push args
 198.231 +                        (. gen (loadArgs))
 198.232 +                                        ;call super
 198.233 +                        (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) 
 198.234 +                                                (. super-type (getInternalName))
 198.235 +                                                (. m (getName))
 198.236 +                                                (. m (getDescriptor)))))))
 198.237 +      
 198.238 +                                        ;add methods matching interfaces', if no mapping -> throw
 198.239 +      (doseq [^java.lang.reflect.Method meth ifaces-meths]
 198.240 +                (gen-method meth 
 198.241 +                            (fn [^GeneratorAdapter gen ^Method m]
 198.242 +                                (. gen (throwException ex-type (. m (getName))))))))
 198.243 +    
 198.244 +                                        ;finish class def
 198.245 +    (. cv (visitEnd))
 198.246 +    [cname (. cv toByteArray)]))
 198.247 +
 198.248 +(defn- get-super-and-interfaces [bases]
 198.249 +  (if (. ^Class (first bases) (isInterface))
 198.250 +    [Object bases]
 198.251 +    [(first bases) (next bases)]))
 198.252 +
 198.253 +(defn get-proxy-class 
 198.254 +  "Takes an optional single class followed by zero or more
 198.255 +  interfaces. If not supplied class defaults to Object.  Creates an
 198.256 +  returns an instance of a proxy class derived from the supplied
 198.257 +  classes. The resulting value is cached and used for any subsequent
 198.258 +  requests for the same class set. Returns a Class object."
 198.259 +  {:added "1.0"}
 198.260 +  [& bases]
 198.261 +    (let [[super interfaces] (get-super-and-interfaces bases)
 198.262 +          pname (proxy-name super interfaces)]
 198.263 +      (or (RT/loadClassForName pname)
 198.264 +          (let [[cname bytecode] (generate-proxy super interfaces)]
 198.265 +            (. ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (defineClass pname bytecode [super interfaces]))))))
 198.266 +
 198.267 +(defn construct-proxy
 198.268 +  "Takes a proxy class and any arguments for its superclass ctor and
 198.269 +  creates and returns an instance of the proxy."
 198.270 +  {:added "1.0"}
 198.271 +  [c & ctor-args]
 198.272 +    (. Reflector (invokeConstructor c (to-array ctor-args))))
 198.273 +
 198.274 +(defn init-proxy
 198.275 +  "Takes a proxy instance and a map of strings (which must
 198.276 +  correspond to methods of the proxy superclass/superinterfaces) to
 198.277 +  fns (which must take arguments matching the corresponding method,
 198.278 +  plus an additional (explicit) first arg corresponding to this, and
 198.279 +  sets the proxy's fn map."
 198.280 +  {:added "1.0"}
 198.281 +  [^IProxy proxy mappings]
 198.282 +    (. proxy (__initClojureFnMappings mappings)))
 198.283 +
 198.284 +(defn update-proxy
 198.285 +  "Takes a proxy instance and a map of strings (which must
 198.286 +  correspond to methods of the proxy superclass/superinterfaces) to
 198.287 +  fns (which must take arguments matching the corresponding method,
 198.288 +  plus an additional (explicit) first arg corresponding to this, and
 198.289 +  updates (via assoc) the proxy's fn map. nil can be passed instead of
 198.290 +  a fn, in which case the corresponding method will revert to the
 198.291 +  default behavior. Note that this function can be used to update the
 198.292 +  behavior of an existing instance without changing its identity."
 198.293 +  {:added "1.0"}
 198.294 +  [^IProxy proxy mappings]
 198.295 +    (. proxy (__updateClojureFnMappings mappings)))
 198.296 +
 198.297 +(defn proxy-mappings
 198.298 +  "Takes a proxy instance and returns the proxy's fn map."
 198.299 +  {:added "1.0"}
 198.300 +  [^IProxy proxy]
 198.301 +    (. proxy (__getClojureFnMappings)))
 198.302 +
 198.303 +(defmacro proxy
 198.304 +  "class-and-interfaces - a vector of class names
 198.305 +
 198.306 +  args - a (possibly empty) vector of arguments to the superclass
 198.307 +  constructor.
 198.308 +
 198.309 +  f => (name [params*] body) or
 198.310 +  (name ([params*] body) ([params+] body) ...)
 198.311 +
 198.312 +  Expands to code which creates a instance of a proxy class that
 198.313 +  implements the named class/interface(s) by calling the supplied
 198.314 +  fns. A single class, if provided, must be first. If not provided it
 198.315 +  defaults to Object.
 198.316 +
 198.317 +  The interfaces names must be valid interface types. If a method fn
 198.318 +  is not provided for a class method, the superclass methd will be
 198.319 +  called. If a method fn is not provided for an interface method, an
 198.320 +  UnsupportedOperationException will be thrown should it be
 198.321 +  called. Method fns are closures and can capture the environment in
 198.322 +  which proxy is called. Each method fn takes an additional implicit
 198.323 +  first arg, which is bound to 'this. Note that while method fns can
 198.324 +  be provided to override protected methods, they have no other access
 198.325 +  to protected members, nor to super, as these capabilities cannot be
 198.326 +  proxied."
 198.327 +  {:added "1.0"}
 198.328 +  [class-and-interfaces args & fs]
 198.329 +   (let [bases (map #(or (resolve %) (throw (Exception. (str "Can't resolve: " %)))) 
 198.330 +                    class-and-interfaces)
 198.331 +         [super interfaces] (get-super-and-interfaces bases)
 198.332 +         compile-effect (when *compile-files*
 198.333 +                          (let [[cname bytecode] (generate-proxy super interfaces)]
 198.334 +                            (clojure.lang.Compiler/writeClassFile cname bytecode)))
 198.335 +         pc-effect (apply get-proxy-class bases)
 198.336 +         pname (proxy-name super interfaces)]
 198.337 +     ;remember the class to prevent it from disappearing before use
 198.338 +     (intern *ns* (symbol pname) pc-effect)
 198.339 +     `(let [;pc# (get-proxy-class ~@class-and-interfaces)
 198.340 +            p# (new ~(symbol pname) ~@args)] ;(construct-proxy pc# ~@args)]   
 198.341 +        (init-proxy p#
 198.342 +         ~(loop [fmap {} fs fs]
 198.343 +            (if fs
 198.344 +              (let [[sym & meths] (first fs)
 198.345 +                    meths (if (vector? (first meths))
 198.346 +                            (list meths)
 198.347 +                            meths)
 198.348 +                    meths (map (fn [[params & body]]
 198.349 +                                   (cons (apply vector 'this params) body))
 198.350 +                               meths)]
 198.351 +                (if-not (contains? fmap (name sym))		  
 198.352 +                (recur (assoc fmap (name sym) (cons `fn meths)) (next fs))
 198.353 +		           (throw (IllegalArgumentException.
 198.354 +			              (str "Method '" (name sym) "' redefined")))))
 198.355 +              fmap)))
 198.356 +        p#)))
 198.357 +
 198.358 +(defn proxy-call-with-super [call this meth]
 198.359 + (let [m (proxy-mappings this)]
 198.360 +    (update-proxy this (assoc m meth nil))
 198.361 +    (let [ret (call)]
 198.362 +      (update-proxy this m)
 198.363 +      ret)))
 198.364 +
 198.365 +(defmacro proxy-super 
 198.366 +  "Use to call a superclass method in the body of a proxy method. 
 198.367 +  Note, expansion captures 'this"
 198.368 +  {:added "1.0"}
 198.369 +  [meth & args]
 198.370 + `(proxy-call-with-super (fn [] (. ~'this ~meth ~@args))  ~'this ~(name meth)))
 198.371 +
 198.372 +(defn bean
 198.373 +  "Takes a Java object and returns a read-only implementation of the
 198.374 +  map abstraction based upon its JavaBean properties."
 198.375 +  {:added "1.0"}
 198.376 +  [^Object x]
 198.377 +  (let [c (. x (getClass))
 198.378 +	pmap (reduce (fn [m ^java.beans.PropertyDescriptor pd]
 198.379 +			 (let [name (. pd (getName))
 198.380 +			       method (. pd (getReadMethod))]
 198.381 +			   (if (and method (zero? (alength (. method (getParameterTypes)))))
 198.382 +			     (assoc m (keyword name) (fn [] (clojure.lang.Reflector/prepRet (. method (invoke x nil)))))
 198.383 +			     m)))
 198.384 +		     {}
 198.385 +		     (seq (.. java.beans.Introspector
 198.386 +			      (getBeanInfo c)
 198.387 +			      (getPropertyDescriptors))))
 198.388 +	v (fn [k] ((pmap k)))
 198.389 +        snapshot (fn []
 198.390 +                   (reduce (fn [m e]
 198.391 +                             (assoc m (key e) ((val e))))
 198.392 +                           {} (seq pmap)))]
 198.393 +    (proxy [clojure.lang.APersistentMap]
 198.394 +           []
 198.395 +      (containsKey [k] (contains? pmap k))
 198.396 +      (entryAt [k] (when (contains? pmap k) (new clojure.lang.MapEntry k (v k))))
 198.397 +      (valAt ([k] (v k))
 198.398 +	     ([k default] (if (contains? pmap k) (v k) default)))
 198.399 +      (cons [m] (conj (snapshot) m))
 198.400 +      (count [] (count pmap))
 198.401 +      (assoc [k v] (assoc (snapshot) k v))
 198.402 +      (without [k] (dissoc (snapshot) k))
 198.403 +      (seq [] ((fn thisfn [plseq]
 198.404 +		  (lazy-seq
 198.405 +                   (when-let [pseq (seq plseq)]
 198.406 +                     (cons (new clojure.lang.MapEntry (first pseq) (v (first pseq)))
 198.407 +                           (thisfn (rest pseq)))))) (keys pmap))))))
 198.408 +
 198.409 +
 198.410 +
   199.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   199.2 +++ b/src/clojure/genclass.clj	Sat Aug 21 06:25:44 2010 -0400
   199.3 @@ -0,0 +1,714 @@
   199.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   199.5 +;   The use and distribution terms for this software are covered by the
   199.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   199.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   199.8 +;   By using this software in any fashion, you are agreeing to be bound by
   199.9 +;   the terms of this license.
  199.10 +;   You must not remove this notice, or any other, from this software.
  199.11 +
  199.12 +(in-ns 'clojure.core)
  199.13 +
  199.14 +(import '(java.lang.reflect Modifier Constructor)
  199.15 +        '(clojure.asm ClassWriter ClassVisitor Opcodes Type)
  199.16 +        '(clojure.asm.commons Method GeneratorAdapter)
  199.17 +        '(clojure.lang IPersistentMap))
  199.18 +
  199.19 +;(defn method-sig [^java.lang.reflect.Method meth]
  199.20 +;  [(. meth (getName)) (seq (. meth (getParameterTypes)))])
  199.21 +
  199.22 +(defn- non-private-methods [^Class c]
  199.23 +  (loop [mm {}
  199.24 +         considered #{}
  199.25 +         c c]
  199.26 +    (if c
  199.27 +      (let [[mm considered]
  199.28 +            (loop [mm mm
  199.29 +                   considered considered
  199.30 +                   meths (seq (concat
  199.31 +                                (seq (. c (getDeclaredMethods)))
  199.32 +                                (seq (. c (getMethods)))))]
  199.33 +              (if meths
  199.34 +                (let [^java.lang.reflect.Method meth (first meths)
  199.35 +                      mods (. meth (getModifiers))
  199.36 +                      mk (method-sig meth)]
  199.37 +                  (if (or (considered mk)
  199.38 +                          (not (or (Modifier/isPublic mods) (Modifier/isProtected mods)))
  199.39 +                          ;(. Modifier (isPrivate mods))
  199.40 +                          (. Modifier (isStatic mods))
  199.41 +                          (. Modifier (isFinal mods))
  199.42 +                          (= "finalize" (.getName meth)))
  199.43 +                    (recur mm (conj considered mk) (next meths))
  199.44 +                    (recur (assoc mm mk meth) (conj considered mk) (next meths))))
  199.45 +                [mm considered]))]
  199.46 +        (recur mm considered (. c (getSuperclass))))
  199.47 +      mm)))
  199.48 +
  199.49 +(defn- ctor-sigs [^Class super]
  199.50 +  (for [^Constructor ctor (. super (getDeclaredConstructors))
  199.51 +        :when (not (. Modifier (isPrivate (. ctor (getModifiers)))))]
  199.52 +    (apply vector (. ctor (getParameterTypes)))))
  199.53 +
  199.54 +(defn- escape-class-name [^Class c]
  199.55 +  (.. (.getSimpleName c) 
  199.56 +      (replace "[]" "<>")))
  199.57 +
  199.58 +(defn- overload-name [mname pclasses]
  199.59 +  (if (seq pclasses)
  199.60 +    (apply str mname (interleave (repeat \-) 
  199.61 +                                 (map escape-class-name pclasses)))
  199.62 +    (str mname "-void")))
  199.63 +
  199.64 +(defn- ^java.lang.reflect.Field find-field [^Class c f]
  199.65 +  (let [start-class c]
  199.66 +    (loop [c c]
  199.67 +      (if (= c Object)
  199.68 +        (throw (new Exception (str "field, " f ", not defined in class, " start-class ", or its ancestors")))
  199.69 +        (let [dflds (.getDeclaredFields c)
  199.70 +              rfld (first (filter #(= f (.getName ^java.lang.reflect.Field %)) dflds))]
  199.71 +          (or rfld (recur (.getSuperclass c))))))))
  199.72 +
  199.73 +;(distinct (map first(keys (mapcat non-private-methods [Object IPersistentMap]))))
  199.74 +
  199.75 +(def ^{:private true} prim->class
  199.76 +     {'int Integer/TYPE
  199.77 +      'long Long/TYPE
  199.78 +      'float Float/TYPE
  199.79 +      'double Double/TYPE
  199.80 +      'void Void/TYPE
  199.81 +      'short Short/TYPE
  199.82 +      'boolean Boolean/TYPE
  199.83 +      'byte Byte/TYPE
  199.84 +      'char Character/TYPE})
  199.85 +
  199.86 +(defn- ^Class the-class [x] 
  199.87 +  (cond 
  199.88 +   (class? x) x
  199.89 +   (contains? prim->class x) (prim->class x)
  199.90 +   :else (let [strx (str x)]
  199.91 +           (clojure.lang.RT/classForName 
  199.92 +            (if (some #{\. \[} strx)
  199.93 +              strx
  199.94 +              (str "java.lang." strx))))))
  199.95 +
  199.96 +;; someday this can be made codepoint aware
  199.97 +(defn- valid-java-method-name
  199.98 +  [^String s]
  199.99 +  (= s (clojure.lang.Compiler/munge s)))
 199.100 +
 199.101 +(defn- validate-generate-class-options
 199.102 +  [{:keys [methods]}]
 199.103 +  (let [[mname] (remove valid-java-method-name (map (comp str first) methods))]
 199.104 +    (when mname (throw (IllegalArgumentException. (str "Not a valid method name: " mname))))))
 199.105 +
 199.106 +(defn- generate-class [options-map]
 199.107 +  (validate-generate-class-options options-map)
 199.108 +  (let [default-options {:prefix "-" :load-impl-ns true :impl-ns (ns-name *ns*)}
 199.109 +        {:keys [name extends implements constructors methods main factory state init exposes 
 199.110 +                exposes-methods prefix load-impl-ns impl-ns post-init]} 
 199.111 +          (merge default-options options-map)
 199.112 +        name-meta (meta name)
 199.113 +        name (str name)
 199.114 +        super (if extends (the-class extends) Object)
 199.115 +        interfaces (map the-class implements)
 199.116 +        supers (cons super interfaces)
 199.117 +        ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super)))
 199.118 +        cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))
 199.119 +        cname (. name (replace "." "/"))
 199.120 +        pkg-name name
 199.121 +        impl-pkg-name (str impl-ns)
 199.122 +        impl-cname (.. impl-pkg-name (replace "." "/") (replace \- \_))
 199.123 +        ctype (. Type (getObjectType cname))
 199.124 +        iname (fn [^Class c] (.. Type (getType c) (getInternalName)))
 199.125 +        totype (fn [^Class c] (. Type (getType c)))
 199.126 +        to-types (fn [cs] (if (pos? (count cs))
 199.127 +                            (into-array (map totype cs))
 199.128 +                            (make-array Type 0)))
 199.129 +        obj-type ^Type (totype Object)
 199.130 +        arg-types (fn [n] (if (pos? n)
 199.131 +                            (into-array (replicate n obj-type))
 199.132 +                            (make-array Type 0)))
 199.133 +        super-type ^Type (totype super)
 199.134 +        init-name (str init)
 199.135 +        post-init-name (str post-init)
 199.136 +        factory-name (str factory)
 199.137 +        state-name (str state)
 199.138 +        main-name "main"
 199.139 +        var-name (fn [s] (clojure.lang.Compiler/munge (str s "__var")))
 199.140 +        class-type  (totype Class)
 199.141 +        rt-type  (totype clojure.lang.RT)
 199.142 +        var-type ^Type (totype clojure.lang.Var)
 199.143 +        ifn-type (totype clojure.lang.IFn)
 199.144 +        iseq-type (totype clojure.lang.ISeq)
 199.145 +        ex-type  (totype java.lang.UnsupportedOperationException)
 199.146 +        all-sigs (distinct (concat (map #(let[[m p] (key %)] {m [p]}) (mapcat non-private-methods supers))
 199.147 +                                   (map (fn [[m p]] {(str m) [p]}) methods)))
 199.148 +        sigs-by-name (apply merge-with concat {} all-sigs)
 199.149 +        overloads (into {} (filter (fn [[m s]] (next s)) sigs-by-name))
 199.150 +        var-fields (concat (when init [init-name]) 
 199.151 +                           (when post-init [post-init-name])
 199.152 +                           (when main [main-name])
 199.153 +                           ;(when exposes-methods (map str (vals exposes-methods)))
 199.154 +                           (distinct (concat (keys sigs-by-name)
 199.155 +                                             (mapcat (fn [[m s]] (map #(overload-name m (map the-class %)) s)) overloads)
 199.156 +                                             (mapcat (comp (partial map str) vals val) exposes))))
 199.157 +        emit-get-var (fn [^GeneratorAdapter gen v]
 199.158 +                       (let [false-label (. gen newLabel)
 199.159 +                             end-label (. gen newLabel)]
 199.160 +                         (. gen getStatic ctype (var-name v) var-type)
 199.161 +                         (. gen dup)
 199.162 +                         (. gen invokeVirtual var-type (. Method (getMethod "boolean isBound()")))
 199.163 +                         (. gen ifZCmp (. GeneratorAdapter EQ) false-label)
 199.164 +                         (. gen invokeVirtual var-type (. Method (getMethod "Object get()")))
 199.165 +                         (. gen goTo end-label)
 199.166 +                         (. gen mark false-label)
 199.167 +                         (. gen pop)
 199.168 +                         (. gen visitInsn (. Opcodes ACONST_NULL))
 199.169 +                         (. gen mark end-label)))
 199.170 +        emit-unsupported (fn [^GeneratorAdapter gen ^Method m]
 199.171 +                           (. gen (throwException ex-type (str (. m (getName)) " ("
 199.172 +                                                               impl-pkg-name "/" prefix (.getName m)
 199.173 +                                                               " not defined?)"))))
 199.174 +        emit-forwarding-method
 199.175 +        (fn [name pclasses rclass as-static else-gen]
 199.176 +          (let [mname (str name)
 199.177 +                pmetas (map meta pclasses)
 199.178 +                pclasses (map the-class pclasses)
 199.179 +                rclass (the-class rclass)
 199.180 +                ptypes (to-types pclasses)
 199.181 +                rtype ^Type (totype rclass)
 199.182 +                m (new Method mname rtype ptypes)
 199.183 +                is-overload (seq (overloads mname))
 199.184 +                gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (if as-static (. Opcodes ACC_STATIC) 0)) 
 199.185 +                         m nil nil cv)
 199.186 +                found-label (. gen (newLabel))
 199.187 +                else-label (. gen (newLabel))
 199.188 +                end-label (. gen (newLabel))]
 199.189 +            (add-annotations gen (meta name))
 199.190 +            (dotimes [i (count pmetas)]
 199.191 +              (add-annotations gen (nth pmetas i) i))
 199.192 +            (. gen (visitCode))
 199.193 +            (if (> (count pclasses) 18)
 199.194 +              (else-gen gen m)
 199.195 +              (do
 199.196 +                (when is-overload
 199.197 +                  (emit-get-var gen (overload-name mname pclasses))
 199.198 +                  (. gen (dup))
 199.199 +                  (. gen (ifNonNull found-label))
 199.200 +                  (. gen (pop)))
 199.201 +                (emit-get-var gen mname)
 199.202 +                (. gen (dup))
 199.203 +                (. gen (ifNull else-label))
 199.204 +                (when is-overload
 199.205 +                  (. gen (mark found-label)))
 199.206 +                                        ;if found
 199.207 +                (.checkCast gen ifn-type)
 199.208 +                (when-not as-static
 199.209 +                  (. gen (loadThis)))
 199.210 +                                        ;box args
 199.211 +                (dotimes [i (count ptypes)]
 199.212 +                  (. gen (loadArg i))
 199.213 +                  (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i))))
 199.214 +                                        ;call fn
 199.215 +                (. gen (invokeInterface ifn-type (new Method "invoke" obj-type 
 199.216 +                                                      (to-types (replicate (+ (count ptypes)
 199.217 +                                                                              (if as-static 0 1)) 
 199.218 +                                                                           Object)))))
 199.219 +                                        ;(into-array (cons obj-type 
 199.220 +                                        ;                 (replicate (count ptypes) obj-type))))))
 199.221 +                                        ;unbox return
 199.222 +                (. gen (unbox rtype))
 199.223 +                (when (= (. rtype (getSort)) (. Type VOID))
 199.224 +                  (. gen (pop)))
 199.225 +                (. gen (goTo end-label))
 199.226 +                
 199.227 +                                        ;else call supplied alternative generator
 199.228 +                (. gen (mark else-label))
 199.229 +                (. gen (pop))
 199.230 +                
 199.231 +                (else-gen gen m)
 199.232 +            
 199.233 +                (. gen (mark end-label))))
 199.234 +            (. gen (returnValue))
 199.235 +            (. gen (endMethod))))
 199.236 +        ]
 199.237 +                                        ;start class definition
 199.238 +    (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER))
 199.239 +                 cname nil (iname super)
 199.240 +                 (when-let [ifc (seq interfaces)]
 199.241 +                   (into-array (map iname ifc)))))
 199.242 +
 199.243 +                                        ; class annotations
 199.244 +    (add-annotations cv name-meta)
 199.245 +    
 199.246 +                                        ;static fields for vars
 199.247 +    (doseq [v var-fields]
 199.248 +      (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_FINAL) (. Opcodes ACC_STATIC))
 199.249 +                        (var-name v) 
 199.250 +                        (. var-type getDescriptor)
 199.251 +                        nil nil)))
 199.252 +    
 199.253 +                                        ;instance field for state
 199.254 +    (when state
 199.255 +      (. cv (visitField (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL))
 199.256 +                        state-name 
 199.257 +                        (. obj-type getDescriptor)
 199.258 +                        nil nil)))
 199.259 +    
 199.260 +                                        ;static init to set up var fields and load init
 199.261 +    (let [gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) 
 199.262 +                   (. Method getMethod "void <clinit> ()")
 199.263 +                   nil nil cv)]
 199.264 +      (. gen (visitCode))
 199.265 +      (doseq [v var-fields]
 199.266 +        (. gen push impl-pkg-name)
 199.267 +        (. gen push (str prefix v))
 199.268 +        (. gen (invokeStatic var-type (. Method (getMethod "clojure.lang.Var internPrivate(String,String)"))))
 199.269 +        (. gen putStatic ctype (var-name v) var-type))
 199.270 +      
 199.271 +      (when load-impl-ns
 199.272 +        (. gen push "clojure.core")
 199.273 +        (. gen push "load")
 199.274 +        (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.Var var(String,String)"))))
 199.275 +        (. gen push (str "/" impl-cname))
 199.276 +        (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (to-types [Object]))))
 199.277 +;        (. gen push (str (.replace impl-pkg-name \- \_) "__init"))
 199.278 +;        (. gen (invokeStatic class-type (. Method (getMethod "Class forName(String)"))))
 199.279 +        (. gen pop))
 199.280 +
 199.281 +      (. gen (returnValue))
 199.282 +      (. gen (endMethod)))
 199.283 +    
 199.284 +                                        ;ctors
 199.285 +    (doseq [[pclasses super-pclasses] ctor-sig-map]
 199.286 +      (let [pclasses (map the-class pclasses)
 199.287 +            super-pclasses (map the-class super-pclasses)
 199.288 +            ptypes (to-types pclasses)
 199.289 +            super-ptypes (to-types super-pclasses)
 199.290 +            m (new Method "<init>" (. Type VOID_TYPE) ptypes)
 199.291 +            super-m (new Method "<init>" (. Type VOID_TYPE) super-ptypes)
 199.292 +            gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)
 199.293 +            no-init-label (. gen newLabel)
 199.294 +            end-label (. gen newLabel)
 199.295 +            no-post-init-label (. gen newLabel)
 199.296 +            end-post-init-label (. gen newLabel)
 199.297 +            nth-method (. Method (getMethod "Object nth(Object,int)"))
 199.298 +            local (. gen newLocal obj-type)]
 199.299 +        (. gen (visitCode))
 199.300 +        
 199.301 +        (if init
 199.302 +          (do
 199.303 +            (emit-get-var gen init-name)
 199.304 +            (. gen dup)
 199.305 +            (. gen ifNull no-init-label)
 199.306 +            (.checkCast gen ifn-type)
 199.307 +                                        ;box init args
 199.308 +            (dotimes [i (count pclasses)]
 199.309 +              (. gen (loadArg i))
 199.310 +              (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i))))
 199.311 +                                        ;call init fn
 199.312 +            (. gen (invokeInterface ifn-type (new Method "invoke" obj-type 
 199.313 +                                                  (arg-types (count ptypes)))))
 199.314 +                                        ;expecting [[super-ctor-args] state] returned
 199.315 +            (. gen dup)
 199.316 +            (. gen push 0)
 199.317 +            (. gen (invokeStatic rt-type nth-method))
 199.318 +            (. gen storeLocal local)
 199.319 +            
 199.320 +            (. gen (loadThis))
 199.321 +            (. gen dupX1)
 199.322 +            (dotimes [i (count super-pclasses)]
 199.323 +              (. gen loadLocal local)
 199.324 +              (. gen push i)
 199.325 +              (. gen (invokeStatic rt-type nth-method))
 199.326 +              (. clojure.lang.Compiler$HostExpr (emitUnboxArg nil gen (nth super-pclasses i))))
 199.327 +            (. gen (invokeConstructor super-type super-m))
 199.328 +            
 199.329 +            (if state
 199.330 +              (do
 199.331 +                (. gen push 1)
 199.332 +                (. gen (invokeStatic rt-type nth-method))
 199.333 +                (. gen (putField ctype state-name obj-type)))
 199.334 +              (. gen pop))
 199.335 +            
 199.336 +            (. gen goTo end-label)
 199.337 +                                        ;no init found
 199.338 +            (. gen mark no-init-label)
 199.339 +            (. gen (throwException ex-type (str impl-pkg-name "/" prefix init-name " not defined")))
 199.340 +            (. gen mark end-label))
 199.341 +          (if (= pclasses super-pclasses)
 199.342 +            (do
 199.343 +              (. gen (loadThis))
 199.344 +              (. gen (loadArgs))
 199.345 +              (. gen (invokeConstructor super-type super-m)))
 199.346 +            (throw (new Exception ":init not specified, but ctor and super ctor args differ"))))
 199.347 +
 199.348 +        (when post-init
 199.349 +          (emit-get-var gen post-init-name)
 199.350 +          (. gen dup)
 199.351 +          (. gen ifNull no-post-init-label)
 199.352 +          (.checkCast gen ifn-type)
 199.353 +          (. gen (loadThis))
 199.354 +                                       ;box init args
 199.355 +          (dotimes [i (count pclasses)]
 199.356 +            (. gen (loadArg i))
 199.357 +            (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i))))
 199.358 +                                       ;call init fn
 199.359 +          (. gen (invokeInterface ifn-type (new Method "invoke" obj-type 
 199.360 +                                                (arg-types (inc (count ptypes))))))
 199.361 +          (. gen pop)
 199.362 +          (. gen goTo end-post-init-label)
 199.363 +                                       ;no init found
 199.364 +          (. gen mark no-post-init-label)
 199.365 +          (. gen (throwException ex-type (str impl-pkg-name "/" prefix post-init-name " not defined")))
 199.366 +          (. gen mark end-post-init-label))
 199.367 +
 199.368 +        (. gen (returnValue))
 199.369 +        (. gen (endMethod))
 199.370 +                                        ;factory
 199.371 +        (when factory
 199.372 +          (let [fm (new Method factory-name ctype ptypes)
 199.373 +                gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) 
 199.374 +                         fm nil nil cv)]
 199.375 +            (. gen (visitCode))
 199.376 +            (. gen newInstance ctype)
 199.377 +            (. gen dup)
 199.378 +            (. gen (loadArgs))
 199.379 +            (. gen (invokeConstructor ctype m))            
 199.380 +            (. gen (returnValue))
 199.381 +            (. gen (endMethod))))))
 199.382 +    
 199.383 +                                        ;add methods matching supers', if no fn -> call super
 199.384 +    (let [mm (non-private-methods super)]
 199.385 +      (doseq [^java.lang.reflect.Method meth (vals mm)]
 199.386 +             (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) false
 199.387 +                                     (fn [^GeneratorAdapter gen ^Method m]
 199.388 +                                       (. gen (loadThis))
 199.389 +                                        ;push args
 199.390 +                                       (. gen (loadArgs))
 199.391 +                                        ;call super
 199.392 +                                       (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) 
 199.393 +                                                               (. super-type (getInternalName))
 199.394 +                                                               (. m (getName))
 199.395 +                                                               (. m (getDescriptor)))))))
 199.396 +                                        ;add methods matching interfaces', if no fn -> throw
 199.397 +      (reduce (fn [mm ^java.lang.reflect.Method meth]
 199.398 +                (if (contains? mm (method-sig meth))
 199.399 +                  mm
 199.400 +                  (do
 199.401 +                    (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) false
 199.402 +                                            emit-unsupported)
 199.403 +                    (assoc mm (method-sig meth) meth))))
 199.404 +              mm (mapcat #(.getMethods ^Class %) interfaces))
 199.405 +                                        ;extra methods
 199.406 +       (doseq [[mname pclasses rclass :as msig] methods]
 199.407 +         (emit-forwarding-method mname pclasses rclass (:static (meta msig))
 199.408 +                                 emit-unsupported))
 199.409 +                                        ;expose specified overridden superclass methods
 199.410 +       (doseq [[local-mname ^java.lang.reflect.Method m] (reduce (fn [ms [[name _ _] m]]
 199.411 +                              (if (contains? exposes-methods (symbol name))
 199.412 +                                (conj ms [((symbol name) exposes-methods) m])
 199.413 +                                ms)) [] (seq mm))]
 199.414 +         (let [ptypes (to-types (.getParameterTypes m))
 199.415 +               rtype (totype (.getReturnType m))
 199.416 +               exposer-m (new Method (str local-mname) rtype ptypes)
 199.417 +               target-m (new Method (.getName m) rtype ptypes)
 199.418 +               gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) exposer-m nil nil cv)]
 199.419 +           (. gen (loadThis))
 199.420 +           (. gen (loadArgs))
 199.421 +           (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) 
 199.422 +                                   (. super-type (getInternalName))
 199.423 +                                   (. target-m (getName))
 199.424 +                                   (. target-m (getDescriptor))))
 199.425 +           (. gen (returnValue))
 199.426 +           (. gen (endMethod)))))
 199.427 +                                        ;main
 199.428 +    (when main
 199.429 +      (let [m (. Method getMethod "void main (String[])")
 199.430 +            gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) 
 199.431 +                     m nil nil cv)
 199.432 +            no-main-label (. gen newLabel)
 199.433 +            end-label (. gen newLabel)]
 199.434 +        (. gen (visitCode))
 199.435 +
 199.436 +        (emit-get-var gen main-name)
 199.437 +        (. gen dup)
 199.438 +        (. gen ifNull no-main-label)
 199.439 +        (.checkCast gen ifn-type)
 199.440 +        (. gen loadArgs)
 199.441 +        (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.ISeq seq(Object)"))))
 199.442 +        (. gen (invokeInterface ifn-type (new Method "applyTo" obj-type 
 199.443 +                                              (into-array [iseq-type]))))
 199.444 +        (. gen pop)
 199.445 +        (. gen goTo end-label)
 199.446 +                                        ;no main found
 199.447 +        (. gen mark no-main-label)
 199.448 +        (. gen (throwException ex-type (str impl-pkg-name "/" prefix main-name " not defined")))
 199.449 +        (. gen mark end-label)
 199.450 +        (. gen (returnValue))
 199.451 +        (. gen (endMethod))))
 199.452 +                                        ;field exposers
 199.453 +    (doseq [[f {getter :get setter :set}] exposes]
 199.454 +      (let [fld (find-field super (str f))
 199.455 +            ftype (totype (.getType fld))
 199.456 +            static? (Modifier/isStatic (.getModifiers fld))
 199.457 +            acc (+ Opcodes/ACC_PUBLIC (if static? Opcodes/ACC_STATIC 0))]
 199.458 +        (when getter
 199.459 +          (let [m (new Method (str getter) ftype (to-types []))
 199.460 +                gen (new GeneratorAdapter acc m nil nil cv)]
 199.461 +            (. gen (visitCode))
 199.462 +            (if static?
 199.463 +              (. gen getStatic ctype (str f) ftype)
 199.464 +              (do
 199.465 +                (. gen loadThis)
 199.466 +                (. gen getField ctype (str f) ftype)))
 199.467 +            (. gen (returnValue))
 199.468 +            (. gen (endMethod))))
 199.469 +        (when setter
 199.470 +          (let [m (new Method (str setter) Type/VOID_TYPE (into-array [ftype]))
 199.471 +                gen (new GeneratorAdapter acc m nil nil cv)]
 199.472 +            (. gen (visitCode))
 199.473 +            (if static?
 199.474 +              (do
 199.475 +                (. gen loadArgs)
 199.476 +                (. gen putStatic ctype (str f) ftype))
 199.477 +              (do
 199.478 +                (. gen loadThis)
 199.479 +                (. gen loadArgs)
 199.480 +                (. gen putField ctype (str f) ftype)))
 199.481 +            (. gen (returnValue))
 199.482 +            (. gen (endMethod))))))
 199.483 +                                        ;finish class def
 199.484 +    (. cv (visitEnd))
 199.485 +    [cname (. cv (toByteArray))]))
 199.486 +
 199.487 +(defmacro gen-class 
 199.488 +  "When compiling, generates compiled bytecode for a class with the
 199.489 +  given package-qualified :name (which, as all names in these
 199.490 +  parameters, can be a string or symbol), and writes the .class file
 199.491 +  to the *compile-path* directory.  When not compiling, does
 199.492 +  nothing. The gen-class construct contains no implementation, as the
 199.493 +  implementation will be dynamically sought by the generated class in
 199.494 +  functions in an implementing Clojure namespace. Given a generated
 199.495 +  class org.mydomain.MyClass with a method named mymethod, gen-class
 199.496 +  will generate an implementation that looks for a function named by 
 199.497 +  (str prefix mymethod) (default prefix: \"-\") in a
 199.498 +  Clojure namespace specified by :impl-ns
 199.499 +  (defaults to the current namespace). All inherited methods,
 199.500 +  generated methods, and init and main functions (see :methods, :init,
 199.501 +  and :main below) will be found similarly prefixed. By default, the
 199.502 +  static initializer for the generated class will attempt to load the
 199.503 +  Clojure support code for the class as a resource from the classpath,
 199.504 +  e.g. in the example case, ``org/mydomain/MyClass__init.class``. This
 199.505 +  behavior can be controlled by :load-impl-ns
 199.506 +
 199.507 +  Note that methods with a maximum of 18 parameters are supported.
 199.508 +
 199.509 +  In all subsequent sections taking types, the primitive types can be
 199.510 +  referred to by their Java names (int, float etc), and classes in the
 199.511 +  java.lang package can be used without a package qualifier. All other
 199.512 +  classes must be fully qualified.
 199.513 +
 199.514 +  Options should be a set of key/value pairs, all except for :name are optional:
 199.515 +
 199.516 +  :name aname
 199.517 +
 199.518 +  The package-qualified name of the class to be generated
 199.519 +
 199.520 +  :extends aclass
 199.521 +
 199.522 +  Specifies the superclass, the non-private methods of which will be
 199.523 +  overridden by the class. If not provided, defaults to Object.
 199.524 +
 199.525 +  :implements [interface ...]
 199.526 +
 199.527 +  One or more interfaces, the methods of which will be implemented by the class.
 199.528 +
 199.529 +  :init name
 199.530 +
 199.531 +  If supplied, names a function that will be called with the arguments
 199.532 +  to the constructor. Must return [ [superclass-constructor-args] state] 
 199.533 +  If not supplied, the constructor args are passed directly to
 199.534 +  the superclass constructor and the state will be nil
 199.535 +
 199.536 +  :constructors {[param-types] [super-param-types], ...}
 199.537 +
 199.538 +  By default, constructors are created for the generated class which
 199.539 +  match the signature(s) of the constructors for the superclass. This
 199.540 +  parameter may be used to explicitly specify constructors, each entry
 199.541 +  providing a mapping from a constructor signature to a superclass
 199.542 +  constructor signature. When you supply this, you must supply an :init
 199.543 +  specifier. 
 199.544 +
 199.545 +  :post-init name
 199.546 +
 199.547 +  If supplied, names a function that will be called with the object as
 199.548 +  the first argument, followed by the arguments to the constructor.
 199.549 +  It will be called every time an object of this class is created,
 199.550 +  immediately after all the inherited constructors have completed.
 199.551 +  It's return value is ignored.
 199.552 +
 199.553 +  :methods [ [name [param-types] return-type], ...]
 199.554 +
 199.555 +  The generated class automatically defines all of the non-private
 199.556 +  methods of its superclasses/interfaces. This parameter can be used
 199.557 +  to specify the signatures of additional methods of the generated
 199.558 +  class. Static methods can be specified with ^{:static true} in the
 199.559 +  signature's metadata. Do not repeat superclass/interface signatures
 199.560 +  here.
 199.561 +
 199.562 +  :main boolean
 199.563 +
 199.564 +  If supplied and true, a static public main function will be generated. It will
 199.565 +  pass each string of the String[] argument as a separate argument to
 199.566 +  a function called (str prefix main).
 199.567 +
 199.568 +  :factory name
 199.569 +
 199.570 +  If supplied, a (set of) public static factory function(s) will be
 199.571 +  created with the given name, and the same signature(s) as the
 199.572 +  constructor(s).
 199.573 +  
 199.574 +  :state name
 199.575 +
 199.576 +  If supplied, a public final instance field with the given name will be
 199.577 +  created. You must supply an :init function in order to provide a
 199.578 +  value for the state. Note that, though final, the state can be a ref
 199.579 +  or agent, supporting the creation of Java objects with transactional
 199.580 +  or asynchronous mutation semantics.
 199.581 +
 199.582 +  :exposes {protected-field-name {:get name :set name}, ...}
 199.583 +
 199.584 +  Since the implementations of the methods of the generated class
 199.585 +  occur in Clojure functions, they have no access to the inherited
 199.586 +  protected fields of the superclass. This parameter can be used to
 199.587 +  generate public getter/setter methods exposing the protected field(s)
 199.588 +  for use in the implementation.
 199.589 +
 199.590 +  :exposes-methods {super-method-name exposed-name, ...}
 199.591 +
 199.592 +  It is sometimes necessary to call the superclass' implementation of an
 199.593 +  overridden method.  Those methods may be exposed and referred in 
 199.594 +  the new method implementation by a local name.
 199.595 +
 199.596 +  :prefix string
 199.597 +
 199.598 +  Default: \"-\" Methods called e.g. Foo will be looked up in vars called
 199.599 +  prefixFoo in the implementing ns.
 199.600 +
 199.601 +  :impl-ns name
 199.602 +
 199.603 +  Default: the name of the current ns. Implementations of methods will be 
 199.604 +  looked up in this namespace.
 199.605 +
 199.606 +  :load-impl-ns boolean
 199.607 +
 199.608 +  Default: true. Causes the static initializer for the generated class
 199.609 +  to reference the load code for the implementing namespace. Should be
 199.610 +  true when implementing-ns is the default, false if you intend to
 199.611 +  load the code via some other method."
 199.612 +  {:added "1.0"}
 199.613 +  
 199.614 +  [& options]
 199.615 +    (when *compile-files*
 199.616 +      (let [options-map (into {} (map vec (partition 2 options)))
 199.617 +            [cname bytecode] (generate-class options-map)]
 199.618 +        (clojure.lang.Compiler/writeClassFile cname bytecode))))
 199.619 +
 199.620 +;;;;;;;;;;;;;;;;;;;; gen-interface ;;;;;;;;;;;;;;;;;;;;;;
 199.621 +;; based on original contribution by Chris Houser
 199.622 +
 199.623 +(defn- ^Type asm-type
 199.624 +  "Returns an asm Type object for c, which may be a primitive class
 199.625 +  (such as Integer/TYPE), any other class (such as Double), or a
 199.626 +  fully-qualified class name given as a string or symbol
 199.627 +  (such as 'java.lang.String)"
 199.628 +  [c]
 199.629 +  (if (or (instance? Class c) (prim->class c))
 199.630 +    (Type/getType (the-class c))
 199.631 +    (let [strx (str c)]
 199.632 +      (Type/getObjectType 
 199.633 +       (.replace (if (some #{\.} strx)
 199.634 +                   strx
 199.635 +                   (str "java.lang." strx)) 
 199.636 +                 "." "/")))))
 199.637 +
 199.638 +(defn- generate-interface
 199.639 +  [{:keys [name extends methods]}]
 199.640 +  (let [iname (.replace (str name) "." "/")
 199.641 +        cv (ClassWriter. ClassWriter/COMPUTE_MAXS)]
 199.642 +    (. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC 
 199.643 +                                Opcodes/ACC_ABSTRACT
 199.644 +                                Opcodes/ACC_INTERFACE)
 199.645 +       iname nil "java/lang/Object"
 199.646 +       (when (seq extends)
 199.647 +         (into-array (map #(.getInternalName (asm-type %)) extends))))
 199.648 +    (add-annotations cv (meta name))
 199.649 +    (doseq [[mname pclasses rclass pmetas] methods]
 199.650 +      (let [mv (. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT)
 199.651 +                  (str mname)
 199.652 +                  (Type/getMethodDescriptor (asm-type rclass) 
 199.653 +                                            (if pclasses
 199.654 +                                              (into-array Type (map asm-type pclasses))
 199.655 +                                              (make-array Type 0)))
 199.656 +                  nil nil)]
 199.657 +        (add-annotations mv (meta mname))
 199.658 +        (dotimes [i (count pmetas)]
 199.659 +          (add-annotations mv (nth pmetas i) i))
 199.660 +        (. mv visitEnd)))
 199.661 +    (. cv visitEnd)
 199.662 +    [iname (. cv toByteArray)]))
 199.663 +
 199.664 +(defmacro gen-interface
 199.665 +  "When compiling, generates compiled bytecode for an interface with
 199.666 +  the given package-qualified :name (which, as all names in these
 199.667 +  parameters, can be a string or symbol), and writes the .class file
 199.668 +  to the *compile-path* directory.  When not compiling, does nothing.
 199.669 + 
 199.670 +  In all subsequent sections taking types, the primitive types can be
 199.671 +  referred to by their Java names (int, float etc), and classes in the
 199.672 +  java.lang package can be used without a package qualifier. All other
 199.673 +  classes must be fully qualified.
 199.674 + 
 199.675 +  Options should be a set of key/value pairs, all except for :name are
 199.676 +  optional:
 199.677 +
 199.678 +  :name aname
 199.679 +
 199.680 +  The package-qualified name of the class to be generated
 199.681 +
 199.682 +  :extends [interface ...]
 199.683 +
 199.684 +  One or more interfaces, which will be extended by this interface.
 199.685 +
 199.686 +  :methods [ [name [param-types] return-type], ...]
 199.687 +
 199.688 +  This parameter is used to specify the signatures of the methods of
 199.689 +  the generated interface.  Do not repeat superinterface signatures
 199.690 +  here."
 199.691 +  {:added "1.0"}
 199.692 +
 199.693 +  [& options]
 199.694 +    (let [options-map (apply hash-map options)
 199.695 +          [cname bytecode] (generate-interface options-map)]
 199.696 +      (if *compile-files*
 199.697 +        (clojure.lang.Compiler/writeClassFile cname bytecode)
 199.698 +        (.defineClass ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) 
 199.699 +                      (str (:name options-map)) bytecode options)))) 
 199.700 +
 199.701 +(comment
 199.702 +
 199.703 +(defn gen-and-load-class 
 199.704 +  "Generates and immediately loads the bytecode for the specified
 199.705 +  class. Note that a class generated this way can be loaded only once
 199.706 +  - the JVM supports only one class with a given name per
 199.707 +  classloader. Subsequent to generation you can import it into any
 199.708 +  desired namespaces just like any other class. See gen-class for a
 199.709 +  description of the options."
 199.710 +  {:added "1.0"}
 199.711 +
 199.712 +  [& options]
 199.713 +  (let [options-map (apply hash-map options)
 199.714 +        [cname bytecode] (generate-class options-map)]
 199.715 +    (.. (clojure.lang.RT/getRootClassLoader) (defineClass cname bytecode options))))
 199.716 +
 199.717 +)
   200.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   200.2 +++ b/src/clojure/gvec.clj	Sat Aug 21 06:25:44 2010 -0400
   200.3 @@ -0,0 +1,460 @@
   200.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   200.5 +;   The use and distribution terms for this software are covered by the
   200.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   200.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   200.8 +;   By using this software in any fashion, you are agreeing to be bound by
   200.9 +;   the terms of this license.
  200.10 +;   You must not remove this notice, or any other, from this software.
  200.11 +
  200.12 +;;; a generic vector implementation for vectors of primitives
  200.13 +
  200.14 +(in-ns 'clojure.core)
  200.15 +
  200.16 +;(set! *warn-on-reflection* true)
  200.17 +
  200.18 +(deftype VecNode [edit arr])
  200.19 +
  200.20 +(def EMPTY-NODE (VecNode. nil (object-array 32)))
  200.21 +
  200.22 +(definterface IVecImpl
  200.23 +  (^int tailoff [])
  200.24 +  (arrayFor [^int i])
  200.25 +  (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode])
  200.26 +  (popTail [^int level node])
  200.27 +  (newPath [edit ^int level node])
  200.28 +  (doAssoc [^int level node ^int i val]))
  200.29 +
  200.30 +(definterface ArrayManager
  200.31 +  (array [^int size])
  200.32 +  (^int alength [arr])
  200.33 +  (aclone [arr])
  200.34 +  (aget [arr ^int i])
  200.35 +  (aset [arr ^int i val]))
  200.36 +
  200.37 +(deftype ArrayChunk [^clojure.core.ArrayManager am arr ^int off ^int end]
  200.38 +  
  200.39 +  clojure.lang.Indexed
  200.40 +  (nth [_ i] (.aget am arr (+ off i)))
  200.41 +  
  200.42 +  (count [_] (- end off))
  200.43 +
  200.44 +  clojure.lang.IChunk
  200.45 +  (dropFirst [_]
  200.46 +    (if (= off end)
  200.47 +      (throw (IllegalStateException. "dropFirst of empty chunk"))
  200.48 +      (new ArrayChunk am arr (inc off) end)))
  200.49 +  
  200.50 +  (reduce [_ f init]
  200.51 +    (loop [ret init i off]
  200.52 +      (if (< i end)
  200.53 +        (recur (f ret (.aget am arr i)) (inc i))
  200.54 +        ret)))
  200.55 +  )
  200.56 +
  200.57 +(deftype VecSeq [^clojure.core.ArrayManager am ^clojure.core.IVecImpl vec anode ^int i ^int offset] 
  200.58 +  :no-print true
  200.59 +
  200.60 +  clojure.core.protocols.InternalReduce
  200.61 +  (internal-reduce
  200.62 +   [_ f val]
  200.63 +   (loop [result val
  200.64 +          aidx offset]
  200.65 +     (if (< aidx (count vec))
  200.66 +       (let [node (.arrayFor vec aidx)
  200.67 +             result (loop [result result
  200.68 +                           node-idx (bit-and (int 0x1f) aidx)]
  200.69 +                      (if (< node-idx (.alength am node))
  200.70 +                        (recur (f result (.aget am node node-idx)) (inc node-idx))
  200.71 +                        result))]
  200.72 +         (recur result (bit-and (int 0xffe0) (+ aidx (int 32)))))
  200.73 +       result)))
  200.74 +  
  200.75 +  clojure.lang.ISeq
  200.76 +  (first [_] (.aget am anode offset))
  200.77 +  (next [this] 
  200.78 +    (if (< (inc offset) (.alength am anode))
  200.79 +      (new VecSeq am vec anode i (inc offset))
  200.80 +      (.chunkedNext this)))
  200.81 +  (more [this]
  200.82 +    (let [s (.next this)]
  200.83 +      (or s (clojure.lang.PersistentList/EMPTY))))
  200.84 +  (cons [this o]
  200.85 +    (clojure.lang.Cons. o this))
  200.86 +  (count [this]
  200.87 +    (loop [i 1
  200.88 +           s (next this)]
  200.89 +      (if s
  200.90 +        (if (instance? clojure.lang.Counted s)
  200.91 +          (+ i (.count s))
  200.92 +          (recur (inc i) (next s)))
  200.93 +        i)))
  200.94 +  (equiv [this o]
  200.95 +    (cond
  200.96 +     (identical? this o) true
  200.97 +     (or (instance? clojure.lang.Sequential o) (instance? java.util.List o))
  200.98 +     (loop [me this
  200.99 +            you (seq o)]
 200.100 +       (if (nil? me)
 200.101 +         (nil? you)
 200.102 +         (and (clojure.lang.Util/equiv (first me) (first you))
 200.103 +              (recur (next me) (next you)))))
 200.104 +     :else false))
 200.105 +  (empty [_]
 200.106 +    clojure.lang.PersistentList/EMPTY)
 200.107 +
 200.108 +
 200.109 +  clojure.lang.Seqable
 200.110 +  (seq [this] this)
 200.111 +
 200.112 +  clojure.lang.IChunkedSeq
 200.113 +  (chunkedFirst [_] (ArrayChunk. am anode offset (.alength am anode)))
 200.114 +  (chunkedNext [_] 
 200.115 +   (let [nexti (+ i (.alength am anode))]
 200.116 +     (when (< nexti (count vec))
 200.117 +       (new VecSeq am vec (.arrayFor vec nexti) nexti 0))))
 200.118 +  (chunkedMore [this]
 200.119 +    (let [s (.chunkedNext this)]
 200.120 +      (or s (clojure.lang.PersistentList/EMPTY)))))
 200.121 +
 200.122 +(defmethod print-method ::VecSeq [v w]
 200.123 +  ((get (methods print-method) clojure.lang.ISeq) v w))
 200.124 +
 200.125 +(deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta]
 200.126 +  Object
 200.127 +  (equals [this o]
 200.128 +    (cond 
 200.129 +     (identical? this o) true
 200.130 +     (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o))
 200.131 +       (and (= cnt (count o))
 200.132 +            (loop [i (int 0)]
 200.133 +              (cond
 200.134 +               (= i cnt) true
 200.135 +               (.equals (.nth this i) (nth o i)) (recur (inc i))
 200.136 +               :else false)))
 200.137 +     (or (instance? clojure.lang.Sequential o) (instance? java.util.List o))
 200.138 +       (.equals (seq this) (seq o))
 200.139 +     :else false))
 200.140 +
 200.141 +  ;todo - cache
 200.142 +  (hashCode [this]
 200.143 +    (loop [hash (int 1) i (int 0)]
 200.144 +      (if (= i cnt)
 200.145 +        hash
 200.146 +        (let [val (.nth this i)]
 200.147 +          (recur (unchecked-add (unchecked-multiply (int 31) hash) 
 200.148 +                                (clojure.lang.Util/hash val)) 
 200.149 +                 (inc i))))))
 200.150 +
 200.151 +  clojure.lang.Counted
 200.152 +  (count [_] cnt)
 200.153 +
 200.154 +  clojure.lang.IMeta
 200.155 +  (meta [_] _meta)
 200.156 +
 200.157 +  clojure.lang.IObj
 200.158 +  (withMeta [_ m] (new Vec am cnt shift root tail m))
 200.159 +
 200.160 +  clojure.lang.Indexed
 200.161 +  (nth [this i]
 200.162 +    (let [a (.arrayFor this i)]
 200.163 +      (.aget am a (bit-and i (int 0x1f)))))
 200.164 +  (nth [this i not-found]
 200.165 +       (let [z (int 0)]
 200.166 +         (if (and (>= i z) (< i (.count this)))
 200.167 +           (.nth this i)
 200.168 +           not-found)))
 200.169 +
 200.170 +  clojure.lang.IPersistentCollection
 200.171 +  (cons [this val]
 200.172 +     (if (< (- cnt (.tailoff this)) (int 32))
 200.173 +      (let [new-tail (.array am (inc (.alength am tail)))]
 200.174 +        (System/arraycopy tail 0 new-tail 0 (.alength am tail))
 200.175 +        (.aset am new-tail (.alength am tail) val)
 200.176 +        (new Vec am (inc cnt) shift root new-tail (meta this)))
 200.177 +      (let [tail-node (VecNode. (.edit root) tail)] 
 200.178 +        (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root?
 200.179 +          (let [new-root (VecNode. (.edit root) (object-array 32))]
 200.180 +            (doto ^objects (.arr new-root)
 200.181 +              (aset 0 root)
 200.182 +              (aset 1 (.newPath this (.edit root) shift tail-node)))
 200.183 +            (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this)))
 200.184 +          (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) 
 200.185 +                 (let [tl (.array am 1)] (.aset am  tl 0 val) tl) (meta this))))))
 200.186 +
 200.187 +  (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0) nil))                             
 200.188 +  (equiv [this o]
 200.189 +    (cond 
 200.190 +     (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o))
 200.191 +       (and (= cnt (count o))
 200.192 +            (loop [i (int 0)]
 200.193 +              (cond
 200.194 +               (= i cnt) true
 200.195 +               (= (.nth this i) (nth o i)) (recur (inc i))
 200.196 +               :else false)))
 200.197 +     (or (instance? clojure.lang.Sequential o) (instance? java.util.List o))
 200.198 +       (= (seq this) (seq o))
 200.199 +     :else false))
 200.200 +
 200.201 +  clojure.lang.IPersistentStack
 200.202 +  (peek [this]
 200.203 +    (when (> cnt (int 0)) 
 200.204 +      (.nth this (dec cnt))))
 200.205 +
 200.206 +  (pop [this]
 200.207 +   (cond
 200.208 +    (zero? cnt) 
 200.209 +      (throw (IllegalStateException. "Can't pop empty vector"))
 200.210 +    (= 1 cnt) 
 200.211 +      (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this))
 200.212 +    (> (- cnt (.tailoff this)) 1)
 200.213 +      (let [new-tail (.array am (dec (.alength am tail)))]
 200.214 +        (System/arraycopy tail 0 new-tail 0 (.alength am new-tail))
 200.215 +        (new Vec am (dec cnt) shift root new-tail (meta this)))
 200.216 +    :else
 200.217 +      (let [new-tail (.arrayFor this (- cnt 2))
 200.218 +            new-root ^clojure.core.VecNode (.popTail this shift root)]
 200.219 +        (cond
 200.220 +         (nil? new-root) 
 200.221 +           (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this))
 200.222 +         (and (> shift 5) (nil? (aget ^objects (.arr new-root) 1)))
 200.223 +           (new Vec am (dec cnt) (- shift 5) (aget ^objects (.arr new-root) 0) new-tail (meta this))
 200.224 +         :else
 200.225 +           (new Vec am (dec cnt) shift new-root new-tail (meta this))))))
 200.226 +
 200.227 +  clojure.lang.IPersistentVector
 200.228 +  (assocN [this i val]
 200.229 +    (cond 
 200.230 +     (and (<= (int 0) i) (< i cnt))
 200.231 +       (if (>= i (.tailoff this))
 200.232 +         (let [new-tail (.array am (.alength am tail))]
 200.233 +           (System/arraycopy tail 0 new-tail 0 (.alength am tail))
 200.234 +           (.aset am new-tail (bit-and i (int 0x1f)) val)
 200.235 +           (new Vec am cnt shift root new-tail (meta this)))
 200.236 +         (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this)))
 200.237 +     (= i cnt) (.cons this val)
 200.238 +     :else (throw (IndexOutOfBoundsException.))))
 200.239 +  
 200.240 +  clojure.lang.Reversible
 200.241 +  (rseq [this]
 200.242 +        (if (> (.count this) 0)
 200.243 +          (clojure.lang.APersistentVector$RSeq. this (dec (.count this)))
 200.244 +          nil))
 200.245 +  
 200.246 +  clojure.lang.Associative
 200.247 +  (assoc [this k v]
 200.248 +    (if (clojure.lang.Util/isInteger k)
 200.249 +      (.assocN this k v)
 200.250 +      (throw (IllegalArgumentException. "Key must be integer"))))
 200.251 +  (containsKey [this k]
 200.252 +    (and (clojure.lang.Util/isInteger k)
 200.253 +         (<= 0 (int k))
 200.254 +         (< (int k) cnt)))
 200.255 +  (entryAt [this k]
 200.256 +    (if (.containsKey this k)
 200.257 +      (clojure.lang.MapEntry. k (.nth this (int k)))
 200.258 +      nil))
 200.259 +
 200.260 +  clojure.lang.ILookup
 200.261 +  (valAt [this k not-found]
 200.262 +    (if (clojure.lang.Util/isInteger k)
 200.263 +      (let [i (int k)]
 200.264 +        (if (and (>= i 0) (< i cnt))
 200.265 +          (.nth this i)
 200.266 +          not-found))
 200.267 +      not-found))
 200.268 +
 200.269 +  (valAt [this k] (.valAt this k nil))
 200.270 +
 200.271 +  clojure.lang.IFn
 200.272 +  (invoke [this k]
 200.273 +    (if (clojure.lang.Util/isInteger k)
 200.274 +      (let [i (int k)]
 200.275 +        (if (and (>= i 0) (< i cnt))
 200.276 +          (.nth this i)
 200.277 +          (throw (IndexOutOfBoundsException.))))
 200.278 +      (throw (IllegalArgumentException. "Key must be integer"))))
 200.279 +
 200.280 +  
 200.281 +  clojure.lang.Seqable
 200.282 +  (seq [this] 
 200.283 +    (if (zero? cnt) 
 200.284 +      nil
 200.285 +      (VecSeq. am this (.arrayFor this 0) 0 0)))
 200.286 +
 200.287 +  clojure.lang.Sequential ;marker, no methods
 200.288 +
 200.289 +  clojure.core.IVecImpl
 200.290 +  (tailoff [_] 
 200.291 +    (- cnt (.alength am tail)))
 200.292 +
 200.293 +  (arrayFor [this i]
 200.294 +    (if (and  (<= (int 0) i) (< i cnt))
 200.295 +      (if (>= i (.tailoff this))
 200.296 +        tail
 200.297 +        (loop [node root level shift]
 200.298 +          (if (zero? level)
 200.299 +            (.arr node)
 200.300 +            (recur (aget ^objects (.arr node) (bit-and (bit-shift-right i level) (int 0x1f))) 
 200.301 +                   (- level (int 5))))))
 200.302 +      (throw (IndexOutOfBoundsException.))))
 200.303 +
 200.304 +  (pushTail [this level parent tailnode]
 200.305 +    (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f))
 200.306 +          parent ^clojure.core.VecNode parent
 200.307 +          ret (VecNode. (.edit parent) (aclone ^objects (.arr parent)))
 200.308 +          node-to-insert (if (= level (int 5))
 200.309 +                           tailnode
 200.310 +                           (let [child (aget ^objects (.arr parent) subidx)]
 200.311 +                             (if child
 200.312 +                               (.pushTail this (- level (int 5)) child tailnode)
 200.313 +                               (.newPath this (.edit root) (- level (int 5)) tailnode))))]
 200.314 +      (aset ^objects (.arr ret) subidx node-to-insert)
 200.315 +      ret))
 200.316 +
 200.317 +  (popTail [this level node]
 200.318 +    (let [node ^clojure.core.VecNode node
 200.319 +          subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))]
 200.320 +      (cond
 200.321 +       (> level 5) 
 200.322 +         (let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))]
 200.323 +           (if (and (nil? new-child) (zero? subidx))
 200.324 +             nil
 200.325 +             (let [arr (aclone ^objects (.arr node))]
 200.326 +               (aset arr subidx new-child)
 200.327 +               (VecNode. (.edit root) arr))))
 200.328 +       (zero? subidx) nil
 200.329 +       :else (let [arr (aclone ^objects (.arr node))]
 200.330 +               (aset arr subidx nil)
 200.331 +               (VecNode. (.edit root) arr)))))
 200.332 +
 200.333 +  (newPath [this edit ^int level node]
 200.334 +    (if (zero? level)
 200.335 +      node
 200.336 +      (let [ret (VecNode. edit (object-array 32))]
 200.337 +        (aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node))
 200.338 +        ret)))
 200.339 +
 200.340 +  (doAssoc [this level node i val]
 200.341 +    (let [node ^clojure.core.VecNode node]       
 200.342 +      (if (zero? level)
 200.343 +        ;on this branch, array will need val type
 200.344 +        (let [arr (.aclone am (.arr node))]
 200.345 +          (.aset am arr (bit-and i (int 0x1f)) val)
 200.346 +          (VecNode. (.edit node) arr))
 200.347 +        (let [arr (aclone ^objects (.arr node))
 200.348 +              subidx (bit-and (bit-shift-right i level) (int 0x1f))]
 200.349 +          (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val))
 200.350 +          (VecNode. (.edit node) arr)))))
 200.351 +
 200.352 +  java.lang.Comparable
 200.353 +  (compareTo [this o]
 200.354 +    (if (identical? this o)
 200.355 +      0
 200.356 +      (let [#^clojure.lang.IPersistentVector v (cast clojure.lang.IPersistentVector o)
 200.357 +            vcnt (.count v)]
 200.358 +        (cond
 200.359 +          (< cnt vcnt) -1
 200.360 +          (> cnt vcnt) 1
 200.361 +          :else
 200.362 +            (loop [i (int 0)]
 200.363 +              (if (= i cnt)
 200.364 +                0
 200.365 +                (let [comp (clojure.lang.Util/compare (.nth this i) (.nth v i))]
 200.366 +                  (if (= 0 comp)
 200.367 +                    (recur (inc i))
 200.368 +                    comp))))))))
 200.369 +
 200.370 +  java.lang.Iterable
 200.371 +  (iterator [this]
 200.372 +    (let [i (java.util.concurrent.atomic.AtomicInteger. 0)]
 200.373 +      (reify java.util.Iterator
 200.374 +        (hasNext [_] (< (.get i) cnt))
 200.375 +        (next [_] (.nth this (dec (.incrementAndGet i))))
 200.376 +        (remove [_] (throw (UnsupportedOperationException.))))))
 200.377 +
 200.378 +  java.util.Collection
 200.379 +  (contains [this o] (boolean (some #(= % o) this)))
 200.380 +  (containsAll [this c] (every? #(.contains this %) c))
 200.381 +  (isEmpty [_] (zero? cnt))
 200.382 +  (toArray [this] (into-array Object this))
 200.383 +  (toArray [this arr]
 200.384 +    (if (>= (count arr) cnt)
 200.385 +      (do
 200.386 +        (dotimes [i cnt]
 200.387 +          (aset arr i (.nth this i)))
 200.388 +        arr)
 200.389 +      (into-array Object this)))
 200.390 +  (size [_] cnt)
 200.391 +  (add [_ o] (throw (UnsupportedOperationException.)))
 200.392 +  (addAll [_ c] (throw (UnsupportedOperationException.)))
 200.393 +  (clear [_] (throw (UnsupportedOperationException.)))
 200.394 +  (^boolean remove [_ o] (throw (UnsupportedOperationException.)))
 200.395 +  (removeAll [_ c] (throw (UnsupportedOperationException.)))
 200.396 +  (retainAll [_ c] (throw (UnsupportedOperationException.)))
 200.397 +
 200.398 +  java.util.List
 200.399 +  (get [this i] (.nth this i))
 200.400 +  (indexOf [this o]
 200.401 +    (loop [i (int 0)]
 200.402 +      (cond
 200.403 +        (== i cnt) -1
 200.404 +        (= o (.nth this i)) i
 200.405 +        :else (recur (inc i)))))
 200.406 +  (lastIndexOf [this o]
 200.407 +    (loop [i (dec cnt)]
 200.408 +      (cond
 200.409 +        (< i 0) -1
 200.410 +        (= o (.nth this i)) i
 200.411 +        :else (recur (dec i)))))
 200.412 +  (listIterator [this] (.listIterator this 0))
 200.413 +  (listIterator [this i]
 200.414 +    (let [i (java.util.concurrent.atomic.AtomicInteger. i)]
 200.415 +      (reify java.util.ListIterator
 200.416 +        (hasNext [_] (< (.get i) cnt))
 200.417 +        (hasPrevious [_] (pos? i))
 200.418 +        (next [_] (.nth this (dec (.incrementAndGet i))))
 200.419 +        (nextIndex [_] (.get i))
 200.420 +        (previous [_] (.nth this (.decrementAndGet i)))
 200.421 +        (previousIndex [_] (dec (.get i)))
 200.422 +        (add [_ e] (throw (UnsupportedOperationException.)))
 200.423 +        (remove [_] (throw (UnsupportedOperationException.)))
 200.424 +        (set [_ e] (throw (UnsupportedOperationException.))))))
 200.425 +  (subList [this a z] (subvec this a z))
 200.426 +  (add [_ i o] (throw (UnsupportedOperationException.)))
 200.427 +  (addAll [_ i c] (throw (UnsupportedOperationException.)))
 200.428 +  (^Object remove [_ ^int i] (throw (UnsupportedOperationException.)))
 200.429 +  (set [_ i e] (throw (UnsupportedOperationException.)))
 200.430 +)
 200.431 +
 200.432 +(defmethod print-method ::Vec [v w]
 200.433 +  ((get (methods print-method) clojure.lang.IPersistentVector) v w))
 200.434 +
 200.435 +(defmacro mk-am {:private true} [t]
 200.436 +  (let [garr (gensym)
 200.437 +        tgarr (with-meta garr {:tag (symbol (str t "s"))})]
 200.438 +    `(reify clojure.core.ArrayManager
 200.439 +            (array [_ size#] (~(symbol (str t "-array")) size#))
 200.440 +            (alength [_ ~garr] (alength ~tgarr))
 200.441 +            (aclone [_ ~garr] (aclone ~tgarr))
 200.442 +            (aget [_ ~garr i#] (aget ~tgarr i#))
 200.443 +            (aset [_ ~garr i# val#] (aset ~tgarr i# (~t val#))))))
 200.444 +
 200.445 +(def ^{:private true} ams
 200.446 +     {:int (mk-am int)
 200.447 +      :long (mk-am long)
 200.448 +      :float (mk-am float)
 200.449 +      :double (mk-am double)
 200.450 +      :byte (mk-am byte)
 200.451 +      :short (mk-am short)
 200.452 +      :char (mk-am char)
 200.453 +      :boolean (mk-am boolean)})
 200.454 +
 200.455 +(defn vector-of 
 200.456 +  "Creates a new vector of a single primitive type t, where t is one
 200.457 +  of :int :long :float :double :byte :short :char or :boolean. The
 200.458 +  resulting vector complies with the interface of vectors in general,
 200.459 +  but stores the values unboxed internally."
 200.460 +  {:added "1.2"}
 200.461 +  [t]
 200.462 +  (let [am ^clojure.core.ArrayManager (ams t)]
 200.463 +    (Vec. am 0 5 EMPTY-NODE (.array am 0) nil)))
   201.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   201.2 +++ b/src/clojure/inspector.clj	Sat Aug 21 06:25:44 2010 -0400
   201.3 @@ -0,0 +1,185 @@
   201.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   201.5 +;   The use and distribution terms for this software are covered by the
   201.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   201.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   201.8 +;   By using this software in any fashion, you are agreeing to be bound by
   201.9 +;   the terms of this license.
  201.10 +;   You must not remove this notice, or any other, from this software.
  201.11 +
  201.12 +(ns ^{:doc "Graphical object inspector for Clojure data structures."
  201.13 +       :author "Rich Hickey"}
  201.14 +    clojure.inspector
  201.15 +    (:import
  201.16 +     (java.awt BorderLayout)
  201.17 +     (java.awt.event ActionEvent ActionListener)
  201.18 +     (javax.swing.tree TreeModel)
  201.19 +     (javax.swing.table TableModel AbstractTableModel)
  201.20 +     (javax.swing JPanel JTree JTable JScrollPane JFrame JToolBar JButton SwingUtilities)))
  201.21 +
  201.22 +(defn atom? [x]
  201.23 +  (not (coll? x)))
  201.24 +
  201.25 +(defn collection-tag [x]
  201.26 +  (cond 
  201.27 +   (instance? java.util.Map$Entry x) :entry
  201.28 +   (instance? java.util.Map x) :map
  201.29 +   (sequential? x) :seq
  201.30 +   :else :atom))
  201.31 +
  201.32 +(defmulti is-leaf collection-tag)
  201.33 +(defmulti get-child (fn [parent index] (collection-tag parent)))
  201.34 +(defmulti get-child-count collection-tag)
  201.35 +
  201.36 +(defmethod is-leaf :default [node]
  201.37 +  (atom? node))
  201.38 +(defmethod get-child :default [parent index]
  201.39 +  (nth parent index))
  201.40 +(defmethod get-child-count :default [parent]
  201.41 +  (count parent))
  201.42 +
  201.43 +(defmethod is-leaf :entry [e]
  201.44 +  (is-leaf (val e)))
  201.45 +(defmethod get-child :entry [e index]
  201.46 +  (get-child (val e) index))
  201.47 +(defmethod get-child-count :entry [e]
  201.48 +  (count (val e)))
  201.49 +
  201.50 +(defmethod is-leaf :map [m]
  201.51 +  false)
  201.52 +(defmethod get-child :map [m index]
  201.53 +  (nth (seq m) index))
  201.54 +
  201.55 +(defn tree-model [data]
  201.56 +  (proxy [TreeModel] []
  201.57 +    (getRoot [] data)
  201.58 +    (addTreeModelListener [treeModelListener])
  201.59 +    (getChild [parent index]
  201.60 +      (get-child parent index))
  201.61 +    (getChildCount [parent]
  201.62 +       (get-child-count parent))
  201.63 +    (isLeaf [node]
  201.64 +      (is-leaf node))
  201.65 +    (valueForPathChanged [path newValue])
  201.66 +    (getIndexOfChild [parent child]
  201.67 +      -1)
  201.68 +    (removeTreeModelListener [treeModelListener])))
  201.69 +
  201.70 +
  201.71 +(defn old-table-model [data]
  201.72 +  (let [row1 (first data)
  201.73 +	colcnt (count row1)
  201.74 +	cnt (count data)
  201.75 +	vals (if (map? row1) vals identity)]
  201.76 +    (proxy [TableModel] []
  201.77 +      (addTableModelListener [tableModelListener])
  201.78 +      (getColumnClass [columnIndex] Object)
  201.79 +      (getColumnCount [] colcnt)
  201.80 +      (getColumnName [columnIndex]
  201.81 +	(if (map? row1)
  201.82 +	  (name (nth (keys row1) columnIndex))
  201.83 +	  (str columnIndex)))
  201.84 +      (getRowCount [] cnt)
  201.85 +      (getValueAt [rowIndex columnIndex]
  201.86 +	(nth (vals (nth data rowIndex)) columnIndex))
  201.87 +      (isCellEditable [rowIndex columnIndex] false)
  201.88 +      (removeTableModelListener [tableModelListener]))))
  201.89 +      
  201.90 +(defn inspect-tree 
  201.91 +  "creates a graphical (Swing) inspector on the supplied hierarchical data"
  201.92 +  {:added "1.0"}
  201.93 +  [data]
  201.94 +  (doto (JFrame. "Clojure Inspector")
  201.95 +    (.add (JScrollPane. (JTree. (tree-model data))))
  201.96 +    (.setSize 400 600)
  201.97 +    (.setVisible true)))
  201.98 +
  201.99 +(defn inspect-table 
 201.100 +  "creates a graphical (Swing) inspector on the supplied regular
 201.101 +  data, which must be a sequential data structure of data structures
 201.102 +  of equal length"
 201.103 +  {:added "1.0"}
 201.104 +    [data]
 201.105 +  (doto (JFrame. "Clojure Inspector")
 201.106 +    (.add (JScrollPane. (JTable. (old-table-model data))))
 201.107 +    (.setSize 400 600)
 201.108 +    (.setVisible true)))
 201.109 +
 201.110 +
 201.111 +(defmulti list-provider class)
 201.112 +
 201.113 +(defmethod list-provider :default [x]
 201.114 +  {:nrows 1 :get-value (fn [i] x) :get-label (fn [i] (.getName (class x)))})
 201.115 +
 201.116 +(defmethod list-provider java.util.List [c]
 201.117 +  (let [v (if (vector? c) c (vec c))]
 201.118 +    {:nrows (count v) 
 201.119 +     :get-value (fn [i] (v i)) 
 201.120 +     :get-label (fn [i] i)}))
 201.121 +
 201.122 +(defmethod list-provider java.util.Map [c]
 201.123 +  (let [v (vec (sort (map (fn [[k v]] (vector k v)) c)))]
 201.124 +    {:nrows (count v) 
 201.125 +     :get-value (fn [i] ((v i) 1)) 
 201.126 +     :get-label (fn [i] ((v i) 0))}))
 201.127 +
 201.128 +(defn list-model [provider]
 201.129 +  (let [{:keys [nrows get-value get-label]} provider]
 201.130 +    (proxy [AbstractTableModel] []
 201.131 +      (getColumnCount [] 2)
 201.132 +      (getRowCount [] nrows)
 201.133 +      (getValueAt [rowIndex columnIndex]
 201.134 +        (cond 
 201.135 +         (= 0 columnIndex) (get-label rowIndex)
 201.136 +         (= 1 columnIndex) (print-str (get-value rowIndex)))))))
 201.137 +
 201.138 +(defmulti table-model class)
 201.139 +
 201.140 +(defmethod table-model :default [x]
 201.141 +  (proxy [AbstractTableModel] []
 201.142 +    (getColumnCount [] 2)
 201.143 +    (getRowCount [] 1)
 201.144 +    (getValueAt [rowIndex columnIndex]
 201.145 +      (if (zero? columnIndex)
 201.146 +        (class x)
 201.147 +        x))))
 201.148 +
 201.149 +;(defn make-inspector [x]
 201.150 +;  (agent {:frame frame :data x :parent nil :index 0}))
 201.151 +
 201.152 +
 201.153 +(defn inspect
 201.154 +  "creates a graphical (Swing) inspector on the supplied object"
 201.155 +  {:added "1.0"}
 201.156 +  [x]
 201.157 +  (doto (JFrame. "Clojure Inspector")
 201.158 +    (.add
 201.159 +      (doto (JPanel. (BorderLayout.))
 201.160 +        (.add (doto (JToolBar.)
 201.161 +                (.add (JButton. "Back"))
 201.162 +                (.addSeparator)
 201.163 +                (.add (JButton. "List"))
 201.164 +                (.add (JButton. "Table"))
 201.165 +                (.add (JButton. "Bean"))
 201.166 +                (.add (JButton. "Line"))
 201.167 +                (.add (JButton. "Bar"))
 201.168 +                (.addSeparator)
 201.169 +                (.add (JButton. "Prev"))
 201.170 +                (.add (JButton. "Next")))
 201.171 +              BorderLayout/NORTH)
 201.172 +        (.add
 201.173 +          (JScrollPane. 
 201.174 +            (doto (JTable. (list-model (list-provider x)))
 201.175 +              (.setAutoResizeMode JTable/AUTO_RESIZE_LAST_COLUMN)))
 201.176 +          BorderLayout/CENTER)))
 201.177 +    (.setSize 400 400)
 201.178 +    (.setVisible true)))
 201.179 +
 201.180 +
 201.181 +(comment
 201.182 +
 201.183 +(load-file "src/inspector.clj")
 201.184 +(refer 'inspector)
 201.185 +(inspect-tree {:a 1 :b 2 :c [1 2 3 {:d 4 :e 5 :f [6 7 8]}]})
 201.186 +(inspect-table [[1 2 3][4 5 6][7 8 9][10 11 12]])
 201.187 +
 201.188 +)
   202.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   202.2 +++ b/src/clojure/java/browse.clj	Sat Aug 21 06:25:44 2010 -0400
   202.3 @@ -0,0 +1,52 @@
   202.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   202.5 +;   The use and distribution terms for this software are covered by the
   202.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   202.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   202.8 +;   By using this software in any fashion, you are agreeing to be bound by
   202.9 +;   the terms of this license.
  202.10 +;   You must not remove this notice, or any other, from this software.
  202.11 +
  202.12 +(ns 
  202.13 +  ^{:author "Christophe Grand",
  202.14 +    :doc "Start a web browser from Clojure"}
  202.15 +  clojure.java.browse
  202.16 +  (:require [clojure.java.shell :as sh]) 
  202.17 +  (:import (java.net URI)))
  202.18 +
  202.19 +(defn- macosx? []
  202.20 +  (-> "os.name" System/getProperty .toLowerCase
  202.21 +    (.startsWith "mac os x")))
  202.22 +
  202.23 +(def *open-url-script* (when (macosx?) "/usr/bin/open"))
  202.24 +
  202.25 +(defn- open-url-in-browser
  202.26 +  "Opens url (a string) in the default system web browser.  May not
  202.27 +  work on all platforms.  Returns url on success, nil if not
  202.28 +  supported."
  202.29 +  [url]
  202.30 +  (try 
  202.31 +    (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" 
  202.32 +      "isDesktopSupported" (to-array nil))
  202.33 +      (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" 
  202.34 +            "getDesktop" (to-array nil))
  202.35 +        (.browse (URI. url)))
  202.36 +      url)
  202.37 +    (catch ClassNotFoundException e
  202.38 +      nil)))        
  202.39 +
  202.40 +(defn- open-url-in-swing
  202.41 + "Opens url (a string) in a Swing window."
  202.42 + [url]
  202.43 +  ; the implementation of this function resides in another namespace to be loaded "on demand"
  202.44 +  ; this fixes a bug on mac os x where the process turns into a GUI app
  202.45 +  ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32
  202.46 +  (require 'clojure.java.browse-ui)
  202.47 +  ((find-var 'clojure.java.browse-ui/open-url-in-swing) url))
  202.48 +
  202.49 +(defn browse-url
  202.50 +  "Open url in a browser"
  202.51 +  {:added "1.2"}
  202.52 +  [url]
  202.53 +  (or (open-url-in-browser url)
  202.54 +      (when *open-url-script* (sh/sh *open-url-script* (str url)) true)
  202.55 +      (open-url-in-swing url)))
   203.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   203.2 +++ b/src/clojure/java/browse_ui.clj	Sat Aug 21 06:25:44 2010 -0400
   203.3 @@ -0,0 +1,30 @@
   203.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   203.5 +;   The use and distribution terms for this software are covered by the
   203.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   203.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   203.8 +;   By using this software in any fashion, you are agreeing to be bound by
   203.9 +;   the terms of this license.
  203.10 +;   You must not remove this notice, or any other, from this software.
  203.11 +
  203.12 +(ns
  203.13 +    ^{:author "Christophe Grand",
  203.14 +      :doc "Helper namespace for clojure.java.browse.
  203.15 +            Prevents console apps from becoming GUI unnecessarily."}
  203.16 +  clojure.java.browse-ui)
  203.17 +
  203.18 +(defn- open-url-in-swing
  203.19 +  [url]
  203.20 +  (let [htmlpane (javax.swing.JEditorPane. url)]
  203.21 +    (.setEditable htmlpane false)
  203.22 +    (.addHyperlinkListener htmlpane
  203.23 +      (proxy [javax.swing.event.HyperlinkListener] []
  203.24 +        (hyperlinkUpdate [#^javax.swing.event.HyperlinkEvent e]
  203.25 +          (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED))
  203.26 +            (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e)
  203.27 +              (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e))
  203.28 +              (.setPage htmlpane (.getURL e)))))))
  203.29 +    (doto (javax.swing.JFrame.)
  203.30 +      (.setContentPane (javax.swing.JScrollPane. htmlpane))
  203.31 +      (.setBounds 32 32 700 900)
  203.32 +      (.show))))
  203.33 +      
   204.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   204.2 +++ b/src/clojure/java/io.clj	Sat Aug 21 06:25:44 2010 -0400
   204.3 @@ -0,0 +1,427 @@
   204.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   204.5 +;   The use and distribution terms for this software are covered by the
   204.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   204.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   204.8 +;   By using this software in any fashion, you are agreeing to be bound by
   204.9 +;   the terms of this license.
  204.10 +;   You must not remove this notice, or any other, from this software.
  204.11 +
  204.12 +(ns 
  204.13 +  ^{:author "Stuart Sierra, Chas Emerick, Stuart Halloway",
  204.14 +     :doc "This file defines polymorphic I/O utility functions for Clojure."}
  204.15 +    clojure.java.io
  204.16 +    (:import 
  204.17 +     (java.io Reader InputStream InputStreamReader PushbackReader
  204.18 +              BufferedReader File OutputStream
  204.19 +              OutputStreamWriter BufferedWriter Writer
  204.20 +              FileInputStream FileOutputStream ByteArrayOutputStream
  204.21 +              StringReader ByteArrayInputStream
  204.22 +              BufferedInputStream BufferedOutputStream
  204.23 +              CharArrayReader Closeable)
  204.24 +     (java.net URI URL MalformedURLException Socket)))
  204.25 +
  204.26 +(def
  204.27 +    ^{:doc "Type object for a Java primitive byte array."
  204.28 +      :private true
  204.29 +      }
  204.30 + byte-array-type (class (make-array Byte/TYPE 0)))
  204.31 +
  204.32 +(def
  204.33 +    ^{:doc "Type object for a Java primitive char array."
  204.34 +      :private true}
  204.35 + char-array-type (class (make-array Character/TYPE 0)))
  204.36 +
  204.37 +(defprotocol ^{:added "1.2"} Coercions
  204.38 +  "Coerce between various 'resource-namish' things."
  204.39 +  (^{:tag java.io.File, :added "1.2"} as-file [x] "Coerce argument to a file.")
  204.40 +  (^{:tag java.net.URL, :added "1.2"} as-url [x] "Coerce argument to a URL."))
  204.41 +
  204.42 +(extend-protocol Coercions
  204.43 +  nil
  204.44 +  (as-file [_] nil)
  204.45 +  (as-url [_] nil)
  204.46 +  
  204.47 +  String
  204.48 +  (as-file [s] (File. s))
  204.49 +  (as-url [s] (URL. s))  
  204.50 +  
  204.51 +  File
  204.52 +  (as-file [f] f)
  204.53 +  (as-url [f] (.toURL f))
  204.54 +
  204.55 +  URL
  204.56 +  (as-url [u] u)
  204.57 +  (as-file [u]
  204.58 +    (if (= "file" (.getProtocol u))
  204.59 +      (as-file (.getPath u))
  204.60 +      (throw (IllegalArgumentException. "Not a file: " u))))
  204.61 +
  204.62 +  URI
  204.63 +  (as-url [u] (.toURL u))
  204.64 +  (as-file [u] (as-file (as-url u))))
  204.65 +
  204.66 +(defprotocol ^{:added "1.2"} IOFactory
  204.67 +  "Factory functions that create ready-to-use, buffered versions of
  204.68 +   the various Java I/O stream types, on top of anything that can
  204.69 +   be unequivocally converted to the requested kind of stream.
  204.70 +
  204.71 +   Common options include
  204.72 +   
  204.73 +     :append    true to open stream in append mode
  204.74 +     :encoding  string name of encoding to use, e.g. \"UTF-8\".
  204.75 +
  204.76 +   Callers should generally prefer the higher level API provided by
  204.77 +   reader, writer, input-stream, and output-stream."
  204.78 +  (^{:added "1.2"} make-reader [x opts] "Creates a BufferedReader. See also IOFactory docs.")
  204.79 +  (^{:added "1.2"} make-writer [x opts] "Creates a BufferedWriter. See also IOFactory docs.")
  204.80 +  (^{:added "1.2"} make-input-stream [x opts] "Creates a BufferedInputStream. See also IOFactory docs.")
  204.81 +  (^{:added "1.2"} make-output-stream [x opts] "Creates a BufferedOutputStream. See also IOFactory docs."))
  204.82 +
  204.83 +(defn ^Reader reader
  204.84 +  "Attempts to coerce its argument into an open java.io.Reader.
  204.85 +   Default implementations always return a java.io.BufferedReader.
  204.86 +
  204.87 +   Default implementations are provided for Reader, BufferedReader,
  204.88 +   InputStream, File, URI, URL, Socket, byte arrays, character arrays,
  204.89 +   and String.
  204.90 +
  204.91 +   If argument is a String, it tries to resolve it first as a URI, then
  204.92 +   as a local file name.  URIs with a 'file' protocol are converted to
  204.93 +   local file names.
  204.94 +
  204.95 +   Should be used inside with-open to ensure the Reader is properly
  204.96 +   closed."
  204.97 +  {:added "1.2"}
  204.98 +  [x & opts]
  204.99 +  (make-reader x (when opts (apply hash-map opts))))
 204.100 +
 204.101 +(defn ^Writer writer
 204.102 +  "Attempts to coerce its argument into an open java.io.Writer.
 204.103 +   Default implementations always return a java.io.BufferedWriter.
 204.104 +
 204.105 +   Default implementations are provided for Writer, BufferedWriter,
 204.106 +   OutputStream, File, URI, URL, Socket, and String.
 204.107 +
 204.108 +   If the argument is a String, it tries to resolve it first as a URI, then
 204.109 +   as a local file name.  URIs with a 'file' protocol are converted to
 204.110 +   local file names.
 204.111 +
 204.112 +   Should be used inside with-open to ensure the Writer is properly
 204.113 +   closed."
 204.114 +  {:added "1.2"}
 204.115 +  [x & opts]
 204.116 +  (make-writer x (when opts (apply hash-map opts))))
 204.117 +
 204.118 +(defn ^InputStream input-stream
 204.119 +  "Attempts to coerce its argument into an open java.io.InputStream.
 204.120 +   Default implementations always return a java.io.BufferedInputStream.
 204.121 +
 204.122 +   Default implementations are defined for OutputStream, File, URI, URL,
 204.123 +   Socket, byte array, and String arguments.
 204.124 +
 204.125 +   If the argument is a String, it tries to resolve it first as a URI, then
 204.126 +   as a local file name.  URIs with a 'file' protocol are converted to
 204.127 +   local file names.
 204.128 +
 204.129 +   Should be used inside with-open to ensure the InputStream is properly
 204.130 +   closed."
 204.131 +  {:added "1.2"}
 204.132 +  [x & opts]
 204.133 +  (make-input-stream x (when opts (apply hash-map opts))))
 204.134 +
 204.135 +(defn ^OutputStream output-stream
 204.136 +  "Attempts to coerce its argument into an open java.io.OutputStream.
 204.137 +   Default implementations always return a java.io.BufferedOutputStream.
 204.138 +
 204.139 +   Default implementations are defined for OutputStream, File, URI, URL,
 204.140 +   Socket, and String arguments.
 204.141 +
 204.142 +   If the argument is a String, it tries to resolve it first as a URI, then
 204.143 +   as a local file name.  URIs with a 'file' protocol are converted to
 204.144 +   local file names.
 204.145 +
 204.146 +   Should be used inside with-open to ensure the OutputStream is
 204.147 +   properly closed."
 204.148 +  {:added "1.2"}
 204.149 +  [x & opts]
 204.150 +  (make-output-stream x (when opts (apply hash-map opts))))
 204.151 +
 204.152 +(defn- ^Boolean append? [opts]
 204.153 +  (boolean (:append opts)))
 204.154 +
 204.155 +(defn- ^String encoding [opts]
 204.156 +  (or (:encoding opts) "UTF-8"))
 204.157 +
 204.158 +(defn- buffer-size [opts]
 204.159 +  (or (:buffer-size opts) 1024))
 204.160 +
 204.161 +(def default-streams-impl
 204.162 +  {:make-reader (fn [x opts] (make-reader (make-input-stream x opts) opts))
 204.163 +   :make-writer (fn [x opts] (make-writer (make-output-stream x opts) opts))
 204.164 +   :make-input-stream (fn [x opts]
 204.165 +                        (throw (IllegalArgumentException.
 204.166 +                                (str "Cannot open <" (pr-str x) "> as an InputStream."))))
 204.167 +   :make-output-stream (fn [x opts]
 204.168 +                         (throw (IllegalArgumentException.
 204.169 +                                 (str "Cannot open <" (pr-str x) "> as an OutputStream."))))})
 204.170 +
 204.171 +(defn- inputstream->reader
 204.172 +  [^InputStream is opts]
 204.173 +  (make-reader (InputStreamReader. is (encoding opts)) opts))
 204.174 +
 204.175 +(defn- outputstream->writer
 204.176 +  [^OutputStream os opts]
 204.177 +  (make-writer (OutputStreamWriter. os (encoding opts)) opts))
 204.178 +
 204.179 +(extend BufferedInputStream
 204.180 +  IOFactory
 204.181 +  (assoc default-streams-impl
 204.182 +    :make-input-stream (fn [x opts] x)
 204.183 +    :make-reader inputstream->reader))
 204.184 +
 204.185 +(extend InputStream
 204.186 +  IOFactory
 204.187 +  (assoc default-streams-impl
 204.188 +    :make-input-stream (fn [x opts] (BufferedInputStream. x))
 204.189 +    :make-reader inputstream->reader))
 204.190 +
 204.191 +(extend Reader
 204.192 +  IOFactory
 204.193 +  (assoc default-streams-impl
 204.194 +    :make-reader (fn [x opts] (BufferedReader. x))))
 204.195 +
 204.196 +(extend BufferedReader
 204.197 +  IOFactory
 204.198 +  (assoc default-streams-impl
 204.199 +    :make-reader (fn [x opts] x)))
 204.200 +
 204.201 +(extend Writer
 204.202 +  IOFactory
 204.203 +  (assoc default-streams-impl
 204.204 +    :make-writer (fn [x opts] (BufferedWriter. x))))
 204.205 +
 204.206 +(extend BufferedWriter
 204.207 +  IOFactory
 204.208 +  (assoc default-streams-impl
 204.209 +    :make-writer (fn [x opts] x)))
 204.210 +
 204.211 +(extend OutputStream
 204.212 +  IOFactory
 204.213 +  (assoc default-streams-impl
 204.214 +    :make-output-stream (fn [x opts] (BufferedOutputStream. x))
 204.215 +    :make-writer outputstream->writer))
 204.216 +
 204.217 +(extend BufferedOutputStream
 204.218 +  IOFactory
 204.219 +  (assoc default-streams-impl
 204.220 +    :make-output-stream (fn [x opts] x)
 204.221 +    :make-writer outputstream->writer))
 204.222 +
 204.223 +(extend File
 204.224 +  IOFactory
 204.225 +  (assoc default-streams-impl
 204.226 +    :make-input-stream (fn [^File x opts] (make-input-stream (FileInputStream. x) opts))
 204.227 +    :make-output-stream (fn [^File x opts] (make-output-stream (FileOutputStream. x (append? opts)) opts))))
 204.228 +
 204.229 +(extend URL
 204.230 +  IOFactory
 204.231 +  (assoc default-streams-impl
 204.232 +    :make-input-stream (fn [^URL x opts]
 204.233 +                         (make-input-stream
 204.234 +                          (if (= "file" (.getProtocol x))
 204.235 +                            (FileInputStream. (.getPath x))
 204.236 +                            (.openStream x)) opts))
 204.237 +    :make-output-stream (fn [^URL x opts]
 204.238 +                          (if (= "file" (.getProtocol x))
 204.239 +                            (make-output-stream (File. (.getPath x)) opts)
 204.240 +                            (throw (IllegalArgumentException. (str "Can not write to non-file URL <" x ">")))))))
 204.241 +
 204.242 +(extend URI
 204.243 +  IOFactory
 204.244 +  (assoc default-streams-impl
 204.245 +    :make-input-stream (fn [^URI x opts] (make-input-stream (.toURL x) opts))
 204.246 +    :make-output-stream (fn [^URI x opts] (make-output-stream (.toURL x) opts))))
 204.247 +
 204.248 +(extend String
 204.249 +  IOFactory
 204.250 +  (assoc default-streams-impl
 204.251 +    :make-input-stream (fn [^String x opts]
 204.252 +                         (try
 204.253 +                          (make-input-stream (URL. x) opts)
 204.254 +                          (catch MalformedURLException e
 204.255 +                            (make-input-stream (File. x) opts))))
 204.256 +    :make-output-stream (fn [^String x opts]
 204.257 +                          (try
 204.258 +                           (make-output-stream (URL. x) opts)
 204.259 +                           (catch MalformedURLException err
 204.260 +                             (make-output-stream (File. x) opts))))))
 204.261 +
 204.262 +(extend Socket
 204.263 +  IOFactory
 204.264 +  (assoc default-streams-impl
 204.265 +    :make-input-stream (fn [^Socket x opts] (make-input-stream (.getInputStream x) opts))
 204.266 +    :make-output-stream (fn [^Socket x opts] (make-output-stream (.getOutputStream x) opts))))
 204.267 +
 204.268 +(extend byte-array-type
 204.269 +  IOFactory
 204.270 +  (assoc default-streams-impl
 204.271 +    :make-input-stream (fn [x opts] (make-input-stream (ByteArrayInputStream. x) opts))))
 204.272 +
 204.273 +(extend char-array-type
 204.274 +  IOFactory
 204.275 +  (assoc default-streams-impl
 204.276 +    :make-reader (fn [x opts] (make-reader (CharArrayReader. x) opts))))
 204.277 +
 204.278 +(extend Object
 204.279 +  IOFactory
 204.280 +  default-streams-impl)
 204.281 +
 204.282 +(defmulti
 204.283 +  #^{:doc "Internal helper for copy"
 204.284 +     :private true
 204.285 +     :arglists '([input output opts])}
 204.286 +  do-copy
 204.287 +  (fn [input output opts] [(type input) (type output)]))
 204.288 +
 204.289 +(defmethod do-copy [InputStream OutputStream] [#^InputStream input #^OutputStream output opts]
 204.290 +  (let [buffer (make-array Byte/TYPE (buffer-size opts))]
 204.291 +    (loop []
 204.292 +      (let [size (.read input buffer)]
 204.293 +        (when (pos? size)
 204.294 +          (do (.write output buffer 0 size)
 204.295 +              (recur)))))))
 204.296 +
 204.297 +(defmethod do-copy [InputStream Writer] [#^InputStream input #^Writer output opts]
 204.298 +  (let [#^"[B" buffer (make-array Byte/TYPE (buffer-size opts))]
 204.299 +    (loop []
 204.300 +      (let [size (.read input buffer)]
 204.301 +        (when (pos? size)
 204.302 +          (let [chars (.toCharArray (String. buffer 0 size (encoding opts)))]
 204.303 +            (do (.write output chars)
 204.304 +                (recur))))))))
 204.305 +
 204.306 +(defmethod do-copy [InputStream File] [#^InputStream input #^File output opts]
 204.307 +  (with-open [out (FileOutputStream. output)]
 204.308 +    (do-copy input out opts)))
 204.309 +
 204.310 +(defmethod do-copy [Reader OutputStream] [#^Reader input #^OutputStream output opts]
 204.311 +  (let [#^"[C" buffer (make-array Character/TYPE (buffer-size opts))]
 204.312 +    (loop []
 204.313 +      (let [size (.read input buffer)]
 204.314 +        (when (pos? size)
 204.315 +          (let [bytes (.getBytes (String. buffer 0 size) (encoding opts))]
 204.316 +            (do (.write output bytes)
 204.317 +                (recur))))))))
 204.318 +
 204.319 +(defmethod do-copy [Reader Writer] [#^Reader input #^Writer output opts]
 204.320 +  (let [#^"[C" buffer (make-array Character/TYPE (buffer-size opts))]
 204.321 +    (loop []
 204.322 +      (let [size (.read input buffer)]
 204.323 +        (when (pos? size)
 204.324 +          (do (.write output buffer 0 size)
 204.325 +              (recur)))))))
 204.326 +
 204.327 +(defmethod do-copy [Reader File] [#^Reader input #^File output opts]
 204.328 +  (with-open [out (FileOutputStream. output)]
 204.329 +    (do-copy input out opts)))
 204.330 +
 204.331 +(defmethod do-copy [File OutputStream] [#^File input #^OutputStream output opts]
 204.332 +  (with-open [in (FileInputStream. input)]
 204.333 +    (do-copy in output opts)))
 204.334 +
 204.335 +(defmethod do-copy [File Writer] [#^File input #^Writer output opts]
 204.336 +  (with-open [in (FileInputStream. input)]
 204.337 +    (do-copy in output opts)))
 204.338 +
 204.339 +(defmethod do-copy [File File] [#^File input #^File output opts]
 204.340 +  (with-open [in (FileInputStream. input)
 204.341 +              out (FileOutputStream. output)]
 204.342 +    (do-copy in out opts)))
 204.343 +
 204.344 +(defmethod do-copy [String OutputStream] [#^String input #^OutputStream output opts]
 204.345 +  (do-copy (StringReader. input) output opts))
 204.346 +
 204.347 +(defmethod do-copy [String Writer] [#^String input #^Writer output opts]
 204.348 +  (do-copy (StringReader. input) output opts))
 204.349 +
 204.350 +(defmethod do-copy [String File] [#^String input #^File output opts]
 204.351 +  (do-copy (StringReader. input) output opts))
 204.352 +
 204.353 +(defmethod do-copy [char-array-type OutputStream] [input #^OutputStream output opts]
 204.354 +  (do-copy (CharArrayReader. input) output opts))
 204.355 +
 204.356 +(defmethod do-copy [char-array-type Writer] [input #^Writer output opts]
 204.357 +  (do-copy (CharArrayReader. input) output opts))
 204.358 +
 204.359 +(defmethod do-copy [char-array-type File] [input #^File output opts]
 204.360 +  (do-copy (CharArrayReader. input) output opts))
 204.361 +
 204.362 +(defmethod do-copy [byte-array-type OutputStream] [#^"[B" input #^OutputStream output opts]
 204.363 +  (do-copy (ByteArrayInputStream. input) output opts))
 204.364 +
 204.365 +(defmethod do-copy [byte-array-type Writer] [#^"[B" input #^Writer output opts]
 204.366 +  (do-copy (ByteArrayInputStream. input) output opts))
 204.367 +
 204.368 +(defmethod do-copy [byte-array-type File] [#^"[B" input #^Writer output opts]
 204.369 +  (do-copy (ByteArrayInputStream. input) output opts))
 204.370 +
 204.371 +(defn copy
 204.372 +  "Copies input to output.  Returns nil or throws IOException.
 204.373 +  Input may be an InputStream, Reader, File, byte[], or String.
 204.374 +  Output may be an OutputStream, Writer, or File.
 204.375 +
 204.376 +  Options are key/value pairs and may be one of
 204.377 +
 204.378 +    :buffer-size  buffer size to use, default is 1024.
 204.379 +    :encoding     encoding to use if converting between
 204.380 +                  byte and char streams.   
 204.381 +
 204.382 +  Does not close any streams except those it opens itself 
 204.383 +  (on a File)."
 204.384 +  {:added "1.2"}
 204.385 +  [input output & opts]
 204.386 +  (do-copy input output (when opts (apply hash-map opts))))
 204.387 +
 204.388 +(defn ^String as-relative-path
 204.389 +  "Take an as-file-able thing and return a string if it is
 204.390 +   a relative path, else IllegalArgumentException."
 204.391 +  {:added "1.2"}
 204.392 +  [x]
 204.393 +  (let [^File f (as-file x)]
 204.394 +    (if (.isAbsolute f)
 204.395 +      (throw (IllegalArgumentException. (str f " is not a relative path")))
 204.396 +      (.getPath f))))
 204.397 +
 204.398 +(defn ^File file
 204.399 +  "Returns a java.io.File, passing each arg to as-file.  Multiple-arg
 204.400 +   versions treat the first argument as parent and subsequent args as
 204.401 +   children relative to the parent."
 204.402 +  {:added "1.2"}
 204.403 +  ([arg]                      
 204.404 +     (as-file arg))
 204.405 +  ([parent child]             
 204.406 +     (File. ^File (as-file parent) ^String (as-relative-path child)))
 204.407 +  ([parent child & more]
 204.408 +     (reduce file (file parent child) more)))
 204.409 +
 204.410 +(defn delete-file
 204.411 +  "Delete file f. Raise an exception if it fails unless silently is true."
 204.412 +  {:added "1.2"}
 204.413 +  [f & [silently]]
 204.414 +  (or (.delete (file f))
 204.415 +      silently
 204.416 +      (throw (java.io.IOException. (str "Couldn't delete " f)))))
 204.417 +
 204.418 +(defn make-parents
 204.419 +  "Given the same arg(s) as for file, creates all parent directories of
 204.420 +   the file they represent."
 204.421 +  {:added "1.2"}
 204.422 +  [f & more]
 204.423 +  (.mkdirs (.getParentFile ^File (apply file f more))))
 204.424 +
 204.425 +(defn ^URL resource
 204.426 +  "Returns the URL for a named resource. Use the context class loader
 204.427 +   if no loader is specified."
 204.428 +  {:added "1.2"}
 204.429 +  ([n] (resource n (.getContextClassLoader (Thread/currentThread))))
 204.430 +  ([n ^ClassLoader loader] (.getResource loader n)))
   205.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   205.2 +++ b/src/clojure/java/javadoc.clj	Sat Aug 21 06:25:44 2010 -0400
   205.3 @@ -0,0 +1,82 @@
   205.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   205.5 +;   The use and distribution terms for this software are covered by the
   205.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   205.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   205.8 +;   By using this software in any fashion, you are agreeing to be bound by
   205.9 +;   the terms of this license.
  205.10 +;   You must not remove this notice, or any other, from this software.
  205.11 +(ns 
  205.12 +  ^{:author "Christophe Grand, Stuart Sierra",
  205.13 +     :doc "A repl helper to quickly open javadocs."}
  205.14 +  clojure.java.javadoc
  205.15 +  (:use [clojure.java.browse :only (browse-url)] )
  205.16 +  (:import
  205.17 +   (java.io File)))
  205.18 +
  205.19 +(def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:")
  205.20 +(def *feeling-lucky* true)
  205.21 +
  205.22 +(def *local-javadocs* (ref (list)))
  205.23 + 
  205.24 +(def *core-java-api*
  205.25 +  (if (= "1.5" (System/getProperty "java.specification.version"))
  205.26 +    "http://java.sun.com/j2se/1.5.0/docs/api/"
  205.27 +    "http://java.sun.com/javase/6/docs/api/"))
  205.28 +
  205.29 +(def *remote-javadocs*
  205.30 + (ref (sorted-map
  205.31 +       "java." *core-java-api*
  205.32 +       "javax." *core-java-api*
  205.33 +       "org.ietf.jgss." *core-java-api*
  205.34 +       "org.omg." *core-java-api*
  205.35 +       "org.w3c.dom." *core-java-api*
  205.36 +       "org.xml.sax." *core-java-api*
  205.37 +       "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/"
  205.38 +       "org.apache.commons.io." "http://commons.apache.org/io/api-release/"
  205.39 +       "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/")))
  205.40 +
  205.41 +(defn add-local-javadoc
  205.42 +  "Adds to the list of local Javadoc paths."
  205.43 +  {:added "1.2"}
  205.44 +  [path]
  205.45 +  (dosync (commute *local-javadocs* conj path)))
  205.46 +
  205.47 +(defn add-remote-javadoc
  205.48 +  "Adds to the list of remote Javadoc URLs.  package-prefix is the
  205.49 +  beginning of the package name that has docs at this URL."
  205.50 +  {:added "1.2"}
  205.51 +  [package-prefix url]
  205.52 +  (dosync (commute *remote-javadocs* assoc package-prefix url)))
  205.53 +
  205.54 +(defn- javadoc-url
  205.55 +  "Searches for a URL for the given class name.  Tries
  205.56 +  *local-javadocs* first, then *remote-javadocs*.  Returns a string."
  205.57 +  {:tag String,
  205.58 +   :added "1.2"}
  205.59 +  [^String classname]
  205.60 +  (let [file-path (.replace classname \. File/separatorChar)
  205.61 +        url-path (.replace classname \. \/)]
  205.62 +    (if-let [file ^File (first
  205.63 +                           (filter #(.exists ^File %)
  205.64 +                             (map #(File. (str %) (str file-path ".html"))
  205.65 +                               @*local-javadocs*)))]
  205.66 +      (-> file .toURI str)
  205.67 +      ;; If no local file, try remote URLs:
  205.68 +      (or (some (fn [[prefix url]]
  205.69 +                  (when (.startsWith classname prefix)
  205.70 +                    (str url url-path ".html")))
  205.71 +            @*remote-javadocs*)
  205.72 +        ;; if *feeling-lucky* try a web search
  205.73 +        (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html"))))))
  205.74 +
  205.75 +(defn javadoc
  205.76 +  "Opens a browser window displaying the javadoc for the argument.
  205.77 +  Tries *local-javadocs* first, then *remote-javadocs*."
  205.78 +  {:added "1.2"}
  205.79 +  [class-or-object]
  205.80 +  (let [^Class c (if (instance? Class class-or-object) 
  205.81 +                    class-or-object 
  205.82 +                    (class class-or-object))]
  205.83 +    (if-let [url (javadoc-url (.getName c))]
  205.84 +      (browse-url url)
  205.85 +      (println "Could not find Javadoc for" c))))
   206.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   206.2 +++ b/src/clojure/java/shell.clj	Sat Aug 21 06:25:44 2010 -0400
   206.3 @@ -0,0 +1,143 @@
   206.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   206.5 +;   The use and distribution terms for this software are covered by the
   206.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   206.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   206.8 +;   By using this software in any fashion, you are agreeing to be bound by
   206.9 +;   the terms of this license.
  206.10 +;   You must not remove this notice, or any other, from this software.
  206.11 +
  206.12 +(ns 
  206.13 +  ^{:author "Chris Houser, Stuart Halloway",
  206.14 +    :doc "Conveniently launch a sub-process providing its stdin and
  206.15 +collecting its stdout"}
  206.16 +  clojure.java.shell
  206.17 +  (:use [clojure.java.io :only (as-file copy)])
  206.18 +  (:import (java.io OutputStreamWriter ByteArrayOutputStream StringWriter)
  206.19 +           (java.nio.charset Charset)))
  206.20 +
  206.21 +(def *sh-dir* nil)
  206.22 +(def *sh-env* nil)
  206.23 +
  206.24 +(defmacro with-sh-dir
  206.25 +  "Sets the directory for use with sh, see sh for details."
  206.26 +  {:added "1.2"}
  206.27 +  [dir & forms]
  206.28 +  `(binding [*sh-dir* ~dir]
  206.29 +     ~@forms))
  206.30 +
  206.31 +(defmacro with-sh-env
  206.32 +  "Sets the environment for use with sh, see sh for details."
  206.33 +  {:added "1.2"}
  206.34 +  [env & forms]
  206.35 +  `(binding [*sh-env* ~env]
  206.36 +     ~@forms))
  206.37 +     
  206.38 +(defn- aconcat
  206.39 +  "Concatenates arrays of given type."
  206.40 +  [type & xs]
  206.41 +  (let [target (make-array type (apply + (map count xs)))]
  206.42 +    (loop [i 0 idx 0]
  206.43 +      (when-let [a (nth xs i nil)]
  206.44 +        (System/arraycopy a 0 target idx (count a))
  206.45 +        (recur (inc i) (+ idx (count a)))))
  206.46 +    target))
  206.47 +
  206.48 +(defn- parse-args
  206.49 +  [args]
  206.50 +  (let [default-encoding "UTF-8" ;; see sh doc string
  206.51 +        default-opts {:out-enc default-encoding :in-enc default-encoding :dir *sh-dir* :env *sh-env*}
  206.52 +        [cmd opts] (split-with string? args)]
  206.53 +    [cmd (merge default-opts (apply hash-map opts))]))
  206.54 +
  206.55 +(defn- ^"[Ljava.lang.String;" as-env-strings 
  206.56 +  "Helper so that callers can pass a Clojure map for the :env to sh."
  206.57 +  [arg]
  206.58 +  (cond
  206.59 +   (nil? arg) nil
  206.60 +   (map? arg) (into-array String (map (fn [[k v]] (str (name k) "=" v)) arg))
  206.61 +   true arg))
  206.62 +
  206.63 +(defn- stream-to-bytes
  206.64 +  [in]
  206.65 +  (with-open [bout (ByteArrayOutputStream.)]
  206.66 +    (copy in bout)
  206.67 +    (.toByteArray bout)))
  206.68 +
  206.69 +(defn- stream-to-string
  206.70 +  ([in] (stream-to-string in (.name (Charset/defaultCharset))))
  206.71 +  ([in enc]
  206.72 +     (with-open [bout (StringWriter.)]
  206.73 +       (copy in bout :encoding enc)
  206.74 +       (.toString bout))))
  206.75 +
  206.76 +(defn- stream-to-enc
  206.77 +  [stream enc]
  206.78 +  (if (= enc :bytes)
  206.79 +    (stream-to-bytes stream)
  206.80 +    (stream-to-string stream enc)))
  206.81 +
  206.82 +(defn sh
  206.83 +  "Passes the given strings to Runtime.exec() to launch a sub-process.
  206.84 +
  206.85 +  Options are
  206.86 +
  206.87 +  :in      may be given followed by a String or byte array specifying input
  206.88 +           to be fed to the sub-process's stdin.
  206.89 +  :in-enc  option may be given followed by a String, used as a character
  206.90 +           encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to
  206.91 +           convert the input string specified by the :in option to the
  206.92 +           sub-process's stdin.  Defaults to UTF-8.
  206.93 +           If the :in option provides a byte array, then the bytes are passed
  206.94 +           unencoded, and this option is ignored.
  206.95 +  :out-enc option may be given followed by :bytes or a String. If a
  206.96 +           String is given, it will be used as a character encoding
  206.97 +           name (for example \"UTF-8\" or \"ISO-8859-1\") to convert
  206.98 +           the sub-process's stdout to a String which is returned.
  206.99 +           If :bytes is given, the sub-process's stdout will be stored
 206.100 +           in a byte array and returned.  Defaults to UTF-8.
 206.101 +  :env     override the process env with a map (or the underlying Java
 206.102 +           String[] if you are a masochist).
 206.103 +  :dir     override the process dir with a String or java.io.File.
 206.104 +
 206.105 +  You can bind :env or :dir for multiple operations using with-sh-env
 206.106 +  and with-sh-dir.
 206.107 +
 206.108 +  sh returns a map of
 206.109 +    :exit => sub-process's exit code
 206.110 +    :out  => sub-process's stdout (as byte[] or String)
 206.111 +    :err  => sub-process's stderr (String via platform default encoding)"
 206.112 +  {:added "1.2"}
 206.113 +  [& args]
 206.114 +  (let [[cmd opts] (parse-args args)
 206.115 +        proc (.exec (Runtime/getRuntime) 
 206.116 +		    ^"[Ljava.lang.String;" (into-array cmd) 
 206.117 +		    (as-env-strings (:env opts))
 206.118 +		    (as-file (:dir opts)))
 206.119 +        {:keys [in in-enc out-enc]} opts]
 206.120 +    (if in
 206.121 +      (future
 206.122 +       (if (instance? (class (byte-array 0)) in)
 206.123 +         (with-open [os (.getOutputStream proc)]
 206.124 +           (.write os ^"[B" in))
 206.125 +         (with-open [osw (OutputStreamWriter. (.getOutputStream proc) ^String in-enc)]
 206.126 +           (.write osw ^String in))))
 206.127 +      (.close (.getOutputStream proc)))
 206.128 +    (with-open [stdout (.getInputStream proc)
 206.129 +                stderr (.getErrorStream proc)]
 206.130 +      (let [out (future (stream-to-enc stdout out-enc))
 206.131 +            err (future (stream-to-string stderr))
 206.132 +            exit-code (.waitFor proc)]
 206.133 +        {:exit exit-code :out @out :err @err}))))
 206.134 +
 206.135 +(comment
 206.136 +
 206.137 +(println (sh "ls" "-l"))
 206.138 +(println (sh "ls" "-l" "/no-such-thing"))
 206.139 +(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n"))
 206.140 +(println (sh "cat" :in "x\u25bax\n"))
 206.141 +(println (sh "echo" "x\u25bax"))
 206.142 +(println (sh "echo" "x\u25bax" :out-enc "ISO-8859-1")) ; reads 4 single-byte chars
 206.143 +(println (sh "cat" "myimage.png" :out-enc :bytes)) ; reads binary file into bytes[]
 206.144 +(println (sh "cmd" "/c dir 1>&2"))
 206.145 +
 206.146 +)
   207.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   207.2 +++ b/src/clojure/lang/AFn.java	Sat Aug 21 06:25:44 2010 -0400
   207.3 @@ -0,0 +1,442 @@
   207.4 +/**
   207.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   207.6 + *   The use and distribution terms for this software are covered by the
   207.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   207.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   207.9 + *   By using this software in any fashion, you are agreeing to be bound by
  207.10 + * 	 the terms of this license.
  207.11 + *   You must not remove this notice, or any other, from this software.
  207.12 + **/
  207.13 +
  207.14 +/* rich Mar 25, 2006 4:05:37 PM */
  207.15 +
  207.16 +package clojure.lang;
  207.17 +
  207.18 +public abstract class AFn implements IFn {
  207.19 +
  207.20 +public Object call() throws Exception{
  207.21 +	return invoke();
  207.22 +}
  207.23 +
  207.24 +public void run(){
  207.25 +	try
  207.26 +		{
  207.27 +		invoke();
  207.28 +		}
  207.29 +	catch(Exception e)
  207.30 +		{
  207.31 +		throw new RuntimeException(e);
  207.32 +		}
  207.33 +}
  207.34 +
  207.35 +
  207.36 +
  207.37 +public Object invoke() throws Exception{
  207.38 +	return throwArity(0);
  207.39 +}
  207.40 +
  207.41 +public Object invoke(Object arg1) throws Exception{
  207.42 +	return throwArity(1);
  207.43 +}
  207.44 +
  207.45 +public Object invoke(Object arg1, Object arg2) throws Exception{
  207.46 +	return throwArity(2);
  207.47 +}
  207.48 +
  207.49 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{
  207.50 +	return throwArity(3);
  207.51 +}
  207.52 +
  207.53 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{
  207.54 +	return throwArity(4);
  207.55 +}
  207.56 +
  207.57 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{
  207.58 +	return throwArity(5);
  207.59 +}
  207.60 +
  207.61 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{
  207.62 +	return throwArity(6);
  207.63 +}
  207.64 +
  207.65 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
  207.66 +		throws Exception{
  207.67 +	return throwArity(7);
  207.68 +}
  207.69 +
  207.70 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  207.71 +                     Object arg8) throws Exception{
  207.72 +	return throwArity(8);
  207.73 +}
  207.74 +
  207.75 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  207.76 +                     Object arg8, Object arg9) throws Exception{
  207.77 +	return throwArity(9);
  207.78 +}
  207.79 +
  207.80 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  207.81 +                     Object arg8, Object arg9, Object arg10) throws Exception{
  207.82 +	return throwArity(10);
  207.83 +}
  207.84 +
  207.85 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  207.86 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{
  207.87 +	return throwArity(11);
  207.88 +}
  207.89 +
  207.90 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  207.91 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{
  207.92 +	return throwArity(12);
  207.93 +}
  207.94 +
  207.95 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  207.96 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13)
  207.97 +		throws Exception{
  207.98 +	return throwArity(13);
  207.99 +}
 207.100 +
 207.101 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.102 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
 207.103 +		throws Exception{
 207.104 +	return throwArity(14);
 207.105 +}
 207.106 +
 207.107 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.108 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.109 +                     Object arg15) throws Exception{
 207.110 +	return throwArity(15);
 207.111 +}
 207.112 +
 207.113 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.114 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.115 +                     Object arg15, Object arg16) throws Exception{
 207.116 +	return throwArity(16);
 207.117 +}
 207.118 +
 207.119 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.120 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.121 +                     Object arg15, Object arg16, Object arg17) throws Exception{
 207.122 +	return throwArity(17);
 207.123 +}
 207.124 +
 207.125 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.126 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.127 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{
 207.128 +	return throwArity(18);
 207.129 +}
 207.130 +
 207.131 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.132 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.133 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{
 207.134 +	return throwArity(19);
 207.135 +}
 207.136 +
 207.137 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.138 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.139 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
 207.140 +		throws Exception{
 207.141 +	return throwArity(20);
 207.142 +}
 207.143 +
 207.144 +
 207.145 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 207.146 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 207.147 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20,
 207.148 +                     Object... args)
 207.149 +		throws Exception{
 207.150 +	return throwArity(21);
 207.151 +}
 207.152 +
 207.153 +public Object applyTo(ISeq arglist) throws Exception{
 207.154 +	return applyToHelper(this, Util.ret1(arglist,arglist = null));
 207.155 +}
 207.156 +
 207.157 +static public Object applyToHelper(IFn ifn, ISeq arglist) throws Exception{
 207.158 +	switch(RT.boundedLength(arglist, 20))
 207.159 +		{
 207.160 +		case 0:
 207.161 +			arglist = null;
 207.162 +			return ifn.invoke();
 207.163 +		case 1:
 207.164 +			Object a1 = arglist.first();
 207.165 +			arglist = null;
 207.166 +			return ifn.invoke(a1);
 207.167 +		case 2:
 207.168 +			return ifn.invoke(arglist.first()
 207.169 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.170 +			);
 207.171 +		case 3:
 207.172 +			return ifn.invoke(arglist.first()
 207.173 +					, (arglist = arglist.next()).first()
 207.174 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.175 +			);
 207.176 +		case 4:
 207.177 +			return ifn.invoke(arglist.first()
 207.178 +					, (arglist = arglist.next()).first()
 207.179 +					, (arglist = arglist.next()).first()
 207.180 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.181 +			);
 207.182 +		case 5:
 207.183 +			return ifn.invoke(arglist.first()
 207.184 +					, (arglist = arglist.next()).first()
 207.185 +					, (arglist = arglist.next()).first()
 207.186 +					, (arglist = arglist.next()).first()
 207.187 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.188 +			);
 207.189 +		case 6:
 207.190 +			return ifn.invoke(arglist.first()
 207.191 +					, (arglist = arglist.next()).first()
 207.192 +					, (arglist = arglist.next()).first()
 207.193 +					, (arglist = arglist.next()).first()
 207.194 +					, (arglist = arglist.next()).first()
 207.195 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.196 +			);
 207.197 +		case 7:
 207.198 +			return ifn.invoke(arglist.first()
 207.199 +					, (arglist = arglist.next()).first()
 207.200 +					, (arglist = arglist.next()).first()
 207.201 +					, (arglist = arglist.next()).first()
 207.202 +					, (arglist = arglist.next()).first()
 207.203 +					, (arglist = arglist.next()).first()
 207.204 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.205 +			);
 207.206 +		case 8:
 207.207 +			return ifn.invoke(arglist.first()
 207.208 +					, (arglist = arglist.next()).first()
 207.209 +					, (arglist = arglist.next()).first()
 207.210 +					, (arglist = arglist.next()).first()
 207.211 +					, (arglist = arglist.next()).first()
 207.212 +					, (arglist = arglist.next()).first()
 207.213 +					, (arglist = arglist.next()).first()
 207.214 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.215 +			);
 207.216 +		case 9:
 207.217 +			return ifn.invoke(arglist.first()
 207.218 +					, (arglist = arglist.next()).first()
 207.219 +					, (arglist = arglist.next()).first()
 207.220 +					, (arglist = arglist.next()).first()
 207.221 +					, (arglist = arglist.next()).first()
 207.222 +					, (arglist = arglist.next()).first()
 207.223 +					, (arglist = arglist.next()).first()
 207.224 +					, (arglist = arglist.next()).first()
 207.225 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.226 +			);
 207.227 +		case 10:
 207.228 +			return ifn.invoke(arglist.first()
 207.229 +					, (arglist = arglist.next()).first()
 207.230 +					, (arglist = arglist.next()).first()
 207.231 +					, (arglist = arglist.next()).first()
 207.232 +					, (arglist = arglist.next()).first()
 207.233 +					, (arglist = arglist.next()).first()
 207.234 +					, (arglist = arglist.next()).first()
 207.235 +					, (arglist = arglist.next()).first()
 207.236 +					, (arglist = arglist.next()).first()
 207.237 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.238 +			);
 207.239 +		case 11:
 207.240 +			return ifn.invoke(arglist.first()
 207.241 +					, (arglist = arglist.next()).first()
 207.242 +					, (arglist = arglist.next()).first()
 207.243 +					, (arglist = arglist.next()).first()
 207.244 +					, (arglist = arglist.next()).first()
 207.245 +					, (arglist = arglist.next()).first()
 207.246 +					, (arglist = arglist.next()).first()
 207.247 +					, (arglist = arglist.next()).first()
 207.248 +					, (arglist = arglist.next()).first()
 207.249 +					, (arglist = arglist.next()).first()
 207.250 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.251 +			);
 207.252 +		case 12:
 207.253 +			return ifn.invoke(arglist.first()
 207.254 +					, (arglist = arglist.next()).first()
 207.255 +					, (arglist = arglist.next()).first()
 207.256 +					, (arglist = arglist.next()).first()
 207.257 +					, (arglist = arglist.next()).first()
 207.258 +					, (arglist = arglist.next()).first()
 207.259 +					, (arglist = arglist.next()).first()
 207.260 +					, (arglist = arglist.next()).first()
 207.261 +					, (arglist = arglist.next()).first()
 207.262 +					, (arglist = arglist.next()).first()
 207.263 +					, (arglist = arglist.next()).first()
 207.264 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.265 +			);
 207.266 +		case 13:
 207.267 +			return ifn.invoke(arglist.first()
 207.268 +					, (arglist = arglist.next()).first()
 207.269 +					, (arglist = arglist.next()).first()
 207.270 +					, (arglist = arglist.next()).first()
 207.271 +					, (arglist = arglist.next()).first()
 207.272 +					, (arglist = arglist.next()).first()
 207.273 +					, (arglist = arglist.next()).first()
 207.274 +					, (arglist = arglist.next()).first()
 207.275 +					, (arglist = arglist.next()).first()
 207.276 +					, (arglist = arglist.next()).first()
 207.277 +					, (arglist = arglist.next()).first()
 207.278 +					, (arglist = arglist.next()).first()
 207.279 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.280 +			);
 207.281 +		case 14:
 207.282 +			return ifn.invoke(arglist.first()
 207.283 +					, (arglist = arglist.next()).first()
 207.284 +					, (arglist = arglist.next()).first()
 207.285 +					, (arglist = arglist.next()).first()
 207.286 +					, (arglist = arglist.next()).first()
 207.287 +					, (arglist = arglist.next()).first()
 207.288 +					, (arglist = arglist.next()).first()
 207.289 +					, (arglist = arglist.next()).first()
 207.290 +					, (arglist = arglist.next()).first()
 207.291 +					, (arglist = arglist.next()).first()
 207.292 +					, (arglist = arglist.next()).first()
 207.293 +					, (arglist = arglist.next()).first()
 207.294 +					, (arglist = arglist.next()).first()
 207.295 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.296 +			);
 207.297 +		case 15:
 207.298 +			return ifn.invoke(arglist.first()
 207.299 +					, (arglist = arglist.next()).first()
 207.300 +					, (arglist = arglist.next()).first()
 207.301 +					, (arglist = arglist.next()).first()
 207.302 +					, (arglist = arglist.next()).first()
 207.303 +					, (arglist = arglist.next()).first()
 207.304 +					, (arglist = arglist.next()).first()
 207.305 +					, (arglist = arglist.next()).first()
 207.306 +					, (arglist = arglist.next()).first()
 207.307 +					, (arglist = arglist.next()).first()
 207.308 +					, (arglist = arglist.next()).first()
 207.309 +					, (arglist = arglist.next()).first()
 207.310 +					, (arglist = arglist.next()).first()
 207.311 +					, (arglist = arglist.next()).first()
 207.312 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.313 +			);
 207.314 +		case 16:
 207.315 +			return ifn.invoke(arglist.first()
 207.316 +					, (arglist = arglist.next()).first()
 207.317 +					, (arglist = arglist.next()).first()
 207.318 +					, (arglist = arglist.next()).first()
 207.319 +					, (arglist = arglist.next()).first()
 207.320 +					, (arglist = arglist.next()).first()
 207.321 +					, (arglist = arglist.next()).first()
 207.322 +					, (arglist = arglist.next()).first()
 207.323 +					, (arglist = arglist.next()).first()
 207.324 +					, (arglist = arglist.next()).first()
 207.325 +					, (arglist = arglist.next()).first()
 207.326 +					, (arglist = arglist.next()).first()
 207.327 +					, (arglist = arglist.next()).first()
 207.328 +					, (arglist = arglist.next()).first()
 207.329 +					, (arglist = arglist.next()).first()
 207.330 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.331 +			);
 207.332 +		case 17:
 207.333 +			return ifn.invoke(arglist.first()
 207.334 +					, (arglist = arglist.next()).first()
 207.335 +					, (arglist = arglist.next()).first()
 207.336 +					, (arglist = arglist.next()).first()
 207.337 +					, (arglist = arglist.next()).first()
 207.338 +					, (arglist = arglist.next()).first()
 207.339 +					, (arglist = arglist.next()).first()
 207.340 +					, (arglist = arglist.next()).first()
 207.341 +					, (arglist = arglist.next()).first()
 207.342 +					, (arglist = arglist.next()).first()
 207.343 +					, (arglist = arglist.next()).first()
 207.344 +					, (arglist = arglist.next()).first()
 207.345 +					, (arglist = arglist.next()).first()
 207.346 +					, (arglist = arglist.next()).first()
 207.347 +					, (arglist = arglist.next()).first()
 207.348 +					, (arglist = arglist.next()).first()
 207.349 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.350 +			);
 207.351 +		case 18:
 207.352 +			return ifn.invoke(arglist.first()
 207.353 +					, (arglist = arglist.next()).first()
 207.354 +					, (arglist = arglist.next()).first()
 207.355 +					, (arglist = arglist.next()).first()
 207.356 +					, (arglist = arglist.next()).first()
 207.357 +					, (arglist = arglist.next()).first()
 207.358 +					, (arglist = arglist.next()).first()
 207.359 +					, (arglist = arglist.next()).first()
 207.360 +					, (arglist = arglist.next()).first()
 207.361 +					, (arglist = arglist.next()).first()
 207.362 +					, (arglist = arglist.next()).first()
 207.363 +					, (arglist = arglist.next()).first()
 207.364 +					, (arglist = arglist.next()).first()
 207.365 +					, (arglist = arglist.next()).first()
 207.366 +					, (arglist = arglist.next()).first()
 207.367 +					, (arglist = arglist.next()).first()
 207.368 +					, (arglist = arglist.next()).first()
 207.369 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.370 +			);
 207.371 +		case 19:
 207.372 +			return ifn.invoke(arglist.first()
 207.373 +					, (arglist = arglist.next()).first()
 207.374 +					, (arglist = arglist.next()).first()
 207.375 +					, (arglist = arglist.next()).first()
 207.376 +					, (arglist = arglist.next()).first()
 207.377 +					, (arglist = arglist.next()).first()
 207.378 +					, (arglist = arglist.next()).first()
 207.379 +					, (arglist = arglist.next()).first()
 207.380 +					, (arglist = arglist.next()).first()
 207.381 +					, (arglist = arglist.next()).first()
 207.382 +					, (arglist = arglist.next()).first()
 207.383 +					, (arglist = arglist.next()).first()
 207.384 +					, (arglist = arglist.next()).first()
 207.385 +					, (arglist = arglist.next()).first()
 207.386 +					, (arglist = arglist.next()).first()
 207.387 +					, (arglist = arglist.next()).first()
 207.388 +					, (arglist = arglist.next()).first()
 207.389 +					, (arglist = arglist.next()).first()
 207.390 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.391 +			);
 207.392 +		case 20:
 207.393 +			return ifn.invoke(arglist.first()
 207.394 +					, (arglist = arglist.next()).first()
 207.395 +					, (arglist = arglist.next()).first()
 207.396 +					, (arglist = arglist.next()).first()
 207.397 +					, (arglist = arglist.next()).first()
 207.398 +					, (arglist = arglist.next()).first()
 207.399 +					, (arglist = arglist.next()).first()
 207.400 +					, (arglist = arglist.next()).first()
 207.401 +					, (arglist = arglist.next()).first()
 207.402 +					, (arglist = arglist.next()).first()
 207.403 +					, (arglist = arglist.next()).first()
 207.404 +					, (arglist = arglist.next()).first()
 207.405 +					, (arglist = arglist.next()).first()
 207.406 +					, (arglist = arglist.next()).first()
 207.407 +					, (arglist = arglist.next()).first()
 207.408 +					, (arglist = arglist.next()).first()
 207.409 +					, (arglist = arglist.next()).first()
 207.410 +					, (arglist = arglist.next()).first()
 207.411 +					, (arglist = arglist.next()).first()
 207.412 +					, Util.ret1((arglist = arglist.next()).first(),arglist = null)
 207.413 +			);
 207.414 +		default:
 207.415 +			return ifn.invoke(arglist.first()
 207.416 +					, (arglist = arglist.next()).first()
 207.417 +					, (arglist = arglist.next()).first()
 207.418 +					, (arglist = arglist.next()).first()
 207.419 +					, (arglist = arglist.next()).first()
 207.420 +					, (arglist = arglist.next()).first()
 207.421 +					, (arglist = arglist.next()).first()
 207.422 +					, (arglist = arglist.next()).first()
 207.423 +					, (arglist = arglist.next()).first()
 207.424 +					, (arglist = arglist.next()).first()
 207.425 +					, (arglist = arglist.next()).first()
 207.426 +					, (arglist = arglist.next()).first()
 207.427 +					, (arglist = arglist.next()).first()
 207.428 +					, (arglist = arglist.next()).first()
 207.429 +					, (arglist = arglist.next()).first()
 207.430 +					, (arglist = arglist.next()).first()
 207.431 +					, (arglist = arglist.next()).first()
 207.432 +					, (arglist = arglist.next()).first()
 207.433 +					, (arglist = arglist.next()).first()
 207.434 +					, (arglist = arglist.next()).first()
 207.435 +					, RT.seqToArray(Util.ret1(arglist.next(),arglist = null)));
 207.436 +		}
 207.437 +}
 207.438 +
 207.439 +public Object throwArity(int n){
 207.440 +	String name = getClass().getSimpleName();
 207.441 +	int suffix = name.lastIndexOf("__");
 207.442 +	throw new IllegalArgumentException("Wrong number of args (" + n + ") passed to: "
 207.443 +	                                   + (suffix == -1 ? name : name.substring(0, suffix)).replace('_', '-'));
 207.444 +}
 207.445 +}
   208.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   208.2 +++ b/src/clojure/lang/AFunction.java	Sat Aug 21 06:25:44 2010 -0400
   208.3 @@ -0,0 +1,42 @@
   208.4 +/**
   208.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   208.6 + *   The use and distribution terms for this software are covered by the
   208.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   208.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   208.9 + *   By using this software in any fashion, you are agreeing to be bound by
  208.10 + * 	 the terms of this license.
  208.11 + *   You must not remove this notice, or any other, from this software.
  208.12 + **/
  208.13 +
  208.14 +/* rich Dec 16, 2008 */
  208.15 +
  208.16 +package clojure.lang;
  208.17 +
  208.18 +import java.io.Serializable;
  208.19 +import java.util.Comparator;
  208.20 +
  208.21 +public abstract class AFunction extends AFn implements IObj, Comparator, Fn, Serializable {
  208.22 +
  208.23 +public volatile MethodImplCache __methodImplCache;
  208.24 +
  208.25 +public int compare(Object o1, Object o2){
  208.26 +	try
  208.27 +		{
  208.28 +		Object o = invoke(o1, o2);
  208.29 +
  208.30 +		if(o instanceof Boolean)
  208.31 +			{
  208.32 +			if(RT.booleanCast(o))
  208.33 +				return -1;
  208.34 +			return RT.booleanCast(invoke(o2,o1))? 1 : 0;
  208.35 +			}
  208.36 +
  208.37 +		Number n = (Number) o;
  208.38 +		return n.intValue();
  208.39 +		}
  208.40 +	catch(Exception e)
  208.41 +		{
  208.42 +		throw new RuntimeException(e);
  208.43 +		}
  208.44 +}
  208.45 +}
   209.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   209.2 +++ b/src/clojure/lang/AMapEntry.java	Sat Aug 21 06:25:44 2010 -0400
   209.3 @@ -0,0 +1,149 @@
   209.4 +/**
   209.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   209.6 + *   The use and distribution terms for this software are covered by the
   209.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   209.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   209.9 + *   By using this software in any fashion, you are agreeing to be bound by
  209.10 + * 	 the terms of this license.
  209.11 + *   You must not remove this notice, or any other, from this software.
  209.12 + **/
  209.13 +
  209.14 +/* rich Mar 1, 2008 */
  209.15 +
  209.16 +package clojure.lang;
  209.17 +
  209.18 +import java.io.StringWriter;
  209.19 +
  209.20 +public abstract class AMapEntry extends APersistentVector implements IMapEntry{
  209.21 +
  209.22 +public Object nth(int i){
  209.23 +	if(i == 0)
  209.24 +		return key();
  209.25 +	else if(i == 1)
  209.26 +		return val();
  209.27 +	else
  209.28 +		throw new IndexOutOfBoundsException();
  209.29 +}
  209.30 +
  209.31 +private IPersistentVector asVector(){
  209.32 +	return LazilyPersistentVector.createOwning(key(), val());
  209.33 +}
  209.34 +
  209.35 +public IPersistentVector assocN(int i, Object val){
  209.36 +	return asVector().assocN(i, val);
  209.37 +}
  209.38 +
  209.39 +public int count(){
  209.40 +	return 2;
  209.41 +}
  209.42 +
  209.43 +public ISeq seq(){
  209.44 +	return asVector().seq();
  209.45 +}
  209.46 +
  209.47 +public IPersistentVector cons(Object o){
  209.48 +	return asVector().cons(o);
  209.49 +}
  209.50 +
  209.51 +public IPersistentCollection empty(){
  209.52 +	return null;
  209.53 +}
  209.54 +
  209.55 +public IPersistentStack pop(){
  209.56 +	return LazilyPersistentVector.createOwning(key());
  209.57 +}
  209.58 +
  209.59 +public Object setValue(Object value){
  209.60 +	throw new UnsupportedOperationException();
  209.61 +}
  209.62 +
  209.63 +/*
  209.64 +
  209.65 +public boolean equals(Object obj){
  209.66 +	return APersistentVector.doEquals(this, obj);
  209.67 +}
  209.68 +
  209.69 +public int hashCode(){
  209.70 +	//must match logic in APersistentVector
  209.71 +	return 31 * (31 + Util.hash(key())) + Util.hash(val());
  209.72 +//	return Util.hashCombine(Util.hashCombine(0, Util.hash(key())), Util.hash(val()));
  209.73 +}
  209.74 +
  209.75 +public String toString(){
  209.76 +	StringWriter sw = new StringWriter();
  209.77 +	try
  209.78 +		{
  209.79 +		RT.print(this, sw);
  209.80 +		}
  209.81 +	catch(Exception e)
  209.82 +		{
  209.83 +		//checked exceptions stink!
  209.84 +		throw new RuntimeException(e);
  209.85 +		}
  209.86 +	return sw.toString();
  209.87 +}
  209.88 +
  209.89 +public int length(){
  209.90 +	return 2;
  209.91 +}
  209.92 +
  209.93 +public Object nth(int i){
  209.94 +	if(i == 0)
  209.95 +		return key();
  209.96 +	else if(i == 1)
  209.97 +		return val();
  209.98 +	else
  209.99 +		throw new IndexOutOfBoundsException();
 209.100 +}
 209.101 +
 209.102 +private IPersistentVector asVector(){
 209.103 +	return LazilyPersistentVector.createOwning(key(), val());
 209.104 +}
 209.105 +
 209.106 +public IPersistentVector assocN(int i, Object val){
 209.107 +	return asVector().assocN(i, val);
 209.108 +}
 209.109 +
 209.110 +public int count(){
 209.111 +	return 2;
 209.112 +}
 209.113 +
 209.114 +public ISeq seq(){
 209.115 +	return asVector().seq();
 209.116 +}
 209.117 +
 209.118 +public IPersistentVector cons(Object o){
 209.119 +	return asVector().cons(o);
 209.120 +}
 209.121 +
 209.122 +public boolean containsKey(Object key){
 209.123 +	return asVector().containsKey(key);
 209.124 +}
 209.125 +
 209.126 +public IMapEntry entryAt(Object key){
 209.127 +	return asVector().entryAt(key);
 209.128 +}
 209.129 +
 209.130 +public Associative assoc(Object key, Object val){
 209.131 +	return asVector().assoc(key, val);
 209.132 +}
 209.133 +
 209.134 +public Object valAt(Object key){
 209.135 +	return asVector().valAt(key);
 209.136 +}
 209.137 +
 209.138 +public Object valAt(Object key, Object notFound){
 209.139 +	return asVector().valAt(key, notFound);
 209.140 +}
 209.141 +
 209.142 +public Object peek(){
 209.143 +	return val();
 209.144 +}
 209.145 +
 209.146 +
 209.147 +public ISeq rseq() throws Exception{
 209.148 +	return asVector().rseq();
 209.149 +}
 209.150 +*/
 209.151 +
 209.152 +}
   210.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   210.2 +++ b/src/clojure/lang/APersistentMap.java	Sat Aug 21 06:25:44 2010 -0400
   210.3 @@ -0,0 +1,384 @@
   210.4 +/**
   210.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   210.6 + *   The use and distribution terms for this software are covered by the
   210.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   210.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   210.9 + *   By using this software in any fashion, you are agreeing to be bound by
  210.10 + * 	 the terms of this license.
  210.11 + *   You must not remove this notice, or any other, from this software.
  210.12 + **/
  210.13 +
  210.14 +package clojure.lang;
  210.15 +
  210.16 +import java.io.Serializable;
  210.17 +import java.util.*;
  210.18 +
  210.19 +public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence {
  210.20 +int _hash = -1;
  210.21 +
  210.22 +public String toString(){
  210.23 +	return RT.printString(this);
  210.24 +}
  210.25 +
  210.26 +public IPersistentCollection cons(Object o){
  210.27 +	if(o instanceof Map.Entry)
  210.28 +		{
  210.29 +		Map.Entry e = (Map.Entry) o;
  210.30 +
  210.31 +		return assoc(e.getKey(), e.getValue());
  210.32 +		}
  210.33 +	else if(o instanceof IPersistentVector)
  210.34 +		{
  210.35 +		IPersistentVector v = (IPersistentVector) o;
  210.36 +		if(v.count() != 2)
  210.37 +			throw new IllegalArgumentException("Vector arg to map conj must be a pair");
  210.38 +		return assoc(v.nth(0), v.nth(1));
  210.39 +		}
  210.40 +
  210.41 +	IPersistentMap ret = this;
  210.42 +	for(ISeq es = RT.seq(o); es != null; es = es.next())
  210.43 +		{
  210.44 +		Map.Entry e = (Map.Entry) es.first();
  210.45 +		ret = ret.assoc(e.getKey(), e.getValue());
  210.46 +		}
  210.47 +	return ret;
  210.48 +}
  210.49 +
  210.50 +public boolean equals(Object obj){
  210.51 +	return mapEquals(this, obj);
  210.52 +}
  210.53 +
  210.54 +static public boolean mapEquals(IPersistentMap m1, Object obj){
  210.55 +	if(m1 == obj) return true;
  210.56 +	if(!(obj instanceof Map))
  210.57 +		return false;
  210.58 +	Map m = (Map) obj;
  210.59 +
  210.60 +	if(m.size() != m1.count() || m.hashCode() != m1.hashCode())
  210.61 +		return false;
  210.62 +
  210.63 +	for(ISeq s = m1.seq(); s != null; s = s.next())
  210.64 +		{
  210.65 +		Map.Entry e = (Map.Entry) s.first();
  210.66 +		boolean found = m.containsKey(e.getKey());
  210.67 +
  210.68 +		if(!found || !Util.equals(e.getValue(), m.get(e.getKey())))
  210.69 +			return false;
  210.70 +		}
  210.71 +
  210.72 +	return true;
  210.73 +}
  210.74 +
  210.75 +public boolean equiv(Object obj){
  210.76 +	if(!(obj instanceof Map))
  210.77 +		return false;
  210.78 +	if(obj instanceof IPersistentMap && !(obj instanceof MapEquivalence))
  210.79 +		return false;
  210.80 +	
  210.81 +	Map m = (Map) obj;
  210.82 +
  210.83 +	if(m.size() != size())
  210.84 +		return false;
  210.85 +
  210.86 +	for(ISeq s = seq(); s != null; s = s.next())
  210.87 +		{
  210.88 +		Map.Entry e = (Map.Entry) s.first();
  210.89 +		boolean found = m.containsKey(e.getKey());
  210.90 +
  210.91 +		if(!found || !Util.equiv(e.getValue(), m.get(e.getKey())))
  210.92 +			return false;
  210.93 +		}
  210.94 +
  210.95 +	return true;
  210.96 +}
  210.97 +public int hashCode(){
  210.98 +	if(_hash == -1)
  210.99 +		{
 210.100 +		this._hash = mapHash(this);
 210.101 +		}
 210.102 +	return _hash;
 210.103 +}
 210.104 +
 210.105 +static public int mapHash(IPersistentMap m){
 210.106 +	int hash = 0;
 210.107 +	for(ISeq s = m.seq(); s != null; s = s.next())
 210.108 +		{
 210.109 +		Map.Entry e = (Map.Entry) s.first();
 210.110 +		hash += (e.getKey() == null ? 0 : e.getKey().hashCode()) ^
 210.111 +				(e.getValue() == null ? 0 : e.getValue().hashCode());
 210.112 +		}
 210.113 +	return hash;
 210.114 +}
 210.115 +
 210.116 +static public class KeySeq extends ASeq{
 210.117 +	ISeq seq;
 210.118 +
 210.119 +	static public KeySeq create(ISeq seq){
 210.120 +		if(seq == null)
 210.121 +			return null;
 210.122 +		return new KeySeq(seq);
 210.123 +	}
 210.124 +
 210.125 +	private KeySeq(ISeq seq){
 210.126 +		this.seq = seq;
 210.127 +	}
 210.128 +
 210.129 +	private KeySeq(IPersistentMap meta, ISeq seq){
 210.130 +		super(meta);
 210.131 +		this.seq = seq;
 210.132 +	}
 210.133 +
 210.134 +	public Object first(){
 210.135 +		return ((Map.Entry) seq.first()).getKey();
 210.136 +	}
 210.137 +
 210.138 +	public ISeq next(){
 210.139 +		return create(seq.next());
 210.140 +	}
 210.141 +
 210.142 +	public KeySeq withMeta(IPersistentMap meta){
 210.143 +		return new KeySeq(meta, seq);
 210.144 +	}
 210.145 +}
 210.146 +
 210.147 +static public class ValSeq extends ASeq{
 210.148 +	ISeq seq;
 210.149 +
 210.150 +	static public ValSeq create(ISeq seq){
 210.151 +		if(seq == null)
 210.152 +			return null;
 210.153 +		return new ValSeq(seq);
 210.154 +	}
 210.155 +
 210.156 +	private ValSeq(ISeq seq){
 210.157 +		this.seq = seq;
 210.158 +	}
 210.159 +
 210.160 +	private ValSeq(IPersistentMap meta, ISeq seq){
 210.161 +		super(meta);
 210.162 +		this.seq = seq;
 210.163 +	}
 210.164 +
 210.165 +	public Object first(){
 210.166 +		return ((Map.Entry) seq.first()).getValue();
 210.167 +	}
 210.168 +
 210.169 +	public ISeq next(){
 210.170 +		return create(seq.next());
 210.171 +	}
 210.172 +
 210.173 +	public ValSeq withMeta(IPersistentMap meta){
 210.174 +		return new ValSeq(meta, seq);
 210.175 +	}
 210.176 +}
 210.177 +
 210.178 +
 210.179 +public Object invoke(Object arg1) throws Exception{
 210.180 +	return valAt(arg1);
 210.181 +}
 210.182 +
 210.183 +public Object invoke(Object arg1, Object notFound) throws Exception{
 210.184 +	return valAt(arg1, notFound);
 210.185 +}
 210.186 +
 210.187 +// java.util.Map implementation
 210.188 +
 210.189 +public void clear(){
 210.190 +	throw new UnsupportedOperationException();
 210.191 +}
 210.192 +
 210.193 +public boolean containsValue(Object value){
 210.194 +	return values().contains(value);
 210.195 +}
 210.196 +
 210.197 +public Set entrySet(){
 210.198 +	return new AbstractSet(){
 210.199 +
 210.200 +		public Iterator iterator(){
 210.201 +			return APersistentMap.this.iterator();
 210.202 +		}
 210.203 +
 210.204 +		public int size(){
 210.205 +			return count();
 210.206 +		}
 210.207 +
 210.208 +		public int hashCode(){
 210.209 +			return APersistentMap.this.hashCode();
 210.210 +		}
 210.211 +
 210.212 +		public boolean contains(Object o){
 210.213 +			if(o instanceof Entry)
 210.214 +				{
 210.215 +				Entry e = (Entry) o;
 210.216 +				Entry found = entryAt(e.getKey());
 210.217 +				if(found != null && Util.equals(found.getValue(), e.getValue()))
 210.218 +					return true;
 210.219 +				}
 210.220 +			return false;
 210.221 +		}
 210.222 +	};
 210.223 +}
 210.224 +
 210.225 +public Object get(Object key){
 210.226 +	return valAt(key);
 210.227 +}
 210.228 +
 210.229 +public boolean isEmpty(){
 210.230 +	return count() == 0;
 210.231 +}
 210.232 +
 210.233 +public Set keySet(){
 210.234 +	return new AbstractSet(){
 210.235 +
 210.236 +		public Iterator iterator(){
 210.237 +			final Iterator mi = APersistentMap.this.iterator();
 210.238 +
 210.239 +			return new Iterator(){
 210.240 +
 210.241 +
 210.242 +				public boolean hasNext(){
 210.243 +					return mi.hasNext();
 210.244 +				}
 210.245 +
 210.246 +				public Object next(){
 210.247 +					Entry e = (Entry) mi.next();
 210.248 +					return e.getKey();
 210.249 +				}
 210.250 +
 210.251 +				public void remove(){
 210.252 +					throw new UnsupportedOperationException();
 210.253 +				}
 210.254 +			};
 210.255 +		}
 210.256 +
 210.257 +		public int size(){
 210.258 +			return count();
 210.259 +		}
 210.260 +
 210.261 +		public boolean contains(Object o){
 210.262 +			return APersistentMap.this.containsKey(o);
 210.263 +		}
 210.264 +	};
 210.265 +}
 210.266 +
 210.267 +public Object put(Object key, Object value){
 210.268 +	throw new UnsupportedOperationException();
 210.269 +}
 210.270 +
 210.271 +public void putAll(Map t){
 210.272 +	throw new UnsupportedOperationException();
 210.273 +}
 210.274 +
 210.275 +public Object remove(Object key){
 210.276 +	throw new UnsupportedOperationException();
 210.277 +}
 210.278 +
 210.279 +public int size(){
 210.280 +	return count();
 210.281 +}
 210.282 +
 210.283 +public Collection values(){
 210.284 +	return new AbstractCollection(){
 210.285 +
 210.286 +		public Iterator iterator(){
 210.287 +			final Iterator mi = APersistentMap.this.iterator();
 210.288 +
 210.289 +			return new Iterator(){
 210.290 +
 210.291 +
 210.292 +				public boolean hasNext(){
 210.293 +					return mi.hasNext();
 210.294 +				}
 210.295 +
 210.296 +				public Object next(){
 210.297 +					Entry e = (Entry) mi.next();
 210.298 +					return e.getValue();
 210.299 +				}
 210.300 +
 210.301 +				public void remove(){
 210.302 +					throw new UnsupportedOperationException();
 210.303 +				}
 210.304 +			};
 210.305 +		}
 210.306 +
 210.307 +		public int size(){
 210.308 +			return count();
 210.309 +		}
 210.310 +	};
 210.311 +}
 210.312 +
 210.313 +/*
 210.314 +// java.util.Collection implementation
 210.315 +
 210.316 +public Object[] toArray(){
 210.317 +	return RT.seqToArray(seq());
 210.318 +}
 210.319 +
 210.320 +public boolean add(Object o){
 210.321 +	throw new UnsupportedOperationException();
 210.322 +}
 210.323 +
 210.324 +public boolean remove(Object o){
 210.325 +	throw new UnsupportedOperationException();
 210.326 +}
 210.327 +
 210.328 +public boolean addAll(Collection c){
 210.329 +	throw new UnsupportedOperationException();
 210.330 +}
 210.331 +
 210.332 +public void clear(){
 210.333 +	throw new UnsupportedOperationException();
 210.334 +}
 210.335 +
 210.336 +public boolean retainAll(Collection c){
 210.337 +	throw new UnsupportedOperationException();
 210.338 +}
 210.339 +
 210.340 +public boolean removeAll(Collection c){
 210.341 +	throw new UnsupportedOperationException();
 210.342 +}
 210.343 +
 210.344 +public boolean containsAll(Collection c){
 210.345 +	for(Object o : c)
 210.346 +		{
 210.347 +		if(!contains(o))
 210.348 +			return false;
 210.349 +		}
 210.350 +	return true;
 210.351 +}
 210.352 +
 210.353 +public Object[] toArray(Object[] a){
 210.354 +	if(a.length >= count())
 210.355 +		{
 210.356 +		ISeq s = seq();
 210.357 +		for(int i = 0; s != null; ++i, s = s.rest())
 210.358 +			{
 210.359 +			a[i] = s.first();
 210.360 +			}
 210.361 +		if(a.length > count())
 210.362 +			a[count()] = null;
 210.363 +		return a;
 210.364 +		}
 210.365 +	else
 210.366 +		return toArray();
 210.367 +}
 210.368 +
 210.369 +public int size(){
 210.370 +	return count();
 210.371 +}
 210.372 +
 210.373 +public boolean isEmpty(){
 210.374 +	return count() == 0;
 210.375 +}
 210.376 +
 210.377 +public boolean contains(Object o){
 210.378 +	if(o instanceof Map.Entry)
 210.379 +		{
 210.380 +		Map.Entry e = (Map.Entry) o;
 210.381 +		Map.Entry v = entryAt(e.getKey());
 210.382 +		return (v != null && Util.equal(v.getValue(), e.getValue()));
 210.383 +		}
 210.384 +	return false;
 210.385 +}
 210.386 +*/
 210.387 +}
   211.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   211.2 +++ b/src/clojure/lang/APersistentSet.java	Sat Aug 21 06:25:44 2010 -0400
   211.3 @@ -0,0 +1,160 @@
   211.4 +/**
   211.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   211.6 + *   The use and distribution terms for this software are covered by the
   211.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   211.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   211.9 + *   By using this software in any fashion, you are agreeing to be bound by
  211.10 + * 	 the terms of this license.
  211.11 + *   You must not remove this notice, or any other, from this software.
  211.12 + **/
  211.13 +
  211.14 +/* rich Mar 3, 2008 */
  211.15 +
  211.16 +package clojure.lang;
  211.17 +
  211.18 +import java.io.Serializable;
  211.19 +import java.util.Collection;
  211.20 +import java.util.Iterator;
  211.21 +import java.util.Set;
  211.22 +
  211.23 +public abstract class APersistentSet extends AFn implements IPersistentSet, Collection, Set, Serializable {
  211.24 +int _hash = -1;
  211.25 +final IPersistentMap impl;
  211.26 +
  211.27 +protected APersistentSet(IPersistentMap impl){
  211.28 +	this.impl = impl;
  211.29 +}
  211.30 +
  211.31 +public String toString(){
  211.32 +	return RT.printString(this);
  211.33 +}
  211.34 +
  211.35 +public boolean contains(Object key){
  211.36 +	return impl.containsKey(key);
  211.37 +}
  211.38 +
  211.39 +public Object get(Object key){
  211.40 +	return impl.valAt(key);
  211.41 +}
  211.42 +
  211.43 +public int count(){
  211.44 +	return impl.count();
  211.45 +}
  211.46 +
  211.47 +public ISeq seq(){
  211.48 +	return RT.keys(impl);
  211.49 +}
  211.50 +
  211.51 +public Object invoke(Object arg1) throws Exception{
  211.52 +	return get(arg1);
  211.53 +}
  211.54 +
  211.55 +public boolean equals(Object obj){
  211.56 +	if(this == obj) return true;
  211.57 +	if(!(obj instanceof Set))
  211.58 +		return false;
  211.59 +	Set m = (Set) obj;
  211.60 +
  211.61 +	if(m.size() != count() || m.hashCode() != hashCode())
  211.62 +		return false;
  211.63 +
  211.64 +	for(Object aM : m)
  211.65 +		{
  211.66 +		if(!contains(aM))
  211.67 +			return false;
  211.68 +		}
  211.69 +//	for(ISeq s = seq(); s != null; s = s.rest())
  211.70 +//		{
  211.71 +//		if(!m.contains(s.first()))
  211.72 +//			return false;
  211.73 +//		}
  211.74 +
  211.75 +	return true;
  211.76 +}
  211.77 +
  211.78 +public boolean equiv(Object o){
  211.79 +	return equals(o);
  211.80 +}
  211.81 +
  211.82 +public int hashCode(){
  211.83 +	if(_hash == -1)
  211.84 +		{
  211.85 +		//int hash = count();
  211.86 +		int hash = 0;
  211.87 +		for(ISeq s = seq(); s != null; s = s.next())
  211.88 +			{
  211.89 +			Object e = s.first();
  211.90 +//			hash = Util.hashCombine(hash, Util.hash(e));
  211.91 +			hash +=  Util.hash(e);
  211.92 +			}
  211.93 +		this._hash = hash;
  211.94 +		}
  211.95 +	return _hash;
  211.96 +}
  211.97 +
  211.98 +public Object[] toArray(){
  211.99 +	return RT.seqToArray(seq());
 211.100 +}
 211.101 +
 211.102 +public boolean add(Object o){
 211.103 +	throw new UnsupportedOperationException();
 211.104 +}
 211.105 +
 211.106 +public boolean remove(Object o){
 211.107 +	throw new UnsupportedOperationException();
 211.108 +}
 211.109 +
 211.110 +public boolean addAll(Collection c){
 211.111 +	throw new UnsupportedOperationException();
 211.112 +}
 211.113 +
 211.114 +public void clear(){
 211.115 +	throw new UnsupportedOperationException();
 211.116 +}
 211.117 +
 211.118 +public boolean retainAll(Collection c){
 211.119 +	throw new UnsupportedOperationException();
 211.120 +}
 211.121 +
 211.122 +public boolean removeAll(Collection c){
 211.123 +	throw new UnsupportedOperationException();
 211.124 +}
 211.125 +
 211.126 +public boolean containsAll(Collection c){
 211.127 +	for(Object o : c)
 211.128 +		{
 211.129 +		if(!contains(o))
 211.130 +			return false;
 211.131 +		}
 211.132 +	return true;
 211.133 +}
 211.134 +
 211.135 +public Object[] toArray(Object[] a){
 211.136 +	if(a.length >= count())
 211.137 +		{
 211.138 +		ISeq s = seq();
 211.139 +		for(int i = 0; s != null; ++i, s = s.next())
 211.140 +			{
 211.141 +			a[i] = s.first();
 211.142 +			}
 211.143 +		if(a.length > count())
 211.144 +			a[count()] = null;
 211.145 +		return a;
 211.146 +		}
 211.147 +	else
 211.148 +		return toArray();
 211.149 +}
 211.150 +
 211.151 +public int size(){
 211.152 +	return count();
 211.153 +}
 211.154 +
 211.155 +public boolean isEmpty(){
 211.156 +	return count() == 0;
 211.157 +}
 211.158 +
 211.159 +public Iterator iterator(){
 211.160 +	return new SeqIterator(seq());
 211.161 +}
 211.162 +
 211.163 +}
   212.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   212.2 +++ b/src/clojure/lang/APersistentVector.java	Sat Aug 21 06:25:44 2010 -0400
   212.3 @@ -0,0 +1,568 @@
   212.4 +/**
   212.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   212.6 + *   The use and distribution terms for this software are covered by the
   212.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   212.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   212.9 + *   By using this software in any fashion, you are agreeing to be bound by
  212.10 + * 	 the terms of this license.
  212.11 + *   You must not remove this notice, or any other, from this software.
  212.12 + **/
  212.13 +
  212.14 +/* rich Dec 18, 2007 */
  212.15 +
  212.16 +package clojure.lang;
  212.17 +
  212.18 +import java.io.Serializable;
  212.19 +import java.util.*;
  212.20 +
  212.21 +public abstract class APersistentVector extends AFn implements IPersistentVector, Iterable,
  212.22 +                                                               List,
  212.23 +                                                               RandomAccess, Comparable,
  212.24 +                                                               Serializable {
  212.25 +int _hash = -1;
  212.26 +
  212.27 +public String toString(){
  212.28 +	return RT.printString(this);
  212.29 +}
  212.30 +
  212.31 +public ISeq seq(){
  212.32 +	if(count() > 0)
  212.33 +		return new Seq(this, 0);
  212.34 +	return null;
  212.35 +}
  212.36 +
  212.37 +public ISeq rseq(){
  212.38 +	if(count() > 0)
  212.39 +		return new RSeq(this, count() - 1);
  212.40 +	return null;
  212.41 +}
  212.42 +
  212.43 +static boolean doEquals(IPersistentVector v, Object obj){
  212.44 +	if(v == obj) return true;
  212.45 +	if(obj instanceof List || obj instanceof IPersistentVector)
  212.46 +		{
  212.47 +		Collection ma = (Collection) obj;
  212.48 +		if(ma.size() != v.count() || ma.hashCode() != v.hashCode())
  212.49 +			return false;
  212.50 +		for(Iterator i1 = ((List) v).iterator(), i2 = ma.iterator();
  212.51 +		    i1.hasNext();)
  212.52 +			{
  212.53 +			if(!Util.equals(i1.next(), i2.next()))
  212.54 +				return false;
  212.55 +			}
  212.56 +		return true;
  212.57 +		}
  212.58 +//	if(obj instanceof IPersistentVector)
  212.59 +//		{
  212.60 +//		IPersistentVector ma = (IPersistentVector) obj;
  212.61 +//		if(ma.count() != v.count() || ma.hashCode() != v.hashCode())
  212.62 +//			return false;
  212.63 +//		for(int i = 0; i < v.count(); i++)
  212.64 +//			{
  212.65 +//			if(!Util.equal(v.nth(i), ma.nth(i)))
  212.66 +//				return false;
  212.67 +//			}
  212.68 +//		}
  212.69 +	else
  212.70 +		{
  212.71 +		if(!(obj instanceof Sequential))
  212.72 +			return false;
  212.73 +		ISeq ms = RT.seq(obj);
  212.74 +		for(int i = 0; i < v.count(); i++, ms = ms.next())
  212.75 +			{
  212.76 +			if(ms == null || !Util.equals(v.nth(i), ms.first()))
  212.77 +				return false;
  212.78 +			}
  212.79 +		if(ms != null)
  212.80 +			return false;
  212.81 +		}
  212.82 +
  212.83 +	return true;
  212.84 +
  212.85 +}
  212.86 +
  212.87 +static boolean doEquiv(IPersistentVector v, Object obj){
  212.88 +	if(obj instanceof List || obj instanceof IPersistentVector)
  212.89 +		{
  212.90 +		Collection ma = (Collection) obj;
  212.91 +		if(ma.size() != v.count())
  212.92 +			return false;
  212.93 +		for(Iterator i1 = ((List) v).iterator(), i2 = ma.iterator();
  212.94 +		    i1.hasNext();)
  212.95 +			{
  212.96 +			if(!Util.equiv(i1.next(), i2.next()))
  212.97 +				return false;
  212.98 +			}
  212.99 +		return true;
 212.100 +		}
 212.101 +//	if(obj instanceof IPersistentVector)
 212.102 +//		{
 212.103 +//		IPersistentVector ma = (IPersistentVector) obj;
 212.104 +//		if(ma.count() != v.count() || ma.hashCode() != v.hashCode())
 212.105 +//			return false;
 212.106 +//		for(int i = 0; i < v.count(); i++)
 212.107 +//			{
 212.108 +//			if(!Util.equal(v.nth(i), ma.nth(i)))
 212.109 +//				return false;
 212.110 +//			}
 212.111 +//		}
 212.112 +	else
 212.113 +		{
 212.114 +		if(!(obj instanceof Sequential))
 212.115 +			return false;
 212.116 +		ISeq ms = RT.seq(obj);
 212.117 +		for(int i = 0; i < v.count(); i++, ms = ms.next())
 212.118 +			{
 212.119 +			if(ms == null || !Util.equiv(v.nth(i), ms.first()))
 212.120 +				return false;
 212.121 +			}
 212.122 +		if(ms != null)
 212.123 +			return false;
 212.124 +		}
 212.125 +
 212.126 +	return true;
 212.127 +
 212.128 +}
 212.129 +
 212.130 +public boolean equals(Object obj){
 212.131 +	return doEquals(this, obj);
 212.132 +}
 212.133 +
 212.134 +public boolean equiv(Object obj){
 212.135 +	return doEquiv(this, obj);
 212.136 +}
 212.137 +
 212.138 +public int hashCode(){
 212.139 +	if(_hash == -1)
 212.140 +		{
 212.141 +		int hash = 1;
 212.142 +		Iterator i = iterator();
 212.143 +		while(i.hasNext())
 212.144 +			{
 212.145 +			Object obj = i.next();
 212.146 +			hash = 31 * hash + (obj == null ? 0 : obj.hashCode());
 212.147 +			}
 212.148 +//		int hash = 0;
 212.149 +//		for(int i = 0; i < count(); i++)
 212.150 +//			{
 212.151 +//			hash = Util.hashCombine(hash, Util.hash(nth(i)));
 212.152 +//			}
 212.153 +		this._hash = hash;
 212.154 +		}
 212.155 +	return _hash;
 212.156 +}
 212.157 +
 212.158 +public Object get(int index){
 212.159 +	return nth(index);
 212.160 +}
 212.161 +
 212.162 +public Object nth(int i, Object notFound){
 212.163 +	if(i >= 0 && i < count())
 212.164 +		return nth(i);
 212.165 +	return notFound;
 212.166 +}
 212.167 +
 212.168 +public Object remove(int i){
 212.169 +	throw new UnsupportedOperationException();
 212.170 +}
 212.171 +
 212.172 +public int indexOf(Object o){
 212.173 +	for(int i = 0; i < count(); i++)
 212.174 +		if(Util.equiv(nth(i), o))
 212.175 +			return i;
 212.176 +	return -1;
 212.177 +}
 212.178 +
 212.179 +public int lastIndexOf(Object o){
 212.180 +	for(int i = count() - 1; i >= 0; i--)
 212.181 +		if(Util.equiv(nth(i), o))
 212.182 +			return i;
 212.183 +	return -1;
 212.184 +}
 212.185 +
 212.186 +public ListIterator listIterator(){
 212.187 +	return listIterator(0);
 212.188 +}
 212.189 +
 212.190 +public ListIterator listIterator(final int index){
 212.191 +	return new ListIterator(){
 212.192 +		int nexti = index;
 212.193 +
 212.194 +		public boolean hasNext(){
 212.195 +			return nexti < count();
 212.196 +		}
 212.197 +
 212.198 +		public Object next(){
 212.199 +			return nth(nexti++);
 212.200 +		}
 212.201 +
 212.202 +		public boolean hasPrevious(){
 212.203 +			return nexti > 0;
 212.204 +		}
 212.205 +
 212.206 +		public Object previous(){
 212.207 +			return nth(--nexti);
 212.208 +		}
 212.209 +
 212.210 +		public int nextIndex(){
 212.211 +			return nexti;
 212.212 +		}
 212.213 +
 212.214 +		public int previousIndex(){
 212.215 +			return nexti - 1;
 212.216 +		}
 212.217 +
 212.218 +		public void remove(){
 212.219 +			throw new UnsupportedOperationException();
 212.220 +		}
 212.221 +
 212.222 +		public void set(Object o){
 212.223 +			throw new UnsupportedOperationException();
 212.224 +		}
 212.225 +
 212.226 +		public void add(Object o){
 212.227 +			throw new UnsupportedOperationException();
 212.228 +		}
 212.229 +	};
 212.230 +}
 212.231 +
 212.232 +public List subList(int fromIndex, int toIndex){
 212.233 +	return (List) RT.subvec(this, fromIndex, toIndex);
 212.234 +}
 212.235 +
 212.236 +
 212.237 +public Object set(int i, Object o){
 212.238 +	throw new UnsupportedOperationException();
 212.239 +}
 212.240 +
 212.241 +public void add(int i, Object o){
 212.242 +	throw new UnsupportedOperationException();
 212.243 +}
 212.244 +
 212.245 +public boolean addAll(int i, Collection c){
 212.246 +	throw new UnsupportedOperationException();
 212.247 +}
 212.248 +
 212.249 +
 212.250 +public Object invoke(Object arg1) throws Exception{
 212.251 +	if(Util.isInteger(arg1))
 212.252 +		return nth(((Number) arg1).intValue());
 212.253 +	throw new IllegalArgumentException("Key must be integer");
 212.254 +}
 212.255 +
 212.256 +public Iterator iterator(){
 212.257 +	//todo - something more efficient
 212.258 +	return new Iterator(){
 212.259 +		int i = 0;
 212.260 +
 212.261 +		public boolean hasNext(){
 212.262 +			return i < count();
 212.263 +		}
 212.264 +
 212.265 +		public Object next(){
 212.266 +			return nth(i++);
 212.267 +		}
 212.268 +
 212.269 +		public void remove(){
 212.270 +			throw new UnsupportedOperationException();
 212.271 +		}
 212.272 +	};
 212.273 +}
 212.274 +
 212.275 +public Object peek(){
 212.276 +	if(count() > 0)
 212.277 +		return nth(count() - 1);
 212.278 +	return null;
 212.279 +}
 212.280 +
 212.281 +public boolean containsKey(Object key){
 212.282 +	if(!(Util.isInteger(key)))
 212.283 +		return false;
 212.284 +	int i = ((Number) key).intValue();
 212.285 +	return i >= 0 && i < count();
 212.286 +}
 212.287 +
 212.288 +public IMapEntry entryAt(Object key){
 212.289 +	if(Util.isInteger(key))
 212.290 +		{
 212.291 +		int i = ((Number) key).intValue();
 212.292 +		if(i >= 0 && i < count())
 212.293 +			return new MapEntry(key, nth(i));
 212.294 +		}
 212.295 +	return null;
 212.296 +}
 212.297 +
 212.298 +public IPersistentVector assoc(Object key, Object val){
 212.299 +	if(Util.isInteger(key))
 212.300 +		{
 212.301 +		int i = ((Number) key).intValue();
 212.302 +		return assocN(i, val);
 212.303 +		}
 212.304 +	throw new IllegalArgumentException("Key must be integer");
 212.305 +}
 212.306 +
 212.307 +public Object valAt(Object key, Object notFound){
 212.308 +	if(Util.isInteger(key))
 212.309 +		{
 212.310 +		int i = ((Number) key).intValue();
 212.311 +		if(i >= 0 && i < count())
 212.312 +			return nth(i);
 212.313 +		}
 212.314 +	return notFound;
 212.315 +}
 212.316 +
 212.317 +public Object valAt(Object key){
 212.318 +	return valAt(key, null);
 212.319 +}
 212.320 +
 212.321 +// java.util.Collection implementation
 212.322 +
 212.323 +public Object[] toArray(){
 212.324 +	return RT.seqToArray(seq());
 212.325 +}
 212.326 +
 212.327 +public boolean add(Object o){
 212.328 +	throw new UnsupportedOperationException();
 212.329 +}
 212.330 +
 212.331 +public boolean remove(Object o){
 212.332 +	throw new UnsupportedOperationException();
 212.333 +}
 212.334 +
 212.335 +public boolean addAll(Collection c){
 212.336 +	throw new UnsupportedOperationException();
 212.337 +}
 212.338 +
 212.339 +public void clear(){
 212.340 +	throw new UnsupportedOperationException();
 212.341 +}
 212.342 +
 212.343 +public boolean retainAll(Collection c){
 212.344 +	throw new UnsupportedOperationException();
 212.345 +}
 212.346 +
 212.347 +public boolean removeAll(Collection c){
 212.348 +	throw new UnsupportedOperationException();
 212.349 +}
 212.350 +
 212.351 +public boolean containsAll(Collection c){
 212.352 +	for(Object o : c)
 212.353 +		{
 212.354 +		if(!contains(o))
 212.355 +			return false;
 212.356 +		}
 212.357 +	return true;
 212.358 +}
 212.359 +
 212.360 +public Object[] toArray(Object[] a){
 212.361 +	if(a.length >= count())
 212.362 +		{
 212.363 +		ISeq s = seq();
 212.364 +		for(int i = 0; s != null; ++i, s = s.next())
 212.365 +			{
 212.366 +			a[i] = s.first();
 212.367 +			}
 212.368 +		if(a.length > count())
 212.369 +			a[count()] = null;
 212.370 +		return a;
 212.371 +		}
 212.372 +	else
 212.373 +		return toArray();
 212.374 +}
 212.375 +
 212.376 +public int size(){
 212.377 +	return count();
 212.378 +}
 212.379 +
 212.380 +public boolean isEmpty(){
 212.381 +	return count() == 0;
 212.382 +}
 212.383 +
 212.384 +public boolean contains(Object o){
 212.385 +	for(ISeq s = seq(); s != null; s = s.next())
 212.386 +		{
 212.387 +		if(Util.equiv(s.first(), o))
 212.388 +			return true;
 212.389 +		}
 212.390 +	return false;
 212.391 +}
 212.392 +
 212.393 +public int length(){
 212.394 +	return count();
 212.395 +}
 212.396 +
 212.397 +public int compareTo(Object o){
 212.398 +	IPersistentVector v = (IPersistentVector) o;
 212.399 +	if(count() < v.count())
 212.400 +		return -1;
 212.401 +	else if(count() > v.count())
 212.402 +		return 1;
 212.403 +	for(int i = 0; i < count(); i++)
 212.404 +		{
 212.405 +		int c = Util.compare(nth(i),v.nth(i));
 212.406 +		if(c != 0)
 212.407 +			return c;
 212.408 +		}
 212.409 +	return 0;
 212.410 +}
 212.411 +
 212.412 +    static class Seq extends ASeq implements IndexedSeq, IReduce{
 212.413 +	//todo - something more efficient
 212.414 +	final IPersistentVector v;
 212.415 +	final int i;
 212.416 +
 212.417 +
 212.418 +	public Seq(IPersistentVector v, int i){
 212.419 +		this.v = v;
 212.420 +		this.i = i;
 212.421 +	}
 212.422 +
 212.423 +	Seq(IPersistentMap meta, IPersistentVector v, int i){
 212.424 +		super(meta);
 212.425 +		this.v = v;
 212.426 +		this.i = i;
 212.427 +	}
 212.428 +
 212.429 +	public Object first(){
 212.430 +		return v.nth(i);
 212.431 +	}
 212.432 +
 212.433 +	public ISeq next(){
 212.434 +		if(i + 1 < v.count())
 212.435 +			return new APersistentVector.Seq(v, i + 1);
 212.436 +		return null;
 212.437 +	}
 212.438 +
 212.439 +	public int index(){
 212.440 +		return i;
 212.441 +	}
 212.442 +
 212.443 +	public int count(){
 212.444 +		return v.count() - i;
 212.445 +	}
 212.446 +
 212.447 +	public APersistentVector.Seq withMeta(IPersistentMap meta){
 212.448 +		return new APersistentVector.Seq(meta, v, i);
 212.449 +	}
 212.450 +
 212.451 +	public Object reduce(IFn f) throws Exception{
 212.452 +		Object ret = v.nth(i);
 212.453 +		for(int x = i + 1; x < v.count(); x++)
 212.454 +			ret = f.invoke(ret, v.nth(x));
 212.455 +		return ret;
 212.456 +	}
 212.457 +
 212.458 +	public Object reduce(IFn f, Object start) throws Exception{
 212.459 +		Object ret = f.invoke(start, v.nth(i));
 212.460 +		for(int x = i + 1; x < v.count(); x++)
 212.461 +			ret = f.invoke(ret, v.nth(x));
 212.462 +		return ret;
 212.463 +	}
 212.464 +    }
 212.465 +
 212.466 +public static class RSeq extends ASeq implements IndexedSeq, Counted{
 212.467 +	final IPersistentVector v;
 212.468 +	final int i;
 212.469 +
 212.470 +	public RSeq(IPersistentVector vector, int i){
 212.471 +		this.v = vector;
 212.472 +		this.i = i;
 212.473 +	}
 212.474 +
 212.475 +	RSeq(IPersistentMap meta, IPersistentVector v, int i){
 212.476 +		super(meta);
 212.477 +		this.v = v;
 212.478 +		this.i = i;
 212.479 +	}
 212.480 +
 212.481 +	public Object first(){
 212.482 +		return v.nth(i);
 212.483 +	}
 212.484 +
 212.485 +	public ISeq next(){
 212.486 +		if(i > 0)
 212.487 +			return new APersistentVector.RSeq(v, i - 1);
 212.488 +		return null;
 212.489 +	}
 212.490 +
 212.491 +	public int index(){
 212.492 +		return i;
 212.493 +	}
 212.494 +
 212.495 +	public int count(){
 212.496 +		return i + 1;
 212.497 +	}
 212.498 +
 212.499 +	public APersistentVector.RSeq withMeta(IPersistentMap meta){
 212.500 +		return new APersistentVector.RSeq(meta, v, i);
 212.501 +	}
 212.502 +}
 212.503 +
 212.504 +static class SubVector extends APersistentVector implements IObj{
 212.505 +	final IPersistentVector v;
 212.506 +	final int start;
 212.507 +	final int end;
 212.508 +	final IPersistentMap _meta;
 212.509 +
 212.510 +
 212.511 +
 212.512 +	public SubVector(IPersistentMap meta, IPersistentVector v, int start, int end){
 212.513 +		this._meta = meta;
 212.514 +
 212.515 +		if(v instanceof APersistentVector.SubVector)
 212.516 +			{
 212.517 +			APersistentVector.SubVector sv = (APersistentVector.SubVector) v;
 212.518 +			start += sv.start;
 212.519 +			end += sv.start;
 212.520 +			v = sv.v;
 212.521 +			}
 212.522 +		this.v = v;
 212.523 +		this.start = start;
 212.524 +		this.end = end;
 212.525 +	}
 212.526 +
 212.527 +	public Object nth(int i){
 212.528 +		if(start + i >= end)
 212.529 +			throw new IndexOutOfBoundsException();
 212.530 +		return v.nth(start + i);
 212.531 +	}
 212.532 +
 212.533 +	public IPersistentVector assocN(int i, Object val){
 212.534 +		if(start + i > end)
 212.535 +			throw new IndexOutOfBoundsException();
 212.536 +		else if(start + i == end)
 212.537 +			return cons(val);
 212.538 +		return new SubVector(_meta, v.assocN(start + i, val), start, end);
 212.539 +	}
 212.540 +
 212.541 +	public int count(){
 212.542 +		return end - start;
 212.543 +	}
 212.544 +
 212.545 +	public IPersistentVector cons(Object o){
 212.546 +		return new SubVector(_meta, v.assocN(end, o), start, end + 1);
 212.547 +	}
 212.548 +
 212.549 +	public IPersistentCollection empty(){
 212.550 +		return PersistentVector.EMPTY.withMeta(meta());
 212.551 +	}
 212.552 +
 212.553 +	public IPersistentStack pop(){
 212.554 +		if(end - 1 == start)
 212.555 +			{
 212.556 +			return PersistentVector.EMPTY;
 212.557 +			}
 212.558 +		return new SubVector(_meta, v, start, end - 1);
 212.559 +	}
 212.560 +
 212.561 +	public SubVector withMeta(IPersistentMap meta){
 212.562 +		if(meta == _meta)
 212.563 +			return this;
 212.564 +		return new SubVector(meta, v, start, end);
 212.565 +	}
 212.566 +
 212.567 +	public IPersistentMap meta(){
 212.568 +		return _meta;
 212.569 +	}
 212.570 +}
 212.571 +}
   213.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   213.2 +++ b/src/clojure/lang/ARef.java	Sat Aug 21 06:25:44 2010 -0400
   213.3 @@ -0,0 +1,107 @@
   213.4 +/**
   213.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   213.6 + *   The use and distribution terms for this software are covered by the
   213.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   213.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   213.9 + *   By using this software in any fashion, you are agreeing to be bound by
  213.10 + * 	 the terms of this license.
  213.11 + *   You must not remove this notice, or any other, from this software.
  213.12 + **/
  213.13 +
  213.14 +/* rich Jan 1, 2009 */
  213.15 +
  213.16 +package clojure.lang;
  213.17 +
  213.18 +import java.util.Map;
  213.19 +
  213.20 +public abstract class ARef extends AReference implements IRef{
  213.21 +protected volatile IFn validator = null;
  213.22 +private volatile IPersistentMap watches = PersistentHashMap.EMPTY;
  213.23 +
  213.24 +public ARef(){
  213.25 +	super();
  213.26 +}
  213.27 +
  213.28 +public ARef(IPersistentMap meta){
  213.29 +	super(meta);
  213.30 +}
  213.31 +
  213.32 +void validate(IFn vf, Object val){
  213.33 +	try
  213.34 +		{
  213.35 +		if(vf != null && !RT.booleanCast(vf.invoke(val)))
  213.36 +			throw new IllegalStateException("Invalid reference state");
  213.37 +		}
  213.38 +	catch(RuntimeException re)
  213.39 +		{
  213.40 +		throw re;
  213.41 +		}
  213.42 +	catch(Exception e)
  213.43 +		{
  213.44 +		throw new IllegalStateException("Invalid reference state", e);
  213.45 +		}
  213.46 +}
  213.47 +
  213.48 +void validate(Object val){
  213.49 +	validate(validator, val);
  213.50 +}
  213.51 +
  213.52 +public void setValidator(IFn vf){
  213.53 +	try
  213.54 +		{
  213.55 +		validate(vf, deref());
  213.56 +		}
  213.57 +	catch(Exception e)
  213.58 +		{
  213.59 +		throw new RuntimeException(e);
  213.60 +		}
  213.61 +	validator = vf;
  213.62 +}
  213.63 +
  213.64 +public IFn getValidator(){
  213.65 +	return validator;
  213.66 +}
  213.67 +
  213.68 +public IPersistentMap getWatches(){
  213.69 +	return watches;
  213.70 +}
  213.71 +
  213.72 +synchronized public IRef addWatch(Object key, IFn callback){
  213.73 +	watches = watches.assoc(key, callback);
  213.74 +	return this;
  213.75 +}
  213.76 +
  213.77 +synchronized public IRef removeWatch(Object key){
  213.78 +	try
  213.79 +		{
  213.80 +		watches = watches.without(key);
  213.81 +		}
  213.82 +	catch(Exception e)
  213.83 +		{
  213.84 +		throw new RuntimeException(e);
  213.85 +		}
  213.86 +
  213.87 +	return this;
  213.88 +}
  213.89 +
  213.90 +public void notifyWatches(Object oldval, Object newval){
  213.91 +	IPersistentMap ws = watches;
  213.92 +	if(ws.count() > 0)
  213.93 +		{
  213.94 +		for(ISeq s = ws.seq(); s != null; s = s.next())
  213.95 +			{
  213.96 +			Map.Entry e = (Map.Entry) s.first();
  213.97 +			IFn fn = (IFn) e.getValue();
  213.98 +			try
  213.99 +				{
 213.100 +				if(fn != null)
 213.101 +					fn.invoke(e.getKey(), this, oldval, newval);
 213.102 +				}
 213.103 +			catch(Exception e1)
 213.104 +				{
 213.105 +				throw new RuntimeException(e1);
 213.106 +				}
 213.107 +			}
 213.108 +		}
 213.109 +}
 213.110 +}
   214.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   214.2 +++ b/src/clojure/lang/AReference.java	Sat Aug 21 06:25:44 2010 -0400
   214.3 @@ -0,0 +1,40 @@
   214.4 +/**
   214.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   214.6 + *   The use and distribution terms for this software are covered by the
   214.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   214.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   214.9 + *   By using this software in any fashion, you are agreeing to be bound by
  214.10 + * 	 the terms of this license.
  214.11 + *   You must not remove this notice, or any other, from this software.
  214.12 + **/
  214.13 +
  214.14 +/* rich Dec 31, 2008 */
  214.15 +
  214.16 +package clojure.lang;
  214.17 +
  214.18 +public class AReference implements IReference {
  214.19 +    private IPersistentMap _meta;
  214.20 +
  214.21 +    public AReference() {
  214.22 +        this(null);
  214.23 +    }
  214.24 +
  214.25 +    public AReference(IPersistentMap meta) {
  214.26 +        _meta = meta;
  214.27 +    }
  214.28 +
  214.29 +    synchronized public IPersistentMap meta() {
  214.30 +        return _meta;
  214.31 +    }
  214.32 +
  214.33 +    synchronized public IPersistentMap alterMeta(IFn alter, ISeq args) throws Exception {
  214.34 +        _meta = (IPersistentMap) alter.applyTo(new Cons(_meta, args));
  214.35 +        return _meta;
  214.36 +    }
  214.37 +
  214.38 +    synchronized public IPersistentMap resetMeta(IPersistentMap m) {
  214.39 +        _meta = m;
  214.40 +        return m;
  214.41 +    }
  214.42 +
  214.43 +}
   215.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   215.2 +++ b/src/clojure/lang/ASeq.java	Sat Aug 21 06:25:44 2010 -0400
   215.3 @@ -0,0 +1,259 @@
   215.4 +/**
   215.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   215.6 + *   The use and distribution terms for this software are covered by the
   215.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   215.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   215.9 + *   By using this software in any fashion, you are agreeing to be bound by
  215.10 + * 	 the terms of this license.
  215.11 + *   You must not remove this notice, or any other, from this software.
  215.12 + **/
  215.13 +
  215.14 +package clojure.lang;
  215.15 +
  215.16 +import java.io.Serializable;
  215.17 +import java.util.*;
  215.18 +
  215.19 +public abstract class ASeq extends Obj implements ISeq, List, Serializable {
  215.20 +transient int _hash = -1;
  215.21 +
  215.22 +public String toString(){
  215.23 +	return RT.printString(this);
  215.24 +}
  215.25 +
  215.26 +public IPersistentCollection empty(){
  215.27 +	return PersistentList.EMPTY;
  215.28 +}
  215.29 +
  215.30 +protected ASeq(IPersistentMap meta){
  215.31 +	super(meta);
  215.32 +}
  215.33 +
  215.34 +
  215.35 +protected ASeq(){
  215.36 +}
  215.37 +
  215.38 +public boolean equiv(Object obj){
  215.39 +
  215.40 +	if(!(obj instanceof Sequential || obj instanceof List))
  215.41 +		return false;
  215.42 +	ISeq ms = RT.seq(obj);
  215.43 +	for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next())
  215.44 +		{
  215.45 +		if(ms == null || !Util.equiv(s.first(), ms.first()))
  215.46 +			return false;
  215.47 +		}
  215.48 +	return ms == null;
  215.49 +
  215.50 +}
  215.51 +
  215.52 +public boolean equals(Object obj){
  215.53 +	if(this == obj) return true;
  215.54 +	if(!(obj instanceof Sequential || obj instanceof List))
  215.55 +		return false;
  215.56 +	ISeq ms = RT.seq(obj);
  215.57 +	for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next())
  215.58 +		{
  215.59 +		if(ms == null || !Util.equals(s.first(), ms.first()))
  215.60 +			return false;
  215.61 +		}
  215.62 +	return ms == null;
  215.63 +
  215.64 +}
  215.65 +
  215.66 +public int hashCode(){
  215.67 +	if(_hash == -1)
  215.68 +		{
  215.69 +		int hash = 1;
  215.70 +		for(ISeq s = seq(); s != null; s = s.next())
  215.71 +			{
  215.72 +			hash = 31 * hash + (s.first() == null ? 0 : s.first().hashCode());
  215.73 +			}
  215.74 +		this._hash = hash;
  215.75 +		}
  215.76 +	return _hash;
  215.77 +}
  215.78 +
  215.79 +
  215.80 +//public Object reduce(IFn f) throws Exception{
  215.81 +//	Object ret = first();
  215.82 +//	for(ISeq s = rest(); s != null; s = s.rest())
  215.83 +//		ret = f.invoke(ret, s.first());
  215.84 +//	return ret;
  215.85 +//}
  215.86 +//
  215.87 +//public Object reduce(IFn f, Object start) throws Exception{
  215.88 +//	Object ret = f.invoke(start, first());
  215.89 +//	for(ISeq s = rest(); s != null; s = s.rest())
  215.90 +//		ret = f.invoke(ret, s.first());
  215.91 +//	return ret;
  215.92 +//}
  215.93 +
  215.94 +//public Object peek(){
  215.95 +//	return first();
  215.96 +//}
  215.97 +//
  215.98 +//public IPersistentList pop(){
  215.99 +//	return rest();
 215.100 +//}
 215.101 +
 215.102 +public int count(){
 215.103 +	int i = 1;
 215.104 +	for(ISeq s = next(); s != null; s = s.next(), i++)
 215.105 +		if(s instanceof Counted)
 215.106 +			return i + s.count();
 215.107 +	return i;
 215.108 +}
 215.109 +
 215.110 +final public ISeq seq(){
 215.111 +	return this;
 215.112 +}
 215.113 +
 215.114 +public ISeq cons(Object o){
 215.115 +	return new Cons(o, this);
 215.116 +}
 215.117 +
 215.118 +public ISeq more(){
 215.119 +    ISeq s = next();
 215.120 +    if(s == null)
 215.121 +        return PersistentList.EMPTY;
 215.122 +    return s;
 215.123 +}
 215.124 +
 215.125 +//final public ISeq rest(){
 215.126 +//    Seqable m = more();
 215.127 +//    if(m == null)
 215.128 +//        return null;
 215.129 +//    return m.seq();
 215.130 +//}
 215.131 +
 215.132 +// java.util.Collection implementation
 215.133 +
 215.134 +public Object[] toArray(){
 215.135 +	return RT.seqToArray(seq());
 215.136 +}
 215.137 +
 215.138 +public boolean add(Object o){
 215.139 +	throw new UnsupportedOperationException();
 215.140 +}
 215.141 +
 215.142 +public boolean remove(Object o){
 215.143 +	throw new UnsupportedOperationException();
 215.144 +}
 215.145 +
 215.146 +public boolean addAll(Collection c){
 215.147 +	throw new UnsupportedOperationException();
 215.148 +}
 215.149 +
 215.150 +public void clear(){
 215.151 +	throw new UnsupportedOperationException();
 215.152 +}
 215.153 +
 215.154 +public boolean retainAll(Collection c){
 215.155 +	throw new UnsupportedOperationException();
 215.156 +}
 215.157 +
 215.158 +public boolean removeAll(Collection c){
 215.159 +	throw new UnsupportedOperationException();
 215.160 +}
 215.161 +
 215.162 +public boolean containsAll(Collection c){
 215.163 +	for(Object o : c)
 215.164 +		{
 215.165 +		if(!contains(o))
 215.166 +			return false;
 215.167 +		}
 215.168 +	return true;
 215.169 +}
 215.170 +
 215.171 +public Object[] toArray(Object[] a){
 215.172 +	if(a.length >= count())
 215.173 +		{
 215.174 +		ISeq s = seq();
 215.175 +		for(int i = 0; s != null; ++i, s = s.next())
 215.176 +			{
 215.177 +			a[i] = s.first();
 215.178 +			}
 215.179 +		if(a.length > count())
 215.180 +			a[count()] = null;
 215.181 +		return a;
 215.182 +		}
 215.183 +	else
 215.184 +		return toArray();
 215.185 +}
 215.186 +
 215.187 +public int size(){
 215.188 +	return count();
 215.189 +}
 215.190 +
 215.191 +public boolean isEmpty(){
 215.192 +	return seq() == null;
 215.193 +}
 215.194 +
 215.195 +public boolean contains(Object o){
 215.196 +	for(ISeq s = seq(); s != null; s = s.next())
 215.197 +		{
 215.198 +		if(Util.equiv(s.first(), o))
 215.199 +			return true;
 215.200 +		}
 215.201 +	return false;
 215.202 +}
 215.203 +
 215.204 +
 215.205 +public Iterator iterator(){
 215.206 +	return new SeqIterator(this);
 215.207 +}
 215.208 +
 215.209 +
 215.210 +
 215.211 +//////////// List stuff /////////////////
 215.212 +private List reify(){
 215.213 +	return Collections.unmodifiableList(new ArrayList(this));
 215.214 +}
 215.215 +
 215.216 +public List subList(int fromIndex, int toIndex){
 215.217 +	return reify().subList(fromIndex, toIndex);
 215.218 +}
 215.219 +
 215.220 +public Object set(int index, Object element){
 215.221 +	throw new UnsupportedOperationException();
 215.222 +}
 215.223 +
 215.224 +public Object remove(int index){
 215.225 +	throw new UnsupportedOperationException();
 215.226 +}
 215.227 +
 215.228 +public int indexOf(Object o){
 215.229 +	ISeq s = seq();
 215.230 +	for(int i = 0; s != null; s = s.next(), i++)
 215.231 +		{
 215.232 +		if(Util.equiv(s.first(), o))
 215.233 +			return i;
 215.234 +		}
 215.235 +	return -1;
 215.236 +}
 215.237 +
 215.238 +public int lastIndexOf(Object o){
 215.239 +	return reify().lastIndexOf(o);
 215.240 +}
 215.241 +
 215.242 +public ListIterator listIterator(){
 215.243 +	return reify().listIterator();
 215.244 +}
 215.245 +
 215.246 +public ListIterator listIterator(int index){
 215.247 +	return reify().listIterator(index);
 215.248 +}
 215.249 +
 215.250 +public Object get(int index){
 215.251 +	return RT.nth(this, index);
 215.252 +}
 215.253 +
 215.254 +public void add(int index, Object element){
 215.255 +	throw new UnsupportedOperationException();
 215.256 +}
 215.257 +
 215.258 +public boolean addAll(int index, Collection c){
 215.259 +	throw new UnsupportedOperationException();
 215.260 +}
 215.261 +
 215.262 +}
   216.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   216.2 +++ b/src/clojure/lang/ATransientMap.java	Sat Aug 21 06:25:44 2010 -0400
   216.3 @@ -0,0 +1,86 @@
   216.4 +/**
   216.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   216.6 + *   The use and distribution terms for this software are covered by the
   216.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   216.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   216.9 + *   By using this software in any fashion, you are agreeing to be bound by
  216.10 + * 	 the terms of this license.
  216.11 + *   You must not remove this notice, or any other, from this software.
  216.12 + **/
  216.13 +
  216.14 +package clojure.lang;
  216.15 +
  216.16 +import java.util.Map;
  216.17 +
  216.18 +import clojure.lang.PersistentHashMap.INode;
  216.19 +
  216.20 +abstract class ATransientMap extends AFn implements ITransientMap {
  216.21 +	abstract void ensureEditable();
  216.22 +	abstract ITransientMap doAssoc(Object key, Object val);
  216.23 +	abstract ITransientMap doWithout(Object key);
  216.24 +	abstract Object doValAt(Object key, Object notFound);
  216.25 +	abstract int doCount();
  216.26 +	abstract IPersistentMap doPersistent();
  216.27 +
  216.28 +	public ITransientMap conj(Object o) {
  216.29 +		ensureEditable();
  216.30 +		if(o instanceof Map.Entry)
  216.31 +			{
  216.32 +			Map.Entry e = (Map.Entry) o;
  216.33 +		
  216.34 +			return assoc(e.getKey(), e.getValue());
  216.35 +			}
  216.36 +		else if(o instanceof IPersistentVector)
  216.37 +			{
  216.38 +			IPersistentVector v = (IPersistentVector) o;
  216.39 +			if(v.count() != 2)
  216.40 +				throw new IllegalArgumentException("Vector arg to map conj must be a pair");
  216.41 +			return assoc(v.nth(0), v.nth(1));
  216.42 +			}
  216.43 +		
  216.44 +		ITransientMap ret = this;
  216.45 +		for(ISeq es = RT.seq(o); es != null; es = es.next())
  216.46 +			{
  216.47 +			Map.Entry e = (Map.Entry) es.first();
  216.48 +			ret = ret.assoc(e.getKey(), e.getValue());
  216.49 +			}
  216.50 +		return ret;
  216.51 +	}
  216.52 +
  216.53 +	public final Object invoke(Object arg1) throws Exception{
  216.54 +		return valAt(arg1);
  216.55 +	}
  216.56 +
  216.57 +	public final Object invoke(Object arg1, Object notFound) throws Exception{
  216.58 +		return valAt(arg1, notFound);
  216.59 +	}
  216.60 +
  216.61 +	public final Object valAt(Object key) {
  216.62 +		return valAt(key, null);
  216.63 +	}
  216.64 +
  216.65 +	public final ITransientMap assoc(Object key, Object val) {
  216.66 +		ensureEditable();
  216.67 +		return doAssoc(key, val);
  216.68 +	}
  216.69 +
  216.70 +	public final ITransientMap without(Object key) {
  216.71 +		ensureEditable();
  216.72 +		return doWithout(key);
  216.73 +	}
  216.74 +
  216.75 +	public final IPersistentMap persistent() {
  216.76 +		ensureEditable();
  216.77 +		return doPersistent();
  216.78 +	}
  216.79 +
  216.80 +	public final Object valAt(Object key, Object notFound) {
  216.81 +		ensureEditable();
  216.82 +		return doValAt(key, notFound);
  216.83 +	}
  216.84 +
  216.85 +	public final int count() {
  216.86 +		ensureEditable();
  216.87 +		return doCount();
  216.88 +	}
  216.89 +}
   217.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   217.2 +++ b/src/clojure/lang/ATransientSet.java	Sat Aug 21 06:25:44 2010 -0400
   217.3 @@ -0,0 +1,54 @@
   217.4 +/**
   217.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   217.6 + *   The use and distribution terms for this software are covered by the
   217.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   217.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   217.9 + *   By using this software in any fashion, you are agreeing to be bound by
  217.10 + * 	 the terms of this license.
  217.11 + *   You must not remove this notice, or any other, from this software.
  217.12 + **/
  217.13 +
  217.14 +/* rich Mar 3, 2008 */
  217.15 +
  217.16 +package clojure.lang;
  217.17 +
  217.18 +public abstract class ATransientSet extends AFn implements ITransientSet{
  217.19 +	ITransientMap impl;
  217.20 +
  217.21 +	ATransientSet(ITransientMap impl) {
  217.22 +		this.impl = impl;
  217.23 +	}
  217.24 +	
  217.25 +	public int count() {
  217.26 +		return impl.count();
  217.27 +	}
  217.28 +
  217.29 +	public ITransientSet conj(Object val) {
  217.30 +		ITransientMap m = impl.assoc(val, val);
  217.31 +		if (m != impl) this.impl = m;
  217.32 +		return this;
  217.33 +	}
  217.34 +
  217.35 +	public boolean contains(Object key) {
  217.36 +		return this != impl.valAt(key, this);
  217.37 +	}
  217.38 +
  217.39 +	public ITransientSet disjoin(Object key) throws Exception {
  217.40 +		ITransientMap m = impl.without(key);
  217.41 +		if (m != impl) this.impl = m;
  217.42 +		return this;
  217.43 +	}
  217.44 +
  217.45 +	public Object get(Object key) {
  217.46 +		return impl.valAt(key);
  217.47 +	}
  217.48 +
  217.49 +	public Object invoke(Object key, Object notFound) throws Exception {
  217.50 +		return impl.valAt(key, notFound);
  217.51 +	}
  217.52 +
  217.53 +	public Object invoke(Object key) throws Exception {
  217.54 +		return impl.valAt(key);	
  217.55 +	}
  217.56 +	
  217.57 +}
   218.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   218.2 +++ b/src/clojure/lang/Agent.java	Sat Aug 21 06:25:44 2010 -0400
   218.3 @@ -0,0 +1,274 @@
   218.4 +/**
   218.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   218.6 + *   The use and distribution terms for this software are covered by the
   218.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   218.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   218.9 + *   By using this software in any fashion, you are agreeing to be bound by
  218.10 + * 	 the terms of this license.
  218.11 + *   You must not remove this notice, or any other, from this software.
  218.12 + **/
  218.13 +
  218.14 +/* rich Nov 17, 2007 */
  218.15 +
  218.16 +package clojure.lang;
  218.17 +
  218.18 +import java.util.concurrent.*;
  218.19 +import java.util.concurrent.atomic.AtomicReference;
  218.20 +import java.util.Map;
  218.21 +
  218.22 +public class Agent extends ARef {
  218.23 +
  218.24 +static class ActionQueue {
  218.25 +	public final IPersistentStack q;
  218.26 +	public final Throwable error; // non-null indicates fail state
  218.27 +	static final ActionQueue EMPTY = new ActionQueue(PersistentQueue.EMPTY, null);
  218.28 +
  218.29 +	public ActionQueue( IPersistentStack q, Throwable error )
  218.30 +		{
  218.31 +		this.q = q;
  218.32 +		this.error = error;
  218.33 +		}
  218.34 +}
  218.35 +
  218.36 +static final Keyword CONTINUE = Keyword.intern(null, "continue");
  218.37 +static final Keyword FAIL = Keyword.intern(null, "fail");
  218.38 +
  218.39 +volatile Object state;
  218.40 +    AtomicReference<ActionQueue> aq = new AtomicReference(ActionQueue.EMPTY);
  218.41 +
  218.42 +    volatile Keyword errorMode = CONTINUE;
  218.43 +    volatile IFn errorHandler = null;
  218.44 +
  218.45 +final public static ExecutorService pooledExecutor =
  218.46 +		Executors.newFixedThreadPool(2 + Runtime.getRuntime().availableProcessors());
  218.47 +
  218.48 +final public static ExecutorService soloExecutor = Executors.newCachedThreadPool();
  218.49 +
  218.50 +final static ThreadLocal<IPersistentVector> nested = new ThreadLocal<IPersistentVector>();
  218.51 +
  218.52 +
  218.53 +public static void shutdown(){
  218.54 +	soloExecutor.shutdown();
  218.55 +	pooledExecutor.shutdown();
  218.56 +}
  218.57 +
  218.58 +static class Action implements Runnable{
  218.59 +	final Agent agent;
  218.60 +	final IFn fn;
  218.61 +	final ISeq args;
  218.62 +	final boolean solo;
  218.63 +
  218.64 +
  218.65 +	public Action(Agent agent, IFn fn, ISeq args, boolean solo){
  218.66 +		this.agent = agent;
  218.67 +		this.args = args;
  218.68 +		this.fn = fn;
  218.69 +		this.solo = solo;
  218.70 +	}
  218.71 +
  218.72 +	void execute(){
  218.73 +		try
  218.74 +			{
  218.75 +			if(solo)
  218.76 +				soloExecutor.execute(this);
  218.77 +			else
  218.78 +				pooledExecutor.execute(this);
  218.79 +			}
  218.80 +		catch(Throwable error)
  218.81 +			{
  218.82 +			if(agent.errorHandler != null)
  218.83 +				{
  218.84 +				try
  218.85 +					{
  218.86 +					agent.errorHandler.invoke(agent, error);
  218.87 +					}
  218.88 +				catch(Throwable e) {} // ignore errorHandler errors
  218.89 +				}
  218.90 +			}
  218.91 +	}
  218.92 +
  218.93 +	static void doRun(Action action){
  218.94 +		try
  218.95 +			{
  218.96 +			Var.pushThreadBindings(RT.map(RT.AGENT, action.agent));
  218.97 +			nested.set(PersistentVector.EMPTY);
  218.98 +
  218.99 +			Throwable error = null;
 218.100 +			try
 218.101 +				{
 218.102 +				Object oldval = action.agent.state;
 218.103 +				Object newval =  action.fn.applyTo(RT.cons(action.agent.state, action.args));
 218.104 +				action.agent.setState(newval);
 218.105 +                action.agent.notifyWatches(oldval,newval);
 218.106 +				}
 218.107 +			catch(Throwable e)
 218.108 +				{
 218.109 +				error = e;
 218.110 +				}
 218.111 +
 218.112 +			if(error == null)
 218.113 +				{
 218.114 +				releasePendingSends();
 218.115 +				}
 218.116 +			else
 218.117 +				{
 218.118 +				nested.set(PersistentVector.EMPTY);
 218.119 +				if(action.agent.errorHandler != null)
 218.120 +					{
 218.121 +					try
 218.122 +						{
 218.123 +						action.agent.errorHandler.invoke(action.agent, error);
 218.124 +						}
 218.125 +					catch(Throwable e) {} // ignore errorHandler errors
 218.126 +					}
 218.127 +				if(action.agent.errorMode == CONTINUE)
 218.128 +					{
 218.129 +					error = null;
 218.130 +					}
 218.131 +				}
 218.132 +
 218.133 +			boolean popped = false;
 218.134 +			ActionQueue next = null;
 218.135 +			while(!popped)
 218.136 +				{
 218.137 +				ActionQueue prior = action.agent.aq.get();
 218.138 +				next = new ActionQueue(prior.q.pop(), error);
 218.139 +				popped = action.agent.aq.compareAndSet(prior, next);
 218.140 +				}
 218.141 +
 218.142 +			if(error == null && next.q.count() > 0)
 218.143 +				((Action) next.q.peek()).execute();
 218.144 +			}
 218.145 +		finally
 218.146 +			{
 218.147 +			nested.set(null);
 218.148 +			Var.popThreadBindings();
 218.149 +			}
 218.150 +	}
 218.151 +
 218.152 +	public void run(){
 218.153 +		doRun(this);
 218.154 +	}
 218.155 +}
 218.156 +
 218.157 +public Agent(Object state) throws Exception{
 218.158 +	this(state,null);
 218.159 +}
 218.160 +
 218.161 +public Agent(Object state, IPersistentMap meta) throws Exception {
 218.162 +    super(meta);
 218.163 +    setState(state);
 218.164 +}
 218.165 +
 218.166 +boolean setState(Object newState) throws Exception{
 218.167 +	validate(newState);
 218.168 +	boolean ret = state != newState;
 218.169 +	state = newState;
 218.170 +	return ret;
 218.171 +}
 218.172 +
 218.173 +public Object deref() throws Exception{
 218.174 +	return state;
 218.175 +}
 218.176 +
 218.177 +public Throwable getError(){
 218.178 +	return aq.get().error;
 218.179 +}
 218.180 +
 218.181 +public void setErrorMode(Keyword k){
 218.182 +	errorMode = k;
 218.183 +}
 218.184 +
 218.185 +public Keyword getErrorMode(){
 218.186 +	return errorMode;
 218.187 +}
 218.188 +
 218.189 +public void setErrorHandler(IFn f){
 218.190 +	errorHandler = f;
 218.191 +}
 218.192 +
 218.193 +public IFn getErrorHandler(){
 218.194 +	return errorHandler;
 218.195 +}
 218.196 +
 218.197 +synchronized public Object restart(Object newState, boolean clearActions){
 218.198 +	if(getError() == null)
 218.199 +		{
 218.200 +		throw new RuntimeException("Agent does not need a restart");
 218.201 +		}
 218.202 +	validate(newState);
 218.203 +	state = newState;
 218.204 +
 218.205 +	if(clearActions)
 218.206 +		aq.set(ActionQueue.EMPTY);
 218.207 +	else
 218.208 +		{
 218.209 +		boolean restarted = false;
 218.210 +		ActionQueue prior = null;
 218.211 +		while(!restarted)
 218.212 +			{
 218.213 +			prior = aq.get();
 218.214 +			restarted = aq.compareAndSet(prior, new ActionQueue(prior.q, null));
 218.215 +			}
 218.216 +
 218.217 +		if(prior.q.count() > 0)
 218.218 +			((Action) prior.q.peek()).execute();
 218.219 +		}
 218.220 +
 218.221 +	return newState;
 218.222 +}
 218.223 +
 218.224 +public Object dispatch(IFn fn, ISeq args, boolean solo) {
 218.225 +	Throwable error = getError();
 218.226 +	if(error != null)
 218.227 +		{
 218.228 +		throw new RuntimeException("Agent is failed, needs restart", error);
 218.229 +		}
 218.230 +	Action action = new Action(this, fn, args, solo);
 218.231 +	dispatchAction(action);
 218.232 +
 218.233 +	return this;
 218.234 +}
 218.235 +
 218.236 +static void dispatchAction(Action action){
 218.237 +	LockingTransaction trans = LockingTransaction.getRunning();
 218.238 +	if(trans != null)
 218.239 +		trans.enqueue(action);
 218.240 +	else if(nested.get() != null)
 218.241 +		{
 218.242 +		nested.set(nested.get().cons(action));
 218.243 +		}
 218.244 +	else
 218.245 +		action.agent.enqueue(action);
 218.246 +}
 218.247 +
 218.248 +void enqueue(Action action){
 218.249 +	boolean queued = false;
 218.250 +	ActionQueue prior = null;
 218.251 +	while(!queued)
 218.252 +		{
 218.253 +		prior = aq.get();
 218.254 +		queued = aq.compareAndSet(prior, new ActionQueue((IPersistentStack)prior.q.cons(action), prior.error));
 218.255 +		}
 218.256 +
 218.257 +	if(prior.q.count() == 0 && prior.error == null)
 218.258 +		action.execute();
 218.259 +}
 218.260 +
 218.261 +public int getQueueCount(){
 218.262 +	return aq.get().q.count();
 218.263 +}
 218.264 +
 218.265 +static public int releasePendingSends(){
 218.266 +	IPersistentVector sends = nested.get();
 218.267 +	if(sends == null)
 218.268 +		return 0;
 218.269 +	for(int i=0;i<sends.count();i++)
 218.270 +		{
 218.271 +		Action a = (Action) sends.valAt(i);
 218.272 +		a.agent.enqueue(a);
 218.273 +		}
 218.274 +	nested.set(PersistentVector.EMPTY);
 218.275 +	return sends.count();
 218.276 +}
 218.277 +}
   219.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   219.2 +++ b/src/clojure/lang/ArrayChunk.java	Sat Aug 21 06:25:44 2010 -0400
   219.3 @@ -0,0 +1,63 @@
   219.4 +/**
   219.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   219.6 + *   The use and distribution terms for this software are covered by the
   219.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   219.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   219.9 + *   By using this software in any fashion, you are agreeing to be bound by
  219.10 + * 	 the terms of this license.
  219.11 + *   You must not remove this notice, or any other, from this software.
  219.12 + **/
  219.13 +
  219.14 +/* rich May 24, 2009 */
  219.15 +
  219.16 +package clojure.lang;
  219.17 +
  219.18 +import java.io.Serializable;
  219.19 +
  219.20 +public final class ArrayChunk implements IChunk, Serializable {
  219.21 +
  219.22 +final Object[] array;
  219.23 +final int off;
  219.24 +final int end;
  219.25 +
  219.26 +public ArrayChunk(Object[] array){
  219.27 +	this(array, 0, array.length);
  219.28 +}
  219.29 +
  219.30 +public ArrayChunk(Object[] array, int off){
  219.31 +	this(array, off, array.length);
  219.32 +}
  219.33 +
  219.34 +public ArrayChunk(Object[] array, int off, int end){
  219.35 +	this.array = array;
  219.36 +	this.off = off;
  219.37 +	this.end = end;
  219.38 +}
  219.39 +
  219.40 +public Object nth(int i){
  219.41 +	return array[off + i];
  219.42 +}
  219.43 +
  219.44 +public Object nth(int i, Object notFound){
  219.45 +	if(i >= 0 && i < count())
  219.46 +		return nth(i);
  219.47 +	return notFound;
  219.48 +}
  219.49 +
  219.50 +public int count(){
  219.51 +	return end - off;
  219.52 +}
  219.53 +
  219.54 +public IChunk dropFirst(){
  219.55 +	if(off==end)
  219.56 +		throw new IllegalStateException("dropFirst of empty chunk");
  219.57 +	return new ArrayChunk(array, off + 1, end);
  219.58 +}
  219.59 +
  219.60 +public Object reduce(IFn f, Object start) throws Exception{
  219.61 +		Object ret = f.invoke(start, array[off]);
  219.62 +		for(int x = off + 1; x < end; x++)
  219.63 +			ret = f.invoke(ret, array[x]);
  219.64 +		return ret;
  219.65 +}
  219.66 +}
   220.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   220.2 +++ b/src/clojure/lang/ArraySeq.java	Sat Aug 21 06:25:44 2010 -0400
   220.3 @@ -0,0 +1,692 @@
   220.4 +/**
   220.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   220.6 + *   The use and distribution terms for this software are covered by the
   220.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   220.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   220.9 + *   By using this software in any fashion, you are agreeing to be bound by
  220.10 + * 	 the terms of this license.
  220.11 + *   You must not remove this notice, or any other, from this software.
  220.12 + **/
  220.13 +
  220.14 +/* rich Jun 19, 2006 */
  220.15 +
  220.16 +package clojure.lang;
  220.17 +
  220.18 +import java.lang.reflect.Array;
  220.19 +
  220.20 +public class ArraySeq extends ASeq implements IndexedSeq, IReduce{
  220.21 +public final Object array;
  220.22 +final int i;
  220.23 +final Object[] oa;
  220.24 +//ISeq _rest;
  220.25 +
  220.26 +static public ArraySeq create(){
  220.27 +	return null;
  220.28 +}
  220.29 +
  220.30 +static public ArraySeq create(Object... array){
  220.31 +	if(array == null || array.length == 0)
  220.32 +		return null;
  220.33 +	return new ArraySeq(array, 0);
  220.34 +}
  220.35 +
  220.36 +static ISeq createFromObject(Object array){
  220.37 +	if(array == null || Array.getLength(array) == 0)
  220.38 +		return null;
  220.39 +	Class aclass = array.getClass();
  220.40 +	if(aclass == int[].class)
  220.41 +		return new ArraySeq_int(null, (int[]) array, 0);
  220.42 +	if(aclass == float[].class)
  220.43 +		return new ArraySeq_float(null, (float[]) array, 0);
  220.44 +	if(aclass == double[].class)
  220.45 +		return new ArraySeq_double(null, (double[]) array, 0);
  220.46 +	if(aclass == long[].class)
  220.47 +		return new ArraySeq_long(null, (long[]) array, 0);
  220.48 +	if(aclass == byte[].class)
  220.49 +		return new ArraySeq_byte(null, (byte[]) array, 0);
  220.50 +	if(aclass == char[].class)
  220.51 +		return new ArraySeq_char(null, (char[]) array, 0);
  220.52 +	if(aclass == boolean[].class)
  220.53 +		return new ArraySeq_boolean(null, (boolean[]) array, 0);
  220.54 +	return new ArraySeq(array, 0);
  220.55 +}
  220.56 +
  220.57 +ArraySeq(Object array, int i){
  220.58 +	this.array = array;
  220.59 +	this.i = i;
  220.60 +	this.oa = (Object[]) (array instanceof Object[] ? array : null);
  220.61 +//    this._rest = this;
  220.62 +}
  220.63 +
  220.64 +ArraySeq(IPersistentMap meta, Object array, int i){
  220.65 +	super(meta);
  220.66 +	this.array = array;
  220.67 +	this.i = i;
  220.68 +	this.oa = (Object[]) (array instanceof Object[] ? array : null);
  220.69 +}
  220.70 +
  220.71 +public Object first(){
  220.72 +	if(oa != null)
  220.73 +		return oa[i];
  220.74 +	return Reflector.prepRet(Array.get(array, i));
  220.75 +}
  220.76 +
  220.77 +public ISeq next(){
  220.78 +	if(oa != null)
  220.79 +		{
  220.80 +		if(i + 1 < oa.length)
  220.81 +			return new ArraySeq(array, i + 1);
  220.82 +		}
  220.83 +	else
  220.84 +		{
  220.85 +		if(i + 1 < Array.getLength(array))
  220.86 +			return new ArraySeq(array, i + 1);
  220.87 +		}
  220.88 +	return null;
  220.89 +}
  220.90 +
  220.91 +public int count(){
  220.92 +	if(oa != null)
  220.93 +		return oa.length - i;
  220.94 +	return Array.getLength(array) - i;
  220.95 +}
  220.96 +
  220.97 +public int index(){
  220.98 +	return i;
  220.99 +}
 220.100 +
 220.101 +public ArraySeq withMeta(IPersistentMap meta){
 220.102 +	return new ArraySeq(meta, array, i);
 220.103 +}
 220.104 +
 220.105 +public Object reduce(IFn f) throws Exception{
 220.106 +	if(oa != null)
 220.107 +		{
 220.108 +		Object ret = oa[i];
 220.109 +		for(int x = i + 1; x < oa.length; x++)
 220.110 +			ret = f.invoke(ret, oa[x]);
 220.111 +		return ret;
 220.112 +		}
 220.113 +
 220.114 +	Object ret = Reflector.prepRet(Array.get(array, i));
 220.115 +	for(int x = i + 1; x < Array.getLength(array); x++)
 220.116 +		ret = f.invoke(ret, Reflector.prepRet(Array.get(array, x)));
 220.117 +	return ret;
 220.118 +}
 220.119 +
 220.120 +public Object reduce(IFn f, Object start) throws Exception{
 220.121 +	if(oa != null)
 220.122 +		{
 220.123 +		Object ret = f.invoke(start, oa[i]);
 220.124 +		for(int x = i + 1; x < oa.length; x++)
 220.125 +			ret = f.invoke(ret, oa[x]);
 220.126 +		return ret;
 220.127 +		}
 220.128 +	Object ret = f.invoke(start, Reflector.prepRet(Array.get(array, i)));
 220.129 +	for(int x = i + 1; x < Array.getLength(array); x++)
 220.130 +		ret = f.invoke(ret, Reflector.prepRet(Array.get(array, x)));
 220.131 +	return ret;
 220.132 +}
 220.133 +
 220.134 +public int indexOf(Object o) {
 220.135 +	if (oa != null) {
 220.136 +		for (int j = i; j < oa.length; j++)
 220.137 +			if (Util.equals(o, oa[j])) return j - i;
 220.138 +	} else {
 220.139 +		int n = Array.getLength(array); 
 220.140 +		for (int j = i; j < n; j++)
 220.141 +			if (Util.equals(o, Reflector.prepRet(Array.get(array, j)))) return j - i;
 220.142 +	}
 220.143 +	return -1;
 220.144 +}
 220.145 +
 220.146 +public int lastIndexOf(Object o) {
 220.147 +	if (oa != null) {
 220.148 +		if (o == null) {
 220.149 +			for (int j = oa.length - 1 ; j >= i; j--)
 220.150 +				if (oa[j] == null) return j - i;
 220.151 +		} else {
 220.152 +			for (int j = oa.length - 1 ; j >= i; j--)
 220.153 +				if (o.equals(oa[j])) return j - i;
 220.154 +		}
 220.155 +	} else {
 220.156 +		if (o == null) {
 220.157 +			for (int j = Array.getLength(array) - 1 ; j >= i; j--)
 220.158 +				if (Reflector.prepRet(Array.get(array, j)) == null) return j - i;
 220.159 +		} else {
 220.160 +			for (int j = Array.getLength(array) - 1 ; j >= i; j--)
 220.161 +				if (o.equals(Reflector.prepRet(Array.get(array, j)))) return j - i;
 220.162 +		}
 220.163 +	}
 220.164 +	return -1;
 220.165 +}
 220.166 +
 220.167 +//////////////////////////////////// specialized primitive versions ///////////////////////////////
 220.168 +
 220.169 +static public class ArraySeq_int extends ASeq implements IndexedSeq, IReduce{
 220.170 +	public final int[] array;
 220.171 +	final int i;
 220.172 +
 220.173 +	ArraySeq_int(IPersistentMap meta, int[] array, int i){
 220.174 +		super(meta);
 220.175 +		this.array = array;
 220.176 +		this.i = i;
 220.177 +	}
 220.178 +
 220.179 +	public Object first(){
 220.180 +		return array[i];
 220.181 +	}
 220.182 +
 220.183 +	public ISeq next(){
 220.184 +		if(i + 1 < array.length)
 220.185 +			return new ArraySeq_int(meta(), array, i + 1);
 220.186 +		return null;
 220.187 +	}
 220.188 +
 220.189 +	public int count(){
 220.190 +		return array.length - i;
 220.191 +	}
 220.192 +
 220.193 +	public int index(){
 220.194 +		return i;
 220.195 +	}
 220.196 +
 220.197 +	public ArraySeq_int withMeta(IPersistentMap meta){
 220.198 +		return new ArraySeq_int(meta, array, i);
 220.199 +	}
 220.200 +
 220.201 +	public Object reduce(IFn f) throws Exception{
 220.202 +		Object ret = array[i];
 220.203 +		for(int x = i + 1; x < array.length; x++)
 220.204 +			ret = f.invoke(ret, array[x]);
 220.205 +		return ret;
 220.206 +	}
 220.207 +
 220.208 +	public Object reduce(IFn f, Object start) throws Exception{
 220.209 +		Object ret = f.invoke(start, array[i]);
 220.210 +		for(int x = i + 1; x < array.length; x++)
 220.211 +			ret = f.invoke(ret, array[x]);
 220.212 +		return ret;
 220.213 +	}
 220.214 +
 220.215 +	public int indexOf(Object o) {
 220.216 +		if (o instanceof Integer) {
 220.217 +			int k = ((Integer) o).intValue();
 220.218 +			for (int j = i; j < array.length; j++)
 220.219 +				if (k == array[j]) return j - i;
 220.220 +		}
 220.221 +		if (o == null) {
 220.222 +			return -1;
 220.223 +		}
 220.224 +		for (int j = i; j < array.length; j++)
 220.225 +			if (o.equals(array[j])) return j - i;
 220.226 +		return -1;
 220.227 +	}
 220.228 +	
 220.229 +	public int lastIndexOf(Object o) {
 220.230 +		if (o instanceof Integer) {
 220.231 +			int k = ((Integer) o).intValue();
 220.232 +			for (int j = array.length - 1; j >= i; j--)
 220.233 +				if (k == array[j]) return j - i;
 220.234 +		}
 220.235 +		if (o == null) {
 220.236 +			return -1;
 220.237 +		}
 220.238 +		for (int j = array.length - 1; j >= i; j--)
 220.239 +			if (o.equals(array[j])) return j - i;
 220.240 +		return -1;
 220.241 +	}
 220.242 +}
 220.243 +
 220.244 +
 220.245 +static public class ArraySeq_float extends ASeq implements IndexedSeq, IReduce{
 220.246 +	public final float[] array;
 220.247 +	final int i;
 220.248 +
 220.249 +	ArraySeq_float(IPersistentMap meta, float[] array, int i){
 220.250 +		super(meta);
 220.251 +		this.array = array;
 220.252 +		this.i = i;
 220.253 +	}
 220.254 +
 220.255 +	public Object first(){
 220.256 +		return array[i];
 220.257 +	}
 220.258 +
 220.259 +	public ISeq next(){
 220.260 +		if(i + 1 < array.length)
 220.261 +			return new ArraySeq_float(meta(), array, i + 1);
 220.262 +		return null;
 220.263 +	}
 220.264 +
 220.265 +	public int count(){
 220.266 +		return array.length - i;
 220.267 +	}
 220.268 +
 220.269 +	public int index(){
 220.270 +		return i;
 220.271 +	}
 220.272 +
 220.273 +	public ArraySeq_float withMeta(IPersistentMap meta){
 220.274 +		return new ArraySeq_float(meta, array, i);
 220.275 +	}
 220.276 +
 220.277 +	public Object reduce(IFn f) throws Exception{
 220.278 +		Object ret = array[i];
 220.279 +		for(int x = i + 1; x < array.length; x++)
 220.280 +			ret = f.invoke(ret, array[x]);
 220.281 +		return ret;
 220.282 +	}
 220.283 +
 220.284 +	public Object reduce(IFn f, Object start) throws Exception{
 220.285 +		Object ret = f.invoke(start, array[i]);
 220.286 +		for(int x = i + 1; x < array.length; x++)
 220.287 +			ret = f.invoke(ret, array[x]);
 220.288 +		return ret;
 220.289 +	}
 220.290 +
 220.291 +	public int indexOf(Object o) {
 220.292 +		if (o instanceof Float) {
 220.293 +			float f = ((Float) o).floatValue();
 220.294 +			for (int j = i; j < array.length; j++)
 220.295 +				if (f == array[j]) return j - i;
 220.296 +		}
 220.297 +		if (o == null) {
 220.298 +			return -1;
 220.299 +		}
 220.300 +		for (int j = i; j < array.length; j++)
 220.301 +			if (o.equals(array[j])) return j - i;
 220.302 +		return -1;
 220.303 +	}
 220.304 +	
 220.305 +	public int lastIndexOf(Object o) {
 220.306 +		if (o instanceof Float) {
 220.307 +			float f = ((Float) o).floatValue();
 220.308 +			for (int j = array.length - 1; j >= i; j--)
 220.309 +				if (f == array[j]) return j - i;
 220.310 +		}
 220.311 +		if (o == null) {
 220.312 +			return -1;
 220.313 +		}
 220.314 +		for (int j = array.length - 1; j >= i; j--)
 220.315 +			if (o.equals(array[j])) return j - i;
 220.316 +		return -1;
 220.317 +	}
 220.318 +}
 220.319 +
 220.320 +static public class ArraySeq_double extends ASeq implements IndexedSeq, IReduce{
 220.321 +	public final double[] array;
 220.322 +	final int i;
 220.323 +
 220.324 +	ArraySeq_double(IPersistentMap meta, double[] array, int i){
 220.325 +		super(meta);
 220.326 +		this.array = array;
 220.327 +		this.i = i;
 220.328 +	}
 220.329 +
 220.330 +	public Object first(){
 220.331 +		return array[i];
 220.332 +	}
 220.333 +
 220.334 +	public ISeq next(){
 220.335 +		if(i + 1 < array.length)
 220.336 +			return new ArraySeq_double(meta(), array, i + 1);
 220.337 +		return null;
 220.338 +	}
 220.339 +
 220.340 +	public int count(){
 220.341 +		return array.length - i;
 220.342 +	}
 220.343 +
 220.344 +	public int index(){
 220.345 +		return i;
 220.346 +	}
 220.347 +
 220.348 +	public ArraySeq_double withMeta(IPersistentMap meta){
 220.349 +		return new ArraySeq_double(meta, array, i);
 220.350 +	}
 220.351 +
 220.352 +	public Object reduce(IFn f) throws Exception{
 220.353 +		Object ret = array[i];
 220.354 +		for(int x = i + 1; x < array.length; x++)
 220.355 +			ret = f.invoke(ret, array[x]);
 220.356 +		return ret;
 220.357 +	}
 220.358 +
 220.359 +	public Object reduce(IFn f, Object start) throws Exception{
 220.360 +		Object ret = f.invoke(start, array[i]);
 220.361 +		for(int x = i + 1; x < array.length; x++)
 220.362 +			ret = f.invoke(ret, array[x]);
 220.363 +		return ret;
 220.364 +	}
 220.365 +
 220.366 +	public int indexOf(Object o) {
 220.367 +		if (o instanceof Double) {
 220.368 +			double d = ((Double) o).doubleValue();
 220.369 +			for (int j = i; j < array.length; j++)
 220.370 +				if (d == array[j]) return j - i;
 220.371 +		}
 220.372 +		if (o == null) {
 220.373 +			return -1;
 220.374 +		}
 220.375 +		for (int j = i; j < array.length; j++)
 220.376 +			if (o.equals(array[j])) return j - i;
 220.377 +		return -1;
 220.378 +	}
 220.379 +	
 220.380 +	public int lastIndexOf(Object o) {
 220.381 +		if (o instanceof Double) {
 220.382 +			double d = ((Double) o).doubleValue();
 220.383 +			for (int j = array.length - 1; j >= i; j--)
 220.384 +				if (d == array[j]) return j - i;
 220.385 +		}
 220.386 +		if (o == null) {
 220.387 +			return -1;
 220.388 +		}
 220.389 +		for (int j = array.length - 1; j >= i; j--)
 220.390 +			if (o.equals(array[j])) return j - i;
 220.391 +		return -1;
 220.392 +	}
 220.393 +}
 220.394 +
 220.395 +static public class ArraySeq_long extends ASeq implements IndexedSeq, IReduce{
 220.396 +	public final long[] array;
 220.397 +	final int i;
 220.398 +
 220.399 +	ArraySeq_long(IPersistentMap meta, long[] array, int i){
 220.400 +		super(meta);
 220.401 +		this.array = array;
 220.402 +		this.i = i;
 220.403 +	}
 220.404 +
 220.405 +	public Object first(){
 220.406 +		return array[i];
 220.407 +	}
 220.408 +
 220.409 +	public ISeq next(){
 220.410 +		if(i + 1 < array.length)
 220.411 +			return new ArraySeq_long(meta(), array, i + 1);
 220.412 +		return null;
 220.413 +	}
 220.414 +
 220.415 +	public int count(){
 220.416 +		return array.length - i;
 220.417 +	}
 220.418 +
 220.419 +	public int index(){
 220.420 +		return i;
 220.421 +	}
 220.422 +
 220.423 +	public ArraySeq_long withMeta(IPersistentMap meta){
 220.424 +		return new ArraySeq_long(meta, array, i);
 220.425 +	}
 220.426 +
 220.427 +	public Object reduce(IFn f) throws Exception{
 220.428 +		Object ret = array[i];
 220.429 +		for(int x = i + 1; x < array.length; x++)
 220.430 +			ret = f.invoke(ret, array[x]);
 220.431 +		return ret;
 220.432 +	}
 220.433 +
 220.434 +	public Object reduce(IFn f, Object start) throws Exception{
 220.435 +		Object ret = f.invoke(start, array[i]);
 220.436 +		for(int x = i + 1; x < array.length; x++)
 220.437 +			ret = f.invoke(ret, array[x]);
 220.438 +		return ret;
 220.439 +	}
 220.440 +
 220.441 +	public int indexOf(Object o) {
 220.442 +		if (o instanceof Long) {
 220.443 +			long l = ((Long) o).longValue();
 220.444 +			for (int j = i; j < array.length; j++)
 220.445 +				if (l == array[j]) return j - i;
 220.446 +		}
 220.447 +		if (o == null) {
 220.448 +			return -1;
 220.449 +		}
 220.450 +		for (int j = i; j < array.length; j++)
 220.451 +			if (o.equals(array[j])) return j - i;
 220.452 +		return -1;
 220.453 +	}
 220.454 +	
 220.455 +	public int lastIndexOf(Object o) {
 220.456 +		if (o instanceof Long) {
 220.457 +			long l = ((Long) o).longValue();
 220.458 +			for (int j = array.length - 1; j >= i; j--)
 220.459 +				if (l == array[j]) return j - i;
 220.460 +		}
 220.461 +		if (o == null) {
 220.462 +			return -1;
 220.463 +		}
 220.464 +		for (int j = array.length - 1; j >= i; j--)
 220.465 +			if (o.equals(array[j])) return j - i;
 220.466 +		return -1;
 220.467 +	}
 220.468 +}
 220.469 +
 220.470 +static public class ArraySeq_byte extends ASeq implements IndexedSeq, IReduce{
 220.471 +	public final byte[] array;
 220.472 +	final int i;
 220.473 +
 220.474 +	ArraySeq_byte(IPersistentMap meta, byte[] array, int i){
 220.475 +		super(meta);
 220.476 +		this.array = array;
 220.477 +		this.i = i;
 220.478 +	}
 220.479 +
 220.480 +	public Object first(){
 220.481 +		return array[i];
 220.482 +	}
 220.483 +
 220.484 +	public ISeq next(){
 220.485 +		if(i + 1 < array.length)
 220.486 +			return new ArraySeq_byte(meta(), array, i + 1);
 220.487 +		return null;
 220.488 +	}
 220.489 +
 220.490 +	public int count(){
 220.491 +		return array.length - i;
 220.492 +	}
 220.493 +
 220.494 +	public int index(){
 220.495 +		return i;
 220.496 +	}
 220.497 +
 220.498 +	public ArraySeq_byte withMeta(IPersistentMap meta){
 220.499 +		return new ArraySeq_byte(meta, array, i);
 220.500 +	}
 220.501 +
 220.502 +	public Object reduce(IFn f) throws Exception{
 220.503 +		Object ret = array[i];
 220.504 +		for(int x = i + 1; x < array.length; x++)
 220.505 +			ret = f.invoke(ret, array[x]);
 220.506 +		return ret;
 220.507 +	}
 220.508 +
 220.509 +	public Object reduce(IFn f, Object start) throws Exception{
 220.510 +		Object ret = f.invoke(start, array[i]);
 220.511 +		for(int x = i + 1; x < array.length; x++)
 220.512 +			ret = f.invoke(ret, array[x]);
 220.513 +		return ret;
 220.514 +	}
 220.515 +
 220.516 +	public int indexOf(Object o) {
 220.517 +		if (o instanceof Byte) {
 220.518 +			byte b = ((Byte) o).byteValue();
 220.519 +			for (int j = i; j < array.length; j++)
 220.520 +				if (b == array[j]) return j - i;
 220.521 +		}
 220.522 +		if (o == null) {
 220.523 +			return -1;
 220.524 +		}
 220.525 +		for (int j = i; j < array.length; j++)
 220.526 +			if (o.equals(array[j])) return j - i;
 220.527 +		return -1;
 220.528 +	}
 220.529 +	
 220.530 +	public int lastIndexOf(Object o) {
 220.531 +		if (o instanceof Byte) {
 220.532 +			byte b = ((Byte) o).byteValue();
 220.533 +			for (int j = array.length - 1; j >= i; j--)
 220.534 +				if (b == array[j]) return j - i;
 220.535 +		}
 220.536 +		if (o == null) {
 220.537 +			return -1;
 220.538 +		}
 220.539 +		for (int j = array.length - 1; j >= i; j--)
 220.540 +			if (o.equals(array[j])) return j - i;
 220.541 +		return -1;
 220.542 +	}
 220.543 +}
 220.544 +
 220.545 +static public class ArraySeq_char extends ASeq implements IndexedSeq, IReduce{
 220.546 +	public final char[] array;
 220.547 +	final int i;
 220.548 +
 220.549 +	ArraySeq_char(IPersistentMap meta, char[] array, int i){
 220.550 +		super(meta);
 220.551 +		this.array = array;
 220.552 +		this.i = i;
 220.553 +	}
 220.554 +
 220.555 +	public Object first(){
 220.556 +		return array[i];
 220.557 +	}
 220.558 +
 220.559 +	public ISeq next(){
 220.560 +		if(i + 1 < array.length)
 220.561 +			return new ArraySeq_char(meta(), array, i + 1);
 220.562 +		return null;
 220.563 +	}
 220.564 +
 220.565 +	public int count(){
 220.566 +		return array.length - i;
 220.567 +	}
 220.568 +
 220.569 +	public int index(){
 220.570 +		return i;
 220.571 +	}
 220.572 +
 220.573 +	public ArraySeq_char withMeta(IPersistentMap meta){
 220.574 +		return new ArraySeq_char(meta, array, i);
 220.575 +	}
 220.576 +
 220.577 +	public Object reduce(IFn f) throws Exception{
 220.578 +		Object ret = array[i];
 220.579 +		for(int x = i + 1; x < array.length; x++)
 220.580 +			ret = f.invoke(ret, array[x]);
 220.581 +		return ret;
 220.582 +	}
 220.583 +
 220.584 +	public Object reduce(IFn f, Object start) throws Exception{
 220.585 +		Object ret = f.invoke(start, array[i]);
 220.586 +		for(int x = i + 1; x < array.length; x++)
 220.587 +			ret = f.invoke(ret, array[x]);
 220.588 +		return ret;
 220.589 +	}
 220.590 +	
 220.591 +	public int indexOf(Object o) {
 220.592 +		if (o instanceof Character) {
 220.593 +			char c = ((Character) o).charValue();
 220.594 +			for (int j = i; j < array.length; j++)
 220.595 +				if (c == array[j]) return j - i;
 220.596 +		}
 220.597 +		if (o == null) {
 220.598 +			return -1;
 220.599 +		}
 220.600 +		for (int j = i; j < array.length; j++)
 220.601 +			if (o.equals(array[j])) return j - i;
 220.602 +		return -1;
 220.603 +	}
 220.604 +	
 220.605 +	public int lastIndexOf(Object o) {
 220.606 +		if (o instanceof Character) {
 220.607 +			char c = ((Character) o).charValue();
 220.608 +			for (int j = array.length - 1; j >= i; j--)
 220.609 +				if (c == array[j]) return j - i;
 220.610 +		}
 220.611 +		if (o == null) {
 220.612 +			return -1;
 220.613 +		}
 220.614 +		for (int j = array.length - 1; j >= i; j--)
 220.615 +			if (o.equals(array[j])) return j - i;
 220.616 +		return -1;
 220.617 +	}
 220.618 +}
 220.619 +
 220.620 +static public class ArraySeq_boolean extends ASeq implements IndexedSeq, IReduce{
 220.621 +	public final boolean[] array;
 220.622 +	final int i;
 220.623 +
 220.624 +	ArraySeq_boolean(IPersistentMap meta, boolean[] array, int i){
 220.625 +		super(meta);
 220.626 +		this.array = array;
 220.627 +		this.i = i;
 220.628 +	}
 220.629 +
 220.630 +	public Object first(){
 220.631 +		return array[i];
 220.632 +	}
 220.633 +
 220.634 +	public ISeq next(){
 220.635 +		if(i + 1 < array.length)
 220.636 +			return new ArraySeq_boolean(meta(), array, i + 1);
 220.637 +		return null;
 220.638 +	}
 220.639 +
 220.640 +	public int count(){
 220.641 +		return array.length - i;
 220.642 +	}
 220.643 +
 220.644 +	public int index(){
 220.645 +		return i;
 220.646 +	}
 220.647 +
 220.648 +	public ArraySeq_boolean withMeta(IPersistentMap meta){
 220.649 +		return new ArraySeq_boolean(meta, array, i);
 220.650 +	}
 220.651 +
 220.652 +	public Object reduce(IFn f) throws Exception{
 220.653 +		Object ret = array[i];
 220.654 +		for(int x = i + 1; x < array.length; x++)
 220.655 +			ret = f.invoke(ret, array[x]);
 220.656 +		return ret;
 220.657 +	}
 220.658 +
 220.659 +	public Object reduce(IFn f, Object start) throws Exception{
 220.660 +		Object ret = f.invoke(start, array[i]);
 220.661 +		for(int x = i + 1; x < array.length; x++)
 220.662 +			ret = f.invoke(ret, array[x]);
 220.663 +		return ret;
 220.664 +	}
 220.665 +	
 220.666 +	public int indexOf(Object o) {
 220.667 +		if (o instanceof Boolean) {
 220.668 +			boolean b = ((Boolean) o).booleanValue();
 220.669 +			for (int j = i; j < array.length; j++)
 220.670 +				if (b == array[j]) return j - i;
 220.671 +		}
 220.672 +		if (o == null) {
 220.673 +			return -1;
 220.674 +		}
 220.675 +		for (int j = i; j < array.length; j++)
 220.676 +			if (o.equals(array[j])) return j - i;
 220.677 +		return -1;
 220.678 +	}
 220.679 +	
 220.680 +	public int lastIndexOf(Object o) {
 220.681 +		if (o instanceof Boolean) {
 220.682 +			boolean b = ((Boolean) o).booleanValue();
 220.683 +			for (int j = array.length - 1; j >= i; j--)
 220.684 +				if (b == array[j]) return j - i;
 220.685 +		}
 220.686 +		if (o == null) {
 220.687 +			return -1;
 220.688 +		}
 220.689 +		for (int j = array.length - 1; j >= i; j--)
 220.690 +			if (o.equals(array[j])) return j - i;
 220.691 +		return -1;
 220.692 +	}
 220.693 +}
 220.694 +
 220.695 +}
   221.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   221.2 +++ b/src/clojure/lang/Associative.java	Sat Aug 21 06:25:44 2010 -0400
   221.3 @@ -0,0 +1,19 @@
   221.4 +package clojure.lang;
   221.5 +
   221.6 +/**
   221.7 + * Copyright (c) Rich Hickey. All rights reserved.
   221.8 + * The use and distribution terms for this software are covered by the
   221.9 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  221.10 + * which can be found in the file epl-v10.html at the root of this distribution.
  221.11 + * By using this software in any fashion, you are agreeing to be bound by
  221.12 + * the terms of this license.
  221.13 + * You must not remove this notice, or any other, from this software.
  221.14 + */
  221.15 +public interface Associative extends IPersistentCollection, ILookup{
  221.16 +boolean containsKey(Object key);
  221.17 +
  221.18 +IMapEntry entryAt(Object key);
  221.19 +
  221.20 +Associative assoc(Object key, Object val);
  221.21 +
  221.22 +}
   222.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   222.2 +++ b/src/clojure/lang/Atom.java	Sat Aug 21 06:25:44 2010 -0400
   222.3 @@ -0,0 +1,104 @@
   222.4 +/**
   222.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   222.6 + *   The use and distribution terms for this software are covered by the
   222.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   222.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   222.9 + *   By using this software in any fashion, you are agreeing to be bound by
  222.10 + * 	 the terms of this license.
  222.11 + *   You must not remove this notice, or any other, from this software.
  222.12 + **/
  222.13 +
  222.14 +/* rich Jan 1, 2009 */
  222.15 +
  222.16 +package clojure.lang;
  222.17 +
  222.18 +import java.util.concurrent.atomic.AtomicReference;
  222.19 +
  222.20 +final public class Atom extends ARef{
  222.21 +final AtomicReference state;
  222.22 +
  222.23 +public Atom(Object state){
  222.24 +	this.state = new AtomicReference(state);
  222.25 +}
  222.26 +
  222.27 +public Atom(Object state, IPersistentMap meta){
  222.28 +	super(meta);
  222.29 +	this.state = new AtomicReference(state);
  222.30 +}
  222.31 +
  222.32 +public Object deref(){
  222.33 +	return state.get();
  222.34 +}
  222.35 +
  222.36 +public Object swap(IFn f) throws Exception{
  222.37 +	for(; ;)
  222.38 +		{
  222.39 +		Object v = deref();
  222.40 +		Object newv = f.invoke(v);
  222.41 +		validate(newv);
  222.42 +		if(state.compareAndSet(v, newv))
  222.43 +			{
  222.44 +			notifyWatches(v, newv);
  222.45 +			return newv;
  222.46 +			}
  222.47 +		}
  222.48 +}
  222.49 +
  222.50 +public Object swap(IFn f, Object arg) throws Exception{
  222.51 +	for(; ;)
  222.52 +		{
  222.53 +		Object v = deref();
  222.54 +		Object newv = f.invoke(v, arg);
  222.55 +		validate(newv);
  222.56 +		if(state.compareAndSet(v, newv))
  222.57 +			{
  222.58 +			notifyWatches(v, newv);
  222.59 +			return newv;
  222.60 +			}
  222.61 +		}
  222.62 +}
  222.63 +
  222.64 +public Object swap(IFn f, Object arg1, Object arg2) throws Exception{
  222.65 +	for(; ;)
  222.66 +		{
  222.67 +		Object v = deref();
  222.68 +		Object newv = f.invoke(v, arg1, arg2);
  222.69 +		validate(newv);
  222.70 +		if(state.compareAndSet(v, newv))
  222.71 +			{
  222.72 +			notifyWatches(v, newv);
  222.73 +			return newv;
  222.74 +			}
  222.75 +		}
  222.76 +}
  222.77 +
  222.78 +public Object swap(IFn f, Object x, Object y, ISeq args) throws Exception{
  222.79 +	for(; ;)
  222.80 +		{
  222.81 +		Object v = deref();
  222.82 +		Object newv = f.applyTo(RT.listStar(v, x, y, args));
  222.83 +		validate(newv);
  222.84 +		if(state.compareAndSet(v, newv))
  222.85 +			{
  222.86 +			notifyWatches(v, newv);
  222.87 +			return newv;
  222.88 +			}
  222.89 +		}
  222.90 +}
  222.91 +
  222.92 +public boolean compareAndSet(Object oldv, Object newv){
  222.93 +	validate(newv);
  222.94 +	boolean ret = state.compareAndSet(oldv, newv);
  222.95 +	if(ret)
  222.96 +		notifyWatches(oldv, newv);
  222.97 +	return ret;
  222.98 +}
  222.99 +
 222.100 +public Object reset(Object newval){
 222.101 +	Object oldval = state.get();
 222.102 +	validate(newval);
 222.103 +	state.set(newval);
 222.104 +	notifyWatches(oldval, newval);
 222.105 +	return newval;
 222.106 +}
 222.107 +}
   223.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   223.2 +++ b/src/clojure/lang/Binding.java	Sat Aug 21 06:25:44 2010 -0400
   223.3 @@ -0,0 +1,26 @@
   223.4 +/**
   223.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   223.6 + *   The use and distribution terms for this software are covered by the
   223.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   223.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   223.9 + *   By using this software in any fashion, you are agreeing to be bound by
  223.10 + * 	 the terms of this license.
  223.11 + *   You must not remove this notice, or any other, from this software.
  223.12 + **/
  223.13 +
  223.14 +package clojure.lang;
  223.15 +
  223.16 +public class Binding<T>{
  223.17 +public T val;
  223.18 +public final Binding rest;
  223.19 +
  223.20 +public Binding(T val){
  223.21 +	this.val = val;
  223.22 +	this.rest = null;
  223.23 +}
  223.24 +
  223.25 +public Binding(T val, Binding rest){
  223.26 +	this.val = val;
  223.27 +	this.rest = rest;
  223.28 +}
  223.29 +}
   224.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   224.2 +++ b/src/clojure/lang/Box.java	Sat Aug 21 06:25:44 2010 -0400
   224.3 @@ -0,0 +1,22 @@
   224.4 +/**
   224.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   224.6 + *   The use and distribution terms for this software are covered by the
   224.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   224.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   224.9 + *   By using this software in any fashion, you are agreeing to be bound by
  224.10 + * 	 the terms of this license.
  224.11 + *   You must not remove this notice, or any other, from this software.
  224.12 + **/
  224.13 +
  224.14 +/* rich Mar 27, 2006 8:40:19 PM */
  224.15 +
  224.16 +package clojure.lang;
  224.17 +
  224.18 +public class Box{
  224.19 +
  224.20 +public Object val;
  224.21 +
  224.22 +public Box(Object val){
  224.23 +	this.val = val;
  224.24 +}
  224.25 +}
   225.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   225.2 +++ b/src/clojure/lang/ChunkBuffer.java	Sat Aug 21 06:25:44 2010 -0400
   225.3 @@ -0,0 +1,37 @@
   225.4 +/**
   225.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   225.6 + *   The use and distribution terms for this software are covered by the
   225.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   225.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   225.9 + *   By using this software in any fashion, you are agreeing to be bound by
  225.10 + * 	 the terms of this license.
  225.11 + *   You must not remove this notice, or any other, from this software.
  225.12 + **/
  225.13 +
  225.14 +/* rich May 26, 2009 */
  225.15 +
  225.16 +package clojure.lang;
  225.17 +
  225.18 +final public class ChunkBuffer implements Counted{
  225.19 +	Object[] buffer;
  225.20 +	int end;
  225.21 +
  225.22 +public ChunkBuffer(int capacity){
  225.23 +	buffer = new Object[capacity];
  225.24 +	end = 0;
  225.25 +}
  225.26 +
  225.27 +public void add(Object o){
  225.28 +	buffer[end++] = o;
  225.29 +}
  225.30 +
  225.31 +public IChunk chunk(){
  225.32 +	ArrayChunk ret = new ArrayChunk(buffer, 0, end);
  225.33 +	buffer = null;
  225.34 +	return ret;
  225.35 +}
  225.36 +
  225.37 +public int count(){
  225.38 +	return end;
  225.39 +}
  225.40 +}
   226.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   226.2 +++ b/src/clojure/lang/ChunkedCons.java	Sat Aug 21 06:25:44 2010 -0400
   226.3 @@ -0,0 +1,67 @@
   226.4 +/**
   226.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   226.6 + *   The use and distribution terms for this software are covered by the
   226.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   226.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   226.9 + *   By using this software in any fashion, you are agreeing to be bound by
  226.10 + * 	 the terms of this license.
  226.11 + *   You must not remove this notice, or any other, from this software.
  226.12 + **/
  226.13 +
  226.14 +/* rich May 25, 2009 */
  226.15 +
  226.16 +package clojure.lang;
  226.17 +
  226.18 +final public class ChunkedCons extends ASeq implements IChunkedSeq{
  226.19 +
  226.20 +final IChunk chunk;
  226.21 +final ISeq _more;
  226.22 +
  226.23 +ChunkedCons(IPersistentMap meta, IChunk chunk, ISeq more){
  226.24 +	super(meta);
  226.25 +	this.chunk = chunk;
  226.26 +	this._more = more;
  226.27 +}
  226.28 +
  226.29 +public ChunkedCons(IChunk chunk, ISeq more){
  226.30 +	this(null,chunk, more);
  226.31 +}
  226.32 +
  226.33 +public Obj withMeta(IPersistentMap meta){
  226.34 +	if(meta != _meta)
  226.35 +		return new ChunkedCons(meta, chunk, _more);
  226.36 +	return this;
  226.37 +}
  226.38 +
  226.39 +public Object first(){
  226.40 +	return chunk.nth(0);
  226.41 +}
  226.42 +
  226.43 +public ISeq next(){
  226.44 +	if(chunk.count() > 1)
  226.45 +		return new ChunkedCons(chunk.dropFirst(), _more);
  226.46 +	return chunkedNext();
  226.47 +}
  226.48 +
  226.49 +public ISeq more(){
  226.50 +	if(chunk.count() > 1)
  226.51 +		return new ChunkedCons(chunk.dropFirst(), _more);
  226.52 +	if(_more == null)
  226.53 +		return PersistentList.EMPTY;
  226.54 +	return _more;
  226.55 +}
  226.56 +
  226.57 +public IChunk chunkedFirst(){
  226.58 +	return chunk;
  226.59 +}
  226.60 +
  226.61 +public ISeq chunkedNext(){
  226.62 +	return chunkedMore().seq();	
  226.63 +}
  226.64 +
  226.65 +public ISeq chunkedMore(){
  226.66 +	if(_more == null)
  226.67 +		return PersistentList.EMPTY;
  226.68 +	return _more;
  226.69 +}
  226.70 +}
   227.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   227.2 +++ b/src/clojure/lang/Compile.java	Sat Aug 21 06:25:44 2010 -0400
   227.3 @@ -0,0 +1,73 @@
   227.4 +/**
   227.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   227.6 + *   The use and distribution terms for this software are covered by the
   227.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   227.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   227.9 + *   By using this software in any fashion, you are agreeing to be bound by
  227.10 + * 	 the terms of this license.
  227.11 + *   You must not remove this notice, or any other, from this software.
  227.12 + **/
  227.13 +
  227.14 +
  227.15 +package clojure.lang;
  227.16 +
  227.17 +import java.io.OutputStreamWriter;
  227.18 +import java.io.PrintWriter;
  227.19 +import java.io.IOException;
  227.20 +
  227.21 +// Compiles libs and generates class files stored within the directory
  227.22 +// named by the Java System property "clojure.compile.path". Arguments are
  227.23 +// strings naming the libs to be compiled. The libs and compile-path must
  227.24 +// all be within CLASSPATH.
  227.25 +
  227.26 +public class Compile{
  227.27 +
  227.28 +private static final String PATH_PROP = "clojure.compile.path";
  227.29 +private static final String REFLECTION_WARNING_PROP = "clojure.compile.warn-on-reflection";
  227.30 +private static final Var compile_path = RT.var("clojure.core", "*compile-path*");
  227.31 +private static final Var compile = RT.var("clojure.core", "compile");
  227.32 +private static final Var warn_on_reflection = RT.var("clojure.core", "*warn-on-reflection*");
  227.33 +
  227.34 +public static void main(String[] args) throws Exception{
  227.35 +
  227.36 +	OutputStreamWriter out = (OutputStreamWriter) RT.OUT.deref();
  227.37 +	PrintWriter err = RT.errPrintWriter();
  227.38 +	String path = System.getProperty(PATH_PROP);
  227.39 +	int count = args.length;
  227.40 +
  227.41 +	if(path == null)
  227.42 +		{
  227.43 +		err.println("ERROR: Must set system property " + PATH_PROP +
  227.44 +		            "\nto the location for compiled .class files." +
  227.45 +		            "\nThis directory must also be on your CLASSPATH.");
  227.46 +		System.exit(1);
  227.47 +		}
  227.48 +
  227.49 +    boolean warnOnReflection = System.getProperty(REFLECTION_WARNING_PROP, "false").equals("true");
  227.50 +
  227.51 +	try
  227.52 +		{
  227.53 +		Var.pushThreadBindings(RT.map(compile_path, path, warn_on_reflection, warnOnReflection));
  227.54 +
  227.55 +		for(String lib : args)
  227.56 +        {
  227.57 +            out.write("Compiling " + lib + " to " + path + "\n");
  227.58 +            out.flush();
  227.59 +            compile.invoke(Symbol.intern(lib));
  227.60 +        }
  227.61 +		}
  227.62 +	finally
  227.63 +		{
  227.64 +        Var.popThreadBindings();
  227.65 +		try
  227.66 +			{
  227.67 +			out.flush();
  227.68 +			out.close();
  227.69 +			}
  227.70 +		catch(IOException e)
  227.71 +			{
  227.72 +			e.printStackTrace(err);
  227.73 +			}
  227.74 +		}
  227.75 +}
  227.76 +}
   228.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   228.2 +++ b/src/clojure/lang/Compiler.java	Sat Aug 21 06:25:44 2010 -0400
   228.3 @@ -0,0 +1,6897 @@
   228.4 +/**
   228.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   228.6 + *   The use and distribution terms for this software are covered by the
   228.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   228.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   228.9 + *   By using this software in any fashion, you are agreeing to be bound by
  228.10 + * 	 the terms of this license.
  228.11 + *   You must not remove this notice, or any other, from this software.
  228.12 + **/
  228.13 +
  228.14 +/* rich Aug 21, 2007 */
  228.15 +
  228.16 +package clojure.lang;
  228.17 +
  228.18 +//*
  228.19 +
  228.20 +import clojure.asm.*;
  228.21 +import clojure.asm.commons.Method;
  228.22 +import clojure.asm.commons.GeneratorAdapter;
  228.23 +//*/
  228.24 +/*
  228.25 +
  228.26 +import org.objectweb.asm.*;
  228.27 +import org.objectweb.asm.commons.Method;
  228.28 +import org.objectweb.asm.commons.GeneratorAdapter;
  228.29 +import org.objectweb.asm.util.TraceClassVisitor;
  228.30 +import org.objectweb.asm.util.CheckClassAdapter;
  228.31 +//*/
  228.32 +
  228.33 +import java.io.*;
  228.34 +import java.util.*;
  228.35 +import java.lang.reflect.Constructor;
  228.36 +import java.lang.reflect.Modifier;
  228.37 +
  228.38 +public class Compiler implements Opcodes{
  228.39 +
  228.40 +static final Symbol DEF = Symbol.create("def");
  228.41 +static final Symbol LOOP = Symbol.create("loop*");
  228.42 +static final Symbol RECUR = Symbol.create("recur");
  228.43 +static final Symbol IF = Symbol.create("if");
  228.44 +static final Symbol LET = Symbol.create("let*");
  228.45 +static final Symbol LETFN = Symbol.create("letfn*");
  228.46 +static final Symbol DO = Symbol.create("do");
  228.47 +static final Symbol FN = Symbol.create("fn*");
  228.48 +static final Symbol QUOTE = Symbol.create("quote");
  228.49 +static final Symbol THE_VAR = Symbol.create("var");
  228.50 +static final Symbol DOT = Symbol.create(".");
  228.51 +static final Symbol ASSIGN = Symbol.create("set!");
  228.52 +//static final Symbol TRY_FINALLY = Symbol.create("try-finally");
  228.53 +static final Symbol TRY = Symbol.create("try");
  228.54 +static final Symbol CATCH = Symbol.create("catch");
  228.55 +static final Symbol FINALLY = Symbol.create("finally");
  228.56 +static final Symbol THROW = Symbol.create("throw");
  228.57 +static final Symbol MONITOR_ENTER = Symbol.create("monitor-enter");
  228.58 +static final Symbol MONITOR_EXIT = Symbol.create("monitor-exit");
  228.59 +static final Symbol IMPORT = Symbol.create("clojure.core", "import*");
  228.60 +//static final Symbol INSTANCE = Symbol.create("instance?");
  228.61 +static final Symbol DEFTYPE = Symbol.create("deftype*");
  228.62 +static final Symbol CASE = Symbol.create("case*");
  228.63 +
  228.64 +//static final Symbol THISFN = Symbol.create("thisfn");
  228.65 +static final Symbol CLASS = Symbol.create("Class");
  228.66 +static final Symbol NEW = Symbol.create("new");
  228.67 +static final Symbol THIS = Symbol.create("this");
  228.68 +static final Symbol REIFY = Symbol.create("reify*");
  228.69 +//static final Symbol UNQUOTE = Symbol.create("unquote");
  228.70 +//static final Symbol UNQUOTE_SPLICING = Symbol.create("unquote-splicing");
  228.71 +//static final Symbol SYNTAX_QUOTE = Symbol.create("clojure.core", "syntax-quote");
  228.72 +static final Symbol LIST = Symbol.create("clojure.core", "list");
  228.73 +static final Symbol HASHMAP = Symbol.create("clojure.core", "hash-map");
  228.74 +static final Symbol VECTOR = Symbol.create("clojure.core", "vector");
  228.75 +static final Symbol IDENTITY = Symbol.create("clojure.core", "identity");
  228.76 +
  228.77 +static final Symbol _AMP_ = Symbol.create("&");
  228.78 +static final Symbol ISEQ = Symbol.create("clojure.lang.ISeq");
  228.79 +
  228.80 +static final Keyword inlineKey = Keyword.intern(null, "inline");
  228.81 +static final Keyword inlineAritiesKey = Keyword.intern(null, "inline-arities");
  228.82 +
  228.83 +static final Keyword volatileKey = Keyword.intern(null, "volatile");
  228.84 +static final Keyword implementsKey = Keyword.intern(null, "implements");
  228.85 +static final String COMPILE_STUB_PREFIX = "compile__stub";
  228.86 +
  228.87 +static final Keyword protocolKey = Keyword.intern(null, "protocol");
  228.88 +static final Keyword onKey = Keyword.intern(null, "on");
  228.89 +
  228.90 +static final Symbol NS = Symbol.create("ns");
  228.91 +static final Symbol IN_NS = Symbol.create("in-ns");
  228.92 +
  228.93 +//static final Symbol IMPORT = Symbol.create("import");
  228.94 +//static final Symbol USE = Symbol.create("use");
  228.95 +
  228.96 +//static final Symbol IFN = Symbol.create("clojure.lang", "IFn");
  228.97 +
  228.98 +static final public IPersistentMap specials = PersistentHashMap.create(
  228.99 +		DEF, new DefExpr.Parser(),
 228.100 +		LOOP, new LetExpr.Parser(),
 228.101 +		RECUR, new RecurExpr.Parser(),
 228.102 +		IF, new IfExpr.Parser(),
 228.103 +		CASE, new CaseExpr.Parser(),
 228.104 +		LET, new LetExpr.Parser(),
 228.105 +		LETFN, new LetFnExpr.Parser(),
 228.106 +		DO, new BodyExpr.Parser(),
 228.107 +		FN, null,
 228.108 +		QUOTE, new ConstantExpr.Parser(),
 228.109 +		THE_VAR, new TheVarExpr.Parser(),
 228.110 +		IMPORT, new ImportExpr.Parser(),
 228.111 +		DOT, new HostExpr.Parser(),
 228.112 +		ASSIGN, new AssignExpr.Parser(),
 228.113 +		DEFTYPE, new NewInstanceExpr.DeftypeParser(),
 228.114 +		REIFY, new NewInstanceExpr.ReifyParser(),
 228.115 +//		TRY_FINALLY, new TryFinallyExpr.Parser(),
 228.116 +TRY, new TryExpr.Parser(),
 228.117 +THROW, new ThrowExpr.Parser(),
 228.118 +MONITOR_ENTER, new MonitorEnterExpr.Parser(),
 228.119 +MONITOR_EXIT, new MonitorExitExpr.Parser(),
 228.120 +//		INSTANCE, new InstanceExpr.Parser(),
 228.121 +//		IDENTICAL, new IdenticalExpr.Parser(),
 228.122 +//THISFN, null,
 228.123 +CATCH, null,
 228.124 +FINALLY, null,
 228.125 +//		CLASS, new ClassExpr.Parser(),
 228.126 +NEW, new NewExpr.Parser(),
 228.127 +//		UNQUOTE, null,
 228.128 +//		UNQUOTE_SPLICING, null,
 228.129 +//		SYNTAX_QUOTE, null,
 228.130 +_AMP_, null
 228.131 +);
 228.132 +
 228.133 +private static final int MAX_POSITIONAL_ARITY = 20;
 228.134 +private static final Type OBJECT_TYPE;
 228.135 +private static final Type KEYWORD_TYPE = Type.getType(Keyword.class);
 228.136 +private static final Type VAR_TYPE = Type.getType(Var.class);
 228.137 +private static final Type SYMBOL_TYPE = Type.getType(Symbol.class);
 228.138 +//private static final Type NUM_TYPE = Type.getType(Num.class);
 228.139 +private static final Type IFN_TYPE = Type.getType(IFn.class);
 228.140 +private static final Type AFUNCTION_TYPE = Type.getType(AFunction.class);
 228.141 +private static final Type RT_TYPE = Type.getType(RT.class);
 228.142 +final static Type CLASS_TYPE = Type.getType(Class.class);
 228.143 +final static Type NS_TYPE = Type.getType(Namespace.class);
 228.144 +final static Type UTIL_TYPE = Type.getType(Util.class);
 228.145 +final static Type REFLECTOR_TYPE = Type.getType(Reflector.class);
 228.146 +final static Type THROWABLE_TYPE = Type.getType(Throwable.class);
 228.147 +final static Type BOOLEAN_OBJECT_TYPE = Type.getType(Boolean.class);
 228.148 +final static Type IPERSISTENTMAP_TYPE = Type.getType(IPersistentMap.class);
 228.149 +final static Type IOBJ_TYPE = Type.getType(IObj.class);
 228.150 +
 228.151 +private static final Type[][] ARG_TYPES;
 228.152 +private static final Type[] EXCEPTION_TYPES = {Type.getType(Exception.class)};
 228.153 +
 228.154 +static
 228.155 +	{
 228.156 +	OBJECT_TYPE = Type.getType(Object.class);
 228.157 +	ARG_TYPES = new Type[MAX_POSITIONAL_ARITY + 2][];
 228.158 +	for(int i = 0; i <= MAX_POSITIONAL_ARITY; ++i)
 228.159 +		{
 228.160 +		Type[] a = new Type[i];
 228.161 +		for(int j = 0; j < i; j++)
 228.162 +			a[j] = OBJECT_TYPE;
 228.163 +		ARG_TYPES[i] = a;
 228.164 +		}
 228.165 +	Type[] a = new Type[MAX_POSITIONAL_ARITY + 1];
 228.166 +	for(int j = 0; j < MAX_POSITIONAL_ARITY; j++)
 228.167 +		a[j] = OBJECT_TYPE;
 228.168 +	a[MAX_POSITIONAL_ARITY] = Type.getType("[Ljava/lang/Object;");
 228.169 +	ARG_TYPES[MAX_POSITIONAL_ARITY + 1] = a;
 228.170 +
 228.171 +
 228.172 +	}
 228.173 +
 228.174 +
 228.175 +//symbol->localbinding
 228.176 +static final public Var LOCAL_ENV = Var.create(null);
 228.177 +
 228.178 +//vector<localbinding>
 228.179 +static final public Var LOOP_LOCALS = Var.create();
 228.180 +
 228.181 +//Label
 228.182 +static final public Var LOOP_LABEL = Var.create();
 228.183 +
 228.184 +//vector<object>
 228.185 +static final public Var CONSTANTS = Var.create();
 228.186 +
 228.187 +//IdentityHashMap
 228.188 +static final public Var CONSTANT_IDS = Var.create();
 228.189 +
 228.190 +//vector<keyword>
 228.191 +static final public Var KEYWORD_CALLSITES = Var.create();
 228.192 +
 228.193 +//vector<var>
 228.194 +static final public Var PROTOCOL_CALLSITES = Var.create();
 228.195 +
 228.196 +//vector<var>
 228.197 +static final public Var VAR_CALLSITES = Var.create();
 228.198 +
 228.199 +//keyword->constid
 228.200 +static final public Var KEYWORDS = Var.create();
 228.201 +
 228.202 +//var->constid
 228.203 +static final public Var VARS = Var.create();
 228.204 +
 228.205 +//FnFrame
 228.206 +static final public Var METHOD = Var.create(null);
 228.207 +
 228.208 +//null or not
 228.209 +static final public Var IN_CATCH_FINALLY = Var.create(null);
 228.210 +
 228.211 +//DynamicClassLoader
 228.212 +static final public Var LOADER = Var.create();
 228.213 +
 228.214 +//String
 228.215 +static final public Var SOURCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
 228.216 +                                            Symbol.create("*source-path*"), "NO_SOURCE_FILE");
 228.217 +
 228.218 +//String
 228.219 +static final public Var SOURCE_PATH = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
 228.220 +                                                 Symbol.create("*file*"), "NO_SOURCE_PATH");
 228.221 +
 228.222 +//String
 228.223 +static final public Var COMPILE_PATH = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
 228.224 +                                                  Symbol.create("*compile-path*"), null);
 228.225 +//boolean
 228.226 +static final public Var COMPILE_FILES = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
 228.227 +                                                   Symbol.create("*compile-files*"), Boolean.FALSE);
 228.228 +
 228.229 +static final public Var INSTANCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
 228.230 +                                            Symbol.create("instance?"));
 228.231 +
 228.232 +static final public Var ADD_ANNOTATIONS = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
 228.233 +                                            Symbol.create("add-annotations"));
 228.234 +
 228.235 +//Integer
 228.236 +static final public Var LINE = Var.create(0);
 228.237 +
 228.238 +//Integer
 228.239 +static final public Var LINE_BEFORE = Var.create(0);
 228.240 +static final public Var LINE_AFTER = Var.create(0);
 228.241 +
 228.242 +//Integer
 228.243 +static final public Var NEXT_LOCAL_NUM = Var.create(0);
 228.244 +
 228.245 +//Integer
 228.246 +static final public Var RET_LOCAL_NUM = Var.create();
 228.247 +
 228.248 +
 228.249 +static final public Var COMPILE_STUB_SYM = Var.create(null);
 228.250 +static final public Var COMPILE_STUB_CLASS = Var.create(null);
 228.251 +
 228.252 +
 228.253 +//PathNode chain
 228.254 +static final public Var CLEAR_PATH = Var.create(null);
 228.255 +
 228.256 +//tail of PathNode chain
 228.257 +static final public Var CLEAR_ROOT = Var.create(null);
 228.258 +
 228.259 +//LocalBinding -> Set<LocalBindingExpr>
 228.260 +static final public Var CLEAR_SITES = Var.create(null);
 228.261 +
 228.262 +    public enum C{
 228.263 +	STATEMENT,  //value ignored
 228.264 +	EXPRESSION, //value required
 228.265 +	RETURN,      //tail position relative to enclosing recur frame
 228.266 +	EVAL
 228.267 +}
 228.268 +
 228.269 +interface Expr{
 228.270 +	Object eval() throws Exception;
 228.271 +
 228.272 +	void emit(C context, ObjExpr objx, GeneratorAdapter gen);
 228.273 +
 228.274 +	boolean hasJavaClass() throws Exception;
 228.275 +
 228.276 +	Class getJavaClass() throws Exception;
 228.277 +}
 228.278 +
 228.279 +public static abstract class UntypedExpr implements Expr{
 228.280 +
 228.281 +	public Class getJavaClass(){
 228.282 +		throw new IllegalArgumentException("Has no Java class");
 228.283 +	}
 228.284 +
 228.285 +	public boolean hasJavaClass(){
 228.286 +		return false;
 228.287 +	}
 228.288 +}
 228.289 +
 228.290 +interface IParser{
 228.291 +	Expr parse(C context, Object form) throws Exception;
 228.292 +}
 228.293 +
 228.294 +static boolean isSpecial(Object sym){
 228.295 +	return specials.containsKey(sym);
 228.296 +}
 228.297 +
 228.298 +static Symbol resolveSymbol(Symbol sym){
 228.299 +	//already qualified or classname?
 228.300 +	if(sym.name.indexOf('.') > 0)
 228.301 +		return sym;
 228.302 +	if(sym.ns != null)
 228.303 +		{
 228.304 +		Namespace ns = namespaceFor(sym);
 228.305 +		if(ns == null || ns.name.name == sym.ns)
 228.306 +			return sym;
 228.307 +		return Symbol.create(ns.name.name, sym.name);
 228.308 +		}
 228.309 +	Object o = currentNS().getMapping(sym);
 228.310 +	if(o == null)
 228.311 +		return Symbol.intern(currentNS().name.name, sym.name);
 228.312 +	else if(o instanceof Class)
 228.313 +		return Symbol.intern(null, ((Class) o).getName());
 228.314 +	else if(o instanceof Var)
 228.315 +			{
 228.316 +			Var v = (Var) o;
 228.317 +			return Symbol.create(v.ns.name.name, v.sym.name);
 228.318 +			}
 228.319 +	return null;
 228.320 +
 228.321 +}
 228.322 +
 228.323 +static class DefExpr implements Expr{
 228.324 +	public final Var var;
 228.325 +	public final Expr init;
 228.326 +	public final Expr meta;
 228.327 +	public final boolean initProvided;
 228.328 +	public final String source;
 228.329 +	public final int line;
 228.330 +	final static Method bindRootMethod = Method.getMethod("void bindRoot(Object)");
 228.331 +	final static Method setTagMethod = Method.getMethod("void setTag(clojure.lang.Symbol)");
 228.332 +	final static Method setMetaMethod = Method.getMethod("void setMeta(clojure.lang.IPersistentMap)");
 228.333 +	final static Method symcreate = Method.getMethod("clojure.lang.Symbol create(String, String)");
 228.334 +
 228.335 +	public DefExpr(String source, int line, Var var, Expr init, Expr meta, boolean initProvided){
 228.336 +		this.source = source;
 228.337 +		this.line = line;
 228.338 +		this.var = var;
 228.339 +		this.init = init;
 228.340 +		this.meta = meta;
 228.341 +		this.initProvided = initProvided;
 228.342 +	}
 228.343 +
 228.344 +    private boolean includesExplicitMetadata(MapExpr expr) {
 228.345 +        for(int i=0; i < expr.keyvals.count(); i += 2)
 228.346 +            {
 228.347 +                Keyword k  = ((KeywordExpr) expr.keyvals.nth(i)).k;
 228.348 +                if ((k != RT.FILE_KEY) &&
 228.349 +                    (k != RT.DECLARED_KEY) &&
 228.350 +                    (k != RT.LINE_KEY))
 228.351 +                    return true;
 228.352 +            }
 228.353 +        return false;
 228.354 +    }
 228.355 +
 228.356 +    public Object eval() throws Exception{
 228.357 +		try
 228.358 +			{
 228.359 +			if(initProvided)
 228.360 +				{
 228.361 +//			if(init instanceof FnExpr && ((FnExpr) init).closes.count()==0)
 228.362 +//				var.bindRoot(new FnLoaderThunk((FnExpr) init,var));
 228.363 +//			else
 228.364 +				var.bindRoot(init.eval());
 228.365 +				}
 228.366 +			if(meta != null)
 228.367 +				{
 228.368 +                IPersistentMap metaMap = (IPersistentMap) meta.eval();
 228.369 +                if (initProvided || includesExplicitMetadata((MapExpr) meta))
 228.370 +				    var.setMeta((IPersistentMap) meta.eval());
 228.371 +				}
 228.372 +			return var;
 228.373 +			}
 228.374 +		catch(Throwable e)
 228.375 +			{
 228.376 +			if(!(e instanceof CompilerException))
 228.377 +				throw new CompilerException(source, line, e);
 228.378 +			else
 228.379 +				throw (CompilerException) e;
 228.380 +			}
 228.381 +	}
 228.382 +
 228.383 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.384 +		objx.emitVar(gen, var);
 228.385 +		if(meta != null)
 228.386 +			{
 228.387 +            if (initProvided || includesExplicitMetadata((MapExpr) meta))
 228.388 +                {
 228.389 +                gen.dup();
 228.390 +                meta.emit(C.EXPRESSION, objx, gen);
 228.391 +                gen.checkCast(IPERSISTENTMAP_TYPE);
 228.392 +                gen.invokeVirtual(VAR_TYPE, setMetaMethod);
 228.393 +                }
 228.394 +			}
 228.395 +		if(initProvided)
 228.396 +			{
 228.397 +			gen.dup();
 228.398 +			init.emit(C.EXPRESSION, objx, gen);
 228.399 +			gen.invokeVirtual(VAR_TYPE, bindRootMethod);
 228.400 +			}
 228.401 +
 228.402 +		if(context == C.STATEMENT)
 228.403 +			gen.pop();
 228.404 +	}
 228.405 +
 228.406 +	public boolean hasJavaClass(){
 228.407 +		return true;
 228.408 +	}
 228.409 +
 228.410 +	public Class getJavaClass(){
 228.411 +		return Var.class;
 228.412 +	}
 228.413 +
 228.414 +	static class Parser implements IParser{
 228.415 +		public Expr parse(C context, Object form) throws Exception{
 228.416 +			//(def x) or (def x initexpr)
 228.417 +			if(RT.count(form) > 3)
 228.418 +				throw new Exception("Too many arguments to def");
 228.419 +			else if(RT.count(form) < 2)
 228.420 +				throw new Exception("Too few arguments to def");
 228.421 +			else if(!(RT.second(form) instanceof Symbol))
 228.422 +					throw new Exception("First argument to def must be a Symbol");
 228.423 +			Symbol sym = (Symbol) RT.second(form);
 228.424 +			Var v = lookupVar(sym, true);
 228.425 +			if(v == null)
 228.426 +				throw new Exception("Can't refer to qualified var that doesn't exist");
 228.427 +			if(!v.ns.equals(currentNS()))
 228.428 +				{
 228.429 +				if(sym.ns == null)
 228.430 +					v = currentNS().intern(sym);
 228.431 +//					throw new Exception("Name conflict, can't def " + sym + " because namespace: " + currentNS().name +
 228.432 +//					                    " refers to:" + v);
 228.433 +				else
 228.434 +					throw new Exception("Can't create defs outside of current ns");
 228.435 +				}
 228.436 +			IPersistentMap mm = sym.meta();
 228.437 +            Object source_path = SOURCE_PATH.get();
 228.438 +            source_path = source_path == null ? "NO_SOURCE_FILE" : source_path;
 228.439 +            mm = (IPersistentMap) RT.assoc(mm, RT.LINE_KEY, LINE.get()).assoc(RT.FILE_KEY, source_path);
 228.440 +			Expr meta = analyze(context == C.EVAL ? context : C.EXPRESSION, mm);
 228.441 +			return new DefExpr((String) SOURCE.deref(), (Integer) LINE.deref(),
 228.442 +			                   v, analyze(context == C.EVAL ? context : C.EXPRESSION, RT.third(form), v.sym.name),
 228.443 +			                   meta, RT.count(form) == 3);
 228.444 +		}
 228.445 +	}
 228.446 +}
 228.447 +
 228.448 +public static class AssignExpr implements Expr{
 228.449 +	public final AssignableExpr target;
 228.450 +	public final Expr val;
 228.451 +
 228.452 +	public AssignExpr(AssignableExpr target, Expr val){
 228.453 +		this.target = target;
 228.454 +		this.val = val;
 228.455 +	}
 228.456 +
 228.457 +	public Object eval() throws Exception{
 228.458 +		return target.evalAssign(val);
 228.459 +	}
 228.460 +
 228.461 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.462 +		target.emitAssign(context, objx, gen, val);
 228.463 +	}
 228.464 +
 228.465 +	public boolean hasJavaClass() throws Exception{
 228.466 +		return val.hasJavaClass();
 228.467 +	}
 228.468 +
 228.469 +	public Class getJavaClass() throws Exception{
 228.470 +		return val.getJavaClass();
 228.471 +	}
 228.472 +
 228.473 +	static class Parser implements IParser{
 228.474 +		public Expr parse(C context, Object frm) throws Exception{
 228.475 +			ISeq form = (ISeq) frm;
 228.476 +			if(RT.length(form) != 3)
 228.477 +				throw new IllegalArgumentException("Malformed assignment, expecting (set! target val)");
 228.478 +			Expr target = analyze(C.EXPRESSION, RT.second(form));
 228.479 +			if(!(target instanceof AssignableExpr))
 228.480 +				throw new IllegalArgumentException("Invalid assignment target");
 228.481 +			return new AssignExpr((AssignableExpr) target, analyze(C.EXPRESSION, RT.third(form)));
 228.482 +		}
 228.483 +	}
 228.484 +}
 228.485 +
 228.486 +public static class VarExpr implements Expr, AssignableExpr{
 228.487 +	public final Var var;
 228.488 +	public final Object tag;
 228.489 +	final static Method getMethod = Method.getMethod("Object get()");
 228.490 +	final static Method setMethod = Method.getMethod("Object set(Object)");
 228.491 +
 228.492 +	public VarExpr(Var var, Symbol tag){
 228.493 +		this.var = var;
 228.494 +		this.tag = tag != null ? tag : var.getTag();
 228.495 +	}
 228.496 +
 228.497 +	public Object eval() throws Exception{
 228.498 +		return var.deref();
 228.499 +	}
 228.500 +
 228.501 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.502 +		objx.emitVar(gen, var);
 228.503 +		gen.invokeVirtual(VAR_TYPE, getMethod);
 228.504 +		if(context == C.STATEMENT)
 228.505 +			{
 228.506 +			gen.pop();
 228.507 +			}
 228.508 +	}
 228.509 +
 228.510 +	public boolean hasJavaClass(){
 228.511 +		return tag != null;
 228.512 +	}
 228.513 +
 228.514 +	public Class getJavaClass() throws Exception{
 228.515 +		return HostExpr.tagToClass(tag);
 228.516 +	}
 228.517 +
 228.518 +	public Object evalAssign(Expr val) throws Exception{
 228.519 +		return var.set(val.eval());
 228.520 +	}
 228.521 +
 228.522 +	public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen,
 228.523 +	                       Expr val){
 228.524 +		objx.emitVar(gen, var);
 228.525 +		val.emit(C.EXPRESSION, objx, gen);
 228.526 +		gen.invokeVirtual(VAR_TYPE, setMethod);
 228.527 +		if(context == C.STATEMENT)
 228.528 +			gen.pop();
 228.529 +	}
 228.530 +}
 228.531 +
 228.532 +public static class TheVarExpr implements Expr{
 228.533 +	public final Var var;
 228.534 +
 228.535 +	public TheVarExpr(Var var){
 228.536 +		this.var = var;
 228.537 +	}
 228.538 +
 228.539 +	public Object eval() throws Exception{
 228.540 +		return var;
 228.541 +	}
 228.542 +
 228.543 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.544 +		objx.emitVar(gen, var);
 228.545 +		if(context == C.STATEMENT)
 228.546 +			gen.pop();
 228.547 +	}
 228.548 +
 228.549 +	public boolean hasJavaClass(){
 228.550 +		return true;
 228.551 +	}
 228.552 +
 228.553 +	public Class getJavaClass() throws ClassNotFoundException{
 228.554 +		return Var.class;
 228.555 +	}
 228.556 +
 228.557 +	static class Parser implements IParser{
 228.558 +		public Expr parse(C context, Object form) throws Exception{
 228.559 +			Symbol sym = (Symbol) RT.second(form);
 228.560 +			Var v = lookupVar(sym, false);
 228.561 +			if(v != null)
 228.562 +				return new TheVarExpr(v);
 228.563 +			throw new Exception("Unable to resolve var: " + sym + " in this context");
 228.564 +		}
 228.565 +	}
 228.566 +}
 228.567 +
 228.568 +public static class KeywordExpr implements Expr{
 228.569 +	public final Keyword k;
 228.570 +
 228.571 +	public KeywordExpr(Keyword k){
 228.572 +		this.k = k;
 228.573 +	}
 228.574 +
 228.575 +	public Object eval() throws Exception{
 228.576 +		return k;
 228.577 +	}
 228.578 +
 228.579 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.580 +		objx.emitKeyword(gen, k);
 228.581 +		if(context == C.STATEMENT)
 228.582 +			gen.pop();
 228.583 +
 228.584 +	}
 228.585 +
 228.586 +	public boolean hasJavaClass(){
 228.587 +		return true;
 228.588 +	}
 228.589 +
 228.590 +	public Class getJavaClass() throws ClassNotFoundException{
 228.591 +		return Keyword.class;
 228.592 +	}
 228.593 +}
 228.594 +
 228.595 +public static class ImportExpr implements Expr{
 228.596 +	public final String c;
 228.597 +	final static Method forNameMethod = Method.getMethod("Class forName(String)");
 228.598 +	final static Method importClassMethod = Method.getMethod("Class importClass(Class)");
 228.599 +	final static Method derefMethod = Method.getMethod("Object deref()");
 228.600 +
 228.601 +	public ImportExpr(String c){
 228.602 +		this.c = c;
 228.603 +	}
 228.604 +
 228.605 +	public Object eval() throws Exception{
 228.606 +		Namespace ns = (Namespace) RT.CURRENT_NS.deref();
 228.607 +		ns.importClass(RT.classForName(c));
 228.608 +		return null;
 228.609 +	}
 228.610 +
 228.611 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.612 +		gen.getStatic(RT_TYPE,"CURRENT_NS",VAR_TYPE);
 228.613 +		gen.invokeVirtual(VAR_TYPE, derefMethod);
 228.614 +		gen.checkCast(NS_TYPE);
 228.615 +		gen.push(c);
 228.616 +		gen.invokeStatic(CLASS_TYPE, forNameMethod);
 228.617 +		gen.invokeVirtual(NS_TYPE, importClassMethod);
 228.618 +		if(context == C.STATEMENT)
 228.619 +			gen.pop();
 228.620 +	}
 228.621 +
 228.622 +	public boolean hasJavaClass(){
 228.623 +		return false;
 228.624 +	}
 228.625 +
 228.626 +	public Class getJavaClass() throws ClassNotFoundException{
 228.627 +		throw new IllegalArgumentException("ImportExpr has no Java class");
 228.628 +	}
 228.629 +
 228.630 +	static class Parser implements IParser{
 228.631 +		public Expr parse(C context, Object form) throws Exception{
 228.632 +			return new ImportExpr((String) RT.second(form));
 228.633 +		}
 228.634 +	}
 228.635 +}
 228.636 +
 228.637 +public static abstract class LiteralExpr implements Expr{
 228.638 +	abstract Object val();
 228.639 +
 228.640 +	public Object eval(){
 228.641 +		return val();
 228.642 +	}
 228.643 +}
 228.644 +
 228.645 +static interface AssignableExpr{
 228.646 +	Object evalAssign(Expr val) throws Exception;
 228.647 +
 228.648 +	void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val);
 228.649 +}
 228.650 +
 228.651 +static public interface MaybePrimitiveExpr extends Expr{
 228.652 +	public boolean canEmitPrimitive();
 228.653 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen);
 228.654 +}
 228.655 +
 228.656 +static public abstract class HostExpr implements Expr, MaybePrimitiveExpr{
 228.657 +	final static Type BOOLEAN_TYPE = Type.getType(Boolean.class);
 228.658 +	final static Type CHAR_TYPE = Type.getType(Character.class);
 228.659 +	final static Type INTEGER_TYPE = Type.getType(Integer.class);
 228.660 +	final static Type LONG_TYPE = Type.getType(Long.class);
 228.661 +	final static Type FLOAT_TYPE = Type.getType(Float.class);
 228.662 +	final static Type DOUBLE_TYPE = Type.getType(Double.class);
 228.663 +	final static Type SHORT_TYPE = Type.getType(Short.class);
 228.664 +	final static Type BYTE_TYPE = Type.getType(Byte.class);
 228.665 +	final static Type NUMBER_TYPE = Type.getType(Number.class);
 228.666 +
 228.667 +	final static Method charValueMethod = Method.getMethod("char charValue()");
 228.668 +	final static Method booleanValueMethod = Method.getMethod("boolean booleanValue()");
 228.669 +
 228.670 +	final static Method charValueOfMethod = Method.getMethod("Character valueOf(char)");
 228.671 +	final static Method intValueOfMethod = Method.getMethod("Integer valueOf(int)");
 228.672 +	final static Method longValueOfMethod = Method.getMethod("Long valueOf(long)");
 228.673 +	final static Method floatValueOfMethod = Method.getMethod("Float valueOf(float)");
 228.674 +	final static Method doubleValueOfMethod = Method.getMethod("Double valueOf(double)");
 228.675 +	final static Method shortValueOfMethod = Method.getMethod("Short valueOf(short)");
 228.676 +	final static Method byteValueOfMethod = Method.getMethod("Byte valueOf(byte)");
 228.677 +
 228.678 +	final static Method intValueMethod = Method.getMethod("int intValue()");
 228.679 +	final static Method longValueMethod = Method.getMethod("long longValue()");
 228.680 +	final static Method floatValueMethod = Method.getMethod("float floatValue()");
 228.681 +	final static Method doubleValueMethod = Method.getMethod("double doubleValue()");
 228.682 +	final static Method byteValueMethod = Method.getMethod("byte byteValue()");
 228.683 +	final static Method shortValueMethod = Method.getMethod("short shortValue()");
 228.684 +
 228.685 +	final static Method fromIntMethod = Method.getMethod("clojure.lang.Num from(int)");
 228.686 +	final static Method fromLongMethod = Method.getMethod("clojure.lang.Num from(long)");
 228.687 +	final static Method fromDoubleMethod = Method.getMethod("clojure.lang.Num from(double)");
 228.688 +
 228.689 +
 228.690 +	//*
 228.691 +	public static void emitBoxReturn(ObjExpr objx, GeneratorAdapter gen, Class returnType){
 228.692 +		if(returnType.isPrimitive())
 228.693 +			{
 228.694 +			if(returnType == boolean.class)
 228.695 +				{
 228.696 +				Label falseLabel = gen.newLabel();
 228.697 +				Label endLabel = gen.newLabel();
 228.698 +				gen.ifZCmp(GeneratorAdapter.EQ, falseLabel);
 228.699 +				gen.getStatic(BOOLEAN_OBJECT_TYPE, "TRUE", BOOLEAN_OBJECT_TYPE);
 228.700 +				gen.goTo(endLabel);
 228.701 +				gen.mark(falseLabel);
 228.702 +				gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE);
 228.703 +//				NIL_EXPR.emit(C.EXPRESSION, fn, gen);
 228.704 +				gen.mark(endLabel);
 228.705 +				}
 228.706 +			else if(returnType == void.class)
 228.707 +				{
 228.708 +				NIL_EXPR.emit(C.EXPRESSION, objx, gen);
 228.709 +				}
 228.710 +			else if(returnType == char.class)
 228.711 +					{
 228.712 +					gen.invokeStatic(CHAR_TYPE, charValueOfMethod);
 228.713 +					}
 228.714 +				else
 228.715 +					{
 228.716 +					if(returnType == int.class)
 228.717 +					//gen.invokeStatic(NUM_TYPE, fromIntMethod);
 228.718 +						gen.invokeStatic(INTEGER_TYPE, intValueOfMethod);
 228.719 +					else if(returnType == float.class)
 228.720 +						{
 228.721 +						//gen.visitInsn(F2D);
 228.722 +						gen.invokeStatic(FLOAT_TYPE, floatValueOfMethod);
 228.723 +						//m = floatValueOfMethod;
 228.724 +						}
 228.725 +					else if(returnType == double.class)
 228.726 +							gen.invokeStatic(DOUBLE_TYPE, doubleValueOfMethod);
 228.727 +						else if(returnType == long.class)
 228.728 +								gen.invokeStatic(LONG_TYPE, longValueOfMethod);
 228.729 +							else if(returnType == byte.class)
 228.730 +									gen.invokeStatic(BYTE_TYPE, byteValueOfMethod);
 228.731 +								else if(returnType == short.class)
 228.732 +										gen.invokeStatic(SHORT_TYPE, shortValueOfMethod);
 228.733 +					}
 228.734 +			}
 228.735 +	}
 228.736 +
 228.737 +	//*/
 228.738 +	public static void emitUnboxArg(ObjExpr objx, GeneratorAdapter gen, Class paramType){
 228.739 +		if(paramType.isPrimitive())
 228.740 +			{
 228.741 +			if(paramType == boolean.class)
 228.742 +				{
 228.743 +				gen.checkCast(BOOLEAN_TYPE);
 228.744 +				gen.invokeVirtual(BOOLEAN_TYPE, booleanValueMethod);
 228.745 +//				Label falseLabel = gen.newLabel();
 228.746 +//				Label endLabel = gen.newLabel();
 228.747 +//				gen.ifNull(falseLabel);
 228.748 +//				gen.push(1);
 228.749 +//				gen.goTo(endLabel);
 228.750 +//				gen.mark(falseLabel);
 228.751 +//				gen.push(0);
 228.752 +//				gen.mark(endLabel);
 228.753 +				}
 228.754 +			else if(paramType == char.class)
 228.755 +				{
 228.756 +				gen.checkCast(CHAR_TYPE);
 228.757 +				gen.invokeVirtual(CHAR_TYPE, charValueMethod);
 228.758 +				}
 228.759 +			else
 228.760 +				{
 228.761 +				Method m = intValueMethod;
 228.762 +				gen.checkCast(NUMBER_TYPE);
 228.763 +				if(paramType == int.class)
 228.764 +					m = intValueMethod;
 228.765 +				else if(paramType == float.class)
 228.766 +					m = floatValueMethod;
 228.767 +				else if(paramType == double.class)
 228.768 +						m = doubleValueMethod;
 228.769 +					else if(paramType == long.class)
 228.770 +							m = longValueMethod;
 228.771 +						else if(paramType == byte.class)
 228.772 +								m = byteValueMethod;
 228.773 +							else if(paramType == short.class)
 228.774 +									m = shortValueMethod;
 228.775 +				gen.invokeVirtual(NUMBER_TYPE, m);
 228.776 +				}
 228.777 +			}
 228.778 +		else
 228.779 +			{
 228.780 +			gen.checkCast(Type.getType(paramType));
 228.781 +			}
 228.782 +	}
 228.783 +
 228.784 +	static class Parser implements IParser{
 228.785 +		public Expr parse(C context, Object frm) throws Exception{
 228.786 +			ISeq form = (ISeq) frm;
 228.787 +			//(. x fieldname-sym) or
 228.788 +			//(. x 0-ary-method)
 228.789 +			// (. x methodname-sym args+)
 228.790 +			// (. x (methodname-sym args?))
 228.791 +			if(RT.length(form) < 3)
 228.792 +				throw new IllegalArgumentException("Malformed member expression, expecting (. target member ...)");
 228.793 +			//determine static or instance
 228.794 +			//static target must be symbol, either fully.qualified.Classname or Classname that has been imported
 228.795 +			int line = (Integer) LINE.deref();
 228.796 +			String source = (String) SOURCE.deref();
 228.797 +			Class c = maybeClass(RT.second(form), false);
 228.798 +			//at this point c will be non-null if static
 228.799 +			Expr instance = null;
 228.800 +			if(c == null)
 228.801 +				instance = analyze(context == C.EVAL ? context : C.EXPRESSION, RT.second(form));
 228.802 +			boolean maybeField = RT.length(form) == 3 &&
 228.803 +			                     (RT.third(form) instanceof Symbol
 228.804 +									|| RT.third(form) instanceof Keyword);
 228.805 +			if(maybeField && !(RT.third(form) instanceof Keyword))
 228.806 +				{
 228.807 +				Symbol sym = (Symbol) RT.third(form);
 228.808 +				if(c != null)
 228.809 +					maybeField = Reflector.getMethods(c, 0, munge(sym.name), true).size() == 0;
 228.810 +				else if(instance != null && instance.hasJavaClass() && instance.getJavaClass() != null)
 228.811 +					maybeField = Reflector.getMethods(instance.getJavaClass(), 0, munge(sym.name), false).size() == 0;
 228.812 +				}
 228.813 +			if(maybeField)    //field
 228.814 +				{
 228.815 +				Symbol sym = (RT.third(form) instanceof Keyword)?
 228.816 +				             ((Keyword)RT.third(form)).sym
 228.817 +							:(Symbol) RT.third(form);
 228.818 +				Symbol tag = tagOf(form);
 228.819 +				if(c != null) {
 228.820 +					return new StaticFieldExpr(line, c, munge(sym.name), tag);
 228.821 +				} else
 228.822 +					return new InstanceFieldExpr(line, instance, munge(sym.name), tag);
 228.823 +				}
 228.824 +			else
 228.825 +				{
 228.826 +				ISeq call = (ISeq) ((RT.third(form) instanceof ISeq) ? RT.third(form) : RT.next(RT.next(form)));
 228.827 +				if(!(RT.first(call) instanceof Symbol))
 228.828 +					throw new IllegalArgumentException("Malformed member expression");
 228.829 +				Symbol sym = (Symbol) RT.first(call);
 228.830 +				Symbol tag = tagOf(form);
 228.831 +				PersistentVector args = PersistentVector.EMPTY;
 228.832 +				for(ISeq s = RT.next(call); s != null; s = s.next())
 228.833 +					args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first()));
 228.834 +				if(c != null)
 228.835 +					return new StaticMethodExpr(source, line, tag, c, munge(sym.name), args);
 228.836 +				else
 228.837 +					return new InstanceMethodExpr(source, line, tag, instance, munge(sym.name), args);
 228.838 +				}
 228.839 +		}
 228.840 +	}
 228.841 +
 228.842 +	private static Class maybeClass(Object form, boolean stringOk) throws Exception{
 228.843 +		if(form instanceof Class)
 228.844 +			return (Class) form;
 228.845 +		Class c = null;
 228.846 +		if(form instanceof Symbol)
 228.847 +			{
 228.848 +			Symbol sym = (Symbol) form;
 228.849 +			if(sym.ns == null) //if ns-qualified can't be classname
 228.850 +				{
 228.851 +				if(Util.equals(sym,COMPILE_STUB_SYM.get()))
 228.852 +					return (Class) COMPILE_STUB_CLASS.get();
 228.853 +				if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[')
 228.854 +					c = RT.classForName(sym.name);
 228.855 +				else
 228.856 +					{
 228.857 +					Object o = currentNS().getMapping(sym);
 228.858 +					if(o instanceof Class)
 228.859 +						c = (Class) o;
 228.860 +					}
 228.861 +				}
 228.862 +			}
 228.863 +		else if(stringOk && form instanceof String)
 228.864 +			c = RT.classForName((String) form);
 228.865 +		return c;
 228.866 +	}
 228.867 +
 228.868 +	/*
 228.869 +	 private static String maybeClassName(Object form, boolean stringOk){
 228.870 +		 String className = null;
 228.871 +		 if(form instanceof Symbol)
 228.872 +			 {
 228.873 +			 Symbol sym = (Symbol) form;
 228.874 +			 if(sym.ns == null) //if ns-qualified can't be classname
 228.875 +				 {
 228.876 +				 if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[')
 228.877 +					 className = sym.name;
 228.878 +				 else
 228.879 +					 {
 228.880 +					 IPersistentMap imports = (IPersistentMap) ((Var) RT.NS_IMPORTS.get()).get();
 228.881 +					 className = (String) imports.valAt(sym);
 228.882 +					 }
 228.883 +				 }
 228.884 +			 }
 228.885 +		 else if(stringOk && form instanceof String)
 228.886 +			 className = (String) form;
 228.887 +		 return className;
 228.888 +	 }
 228.889 + */
 228.890 +	static Class tagToClass(Object tag) throws Exception{
 228.891 +		Class c = maybeClass(tag, true);
 228.892 +		if(tag instanceof Symbol)
 228.893 +			{
 228.894 +			Symbol sym = (Symbol) tag;
 228.895 +			if(sym.ns == null) //if ns-qualified can't be classname
 228.896 +				{
 228.897 +				if(sym.name.equals("objects"))
 228.898 +					c = Object[].class;
 228.899 +				else if(sym.name.equals("ints"))
 228.900 +					c = int[].class;
 228.901 +				else if(sym.name.equals("longs"))
 228.902 +					c = long[].class;
 228.903 +				else if(sym.name.equals("floats"))
 228.904 +						c = float[].class;
 228.905 +					else if(sym.name.equals("doubles"))
 228.906 +							c = double[].class;
 228.907 +						else if(sym.name.equals("chars"))
 228.908 +								c = char[].class;
 228.909 +							else if(sym.name.equals("shorts"))
 228.910 +									c = short[].class;
 228.911 +								else if(sym.name.equals("bytes"))
 228.912 +										c = byte[].class;
 228.913 +									else if(sym.name.equals("booleans"))
 228.914 +											c = boolean[].class;
 228.915 +				}
 228.916 +			}
 228.917 +		if(c != null)
 228.918 +			return c;
 228.919 +		throw new IllegalArgumentException("Unable to resolve classname: " + tag);
 228.920 +	}
 228.921 +}
 228.922 +
 228.923 +static abstract class FieldExpr extends HostExpr{
 228.924 +}
 228.925 +
 228.926 +static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{
 228.927 +	public final Expr target;
 228.928 +	public final Class targetClass;
 228.929 +	public final java.lang.reflect.Field field;
 228.930 +	public final String fieldName;
 228.931 +	public final int line;
 228.932 +	public final Symbol tag;
 228.933 +	final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String)");
 228.934 +	final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)");
 228.935 +
 228.936 +
 228.937 +	public InstanceFieldExpr(int line, Expr target, String fieldName, Symbol tag) throws Exception{
 228.938 +		this.target = target;
 228.939 +		this.targetClass = target.hasJavaClass() ? target.getJavaClass() : null;
 228.940 +		this.field = targetClass != null ? Reflector.getField(targetClass, fieldName, false) : null;
 228.941 +		this.fieldName = fieldName;
 228.942 +		this.line = line;
 228.943 +		this.tag = tag;
 228.944 +		if(field == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref()))
 228.945 +			{
 228.946 +			RT.errPrintWriter()
 228.947 +		      .format("Reflection warning, %s:%d - reference to field %s can't be resolved.\n",
 228.948 +					  SOURCE_PATH.deref(), line, fieldName);
 228.949 +			}
 228.950 +	}
 228.951 +
 228.952 +	public Object eval() throws Exception{
 228.953 +		return Reflector.invokeNoArgInstanceMember(target.eval(), fieldName);
 228.954 +	}
 228.955 +
 228.956 +	public boolean canEmitPrimitive(){
 228.957 +		return targetClass != null && field != null &&
 228.958 +		       Util.isPrimitive(field.getType());
 228.959 +	}
 228.960 +
 228.961 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
 228.962 +		gen.visitLineNumber(line, gen.mark());
 228.963 +		if(targetClass != null && field != null)
 228.964 +			{
 228.965 +			target.emit(C.EXPRESSION, objx, gen);
 228.966 +			gen.checkCast(getType(targetClass));
 228.967 +			gen.getField(getType(targetClass), fieldName, Type.getType(field.getType()));
 228.968 +			}
 228.969 +		else
 228.970 +			throw new UnsupportedOperationException("Unboxed emit of unknown member");
 228.971 +	}
 228.972 +
 228.973 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
 228.974 +		gen.visitLineNumber(line, gen.mark());
 228.975 +		if(targetClass != null && field != null)
 228.976 +			{
 228.977 +			target.emit(C.EXPRESSION, objx, gen);
 228.978 +			gen.checkCast(getType(targetClass));
 228.979 +			gen.getField(getType(targetClass), fieldName, Type.getType(field.getType()));
 228.980 +			//if(context != C.STATEMENT)
 228.981 +			HostExpr.emitBoxReturn(objx, gen, field.getType());
 228.982 +			if(context == C.STATEMENT)
 228.983 +				{
 228.984 +				gen.pop();
 228.985 +				}
 228.986 +			}
 228.987 +		else
 228.988 +			{
 228.989 +			target.emit(C.EXPRESSION, objx, gen);
 228.990 +			gen.push(fieldName);
 228.991 +			gen.invokeStatic(REFLECTOR_TYPE, invokeNoArgInstanceMember);
 228.992 +			if(context == C.STATEMENT)
 228.993 +				gen.pop();
 228.994 +			}
 228.995 +	}
 228.996 +
 228.997 +	public boolean hasJavaClass() throws Exception{
 228.998 +		return field != null || tag != null;
 228.999 +	}
228.1000 +
228.1001 +	public Class getJavaClass() throws Exception{
228.1002 +		return tag != null ? HostExpr.tagToClass(tag) : field.getType();
228.1003 +	}
228.1004 +
228.1005 +	public Object evalAssign(Expr val) throws Exception{
228.1006 +		return Reflector.setInstanceField(target.eval(), fieldName, val.eval());
228.1007 +	}
228.1008 +
228.1009 +	public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen,
228.1010 +	                       Expr val){
228.1011 +		gen.visitLineNumber(line, gen.mark());
228.1012 +		if(targetClass != null && field != null)
228.1013 +			{
228.1014 +			target.emit(C.EXPRESSION, objx, gen);
228.1015 +			gen.checkCast(Type.getType(targetClass));
228.1016 +			val.emit(C.EXPRESSION, objx, gen);
228.1017 +			gen.dupX1();
228.1018 +			HostExpr.emitUnboxArg(objx, gen, field.getType());
228.1019 +			gen.putField(Type.getType(targetClass), fieldName, Type.getType(field.getType()));
228.1020 +			}
228.1021 +		else
228.1022 +			{
228.1023 +			target.emit(C.EXPRESSION, objx, gen);
228.1024 +			gen.push(fieldName);
228.1025 +			val.emit(C.EXPRESSION, objx, gen);
228.1026 +			gen.invokeStatic(REFLECTOR_TYPE, setInstanceFieldMethod);
228.1027 +			}
228.1028 +		if(context == C.STATEMENT)
228.1029 +			gen.pop();
228.1030 +	}
228.1031 +}
228.1032 +
228.1033 +static class StaticFieldExpr extends FieldExpr implements AssignableExpr{
228.1034 +	//final String className;
228.1035 +	public final String fieldName;
228.1036 +	public final Class c;
228.1037 +	public final java.lang.reflect.Field field;
228.1038 +	public final Symbol tag;
228.1039 +//	final static Method getStaticFieldMethod = Method.getMethod("Object getStaticField(String,String)");
228.1040 +//	final static Method setStaticFieldMethod = Method.getMethod("Object setStaticField(String,String,Object)");
228.1041 +	final int line;
228.1042 +
228.1043 +	public StaticFieldExpr(int line, Class c, String fieldName, Symbol tag) throws Exception{
228.1044 +		//this.className = className;
228.1045 +		this.fieldName = fieldName;
228.1046 +		this.line = line;
228.1047 +		//c = Class.forName(className);
228.1048 +		this.c = c;
228.1049 +		field = c.getField(fieldName);
228.1050 +		this.tag = tag;
228.1051 +	}
228.1052 +
228.1053 +	public Object eval() throws Exception{
228.1054 +		return Reflector.getStaticField(c, fieldName);
228.1055 +	}
228.1056 +
228.1057 +	public boolean canEmitPrimitive(){
228.1058 +		return Util.isPrimitive(field.getType());
228.1059 +	}
228.1060 +
228.1061 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.1062 +		gen.visitLineNumber(line, gen.mark());
228.1063 +		gen.getStatic(Type.getType(c), fieldName, Type.getType(field.getType()));
228.1064 +	}
228.1065 +
228.1066 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1067 +		gen.visitLineNumber(line, gen.mark());
228.1068 +
228.1069 +		gen.getStatic(Type.getType(c), fieldName, Type.getType(field.getType()));
228.1070 +		//if(context != C.STATEMENT)
228.1071 +		HostExpr.emitBoxReturn(objx, gen, field.getType());
228.1072 +		if(context == C.STATEMENT)
228.1073 +			{
228.1074 +			gen.pop();
228.1075 +			}
228.1076 +//		gen.push(className);
228.1077 +//		gen.push(fieldName);
228.1078 +//		gen.invokeStatic(REFLECTOR_TYPE, getStaticFieldMethod);
228.1079 +	}
228.1080 +
228.1081 +	public boolean hasJavaClass(){
228.1082 +		return true;
228.1083 +	}
228.1084 +
228.1085 +	public Class getJavaClass() throws Exception{
228.1086 +		//Class c = Class.forName(className);
228.1087 +		//java.lang.reflect.Field field = c.getField(fieldName);
228.1088 +		return tag != null ? HostExpr.tagToClass(tag) : field.getType();
228.1089 +	}
228.1090 +
228.1091 +	public Object evalAssign(Expr val) throws Exception{
228.1092 +		return Reflector.setStaticField(c, fieldName, val.eval());
228.1093 +	}
228.1094 +
228.1095 +	public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen,
228.1096 +	                       Expr val){
228.1097 +		gen.visitLineNumber(line, gen.mark());
228.1098 +		val.emit(C.EXPRESSION, objx, gen);
228.1099 +		gen.dup();
228.1100 +		HostExpr.emitUnboxArg(objx, gen, field.getType());
228.1101 +		gen.putStatic(Type.getType(c), fieldName, Type.getType(field.getType()));
228.1102 +		if(context == C.STATEMENT)
228.1103 +			gen.pop();
228.1104 +	}
228.1105 +
228.1106 +
228.1107 +}
228.1108 +
228.1109 +static Class maybePrimitiveType(Expr e){
228.1110 +	try
228.1111 +		{
228.1112 +		if(e instanceof MaybePrimitiveExpr && e.hasJavaClass() && ((MaybePrimitiveExpr)e).canEmitPrimitive())
228.1113 +			{
228.1114 +			Class c = e.getJavaClass();
228.1115 +			if(Util.isPrimitive(c))
228.1116 +				return c;
228.1117 +			}
228.1118 +		}
228.1119 +	catch(Exception ex)
228.1120 +		{
228.1121 +		throw new RuntimeException(ex);
228.1122 +		}
228.1123 +	return null;
228.1124 +}
228.1125 +
228.1126 +static abstract class MethodExpr extends HostExpr{
228.1127 +	static void emitArgsAsArray(IPersistentVector args, ObjExpr objx, GeneratorAdapter gen){
228.1128 +		gen.push(args.count());
228.1129 +		gen.newArray(OBJECT_TYPE);
228.1130 +		for(int i = 0; i < args.count(); i++)
228.1131 +			{
228.1132 +			gen.dup();
228.1133 +			gen.push(i);
228.1134 +			((Expr) args.nth(i)).emit(C.EXPRESSION, objx, gen);
228.1135 +			gen.arrayStore(OBJECT_TYPE);
228.1136 +			}
228.1137 +	}
228.1138 +
228.1139 +	public static void emitTypedArgs(ObjExpr objx, GeneratorAdapter gen, Class[] parameterTypes, IPersistentVector args){
228.1140 +		for(int i = 0; i < parameterTypes.length; i++)
228.1141 +			{
228.1142 +			Expr e = (Expr) args.nth(i);
228.1143 +			try
228.1144 +				{
228.1145 +				if(maybePrimitiveType(e) == parameterTypes[i])
228.1146 +					{
228.1147 +					((MaybePrimitiveExpr) e).emitUnboxed(C.EXPRESSION, objx, gen);
228.1148 +					}
228.1149 +				else
228.1150 +					{
228.1151 +					e.emit(C.EXPRESSION, objx, gen);
228.1152 +					HostExpr.emitUnboxArg(objx, gen, parameterTypes[i]);
228.1153 +					}
228.1154 +				}
228.1155 +			catch(Exception e1)
228.1156 +				{
228.1157 +				e1.printStackTrace(RT.errPrintWriter());
228.1158 +				}
228.1159 +
228.1160 +			}
228.1161 +	}
228.1162 +}
228.1163 +
228.1164 +static class InstanceMethodExpr extends MethodExpr{
228.1165 +	public final Expr target;
228.1166 +	public final String methodName;
228.1167 +	public final IPersistentVector args;
228.1168 +	public final String source;
228.1169 +	public final int line;
228.1170 +	public final Symbol tag;
228.1171 +	public final java.lang.reflect.Method method;
228.1172 +
228.1173 +	final static Method invokeInstanceMethodMethod =
228.1174 +			Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])");
228.1175 +
228.1176 +
228.1177 +	public InstanceMethodExpr(String source, int line, Symbol tag, Expr target, String methodName, IPersistentVector args)
228.1178 +			throws Exception{
228.1179 +		this.source = source;
228.1180 +		this.line = line;
228.1181 +		this.args = args;
228.1182 +		this.methodName = methodName;
228.1183 +		this.target = target;
228.1184 +		this.tag = tag;
228.1185 +		if(target.hasJavaClass() && target.getJavaClass() != null)
228.1186 +			{
228.1187 +			List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false);
228.1188 +			if(methods.isEmpty())
228.1189 +				method = null;
228.1190 +			//throw new IllegalArgumentException("No matching method found");
228.1191 +			else
228.1192 +				{
228.1193 +				int methodidx = 0;
228.1194 +				if(methods.size() > 1)
228.1195 +					{
228.1196 +					ArrayList<Class[]> params = new ArrayList();
228.1197 +					ArrayList<Class> rets = new ArrayList();
228.1198 +					for(int i = 0; i < methods.size(); i++)
228.1199 +						{
228.1200 +						java.lang.reflect.Method m = (java.lang.reflect.Method) methods.get(i);
228.1201 +						params.add(m.getParameterTypes());
228.1202 +						rets.add(m.getReturnType());
228.1203 +						}
228.1204 +					methodidx = getMatchingParams(methodName, params, args, rets);
228.1205 +					}
228.1206 +				java.lang.reflect.Method m =
228.1207 +						(java.lang.reflect.Method) (methodidx >= 0 ? methods.get(methodidx) : null);
228.1208 +				if(m != null && !Modifier.isPublic(m.getDeclaringClass().getModifiers()))
228.1209 +					{
228.1210 +					//public method of non-public class, try to find it in hierarchy
228.1211 +					m = Reflector.getAsMethodOfPublicBase(m.getDeclaringClass(), m);
228.1212 +					}
228.1213 +				method = m;
228.1214 +				}
228.1215 +			}
228.1216 +		else
228.1217 +			method = null;
228.1218 +
228.1219 +		if(method == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref()))
228.1220 +			{
228.1221 +			RT.errPrintWriter()
228.1222 +		      .format("Reflection warning, %s:%d - call to %s can't be resolved.\n",
228.1223 +					  SOURCE_PATH.deref(), line, methodName);
228.1224 +			}
228.1225 +	}
228.1226 +
228.1227 +	public Object eval() throws Exception{
228.1228 +		try
228.1229 +			{
228.1230 +			Object targetval = target.eval();
228.1231 +			Object[] argvals = new Object[args.count()];
228.1232 +			for(int i = 0; i < args.count(); i++)
228.1233 +				argvals[i] = ((Expr) args.nth(i)).eval();
228.1234 +			if(method != null)
228.1235 +				{
228.1236 +				LinkedList ms = new LinkedList();
228.1237 +				ms.add(method);
228.1238 +				return Reflector.invokeMatchingMethod(methodName, ms, targetval, argvals);
228.1239 +				}
228.1240 +			return Reflector.invokeInstanceMethod(targetval, methodName, argvals);
228.1241 +			}
228.1242 +		catch(Throwable e)
228.1243 +			{
228.1244 +			if(!(e instanceof CompilerException))
228.1245 +				throw new CompilerException(source, line, e);
228.1246 +			else
228.1247 +				throw (CompilerException) e;
228.1248 +			}
228.1249 +	}
228.1250 +
228.1251 +	public boolean canEmitPrimitive(){
228.1252 +		return method != null && Util.isPrimitive(method.getReturnType());
228.1253 +	}
228.1254 +
228.1255 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.1256 +		gen.visitLineNumber(line, gen.mark());
228.1257 +		if(method != null)
228.1258 +			{
228.1259 +			Type type = Type.getType(method.getDeclaringClass());
228.1260 +			target.emit(C.EXPRESSION, objx, gen);
228.1261 +			//if(!method.getDeclaringClass().isInterface())
228.1262 +			gen.checkCast(type);
228.1263 +			MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args);
228.1264 +			if(context == C.RETURN)
228.1265 +				{
228.1266 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.1267 +				method.emitClearLocals(gen);
228.1268 +				}
228.1269 +			Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method));
228.1270 +			if(method.getDeclaringClass().isInterface())
228.1271 +				gen.invokeInterface(type, m);
228.1272 +			else
228.1273 +				gen.invokeVirtual(type, m);
228.1274 +			}
228.1275 +		else
228.1276 +			throw new UnsupportedOperationException("Unboxed emit of unknown member");
228.1277 +	}
228.1278 +
228.1279 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1280 +		gen.visitLineNumber(line, gen.mark());
228.1281 +		if(method != null)
228.1282 +			{
228.1283 +			Type type = Type.getType(method.getDeclaringClass());
228.1284 +			target.emit(C.EXPRESSION, objx, gen);
228.1285 +			//if(!method.getDeclaringClass().isInterface())
228.1286 +			gen.checkCast(type);
228.1287 +			MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args);
228.1288 +			if(context == C.RETURN)
228.1289 +				{
228.1290 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.1291 +				method.emitClearLocals(gen);
228.1292 +				}
228.1293 +			Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method));
228.1294 +			if(method.getDeclaringClass().isInterface())
228.1295 +				gen.invokeInterface(type, m);
228.1296 +			else
228.1297 +				gen.invokeVirtual(type, m);
228.1298 +			//if(context != C.STATEMENT || method.getReturnType() == Void.TYPE)
228.1299 +			HostExpr.emitBoxReturn(objx, gen, method.getReturnType());
228.1300 +			}
228.1301 +		else
228.1302 +			{
228.1303 +			target.emit(C.EXPRESSION, objx, gen);
228.1304 +			gen.push(methodName);
228.1305 +			emitArgsAsArray(args, objx, gen);
228.1306 +			if(context == C.RETURN)
228.1307 +				{
228.1308 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.1309 +				method.emitClearLocals(gen);
228.1310 +				}
228.1311 +			gen.invokeStatic(REFLECTOR_TYPE, invokeInstanceMethodMethod);
228.1312 +			}
228.1313 +		if(context == C.STATEMENT)
228.1314 +			gen.pop();
228.1315 +	}
228.1316 +
228.1317 +	public boolean hasJavaClass(){
228.1318 +		return method != null || tag != null;
228.1319 +	}
228.1320 +
228.1321 +	public Class getJavaClass() throws Exception{
228.1322 +		return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType();
228.1323 +	}
228.1324 +}
228.1325 +
228.1326 +
228.1327 +static class StaticMethodExpr extends MethodExpr{
228.1328 +	//final String className;
228.1329 +	public final Class c;
228.1330 +	public final String methodName;
228.1331 +	public final IPersistentVector args;
228.1332 +	public final String source;
228.1333 +	public final int line;
228.1334 +	public final java.lang.reflect.Method method;
228.1335 +	public final Symbol tag;
228.1336 +	final static Method forNameMethod = Method.getMethod("Class forName(String)");
228.1337 +	final static Method invokeStaticMethodMethod =
228.1338 +			Method.getMethod("Object invokeStaticMethod(Class,String,Object[])");
228.1339 +
228.1340 +
228.1341 +	public StaticMethodExpr(String source, int line, Symbol tag, Class c, String methodName, IPersistentVector args)
228.1342 +			throws Exception{
228.1343 +		this.c = c;
228.1344 +		this.methodName = methodName;
228.1345 +		this.args = args;
228.1346 +		this.source = source;
228.1347 +		this.line = line;
228.1348 +		this.tag = tag;
228.1349 +
228.1350 +		List methods = Reflector.getMethods(c, args.count(), methodName, true);
228.1351 +		if(methods.isEmpty())
228.1352 +			throw new IllegalArgumentException("No matching method: " + methodName);
228.1353 +
228.1354 +		int methodidx = 0;
228.1355 +		if(methods.size() > 1)
228.1356 +			{
228.1357 +			ArrayList<Class[]> params = new ArrayList();
228.1358 +			ArrayList<Class> rets = new ArrayList();
228.1359 +			for(int i = 0; i < methods.size(); i++)
228.1360 +				{
228.1361 +				java.lang.reflect.Method m = (java.lang.reflect.Method) methods.get(i);
228.1362 +				params.add(m.getParameterTypes());
228.1363 +				rets.add(m.getReturnType());
228.1364 +				}
228.1365 +			methodidx = getMatchingParams(methodName, params, args, rets);
228.1366 +			}
228.1367 +		method = (java.lang.reflect.Method) (methodidx >= 0 ? methods.get(methodidx) : null);
228.1368 +		if(method == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref()))
228.1369 +			{
228.1370 +			RT.errPrintWriter()
228.1371 +              .format("Reflection warning, %s:%d - call to %s can't be resolved.\n",
228.1372 +                      SOURCE_PATH.deref(), line, methodName);
228.1373 +			}
228.1374 +	}
228.1375 +
228.1376 +	public Object eval() throws Exception{
228.1377 +		try
228.1378 +			{
228.1379 +			Object[] argvals = new Object[args.count()];
228.1380 +			for(int i = 0; i < args.count(); i++)
228.1381 +				argvals[i] = ((Expr) args.nth(i)).eval();
228.1382 +			if(method != null)
228.1383 +				{
228.1384 +				LinkedList ms = new LinkedList();
228.1385 +				ms.add(method);
228.1386 +				return Reflector.invokeMatchingMethod(methodName, ms, null, argvals);
228.1387 +				}
228.1388 +			return Reflector.invokeStaticMethod(c, methodName, argvals);
228.1389 +			}
228.1390 +		catch(Throwable e)
228.1391 +			{
228.1392 +			if(!(e instanceof CompilerException))
228.1393 +				throw new CompilerException(source, line, e);
228.1394 +			else
228.1395 +				throw (CompilerException) e;
228.1396 +			}
228.1397 +	}
228.1398 +
228.1399 +	public boolean canEmitPrimitive(){
228.1400 +		return method != null && Util.isPrimitive(method.getReturnType());
228.1401 +	}
228.1402 +
228.1403 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.1404 +		gen.visitLineNumber(line, gen.mark());
228.1405 +		if(method != null)
228.1406 +			{
228.1407 +			MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args);
228.1408 +			//Type type = Type.getObjectType(className.replace('.', '/'));
228.1409 +			if(context == C.RETURN)
228.1410 +				{
228.1411 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.1412 +				method.emitClearLocals(gen);
228.1413 +				}
228.1414 +			Type type = Type.getType(c);
228.1415 +			Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method));
228.1416 +			gen.invokeStatic(type, m);
228.1417 +			}
228.1418 +		else
228.1419 +			throw new UnsupportedOperationException("Unboxed emit of unknown member");
228.1420 +	}
228.1421 +
228.1422 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1423 +		gen.visitLineNumber(line, gen.mark());
228.1424 +		if(method != null)
228.1425 +			{
228.1426 +			MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args);
228.1427 +			//Type type = Type.getObjectType(className.replace('.', '/'));
228.1428 +			if(context == C.RETURN)
228.1429 +				{
228.1430 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.1431 +				method.emitClearLocals(gen);
228.1432 +				}
228.1433 +			Type type = Type.getType(c);
228.1434 +			Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method));
228.1435 +			gen.invokeStatic(type, m);
228.1436 +			//if(context != C.STATEMENT || method.getReturnType() == Void.TYPE)
228.1437 +			HostExpr.emitBoxReturn(objx, gen, method.getReturnType());
228.1438 +			}
228.1439 +		else
228.1440 +			{
228.1441 +			gen.push(c.getName());
228.1442 +			gen.invokeStatic(CLASS_TYPE, forNameMethod);
228.1443 +			gen.push(methodName);
228.1444 +			emitArgsAsArray(args, objx, gen);
228.1445 +			if(context == C.RETURN)
228.1446 +				{
228.1447 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.1448 +				method.emitClearLocals(gen);
228.1449 +				}
228.1450 +			gen.invokeStatic(REFLECTOR_TYPE, invokeStaticMethodMethod);
228.1451 +			}
228.1452 +		if(context == C.STATEMENT)
228.1453 +			gen.pop();
228.1454 +	}
228.1455 +
228.1456 +	public boolean hasJavaClass(){
228.1457 +		return method != null || tag != null;
228.1458 +	}
228.1459 +
228.1460 +	public Class getJavaClass() throws Exception{
228.1461 +		return tag != null ? HostExpr.tagToClass(tag) : method.getReturnType();
228.1462 +	}
228.1463 +}
228.1464 +
228.1465 +static class UnresolvedVarExpr implements Expr{
228.1466 +	public final Symbol symbol;
228.1467 +
228.1468 +	public UnresolvedVarExpr(Symbol symbol){
228.1469 +		this.symbol = symbol;
228.1470 +	}
228.1471 +
228.1472 +	public boolean hasJavaClass(){
228.1473 +		return false;
228.1474 +	}
228.1475 +
228.1476 +	public Class getJavaClass() throws Exception{
228.1477 +		throw new IllegalArgumentException(
228.1478 +				"UnresolvedVarExpr has no Java class");
228.1479 +	}
228.1480 +
228.1481 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1482 +	}
228.1483 +
228.1484 +	public Object eval() throws Exception{
228.1485 +		throw new IllegalArgumentException(
228.1486 +				"UnresolvedVarExpr cannot be evalled");
228.1487 +	}
228.1488 +}
228.1489 +
228.1490 +static class ConstantExpr extends LiteralExpr{
228.1491 +	//stuff quoted vals in classloader at compile time, pull out at runtime
228.1492 +	//this won't work for static compilation...
228.1493 +	public final Object v;
228.1494 +	public final int id;
228.1495 +
228.1496 +	public ConstantExpr(Object v){
228.1497 +		this.v = v;
228.1498 +		this.id = registerConstant(v);
228.1499 +//		this.id = RT.nextID();
228.1500 +//		DynamicClassLoader loader = (DynamicClassLoader) LOADER.get();
228.1501 +//		loader.registerQuotedVal(id, v);
228.1502 +	}
228.1503 +
228.1504 +	Object val(){
228.1505 +		return v;
228.1506 +	}
228.1507 +
228.1508 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1509 +		objx.emitConstant(gen, id);
228.1510 +		if(context == C.STATEMENT)
228.1511 +			{
228.1512 +			gen.pop();
228.1513 +//			gen.loadThis();
228.1514 +//			gen.invokeVirtual(OBJECT_TYPE, getClassMethod);
228.1515 +//			gen.invokeVirtual(CLASS_TYPE, getClassLoaderMethod);
228.1516 +//			gen.checkCast(DYNAMIC_CLASSLOADER_TYPE);
228.1517 +//			gen.push(id);
228.1518 +//			gen.invokeVirtual(DYNAMIC_CLASSLOADER_TYPE, getQuotedValMethod);
228.1519 +			}
228.1520 +	}
228.1521 +
228.1522 +	public boolean hasJavaClass(){
228.1523 +		return Modifier.isPublic(v.getClass().getModifiers());
228.1524 +		//return false;
228.1525 +	}
228.1526 +
228.1527 +	public Class getJavaClass() throws Exception{
228.1528 +		return v.getClass();
228.1529 +		//throw new IllegalArgumentException("Has no Java class");
228.1530 +	}
228.1531 +
228.1532 +	static class Parser implements IParser{
228.1533 +		public Expr parse(C context, Object form){
228.1534 +			Object v = RT.second(form);
228.1535 +
228.1536 +			if(v == null)
228.1537 +				return NIL_EXPR;
228.1538 +//			Class fclass = v.getClass();
228.1539 +//			if(fclass == Keyword.class)
228.1540 +//				return registerKeyword((Keyword) v);
228.1541 +//			else if(v instanceof Num)
228.1542 +//				return new NumExpr((Num) v);
228.1543 +//			else if(fclass == String.class)
228.1544 +//				return new StringExpr((String) v);
228.1545 +//			else if(fclass == Character.class)
228.1546 +//				return new CharExpr((Character) v);
228.1547 +//			else if(v instanceof IPersistentCollection && ((IPersistentCollection) v).count() == 0)
228.1548 +//				return new EmptyExpr(v);
228.1549 +			else
228.1550 +				return new ConstantExpr(v);
228.1551 +		}
228.1552 +	}
228.1553 +}
228.1554 +
228.1555 +static class NilExpr extends LiteralExpr{
228.1556 +	Object val(){
228.1557 +		return null;
228.1558 +	}
228.1559 +
228.1560 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1561 +		gen.visitInsn(Opcodes.ACONST_NULL);
228.1562 +		if(context == C.STATEMENT)
228.1563 +			gen.pop();
228.1564 +	}
228.1565 +
228.1566 +	public boolean hasJavaClass(){
228.1567 +		return true;
228.1568 +	}
228.1569 +
228.1570 +	public Class getJavaClass() throws Exception{
228.1571 +		return null;
228.1572 +	}
228.1573 +}
228.1574 +
228.1575 +final static NilExpr NIL_EXPR = new NilExpr();
228.1576 +
228.1577 +static class BooleanExpr extends LiteralExpr{
228.1578 +	public final boolean val;
228.1579 +
228.1580 +
228.1581 +	public BooleanExpr(boolean val){
228.1582 +		this.val = val;
228.1583 +	}
228.1584 +
228.1585 +	Object val(){
228.1586 +		return val ? RT.T : RT.F;
228.1587 +	}
228.1588 +
228.1589 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1590 +		if(val)
228.1591 +			gen.getStatic(BOOLEAN_OBJECT_TYPE, "TRUE", BOOLEAN_OBJECT_TYPE);
228.1592 +		else
228.1593 +			gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE);
228.1594 +		if(context == C.STATEMENT)
228.1595 +			{
228.1596 +			gen.pop();
228.1597 +			}
228.1598 +	}
228.1599 +
228.1600 +	public boolean hasJavaClass(){
228.1601 +		return true;
228.1602 +	}
228.1603 +
228.1604 +	public Class getJavaClass() throws Exception{
228.1605 +		return Boolean.class;
228.1606 +	}
228.1607 +}
228.1608 +
228.1609 +final static BooleanExpr TRUE_EXPR = new BooleanExpr(true);
228.1610 +final static BooleanExpr FALSE_EXPR = new BooleanExpr(false);
228.1611 +
228.1612 +static class StringExpr extends LiteralExpr{
228.1613 +	public final String str;
228.1614 +
228.1615 +	public StringExpr(String str){
228.1616 +		this.str = str;
228.1617 +	}
228.1618 +
228.1619 +	Object val(){
228.1620 +		return str;
228.1621 +	}
228.1622 +
228.1623 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1624 +		if(context != C.STATEMENT)
228.1625 +			gen.push(str);
228.1626 +	}
228.1627 +
228.1628 +	public boolean hasJavaClass(){
228.1629 +		return true;
228.1630 +	}
228.1631 +
228.1632 +	public Class getJavaClass() throws Exception{
228.1633 +		return String.class;
228.1634 +	}
228.1635 +}
228.1636 +
228.1637 +
228.1638 +static class MonitorEnterExpr extends UntypedExpr{
228.1639 +	final Expr target;
228.1640 +
228.1641 +	public MonitorEnterExpr(Expr target){
228.1642 +		this.target = target;
228.1643 +	}
228.1644 +
228.1645 +	public Object eval() throws Exception{
228.1646 +		throw new UnsupportedOperationException("Can't eval monitor-enter");
228.1647 +	}
228.1648 +
228.1649 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1650 +		target.emit(C.EXPRESSION, objx, gen);
228.1651 +		gen.monitorEnter();
228.1652 +		NIL_EXPR.emit(context, objx, gen);
228.1653 +	}
228.1654 +
228.1655 +	static class Parser implements IParser{
228.1656 +		public Expr parse(C context, Object form) throws Exception{
228.1657 +			return new MonitorEnterExpr(analyze(C.EXPRESSION, RT.second(form)));
228.1658 +		}
228.1659 +	}
228.1660 +}
228.1661 +
228.1662 +static class MonitorExitExpr extends UntypedExpr{
228.1663 +	final Expr target;
228.1664 +
228.1665 +	public MonitorExitExpr(Expr target){
228.1666 +		this.target = target;
228.1667 +	}
228.1668 +
228.1669 +	public Object eval() throws Exception{
228.1670 +		throw new UnsupportedOperationException("Can't eval monitor-exit");
228.1671 +	}
228.1672 +
228.1673 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1674 +		target.emit(C.EXPRESSION, objx, gen);
228.1675 +		gen.monitorExit();
228.1676 +		NIL_EXPR.emit(context, objx, gen);
228.1677 +	}
228.1678 +
228.1679 +	static class Parser implements IParser{
228.1680 +		public Expr parse(C context, Object form) throws Exception{
228.1681 +			return new MonitorExitExpr(analyze(C.EXPRESSION, RT.second(form)));
228.1682 +		}
228.1683 +	}
228.1684 +
228.1685 +}
228.1686 +
228.1687 +public static class TryExpr implements Expr{
228.1688 +	public final Expr tryExpr;
228.1689 +	public final Expr finallyExpr;
228.1690 +	public final PersistentVector catchExprs;
228.1691 +	public final int retLocal;
228.1692 +	public final int finallyLocal;
228.1693 +
228.1694 +	public static class CatchClause{
228.1695 +		//final String className;
228.1696 +		public final Class c;
228.1697 +		public final LocalBinding lb;
228.1698 +		public final Expr handler;
228.1699 +		Label label;
228.1700 +		Label endLabel;
228.1701 +
228.1702 +
228.1703 +		public CatchClause(Class c, LocalBinding lb, Expr handler){
228.1704 +			this.c = c;
228.1705 +			this.lb = lb;
228.1706 +			this.handler = handler;
228.1707 +		}
228.1708 +	}
228.1709 +
228.1710 +	public TryExpr(Expr tryExpr, PersistentVector catchExprs, Expr finallyExpr, int retLocal, int finallyLocal){
228.1711 +		this.tryExpr = tryExpr;
228.1712 +		this.catchExprs = catchExprs;
228.1713 +		this.finallyExpr = finallyExpr;
228.1714 +		this.retLocal = retLocal;
228.1715 +		this.finallyLocal = finallyLocal;
228.1716 +	}
228.1717 +
228.1718 +	public Object eval() throws Exception{
228.1719 +		throw new UnsupportedOperationException("Can't eval try");
228.1720 +	}
228.1721 +
228.1722 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1723 +		Label startTry = gen.newLabel();
228.1724 +		Label endTry = gen.newLabel();
228.1725 +		Label end = gen.newLabel();
228.1726 +		Label ret = gen.newLabel();
228.1727 +		Label finallyLabel = gen.newLabel();
228.1728 +		for(int i = 0; i < catchExprs.count(); i++)
228.1729 +			{
228.1730 +			CatchClause clause = (CatchClause) catchExprs.nth(i);
228.1731 +			clause.label = gen.newLabel();
228.1732 +			clause.endLabel = gen.newLabel();
228.1733 +			}
228.1734 +
228.1735 +		gen.mark(startTry);
228.1736 +		tryExpr.emit(context, objx, gen);
228.1737 +		if(context != C.STATEMENT)
228.1738 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), retLocal);
228.1739 +		gen.mark(endTry);
228.1740 +		if(finallyExpr != null)
228.1741 +			finallyExpr.emit(C.STATEMENT, objx, gen);
228.1742 +		gen.goTo(ret);
228.1743 +
228.1744 +		for(int i = 0; i < catchExprs.count(); i++)
228.1745 +			{
228.1746 +			CatchClause clause = (CatchClause) catchExprs.nth(i);
228.1747 +			gen.mark(clause.label);
228.1748 +			//exception should be on stack
228.1749 +			//put in clause local
228.1750 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), clause.lb.idx);
228.1751 +			clause.handler.emit(context, objx, gen);
228.1752 +			if(context != C.STATEMENT)
228.1753 +				gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), retLocal);
228.1754 +			gen.mark(clause.endLabel);
228.1755 +
228.1756 +			if(finallyExpr != null)
228.1757 +				finallyExpr.emit(C.STATEMENT, objx, gen);
228.1758 +			gen.goTo(ret);
228.1759 +			}
228.1760 +		if(finallyExpr != null)
228.1761 +			{
228.1762 +			gen.mark(finallyLabel);
228.1763 +			//exception should be on stack
228.1764 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), finallyLocal);
228.1765 +			finallyExpr.emit(C.STATEMENT, objx, gen);
228.1766 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), finallyLocal);
228.1767 +			gen.throwException();
228.1768 +			}
228.1769 +		gen.mark(ret);
228.1770 +		if(context != C.STATEMENT)
228.1771 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), retLocal);
228.1772 +		gen.mark(end);
228.1773 +		for(int i = 0; i < catchExprs.count(); i++)
228.1774 +			{
228.1775 +			CatchClause clause = (CatchClause) catchExprs.nth(i);
228.1776 +			gen.visitTryCatchBlock(startTry, endTry, clause.label, clause.c.getName().replace('.', '/'));
228.1777 +			}
228.1778 +		if(finallyExpr != null)
228.1779 +			{
228.1780 +				gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null);
228.1781 +				for(int i = 0; i < catchExprs.count(); i++)
228.1782 +					{
228.1783 +					CatchClause clause = (CatchClause) catchExprs.nth(i);
228.1784 +					gen.visitTryCatchBlock(clause.label, clause.endLabel, finallyLabel, null);
228.1785 +					}
228.1786 +			}
228.1787 +		for(int i = 0; i < catchExprs.count(); i++)
228.1788 +			{
228.1789 +			CatchClause clause = (CatchClause) catchExprs.nth(i);
228.1790 +			gen.visitLocalVariable(clause.lb.name, "Ljava/lang/Object;", null, clause.label, clause.endLabel,
228.1791 +			                       clause.lb.idx);
228.1792 +			}
228.1793 +	}
228.1794 +
228.1795 +	public boolean hasJavaClass() throws Exception{
228.1796 +		return tryExpr.hasJavaClass();
228.1797 +	}
228.1798 +
228.1799 +	public Class getJavaClass() throws Exception{
228.1800 +		return tryExpr.getJavaClass();
228.1801 +	}
228.1802 +
228.1803 +	static class Parser implements IParser{
228.1804 +
228.1805 +		public Expr parse(C context, Object frm) throws Exception{
228.1806 +			ISeq form = (ISeq) frm;
228.1807 +//			if(context == C.EVAL || context == C.EXPRESSION)
228.1808 +			if(context != C.RETURN)
228.1809 +				return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
228.1810 +
228.1811 +			//(try try-expr* catch-expr* finally-expr?)
228.1812 +			//catch-expr: (catch class sym expr*)
228.1813 +			//finally-expr: (finally expr*)
228.1814 +
228.1815 +			PersistentVector body = PersistentVector.EMPTY;
228.1816 +			PersistentVector catches = PersistentVector.EMPTY;
228.1817 +            Expr bodyExpr = null;
228.1818 +			Expr finallyExpr = null;
228.1819 +			boolean caught = false;
228.1820 +
228.1821 +			int retLocal = getAndIncLocalNum();
228.1822 +			int finallyLocal = getAndIncLocalNum();
228.1823 +			for(ISeq fs = form.next(); fs != null; fs = fs.next())
228.1824 +				{
228.1825 +				Object f = fs.first();
228.1826 +				Object op = (f instanceof ISeq) ? ((ISeq) f).first() : null;
228.1827 +				if(!Util.equals(op, CATCH) && !Util.equals(op, FINALLY))
228.1828 +					{
228.1829 +					if(caught)
228.1830 +						throw new Exception("Only catch or finally clause can follow catch in try expression");
228.1831 +					body = body.cons(f);
228.1832 +					}
228.1833 +				else
228.1834 +					{
228.1835 +                    if(bodyExpr == null)
228.1836 +                        bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body));
228.1837 +					if(Util.equals(op, CATCH))
228.1838 +						{
228.1839 +						Class c = HostExpr.maybeClass(RT.second(f), false);
228.1840 +						if(c == null)
228.1841 +							throw new IllegalArgumentException("Unable to resolve classname: " + RT.second(f));
228.1842 +						if(!(RT.third(f) instanceof Symbol))
228.1843 +							throw new IllegalArgumentException(
228.1844 +									"Bad binding form, expected symbol, got: " + RT.third(f));
228.1845 +						Symbol sym = (Symbol) RT.third(f);
228.1846 +						if(sym.getNamespace() != null)
228.1847 +							throw new Exception("Can't bind qualified name:" + sym);
228.1848 +
228.1849 +						IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(),
228.1850 +						                                        NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref(),
228.1851 +						                                        IN_CATCH_FINALLY, RT.T);
228.1852 +						try
228.1853 +							{
228.1854 +							Var.pushThreadBindings(dynamicBindings);
228.1855 +							LocalBinding lb = registerLocal(sym,
228.1856 +							                                (Symbol) (RT.second(f) instanceof Symbol ? RT.second(f)
228.1857 +							                                                                         : null),
228.1858 +							                                null,false);
228.1859 +							Expr handler = (new BodyExpr.Parser()).parse(context, RT.next(RT.next(RT.next(f))));
228.1860 +							catches = catches.cons(new CatchClause(c, lb, handler));
228.1861 +							}
228.1862 +						finally
228.1863 +							{
228.1864 +							Var.popThreadBindings();
228.1865 +							}
228.1866 +						caught = true;
228.1867 +						}
228.1868 +					else //finally
228.1869 +						{
228.1870 +						if(fs.next() != null)
228.1871 +							throw new Exception("finally clause must be last in try expression");
228.1872 +						try
228.1873 +							{
228.1874 +							Var.pushThreadBindings(RT.map(IN_CATCH_FINALLY, RT.T));
228.1875 +							finallyExpr = (new BodyExpr.Parser()).parse(C.STATEMENT, RT.next(f));
228.1876 +							}
228.1877 +						finally
228.1878 +							{
228.1879 +							Var.popThreadBindings();
228.1880 +							}
228.1881 +						}
228.1882 +					}
228.1883 +				}
228.1884 +            if(bodyExpr == null)
228.1885 +                bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body));
228.1886 +
228.1887 +			return new TryExpr(bodyExpr, catches, finallyExpr, retLocal,
228.1888 +			                   finallyLocal);
228.1889 +		}
228.1890 +	}
228.1891 +}
228.1892 +
228.1893 +//static class TryFinallyExpr implements Expr{
228.1894 +//	final Expr tryExpr;
228.1895 +//	final Expr finallyExpr;
228.1896 +//
228.1897 +//
228.1898 +//	public TryFinallyExpr(Expr tryExpr, Expr finallyExpr){
228.1899 +//		this.tryExpr = tryExpr;
228.1900 +//		this.finallyExpr = finallyExpr;
228.1901 +//	}
228.1902 +//
228.1903 +//	public Object eval() throws Exception{
228.1904 +//		throw new UnsupportedOperationException("Can't eval try");
228.1905 +//	}
228.1906 +//
228.1907 +//	public void emit(C context, FnExpr fn, GeneratorAdapter gen){
228.1908 +//		Label startTry = gen.newLabel();
228.1909 +//		Label endTry = gen.newLabel();
228.1910 +//		Label end = gen.newLabel();
228.1911 +//		Label finallyLabel = gen.newLabel();
228.1912 +//		gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null);
228.1913 +//		gen.mark(startTry);
228.1914 +//		tryExpr.emit(context, fn, gen);
228.1915 +//		gen.mark(endTry);
228.1916 +//		finallyExpr.emit(C.STATEMENT, fn, gen);
228.1917 +//		gen.goTo(end);
228.1918 +//		gen.mark(finallyLabel);
228.1919 +//		//exception should be on stack
228.1920 +//		finallyExpr.emit(C.STATEMENT, fn, gen);
228.1921 +//		gen.throwException();
228.1922 +//		gen.mark(end);
228.1923 +//	}
228.1924 +//
228.1925 +//	public boolean hasJavaClass() throws Exception{
228.1926 +//		return tryExpr.hasJavaClass();
228.1927 +//	}
228.1928 +//
228.1929 +//	public Class getJavaClass() throws Exception{
228.1930 +//		return tryExpr.getJavaClass();
228.1931 +//	}
228.1932 +//
228.1933 +//	static class Parser implements IParser{
228.1934 +//		public Expr parse(C context, Object frm) throws Exception{
228.1935 +//			ISeq form = (ISeq) frm;
228.1936 +//			//(try-finally try-expr finally-expr)
228.1937 +//			if(form.count() != 3)
228.1938 +//				throw new IllegalArgumentException(
228.1939 +//						"Wrong number of arguments, expecting: (try-finally try-expr finally-expr) ");
228.1940 +//
228.1941 +//			if(context == C.EVAL || context == C.EXPRESSION)
228.1942 +//				return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
228.1943 +//
228.1944 +//			return new TryFinallyExpr(analyze(context, RT.second(form)),
228.1945 +//			                          analyze(C.STATEMENT, RT.third(form)));
228.1946 +//		}
228.1947 +//	}
228.1948 +//}
228.1949 +
228.1950 +static class ThrowExpr extends UntypedExpr{
228.1951 +	public final Expr excExpr;
228.1952 +
228.1953 +	public ThrowExpr(Expr excExpr){
228.1954 +		this.excExpr = excExpr;
228.1955 +	}
228.1956 +
228.1957 +
228.1958 +	public Object eval() throws Exception{
228.1959 +		throw new Exception("Can't eval throw");
228.1960 +	}
228.1961 +
228.1962 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.1963 +		excExpr.emit(C.EXPRESSION, objx, gen);
228.1964 +		gen.checkCast(THROWABLE_TYPE);
228.1965 +		gen.throwException();
228.1966 +	}
228.1967 +
228.1968 +	static class Parser implements IParser{
228.1969 +		public Expr parse(C context, Object form) throws Exception{
228.1970 +			if(context == C.EVAL)
228.1971 +				return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
228.1972 +			return new ThrowExpr(analyze(C.EXPRESSION, RT.second(form)));
228.1973 +		}
228.1974 +	}
228.1975 +}
228.1976 +
228.1977 +
228.1978 +static public boolean subsumes(Class[] c1, Class[] c2){
228.1979 +	//presumes matching lengths
228.1980 +	Boolean better = false;
228.1981 +	for(int i = 0; i < c1.length; i++)
228.1982 +		{
228.1983 +		if(c1[i] != c2[i])// || c2[i].isPrimitive() && c1[i] == Object.class))
228.1984 +			{
228.1985 +			if(!c1[i].isPrimitive() && c2[i].isPrimitive()
228.1986 +			   //|| Number.class.isAssignableFrom(c1[i]) && c2[i].isPrimitive()
228.1987 +			   ||
228.1988 +			   c2[i].isAssignableFrom(c1[i]))
228.1989 +				better = true;
228.1990 +			else
228.1991 +				return false;
228.1992 +			}
228.1993 +		}
228.1994 +	return better;
228.1995 +}
228.1996 +
228.1997 +static int getMatchingParams(String methodName, ArrayList<Class[]> paramlists, IPersistentVector argexprs,
228.1998 +                             List<Class> rets)
228.1999 +		throws Exception{
228.2000 +	//presumes matching lengths
228.2001 +	int matchIdx = -1;
228.2002 +	boolean tied = false;
228.2003 +    boolean foundExact = false;
228.2004 +	for(int i = 0; i < paramlists.size(); i++)
228.2005 +		{
228.2006 +		boolean match = true;
228.2007 +		ISeq aseq = argexprs.seq();
228.2008 +		int exact = 0;
228.2009 +		for(int p = 0; match && p < argexprs.count() && aseq != null; ++p, aseq = aseq.next())
228.2010 +			{
228.2011 +			Expr arg = (Expr) aseq.first();
228.2012 +			Class aclass = arg.hasJavaClass() ? arg.getJavaClass() : Object.class;
228.2013 +			Class pclass = paramlists.get(i)[p];
228.2014 +			if(arg.hasJavaClass() && aclass == pclass)
228.2015 +				exact++;
228.2016 +			else
228.2017 +				match = Reflector.paramArgTypeMatch(pclass, aclass);
228.2018 +			}
228.2019 +		if(exact == argexprs.count())
228.2020 +            {
228.2021 +            if(!foundExact || matchIdx == -1 || rets.get(matchIdx).isAssignableFrom(rets.get(i)))
228.2022 +                matchIdx = i;
228.2023 +            foundExact = true;
228.2024 +            }
228.2025 +		else if(match && !foundExact)
228.2026 +			{
228.2027 +			if(matchIdx == -1)
228.2028 +				matchIdx = i;
228.2029 +			else
228.2030 +				{
228.2031 +				if(subsumes(paramlists.get(i), paramlists.get(matchIdx)))
228.2032 +					{
228.2033 +					matchIdx = i;
228.2034 +					tied = false;
228.2035 +					}
228.2036 +				else if(Arrays.equals(paramlists.get(matchIdx), paramlists.get(i)))
228.2037 +					{
228.2038 +					if(rets.get(matchIdx).isAssignableFrom(rets.get(i)))
228.2039 +						matchIdx = i;
228.2040 +					}
228.2041 +				else if(!(subsumes(paramlists.get(matchIdx), paramlists.get(i))))
228.2042 +						tied = true;
228.2043 +				}
228.2044 +			}
228.2045 +		}
228.2046 +	if(tied)
228.2047 +		throw new IllegalArgumentException("More than one matching method found: " + methodName);
228.2048 +
228.2049 +	return matchIdx;
228.2050 +}
228.2051 +
228.2052 +public static class NewExpr implements Expr{
228.2053 +	public final IPersistentVector args;
228.2054 +	public final Constructor ctor;
228.2055 +	public final Class c;
228.2056 +	final static Method invokeConstructorMethod =
228.2057 +			Method.getMethod("Object invokeConstructor(Class,Object[])");
228.2058 +//	final static Method forNameMethod = Method.getMethod("Class classForName(String)");
228.2059 +	final static Method forNameMethod = Method.getMethod("Class forName(String)");
228.2060 +
228.2061 +
228.2062 +	public NewExpr(Class c, IPersistentVector args, int line) throws Exception{
228.2063 +		this.args = args;
228.2064 +		this.c = c;
228.2065 +		Constructor[] allctors = c.getConstructors();
228.2066 +		ArrayList ctors = new ArrayList();
228.2067 +		ArrayList<Class[]> params = new ArrayList();
228.2068 +		ArrayList<Class> rets = new ArrayList();
228.2069 +		for(int i = 0; i < allctors.length; i++)
228.2070 +			{
228.2071 +			Constructor ctor = allctors[i];
228.2072 +			if(ctor.getParameterTypes().length == args.count())
228.2073 +				{
228.2074 +				ctors.add(ctor);
228.2075 +				params.add(ctor.getParameterTypes());
228.2076 +				rets.add(c);
228.2077 +				}
228.2078 +			}
228.2079 +		if(ctors.isEmpty())
228.2080 +			throw new IllegalArgumentException("No matching ctor found for " + c);
228.2081 +
228.2082 +		int ctoridx = 0;
228.2083 +		if(ctors.size() > 1)
228.2084 +			{
228.2085 +			ctoridx = getMatchingParams(c.getName(), params, args, rets);
228.2086 +			}
228.2087 +
228.2088 +		this.ctor = ctoridx >= 0 ? (Constructor) ctors.get(ctoridx) : null;
228.2089 +		if(ctor == null && RT.booleanCast(RT.WARN_ON_REFLECTION.deref()))
228.2090 +			{
228.2091 +			RT.errPrintWriter()
228.2092 +              .format("Reflection warning, %s:%d - call to %s ctor can't be resolved.\n",
228.2093 +                      SOURCE_PATH.deref(), line, c.getName());
228.2094 +			}
228.2095 +	}
228.2096 +
228.2097 +	public Object eval() throws Exception{
228.2098 +		Object[] argvals = new Object[args.count()];
228.2099 +		for(int i = 0; i < args.count(); i++)
228.2100 +			argvals[i] = ((Expr) args.nth(i)).eval();
228.2101 +		if(this.ctor != null)
228.2102 +			{
228.2103 +			return ctor.newInstance(Reflector.boxArgs(ctor.getParameterTypes(), argvals));
228.2104 +			}
228.2105 +		return Reflector.invokeConstructor(c, argvals);
228.2106 +	}
228.2107 +
228.2108 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2109 +		if(this.ctor != null)
228.2110 +			{
228.2111 +			Type type = getType(c);
228.2112 +			gen.newInstance(type);
228.2113 +			gen.dup();
228.2114 +			MethodExpr.emitTypedArgs(objx, gen, ctor.getParameterTypes(), args);
228.2115 +			if(context == C.RETURN)
228.2116 +				{
228.2117 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.2118 +				method.emitClearLocals(gen);
228.2119 +				}
228.2120 +			gen.invokeConstructor(type, new Method("<init>", Type.getConstructorDescriptor(ctor)));
228.2121 +			}
228.2122 +		else
228.2123 +			{
228.2124 +			gen.push(destubClassName(c.getName()));
228.2125 +			gen.invokeStatic(CLASS_TYPE, forNameMethod);
228.2126 +			MethodExpr.emitArgsAsArray(args, objx, gen);
228.2127 +			if(context == C.RETURN)
228.2128 +				{
228.2129 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.2130 +				method.emitClearLocals(gen);
228.2131 +				}
228.2132 +			gen.invokeStatic(REFLECTOR_TYPE, invokeConstructorMethod);
228.2133 +			}
228.2134 +		if(context == C.STATEMENT)
228.2135 +			gen.pop();
228.2136 +	}
228.2137 +
228.2138 +	public boolean hasJavaClass(){
228.2139 +		return true;
228.2140 +	}
228.2141 +
228.2142 +	public Class getJavaClass() throws Exception{
228.2143 +		return c;
228.2144 +	}
228.2145 +
228.2146 +	static class Parser implements IParser{
228.2147 +		public Expr parse(C context, Object frm) throws Exception{
228.2148 +			int line = (Integer) LINE.deref();
228.2149 +			ISeq form = (ISeq) frm;
228.2150 +			//(new Classname args...)
228.2151 +			if(form.count() < 2)
228.2152 +				throw new Exception("wrong number of arguments, expecting: (new Classname args...)");
228.2153 +			Class c = HostExpr.maybeClass(RT.second(form), false);
228.2154 +			if(c == null)
228.2155 +				throw new IllegalArgumentException("Unable to resolve classname: " + RT.second(form));
228.2156 +			PersistentVector args = PersistentVector.EMPTY;
228.2157 +			for(ISeq s = RT.next(RT.next(form)); s != null; s = s.next())
228.2158 +				args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first()));
228.2159 +			return new NewExpr(c, args, line);
228.2160 +		}
228.2161 +	}
228.2162 +
228.2163 +}
228.2164 +
228.2165 +public static class MetaExpr implements Expr{
228.2166 +	public final Expr expr;
228.2167 +	public final MapExpr meta;
228.2168 +	final static Type IOBJ_TYPE = Type.getType(IObj.class);
228.2169 +	final static Method withMetaMethod = Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)");
228.2170 +
228.2171 +
228.2172 +	public MetaExpr(Expr expr, MapExpr meta){
228.2173 +		this.expr = expr;
228.2174 +		this.meta = meta;
228.2175 +	}
228.2176 +
228.2177 +	public Object eval() throws Exception{
228.2178 +		return ((IObj) expr.eval()).withMeta((IPersistentMap) meta.eval());
228.2179 +	}
228.2180 +
228.2181 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2182 +		expr.emit(C.EXPRESSION, objx, gen);
228.2183 +		gen.checkCast(IOBJ_TYPE);
228.2184 +		meta.emit(C.EXPRESSION, objx, gen);
228.2185 +		gen.checkCast(IPERSISTENTMAP_TYPE);
228.2186 +		gen.invokeInterface(IOBJ_TYPE, withMetaMethod);
228.2187 +		if(context == C.STATEMENT)
228.2188 +			{
228.2189 +			gen.pop();
228.2190 +			}
228.2191 +	}
228.2192 +
228.2193 +	public boolean hasJavaClass() throws Exception{
228.2194 +		return expr.hasJavaClass();
228.2195 +	}
228.2196 +
228.2197 +	public Class getJavaClass() throws Exception{
228.2198 +		return expr.getJavaClass();
228.2199 +	}
228.2200 +}
228.2201 +
228.2202 +public static class IfExpr implements Expr, MaybePrimitiveExpr{
228.2203 +	public final Expr testExpr;
228.2204 +	public final Expr thenExpr;
228.2205 +	public final Expr elseExpr;
228.2206 +	public final int line;
228.2207 +
228.2208 +
228.2209 +	public IfExpr(int line, Expr testExpr, Expr thenExpr, Expr elseExpr){
228.2210 +		this.testExpr = testExpr;
228.2211 +		this.thenExpr = thenExpr;
228.2212 +		this.elseExpr = elseExpr;
228.2213 +		this.line = line;
228.2214 +	}
228.2215 +
228.2216 +	public Object eval() throws Exception{
228.2217 +		Object t = testExpr.eval();
228.2218 +		if(t != null && t != Boolean.FALSE)
228.2219 +			return thenExpr.eval();
228.2220 +		return elseExpr.eval();
228.2221 +	}
228.2222 +
228.2223 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2224 +		doEmit(context, objx, gen,false);
228.2225 +	}
228.2226 +
228.2227 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.2228 +		doEmit(context, objx, gen, true);
228.2229 +	}
228.2230 +
228.2231 +	public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUnboxed){
228.2232 +		Label nullLabel = gen.newLabel();
228.2233 +		Label falseLabel = gen.newLabel();
228.2234 +		Label endLabel = gen.newLabel();
228.2235 +
228.2236 +		gen.visitLineNumber(line, gen.mark());
228.2237 +
228.2238 +		try
228.2239 +			{
228.2240 +			if(maybePrimitiveType(testExpr) == boolean.class)
228.2241 +				{
228.2242 +				((MaybePrimitiveExpr) testExpr).emitUnboxed(C.EXPRESSION, objx, gen);
228.2243 +				gen.ifZCmp(gen.EQ, falseLabel);
228.2244 +				}
228.2245 +			else
228.2246 +				{
228.2247 +				testExpr.emit(C.EXPRESSION, objx, gen);
228.2248 +				gen.dup();
228.2249 +				gen.ifNull(nullLabel);
228.2250 +				gen.getStatic(BOOLEAN_OBJECT_TYPE, "FALSE", BOOLEAN_OBJECT_TYPE);
228.2251 +				gen.visitJumpInsn(IF_ACMPEQ, falseLabel);
228.2252 +				}
228.2253 +			}
228.2254 +		catch(Exception e)
228.2255 +			{
228.2256 +			throw new RuntimeException(e);
228.2257 +			}
228.2258 +		if(emitUnboxed)
228.2259 +			((MaybePrimitiveExpr)thenExpr).emitUnboxed(context, objx, gen);
228.2260 +		else
228.2261 +			thenExpr.emit(context, objx, gen);
228.2262 +		gen.goTo(endLabel);
228.2263 +		gen.mark(nullLabel);
228.2264 +		gen.pop();
228.2265 +		gen.mark(falseLabel);
228.2266 +		if(emitUnboxed)
228.2267 +			((MaybePrimitiveExpr)elseExpr).emitUnboxed(context, objx, gen);
228.2268 +		else
228.2269 +			elseExpr.emit(context, objx, gen);
228.2270 +		gen.mark(endLabel);
228.2271 +	}
228.2272 +
228.2273 +	public boolean hasJavaClass() throws Exception{
228.2274 +		return thenExpr.hasJavaClass()
228.2275 +		       && elseExpr.hasJavaClass()
228.2276 +		       &&
228.2277 +		       (thenExpr.getJavaClass() == elseExpr.getJavaClass()
228.2278 +		        || (thenExpr.getJavaClass() == null && !elseExpr.getJavaClass().isPrimitive())
228.2279 +		        || (elseExpr.getJavaClass() == null && !thenExpr.getJavaClass().isPrimitive()));
228.2280 +	}
228.2281 +
228.2282 +	public boolean canEmitPrimitive(){
228.2283 +		try
228.2284 +			{
228.2285 +			return thenExpr instanceof MaybePrimitiveExpr
228.2286 +			       && elseExpr instanceof MaybePrimitiveExpr
228.2287 +			       && thenExpr.getJavaClass() == elseExpr.getJavaClass()
228.2288 +			       && ((MaybePrimitiveExpr)thenExpr).canEmitPrimitive()
228.2289 +				   && ((MaybePrimitiveExpr)elseExpr).canEmitPrimitive();
228.2290 +			}
228.2291 +		catch(Exception e)
228.2292 +			{
228.2293 +			return false;
228.2294 +			}
228.2295 +	}
228.2296 +
228.2297 +	public Class getJavaClass() throws Exception{
228.2298 +		Class thenClass = thenExpr.getJavaClass();
228.2299 +		if(thenClass != null)
228.2300 +			return thenClass;
228.2301 +		return elseExpr.getJavaClass();
228.2302 +	}
228.2303 +
228.2304 +	static class Parser implements IParser{
228.2305 +		public Expr parse(C context, Object frm) throws Exception{
228.2306 +			ISeq form = (ISeq) frm;
228.2307 +			//(if test then) or (if test then else)
228.2308 +			if(form.count() > 4)
228.2309 +				throw new Exception("Too many arguments to if");
228.2310 +			else if(form.count() < 3)
228.2311 +				throw new Exception("Too few arguments to if");
228.2312 +            PathNode branch = new PathNode(PATHTYPE.BRANCH, (PathNode) CLEAR_PATH.get());
228.2313 +            Expr testexpr = analyze(context == C.EVAL ? context : C.EXPRESSION, RT.second(form));
228.2314 +            Expr thenexpr, elseexpr;
228.2315 +            try {
228.2316 +                Var.pushThreadBindings(
228.2317 +                        RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch)));
228.2318 +                thenexpr = analyze(context, RT.third(form));
228.2319 +                }
228.2320 +            finally{
228.2321 +                Var.popThreadBindings();
228.2322 +                }
228.2323 +            try {
228.2324 +                Var.pushThreadBindings(
228.2325 +                        RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch)));
228.2326 +                elseexpr = analyze(context, RT.fourth(form));
228.2327 +                }
228.2328 +            finally{
228.2329 +                Var.popThreadBindings();
228.2330 +                }
228.2331 +			return new IfExpr((Integer) LINE.deref(),
228.2332 +			                  testexpr,
228.2333 +			                  thenexpr,
228.2334 +			                  elseexpr);
228.2335 +		}
228.2336 +	}
228.2337 +}
228.2338 +
228.2339 +static final public IPersistentMap CHAR_MAP =
228.2340 +		PersistentHashMap.create('-', "_",
228.2341 +//		                         '.', "_DOT_",
228.2342 +':', "_COLON_",
228.2343 +'+', "_PLUS_",
228.2344 +'>', "_GT_",
228.2345 +'<', "_LT_",
228.2346 +'=', "_EQ_",
228.2347 +'~', "_TILDE_",
228.2348 +'!', "_BANG_",
228.2349 +'@', "_CIRCA_",
228.2350 +'#', "_SHARP_",
228.2351 +'$', "_DOLLARSIGN_",
228.2352 +'%', "_PERCENT_",
228.2353 +'^', "_CARET_",
228.2354 +'&', "_AMPERSAND_",
228.2355 +'*', "_STAR_",
228.2356 +'|', "_BAR_",
228.2357 +'{', "_LBRACE_",
228.2358 +'}', "_RBRACE_",
228.2359 +'[', "_LBRACK_",
228.2360 +']', "_RBRACK_",
228.2361 +'/', "_SLASH_",
228.2362 +'\\', "_BSLASH_",
228.2363 +'?', "_QMARK_");
228.2364 +
228.2365 +static public String munge(String name){
228.2366 +	StringBuilder sb = new StringBuilder();
228.2367 +	for(char c : name.toCharArray())
228.2368 +		{
228.2369 +		String sub = (String) CHAR_MAP.valAt(c);
228.2370 +		if(sub != null)
228.2371 +			sb.append(sub);
228.2372 +		else
228.2373 +			sb.append(c);
228.2374 +		}
228.2375 +	return sb.toString();
228.2376 +}
228.2377 +
228.2378 +public static class EmptyExpr implements Expr{
228.2379 +	public final Object coll;
228.2380 +	final static Type HASHMAP_TYPE = Type.getType(PersistentArrayMap.class);
228.2381 +	final static Type HASHSET_TYPE = Type.getType(PersistentHashSet.class);
228.2382 +	final static Type VECTOR_TYPE = Type.getType(PersistentVector.class);
228.2383 +	final static Type LIST_TYPE = Type.getType(PersistentList.class);
228.2384 +	final static Type EMPTY_LIST_TYPE = Type.getType(PersistentList.EmptyList.class);
228.2385 +
228.2386 +
228.2387 +	public EmptyExpr(Object coll){
228.2388 +		this.coll = coll;
228.2389 +	}
228.2390 +
228.2391 +	public Object eval() throws Exception{
228.2392 +		return coll;
228.2393 +	}
228.2394 +
228.2395 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2396 +		if(coll instanceof IPersistentList)
228.2397 +			gen.getStatic(LIST_TYPE, "EMPTY", EMPTY_LIST_TYPE);
228.2398 +		else if(coll instanceof IPersistentVector)
228.2399 +			gen.getStatic(VECTOR_TYPE, "EMPTY", VECTOR_TYPE);
228.2400 +		else if(coll instanceof IPersistentMap)
228.2401 +				gen.getStatic(HASHMAP_TYPE, "EMPTY", HASHMAP_TYPE);
228.2402 +			else if(coll instanceof IPersistentSet)
228.2403 +					gen.getStatic(HASHSET_TYPE, "EMPTY", HASHSET_TYPE);
228.2404 +				else
228.2405 +					throw new UnsupportedOperationException("Unknown Collection type");
228.2406 +		if(context == C.STATEMENT)
228.2407 +			{
228.2408 +			gen.pop();
228.2409 +			}
228.2410 +	}
228.2411 +
228.2412 +	public boolean hasJavaClass() throws Exception{
228.2413 +		return true;
228.2414 +	}
228.2415 +
228.2416 +	public Class getJavaClass() throws Exception{
228.2417 +		if(coll instanceof IPersistentList)
228.2418 +			return IPersistentList.class;
228.2419 +		else if(coll instanceof IPersistentVector)
228.2420 +			return IPersistentVector.class;
228.2421 +		else if(coll instanceof IPersistentMap)
228.2422 +				return IPersistentMap.class;
228.2423 +			else if(coll instanceof IPersistentSet)
228.2424 +					return IPersistentSet.class;
228.2425 +				else
228.2426 +					throw new UnsupportedOperationException("Unknown Collection type");
228.2427 +	}
228.2428 +}
228.2429 +
228.2430 +public static class ListExpr implements Expr{
228.2431 +	public final IPersistentVector args;
228.2432 +	final static Method arrayToListMethod = Method.getMethod("clojure.lang.ISeq arrayToList(Object[])");
228.2433 +
228.2434 +
228.2435 +	public ListExpr(IPersistentVector args){
228.2436 +		this.args = args;
228.2437 +	}
228.2438 +
228.2439 +	public Object eval() throws Exception{
228.2440 +		IPersistentVector ret = PersistentVector.EMPTY;
228.2441 +		for(int i = 0; i < args.count(); i++)
228.2442 +			ret = (IPersistentVector) ret.cons(((Expr) args.nth(i)).eval());
228.2443 +		return ret.seq();
228.2444 +	}
228.2445 +
228.2446 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2447 +		MethodExpr.emitArgsAsArray(args, objx, gen);
228.2448 +		gen.invokeStatic(RT_TYPE, arrayToListMethod);
228.2449 +		if(context == C.STATEMENT)
228.2450 +			gen.pop();
228.2451 +	}
228.2452 +
228.2453 +	public boolean hasJavaClass() throws Exception{
228.2454 +		return true;
228.2455 +	}
228.2456 +
228.2457 +	public Class getJavaClass() throws Exception{
228.2458 +		return IPersistentList.class;
228.2459 +	}
228.2460 +
228.2461 +}
228.2462 +
228.2463 +public static class MapExpr implements Expr{
228.2464 +	public final IPersistentVector keyvals;
228.2465 +	final static Method mapMethod = Method.getMethod("clojure.lang.IPersistentMap map(Object[])");
228.2466 +
228.2467 +
228.2468 +	public MapExpr(IPersistentVector keyvals){
228.2469 +		this.keyvals = keyvals;
228.2470 +	}
228.2471 +
228.2472 +	public Object eval() throws Exception{
228.2473 +		Object[] ret = new Object[keyvals.count()];
228.2474 +		for(int i = 0; i < keyvals.count(); i++)
228.2475 +			ret[i] = ((Expr) keyvals.nth(i)).eval();
228.2476 +		return RT.map(ret);
228.2477 +	}
228.2478 +
228.2479 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2480 +		MethodExpr.emitArgsAsArray(keyvals, objx, gen);
228.2481 +		gen.invokeStatic(RT_TYPE, mapMethod);
228.2482 +		if(context == C.STATEMENT)
228.2483 +			gen.pop();
228.2484 +	}
228.2485 +
228.2486 +	public boolean hasJavaClass() throws Exception{
228.2487 +		return true;
228.2488 +	}
228.2489 +
228.2490 +	public Class getJavaClass() throws Exception{
228.2491 +		return IPersistentMap.class;
228.2492 +	}
228.2493 +
228.2494 +
228.2495 +	static public Expr parse(C context, IPersistentMap form) throws Exception{
228.2496 +		IPersistentVector keyvals = PersistentVector.EMPTY;
228.2497 +		for(ISeq s = RT.seq(form); s != null; s = s.next())
228.2498 +			{
228.2499 +			IMapEntry e = (IMapEntry) s.first();
228.2500 +			keyvals = (IPersistentVector) keyvals.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e.key()));
228.2501 +			keyvals = (IPersistentVector) keyvals.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e.val()));
228.2502 +			}
228.2503 +		Expr ret = new MapExpr(keyvals);
228.2504 +		if(form instanceof IObj && ((IObj) form).meta() != null)
228.2505 +			return new MetaExpr(ret, (MapExpr) MapExpr
228.2506 +					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta()));
228.2507 +		else
228.2508 +			return ret;
228.2509 +	}
228.2510 +}
228.2511 +
228.2512 +public static class SetExpr implements Expr{
228.2513 +	public final IPersistentVector keys;
228.2514 +	final static Method setMethod = Method.getMethod("clojure.lang.IPersistentSet set(Object[])");
228.2515 +
228.2516 +
228.2517 +	public SetExpr(IPersistentVector keys){
228.2518 +		this.keys = keys;
228.2519 +	}
228.2520 +
228.2521 +	public Object eval() throws Exception{
228.2522 +		Object[] ret = new Object[keys.count()];
228.2523 +		for(int i = 0; i < keys.count(); i++)
228.2524 +			ret[i] = ((Expr) keys.nth(i)).eval();
228.2525 +		return RT.set(ret);
228.2526 +	}
228.2527 +
228.2528 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2529 +		MethodExpr.emitArgsAsArray(keys, objx, gen);
228.2530 +		gen.invokeStatic(RT_TYPE, setMethod);
228.2531 +		if(context == C.STATEMENT)
228.2532 +			gen.pop();
228.2533 +	}
228.2534 +
228.2535 +	public boolean hasJavaClass() throws Exception{
228.2536 +		return true;
228.2537 +	}
228.2538 +
228.2539 +	public Class getJavaClass() throws Exception{
228.2540 +		return IPersistentSet.class;
228.2541 +	}
228.2542 +
228.2543 +
228.2544 +	static public Expr parse(C context, IPersistentSet form) throws Exception{
228.2545 +		IPersistentVector keys = PersistentVector.EMPTY;
228.2546 +		for(ISeq s = RT.seq(form); s != null; s = s.next())
228.2547 +			{
228.2548 +			Object e = s.first();
228.2549 +			keys = (IPersistentVector) keys.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, e));
228.2550 +			}
228.2551 +		Expr ret = new SetExpr(keys);
228.2552 +		if(form instanceof IObj && ((IObj) form).meta() != null)
228.2553 +			return new MetaExpr(ret, (MapExpr) MapExpr
228.2554 +					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta()));
228.2555 +		else
228.2556 +			return ret;
228.2557 +	}
228.2558 +}
228.2559 +
228.2560 +public static class VectorExpr implements Expr{
228.2561 +	public final IPersistentVector args;
228.2562 +	final static Method vectorMethod = Method.getMethod("clojure.lang.IPersistentVector vector(Object[])");
228.2563 +
228.2564 +
228.2565 +	public VectorExpr(IPersistentVector args){
228.2566 +		this.args = args;
228.2567 +	}
228.2568 +
228.2569 +	public Object eval() throws Exception{
228.2570 +		IPersistentVector ret = PersistentVector.EMPTY;
228.2571 +		for(int i = 0; i < args.count(); i++)
228.2572 +			ret = (IPersistentVector) ret.cons(((Expr) args.nth(i)).eval());
228.2573 +		return ret;
228.2574 +	}
228.2575 +
228.2576 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2577 +		MethodExpr.emitArgsAsArray(args, objx, gen);
228.2578 +		gen.invokeStatic(RT_TYPE, vectorMethod);
228.2579 +		if(context == C.STATEMENT)
228.2580 +			gen.pop();
228.2581 +	}
228.2582 +
228.2583 +	public boolean hasJavaClass() throws Exception{
228.2584 +		return true;
228.2585 +	}
228.2586 +
228.2587 +	public Class getJavaClass() throws Exception{
228.2588 +		return IPersistentVector.class;
228.2589 +	}
228.2590 +
228.2591 +	static public Expr parse(C context, IPersistentVector form) throws Exception{
228.2592 +		IPersistentVector args = PersistentVector.EMPTY;
228.2593 +		for(int i = 0; i < form.count(); i++)
228.2594 +			args = (IPersistentVector) args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, form.nth(i)));
228.2595 +		Expr ret = new VectorExpr(args);
228.2596 +		if(form instanceof IObj && ((IObj) form).meta() != null)
228.2597 +			return new MetaExpr(ret, (MapExpr) MapExpr
228.2598 +					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta()));
228.2599 +		else
228.2600 +			return ret;
228.2601 +	}
228.2602 +
228.2603 +}
228.2604 +
228.2605 +static class KeywordInvokeExpr implements Expr{
228.2606 +	public final KeywordExpr kw;
228.2607 +	public final Object tag;
228.2608 +	public final Expr target;
228.2609 +	public final int line;
228.2610 +	public final int siteIndex;
228.2611 +	public final String source;
228.2612 +	static Type ILOOKUP_TYPE = Type.getType(ILookup.class);
228.2613 +
228.2614 +	public KeywordInvokeExpr(String source, int line, Symbol tag, KeywordExpr kw, Expr target){
228.2615 +		this.source = source;
228.2616 +		this.kw = kw;
228.2617 +		this.target = target;
228.2618 +		this.line = line;
228.2619 +		this.tag = tag;
228.2620 +		this.siteIndex = registerKeywordCallsite(kw.k);
228.2621 +	}
228.2622 +
228.2623 +	public Object eval() throws Exception{
228.2624 +		try
228.2625 +			{
228.2626 +			return kw.k.invoke(target.eval());
228.2627 +			}
228.2628 +		catch(Throwable e)
228.2629 +			{
228.2630 +			if(!(e instanceof CompilerException))
228.2631 +				throw new CompilerException(source, line, e);
228.2632 +			else
228.2633 +				throw (CompilerException) e;
228.2634 +			}
228.2635 +	}
228.2636 +
228.2637 +    public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2638 +        Label endLabel = gen.newLabel();
228.2639 +        Label faultLabel = gen.newLabel();
228.2640 +
228.2641 +        gen.visitLineNumber(line, gen.mark());
228.2642 +        gen.getStatic(objx.objtype, objx.thunkNameStatic(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE);
228.2643 +        gen.dup();
228.2644 +        target.emit(C.EXPRESSION, objx, gen);
228.2645 +        gen.dupX2();
228.2646 +        gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE, Method.getMethod("Object get(Object)"));
228.2647 +        gen.dupX2();
228.2648 +        gen.visitJumpInsn(IF_ACMPEQ, faultLabel);
228.2649 +        gen.pop();
228.2650 +        gen.goTo(endLabel);
228.2651 +
228.2652 +        gen.mark(faultLabel);
228.2653 +        gen.swap();
228.2654 +        gen.pop();
228.2655 +        gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE);
228.2656 +        gen.swap();
228.2657 +        gen.loadThis();
228.2658 +        gen.invokeInterface(ObjExpr.ILOOKUP_SITE_TYPE,
228.2659 +                            Method.getMethod("Object fault(Object, clojure.lang.ILookupHost)"));
228.2660 +
228.2661 +        gen.mark(endLabel);
228.2662 +        if(context == C.STATEMENT)
228.2663 +            gen.pop();
228.2664 +    }
228.2665 +
228.2666 +	public void emit2(C context, ObjExpr objx, GeneratorAdapter gen){
228.2667 +		Label endLabel = gen.newLabel();
228.2668 +		Label faultLabel = gen.newLabel();
228.2669 +
228.2670 +		gen.visitLineNumber(line, gen.mark());
228.2671 +		target.emit(C.EXPRESSION, objx, gen);
228.2672 +		gen.dup();
228.2673 +		gen.getStatic(objx.objtype, objx.thunkNameStatic(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE);
228.2674 +		gen.swap();
228.2675 +		gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE);
228.2676 +///		gen.loadThis();
228.2677 +		gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE,
228.2678 +		                    Method.getMethod("Object get(Object,clojure.lang.ILookupSite)"));
228.2679 +//		gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE,
228.2680 +//		                    Method.getMethod("Object get(Object,clojure.lang.ILookupSite,clojure.lang.ILookupHost)"));
228.2681 +		gen.dup();
228.2682 +		gen.getStatic(objx.objtype, objx.siteNameStatic(siteIndex),ObjExpr.KEYWORD_LOOKUPSITE_TYPE);
228.2683 +		gen.visitJumpInsn(IF_ACMPEQ, faultLabel);
228.2684 +		gen.swap();
228.2685 +		gen.pop();
228.2686 +		gen.goTo(endLabel);
228.2687 +
228.2688 +		gen.mark(faultLabel);
228.2689 +		gen.swap();
228.2690 +		gen.loadThis();
228.2691 +		gen.invokeInterface(ObjExpr.ILOOKUP_SITE_TYPE,
228.2692 +		                    Method.getMethod("Object fault(Object, clojure.lang.ILookupHost)"));
228.2693 +				
228.2694 +		gen.mark(endLabel);
228.2695 +		if(context == C.STATEMENT)
228.2696 +			gen.pop();
228.2697 +	}
228.2698 +
228.2699 +	public void emitInstance(C context, ObjExpr objx, GeneratorAdapter gen){
228.2700 +		gen.visitLineNumber(line, gen.mark());
228.2701 +		gen.loadThis();
228.2702 +		gen.getField(objx.objtype, objx.thunkName(siteIndex),ObjExpr.ILOOKUP_THUNK_TYPE);
228.2703 +		target.emit(C.EXPRESSION, objx, gen);
228.2704 +		gen.loadThis();
228.2705 +		gen.getField(objx.objtype, objx.siteName(siteIndex),ObjExpr.ILOOKUP_SITE_TYPE);
228.2706 +		gen.loadThis();
228.2707 +		gen.checkCast(Type.getType(ILookupHost.class));
228.2708 +		gen.invokeInterface(ObjExpr.ILOOKUP_THUNK_TYPE,
228.2709 +		                    Method.getMethod("Object get(Object,clojure.lang.ILookupSite,clojure.lang.ILookupHost)"));
228.2710 +		if(context == C.STATEMENT)
228.2711 +			gen.pop();
228.2712 +	}
228.2713 +
228.2714 +	public void emitNormal(C context, ObjExpr objx, GeneratorAdapter gen){
228.2715 +		Label slowLabel = gen.newLabel();
228.2716 +		Label endLabel = gen.newLabel();
228.2717 +
228.2718 +		gen.visitLineNumber(line, gen.mark());
228.2719 +		target.emit(C.EXPRESSION, objx, gen);
228.2720 +		gen.dup();
228.2721 +		gen.instanceOf(ILOOKUP_TYPE);
228.2722 +		gen.ifZCmp(GeneratorAdapter.EQ, slowLabel);
228.2723 +		kw.emit(C.EXPRESSION, objx, gen);
228.2724 +		gen.invokeInterface(ILOOKUP_TYPE, new Method("valAt", OBJECT_TYPE, ARG_TYPES[1]));
228.2725 +		gen.goTo(endLabel);
228.2726 +
228.2727 +		gen.mark(slowLabel);
228.2728 +		kw.emit(C.EXPRESSION, objx, gen);
228.2729 +		gen.invokeStatic(RT_TYPE, new Method("get", OBJECT_TYPE, ARG_TYPES[2]));
228.2730 +
228.2731 +		gen.mark(endLabel);
228.2732 +
228.2733 +		if(context == C.STATEMENT)
228.2734 +			gen.pop();
228.2735 +	}
228.2736 +
228.2737 +	public boolean hasJavaClass() throws Exception{
228.2738 +		return tag != null;
228.2739 +	}
228.2740 +
228.2741 +	public Class getJavaClass() throws Exception{
228.2742 +		return HostExpr.tagToClass(tag);
228.2743 +	}
228.2744 +
228.2745 +}
228.2746 +//static class KeywordSiteInvokeExpr implements Expr{
228.2747 +//	public final Expr site;
228.2748 +//	public final Object tag;
228.2749 +//	public final Expr target;
228.2750 +//	public final int line;
228.2751 +//	public final String source;
228.2752 +//
228.2753 +//	public KeywordSiteInvokeExpr(String source, int line, Symbol tag, Expr site, Expr target){
228.2754 +//		this.source = source;
228.2755 +//		this.site = site;
228.2756 +//		this.target = target;
228.2757 +//		this.line = line;
228.2758 +//		this.tag = tag;
228.2759 +//	}
228.2760 +//
228.2761 +//	public Object eval() throws Exception{
228.2762 +//		try
228.2763 +//			{
228.2764 +//			KeywordCallSite s = (KeywordCallSite) site.eval();
228.2765 +//			return s.thunk.invoke(s,target.eval());
228.2766 +//			}
228.2767 +//		catch(Throwable e)
228.2768 +//			{
228.2769 +//			if(!(e instanceof CompilerException))
228.2770 +//				throw new CompilerException(source, line, e);
228.2771 +//			else
228.2772 +//				throw (CompilerException) e;
228.2773 +//			}
228.2774 +//	}
228.2775 +//
228.2776 +//	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2777 +//		gen.visitLineNumber(line, gen.mark());
228.2778 +//		site.emit(C.EXPRESSION, objx, gen);
228.2779 +//		gen.dup();
228.2780 +//		gen.getField(Type.getType(KeywordCallSite.class),"thunk",IFN_TYPE);
228.2781 +//		gen.swap();
228.2782 +//		target.emit(C.EXPRESSION, objx, gen);
228.2783 +//
228.2784 +//		gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[2]));
228.2785 +//		if(context == C.STATEMENT)
228.2786 +//			gen.pop();
228.2787 +//	}
228.2788 +//
228.2789 +//	public boolean hasJavaClass() throws Exception{
228.2790 +//		return tag != null;
228.2791 +//	}
228.2792 +//
228.2793 +//	public Class getJavaClass() throws Exception{
228.2794 +//		return HostExpr.tagToClass(tag);
228.2795 +//	}
228.2796 +//
228.2797 +//}
228.2798 +
228.2799 +public static class InstanceOfExpr implements Expr, MaybePrimitiveExpr{
228.2800 +	Expr expr;
228.2801 +	Class c;
228.2802 +
228.2803 +	public InstanceOfExpr(Class c, Expr expr){
228.2804 +		this.expr = expr;
228.2805 +		this.c = c;
228.2806 +	}
228.2807 +
228.2808 +	public Object eval() throws Exception{
228.2809 +		if(c.isInstance(expr.eval()))
228.2810 +			return RT.T;
228.2811 +		return RT.F;
228.2812 +	}
228.2813 +
228.2814 +	public boolean canEmitPrimitive(){
228.2815 +		return true;
228.2816 +	}
228.2817 +
228.2818 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.2819 +		expr.emit(C.EXPRESSION,objx,gen);
228.2820 +		gen.instanceOf(Type.getType(c));
228.2821 +	}
228.2822 +
228.2823 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2824 +		emitUnboxed(context,objx,gen);
228.2825 +		HostExpr.emitBoxReturn(objx,gen,Boolean.TYPE);
228.2826 +		if(context == C.STATEMENT)
228.2827 +			gen.pop();
228.2828 +	}
228.2829 +
228.2830 +	public boolean hasJavaClass() throws Exception{
228.2831 +		return true;
228.2832 +	}
228.2833 +
228.2834 +	public Class getJavaClass() throws Exception{
228.2835 +		return Boolean.TYPE;
228.2836 +	}
228.2837 +
228.2838 +}
228.2839 +
228.2840 +static class InvokeExpr implements Expr{
228.2841 +	public final Expr fexpr;
228.2842 +	public final Object tag;
228.2843 +	public final IPersistentVector args;
228.2844 +	public final int line;
228.2845 +	public final String source;
228.2846 +	public boolean isProtocol = false;
228.2847 +	public boolean isDirect = false;
228.2848 +	public int siteIndex = -1;
228.2849 +	public Class protocolOn;
228.2850 +	public java.lang.reflect.Method onMethod;
228.2851 +	static Keyword onKey = Keyword.intern("on");
228.2852 +	static Keyword methodMapKey = Keyword.intern("method-map");
228.2853 +	static Keyword dynamicKey = Keyword.intern("dynamic");
228.2854 +
228.2855 +	public InvokeExpr(String source, int line, Symbol tag, Expr fexpr, IPersistentVector args) throws Exception{
228.2856 +		this.source = source;
228.2857 +		this.fexpr = fexpr;
228.2858 +		this.args = args;
228.2859 +		this.line = line;
228.2860 +		if(fexpr instanceof VarExpr)
228.2861 +			{
228.2862 +			Var fvar = ((VarExpr)fexpr).var;
228.2863 +			Var pvar =  (Var)RT.get(fvar.meta(), protocolKey);
228.2864 +			if(pvar != null && PROTOCOL_CALLSITES.isBound())
228.2865 +				{
228.2866 +				this.isProtocol = true;
228.2867 +				this.siteIndex = registerProtocolCallsite(((VarExpr)fexpr).var);
228.2868 +				Object pon = RT.get(pvar.get(), onKey);
228.2869 +				this.protocolOn = HostExpr.maybeClass(pon,false);
228.2870 +				if(this.protocolOn != null)
228.2871 +					{
228.2872 +					IPersistentMap mmap = (IPersistentMap) RT.get(pvar.get(), methodMapKey);
228.2873 +                    Keyword mmapVal = (Keyword) mmap.valAt(Keyword.intern(fvar.sym));
228.2874 +                    if (mmapVal == null) {
228.2875 +                        throw new IllegalArgumentException(
228.2876 +                              "No method of interface: " + protocolOn.getName() +
228.2877 +                              " found for function: " + fvar.sym + " of protocol: " + pvar.sym +
228.2878 +                              " (The protocol method may have been defined before and removed.)");
228.2879 +                    }
228.2880 +                    String mname = munge(mmapVal.sym.toString());
228.2881 + 					List methods = Reflector.getMethods(protocolOn, args.count() - 1, mname, false);
228.2882 +					if(methods.size() != 1)
228.2883 +						throw new IllegalArgumentException(
228.2884 +								"No single method: " + mname + " of interface: " + protocolOn.getName() +
228.2885 +								" found for function: " + fvar.sym + " of protocol: " + pvar.sym);
228.2886 +					this.onMethod = (java.lang.reflect.Method) methods.get(0);
228.2887 +					}
228.2888 +				}
228.2889 +//			else if(pvar == null && VAR_CALLSITES.isBound()
228.2890 +//			        && fvar.ns.name.name.startsWith("clojure")
228.2891 +//					&& !RT.booleanCast(RT.get(RT.meta(fvar),dynamicKey))
228.2892 +//					)
228.2893 +//				{
228.2894 +//				//todo - more specific criteria for binding these
228.2895 +//				this.isDirect = true;
228.2896 +//				this.siteIndex = registerVarCallsite(((VarExpr) fexpr).var);
228.2897 +//				}
228.2898 +			}
228.2899 +		this.tag = tag != null ? tag : (fexpr instanceof VarExpr ? ((VarExpr) fexpr).tag : null);
228.2900 +	}
228.2901 +
228.2902 +	public Object eval() throws Exception{
228.2903 +		try
228.2904 +			{
228.2905 +			IFn fn = (IFn) fexpr.eval();
228.2906 +			PersistentVector argvs = PersistentVector.EMPTY;
228.2907 +			for(int i = 0; i < args.count(); i++)
228.2908 +				argvs = argvs.cons(((Expr) args.nth(i)).eval());
228.2909 +			return fn.applyTo(RT.seq(argvs));
228.2910 +			}
228.2911 +		catch(Throwable e)
228.2912 +			{
228.2913 +			if(!(e instanceof CompilerException))
228.2914 +				throw new CompilerException(source, line, e);
228.2915 +			else
228.2916 +				throw (CompilerException) e;
228.2917 +			}
228.2918 +	}
228.2919 +
228.2920 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.2921 +		gen.visitLineNumber(line, gen.mark());
228.2922 +		if(isProtocol)
228.2923 +			{
228.2924 +			emitProto(context,objx,gen);
228.2925 +			}
228.2926 +		else if(isDirect)
228.2927 +			{
228.2928 +			Label callLabel = gen.newLabel();
228.2929 +
228.2930 +			gen.getStatic(objx.objtype, objx.varCallsiteName(siteIndex), IFN_TYPE);
228.2931 +			gen.dup();
228.2932 +			gen.ifNonNull(callLabel);
228.2933 +
228.2934 +			gen.pop();
228.2935 +			fexpr.emit(C.EXPRESSION, objx, gen);
228.2936 +			gen.checkCast(IFN_TYPE);
228.2937 +//			gen.dup();
228.2938 +//			gen.putStatic(objx.objtype, objx.varCallsiteName(siteIndex), IFN_TYPE);
228.2939 +
228.2940 +			gen.mark(callLabel);
228.2941 +			emitArgsAndCall(0, context,objx,gen);
228.2942 +			}
228.2943 +		else
228.2944 +			{
228.2945 +			fexpr.emit(C.EXPRESSION, objx, gen);
228.2946 +			gen.checkCast(IFN_TYPE);
228.2947 +			emitArgsAndCall(0, context,objx,gen);
228.2948 +			}
228.2949 +		if(context == C.STATEMENT)
228.2950 +			gen.pop();		
228.2951 +	}
228.2952 +
228.2953 +	public void emitProto(C context, ObjExpr objx, GeneratorAdapter gen){
228.2954 +		Label onLabel = gen.newLabel();
228.2955 +		Label callLabel = gen.newLabel();
228.2956 +		Label endLabel = gen.newLabel();
228.2957 +
228.2958 +		Var v = ((VarExpr)fexpr).var;
228.2959 +
228.2960 +		Expr e = (Expr) args.nth(0);
228.2961 +		e.emit(C.EXPRESSION, objx, gen);
228.2962 +		gen.dup(); //target, target
228.2963 +		gen.invokeStatic(UTIL_TYPE,Method.getMethod("Class classOf(Object)")); //target,class
228.2964 +		gen.loadThis();
228.2965 +		gen.getField(objx.objtype, objx.cachedClassName(siteIndex),CLASS_TYPE); //target,class,cached-class
228.2966 +		gen.visitJumpInsn(IF_ACMPEQ, callLabel); //target
228.2967 +		if(protocolOn != null)
228.2968 +			{
228.2969 +			gen.dup(); //target, target			
228.2970 +			gen.instanceOf(Type.getType(protocolOn));
228.2971 +			gen.ifZCmp(GeneratorAdapter.NE, onLabel);
228.2972 +			}
228.2973 +
228.2974 +		gen.mark(callLabel); //target
228.2975 +		gen.dup(); //target, target
228.2976 +		gen.invokeStatic(UTIL_TYPE,Method.getMethod("Class classOf(Object)")); //target,class
228.2977 +		gen.loadThis();
228.2978 +		gen.swap();
228.2979 +		gen.putField(objx.objtype, objx.cachedClassName(siteIndex),CLASS_TYPE); //target
228.2980 +		objx.emitVar(gen, v);
228.2981 +		gen.invokeVirtual(VAR_TYPE, Method.getMethod("Object getRawRoot()")); //target, proto-fn
228.2982 +		gen.swap();
228.2983 +		emitArgsAndCall(1, context,objx,gen);
228.2984 +		gen.goTo(endLabel);
228.2985 +
228.2986 +		gen.mark(onLabel); //target
228.2987 +		if(protocolOn != null)
228.2988 +			{
228.2989 +			MethodExpr.emitTypedArgs(objx, gen, onMethod.getParameterTypes(), RT.subvec(args,1,args.count()));
228.2990 +			if(context == C.RETURN)
228.2991 +				{
228.2992 +				ObjMethod method = (ObjMethod) METHOD.deref();
228.2993 +				method.emitClearLocals(gen);
228.2994 +				}
228.2995 +			Method m = new Method(onMethod.getName(), Type.getReturnType(onMethod), Type.getArgumentTypes(onMethod));
228.2996 +			gen.invokeInterface(Type.getType(protocolOn), m);
228.2997 +			HostExpr.emitBoxReturn(objx, gen, onMethod.getReturnType());
228.2998 +			}
228.2999 +		gen.mark(endLabel);
228.3000 +	}
228.3001 +
228.3002 +	void emitArgsAndCall(int firstArgToEmit, C context, ObjExpr objx, GeneratorAdapter gen){
228.3003 +		for(int i = firstArgToEmit; i < Math.min(MAX_POSITIONAL_ARITY, args.count()); i++)
228.3004 +			{
228.3005 +			Expr e = (Expr) args.nth(i);
228.3006 +			e.emit(C.EXPRESSION, objx, gen);
228.3007 +			}
228.3008 +		if(args.count() > MAX_POSITIONAL_ARITY)
228.3009 +			{
228.3010 +			PersistentVector restArgs = PersistentVector.EMPTY;
228.3011 +			for(int i = MAX_POSITIONAL_ARITY; i < args.count(); i++)
228.3012 +				{
228.3013 +				restArgs = restArgs.cons(args.nth(i));
228.3014 +				}
228.3015 +			MethodExpr.emitArgsAsArray(restArgs, objx, gen);
228.3016 +			}
228.3017 +
228.3018 +		if(context == C.RETURN)
228.3019 +			{
228.3020 +			ObjMethod method = (ObjMethod) METHOD.deref();
228.3021 +			method.emitClearLocals(gen);
228.3022 +			}
228.3023 +
228.3024 +		gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[Math.min(MAX_POSITIONAL_ARITY + 1,
228.3025 +		                                                                                   args.count())]));
228.3026 +	}
228.3027 +
228.3028 +	public boolean hasJavaClass() throws Exception{
228.3029 +		return tag != null;
228.3030 +	}
228.3031 +
228.3032 +	public Class getJavaClass() throws Exception{
228.3033 +		return HostExpr.tagToClass(tag);
228.3034 +	}
228.3035 +
228.3036 +	static public Expr parse(C context, ISeq form) throws Exception{
228.3037 +		if(context != C.EVAL)
228.3038 +			context = C.EXPRESSION;
228.3039 +		Expr fexpr = analyze(context, form.first());
228.3040 +		if(fexpr instanceof VarExpr && ((VarExpr)fexpr).var.equals(INSTANCE))
228.3041 +			{
228.3042 +			if(RT.second(form) instanceof Symbol)
228.3043 +				{
228.3044 +				Class c = HostExpr.maybeClass(RT.second(form),false);
228.3045 +				if(c != null)
228.3046 +					return new InstanceOfExpr(c, analyze(context, RT.third(form)));
228.3047 +				}
228.3048 +			}
228.3049 +
228.3050 +		if(fexpr instanceof KeywordExpr && RT.count(form) == 2 && KEYWORD_CALLSITES.isBound())
228.3051 +			{
228.3052 +//			fexpr = new ConstantExpr(new KeywordCallSite(((KeywordExpr)fexpr).k));
228.3053 +			Expr target = analyze(context, RT.second(form));
228.3054 +			return new KeywordInvokeExpr((String) SOURCE.deref(), (Integer) LINE.deref(), tagOf(form),
228.3055 +			                             (KeywordExpr) fexpr, target);
228.3056 +			}
228.3057 +		PersistentVector args = PersistentVector.EMPTY;
228.3058 +		for(ISeq s = RT.seq(form.next()); s != null; s = s.next())
228.3059 +			{
228.3060 +			args = args.cons(analyze(context, s.first()));
228.3061 +			}
228.3062 +//		if(args.count() > MAX_POSITIONAL_ARITY)
228.3063 +//			throw new IllegalArgumentException(
228.3064 +//					String.format("No more than %d args supported", MAX_POSITIONAL_ARITY));
228.3065 +
228.3066 +		return new InvokeExpr((String) SOURCE.deref(), (Integer) LINE.deref(), tagOf(form), fexpr, args);
228.3067 +	}
228.3068 +}
228.3069 +
228.3070 +static class SourceDebugExtensionAttribute extends Attribute{
228.3071 +	public SourceDebugExtensionAttribute(){
228.3072 +		super("SourceDebugExtension");
228.3073 +	}
228.3074 +
228.3075 +	void writeSMAP(ClassWriter cw, String smap){
228.3076 +		ByteVector bv = write(cw, null, -1, -1, -1);
228.3077 +		bv.putUTF8(smap);
228.3078 +	}
228.3079 +}
228.3080 +
228.3081 +static public class FnExpr extends ObjExpr{
228.3082 +	final static Type aFnType = Type.getType(AFunction.class);
228.3083 +	final static Type restFnType = Type.getType(RestFn.class);
228.3084 +	//if there is a variadic overload (there can only be one) it is stored here
228.3085 +	FnMethod variadicMethod = null;
228.3086 +	IPersistentCollection methods;
228.3087 +	//	String superName = null;
228.3088 +
228.3089 +	public FnExpr(Object tag){
228.3090 +		super(tag);
228.3091 +	}
228.3092 +
228.3093 +	public boolean hasJavaClass() throws Exception{
228.3094 +		return true;
228.3095 +	}
228.3096 +
228.3097 +	public Class getJavaClass() throws Exception{
228.3098 +		return AFunction.class;
228.3099 +	}
228.3100 +
228.3101 +	protected void emitMethods(ClassVisitor cv){
228.3102 +		//override of invoke/doInvoke for each method
228.3103 +		for(ISeq s = RT.seq(methods); s != null; s = s.next())
228.3104 +			{
228.3105 +			ObjMethod method = (ObjMethod) s.first();
228.3106 +			method.emit(this, cv);
228.3107 +			}
228.3108 +
228.3109 +		if(isVariadic())
228.3110 +			{
228.3111 +			GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC,
228.3112 +			                                            Method.getMethod("int getRequiredArity()"),
228.3113 +			                                            null,
228.3114 +			                                            null,
228.3115 +			                                            cv);
228.3116 +			gen.visitCode();
228.3117 +			gen.push(variadicMethod.reqParms.count());
228.3118 +			gen.returnValue();
228.3119 +			gen.endMethod();
228.3120 +			}
228.3121 +	}
228.3122 +
228.3123 +	static Expr parse(C context, ISeq form, String name) throws Exception{
228.3124 +		ISeq origForm = form;
228.3125 +		FnExpr fn = new FnExpr(tagOf(form));
228.3126 +		fn.src = form;
228.3127 +		ObjMethod enclosingMethod = (ObjMethod) METHOD.deref();
228.3128 +		if(((IMeta) form.first()).meta() != null)
228.3129 +			{
228.3130 +			fn.onceOnly = RT.booleanCast(RT.get(RT.meta(form.first()), Keyword.intern(null, "once")));
228.3131 +//			fn.superName = (String) RT.get(RT.meta(form.first()), Keyword.intern(null, "super-name"));
228.3132 +			}
228.3133 +		//fn.thisName = name;
228.3134 +		String basename = enclosingMethod != null ?
228.3135 +		                  (enclosingMethod.objx.name + "$")
228.3136 +		                                          : //"clojure.fns." +
228.3137 +		                  (munge(currentNS().name.name) + "$");
228.3138 +		if(RT.second(form) instanceof Symbol)
228.3139 +			name = ((Symbol) RT.second(form)).name;
228.3140 +		String simpleName = name != null ?
228.3141 +		                    (munge(name).replace(".", "_DOT_")
228.3142 +		                    + (enclosingMethod != null ? "__" + RT.nextID() : ""))
228.3143 +		                    : ("fn"
228.3144 +		                      + "__" + RT.nextID());
228.3145 +		fn.name = basename + simpleName;
228.3146 +		fn.internalName = fn.name.replace('.', '/');
228.3147 +		fn.objtype = Type.getObjectType(fn.internalName);
228.3148 +		try
228.3149 +			{
228.3150 +			Var.pushThreadBindings(
228.3151 +					RT.map(CONSTANTS, PersistentVector.EMPTY,
228.3152 +					       CONSTANT_IDS, new IdentityHashMap(),
228.3153 +					       KEYWORDS, PersistentHashMap.EMPTY,
228.3154 +					       VARS, PersistentHashMap.EMPTY,
228.3155 +					       KEYWORD_CALLSITES, PersistentVector.EMPTY,
228.3156 +					       PROTOCOL_CALLSITES, PersistentVector.EMPTY,
228.3157 +					       VAR_CALLSITES, PersistentVector.EMPTY
228.3158 +					));
228.3159 +
228.3160 +			//arglist might be preceded by symbol naming this fn
228.3161 +			if(RT.second(form) instanceof Symbol)
228.3162 +				{
228.3163 +				fn.thisName = ((Symbol) RT.second(form)).name;
228.3164 +				form = RT.cons(FN, RT.next(RT.next(form)));
228.3165 +				}
228.3166 +
228.3167 +			//now (fn [args] body...) or (fn ([args] body...) ([args2] body2...) ...)
228.3168 +			//turn former into latter
228.3169 +			if(RT.second(form) instanceof IPersistentVector)
228.3170 +				form = RT.list(FN, RT.next(form));
228.3171 +			fn.line = (Integer) LINE.deref();
228.3172 +			FnMethod[] methodArray = new FnMethod[MAX_POSITIONAL_ARITY + 1];
228.3173 +			FnMethod variadicMethod = null;
228.3174 +			for(ISeq s = RT.next(form); s != null; s = RT.next(s))
228.3175 +				{
228.3176 +				FnMethod f = FnMethod.parse(fn, (ISeq) RT.first(s));
228.3177 +				if(f.isVariadic())
228.3178 +					{
228.3179 +					if(variadicMethod == null)
228.3180 +						variadicMethod = f;
228.3181 +					else
228.3182 +						throw new Exception("Can't have more than 1 variadic overload");
228.3183 +					}
228.3184 +				else if(methodArray[f.reqParms.count()] == null)
228.3185 +					methodArray[f.reqParms.count()] = f;
228.3186 +				else
228.3187 +					throw new Exception("Can't have 2 overloads with same arity");
228.3188 +				}
228.3189 +			if(variadicMethod != null)
228.3190 +				{
228.3191 +				for(int i = variadicMethod.reqParms.count() + 1; i <= MAX_POSITIONAL_ARITY; i++)
228.3192 +					if(methodArray[i] != null)
228.3193 +						throw new Exception(
228.3194 +								"Can't have fixed arity function with more params than variadic function");
228.3195 +				}
228.3196 +
228.3197 +			IPersistentCollection methods = null;
228.3198 +			for(int i = 0; i < methodArray.length; i++)
228.3199 +				if(methodArray[i] != null)
228.3200 +					methods = RT.conj(methods, methodArray[i]);
228.3201 +			if(variadicMethod != null)
228.3202 +				methods = RT.conj(methods, variadicMethod);
228.3203 +
228.3204 +			fn.methods = methods;
228.3205 +			fn.variadicMethod = variadicMethod;
228.3206 +			fn.keywords = (IPersistentMap) KEYWORDS.deref();
228.3207 +			fn.vars = (IPersistentMap) VARS.deref();
228.3208 +			fn.constants = (PersistentVector) CONSTANTS.deref();
228.3209 +			fn.keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref();
228.3210 +			fn.protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref();
228.3211 +			fn.varCallsites = (IPersistentVector) VAR_CALLSITES.deref();
228.3212 +
228.3213 +			fn.constantsID = RT.nextID();
228.3214 +//			DynamicClassLoader loader = (DynamicClassLoader) LOADER.get();
228.3215 +//			loader.registerConstants(fn.constantsID, fn.constants.toArray());
228.3216 +			}
228.3217 +		finally
228.3218 +			{
228.3219 +			Var.popThreadBindings();
228.3220 +			}
228.3221 +		fn.compile(fn.isVariadic() ? "clojure/lang/RestFn" : "clojure/lang/AFunction",null,fn.onceOnly);
228.3222 +		fn.getCompiledClass();
228.3223 +
228.3224 +		if(origForm instanceof IObj && ((IObj) origForm).meta() != null)
228.3225 +			return new MetaExpr(fn, (MapExpr) MapExpr
228.3226 +					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) origForm).meta()));
228.3227 +		else
228.3228 +			return fn;
228.3229 +	}
228.3230 +
228.3231 +	public final ObjMethod variadicMethod(){
228.3232 +		return variadicMethod;
228.3233 +	}
228.3234 +
228.3235 +	boolean isVariadic(){
228.3236 +		return variadicMethod != null;
228.3237 +	}
228.3238 +
228.3239 +	public final IPersistentCollection methods(){
228.3240 +		return methods;
228.3241 +	}
228.3242 +}
228.3243 +
228.3244 +static public class ObjExpr implements Expr{
228.3245 +	static final String CONST_PREFIX = "const__";
228.3246 +	String name;
228.3247 +	//String simpleName;
228.3248 +	String internalName;
228.3249 +	String thisName;
228.3250 +	Type objtype;
228.3251 +	public final Object tag;
228.3252 +	//localbinding->itself
228.3253 +	IPersistentMap closes = PersistentHashMap.EMPTY;
228.3254 +    //localbndingexprs
228.3255 +    IPersistentVector closesExprs = PersistentVector.EMPTY;
228.3256 +	//symbols
228.3257 +	IPersistentSet volatiles = PersistentHashSet.EMPTY;
228.3258 +
228.3259 +	//symbol->lb
228.3260 +	IPersistentMap fields = null;
228.3261 +
228.3262 +	//Keyword->KeywordExpr
228.3263 +	IPersistentMap keywords = PersistentHashMap.EMPTY;
228.3264 +	IPersistentMap vars = PersistentHashMap.EMPTY;
228.3265 +	Class compiledClass;
228.3266 +	int line;
228.3267 +	PersistentVector constants;
228.3268 +	int constantsID;
228.3269 +	int altCtorDrops = 0;
228.3270 +
228.3271 +	IPersistentVector keywordCallsites;
228.3272 +	IPersistentVector protocolCallsites;
228.3273 +	IPersistentVector varCallsites;
228.3274 +	boolean onceOnly = false;
228.3275 +
228.3276 +	Object src;
228.3277 +
228.3278 +	final static Method voidctor = Method.getMethod("void <init>()");
228.3279 +	protected IPersistentMap classMeta;
228.3280 +
228.3281 +	public final String name(){
228.3282 +		return name;
228.3283 +	}
228.3284 +
228.3285 +//	public final String simpleName(){
228.3286 +//		return simpleName;
228.3287 +//	}
228.3288 +
228.3289 +	public final String internalName(){
228.3290 +		return internalName;
228.3291 +	}
228.3292 +
228.3293 +	public final String thisName(){
228.3294 +		return thisName;
228.3295 +	}
228.3296 +
228.3297 +	public final Type objtype(){
228.3298 +		return objtype;
228.3299 +	}
228.3300 +
228.3301 +	public final IPersistentMap closes(){
228.3302 +		return closes;
228.3303 +	}
228.3304 +
228.3305 +	public final IPersistentMap keywords(){
228.3306 +		return keywords;
228.3307 +	}
228.3308 +
228.3309 +	public final IPersistentMap vars(){
228.3310 +		return vars;
228.3311 +	}
228.3312 +
228.3313 +	public final Class compiledClass(){
228.3314 +		return compiledClass;
228.3315 +	}
228.3316 +
228.3317 +	public final int line(){
228.3318 +		return line;
228.3319 +	}
228.3320 +
228.3321 +	public final PersistentVector constants(){
228.3322 +		return constants;
228.3323 +	}
228.3324 +
228.3325 +	public final int constantsID(){
228.3326 +		return constantsID;
228.3327 +	}
228.3328 +
228.3329 +	final static Method kwintern = Method.getMethod("clojure.lang.Keyword intern(String, String)");
228.3330 +	final static Method symcreate = Method.getMethod("clojure.lang.Symbol create(String)");
228.3331 +	final static Method varintern =
228.3332 +			Method.getMethod("clojure.lang.Var intern(clojure.lang.Symbol, clojure.lang.Symbol)");
228.3333 +
228.3334 +	final static Type DYNAMIC_CLASSLOADER_TYPE = Type.getType(DynamicClassLoader.class);
228.3335 +	final static Method getClassMethod = Method.getMethod("Class getClass()");
228.3336 +	final static Method getClassLoaderMethod = Method.getMethod("ClassLoader getClassLoader()");
228.3337 +	final static Method getConstantsMethod = Method.getMethod("Object[] getConstants(int)");
228.3338 +	final static Method readStringMethod = Method.getMethod("Object readString(String)");
228.3339 +
228.3340 +	final static Type ILOOKUP_SITE_TYPE = Type.getType(ILookupSite.class);
228.3341 +	final static Type ILOOKUP_THUNK_TYPE = Type.getType(ILookupThunk.class);
228.3342 +	final static Type KEYWORD_LOOKUPSITE_TYPE = Type.getType(KeywordLookupSite.class);
228.3343 +
228.3344 +	private DynamicClassLoader loader;
228.3345 +	private byte[] bytecode;
228.3346 +
228.3347 +	public ObjExpr(Object tag){
228.3348 +		this.tag = tag;
228.3349 +	}
228.3350 +
228.3351 +	static String trimGenID(String name){
228.3352 +		int i = name.lastIndexOf("__");
228.3353 +		return i==-1?name:name.substring(0,i);
228.3354 +	}
228.3355 +	
228.3356 +
228.3357 +
228.3358 +	Type[] ctorTypes(){
228.3359 +		IPersistentVector tv = isDeftype()?PersistentVector.EMPTY:RT.vector(IPERSISTENTMAP_TYPE);
228.3360 +		for(ISeq s = RT.keys(closes); s != null; s = s.next())
228.3361 +			{
228.3362 +			LocalBinding lb = (LocalBinding) s.first();
228.3363 +			if(lb.getPrimitiveType() != null)
228.3364 +				tv = tv.cons(Type.getType(lb.getPrimitiveType()));
228.3365 +			else
228.3366 +				tv = tv.cons(OBJECT_TYPE);
228.3367 +			}
228.3368 +		Type[] ret = new Type[tv.count()];
228.3369 +		for(int i = 0; i < tv.count(); i++)
228.3370 +			ret[i] = (Type) tv.nth(i);
228.3371 +		return ret;
228.3372 +	}
228.3373 +
228.3374 +	void compile(String superName, String[] interfaceNames, boolean oneTimeUse) throws Exception{
228.3375 +		//create bytecode for a class
228.3376 +		//with name current_ns.defname[$letname]+
228.3377 +		//anonymous fns get names fn__id
228.3378 +		//derived from AFn/RestFn
228.3379 +		if(keywordCallsites.count() > 0)
228.3380 +			{
228.3381 +			if(interfaceNames == null)
228.3382 +				interfaceNames = new String[]{"clojure/lang/ILookupHost"};
228.3383 +			else
228.3384 +				{
228.3385 +				String[] inames = new String[interfaceNames.length + 1];
228.3386 +				System.arraycopy(interfaceNames,0,inames,0,interfaceNames.length);
228.3387 +				inames[interfaceNames.length] =  "clojure/lang/ILookupHost";
228.3388 +				interfaceNames = inames;
228.3389 +				}
228.3390 +			}
228.3391 +		ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS);
228.3392 +//		ClassWriter cw = new ClassWriter(0);
228.3393 +		ClassVisitor cv = cw;
228.3394 +//		ClassVisitor cv = new TraceClassVisitor(new CheckClassAdapter(cw), new PrintWriter(System.out));
228.3395 +		//ClassVisitor cv = new TraceClassVisitor(cw, new PrintWriter(System.out));
228.3396 +		cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER + ACC_FINAL, internalName, null,superName,interfaceNames);
228.3397 +//		         superName != null ? superName :
228.3398 +//		         (isVariadic() ? "clojure/lang/RestFn" : "clojure/lang/AFunction"), null);
228.3399 +		String source = (String) SOURCE.deref();
228.3400 +		int lineBefore = (Integer) LINE_BEFORE.deref();
228.3401 +		int lineAfter = (Integer) LINE_AFTER.deref() + 1;
228.3402 +
228.3403 +		if(source != null && SOURCE_PATH.deref() != null)
228.3404 +			{
228.3405 +			//cv.visitSource(source, null);
228.3406 +			String smap = "SMAP\n" +
228.3407 +			              ((source.lastIndexOf('.') > 0) ?
228.3408 +			               source.substring(0, source.lastIndexOf('.'))
228.3409 +			                :source)
228.3410 +			                       //                      : simpleName)
228.3411 +			              + ".java\n" +
228.3412 +			              "Clojure\n" +
228.3413 +			              "*S Clojure\n" +
228.3414 +			              "*F\n" +
228.3415 +			              "+ 1 " + source + "\n" +
228.3416 +			              (String) SOURCE_PATH.deref() + "\n" +
228.3417 +			              "*L\n" +
228.3418 +			              String.format("%d#1,%d:%d\n", lineBefore, lineAfter - lineBefore, lineBefore) +
228.3419 +			              "*E";
228.3420 +			cv.visitSource(source, smap);
228.3421 +			}
228.3422 +		addAnnotation(cv, classMeta);
228.3423 +		//static fields for constants
228.3424 +		for(int i = 0; i < constants.count(); i++)
228.3425 +			{
228.3426 +			cv.visitField(ACC_PUBLIC + ACC_FINAL
228.3427 +			              + ACC_STATIC, constantName(i), constantType(i).getDescriptor(),
228.3428 +			              null, null);
228.3429 +			}
228.3430 +
228.3431 +		//static fields for lookup sites
228.3432 +		for(int i = 0; i < keywordCallsites.count(); i++)
228.3433 +			{
228.3434 +			cv.visitField(ACC_FINAL
228.3435 +			              + ACC_STATIC, siteNameStatic(i), KEYWORD_LOOKUPSITE_TYPE.getDescriptor(),
228.3436 +			              null, null);
228.3437 +			cv.visitField(ACC_STATIC, thunkNameStatic(i), ILOOKUP_THUNK_TYPE.getDescriptor(),
228.3438 +			              null, null);
228.3439 +			}
228.3440 +
228.3441 +		for(int i=0;i<varCallsites.count();i++)
228.3442 +			{
228.3443 +			cv.visitField(ACC_PRIVATE + ACC_STATIC + ACC_FINAL
228.3444 +					, varCallsiteName(i), IFN_TYPE.getDescriptor(), null, null);
228.3445 +			}
228.3446 +
228.3447 +		//static init for constants, keywords and vars
228.3448 +		GeneratorAdapter clinitgen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
228.3449 +		                                                  Method.getMethod("void <clinit> ()"),
228.3450 +		                                                  null,
228.3451 +		                                                  null,
228.3452 +		                                                  cv);
228.3453 +		clinitgen.visitCode();
228.3454 +		clinitgen.visitLineNumber(line, clinitgen.mark());
228.3455 +
228.3456 +		if(constants.count() > 0)
228.3457 +			{
228.3458 +			emitConstants(clinitgen);
228.3459 +			}
228.3460 +
228.3461 +		if(keywordCallsites.count() > 0)
228.3462 +			emitKeywordCallsites(clinitgen);
228.3463 +
228.3464 +		for(int i=0;i<varCallsites.count();i++)
228.3465 +			{
228.3466 +			Label skipLabel = clinitgen.newLabel();
228.3467 +			Label endLabel = clinitgen.newLabel();
228.3468 +			Var var = (Var) varCallsites.nth(i);
228.3469 +			clinitgen.push(var.ns.name.toString());
228.3470 +			clinitgen.push(var.sym.toString());
228.3471 +			clinitgen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
228.3472 +			clinitgen.dup();
228.3473 +			clinitgen.invokeVirtual(VAR_TYPE,Method.getMethod("boolean hasRoot()"));
228.3474 +			clinitgen.ifZCmp(GeneratorAdapter.EQ,skipLabel);
228.3475 +
228.3476 +			clinitgen.invokeVirtual(VAR_TYPE,Method.getMethod("Object getRoot()"));
228.3477 +            clinitgen.dup();
228.3478 +            clinitgen.instanceOf(AFUNCTION_TYPE);
228.3479 +            clinitgen.ifZCmp(GeneratorAdapter.EQ,skipLabel);
228.3480 +			clinitgen.checkCast(IFN_TYPE);
228.3481 +			clinitgen.putStatic(objtype, varCallsiteName(i), IFN_TYPE);
228.3482 +			clinitgen.goTo(endLabel);
228.3483 +
228.3484 +			clinitgen.mark(skipLabel);
228.3485 +			clinitgen.pop();
228.3486 +
228.3487 +			clinitgen.mark(endLabel);
228.3488 +			}
228.3489 +
228.3490 +		clinitgen.returnValue();
228.3491 +
228.3492 +		clinitgen.endMethod();
228.3493 +		if(!isDeftype())
228.3494 +			{
228.3495 +			cv.visitField(ACC_FINAL, "__meta", IPERSISTENTMAP_TYPE.getDescriptor(), null, null);
228.3496 +			}
228.3497 +		//instance fields for closed-overs
228.3498 +		for(ISeq s = RT.keys(closes); s != null; s = s.next())
228.3499 +			{
228.3500 +			LocalBinding lb = (LocalBinding) s.first();
228.3501 +			if(isDeftype())
228.3502 +				{
228.3503 +				int access = isVolatile(lb) ? ACC_VOLATILE :
228.3504 +				             isMutable(lb) ? 0 :
228.3505 +				             (ACC_PUBLIC + ACC_FINAL);
228.3506 +				FieldVisitor fv;
228.3507 +				if(lb.getPrimitiveType() != null)
228.3508 +					fv = cv.visitField(access
228.3509 +							, lb.name, Type.getType(lb.getPrimitiveType()).getDescriptor(),
228.3510 +								  null, null);
228.3511 +				else
228.3512 +				//todo - when closed-overs are fields, use more specific types here and in ctor and emitLocal?
228.3513 +					fv = cv.visitField(access
228.3514 +							, lb.name, OBJECT_TYPE.getDescriptor(), null, null);
228.3515 +				addAnnotation(fv, RT.meta(lb.sym));
228.3516 +				}
228.3517 +			else
228.3518 +				{
228.3519 +				//todo - only enable this non-private+writability for letfns where we need it
228.3520 +				if(lb.getPrimitiveType() != null)
228.3521 +					cv.visitField(0 + (isVolatile(lb) ? ACC_VOLATILE : 0)
228.3522 +							, lb.name, Type.getType(lb.getPrimitiveType()).getDescriptor(),
228.3523 +								  null, null);
228.3524 +				else
228.3525 +					cv.visitField(0 //+ (oneTimeUse ? 0 : ACC_FINAL)
228.3526 +							, lb.name, OBJECT_TYPE.getDescriptor(), null, null);
228.3527 +				}
228.3528 +			}
228.3529 +
228.3530 +		//instance fields for callsites and thunks
228.3531 +		for(int i=0;i<protocolCallsites.count();i++)
228.3532 +			{
228.3533 +			cv.visitField(ACC_PRIVATE, cachedClassName(i), CLASS_TYPE.getDescriptor(), null, null);
228.3534 +			cv.visitField(ACC_PRIVATE, cachedProtoFnName(i), AFUNCTION_TYPE.getDescriptor(), null, null);
228.3535 +			cv.visitField(ACC_PRIVATE, cachedProtoImplName(i), IFN_TYPE.getDescriptor(), null, null);			
228.3536 +			}
228.3537 +
228.3538 +		//ctor that takes closed-overs and inits base + fields
228.3539 +		Method m = new Method("<init>", Type.VOID_TYPE, ctorTypes());
228.3540 +		GeneratorAdapter ctorgen = new GeneratorAdapter(ACC_PUBLIC,
228.3541 +		                                                m,
228.3542 +		                                                null,
228.3543 +		                                                null,
228.3544 +		                                                cv);
228.3545 +		Label start = ctorgen.newLabel();
228.3546 +		Label end = ctorgen.newLabel();
228.3547 +		ctorgen.visitCode();
228.3548 +		ctorgen.visitLineNumber(line, ctorgen.mark());
228.3549 +		ctorgen.visitLabel(start);
228.3550 +		ctorgen.loadThis();
228.3551 +//		if(superName != null)
228.3552 +			ctorgen.invokeConstructor(Type.getObjectType(superName), voidctor);
228.3553 +//		else if(isVariadic()) //RestFn ctor takes reqArity arg
228.3554 +//			{
228.3555 +//			ctorgen.push(variadicMethod.reqParms.count());
228.3556 +//			ctorgen.invokeConstructor(restFnType, restfnctor);
228.3557 +//			}
228.3558 +//		else
228.3559 +//			ctorgen.invokeConstructor(aFnType, voidctor);
228.3560 +		if(!isDeftype())
228.3561 +			{
228.3562 +			ctorgen.loadThis();
228.3563 +			ctorgen.visitVarInsn(IPERSISTENTMAP_TYPE.getOpcode(Opcodes.ILOAD), 1);
228.3564 +			ctorgen.putField(objtype, "__meta", IPERSISTENTMAP_TYPE);
228.3565 +			}
228.3566 +
228.3567 +		int a = isDeftype()?1:2;
228.3568 +		for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a)
228.3569 +			{
228.3570 +			LocalBinding lb = (LocalBinding) s.first();
228.3571 +			ctorgen.loadThis();
228.3572 +			Class primc = lb.getPrimitiveType();
228.3573 +			if(primc != null)
228.3574 +				{
228.3575 +				ctorgen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), a);
228.3576 +				ctorgen.putField(objtype, lb.name, Type.getType(primc));
228.3577 +				if(primc == Long.TYPE || primc == Double.TYPE)
228.3578 +					++a;
228.3579 +				}
228.3580 +			else
228.3581 +				{
228.3582 +				ctorgen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), a);
228.3583 +				ctorgen.putField(objtype, lb.name, OBJECT_TYPE);
228.3584 +				}
228.3585 +            closesExprs = closesExprs.cons(new LocalBindingExpr(lb, null));
228.3586 +			}
228.3587 +
228.3588 +
228.3589 +		ctorgen.visitLabel(end);
228.3590 +
228.3591 +		ctorgen.returnValue();
228.3592 +
228.3593 +		ctorgen.endMethod();
228.3594 +
228.3595 +		if(altCtorDrops > 0)
228.3596 +			{
228.3597 +					//ctor that takes closed-overs and inits base + fields
228.3598 +			Type[] ctorTypes = ctorTypes();
228.3599 +			Type[] altCtorTypes = new Type[ctorTypes.length-altCtorDrops];
228.3600 +			for(int i=0;i<altCtorTypes.length;i++)
228.3601 +				altCtorTypes[i] = ctorTypes[i];
228.3602 +			Method alt = new Method("<init>", Type.VOID_TYPE, altCtorTypes);
228.3603 +			ctorgen = new GeneratorAdapter(ACC_PUBLIC,
228.3604 +															alt,
228.3605 +															null,
228.3606 +															null,
228.3607 +															cv);
228.3608 +			ctorgen.visitCode();
228.3609 +			ctorgen.loadThis();
228.3610 +			ctorgen.loadArgs();
228.3611 +			for(int i=0;i<altCtorDrops;i++)
228.3612 +				ctorgen.visitInsn(Opcodes.ACONST_NULL);
228.3613 +
228.3614 +			ctorgen.invokeConstructor(objtype, new Method("<init>", Type.VOID_TYPE, ctorTypes));
228.3615 +
228.3616 +			ctorgen.returnValue();
228.3617 +			ctorgen.endMethod();
228.3618 +			}
228.3619 +
228.3620 +		if(!isDeftype())
228.3621 +			{
228.3622 +					//ctor that takes closed-overs but not meta
228.3623 +			Type[] ctorTypes = ctorTypes();
228.3624 +			Type[] noMetaCtorTypes = new Type[ctorTypes.length-1];
228.3625 +			for(int i=1;i<ctorTypes.length;i++)
228.3626 +				noMetaCtorTypes[i-1] = ctorTypes[i];
228.3627 +			Method alt = new Method("<init>", Type.VOID_TYPE, noMetaCtorTypes);
228.3628 +			ctorgen = new GeneratorAdapter(ACC_PUBLIC,
228.3629 +															alt,
228.3630 +															null,
228.3631 +															null,
228.3632 +															cv);
228.3633 +			ctorgen.visitCode();
228.3634 +			ctorgen.loadThis();
228.3635 +			ctorgen.visitInsn(Opcodes.ACONST_NULL);	//null meta
228.3636 +			ctorgen.loadArgs();
228.3637 +			ctorgen.invokeConstructor(objtype, new Method("<init>", Type.VOID_TYPE, ctorTypes));
228.3638 +
228.3639 +			ctorgen.returnValue();
228.3640 +			ctorgen.endMethod();
228.3641 +
228.3642 +			//meta()
228.3643 +			Method meth = Method.getMethod("clojure.lang.IPersistentMap meta()");
228.3644 +
228.3645 +			GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC,
228.3646 +												meth,
228.3647 +												null,
228.3648 +												null,
228.3649 +												cv);
228.3650 +			gen.visitCode();
228.3651 +			gen.loadThis();
228.3652 +			gen.getField(objtype,"__meta",IPERSISTENTMAP_TYPE);
228.3653 +
228.3654 +			gen.returnValue();
228.3655 +			gen.endMethod();
228.3656 +
228.3657 +			//withMeta()
228.3658 +			meth = Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)");
228.3659 +
228.3660 +			gen = new GeneratorAdapter(ACC_PUBLIC,
228.3661 +												meth,
228.3662 +												null,
228.3663 +												null,
228.3664 +												cv);
228.3665 +			gen.visitCode();
228.3666 +			gen.newInstance(objtype);
228.3667 +			gen.dup();
228.3668 +			gen.loadArg(0);
228.3669 +
228.3670 +			for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a)
228.3671 +				{
228.3672 +				LocalBinding lb = (LocalBinding) s.first();
228.3673 +				gen.loadThis();
228.3674 +				Class primc = lb.getPrimitiveType();
228.3675 +				if(primc != null)
228.3676 +					{
228.3677 +					gen.getField(objtype, lb.name, Type.getType(primc));
228.3678 +					}
228.3679 +				else
228.3680 +					{
228.3681 +					gen.getField(objtype, lb.name, OBJECT_TYPE);
228.3682 +					}
228.3683 +				}
228.3684 +
228.3685 +			gen.invokeConstructor(objtype, new Method("<init>", Type.VOID_TYPE, ctorTypes));
228.3686 +			gen.returnValue();
228.3687 +			gen.endMethod();
228.3688 +			}
228.3689 +		
228.3690 +		emitMethods(cv);
228.3691 +
228.3692 +		if(keywordCallsites.count() > 0)
228.3693 +			{
228.3694 +			Method meth = Method.getMethod("void swapThunk(int,clojure.lang.ILookupThunk)");
228.3695 +
228.3696 +			GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC,
228.3697 +												meth,
228.3698 +												null,
228.3699 +												null,
228.3700 +												cv);
228.3701 +			gen.visitCode();
228.3702 +			Label endLabel = gen.newLabel();
228.3703 +
228.3704 +			Label[] labels = new Label[keywordCallsites.count()];
228.3705 +			for(int i = 0; i < keywordCallsites.count();i++)
228.3706 +				{
228.3707 +				labels[i] = gen.newLabel();
228.3708 +				}
228.3709 +			gen.loadArg(0);
228.3710 +			gen.visitTableSwitchInsn(0,keywordCallsites.count()-1,endLabel,labels);
228.3711 +
228.3712 +			for(int i = 0; i < keywordCallsites.count();i++)
228.3713 +				{
228.3714 +				gen.mark(labels[i]);
228.3715 +//				gen.loadThis();
228.3716 +				gen.loadArg(1);
228.3717 +				gen.putStatic(objtype, thunkNameStatic(i),ILOOKUP_THUNK_TYPE);
228.3718 +				gen.goTo(endLabel);
228.3719 +				}
228.3720 +
228.3721 +			gen.mark(endLabel);
228.3722 +
228.3723 +			gen.returnValue();
228.3724 +			gen.endMethod();
228.3725 +			}
228.3726 +		
228.3727 +		//end of class
228.3728 +		cv.visitEnd();
228.3729 +
228.3730 +		bytecode = cw.toByteArray();
228.3731 +		if(RT.booleanCast(COMPILE_FILES.deref()))
228.3732 +			writeClassFile(internalName, bytecode);
228.3733 +//		else
228.3734 +//			getCompiledClass();
228.3735 +	}
228.3736 +
228.3737 +	private void emitKeywordCallsites(GeneratorAdapter clinitgen){
228.3738 +		for(int i=0;i<keywordCallsites.count();i++)
228.3739 +			{
228.3740 +			Keyword k = (Keyword) keywordCallsites.nth(i);
228.3741 +			clinitgen.newInstance(KEYWORD_LOOKUPSITE_TYPE);
228.3742 +			clinitgen.dup();
228.3743 +			clinitgen.push(i);
228.3744 +			emitValue(k,clinitgen);
228.3745 +			clinitgen.invokeConstructor(KEYWORD_LOOKUPSITE_TYPE,
228.3746 +			                            Method.getMethod("void <init>(int,clojure.lang.Keyword)"));
228.3747 +			clinitgen.dup();
228.3748 +			clinitgen.putStatic(objtype, siteNameStatic(i), KEYWORD_LOOKUPSITE_TYPE);
228.3749 +			clinitgen.putStatic(objtype, thunkNameStatic(i), ILOOKUP_THUNK_TYPE);
228.3750 +			}
228.3751 +	}
228.3752 +
228.3753 +	protected void emitMethods(ClassVisitor gen){
228.3754 +	}
228.3755 +
228.3756 +	void emitListAsObjectArray(Object value, GeneratorAdapter gen){
228.3757 +		gen.push(((List) value).size());
228.3758 +		gen.newArray(OBJECT_TYPE);
228.3759 +		int i = 0;
228.3760 +		for(Iterator it = ((List) value).iterator(); it.hasNext(); i++)
228.3761 +			{
228.3762 +			gen.dup();
228.3763 +			gen.push(i);
228.3764 +			emitValue(it.next(), gen);
228.3765 +			gen.arrayStore(OBJECT_TYPE);
228.3766 +			}
228.3767 +	}
228.3768 +
228.3769 +	void emitValue(Object value, GeneratorAdapter gen){
228.3770 +		boolean partial = true;
228.3771 +		//System.out.println(value.getClass().toString());
228.3772 +
228.3773 +		if(value instanceof String)
228.3774 +			{
228.3775 +			gen.push((String) value);
228.3776 +			}
228.3777 +		else if(value instanceof Integer)
228.3778 +			{
228.3779 +			gen.push(((Integer) value).intValue());
228.3780 +			gen.invokeStatic(Type.getType(Integer.class), Method.getMethod("Integer valueOf(int)"));
228.3781 +			}
228.3782 +		else if(value instanceof Double)
228.3783 +				{
228.3784 +				gen.push(((Double) value).doubleValue());
228.3785 +				gen.invokeStatic(Type.getType(Double.class), Method.getMethod("Double valueOf(double)"));
228.3786 +				}
228.3787 +			else if(value instanceof Character)
228.3788 +					{
228.3789 +					gen.push(((Character) value).charValue());
228.3790 +					gen.invokeStatic(Type.getType(Character.class), Method.getMethod("Character valueOf(char)"));
228.3791 +					}
228.3792 +				else if(value instanceof Class)
228.3793 +						{
228.3794 +                                                Class cc = (Class)value;
228.3795 +                                                if(cc.isPrimitive())
228.3796 +                                                        {
228.3797 +                                                        Type bt;
228.3798 +                                                        if ( cc == boolean.class ) bt = Type.getType(Boolean.class);
228.3799 +                                                        else if ( cc == byte.class ) bt = Type.getType(Byte.class);
228.3800 +                                                        else if ( cc == char.class ) bt = Type.getType(Character.class);
228.3801 +                                                        else if ( cc == double.class ) bt = Type.getType(Double.class);
228.3802 +                                                        else if ( cc == float.class ) bt = Type.getType(Float.class);
228.3803 +                                                        else if ( cc == int.class ) bt = Type.getType(Integer.class);
228.3804 +                                                        else if ( cc == long.class ) bt = Type.getType(Long.class);
228.3805 +                                                        else if ( cc == short.class ) bt = Type.getType(Short.class);
228.3806 +                                                        else throw new RuntimeException(
228.3807 +                                                                "Can't embed unknown primitive in code: " + value);
228.3808 +                                                        gen.getStatic( bt, "TYPE", Type.getType(Class.class) );
228.3809 +                                                        }
228.3810 +                                                else
228.3811 +                                                        {
228.3812 +                                                        gen.push(destubClassName(cc.getName()));
228.3813 +                                                        gen.invokeStatic(Type.getType(Class.class), Method.getMethod("Class forName(String)"));
228.3814 +                                                        }
228.3815 +						}
228.3816 +					else if(value instanceof Symbol)
228.3817 +							{
228.3818 +							gen.push(((Symbol) value).ns);
228.3819 +							gen.push(((Symbol) value).name);
228.3820 +							gen.invokeStatic(Type.getType(Symbol.class),
228.3821 +							                 Method.getMethod("clojure.lang.Symbol create(String,String)"));
228.3822 +							}
228.3823 +						else if(value instanceof Keyword)
228.3824 +								{
228.3825 +								emitValue(((Keyword) value).sym, gen);
228.3826 +								gen.invokeStatic(Type.getType(Keyword.class),
228.3827 +								                 Method.getMethod("clojure.lang.Keyword intern(clojure.lang.Symbol)"));
228.3828 +								}
228.3829 +//						else if(value instanceof KeywordCallSite)
228.3830 +//								{
228.3831 +//								emitValue(((KeywordCallSite) value).k.sym, gen);
228.3832 +//								gen.invokeStatic(Type.getType(KeywordCallSite.class),
228.3833 +//								                 Method.getMethod("clojure.lang.KeywordCallSite create(clojure.lang.Symbol)"));
228.3834 +//								}
228.3835 +							else if(value instanceof Var)
228.3836 +									{
228.3837 +									Var var = (Var) value;
228.3838 +									gen.push(var.ns.name.toString());
228.3839 +									gen.push(var.sym.toString());
228.3840 +									gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
228.3841 +									}
228.3842 +								else if(value instanceof IPersistentMap)
228.3843 +										{
228.3844 +										List entries = new ArrayList();
228.3845 +										for(Map.Entry entry : (Set<Map.Entry>) ((Map) value).entrySet())
228.3846 +											{
228.3847 +											entries.add(entry.getKey());
228.3848 +											entries.add(entry.getValue());
228.3849 +											}
228.3850 +										emitListAsObjectArray(entries, gen);
228.3851 +										gen.invokeStatic(RT_TYPE,
228.3852 +										                 Method.getMethod("clojure.lang.IPersistentMap map(Object[])"));
228.3853 +										}
228.3854 +									else if(value instanceof IPersistentVector)
228.3855 +											{
228.3856 +											emitListAsObjectArray(value, gen);
228.3857 +											gen.invokeStatic(RT_TYPE, Method.getMethod(
228.3858 +													"clojure.lang.IPersistentVector vector(Object[])"));
228.3859 +											}
228.3860 +										else if(value instanceof ISeq || value instanceof IPersistentList)
228.3861 +												{
228.3862 +												emitListAsObjectArray(value, gen);
228.3863 +												gen.invokeStatic(Type.getType(java.util.Arrays.class),
228.3864 +												                 Method.getMethod("java.util.List asList(Object[])"));
228.3865 +												gen.invokeStatic(Type.getType(PersistentList.class),
228.3866 +												                 Method.getMethod(
228.3867 +														                 "clojure.lang.IPersistentList create(java.util.List)"));
228.3868 +												}
228.3869 +											else
228.3870 +												{
228.3871 +												String cs = null;
228.3872 +												try
228.3873 +													{
228.3874 +													cs = RT.printString(value);
228.3875 +													//System.out.println("WARNING SLOW CODE: " + value.getClass() + " -> " + cs);
228.3876 +													}
228.3877 +												catch(Exception e)
228.3878 +													{
228.3879 +													throw new RuntimeException(
228.3880 +															"Can't embed object in code, maybe print-dup not defined: " +
228.3881 +															value);
228.3882 +													}
228.3883 +												if(cs.length() == 0)
228.3884 +													throw new RuntimeException(
228.3885 +															"Can't embed unreadable object in code: " + value);
228.3886 +
228.3887 +												if(cs.startsWith("#<"))
228.3888 +													throw new RuntimeException(
228.3889 +															"Can't embed unreadable object in code: " + cs);
228.3890 +
228.3891 +												gen.push(cs);
228.3892 +												gen.invokeStatic(RT_TYPE, readStringMethod);
228.3893 +												partial = false;
228.3894 +												}
228.3895 +
228.3896 +		if(partial)
228.3897 +			{
228.3898 +			if(value instanceof IObj && RT.count(((IObj) value).meta()) > 0)
228.3899 +				{
228.3900 +				gen.checkCast(IOBJ_TYPE);
228.3901 +				emitValue(((IObj) value).meta(), gen);
228.3902 +				gen.checkCast(IPERSISTENTMAP_TYPE);
228.3903 +				gen.invokeInterface(IOBJ_TYPE,
228.3904 +				                    Method.getMethod("clojure.lang.IObj withMeta(clojure.lang.IPersistentMap)"));
228.3905 +				}
228.3906 +			}
228.3907 +	}
228.3908 +
228.3909 +
228.3910 +	void emitConstants(GeneratorAdapter clinitgen){
228.3911 +		try
228.3912 +			{
228.3913 +			Var.pushThreadBindings(RT.map(RT.PRINT_DUP, RT.T));
228.3914 +
228.3915 +			for(int i = 0; i < constants.count(); i++)
228.3916 +				{
228.3917 +				emitValue(constants.nth(i), clinitgen);
228.3918 +				clinitgen.checkCast(constantType(i));
228.3919 +				clinitgen.putStatic(objtype, constantName(i), constantType(i));
228.3920 +				}
228.3921 +			}
228.3922 +		finally
228.3923 +			{
228.3924 +			Var.popThreadBindings();
228.3925 +			}
228.3926 +	}
228.3927 +
228.3928 +	boolean isMutable(LocalBinding lb){
228.3929 +		return isVolatile(lb) ||
228.3930 +		       RT.booleanCast(RT.contains(fields, lb.sym)) &&
228.3931 +		       RT.booleanCast(RT.get(lb.sym.meta(), Keyword.intern("unsynchronized-mutable")));
228.3932 +	}
228.3933 +
228.3934 +	boolean isVolatile(LocalBinding lb){
228.3935 +		return RT.booleanCast(RT.contains(fields, lb.sym)) &&
228.3936 +		       RT.booleanCast(RT.get(lb.sym.meta(), Keyword.intern("volatile-mutable")));
228.3937 +	}
228.3938 +
228.3939 +	boolean isDeftype(){
228.3940 +		return fields != null;
228.3941 +	}
228.3942 +
228.3943 +	void emitClearCloses(GeneratorAdapter gen){
228.3944 +//		int a = 1;
228.3945 +//		for(ISeq s = RT.keys(closes); s != null; s = s.next(), ++a)
228.3946 +//			{
228.3947 +//			LocalBinding lb = (LocalBinding) s.first();
228.3948 +//			Class primc = lb.getPrimitiveType();
228.3949 +//			if(primc == null)
228.3950 +//				{
228.3951 +//				gen.loadThis();
228.3952 +//				gen.visitInsn(Opcodes.ACONST_NULL);
228.3953 +//				gen.putField(objtype, lb.name, OBJECT_TYPE);
228.3954 +//				}
228.3955 +//			}
228.3956 +	}
228.3957 +
228.3958 +	synchronized Class getCompiledClass(){
228.3959 +		if(compiledClass == null)
228.3960 +			try
228.3961 +				{
228.3962 +//				if(RT.booleanCast(COMPILE_FILES.deref()))
228.3963 +//					compiledClass = RT.classForName(name);//loader.defineClass(name, bytecode);
228.3964 +//				else
228.3965 +					{
228.3966 +					loader = (DynamicClassLoader) LOADER.deref();
228.3967 +					compiledClass = loader.defineClass(name, bytecode, src);
228.3968 +					}
228.3969 +				}
228.3970 +			catch(Exception e)
228.3971 +				{
228.3972 +				throw new RuntimeException(e);
228.3973 +				}
228.3974 +		return compiledClass;
228.3975 +	}
228.3976 +
228.3977 +	public Object eval() throws Exception{
228.3978 +		if(isDeftype())
228.3979 +			return null;
228.3980 +		return getCompiledClass().newInstance();
228.3981 +	}
228.3982 +
228.3983 +	public void emitLetFnInits(GeneratorAdapter gen, ObjExpr objx, IPersistentSet letFnLocals){
228.3984 +		//objx arg is enclosing objx, not this
228.3985 +		gen.checkCast(objtype);
228.3986 +
228.3987 +		for(ISeq s = RT.keys(closes); s != null; s = s.next())
228.3988 +			{
228.3989 +			LocalBinding lb = (LocalBinding) s.first();
228.3990 +			if(letFnLocals.contains(lb))
228.3991 +				{
228.3992 +				Class primc = lb.getPrimitiveType();
228.3993 +				gen.dup();
228.3994 +				if(primc != null)
228.3995 +					{
228.3996 +					objx.emitUnboxedLocal(gen, lb);
228.3997 +					gen.putField(objtype, lb.name, Type.getType(primc));
228.3998 +					}
228.3999 +				else
228.4000 +					{
228.4001 +					objx.emitLocal(gen, lb, false);
228.4002 +					gen.putField(objtype, lb.name, OBJECT_TYPE);
228.4003 +					}
228.4004 +				}
228.4005 +			}
228.4006 +		gen.pop();
228.4007 +
228.4008 +	}
228.4009 +
228.4010 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.4011 +		//emitting a Fn means constructing an instance, feeding closed-overs from enclosing scope, if any
228.4012 +		//objx arg is enclosing objx, not this
228.4013 +//		getCompiledClass();
228.4014 +		if(isDeftype())
228.4015 +			{
228.4016 +			gen.visitInsn(Opcodes.ACONST_NULL);
228.4017 +			}
228.4018 +		else
228.4019 +			{
228.4020 +			gen.newInstance(objtype);
228.4021 +			gen.dup();
228.4022 +			gen.visitInsn(Opcodes.ACONST_NULL);				
228.4023 +			for(ISeq s = RT.seq(closesExprs); s != null; s = s.next())
228.4024 +				{
228.4025 +                LocalBindingExpr lbe = (LocalBindingExpr) s.first();
228.4026 +				LocalBinding lb = lbe.b;
228.4027 +				if(lb.getPrimitiveType() != null)
228.4028 +					objx.emitUnboxedLocal(gen, lb);
228.4029 +				else
228.4030 +					objx.emitLocal(gen, lb, lbe.shouldClear);
228.4031 +				}
228.4032 +			gen.invokeConstructor(objtype, new Method("<init>", Type.VOID_TYPE, ctorTypes()));
228.4033 +			}
228.4034 +		if(context == C.STATEMENT)
228.4035 +			gen.pop();
228.4036 +	}
228.4037 +
228.4038 +	public boolean hasJavaClass() throws Exception{
228.4039 +		return true;
228.4040 +	}
228.4041 +
228.4042 +	public Class getJavaClass() throws Exception{
228.4043 +		return (compiledClass != null) ? compiledClass
228.4044 +			: (tag != null) ? HostExpr.tagToClass(tag)
228.4045 +			: IFn.class;
228.4046 +	}
228.4047 +
228.4048 +	public void emitAssignLocal(GeneratorAdapter gen, LocalBinding lb,Expr val){
228.4049 +		if(!isMutable(lb))
228.4050 +			throw new IllegalArgumentException("Cannot assign to non-mutable: " + lb.name);
228.4051 +		Class primc = lb.getPrimitiveType();
228.4052 +		gen.loadThis();
228.4053 +		if(primc != null)
228.4054 +			{
228.4055 +			if(!(val instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr) val).canEmitPrimitive()))
228.4056 +				throw new IllegalArgumentException("Must assign primitive to primitive mutable: " + lb.name);
228.4057 +			MaybePrimitiveExpr me = (MaybePrimitiveExpr) val;
228.4058 +			me.emitUnboxed(C.EXPRESSION, this, gen);
228.4059 +			gen.putField(objtype, lb.name, Type.getType(primc));
228.4060 +			}
228.4061 +		else
228.4062 +			{
228.4063 +			val.emit(C.EXPRESSION, this, gen);
228.4064 +			gen.putField(objtype, lb.name, OBJECT_TYPE);
228.4065 +			}
228.4066 +	}
228.4067 +
228.4068 +	private void emitLocal(GeneratorAdapter gen, LocalBinding lb, boolean clear){
228.4069 +		if(closes.containsKey(lb))
228.4070 +			{
228.4071 +			Class primc = lb.getPrimitiveType();
228.4072 +			gen.loadThis();
228.4073 +			if(primc != null)
228.4074 +				{
228.4075 +				gen.getField(objtype, lb.name, Type.getType(primc));
228.4076 +				HostExpr.emitBoxReturn(this, gen, primc);
228.4077 +				}
228.4078 +			else
228.4079 +				{
228.4080 +				gen.getField(objtype, lb.name, OBJECT_TYPE);
228.4081 +				if(onceOnly && clear && lb.canBeCleared)
228.4082 +					{
228.4083 +					gen.loadThis();
228.4084 +					gen.visitInsn(Opcodes.ACONST_NULL);
228.4085 +					gen.putField(objtype, lb.name, OBJECT_TYPE);
228.4086 +					}
228.4087 +				}
228.4088 +			}
228.4089 +		else
228.4090 +			{
228.4091 +			Class primc = lb.getPrimitiveType();
228.4092 +//            String rep = lb.sym.name + " " + lb.toString().substring(lb.toString().lastIndexOf('@'));
228.4093 +			if(lb.isArg)
228.4094 +				{
228.4095 +				gen.loadArg(lb.idx-1);
228.4096 +				if(primc != null)
228.4097 +					HostExpr.emitBoxReturn(this, gen, primc);
228.4098 +                else
228.4099 +                    {
228.4100 +                    if(clear && lb.canBeCleared)
228.4101 +                        {
228.4102 +//                        System.out.println("clear: " + rep);
228.4103 +                        gen.visitInsn(Opcodes.ACONST_NULL);
228.4104 +                        gen.storeArg(lb.idx - 1);
228.4105 +                        }
228.4106 +                    else
228.4107 +                        {
228.4108 +//                        System.out.println("use: " + rep);
228.4109 +                        }
228.4110 +                    }     
228.4111 +				}
228.4112 +			else
228.4113 +				{
228.4114 +				if(primc != null)
228.4115 +					{
228.4116 +					gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), lb.idx);
228.4117 +					HostExpr.emitBoxReturn(this, gen, primc);
228.4118 +					}
228.4119 +				else
228.4120 +                    {
228.4121 +					gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), lb.idx);
228.4122 +                    if(clear && lb.canBeCleared)
228.4123 +                        {
228.4124 +//                        System.out.println("clear: " + rep);
228.4125 +                        gen.visitInsn(Opcodes.ACONST_NULL);
228.4126 +                        gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), lb.idx);
228.4127 +                        }
228.4128 +                    else
228.4129 +                        {
228.4130 +//                        System.out.println("use: " + rep);
228.4131 +                        }
228.4132 +                    }
228.4133 +				}
228.4134 +			}
228.4135 +	}
228.4136 +
228.4137 +	private void emitUnboxedLocal(GeneratorAdapter gen, LocalBinding lb){
228.4138 +		Class primc = lb.getPrimitiveType();
228.4139 +		if(closes.containsKey(lb))
228.4140 +			{
228.4141 +			gen.loadThis();
228.4142 +			gen.getField(objtype, lb.name, Type.getType(primc));
228.4143 +			}
228.4144 +		else if(lb.isArg)
228.4145 +			gen.loadArg(lb.idx-1);
228.4146 +		else
228.4147 +			gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ILOAD), lb.idx);
228.4148 +	}
228.4149 +
228.4150 +	public void emitVar(GeneratorAdapter gen, Var var){
228.4151 +		Integer i = (Integer) vars.valAt(var);
228.4152 +		emitConstant(gen, i);
228.4153 +		//gen.getStatic(fntype, munge(var.sym.toString()), VAR_TYPE);
228.4154 +	}
228.4155 +
228.4156 +	public void emitKeyword(GeneratorAdapter gen, Keyword k){
228.4157 +		Integer i = (Integer) keywords.valAt(k);
228.4158 +		emitConstant(gen, i);
228.4159 +//		gen.getStatic(fntype, munge(k.sym.toString()), KEYWORD_TYPE);
228.4160 +	}
228.4161 +
228.4162 +	public void emitConstant(GeneratorAdapter gen, int id){
228.4163 +		gen.getStatic(objtype, constantName(id), constantType(id));
228.4164 +	}
228.4165 +
228.4166 +
228.4167 +	String constantName(int id){
228.4168 +		return CONST_PREFIX + id;
228.4169 +	}
228.4170 +
228.4171 +	String siteName(int n){
228.4172 +		return "__site__" + n;
228.4173 +	}
228.4174 +
228.4175 +	String siteNameStatic(int n){
228.4176 +		return siteName(n) + "__";
228.4177 +	}
228.4178 +
228.4179 +	String thunkName(int n){
228.4180 +		return "__thunk__" + n;
228.4181 +	}
228.4182 +
228.4183 +	String cachedClassName(int n){
228.4184 +		return "__cached_class__" + n;
228.4185 +	}
228.4186 +
228.4187 +	String cachedProtoFnName(int n){
228.4188 +		return "__cached_proto_fn__" + n;
228.4189 +	}
228.4190 +
228.4191 +	String cachedProtoImplName(int n){
228.4192 +		return "__cached_proto_impl__" + n;
228.4193 +	}
228.4194 +
228.4195 +	String varCallsiteName(int n){
228.4196 +		return "__var__callsite__" + n;
228.4197 +	}
228.4198 +
228.4199 +	String thunkNameStatic(int n){
228.4200 +		return thunkName(n) + "__";
228.4201 +	}
228.4202 +
228.4203 +	Type constantType(int id){
228.4204 +		Object o = constants.nth(id);
228.4205 +		Class c = o.getClass();
228.4206 +		if(Modifier.isPublic(c.getModifiers()))
228.4207 +			{
228.4208 +			//can't emit derived fn types due to visibility
228.4209 +			if(LazySeq.class.isAssignableFrom(c))
228.4210 +				return Type.getType(ISeq.class);
228.4211 +			else if(c == Keyword.class)
228.4212 +				return Type.getType(Keyword.class);
228.4213 +//			else if(c == KeywordCallSite.class)
228.4214 +//				return Type.getType(KeywordCallSite.class);
228.4215 +			else if(RestFn.class.isAssignableFrom(c))
228.4216 +				return Type.getType(RestFn.class);
228.4217 +			else if(AFn.class.isAssignableFrom(c))
228.4218 +					return Type.getType(AFn.class);
228.4219 +				else if(c == Var.class)
228.4220 +						return Type.getType(Var.class);
228.4221 +					else if(c == String.class)
228.4222 +							return Type.getType(String.class);
228.4223 +
228.4224 +//			return Type.getType(c);
228.4225 +			}
228.4226 +		return OBJECT_TYPE;
228.4227 +	}
228.4228 +
228.4229 +}
228.4230 +
228.4231 +enum PATHTYPE {
228.4232 +    PATH, BRANCH;
228.4233 +}
228.4234 +
228.4235 +static class PathNode{
228.4236 +    final PATHTYPE type;
228.4237 +    final PathNode parent;
228.4238 +
228.4239 +    PathNode(PATHTYPE type, PathNode parent) {
228.4240 +        this.type = type;
228.4241 +        this.parent = parent;
228.4242 +    }
228.4243 +}
228.4244 +
228.4245 +static PathNode clearPathRoot(){
228.4246 +    return (PathNode) CLEAR_ROOT.get();
228.4247 +}
228.4248 +    
228.4249 +enum PSTATE{
228.4250 +	REQ, REST, DONE
228.4251 +}
228.4252 +
228.4253 +public static class FnMethod extends ObjMethod{
228.4254 +	//localbinding->localbinding
228.4255 +	PersistentVector reqParms = PersistentVector.EMPTY;
228.4256 +	LocalBinding restParm = null;
228.4257 +
228.4258 +	public FnMethod(ObjExpr objx, ObjMethod parent){
228.4259 +		super(objx, parent);
228.4260 +	}
228.4261 +
228.4262 +	static FnMethod parse(ObjExpr objx, ISeq form) throws Exception{
228.4263 +		//([args] body...)
228.4264 +		IPersistentVector parms = (IPersistentVector) RT.first(form);
228.4265 +		ISeq body = RT.next(form);
228.4266 +		try
228.4267 +			{
228.4268 +			FnMethod method = new FnMethod(objx, (ObjMethod) METHOD.deref());
228.4269 +			method.line = (Integer) LINE.deref();
228.4270 +			//register as the current method and set up a new env frame
228.4271 +            PathNode pnode =  (PathNode) CLEAR_PATH.get();
228.4272 +			if(pnode == null)
228.4273 +				pnode = new PathNode(PATHTYPE.PATH,null);
228.4274 +			Var.pushThreadBindings(
228.4275 +					RT.map(
228.4276 +							METHOD, method,
228.4277 +							LOCAL_ENV, LOCAL_ENV.deref(),
228.4278 +							LOOP_LOCALS, null,
228.4279 +							NEXT_LOCAL_NUM, 0
228.4280 +                            ,CLEAR_PATH, pnode
228.4281 +                            ,CLEAR_ROOT, pnode
228.4282 +                            ,CLEAR_SITES, PersistentHashMap.EMPTY
228.4283 +                        ));
228.4284 +
228.4285 +			//register 'this' as local 0
228.4286 +			//registerLocal(THISFN, null, null);
228.4287 +			if(objx.thisName != null)
228.4288 +				registerLocal(Symbol.intern(objx.thisName), null, null,false);
228.4289 +			else
228.4290 +				getAndIncLocalNum();
228.4291 +			PSTATE state = PSTATE.REQ;
228.4292 +			PersistentVector argLocals = PersistentVector.EMPTY;
228.4293 +			for(int i = 0; i < parms.count(); i++)
228.4294 +				{
228.4295 +				if(!(parms.nth(i) instanceof Symbol))
228.4296 +					throw new IllegalArgumentException("fn params must be Symbols");
228.4297 +				Symbol p = (Symbol) parms.nth(i);
228.4298 +				if(p.getNamespace() != null)
228.4299 +					throw new Exception("Can't use qualified name as parameter: " + p);
228.4300 +				if(p.equals(_AMP_))
228.4301 +					{
228.4302 +					if(state == PSTATE.REQ)
228.4303 +						state = PSTATE.REST;
228.4304 +					else
228.4305 +						throw new Exception("Invalid parameter list");
228.4306 +					}
228.4307 +
228.4308 +				else
228.4309 +					{
228.4310 +					LocalBinding lb = registerLocal(p, state == PSTATE.REST ? ISEQ : tagOf(p), null,true);
228.4311 +					argLocals = argLocals.cons(lb);
228.4312 +					switch(state)
228.4313 +						{
228.4314 +						case REQ:
228.4315 +							method.reqParms = method.reqParms.cons(lb);
228.4316 +							break;
228.4317 +						case REST:
228.4318 +							method.restParm = lb;
228.4319 +							state = PSTATE.DONE;
228.4320 +							break;
228.4321 +
228.4322 +						default:
228.4323 +							throw new Exception("Unexpected parameter");
228.4324 +						}
228.4325 +					}
228.4326 +				}
228.4327 +			if(method.reqParms.count() > MAX_POSITIONAL_ARITY)
228.4328 +				throw new Exception("Can't specify more than " + MAX_POSITIONAL_ARITY + " params");
228.4329 +			LOOP_LOCALS.set(argLocals);
228.4330 +			method.argLocals = argLocals;
228.4331 +			method.body = (new BodyExpr.Parser()).parse(C.RETURN, body);
228.4332 +			return method;
228.4333 +			}
228.4334 +		finally
228.4335 +			{
228.4336 +			Var.popThreadBindings();
228.4337 +			}
228.4338 +	}
228.4339 +
228.4340 +	public final PersistentVector reqParms(){
228.4341 +		return reqParms;
228.4342 +	}
228.4343 +
228.4344 +	public final LocalBinding restParm(){
228.4345 +		return restParm;
228.4346 +	}
228.4347 +
228.4348 +	boolean isVariadic(){
228.4349 +		return restParm != null;
228.4350 +	}
228.4351 +
228.4352 +	int numParams(){
228.4353 +		return reqParms.count() + (isVariadic() ? 1 : 0);
228.4354 +	}
228.4355 +
228.4356 +	String getMethodName(){
228.4357 +		return isVariadic()?"doInvoke":"invoke";
228.4358 +	}
228.4359 +
228.4360 +	Type getReturnType(){
228.4361 +		return OBJECT_TYPE;
228.4362 +	}
228.4363 +
228.4364 +	Type[] getArgTypes(){
228.4365 +		if(isVariadic() && reqParms.count() == MAX_POSITIONAL_ARITY)
228.4366 +			{
228.4367 +			Type[] ret = new Type[MAX_POSITIONAL_ARITY + 1];
228.4368 +			for(int i = 0;i<MAX_POSITIONAL_ARITY + 1;i++)
228.4369 +				ret[i] = OBJECT_TYPE;
228.4370 +			return ret;
228.4371 +			}
228.4372 +		return  ARG_TYPES[numParams()];
228.4373 +	}
228.4374 +
228.4375 +	void emitClearLocals(GeneratorAdapter gen){
228.4376 +//		for(int i = 1; i < numParams() + 1; i++)
228.4377 +//			{
228.4378 +//			if(!localsUsedInCatchFinally.contains(i))
228.4379 +//				{
228.4380 +//				gen.visitInsn(Opcodes.ACONST_NULL);
228.4381 +//				gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), i);
228.4382 +//				}
228.4383 +//			}
228.4384 +//		for(int i = numParams() + 1; i < maxLocal + 1; i++)
228.4385 +//			{
228.4386 +//			if(!localsUsedInCatchFinally.contains(i))
228.4387 +//				{
228.4388 +//				LocalBinding b = (LocalBinding) RT.get(indexlocals, i);
228.4389 +//				if(b == null || maybePrimitiveType(b.init) == null)
228.4390 +//					{
228.4391 +//					gen.visitInsn(Opcodes.ACONST_NULL);
228.4392 +//					gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), i);
228.4393 +//					}
228.4394 +//				}
228.4395 +//			}
228.4396 +//		if(((FnExpr)objx).onceOnly)
228.4397 +//			{
228.4398 +//			objx.emitClearCloses(gen);
228.4399 +//			}
228.4400 +	}
228.4401 +}
228.4402 +
228.4403 +abstract public static class ObjMethod{
228.4404 +	//when closures are defined inside other closures,
228.4405 +	//the closed over locals need to be propagated to the enclosing objx
228.4406 +	public final ObjMethod parent;
228.4407 +	//localbinding->localbinding
228.4408 +	IPersistentMap locals = null;
228.4409 +	//num->localbinding
228.4410 +	IPersistentMap indexlocals = null;
228.4411 +	Expr body = null;
228.4412 +	ObjExpr objx;
228.4413 +	PersistentVector argLocals;
228.4414 +	int maxLocal = 0;
228.4415 +	int line;
228.4416 +	PersistentHashSet localsUsedInCatchFinally = PersistentHashSet.EMPTY;
228.4417 +	protected IPersistentMap methodMeta;
228.4418 +
228.4419 +	public final IPersistentMap locals(){
228.4420 +		return locals;
228.4421 +	}
228.4422 +
228.4423 +	public final Expr body(){
228.4424 +		return body;
228.4425 +	}
228.4426 +
228.4427 +	public final ObjExpr objx(){
228.4428 +		return objx;
228.4429 +	}
228.4430 +
228.4431 +	public final PersistentVector argLocals(){
228.4432 +		return argLocals;
228.4433 +	}
228.4434 +
228.4435 +	public final int maxLocal(){
228.4436 +		return maxLocal;
228.4437 +	}
228.4438 +
228.4439 +	public final int line(){
228.4440 +		return line;
228.4441 +	}
228.4442 +
228.4443 +	public ObjMethod(ObjExpr objx, ObjMethod parent){
228.4444 +		this.parent = parent;
228.4445 +		this.objx = objx;
228.4446 +	}
228.4447 +
228.4448 +	abstract int numParams();
228.4449 +	abstract String getMethodName();
228.4450 +	abstract Type getReturnType();
228.4451 +	abstract Type[] getArgTypes();
228.4452 +
228.4453 +	public void emit(ObjExpr fn, ClassVisitor cv){
228.4454 +		Method m = new Method(getMethodName(), getReturnType(), getArgTypes());
228.4455 +
228.4456 +		GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC,
228.4457 +		                                            m,
228.4458 +		                                            null,
228.4459 +		                                            //todo don't hardwire this
228.4460 +		                                            EXCEPTION_TYPES,
228.4461 +		                                            cv);
228.4462 +		gen.visitCode();
228.4463 +		Label loopLabel = gen.mark();
228.4464 +		gen.visitLineNumber(line, loopLabel);
228.4465 +		try
228.4466 +			{
228.4467 +			Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel, METHOD, this));
228.4468 +			body.emit(C.RETURN, fn, gen);
228.4469 +			Label end = gen.mark();
228.4470 +			gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0);
228.4471 +			for(ISeq lbs = argLocals.seq(); lbs != null; lbs = lbs.next())
228.4472 +				{
228.4473 +				LocalBinding lb = (LocalBinding) lbs.first();
228.4474 +				gen.visitLocalVariable(lb.name, "Ljava/lang/Object;", null, loopLabel, end, lb.idx);
228.4475 +				}
228.4476 +			}
228.4477 +		finally
228.4478 +			{
228.4479 +			Var.popThreadBindings();
228.4480 +			}
228.4481 +
228.4482 +		gen.returnValue();
228.4483 +		//gen.visitMaxs(1, 1);
228.4484 +		gen.endMethod();
228.4485 +	}
228.4486 +
228.4487 +    void emitClearLocals(GeneratorAdapter gen){
228.4488 +    }
228.4489 +    
228.4490 +	void emitClearLocalsOld(GeneratorAdapter gen){
228.4491 +		for(int i=0;i<argLocals.count();i++)
228.4492 +			{
228.4493 +			LocalBinding lb = (LocalBinding) argLocals.nth(i);
228.4494 +			if(!localsUsedInCatchFinally.contains(lb.idx) && lb.getPrimitiveType() == null)
228.4495 +				{
228.4496 +				gen.visitInsn(Opcodes.ACONST_NULL);
228.4497 +				gen.storeArg(lb.idx - 1);				
228.4498 +				}
228.4499 +
228.4500 +			}
228.4501 +//		for(int i = 1; i < numParams() + 1; i++)
228.4502 +//			{
228.4503 +//			if(!localsUsedInCatchFinally.contains(i))
228.4504 +//				{
228.4505 +//				gen.visitInsn(Opcodes.ACONST_NULL);
228.4506 +//				gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), i);
228.4507 +//				}
228.4508 +//			}
228.4509 +		for(int i = numParams() + 1; i < maxLocal + 1; i++)
228.4510 +			{
228.4511 +			if(!localsUsedInCatchFinally.contains(i))
228.4512 +				{
228.4513 +				LocalBinding b = (LocalBinding) RT.get(indexlocals, i);
228.4514 +				if(b == null || maybePrimitiveType(b.init) == null)
228.4515 +					{
228.4516 +					gen.visitInsn(Opcodes.ACONST_NULL);
228.4517 +					gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), i);
228.4518 +					}
228.4519 +				}
228.4520 +			}
228.4521 +	}
228.4522 +}
228.4523 +
228.4524 +public static class LocalBinding{
228.4525 +	public final Symbol sym;
228.4526 +	public final Symbol tag;
228.4527 +	public Expr init;
228.4528 +	public final int idx;
228.4529 +	public final String name;
228.4530 +	public final boolean isArg;
228.4531 +    public final PathNode clearPathRoot;
228.4532 +	public boolean canBeCleared = true;
228.4533 +
228.4534 +    public LocalBinding(int num, Symbol sym, Symbol tag, Expr init, boolean isArg,PathNode clearPathRoot)
228.4535 +                throws Exception{
228.4536 +		if(maybePrimitiveType(init) != null && tag != null)
228.4537 +			throw new UnsupportedOperationException("Can't type hint a local with a primitive initializer");
228.4538 +		this.idx = num;
228.4539 +		this.sym = sym;
228.4540 +		this.tag = tag;
228.4541 +		this.init = init;
228.4542 +		this.isArg = isArg;
228.4543 +        this.clearPathRoot = clearPathRoot;
228.4544 +		name = munge(sym.name);
228.4545 +	}
228.4546 +
228.4547 +	public boolean hasJavaClass() throws Exception{
228.4548 +		if(init != null && init.hasJavaClass()
228.4549 +		   && Util.isPrimitive(init.getJavaClass())
228.4550 +		   && !(init instanceof MaybePrimitiveExpr))
228.4551 +			return false;
228.4552 +		return tag != null
228.4553 +		       || (init != null && init.hasJavaClass());
228.4554 +	}
228.4555 +
228.4556 +	public Class getJavaClass() throws Exception{
228.4557 +		return tag != null ? HostExpr.tagToClass(tag)
228.4558 +		                   : init.getJavaClass();
228.4559 +	}
228.4560 +
228.4561 +	public Class getPrimitiveType(){
228.4562 +		return maybePrimitiveType(init);
228.4563 +	}
228.4564 +}
228.4565 +
228.4566 +public static class LocalBindingExpr implements Expr, MaybePrimitiveExpr, AssignableExpr{
228.4567 +	public final LocalBinding b;
228.4568 +	public final Symbol tag;
228.4569 +
228.4570 +    public final PathNode clearPath;
228.4571 +    public final PathNode clearRoot;
228.4572 +    public boolean shouldClear = false;
228.4573 +
228.4574 +
228.4575 +	public LocalBindingExpr(LocalBinding b, Symbol tag)
228.4576 +            throws Exception{
228.4577 +		if(b.getPrimitiveType() != null && tag != null)
228.4578 +			throw new UnsupportedOperationException("Can't type hint a primitive local");
228.4579 +		this.b = b;
228.4580 +		this.tag = tag;
228.4581 +
228.4582 +        this.clearPath = (PathNode)CLEAR_PATH.get();
228.4583 +        this.clearRoot = (PathNode)CLEAR_ROOT.get();
228.4584 +        IPersistentCollection sites = (IPersistentCollection) RT.get(CLEAR_SITES.get(),b);
228.4585 +
228.4586 +        if(b.idx > 0)
228.4587 +            {
228.4588 +//            Object dummy;
228.4589 +
228.4590 +            if(sites != null)
228.4591 +                {
228.4592 +                for(ISeq s = sites.seq();s!=null;s = s.next())
228.4593 +                    {
228.4594 +                    LocalBindingExpr o = (LocalBindingExpr) s.first();
228.4595 +                    PathNode common = commonPath(clearPath,o.clearPath);
228.4596 +                    if(common != null && common.type == PATHTYPE.PATH)
228.4597 +                        o.shouldClear = false;
228.4598 +//                    else
228.4599 +//                        dummy = null;
228.4600 +                    }
228.4601 +                }
228.4602 +
228.4603 +            if(clearRoot == b.clearPathRoot)
228.4604 +                {
228.4605 +                this.shouldClear = true;
228.4606 +                sites = RT.conj(sites,this);
228.4607 +                CLEAR_SITES.set(RT.assoc(CLEAR_SITES.get(), b, sites));
228.4608 +                }
228.4609 +//            else
228.4610 +//                dummy = null;
228.4611 +            }
228.4612 + 	    }
228.4613 +
228.4614 +	public Object eval() throws Exception{
228.4615 +		throw new UnsupportedOperationException("Can't eval locals");
228.4616 +	}
228.4617 +
228.4618 +	public boolean canEmitPrimitive(){
228.4619 +		return b.getPrimitiveType() != null;
228.4620 +	}
228.4621 +
228.4622 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.4623 +		objx.emitUnboxedLocal(gen, b);
228.4624 +	}
228.4625 +
228.4626 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.4627 +		if(context != C.STATEMENT)
228.4628 +			objx.emitLocal(gen, b, shouldClear);
228.4629 +	}
228.4630 +
228.4631 +	public Object evalAssign(Expr val) throws Exception{
228.4632 +		throw new UnsupportedOperationException("Can't eval locals");
228.4633 +	}
228.4634 +
228.4635 +	public void emitAssign(C context, ObjExpr objx, GeneratorAdapter gen, Expr val){
228.4636 +		objx.emitAssignLocal(gen, b,val);
228.4637 +		if(context != C.STATEMENT)
228.4638 +			objx.emitLocal(gen, b, false);
228.4639 +	}
228.4640 +
228.4641 +	public boolean hasJavaClass() throws Exception{
228.4642 +		return tag != null || b.hasJavaClass();
228.4643 +	}
228.4644 +
228.4645 +	public Class getJavaClass() throws Exception{
228.4646 +		if(tag != null)
228.4647 +			return HostExpr.tagToClass(tag);
228.4648 +		return b.getJavaClass();
228.4649 +	}
228.4650 +
228.4651 +
228.4652 +}
228.4653 +
228.4654 +public static class BodyExpr implements Expr, MaybePrimitiveExpr{
228.4655 +	PersistentVector exprs;
228.4656 +
228.4657 +	public final PersistentVector exprs(){
228.4658 +		return exprs;
228.4659 +	}
228.4660 +
228.4661 +	public BodyExpr(PersistentVector exprs){
228.4662 +		this.exprs = exprs;
228.4663 +	}
228.4664 +
228.4665 +	static class Parser implements IParser{
228.4666 +		public Expr parse(C context, Object frms) throws Exception{
228.4667 +			ISeq forms = (ISeq) frms;
228.4668 +			if(Util.equals(RT.first(forms), DO))
228.4669 +				forms = RT.next(forms);
228.4670 +			PersistentVector exprs = PersistentVector.EMPTY;
228.4671 +			for(; forms != null; forms = forms.next())
228.4672 +				{
228.4673 +				Expr e = (context != C.EVAL &&
228.4674 +				          (context == C.STATEMENT || forms.next() != null)) ?
228.4675 +				         analyze(C.STATEMENT, forms.first())
228.4676 +				                                                            :
228.4677 +				         analyze(context, forms.first());
228.4678 +				exprs = exprs.cons(e);
228.4679 +				}
228.4680 +			if(exprs.count() == 0)
228.4681 +				exprs = exprs.cons(NIL_EXPR);
228.4682 +			return new BodyExpr(exprs);
228.4683 +		}
228.4684 +	}
228.4685 +
228.4686 +	public Object eval() throws Exception{
228.4687 +		Object ret = null;
228.4688 +		for(Object o : exprs)
228.4689 +			{
228.4690 +			Expr e = (Expr) o;
228.4691 +			ret = e.eval();
228.4692 +			}
228.4693 +		return ret;
228.4694 +	}
228.4695 +
228.4696 +	public boolean canEmitPrimitive(){
228.4697 +		return lastExpr() instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr)lastExpr()).canEmitPrimitive();
228.4698 +	}
228.4699 +
228.4700 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.4701 +		for(int i = 0; i < exprs.count() - 1; i++)
228.4702 +			{
228.4703 +			Expr e = (Expr) exprs.nth(i);
228.4704 +			e.emit(C.STATEMENT, objx, gen);
228.4705 +			}
228.4706 +		MaybePrimitiveExpr last = (MaybePrimitiveExpr) exprs.nth(exprs.count() - 1);
228.4707 +		last.emitUnboxed(context, objx, gen);
228.4708 +	}
228.4709 +
228.4710 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.4711 +		for(int i = 0; i < exprs.count() - 1; i++)
228.4712 +			{
228.4713 +			Expr e = (Expr) exprs.nth(i);
228.4714 +			e.emit(C.STATEMENT, objx, gen);
228.4715 +			}
228.4716 +		Expr last = (Expr) exprs.nth(exprs.count() - 1);
228.4717 +		last.emit(context, objx, gen);
228.4718 +	}
228.4719 +
228.4720 +	public boolean hasJavaClass() throws Exception{
228.4721 +		return lastExpr().hasJavaClass();
228.4722 +	}
228.4723 +
228.4724 +	public Class getJavaClass() throws Exception{
228.4725 +		return lastExpr().getJavaClass();
228.4726 +	}
228.4727 +
228.4728 +	private Expr lastExpr(){
228.4729 +		return (Expr) exprs.nth(exprs.count() - 1);
228.4730 +	}
228.4731 +}
228.4732 +
228.4733 +public static class BindingInit{
228.4734 +	LocalBinding binding;
228.4735 +	Expr init;
228.4736 +
228.4737 +	public final LocalBinding binding(){
228.4738 +		return binding;
228.4739 +	}
228.4740 +
228.4741 +	public final Expr init(){
228.4742 +		return init;
228.4743 +	}
228.4744 +
228.4745 +	public BindingInit(LocalBinding binding, Expr init){
228.4746 +		this.binding = binding;
228.4747 +		this.init = init;
228.4748 +	}
228.4749 +}
228.4750 +
228.4751 +public static class LetFnExpr implements Expr{
228.4752 +	public final PersistentVector bindingInits;
228.4753 +	public final Expr body;
228.4754 +
228.4755 +	public LetFnExpr(PersistentVector bindingInits, Expr body){
228.4756 +		this.bindingInits = bindingInits;
228.4757 +		this.body = body;
228.4758 +	}
228.4759 +
228.4760 +	static class Parser implements IParser{
228.4761 +		public Expr parse(C context, Object frm) throws Exception{
228.4762 +			ISeq form = (ISeq) frm;
228.4763 +			//(letfns* [var (fn [args] body) ...] body...)
228.4764 +			if(!(RT.second(form) instanceof IPersistentVector))
228.4765 +				throw new IllegalArgumentException("Bad binding form, expected vector");
228.4766 +
228.4767 +			IPersistentVector bindings = (IPersistentVector) RT.second(form);
228.4768 +			if((bindings.count() % 2) != 0)
228.4769 +				throw new IllegalArgumentException("Bad binding form, expected matched symbol expression pairs");
228.4770 +
228.4771 +			ISeq body = RT.next(RT.next(form));
228.4772 +
228.4773 +			if(context == C.EVAL)
228.4774 +				return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
228.4775 +
228.4776 +			IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(),
228.4777 +			                                        NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref());
228.4778 +
228.4779 +			try
228.4780 +				{
228.4781 +				Var.pushThreadBindings(dynamicBindings);
228.4782 +
228.4783 +				//pre-seed env (like Lisp labels)
228.4784 +				PersistentVector lbs = PersistentVector.EMPTY;
228.4785 +				for(int i = 0; i < bindings.count(); i += 2)
228.4786 +					{
228.4787 +					if(!(bindings.nth(i) instanceof Symbol))
228.4788 +						throw new IllegalArgumentException(
228.4789 +								"Bad binding form, expected symbol, got: " + bindings.nth(i));
228.4790 +					Symbol sym = (Symbol) bindings.nth(i);
228.4791 +					if(sym.getNamespace() != null)
228.4792 +						throw new Exception("Can't let qualified name: " + sym);
228.4793 +					LocalBinding lb = registerLocal(sym, tagOf(sym), null,false);
228.4794 +					lb.canBeCleared = false;
228.4795 +					lbs = lbs.cons(lb);
228.4796 +					}
228.4797 +				PersistentVector bindingInits = PersistentVector.EMPTY;
228.4798 +				for(int i = 0; i < bindings.count(); i += 2)
228.4799 +					{
228.4800 +					Symbol sym = (Symbol) bindings.nth(i);
228.4801 +					Expr init = analyze(C.EXPRESSION, bindings.nth(i + 1), sym.name);
228.4802 +					LocalBinding lb = (LocalBinding) lbs.nth(i / 2);
228.4803 +					lb.init = init;
228.4804 +					BindingInit bi = new BindingInit(lb, init);
228.4805 +					bindingInits = bindingInits.cons(bi);
228.4806 +					}
228.4807 +				return new LetFnExpr(bindingInits, (new BodyExpr.Parser()).parse(context, body));
228.4808 +				}
228.4809 +			finally
228.4810 +				{
228.4811 +				Var.popThreadBindings();
228.4812 +				}
228.4813 +		}
228.4814 +	}
228.4815 +
228.4816 +	public Object eval() throws Exception{
228.4817 +		throw new UnsupportedOperationException("Can't eval letfns");
228.4818 +	}
228.4819 +
228.4820 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.4821 +		for(int i = 0; i < bindingInits.count(); i++)
228.4822 +			{
228.4823 +			BindingInit bi = (BindingInit) bindingInits.nth(i);
228.4824 +			gen.visitInsn(Opcodes.ACONST_NULL);
228.4825 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx);
228.4826 +			}
228.4827 +
228.4828 +		IPersistentSet lbset = PersistentHashSet.EMPTY;
228.4829 +
228.4830 +		for(int i = 0; i < bindingInits.count(); i++)
228.4831 +			{
228.4832 +			BindingInit bi = (BindingInit) bindingInits.nth(i);
228.4833 +			lbset = (IPersistentSet) lbset.cons(bi.binding);
228.4834 +			bi.init.emit(C.EXPRESSION, objx, gen);
228.4835 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx);
228.4836 +			}
228.4837 +
228.4838 +		for(int i = 0; i < bindingInits.count(); i++)
228.4839 +			{
228.4840 +			BindingInit bi = (BindingInit) bindingInits.nth(i);
228.4841 +			ObjExpr fe = (ObjExpr) bi.init;
228.4842 +			gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ILOAD), bi.binding.idx);
228.4843 +			fe.emitLetFnInits(gen, objx, lbset);
228.4844 +			}
228.4845 +
228.4846 +		Label loopLabel = gen.mark();
228.4847 +
228.4848 +		body.emit(context, objx, gen);
228.4849 +
228.4850 +		Label end = gen.mark();
228.4851 +//		gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0);
228.4852 +		for(ISeq bis = bindingInits.seq(); bis != null; bis = bis.next())
228.4853 +			{
228.4854 +			BindingInit bi = (BindingInit) bis.first();
228.4855 +			String lname = bi.binding.name;
228.4856 +			if(lname.endsWith("__auto__"))
228.4857 +				lname += RT.nextID();
228.4858 +			Class primc = maybePrimitiveType(bi.init);
228.4859 +			if(primc != null)
228.4860 +				gen.visitLocalVariable(lname, Type.getDescriptor(primc), null, loopLabel, end,
228.4861 +				                       bi.binding.idx);
228.4862 +			else
228.4863 +				gen.visitLocalVariable(lname, "Ljava/lang/Object;", null, loopLabel, end, bi.binding.idx);
228.4864 +			}
228.4865 +	}
228.4866 +
228.4867 +	public boolean hasJavaClass() throws Exception{
228.4868 +		return body.hasJavaClass();
228.4869 +	}
228.4870 +
228.4871 +	public Class getJavaClass() throws Exception{
228.4872 +		return body.getJavaClass();
228.4873 +	}
228.4874 +}
228.4875 +
228.4876 +public static class LetExpr implements Expr, MaybePrimitiveExpr{
228.4877 +	public final PersistentVector bindingInits;
228.4878 +	public final Expr body;
228.4879 +	public final boolean isLoop;
228.4880 +
228.4881 +	public LetExpr(PersistentVector bindingInits, Expr body, boolean isLoop){
228.4882 +		this.bindingInits = bindingInits;
228.4883 +		this.body = body;
228.4884 +		this.isLoop = isLoop;
228.4885 +	}
228.4886 +
228.4887 +	static class Parser implements IParser{
228.4888 +		public Expr parse(C context, Object frm) throws Exception{
228.4889 +			ISeq form = (ISeq) frm;
228.4890 +			//(let [var val var2 val2 ...] body...)
228.4891 +			boolean isLoop = RT.first(form).equals(LOOP);
228.4892 +			if(!(RT.second(form) instanceof IPersistentVector))
228.4893 +				throw new IllegalArgumentException("Bad binding form, expected vector");
228.4894 +
228.4895 +			IPersistentVector bindings = (IPersistentVector) RT.second(form);
228.4896 +			if((bindings.count() % 2) != 0)
228.4897 +				throw new IllegalArgumentException("Bad binding form, expected matched symbol expression pairs");
228.4898 +
228.4899 +			ISeq body = RT.next(RT.next(form));
228.4900 +
228.4901 +			if(context == C.EVAL
228.4902 +			   || (context == C.EXPRESSION && isLoop))
228.4903 +				return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
228.4904 +
228.4905 +			IPersistentMap dynamicBindings = RT.map(LOCAL_ENV, LOCAL_ENV.deref(),
228.4906 +			                                        NEXT_LOCAL_NUM, NEXT_LOCAL_NUM.deref());
228.4907 +			if(isLoop)
228.4908 +				dynamicBindings = dynamicBindings.assoc(LOOP_LOCALS, null);
228.4909 +
228.4910 +			try
228.4911 +				{
228.4912 +				Var.pushThreadBindings(dynamicBindings);
228.4913 +
228.4914 +				PersistentVector bindingInits = PersistentVector.EMPTY;
228.4915 +				PersistentVector loopLocals = PersistentVector.EMPTY;
228.4916 +				for(int i = 0; i < bindings.count(); i += 2)
228.4917 +					{
228.4918 +					if(!(bindings.nth(i) instanceof Symbol))
228.4919 +						throw new IllegalArgumentException(
228.4920 +								"Bad binding form, expected symbol, got: " + bindings.nth(i));
228.4921 +					Symbol sym = (Symbol) bindings.nth(i);
228.4922 +					if(sym.getNamespace() != null)
228.4923 +						throw new Exception("Can't let qualified name: " + sym);
228.4924 +					Expr init = analyze(C.EXPRESSION, bindings.nth(i + 1), sym.name);
228.4925 +					//sequential enhancement of env (like Lisp let*)
228.4926 +					LocalBinding lb = registerLocal(sym, tagOf(sym), init,false);
228.4927 +					BindingInit bi = new BindingInit(lb, init);
228.4928 +					bindingInits = bindingInits.cons(bi);
228.4929 +
228.4930 +					if(isLoop)
228.4931 +						loopLocals = loopLocals.cons(lb);
228.4932 +					}
228.4933 +				if(isLoop)
228.4934 +					LOOP_LOCALS.set(loopLocals);
228.4935 +                Expr bodyExpr;
228.4936 +                try {
228.4937 +                    if(isLoop)
228.4938 +                        {
228.4939 +                        PathNode root = new PathNode(PATHTYPE.PATH, (PathNode) CLEAR_PATH.get());
228.4940 +                        Var.pushThreadBindings(
228.4941 +                            RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,root),
228.4942 +                                   CLEAR_ROOT, new PathNode(PATHTYPE.PATH,root)));
228.4943 +                        }
228.4944 +                    bodyExpr = (new BodyExpr.Parser()).parse(isLoop ? C.RETURN : context, body);
228.4945 +                    }
228.4946 +                finally{
228.4947 +                    if(isLoop)
228.4948 +                       Var.popThreadBindings();
228.4949 +                    }
228.4950 +				return new LetExpr(bindingInits, bodyExpr,
228.4951 +				                   isLoop);
228.4952 +				}
228.4953 +			finally
228.4954 +				{
228.4955 +				Var.popThreadBindings();
228.4956 +				}
228.4957 +		}
228.4958 +	}
228.4959 +
228.4960 +	public Object eval() throws Exception{
228.4961 +		throw new UnsupportedOperationException("Can't eval let/loop");
228.4962 +	}
228.4963 +
228.4964 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.4965 +		doEmit(context, objx, gen, false);
228.4966 +	}
228.4967 +
228.4968 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.4969 +		doEmit(context, objx, gen, true);
228.4970 +	}
228.4971 +
228.4972 +
228.4973 +	public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUnboxed){
228.4974 +		for(int i = 0; i < bindingInits.count(); i++)
228.4975 +			{
228.4976 +			BindingInit bi = (BindingInit) bindingInits.nth(i);
228.4977 +			Class primc = maybePrimitiveType(bi.init);
228.4978 +			if(primc != null)
228.4979 +				{
228.4980 +				((MaybePrimitiveExpr) bi.init).emitUnboxed(C.EXPRESSION, objx, gen);
228.4981 +				gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ISTORE), bi.binding.idx);
228.4982 +				}
228.4983 +			else
228.4984 +				{
228.4985 +				bi.init.emit(C.EXPRESSION, objx, gen);
228.4986 +				gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx);
228.4987 +				}
228.4988 +			}
228.4989 +		Label loopLabel = gen.mark();
228.4990 +		if(isLoop)
228.4991 +			{
228.4992 +			try
228.4993 +				{
228.4994 +				Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel));
228.4995 +				if(emitUnboxed)
228.4996 +					((MaybePrimitiveExpr)body).emitUnboxed(context, objx, gen);
228.4997 +				else
228.4998 +					body.emit(context, objx, gen);
228.4999 +				}
228.5000 +			finally
228.5001 +				{
228.5002 +				Var.popThreadBindings();
228.5003 +				}
228.5004 +			}
228.5005 +		else
228.5006 +			{
228.5007 +			if(emitUnboxed)
228.5008 +				((MaybePrimitiveExpr)body).emitUnboxed(context, objx, gen);
228.5009 +			else
228.5010 +				body.emit(context, objx, gen);
228.5011 +			}
228.5012 +		Label end = gen.mark();
228.5013 +//		gen.visitLocalVariable("this", "Ljava/lang/Object;", null, loopLabel, end, 0);
228.5014 +		for(ISeq bis = bindingInits.seq(); bis != null; bis = bis.next())
228.5015 +			{
228.5016 +			BindingInit bi = (BindingInit) bis.first();
228.5017 +			String lname = bi.binding.name;
228.5018 +			if(lname.endsWith("__auto__"))
228.5019 +				lname += RT.nextID();
228.5020 +			Class primc = maybePrimitiveType(bi.init);
228.5021 +			if(primc != null)
228.5022 +				gen.visitLocalVariable(lname, Type.getDescriptor(primc), null, loopLabel, end,
228.5023 +				                       bi.binding.idx);
228.5024 +			else
228.5025 +				gen.visitLocalVariable(lname, "Ljava/lang/Object;", null, loopLabel, end, bi.binding.idx);
228.5026 +			}
228.5027 +	}
228.5028 +
228.5029 +	public boolean hasJavaClass() throws Exception{
228.5030 +		return body.hasJavaClass();
228.5031 +	}
228.5032 +
228.5033 +	public Class getJavaClass() throws Exception{
228.5034 +		return body.getJavaClass();
228.5035 +	}
228.5036 +
228.5037 +	public boolean canEmitPrimitive(){
228.5038 +		return body instanceof MaybePrimitiveExpr && ((MaybePrimitiveExpr)body).canEmitPrimitive();
228.5039 +	}
228.5040 +
228.5041 +}
228.5042 +
228.5043 +public static class RecurExpr implements Expr{
228.5044 +	public final IPersistentVector args;
228.5045 +	public final IPersistentVector loopLocals;
228.5046 +
228.5047 +	public RecurExpr(IPersistentVector loopLocals, IPersistentVector args){
228.5048 +		this.loopLocals = loopLocals;
228.5049 +		this.args = args;
228.5050 +	}
228.5051 +
228.5052 +	public Object eval() throws Exception{
228.5053 +		throw new UnsupportedOperationException("Can't eval recur");
228.5054 +	}
228.5055 +
228.5056 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.5057 +		Label loopLabel = (Label) LOOP_LABEL.deref();
228.5058 +		if(loopLabel == null)
228.5059 +			throw new IllegalStateException();
228.5060 +		for(int i = 0; i < loopLocals.count(); i++)
228.5061 +			{
228.5062 +			LocalBinding lb = (LocalBinding) loopLocals.nth(i);
228.5063 +			Expr arg = (Expr) args.nth(i);
228.5064 +			if(lb.getPrimitiveType() != null)
228.5065 +				{
228.5066 +				Class primc = lb.getPrimitiveType();
228.5067 +				try
228.5068 +					{
228.5069 +					if(!(arg instanceof MaybePrimitiveExpr && arg.hasJavaClass() && arg.getJavaClass() == primc))
228.5070 +						throw new IllegalArgumentException("recur arg for primitive local: " +
228.5071 +						                                   lb.name + " must be matching primitive");
228.5072 +					}
228.5073 +				catch(Exception e)
228.5074 +					{
228.5075 +					throw new RuntimeException(e);
228.5076 +					}
228.5077 +				((MaybePrimitiveExpr) arg).emitUnboxed(C.EXPRESSION, objx, gen);
228.5078 +				}
228.5079 +			else
228.5080 +				{
228.5081 +				arg.emit(C.EXPRESSION, objx, gen);
228.5082 +				}
228.5083 +			}
228.5084 +
228.5085 +		for(int i = loopLocals.count() - 1; i >= 0; i--)
228.5086 +			{
228.5087 +			LocalBinding lb = (LocalBinding) loopLocals.nth(i);
228.5088 +			Class primc = lb.getPrimitiveType();
228.5089 +			if(lb.isArg)
228.5090 +				gen.storeArg(lb.idx-1);
228.5091 +			else
228.5092 +				{
228.5093 +				if(primc != null)
228.5094 +					gen.visitVarInsn(Type.getType(primc).getOpcode(Opcodes.ISTORE), lb.idx);
228.5095 +				else
228.5096 +					gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), lb.idx);
228.5097 +				}
228.5098 +			}
228.5099 +
228.5100 +		gen.goTo(loopLabel);
228.5101 +	}
228.5102 +
228.5103 +	public boolean hasJavaClass() throws Exception{
228.5104 +		return true;
228.5105 +	}
228.5106 +
228.5107 +	public Class getJavaClass() throws Exception{
228.5108 +		return null;
228.5109 +	}
228.5110 +
228.5111 +	static class Parser implements IParser{
228.5112 +		public Expr parse(C context, Object frm) throws Exception{
228.5113 +			ISeq form = (ISeq) frm;
228.5114 +			IPersistentVector loopLocals = (IPersistentVector) LOOP_LOCALS.deref();
228.5115 +			if(context != C.RETURN || loopLocals == null)
228.5116 +				throw new UnsupportedOperationException("Can only recur from tail position");
228.5117 +			if(IN_CATCH_FINALLY.deref() != null)
228.5118 +				throw new UnsupportedOperationException("Cannot recur from catch/finally");
228.5119 +			PersistentVector args = PersistentVector.EMPTY;
228.5120 +			for(ISeq s = RT.seq(form.next()); s != null; s = s.next())
228.5121 +				{
228.5122 +				args = args.cons(analyze(C.EXPRESSION, s.first()));
228.5123 +				}
228.5124 +			if(args.count() != loopLocals.count())
228.5125 +				throw new IllegalArgumentException(
228.5126 +						String.format("Mismatched argument count to recur, expected: %d args, got: %d",
228.5127 +						              loopLocals.count(), args.count()));
228.5128 +			return new RecurExpr(loopLocals, args);
228.5129 +		}
228.5130 +	}
228.5131 +}
228.5132 +
228.5133 +private static LocalBinding registerLocal(Symbol sym, Symbol tag, Expr init, boolean isArg) throws Exception{
228.5134 +	int num = getAndIncLocalNum();
228.5135 +	LocalBinding b = new LocalBinding(num, sym, tag, init, isArg, clearPathRoot());
228.5136 +	IPersistentMap localsMap = (IPersistentMap) LOCAL_ENV.deref();
228.5137 +	LOCAL_ENV.set(RT.assoc(localsMap, b.sym, b));
228.5138 +	ObjMethod method = (ObjMethod) METHOD.deref();
228.5139 +	method.locals = (IPersistentMap) RT.assoc(method.locals, b, b);
228.5140 +	method.indexlocals = (IPersistentMap) RT.assoc(method.indexlocals, num, b);
228.5141 +	return b;
228.5142 +}
228.5143 +
228.5144 +private static int getAndIncLocalNum(){
228.5145 +	int num = ((Number) NEXT_LOCAL_NUM.deref()).intValue();
228.5146 +	ObjMethod m = (ObjMethod) METHOD.deref();
228.5147 +	if(num > m.maxLocal)
228.5148 +		m.maxLocal = num;
228.5149 +	NEXT_LOCAL_NUM.set(num + 1);
228.5150 +	return num;
228.5151 +}
228.5152 +
228.5153 +public static Expr analyze(C context, Object form) throws Exception{
228.5154 +	return analyze(context, form, null);
228.5155 +}
228.5156 +
228.5157 +private static Expr analyze(C context, Object form, String name) throws Exception{
228.5158 +	//todo symbol macro expansion?
228.5159 +	try
228.5160 +		{
228.5161 +		if(form instanceof LazySeq)
228.5162 +			{
228.5163 +			form = RT.seq(form);
228.5164 +			if(form == null)
228.5165 +				form = PersistentList.EMPTY;
228.5166 +			}
228.5167 +		if(form == null)
228.5168 +			return NIL_EXPR;
228.5169 +		else if(form == Boolean.TRUE)
228.5170 +			return TRUE_EXPR;
228.5171 +		else if(form == Boolean.FALSE)
228.5172 +				return FALSE_EXPR;
228.5173 +		Class fclass = form.getClass();
228.5174 +		if(fclass == Symbol.class)
228.5175 +			return analyzeSymbol((Symbol) form);
228.5176 +		else if(fclass == Keyword.class)
228.5177 +			return registerKeyword((Keyword) form);
228.5178 +//	else if(form instanceof Num)
228.5179 +//		return new NumExpr((Num) form);
228.5180 +		else if(fclass == String.class)
228.5181 +				return new StringExpr(((String) form).intern());
228.5182 +//	else if(fclass == Character.class)
228.5183 +//		return new CharExpr((Character) form);
228.5184 +			else if(form instanceof IPersistentCollection && ((IPersistentCollection) form).count() == 0)
228.5185 +					{
228.5186 +					Expr ret = new EmptyExpr(form);
228.5187 +					if(RT.meta(form) != null)
228.5188 +						ret = new MetaExpr(ret, (MapExpr) MapExpr
228.5189 +								.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) form).meta()));
228.5190 +					return ret;
228.5191 +					}
228.5192 +				else if(form instanceof ISeq)
228.5193 +						return analyzeSeq(context, (ISeq) form, name);
228.5194 +					else if(form instanceof IPersistentVector)
228.5195 +							return VectorExpr.parse(context, (IPersistentVector) form);
228.5196 +						else if(form instanceof IPersistentMap)
228.5197 +								return MapExpr.parse(context, (IPersistentMap) form);
228.5198 +							else if(form instanceof IPersistentSet)
228.5199 +									return SetExpr.parse(context, (IPersistentSet) form);
228.5200 +
228.5201 +//	else
228.5202 +		//throw new UnsupportedOperationException();
228.5203 +		return new ConstantExpr(form);
228.5204 +		}
228.5205 +	catch(Throwable e)
228.5206 +		{
228.5207 +		if(!(e instanceof CompilerException))
228.5208 +			throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e);
228.5209 +		else
228.5210 +			throw (CompilerException) e;
228.5211 +		}
228.5212 +}
228.5213 +
228.5214 +static public class CompilerException extends Exception{
228.5215 +
228.5216 +	public CompilerException(String source, int line, Throwable cause){
228.5217 +		super(errorMsg(source, line, cause.toString()), cause);
228.5218 +	}
228.5219 +
228.5220 +	public String toString(){
228.5221 +		return getMessage();
228.5222 +	}
228.5223 +}
228.5224 +
228.5225 +static public Var isMacro(Object op) throws Exception{
228.5226 +	//no local macros for now
228.5227 +	if(op instanceof Symbol && referenceLocal((Symbol) op) != null)
228.5228 +		return null;
228.5229 +	if(op instanceof Symbol || op instanceof Var)
228.5230 +		{
228.5231 +		Var v = (op instanceof Var) ? (Var) op : lookupVar((Symbol) op, false);
228.5232 +		if(v != null && v.isMacro())
228.5233 +			{
228.5234 +			if(v.ns != currentNS() && !v.isPublic())
228.5235 +				throw new IllegalStateException("var: " + v + " is not public");
228.5236 +			return v;
228.5237 +			}
228.5238 +		}
228.5239 +	return null;
228.5240 +}
228.5241 +
228.5242 +static public IFn isInline(Object op, int arity) throws Exception{
228.5243 +	//no local inlines for now
228.5244 +	if(op instanceof Symbol && referenceLocal((Symbol) op) != null)
228.5245 +		return null;
228.5246 +	if(op instanceof Symbol || op instanceof Var)
228.5247 +		{
228.5248 +		Var v = (op instanceof Var) ? (Var) op : lookupVar((Symbol) op, false);
228.5249 +		if(v != null)
228.5250 +			{
228.5251 +			if(v.ns != currentNS() && !v.isPublic())
228.5252 +				throw new IllegalStateException("var: " + v + " is not public");
228.5253 +			IFn ret = (IFn) RT.get(v.meta(), inlineKey);
228.5254 +			if(ret != null)
228.5255 +				{
228.5256 +				IFn arityPred = (IFn) RT.get(v.meta(), inlineAritiesKey);
228.5257 +				if(arityPred == null || RT.booleanCast(arityPred.invoke(arity)))
228.5258 +					return ret;
228.5259 +				}
228.5260 +			}
228.5261 +		}
228.5262 +	return null;
228.5263 +}
228.5264 +
228.5265 +public static boolean namesStaticMember(Symbol sym){
228.5266 +	return sym.ns != null && namespaceFor(sym) == null;
228.5267 +}
228.5268 +
228.5269 +public static Object preserveTag(ISeq src, Object dst) {
228.5270 +	Symbol tag = tagOf(src);
228.5271 +	if (tag != null && dst instanceof IObj) {
228.5272 +		IPersistentMap meta = RT.meta(dst);
228.5273 +		return ((IObj) dst).withMeta((IPersistentMap) RT.assoc(meta, RT.TAG_KEY, tag));
228.5274 +	}
228.5275 +	return dst;
228.5276 +}
228.5277 +
228.5278 +public static Object macroexpand1(Object x) throws Exception{
228.5279 +	if(x instanceof ISeq)
228.5280 +		{
228.5281 +		ISeq form = (ISeq) x;
228.5282 +		Object op = RT.first(form);
228.5283 +		if(isSpecial(op))
228.5284 +			return x;
228.5285 +		//macro expansion
228.5286 +		Var v = isMacro(op);
228.5287 +		if(v != null)
228.5288 +			{
228.5289 +			return v.applyTo(RT.cons(form,RT.cons(LOCAL_ENV.get(),form.next())));
228.5290 +			}
228.5291 +		else
228.5292 +			{
228.5293 +			if(op instanceof Symbol)
228.5294 +				{
228.5295 +				Symbol sym = (Symbol) op;
228.5296 +				String sname = sym.name;
228.5297 +				//(.substring s 2 5) => (. s substring 2 5)
228.5298 +				if(sym.name.charAt(0) == '.')
228.5299 +					{
228.5300 +					if(RT.length(form) < 2)
228.5301 +						throw new IllegalArgumentException(
228.5302 +								"Malformed member expression, expecting (.member target ...)");
228.5303 +					Symbol meth = Symbol.intern(sname.substring(1));
228.5304 +					Object target = RT.second(form);
228.5305 +					if(HostExpr.maybeClass(target, false) != null)
228.5306 +						{
228.5307 +						target = ((IObj)RT.list(IDENTITY, target)).withMeta(RT.map(RT.TAG_KEY,CLASS));
228.5308 +						}
228.5309 +					return preserveTag(form, RT.listStar(DOT, target, meth, form.next().next()));
228.5310 +					}
228.5311 +				else if(namesStaticMember(sym))
228.5312 +					{
228.5313 +					Symbol target = Symbol.intern(sym.ns);
228.5314 +					Class c = HostExpr.maybeClass(target, false);
228.5315 +					if(c != null)
228.5316 +						{
228.5317 +						Symbol meth = Symbol.intern(sym.name);
228.5318 +						return preserveTag(form, RT.listStar(DOT, target, meth, form.next()));
228.5319 +						}
228.5320 +					}
228.5321 +				else
228.5322 +					{
228.5323 +					//(s.substring 2 5) => (. s substring 2 5)
228.5324 +					//also (package.class.name ...) (. package.class name ...)
228.5325 +					int idx = sname.lastIndexOf('.');
228.5326 +//					if(idx > 0 && idx < sname.length() - 1)
228.5327 +//						{
228.5328 +//						Symbol target = Symbol.intern(sname.substring(0, idx));
228.5329 +//						Symbol meth = Symbol.intern(sname.substring(idx + 1));
228.5330 +//						return RT.listStar(DOT, target, meth, form.rest());
228.5331 +//						}
228.5332 +					//(StringBuilder. "foo") => (new StringBuilder "foo")	
228.5333 +					//else 
228.5334 +					if(idx == sname.length() - 1)
228.5335 +						return RT.listStar(NEW, Symbol.intern(sname.substring(0, idx)), form.next());
228.5336 +					}
228.5337 +				}
228.5338 +			}
228.5339 +		}
228.5340 +	return x;
228.5341 +}
228.5342 +
228.5343 +static Object macroexpand(Object form) throws Exception{
228.5344 +	Object exf = macroexpand1(form);
228.5345 +	if(exf != form)
228.5346 +		return macroexpand(exf);
228.5347 +	return form;
228.5348 +}
228.5349 +
228.5350 +private static Expr analyzeSeq(C context, ISeq form, String name) throws Exception{
228.5351 +	Integer line = (Integer) LINE.deref();
228.5352 +	if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY))
228.5353 +		line = (Integer) RT.meta(form).valAt(RT.LINE_KEY);
228.5354 +	Var.pushThreadBindings(
228.5355 +			RT.map(LINE, line));
228.5356 +	try
228.5357 +		{
228.5358 +		Object me = macroexpand1(form);
228.5359 +		if(me != form)
228.5360 +			return analyze(context, me, name);
228.5361 +
228.5362 +		Object op = RT.first(form);
228.5363 +		if(op == null)
228.5364 +			throw new IllegalArgumentException("Can't call nil");
228.5365 +		IFn inline = isInline(op, RT.count(RT.next(form)));
228.5366 +		if(inline != null)
228.5367 +			return analyze(context, preserveTag(form, inline.applyTo(RT.next(form))));
228.5368 +		IParser p;
228.5369 +		if(op.equals(FN))
228.5370 +			return FnExpr.parse(context, form, name);
228.5371 +		else if((p = (IParser) specials.valAt(op)) != null)
228.5372 +			return p.parse(context, form);
228.5373 +		else
228.5374 +			return InvokeExpr.parse(context, form);
228.5375 +		}
228.5376 +	catch(Throwable e)
228.5377 +		{
228.5378 +		if(!(e instanceof CompilerException))
228.5379 +			throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e);
228.5380 +		else
228.5381 +			throw (CompilerException) e;
228.5382 +		}
228.5383 +	finally
228.5384 +		{
228.5385 +		Var.popThreadBindings();
228.5386 +		}
228.5387 +}
228.5388 +
228.5389 +static String errorMsg(String source, int line, String s){
228.5390 +	return String.format("%s (%s:%d)", s, source, line);
228.5391 +}
228.5392 +
228.5393 +public static Object eval(Object form) throws Exception{
228.5394 +	return eval(form, true);
228.5395 +}
228.5396 +
228.5397 +public static Object eval(Object form, boolean freshLoader) throws Exception{
228.5398 +	boolean createdLoader = false;
228.5399 +	if(true)//!LOADER.isBound())
228.5400 +		{
228.5401 +		Var.pushThreadBindings(RT.map(LOADER, RT.makeClassLoader()));
228.5402 +		createdLoader = true;
228.5403 +		}
228.5404 +	try
228.5405 +		{
228.5406 +		Integer line = (Integer) LINE.deref();
228.5407 +		if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY))
228.5408 +			line = (Integer) RT.meta(form).valAt(RT.LINE_KEY);
228.5409 +		Var.pushThreadBindings(RT.map(LINE, line));
228.5410 +		try
228.5411 +			{
228.5412 +			form = macroexpand(form);
228.5413 +			if(form instanceof IPersistentCollection && Util.equals(RT.first(form), DO))
228.5414 +				{
228.5415 +				ISeq s = RT.next(form);
228.5416 +				for(; RT.next(s) != null; s = RT.next(s))
228.5417 +					eval(RT.first(s),false);
228.5418 +				return eval(RT.first(s),false);
228.5419 +				}
228.5420 +			else if(form instanceof IPersistentCollection
228.5421 +			        && !(RT.first(form) instanceof Symbol
228.5422 +			             && ((Symbol) RT.first(form)).name.startsWith("def")))
228.5423 +				{
228.5424 +				ObjExpr fexpr = (ObjExpr) analyze(C.EXPRESSION, RT.list(FN, PersistentVector.EMPTY, form),
228.5425 +				                                  "eval" + RT.nextID());
228.5426 +				IFn fn = (IFn) fexpr.eval();
228.5427 +				return fn.invoke();
228.5428 +				}
228.5429 +			else
228.5430 +				{
228.5431 +				Expr expr = analyze(C.EVAL, form);
228.5432 +				return expr.eval();
228.5433 +				}
228.5434 +			}
228.5435 +		finally
228.5436 +			{
228.5437 +			Var.popThreadBindings();
228.5438 +			}
228.5439 +		}
228.5440 +	catch(Throwable e)
228.5441 +		{
228.5442 +		if(!(e instanceof CompilerException))
228.5443 +			throw new CompilerException((String) SOURCE.deref(), (Integer) LINE.deref(), e);
228.5444 +		else
228.5445 +			throw (CompilerException) e;
228.5446 +		}
228.5447 +	finally
228.5448 +		{
228.5449 +		if(createdLoader)
228.5450 +			Var.popThreadBindings();
228.5451 +		}
228.5452 +}
228.5453 +
228.5454 +private static int registerConstant(Object o){
228.5455 +	if(!CONSTANTS.isBound())
228.5456 +		return -1;
228.5457 +	PersistentVector v = (PersistentVector) CONSTANTS.deref();
228.5458 +	IdentityHashMap<Object,Integer> ids = (IdentityHashMap<Object,Integer>) CONSTANT_IDS.deref();
228.5459 +	Integer i = ids.get(o);
228.5460 +	if(i != null)
228.5461 +		return i;
228.5462 +	CONSTANTS.set(RT.conj(v, o));
228.5463 +	ids.put(o, v.count());
228.5464 +	return v.count();
228.5465 +}
228.5466 +
228.5467 +private static KeywordExpr registerKeyword(Keyword keyword){
228.5468 +	if(!KEYWORDS.isBound())
228.5469 +		return new KeywordExpr(keyword);
228.5470 +
228.5471 +	IPersistentMap keywordsMap = (IPersistentMap) KEYWORDS.deref();
228.5472 +	Object id = RT.get(keywordsMap, keyword);
228.5473 +	if(id == null)
228.5474 +		{
228.5475 +		KEYWORDS.set(RT.assoc(keywordsMap, keyword, registerConstant(keyword)));
228.5476 +		}
228.5477 +	return new KeywordExpr(keyword);
228.5478 +//	KeywordExpr ke = (KeywordExpr) RT.get(keywordsMap, keyword);
228.5479 +//	if(ke == null)
228.5480 +//		KEYWORDS.set(RT.assoc(keywordsMap, keyword, ke = new KeywordExpr(keyword)));
228.5481 +//	return ke;
228.5482 +}
228.5483 +
228.5484 +private static int registerKeywordCallsite(Keyword keyword){
228.5485 +	if(!KEYWORD_CALLSITES.isBound())
228.5486 +		throw new IllegalAccessError("KEYWORD_CALLSITES is not bound");
228.5487 +
228.5488 +	IPersistentVector keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref();
228.5489 +
228.5490 +	keywordCallsites = keywordCallsites.cons(keyword);
228.5491 +	KEYWORD_CALLSITES.set(keywordCallsites);
228.5492 +	return keywordCallsites.count()-1;
228.5493 +}
228.5494 +
228.5495 +private static int registerProtocolCallsite(Var v){
228.5496 +	if(!PROTOCOL_CALLSITES.isBound())
228.5497 +		throw new IllegalAccessError("PROTOCOL_CALLSITES is not bound");
228.5498 +
228.5499 +	IPersistentVector protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref();
228.5500 +
228.5501 +	protocolCallsites = protocolCallsites.cons(v);
228.5502 +	PROTOCOL_CALLSITES.set(protocolCallsites);
228.5503 +	return protocolCallsites.count()-1;
228.5504 +}
228.5505 +
228.5506 +private static int registerVarCallsite(Var v){
228.5507 +	if(!VAR_CALLSITES.isBound())
228.5508 +		throw new IllegalAccessError("VAR_CALLSITES is not bound");
228.5509 +
228.5510 +	IPersistentVector varCallsites = (IPersistentVector) VAR_CALLSITES.deref();
228.5511 +
228.5512 +	varCallsites = varCallsites.cons(v);
228.5513 +	VAR_CALLSITES.set(varCallsites);
228.5514 +	return varCallsites.count()-1;
228.5515 +}
228.5516 +
228.5517 +static ISeq fwdPath(PathNode p1){
228.5518 +    ISeq ret = null;
228.5519 +    for(;p1 != null;p1 = p1.parent)
228.5520 +        ret = RT.cons(p1,ret);
228.5521 +    return ret;
228.5522 +}
228.5523 +
228.5524 +static PathNode commonPath(PathNode n1, PathNode n2){
228.5525 +    ISeq xp = fwdPath(n1);
228.5526 +    ISeq yp = fwdPath(n2);
228.5527 +    if(RT.first(xp) != RT.first(yp))
228.5528 +        return null;
228.5529 +    while(RT.second(xp) != null && RT.second(xp) == RT.second(yp))
228.5530 +        {
228.5531 +        xp = xp.next();
228.5532 +        yp = yp.next();
228.5533 +        }
228.5534 +    return (PathNode) RT.first(xp);
228.5535 +}
228.5536 +
228.5537 +static void addAnnotation(Object visitor, IPersistentMap meta){
228.5538 +	try{
228.5539 +	if(meta != null && ADD_ANNOTATIONS.isBound())
228.5540 +		 ADD_ANNOTATIONS.invoke(visitor, meta);
228.5541 +	}
228.5542 +	catch (Exception e)
228.5543 +		{
228.5544 +		throw new RuntimeException(e);
228.5545 +		}
228.5546 +}
228.5547 +
228.5548 +static void addParameterAnnotation(Object visitor, IPersistentMap meta, int i){
228.5549 +	try{
228.5550 +	if(meta != null && ADD_ANNOTATIONS.isBound())
228.5551 +		 ADD_ANNOTATIONS.invoke(visitor, meta, i);
228.5552 +	}
228.5553 +	catch (Exception e)
228.5554 +		{
228.5555 +		throw new RuntimeException(e);
228.5556 +		}
228.5557 +}
228.5558 +
228.5559 +private static Expr analyzeSymbol(Symbol sym) throws Exception{
228.5560 +	Symbol tag = tagOf(sym);
228.5561 +	if(sym.ns == null) //ns-qualified syms are always Vars
228.5562 +		{
228.5563 +		LocalBinding b = referenceLocal(sym);
228.5564 +		if(b != null)
228.5565 +            {
228.5566 +            return new LocalBindingExpr(b, tag);
228.5567 +            }
228.5568 +		}
228.5569 +	else
228.5570 +		{
228.5571 +		if(namespaceFor(sym) == null)
228.5572 +			{
228.5573 +			Symbol nsSym = Symbol.create(sym.ns);
228.5574 +			Class c = HostExpr.maybeClass(nsSym, false);
228.5575 +			if(c != null)
228.5576 +				{
228.5577 +				if(Reflector.getField(c, sym.name, true) != null)
228.5578 +					return new StaticFieldExpr((Integer) LINE.deref(), c, sym.name, tag);
228.5579 +				throw new Exception("Unable to find static field: " + sym.name + " in " + c);
228.5580 +				}
228.5581 +			}
228.5582 +		}
228.5583 +	//Var v = lookupVar(sym, false);
228.5584 +//	Var v = lookupVar(sym, false);
228.5585 +//	if(v != null)
228.5586 +//		return new VarExpr(v, tag);
228.5587 +	Object o = resolve(sym);
228.5588 +	if(o instanceof Var)
228.5589 +		{
228.5590 +		Var v = (Var) o;
228.5591 +		if(isMacro(v) != null)
228.5592 +			throw new Exception("Can't take value of a macro: " + v);
228.5593 +		registerVar(v);
228.5594 +		return new VarExpr(v, tag);
228.5595 +		}
228.5596 +	else if(o instanceof Class)
228.5597 +		return new ConstantExpr(o);
228.5598 +	else if(o instanceof Symbol)
228.5599 +			return new UnresolvedVarExpr((Symbol) o);
228.5600 +
228.5601 +	throw new Exception("Unable to resolve symbol: " + sym + " in this context");
228.5602 +
228.5603 +}
228.5604 +
228.5605 +static String destubClassName(String className){
228.5606 +	//skip over prefix + '.' or '/'
228.5607 +	if(className.startsWith(COMPILE_STUB_PREFIX))
228.5608 +		return className.substring(COMPILE_STUB_PREFIX.length()+1);
228.5609 +	return className;
228.5610 +}
228.5611 +
228.5612 +static Type getType(Class c){
228.5613 +	String descriptor = Type.getType(c).getDescriptor();
228.5614 +	if(descriptor.startsWith("L"))
228.5615 +		descriptor = "L" + destubClassName(descriptor.substring(1));
228.5616 +	return Type.getType(descriptor);
228.5617 +}
228.5618 +
228.5619 +static Object resolve(Symbol sym, boolean allowPrivate) throws Exception{
228.5620 +	return resolveIn(currentNS(), sym, allowPrivate);
228.5621 +}
228.5622 +
228.5623 +static Object resolve(Symbol sym) throws Exception{
228.5624 +	return resolveIn(currentNS(), sym, false);
228.5625 +}
228.5626 +
228.5627 +static Namespace namespaceFor(Symbol sym){
228.5628 +	return namespaceFor(currentNS(), sym);
228.5629 +}
228.5630 +
228.5631 +static Namespace namespaceFor(Namespace inns, Symbol sym){
228.5632 +	//note, presumes non-nil sym.ns
228.5633 +	// first check against currentNS' aliases...
228.5634 +	Symbol nsSym = Symbol.create(sym.ns);
228.5635 +	Namespace ns = inns.lookupAlias(nsSym);
228.5636 +	if(ns == null)
228.5637 +		{
228.5638 +		// ...otherwise check the Namespaces map.
228.5639 +		ns = Namespace.find(nsSym);
228.5640 +		}
228.5641 +	return ns;
228.5642 +}
228.5643 +
228.5644 +static public Object resolveIn(Namespace n, Symbol sym, boolean allowPrivate) throws Exception{
228.5645 +	//note - ns-qualified vars must already exist
228.5646 +	if(sym.ns != null)
228.5647 +		{
228.5648 +		Namespace ns = namespaceFor(n, sym);
228.5649 +		if(ns == null)
228.5650 +			throw new Exception("No such namespace: " + sym.ns);
228.5651 +
228.5652 +		Var v = ns.findInternedVar(Symbol.create(sym.name));
228.5653 +		if(v == null)
228.5654 +			throw new Exception("No such var: " + sym);
228.5655 +		else if(v.ns != currentNS() && !v.isPublic() && !allowPrivate)
228.5656 +			throw new IllegalStateException("var: " + sym + " is not public");
228.5657 +		return v;
228.5658 +		}
228.5659 +	else if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[')
228.5660 +		{
228.5661 +		return RT.classForName(sym.name);
228.5662 +		}
228.5663 +	else if(sym.equals(NS))
228.5664 +			return RT.NS_VAR;
228.5665 +		else if(sym.equals(IN_NS))
228.5666 +				return RT.IN_NS_VAR;
228.5667 +			else
228.5668 +				{
228.5669 +				if(Util.equals(sym,COMPILE_STUB_SYM.get()))
228.5670 +					return COMPILE_STUB_CLASS.get();
228.5671 +				Object o = n.getMapping(sym);
228.5672 +				if(o == null)
228.5673 +					{
228.5674 +					if(RT.booleanCast(RT.ALLOW_UNRESOLVED_VARS.deref()))
228.5675 +						{
228.5676 +						return sym;
228.5677 +						}
228.5678 +					else
228.5679 +						{
228.5680 +						throw new Exception("Unable to resolve symbol: " + sym + " in this context");
228.5681 +						}
228.5682 +					}
228.5683 +				return o;
228.5684 +				}
228.5685 +}
228.5686 +
228.5687 +
228.5688 +static public Object maybeResolveIn(Namespace n, Symbol sym) throws Exception{
228.5689 +	//note - ns-qualified vars must already exist
228.5690 +	if(sym.ns != null)
228.5691 +		{
228.5692 +		Namespace ns = namespaceFor(n, sym);
228.5693 +		if(ns == null)
228.5694 +			return null;
228.5695 +		Var v = ns.findInternedVar(Symbol.create(sym.name));
228.5696 +		if(v == null)
228.5697 +			return null;
228.5698 +		return v;
228.5699 +		}
228.5700 +	else if(sym.name.indexOf('.') > 0 && !sym.name.endsWith(".") 
228.5701 +			|| sym.name.charAt(0) == '[')
228.5702 +		{
228.5703 +		return RT.classForName(sym.name);
228.5704 +		}
228.5705 +	else if(sym.equals(NS))
228.5706 +			return RT.NS_VAR;
228.5707 +		else if(sym.equals(IN_NS))
228.5708 +				return RT.IN_NS_VAR;
228.5709 +			else
228.5710 +				{
228.5711 +				Object o = n.getMapping(sym);
228.5712 +				return o;
228.5713 +				}
228.5714 +}
228.5715 +
228.5716 +
228.5717 +static Var lookupVar(Symbol sym, boolean internNew) throws Exception{
228.5718 +	Var var = null;
228.5719 +
228.5720 +	//note - ns-qualified vars in other namespaces must already exist
228.5721 +	if(sym.ns != null)
228.5722 +		{
228.5723 +		Namespace ns = namespaceFor(sym);
228.5724 +		if(ns == null)
228.5725 +			return null;
228.5726 +		//throw new Exception("No such namespace: " + sym.ns);
228.5727 +		Symbol name = Symbol.create(sym.name);
228.5728 +		if(internNew && ns == currentNS())
228.5729 +			var = currentNS().intern(name);
228.5730 +		else
228.5731 +			var = ns.findInternedVar(name);
228.5732 +		}
228.5733 +	else if(sym.equals(NS))
228.5734 +		var = RT.NS_VAR;
228.5735 +	else if(sym.equals(IN_NS))
228.5736 +			var = RT.IN_NS_VAR;
228.5737 +		else
228.5738 +			{
228.5739 +			//is it mapped?
228.5740 +			Object o = currentNS().getMapping(sym);
228.5741 +			if(o == null)
228.5742 +				{
228.5743 +				//introduce a new var in the current ns
228.5744 +				if(internNew)
228.5745 +					var = currentNS().intern(Symbol.create(sym.name));
228.5746 +				}
228.5747 +			else if(o instanceof Var)
228.5748 +				{
228.5749 +				var = (Var) o;
228.5750 +				}
228.5751 +			else
228.5752 +				{
228.5753 +				throw new Exception("Expecting var, but " + sym + " is mapped to " + o);
228.5754 +				}
228.5755 +			}
228.5756 +	if(var != null)
228.5757 +		registerVar(var);
228.5758 +	return var;
228.5759 +}
228.5760 +
228.5761 +private static void registerVar(Var var) throws Exception{
228.5762 +	if(!VARS.isBound())
228.5763 +		return;
228.5764 +	IPersistentMap varsMap = (IPersistentMap) VARS.deref();
228.5765 +	Object id = RT.get(varsMap, var);
228.5766 +	if(id == null)
228.5767 +		{
228.5768 +		VARS.set(RT.assoc(varsMap, var, registerConstant(var)));
228.5769 +		}
228.5770 +//	if(varsMap != null && RT.get(varsMap, var) == null)
228.5771 +//		VARS.set(RT.assoc(varsMap, var, var));
228.5772 +}
228.5773 +
228.5774 +static Namespace currentNS(){
228.5775 +	return (Namespace) RT.CURRENT_NS.deref();
228.5776 +}
228.5777 +
228.5778 +static void closeOver(LocalBinding b, ObjMethod method){
228.5779 +	if(b != null && method != null)
228.5780 +		{
228.5781 +		if(RT.get(method.locals, b) == null)
228.5782 +			{
228.5783 +			method.objx.closes = (IPersistentMap) RT.assoc(method.objx.closes, b, b);
228.5784 +			closeOver(b, method.parent);
228.5785 +			}
228.5786 +		else if(IN_CATCH_FINALLY.deref() != null)
228.5787 +			{
228.5788 +			method.localsUsedInCatchFinally = (PersistentHashSet) method.localsUsedInCatchFinally.cons(b.idx);
228.5789 +			}
228.5790 +		}
228.5791 +}
228.5792 +
228.5793 +
228.5794 +static LocalBinding referenceLocal(Symbol sym) throws Exception{
228.5795 +	if(!LOCAL_ENV.isBound())
228.5796 +		return null;
228.5797 +	LocalBinding b = (LocalBinding) RT.get(LOCAL_ENV.deref(), sym);
228.5798 +	if(b != null)
228.5799 +		{
228.5800 +		ObjMethod method = (ObjMethod) METHOD.deref();
228.5801 +		closeOver(b, method);
228.5802 +		}
228.5803 +	return b;
228.5804 +}
228.5805 +
228.5806 +private static Symbol tagOf(Object o){
228.5807 +	Object tag = RT.get(RT.meta(o), RT.TAG_KEY);
228.5808 +	if(tag instanceof Symbol)
228.5809 +		return (Symbol) tag;
228.5810 +	else if(tag instanceof String)
228.5811 +		return Symbol.intern(null, (String) tag);
228.5812 +	return null;
228.5813 +}
228.5814 +
228.5815 +public static Object loadFile(String file) throws Exception{
228.5816 +//	File fo = new File(file);
228.5817 +//	if(!fo.exists())
228.5818 +//		return null;
228.5819 +
228.5820 +	FileInputStream f = new FileInputStream(file);
228.5821 +	try
228.5822 +		{
228.5823 +		return load(new InputStreamReader(f, RT.UTF8), new File(file).getAbsolutePath(), (new File(file)).getName());
228.5824 +		}
228.5825 +	finally
228.5826 +		{
228.5827 +		f.close();
228.5828 +		}
228.5829 +}
228.5830 +
228.5831 +public static Object load(Reader rdr) throws Exception{
228.5832 +	return load(rdr, null, "NO_SOURCE_FILE");
228.5833 +}
228.5834 +
228.5835 +public static Object load(Reader rdr, String sourcePath, String sourceName) throws Exception{
228.5836 +	Object EOF = new Object();
228.5837 +	Object ret = null;
228.5838 +	LineNumberingPushbackReader pushbackReader =
228.5839 +			(rdr instanceof LineNumberingPushbackReader) ? (LineNumberingPushbackReader) rdr :
228.5840 +			new LineNumberingPushbackReader(rdr);
228.5841 +	Var.pushThreadBindings(
228.5842 +			RT.map(LOADER, RT.makeClassLoader(),
228.5843 +			       SOURCE_PATH, sourcePath,
228.5844 +			       SOURCE, sourceName,
228.5845 +			       METHOD, null,
228.5846 +			       LOCAL_ENV, null,
228.5847 +					LOOP_LOCALS, null,
228.5848 +					NEXT_LOCAL_NUM, 0,
228.5849 +			       RT.CURRENT_NS, RT.CURRENT_NS.deref(),
228.5850 +			       LINE_BEFORE, pushbackReader.getLineNumber(),
228.5851 +			       LINE_AFTER, pushbackReader.getLineNumber()
228.5852 +			));
228.5853 +
228.5854 +	try
228.5855 +		{
228.5856 +		for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF;
228.5857 +		    r = LispReader.read(pushbackReader, false, EOF, false))
228.5858 +			{
228.5859 +			LINE_AFTER.set(pushbackReader.getLineNumber());
228.5860 +			ret = eval(r,false);
228.5861 +			LINE_BEFORE.set(pushbackReader.getLineNumber());
228.5862 +			}
228.5863 +		}
228.5864 +	catch(LispReader.ReaderException e)
228.5865 +		{
228.5866 +		throw new CompilerException(sourceName, e.line, e.getCause());
228.5867 +		}
228.5868 +	finally
228.5869 +		{
228.5870 +		Var.popThreadBindings();
228.5871 +		}
228.5872 +	return ret;
228.5873 +}
228.5874 +
228.5875 +static public void writeClassFile(String internalName, byte[] bytecode) throws Exception{
228.5876 +	String genPath = (String) COMPILE_PATH.deref();
228.5877 +	if(genPath == null)
228.5878 +		throw new Exception("*compile-path* not set");
228.5879 +	String[] dirs = internalName.split("/");
228.5880 +	String p = genPath;
228.5881 +	for(int i = 0; i < dirs.length - 1; i++)
228.5882 +		{
228.5883 +		p += File.separator + dirs[i];
228.5884 +		(new File(p)).mkdir();
228.5885 +		}
228.5886 +	String path = genPath + File.separator + internalName + ".class";
228.5887 +	File cf = new File(path);
228.5888 +	cf.createNewFile();
228.5889 +	FileOutputStream cfs = new FileOutputStream(cf);
228.5890 +	try
228.5891 +		{
228.5892 +		cfs.write(bytecode);
228.5893 +		cfs.flush();
228.5894 +		cfs.getFD().sync();
228.5895 +		}
228.5896 +	finally
228.5897 +		{
228.5898 +		cfs.close();
228.5899 +		}
228.5900 +}
228.5901 +
228.5902 +public static void pushNS(){
228.5903 +	Var.pushThreadBindings(PersistentHashMap.create(Var.intern(Symbol.create("clojure.core"),
228.5904 +	                                                           Symbol.create("*ns*")), null));
228.5905 +}
228.5906 +
228.5907 +public static ILookupThunk getLookupThunk(Object target, Keyword k){
228.5908 +	return null;  //To change body of created methods use File | Settings | File Templates.
228.5909 +}
228.5910 +
228.5911 +static void compile1(GeneratorAdapter gen, ObjExpr objx, Object form) throws Exception{
228.5912 +	Integer line = (Integer) LINE.deref();
228.5913 +	if(RT.meta(form) != null && RT.meta(form).containsKey(RT.LINE_KEY))
228.5914 +		line = (Integer) RT.meta(form).valAt(RT.LINE_KEY);
228.5915 +	Var.pushThreadBindings(
228.5916 +			RT.map(LINE, line
228.5917 +			       ,LOADER, RT.makeClassLoader()
228.5918 +			));
228.5919 +	try
228.5920 +		{
228.5921 +		form = macroexpand(form);
228.5922 +		if(form instanceof IPersistentCollection && Util.equals(RT.first(form), DO))
228.5923 +			{
228.5924 +			for(ISeq s = RT.next(form); s != null; s = RT.next(s))
228.5925 +				{
228.5926 +				compile1(gen, objx, RT.first(s));
228.5927 +				}
228.5928 +			}
228.5929 +		else
228.5930 +			{
228.5931 +			Expr expr = analyze(C.EVAL, form);
228.5932 +			objx.keywords = (IPersistentMap) KEYWORDS.deref();
228.5933 +			objx.vars = (IPersistentMap) VARS.deref();
228.5934 +			objx.constants = (PersistentVector) CONSTANTS.deref();
228.5935 +			expr.emit(C.EXPRESSION, objx, gen);
228.5936 +			expr.eval();
228.5937 +			}
228.5938 +		}
228.5939 +	finally
228.5940 +		{
228.5941 +		Var.popThreadBindings();
228.5942 +		}
228.5943 +}
228.5944 +
228.5945 +public static Object compile(Reader rdr, String sourcePath, String sourceName) throws Exception{
228.5946 +	if(COMPILE_PATH.deref() == null)
228.5947 +		throw new Exception("*compile-path* not set");
228.5948 +
228.5949 +	Object EOF = new Object();
228.5950 +	Object ret = null;
228.5951 +	LineNumberingPushbackReader pushbackReader =
228.5952 +			(rdr instanceof LineNumberingPushbackReader) ? (LineNumberingPushbackReader) rdr :
228.5953 +			new LineNumberingPushbackReader(rdr);
228.5954 +	Var.pushThreadBindings(
228.5955 +			RT.map(SOURCE_PATH, sourcePath,
228.5956 +			       SOURCE, sourceName,
228.5957 +			       METHOD, null,
228.5958 +			       LOCAL_ENV, null,
228.5959 +					LOOP_LOCALS, null,
228.5960 +					NEXT_LOCAL_NUM, 0,
228.5961 +			       RT.CURRENT_NS, RT.CURRENT_NS.deref(),
228.5962 +			       LINE_BEFORE, pushbackReader.getLineNumber(),
228.5963 +			       LINE_AFTER, pushbackReader.getLineNumber(),
228.5964 +			       CONSTANTS, PersistentVector.EMPTY,
228.5965 +			       CONSTANT_IDS, new IdentityHashMap(),
228.5966 +			       KEYWORDS, PersistentHashMap.EMPTY,
228.5967 +			       VARS, PersistentHashMap.EMPTY
228.5968 +			   //    ,LOADER, RT.makeClassLoader()
228.5969 +			));
228.5970 +
228.5971 +	try
228.5972 +		{
228.5973 +		//generate loader class
228.5974 +		ObjExpr objx = new ObjExpr(null);
228.5975 +		objx.internalName = sourcePath.replace(File.separator, "/").substring(0, sourcePath.lastIndexOf('.'))
228.5976 +		                  + RT.LOADER_SUFFIX;
228.5977 +
228.5978 +		objx.objtype = Type.getObjectType(objx.internalName);
228.5979 +		ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS);
228.5980 +		ClassVisitor cv = cw;
228.5981 +		cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, objx.internalName, null, "java/lang/Object", null);
228.5982 +
228.5983 +		//static load method
228.5984 +		GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
228.5985 +		                                            Method.getMethod("void load ()"),
228.5986 +		                                            null,
228.5987 +		                                            null,
228.5988 +		                                            cv);
228.5989 +		gen.visitCode();
228.5990 +
228.5991 +		for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF;
228.5992 +		    r = LispReader.read(pushbackReader, false, EOF, false))
228.5993 +			{
228.5994 +				LINE_AFTER.set(pushbackReader.getLineNumber());
228.5995 +				compile1(gen, objx, r);
228.5996 +				LINE_BEFORE.set(pushbackReader.getLineNumber());
228.5997 +			}
228.5998 +		//end of load
228.5999 +		gen.returnValue();
228.6000 +		gen.endMethod();
228.6001 +
228.6002 +		//static fields for constants
228.6003 +		for(int i = 0; i < objx.constants.count(); i++)
228.6004 +			{
228.6005 +			cv.visitField(ACC_PUBLIC + ACC_FINAL + ACC_STATIC, objx.constantName(i), objx.constantType(i).getDescriptor(),
228.6006 +			              null, null);
228.6007 +			}
228.6008 +
228.6009 +		//static init for constants, keywords and vars
228.6010 +		GeneratorAdapter clinitgen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
228.6011 +		                                                  Method.getMethod("void <clinit> ()"),
228.6012 +		                                                  null,
228.6013 +		                                                  null,
228.6014 +		                                                  cv);
228.6015 +		clinitgen.visitCode();
228.6016 +		Label startTry = clinitgen.newLabel();
228.6017 +		Label endTry = clinitgen.newLabel();
228.6018 +		Label end = clinitgen.newLabel();
228.6019 +		Label finallyLabel = clinitgen.newLabel();
228.6020 +
228.6021 +		if(objx.constants.count() > 0)
228.6022 +			{
228.6023 +			objx.emitConstants(clinitgen);
228.6024 +			}
228.6025 +		clinitgen.invokeStatic(Type.getType(Compiler.class), Method.getMethod("void pushNS()"));
228.6026 +		clinitgen.mark(startTry);
228.6027 +		clinitgen.invokeStatic(objx.objtype, Method.getMethod("void load()"));
228.6028 +		clinitgen.mark(endTry);
228.6029 +		clinitgen.invokeStatic(VAR_TYPE, Method.getMethod("void popThreadBindings()"));
228.6030 +		clinitgen.goTo(end);
228.6031 +
228.6032 +		clinitgen.mark(finallyLabel);
228.6033 +		//exception should be on stack
228.6034 +		clinitgen.invokeStatic(VAR_TYPE, Method.getMethod("void popThreadBindings()"));
228.6035 +		clinitgen.throwException();
228.6036 +		clinitgen.mark(end);
228.6037 +		clinitgen.visitTryCatchBlock(startTry, endTry, finallyLabel, null);
228.6038 +
228.6039 +		//end of static init
228.6040 +		clinitgen.returnValue();
228.6041 +		clinitgen.endMethod();
228.6042 +
228.6043 +		//end of class
228.6044 +		cv.visitEnd();
228.6045 +
228.6046 +		writeClassFile(objx.internalName, cw.toByteArray());
228.6047 +		}
228.6048 +	catch(LispReader.ReaderException e)
228.6049 +		{
228.6050 +		throw new CompilerException(sourceName, e.line, e.getCause());
228.6051 +		}
228.6052 +	finally
228.6053 +		{
228.6054 +		Var.popThreadBindings();
228.6055 +		}
228.6056 +	return ret;
228.6057 +}
228.6058 +
228.6059 +
228.6060 +static public class NewInstanceExpr extends ObjExpr{
228.6061 +	//IPersistentMap optionsMap = PersistentArrayMap.EMPTY;
228.6062 +	IPersistentCollection methods;
228.6063 +
228.6064 +	Map<IPersistentVector,java.lang.reflect.Method> mmap;
228.6065 +	Map<IPersistentVector,Set<Class>> covariants;
228.6066 +
228.6067 +	public NewInstanceExpr(Object tag){
228.6068 +		super(tag);
228.6069 +	}
228.6070 +
228.6071 +	static class DeftypeParser implements IParser{
228.6072 +		public Expr parse(C context, final Object frm) throws Exception{
228.6073 +			ISeq rform = (ISeq) frm;
228.6074 +			//(deftype* tagname classname [fields] :implements [interfaces] :tag tagname methods*)
228.6075 +			rform = RT.next(rform);
228.6076 +			String tagname = ((Symbol) rform.first()).toString();
228.6077 +			rform = rform.next();
228.6078 +			Symbol classname = (Symbol) rform.first();
228.6079 +			rform = rform.next();
228.6080 +			IPersistentVector fields = (IPersistentVector) rform.first();
228.6081 +			rform = rform.next();
228.6082 +			IPersistentMap opts = PersistentHashMap.EMPTY;
228.6083 +			while(rform != null && rform.first() instanceof Keyword)
228.6084 +				{
228.6085 +				opts = opts.assoc(rform.first(), RT.second(rform));
228.6086 +				rform = rform.next().next();
228.6087 +				}
228.6088 +
228.6089 +			ObjExpr ret = build((IPersistentVector)RT.get(opts,implementsKey,PersistentVector.EMPTY),fields,null,tagname, classname,
228.6090 +			             (Symbol) RT.get(opts,RT.TAG_KEY),rform, frm);
228.6091 +			return ret;
228.6092 +		}
228.6093 +	}
228.6094 +
228.6095 +	static class ReifyParser implements IParser{
228.6096 +	public Expr parse(C context, Object frm) throws Exception{
228.6097 +		//(reify this-name? [interfaces] (method-name [args] body)*)
228.6098 +		ISeq form = (ISeq) frm;
228.6099 +		ObjMethod enclosingMethod = (ObjMethod) METHOD.deref();
228.6100 +		String basename = enclosingMethod != null ?
228.6101 +		                  (trimGenID(enclosingMethod.objx.name) + "$")
228.6102 +		                 : (munge(currentNS().name.name) + "$");
228.6103 +		String simpleName = "reify__" + RT.nextID();
228.6104 +		String classname = basename + simpleName;
228.6105 +
228.6106 +		ISeq rform = RT.next(form);
228.6107 +
228.6108 +		IPersistentVector interfaces = ((IPersistentVector) RT.first(rform)).cons(Symbol.intern("clojure.lang.IObj"));
228.6109 +
228.6110 +
228.6111 +		rform = RT.next(rform);
228.6112 +
228.6113 +
228.6114 +		ObjExpr ret = build(interfaces, null, null, classname, Symbol.intern(classname), null, rform, frm);
228.6115 +		if(frm instanceof IObj && ((IObj) frm).meta() != null)
228.6116 +			return new MetaExpr(ret, (MapExpr) MapExpr
228.6117 +					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) frm).meta()));
228.6118 +		else
228.6119 +			return ret;
228.6120 +	}
228.6121 +	}
228.6122 +
228.6123 +	static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSyms, Symbol thisSym,
228.6124 +	                     String tagName, Symbol className,
228.6125 +	                  Symbol typeTag, ISeq methodForms, Object frm) throws Exception{
228.6126 +		NewInstanceExpr ret = new NewInstanceExpr(null);
228.6127 +
228.6128 +		ret.src = frm;
228.6129 +		ret.name = className.toString();
228.6130 +		ret.classMeta = RT.meta(className);
228.6131 +		ret.internalName = ret.name.replace('.', '/');
228.6132 +		ret.objtype = Type.getObjectType(ret.internalName);
228.6133 +
228.6134 +		if(thisSym != null)
228.6135 +			ret.thisName = thisSym.name;
228.6136 +
228.6137 +		if(fieldSyms != null)
228.6138 +			{
228.6139 +			IPersistentMap fmap = PersistentHashMap.EMPTY;
228.6140 +			Object[] closesvec = new Object[2 * fieldSyms.count()];
228.6141 +			for(int i=0;i<fieldSyms.count();i++)
228.6142 +				{
228.6143 +				Symbol sym = (Symbol) fieldSyms.nth(i);
228.6144 +				LocalBinding lb = new LocalBinding(-1, sym, null,
228.6145 +				                                   new MethodParamExpr(tagClass(tagOf(sym))),false,null);
228.6146 +				fmap = fmap.assoc(sym, lb);
228.6147 +				closesvec[i*2] = lb;
228.6148 +				closesvec[i*2 + 1] = lb;
228.6149 +				}
228.6150 +
228.6151 +			//todo - inject __meta et al into closes - when?
228.6152 +			//use array map to preserve ctor order
228.6153 +			ret.closes = new PersistentArrayMap(closesvec);
228.6154 +			ret.fields = fmap;
228.6155 +			for(int i=fieldSyms.count()-1;i >= 0 && ((Symbol)fieldSyms.nth(i)).name.startsWith("__");--i)
228.6156 +				ret.altCtorDrops++;
228.6157 +			}
228.6158 +		//todo - set up volatiles
228.6159 +//		ret.volatiles = PersistentHashSet.create(RT.seq(RT.get(ret.optionsMap, volatileKey)));
228.6160 +
228.6161 +		PersistentVector interfaces = PersistentVector.EMPTY;
228.6162 +		for(ISeq s = RT.seq(interfaceSyms);s!=null;s = s.next())
228.6163 +			{
228.6164 +			Class c = (Class) resolve((Symbol) s.first());
228.6165 +			if(!c.isInterface())
228.6166 +				throw new IllegalArgumentException("only interfaces are supported, had: " + c.getName());
228.6167 +			interfaces = interfaces.cons(c);
228.6168 +			}
228.6169 +		Class superClass = Object.class;
228.6170 +		Map[] mc = gatherMethods(superClass,RT.seq(interfaces));
228.6171 +		Map overrideables = mc[0];
228.6172 +		Map covariants = mc[1];
228.6173 +		ret.mmap = overrideables;
228.6174 +		ret.covariants = covariants;
228.6175 +		
228.6176 +		String[] inames = interfaceNames(interfaces);
228.6177 +
228.6178 +		Class stub = compileStub(slashname(superClass),ret, inames, frm);
228.6179 +		Symbol thistag = Symbol.intern(null,stub.getName());
228.6180 +
228.6181 +		try
228.6182 +			{
228.6183 +			Var.pushThreadBindings(
228.6184 +					RT.map(CONSTANTS, PersistentVector.EMPTY,
228.6185 +					       CONSTANT_IDS, new IdentityHashMap(),
228.6186 +					       KEYWORDS, PersistentHashMap.EMPTY,
228.6187 +					       VARS, PersistentHashMap.EMPTY,
228.6188 +					       KEYWORD_CALLSITES, PersistentVector.EMPTY,
228.6189 +					       PROTOCOL_CALLSITES, PersistentVector.EMPTY,
228.6190 +					       VAR_CALLSITES, PersistentVector.EMPTY
228.6191 +							));
228.6192 +			if(ret.isDeftype())
228.6193 +				{
228.6194 +				Var.pushThreadBindings(RT.map(METHOD, null,
228.6195 +				                              LOCAL_ENV, ret.fields
228.6196 +						, COMPILE_STUB_SYM, Symbol.intern(null, tagName)
228.6197 +						, COMPILE_STUB_CLASS, stub));
228.6198 +				}
228.6199 +
228.6200 +			//now (methodname [args] body)*
228.6201 +			ret.line = (Integer) LINE.deref();
228.6202 +			IPersistentCollection methods = null;
228.6203 +			for(ISeq s = methodForms; s != null; s = RT.next(s))
228.6204 +				{
228.6205 +				NewInstanceMethod m = NewInstanceMethod.parse(ret, (ISeq) RT.first(s),thistag, overrideables);
228.6206 +				methods = RT.conj(methods, m);
228.6207 +				}
228.6208 +
228.6209 +
228.6210 +			ret.methods = methods;
228.6211 +			ret.keywords = (IPersistentMap) KEYWORDS.deref();
228.6212 +			ret.vars = (IPersistentMap) VARS.deref();
228.6213 +			ret.constants = (PersistentVector) CONSTANTS.deref();
228.6214 +			ret.constantsID = RT.nextID();
228.6215 +			ret.keywordCallsites = (IPersistentVector) KEYWORD_CALLSITES.deref();
228.6216 +			ret.protocolCallsites = (IPersistentVector) PROTOCOL_CALLSITES.deref();
228.6217 +			ret.varCallsites = (IPersistentVector) VAR_CALLSITES.deref();
228.6218 +			}
228.6219 +		finally
228.6220 +			{
228.6221 +			if(ret.isDeftype())
228.6222 +				Var.popThreadBindings();
228.6223 +			Var.popThreadBindings();
228.6224 +			}
228.6225 +
228.6226 +		ret.compile(slashname(superClass),inames,false);
228.6227 +		ret.getCompiledClass();
228.6228 +		return ret;
228.6229 +		}
228.6230 +
228.6231 +	/***
228.6232 +	 * Current host interop uses reflection, which requires pre-existing classes
228.6233 +	 * Work around this by:
228.6234 +	 * Generate a stub class that has the same interfaces and fields as the class we are generating.
228.6235 +	 * Use it as a type hint for this, and bind the simple name of the class to this stub (in resolve etc)
228.6236 +	 * Unmunge the name (using a magic prefix) on any code gen for classes
228.6237 +	 */
228.6238 +	static Class compileStub(String superName, NewInstanceExpr ret, String[] interfaceNames, Object frm){
228.6239 +		ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS);
228.6240 +		ClassVisitor cv = cw;
228.6241 +		cv.visit(V1_5, ACC_PUBLIC + ACC_SUPER, COMPILE_STUB_PREFIX + "/" + ret.internalName,
228.6242 +		         null,superName,interfaceNames);
228.6243 +
228.6244 +		//instance fields for closed-overs
228.6245 +		for(ISeq s = RT.keys(ret.closes); s != null; s = s.next())
228.6246 +			{
228.6247 +			LocalBinding lb = (LocalBinding) s.first();
228.6248 +			int access = ACC_PUBLIC + (ret.isVolatile(lb) ? ACC_VOLATILE :
228.6249 +			                           ret.isMutable(lb) ? 0 :
228.6250 +			                           ACC_FINAL);
228.6251 +			if(lb.getPrimitiveType() != null)
228.6252 +				cv.visitField(access
228.6253 +						, lb.name, Type.getType(lb.getPrimitiveType()).getDescriptor(),
228.6254 +							  null, null);
228.6255 +			else
228.6256 +			//todo - when closed-overs are fields, use more specific types here and in ctor and emitLocal?
228.6257 +				cv.visitField(access
228.6258 +						, lb.name, OBJECT_TYPE.getDescriptor(), null, null);
228.6259 +			}
228.6260 +
228.6261 +		//ctor that takes closed-overs and does nothing
228.6262 +		Method m = new Method("<init>", Type.VOID_TYPE, ret.ctorTypes());
228.6263 +		GeneratorAdapter ctorgen = new GeneratorAdapter(ACC_PUBLIC,
228.6264 +		                                                m,
228.6265 +		                                                null,
228.6266 +		                                                null,
228.6267 +		                                                cv);
228.6268 +		ctorgen.visitCode();
228.6269 +		ctorgen.loadThis();
228.6270 +		ctorgen.invokeConstructor(Type.getObjectType(superName), voidctor);
228.6271 +		ctorgen.returnValue();
228.6272 +		ctorgen.endMethod();
228.6273 +
228.6274 +		if(ret.altCtorDrops > 0)
228.6275 +			{
228.6276 +			Type[] ctorTypes = ret.ctorTypes();
228.6277 +			Type[] altCtorTypes = new Type[ctorTypes.length-ret.altCtorDrops];
228.6278 +			for(int i=0;i<altCtorTypes.length;i++)
228.6279 +				altCtorTypes[i] = ctorTypes[i];
228.6280 +			Method alt = new Method("<init>", Type.VOID_TYPE, altCtorTypes);
228.6281 +			ctorgen = new GeneratorAdapter(ACC_PUBLIC,
228.6282 +															alt,
228.6283 +															null,
228.6284 +															null,
228.6285 +															cv);
228.6286 +			ctorgen.visitCode();
228.6287 +			ctorgen.loadThis();
228.6288 +			ctorgen.loadArgs();
228.6289 +			for(int i=0;i<ret.altCtorDrops;i++)
228.6290 +				ctorgen.visitInsn(Opcodes.ACONST_NULL);
228.6291 +
228.6292 +			ctorgen.invokeConstructor(Type.getObjectType(COMPILE_STUB_PREFIX + "/" + ret.internalName),
228.6293 +			                          new Method("<init>", Type.VOID_TYPE, ctorTypes));
228.6294 +
228.6295 +			ctorgen.returnValue();
228.6296 +			ctorgen.endMethod();
228.6297 +			}
228.6298 +		//end of class
228.6299 +		cv.visitEnd();
228.6300 +
228.6301 +		byte[] bytecode = cw.toByteArray();
228.6302 +		DynamicClassLoader loader = (DynamicClassLoader) LOADER.deref();
228.6303 +		return loader.defineClass(COMPILE_STUB_PREFIX + "." + ret.name, bytecode, frm);
228.6304 +	}
228.6305 +
228.6306 +	static String[] interfaceNames(IPersistentVector interfaces){
228.6307 +		int icnt = interfaces.count();
228.6308 +		String[] inames = icnt > 0 ? new String[icnt] : null;
228.6309 +		for(int i=0;i<icnt;i++)
228.6310 +			inames[i] = slashname((Class) interfaces.nth(i));
228.6311 +		return inames;
228.6312 +	}
228.6313 +
228.6314 +
228.6315 +	static String slashname(Class c){
228.6316 +		return c.getName().replace('.', '/');
228.6317 +	}
228.6318 +
228.6319 +
228.6320 +	protected void emitMethods(ClassVisitor cv){
228.6321 +		for(ISeq s = RT.seq(methods); s != null; s = s.next())
228.6322 +			{
228.6323 +			ObjMethod method = (ObjMethod) s.first();
228.6324 +			method.emit(this, cv);
228.6325 +			}
228.6326 +		//emit bridge methods
228.6327 +		for(Map.Entry<IPersistentVector,Set<Class>> e : covariants.entrySet())
228.6328 +			{
228.6329 +			java.lang.reflect.Method m = mmap.get(e.getKey());
228.6330 +			Class[] params = m.getParameterTypes();
228.6331 +			Type[] argTypes = new Type[params.length];
228.6332 +
228.6333 +			for(int i = 0; i < params.length; i++)
228.6334 +				{
228.6335 +				argTypes[i] = Type.getType(params[i]);
228.6336 +				}
228.6337 +
228.6338 +			Method target = new Method(m.getName(), Type.getType(m.getReturnType()), argTypes);
228.6339 +
228.6340 +			for(Class retType : e.getValue())
228.6341 +				{
228.6342 + 		        Method meth = new Method(m.getName(), Type.getType(retType), argTypes);
228.6343 +
228.6344 +				GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_BRIDGE,
228.6345 +		                                            meth,
228.6346 +		                                            null,
228.6347 +		                                            //todo don't hardwire this
228.6348 +		                                            EXCEPTION_TYPES,
228.6349 +		                                            cv);
228.6350 +				gen.visitCode();
228.6351 +				gen.loadThis();
228.6352 +				gen.loadArgs();
228.6353 +				gen.invokeInterface(Type.getType(m.getDeclaringClass()),target);
228.6354 +				gen.returnValue();
228.6355 +				gen.endMethod();
228.6356 +				}
228.6357 +			}
228.6358 +	}
228.6359 +
228.6360 +	static public IPersistentVector msig(java.lang.reflect.Method m){
228.6361 +		return RT.vector(m.getName(), RT.seq(m.getParameterTypes()),m.getReturnType());
228.6362 +	}
228.6363 +
228.6364 +	static void considerMethod(java.lang.reflect.Method m, Map mm){
228.6365 +		IPersistentVector mk = msig(m);
228.6366 +		int mods = m.getModifiers();
228.6367 +
228.6368 +		if(!(mm.containsKey(mk)
228.6369 +		    || !(Modifier.isPublic(mods) || Modifier.isProtected(mods))
228.6370 +		    || Modifier.isStatic(mods)
228.6371 +		    || Modifier.isFinal(mods)))
228.6372 +			{
228.6373 +				mm.put(mk, m);
228.6374 +			}
228.6375 +	}
228.6376 +
228.6377 +	static void gatherMethods(Class c, Map mm){
228.6378 +		for(; c != null; c = c.getSuperclass())
228.6379 +			{
228.6380 +			for(java.lang.reflect.Method m : c.getDeclaredMethods())
228.6381 +				considerMethod(m, mm);
228.6382 +			for(java.lang.reflect.Method m : c.getMethods())
228.6383 +				considerMethod(m, mm);
228.6384 +			}
228.6385 +	}
228.6386 +
228.6387 +	static public Map[] gatherMethods(Class sc, ISeq interfaces){
228.6388 +		Map allm = new HashMap();
228.6389 +		gatherMethods(sc, allm);
228.6390 +		for(; interfaces != null; interfaces = interfaces.next())
228.6391 +			gatherMethods((Class) interfaces.first(), allm);
228.6392 +
228.6393 +		Map<IPersistentVector,java.lang.reflect.Method> mm = new HashMap<IPersistentVector,java.lang.reflect.Method>();
228.6394 +		Map<IPersistentVector,Set<Class>> covariants = new HashMap<IPersistentVector,Set<Class>>();
228.6395 +		for(Object o : allm.entrySet())
228.6396 +			{
228.6397 +			Map.Entry e = (Map.Entry) o;
228.6398 +			IPersistentVector mk = (IPersistentVector) e.getKey();
228.6399 +			mk = (IPersistentVector) mk.pop();
228.6400 +			java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue();
228.6401 +			if(mm.containsKey(mk)) //covariant return
228.6402 +				{
228.6403 +				Set<Class> cvs = covariants.get(mk);
228.6404 +				if(cvs == null)
228.6405 +					{
228.6406 +					cvs = new HashSet<Class>();
228.6407 +					covariants.put(mk,cvs);
228.6408 +					}
228.6409 +				java.lang.reflect.Method om = mm.get(mk);
228.6410 +				if(om.getReturnType().isAssignableFrom(m.getReturnType()))
228.6411 +					{
228.6412 +					cvs.add(om.getReturnType());
228.6413 +					mm.put(mk, m);
228.6414 +					}
228.6415 +				else
228.6416 +					cvs.add(m.getReturnType());
228.6417 +				}
228.6418 +			else
228.6419 +				mm.put(mk, m);
228.6420 +			}
228.6421 +		return new Map[]{mm,covariants};
228.6422 +	}
228.6423 +}
228.6424 +
228.6425 +public static class NewInstanceMethod extends ObjMethod{
228.6426 +	String name;
228.6427 +	Type[] argTypes;
228.6428 +	Type retType;
228.6429 +	Class retClass;
228.6430 +	Class[] exclasses;
228.6431 +
228.6432 +	static Symbol dummyThis = Symbol.intern(null,"dummy_this_dlskjsdfower");
228.6433 +	private IPersistentVector parms;
228.6434 +
228.6435 +	public NewInstanceMethod(ObjExpr objx, ObjMethod parent){
228.6436 +		super(objx, parent);
228.6437 +	}
228.6438 +
228.6439 +	int numParams(){
228.6440 +		return argLocals.count();
228.6441 +	}
228.6442 +
228.6443 +	String getMethodName(){
228.6444 +		return name;
228.6445 +	}
228.6446 +
228.6447 +	Type getReturnType(){
228.6448 +		return retType;
228.6449 +	}
228.6450 +
228.6451 +	Type[] getArgTypes(){
228.6452 +		return argTypes;
228.6453 +	}
228.6454 +
228.6455 +
228.6456 +
228.6457 +	static public IPersistentVector msig(String name,Class[] paramTypes){
228.6458 +		return RT.vector(name,RT.seq(paramTypes));
228.6459 +	}
228.6460 +
228.6461 +	static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag,
228.6462 +	                               Map overrideables) throws Exception{
228.6463 +		//(methodname [this-name args*] body...)
228.6464 +		//this-name might be nil
228.6465 +		NewInstanceMethod method = new NewInstanceMethod(objx, (ObjMethod) METHOD.deref());
228.6466 +		Symbol dotname = (Symbol)RT.first(form);
228.6467 +		Symbol name = (Symbol) Symbol.intern(null,munge(dotname.name)).withMeta(RT.meta(dotname));
228.6468 +		IPersistentVector parms = (IPersistentVector) RT.second(form);
228.6469 +		if(parms.count() == 0)
228.6470 +			{
228.6471 +			throw new IllegalArgumentException("Must supply at least one argument for 'this' in: " + dotname);
228.6472 +			}
228.6473 +		Symbol thisName = (Symbol) parms.nth(0);
228.6474 +		parms = RT.subvec(parms,1,parms.count());
228.6475 +		ISeq body = RT.next(RT.next(form));
228.6476 +		try
228.6477 +			{
228.6478 +			method.line = (Integer) LINE.deref();
228.6479 +			//register as the current method and set up a new env frame
228.6480 +            PathNode pnode =  new PathNode(PATHTYPE.PATH, (PathNode) CLEAR_PATH.get());
228.6481 +			Var.pushThreadBindings(
228.6482 +					RT.map(
228.6483 +							METHOD, method,
228.6484 +							LOCAL_ENV, LOCAL_ENV.deref(),
228.6485 +							LOOP_LOCALS, null,
228.6486 +							NEXT_LOCAL_NUM, 0
228.6487 +                            ,CLEAR_PATH, pnode
228.6488 +                            ,CLEAR_ROOT, pnode
228.6489 +                            ,CLEAR_SITES, PersistentHashMap.EMPTY
228.6490 +                    ));
228.6491 +
228.6492 +			//register 'this' as local 0
228.6493 +			if(thisName != null)
228.6494 +				registerLocal((thisName == null) ? dummyThis:thisName,thistag, null,false);
228.6495 +			else
228.6496 +				getAndIncLocalNum();
228.6497 +
228.6498 +			PersistentVector argLocals = PersistentVector.EMPTY;
228.6499 +			method.retClass = tagClass(tagOf(name));
228.6500 +			method.argTypes = new Type[parms.count()];
228.6501 +			boolean hinted = tagOf(name) != null;
228.6502 +			Class[] pclasses = new Class[parms.count()];
228.6503 +			Symbol[] psyms = new Symbol[parms.count()];
228.6504 +
228.6505 +			for(int i = 0; i < parms.count(); i++)
228.6506 +				{
228.6507 +				if(!(parms.nth(i) instanceof Symbol))
228.6508 +					throw new IllegalArgumentException("params must be Symbols");
228.6509 +				Symbol p = (Symbol) parms.nth(i);
228.6510 +				Object tag = tagOf(p);
228.6511 +				if(tag != null)
228.6512 +					hinted = true;
228.6513 +				if(p.getNamespace() != null)
228.6514 +					p = Symbol.create(p.name);
228.6515 +				Class pclass = tagClass(tag);
228.6516 +				pclasses[i] = pclass;
228.6517 +				psyms[i] = p;
228.6518 +				}
228.6519 +			Map matches = findMethodsWithNameAndArity(name.name, parms.count(), overrideables);
228.6520 +			Object mk = msig(name.name, pclasses);
228.6521 +			java.lang.reflect.Method m = null;
228.6522 +			if(matches.size() > 0)
228.6523 +				{
228.6524 +				//multiple methods
228.6525 +				if(matches.size() > 1)
228.6526 +					{
228.6527 +					//must be hinted and match one method
228.6528 +					if(!hinted)
228.6529 +						throw new IllegalArgumentException("Must hint overloaded method: " + name.name);
228.6530 +					m = (java.lang.reflect.Method) matches.get(mk);
228.6531 +					if(m == null)
228.6532 +						throw new IllegalArgumentException("Can't find matching overloaded method: " + name.name);
228.6533 +					if(m.getReturnType() != method.retClass)
228.6534 +						throw new IllegalArgumentException("Mismatched return type: " + name.name +
228.6535 +						", expected: " + m.getReturnType().getName()  + ", had: " + method.retClass.getName());
228.6536 +					}
228.6537 +				else  //one match
228.6538 +					{
228.6539 +					//if hinted, validate match,
228.6540 +					if(hinted)
228.6541 +						{
228.6542 +						m = (java.lang.reflect.Method) matches.get(mk);
228.6543 +						if(m == null)
228.6544 +							throw new IllegalArgumentException("Can't find matching method: " + name.name +
228.6545 +							                                   ", leave off hints for auto match.");
228.6546 +						if(m.getReturnType() != method.retClass)
228.6547 +							throw new IllegalArgumentException("Mismatched return type: " + name.name +
228.6548 +							", expected: " + m.getReturnType().getName()  + ", had: " + method.retClass.getName());
228.6549 +						}
228.6550 +					else //adopt found method sig
228.6551 +						{
228.6552 +						m = (java.lang.reflect.Method) matches.values().iterator().next();
228.6553 +						method.retClass = m.getReturnType();
228.6554 +						pclasses = m.getParameterTypes();
228.6555 +						}
228.6556 +					}
228.6557 +				}
228.6558 +//			else if(findMethodsWithName(name.name,allmethods).size()>0)
228.6559 +//				throw new IllegalArgumentException("Can't override/overload method: " + name.name);
228.6560 +			else
228.6561 +				throw new IllegalArgumentException("Can't define method not in interfaces: " + name.name);
228.6562 +
228.6563 +			//else
228.6564 +				//validate unque name+arity among additional methods
228.6565 +
228.6566 +			method.retType = Type.getType(method.retClass);
228.6567 +			method.exclasses = m.getExceptionTypes();
228.6568 +
228.6569 +			for(int i = 0; i < parms.count(); i++)
228.6570 +				{
228.6571 +				LocalBinding lb = registerLocal(psyms[i], null, new MethodParamExpr(pclasses[i]),true);
228.6572 +				argLocals = argLocals.assocN(i,lb);
228.6573 +				method.argTypes[i] = Type.getType(pclasses[i]);
228.6574 +				}
228.6575 +			for(int i = 0; i < parms.count(); i++)
228.6576 +				{
228.6577 +				if(pclasses[i] == long.class || pclasses[i] == double.class)
228.6578 +					getAndIncLocalNum();
228.6579 +				}
228.6580 +			LOOP_LOCALS.set(argLocals);
228.6581 +			method.name = name.name;
228.6582 +			method.methodMeta = RT.meta(name);
228.6583 +			method.parms = parms;
228.6584 +			method.argLocals = argLocals;
228.6585 +			method.body = (new BodyExpr.Parser()).parse(C.RETURN, body);
228.6586 +			return method;
228.6587 +			}
228.6588 +		finally
228.6589 +			{
228.6590 +			Var.popThreadBindings();
228.6591 +			}
228.6592 +	}
228.6593 +
228.6594 +	private static Map findMethodsWithNameAndArity(String name, int arity, Map mm){
228.6595 +		Map ret = new HashMap();
228.6596 +		for(Object o : mm.entrySet())
228.6597 +			{
228.6598 +			Map.Entry e = (Map.Entry) o;
228.6599 +			java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue();
228.6600 +			if(name.equals(m.getName()) && m.getParameterTypes().length == arity)
228.6601 +				ret.put(e.getKey(), e.getValue());
228.6602 +			}
228.6603 +		return ret;
228.6604 +	}
228.6605 +
228.6606 +	private static Map findMethodsWithName(String name, Map mm){
228.6607 +		Map ret = new HashMap();
228.6608 +		for(Object o : mm.entrySet())
228.6609 +			{
228.6610 +			Map.Entry e = (Map.Entry) o;
228.6611 +			java.lang.reflect.Method m = (java.lang.reflect.Method) e.getValue();
228.6612 +			if(name.equals(m.getName()))
228.6613 +				ret.put(e.getKey(), e.getValue());
228.6614 +			}
228.6615 +		return ret;
228.6616 +	}
228.6617 +
228.6618 +	public void emit(ObjExpr obj, ClassVisitor cv){
228.6619 +		Method m = new Method(getMethodName(), getReturnType(), getArgTypes());
228.6620 +
228.6621 +		Type[] extypes = null;
228.6622 +		if(exclasses.length > 0)
228.6623 +			{
228.6624 +			extypes = new Type[exclasses.length];
228.6625 +			for(int i=0;i<exclasses.length;i++)
228.6626 +				extypes[i] = Type.getType(exclasses[i]);
228.6627 +			}
228.6628 +		GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC,
228.6629 +		                                            m,
228.6630 +		                                            null,
228.6631 +		                                            extypes,
228.6632 +		                                            cv);
228.6633 +		addAnnotation(gen,methodMeta);
228.6634 +		for(int i = 0; i < parms.count(); i++)
228.6635 +			{
228.6636 +			IPersistentMap meta = RT.meta(parms.nth(i));
228.6637 +			addParameterAnnotation(gen, meta, i);
228.6638 +			}
228.6639 +		gen.visitCode();
228.6640 +		Label loopLabel = gen.mark();
228.6641 +		gen.visitLineNumber(line, loopLabel);
228.6642 +		try
228.6643 +			{
228.6644 +			Var.pushThreadBindings(RT.map(LOOP_LABEL, loopLabel, METHOD, this));
228.6645 +			MaybePrimitiveExpr be = (MaybePrimitiveExpr) body;
228.6646 +			if(Util.isPrimitive(retClass) && be.canEmitPrimitive())
228.6647 +				{
228.6648 +				if(be.getJavaClass() == retClass)
228.6649 +					be.emitUnboxed(C.RETURN,obj,gen);
228.6650 +				//todo - support the standard widening conversions
228.6651 +				else
228.6652 +					throw new IllegalArgumentException("Mismatched primitive return, expected: "
228.6653 +					                                   + retClass + ", had: " + be.getJavaClass());
228.6654 +				}
228.6655 +			else
228.6656 +				{
228.6657 +				body.emit(C.RETURN, obj, gen);
228.6658 +				if(retClass == void.class)
228.6659 +					{
228.6660 +					gen.pop();
228.6661 +					}
228.6662 +				else
228.6663 +					gen.unbox(retType);
228.6664 +				}
228.6665 +
228.6666 +			Label end = gen.mark();
228.6667 +			gen.visitLocalVariable("this", obj.objtype.getDescriptor(), null, loopLabel, end, 0);
228.6668 +			for(ISeq lbs = argLocals.seq(); lbs != null; lbs = lbs.next())
228.6669 +				{
228.6670 +				LocalBinding lb = (LocalBinding) lbs.first();
228.6671 +				gen.visitLocalVariable(lb.name, argTypes[lb.idx-1].getDescriptor(), null, loopLabel, end, lb.idx);
228.6672 +				}
228.6673 +			}
228.6674 +		catch(Exception e)
228.6675 +			{
228.6676 +			throw new RuntimeException(e);
228.6677 +			}
228.6678 +		finally
228.6679 +			{
228.6680 +			Var.popThreadBindings();
228.6681 +			}
228.6682 +
228.6683 +		gen.returnValue();
228.6684 +		//gen.visitMaxs(1, 1);
228.6685 +		gen.endMethod();
228.6686 +	}
228.6687 +}
228.6688 +
228.6689 +	static Class primClass(Symbol sym){
228.6690 +		if(sym == null)
228.6691 +			return null;
228.6692 +		Class c = null;
228.6693 +		if(sym.name.equals("int"))
228.6694 +			c = int.class;
228.6695 +		else if(sym.name.equals("long"))
228.6696 +			c = long.class;
228.6697 +		else if(sym.name.equals("float"))
228.6698 +			c = float.class;
228.6699 +		else if(sym.name.equals("double"))
228.6700 +			c = double.class;
228.6701 +		else if(sym.name.equals("char"))
228.6702 +			c = char.class;
228.6703 +		else if(sym.name.equals("short"))
228.6704 +			c = short.class;
228.6705 +		else if(sym.name.equals("byte"))
228.6706 +			c = byte.class;
228.6707 +		else if(sym.name.equals("boolean"))
228.6708 +			c = boolean.class;
228.6709 +		else if(sym.name.equals("void"))
228.6710 +			c = void.class;
228.6711 +		return c;
228.6712 +	}
228.6713 +
228.6714 +	static Class tagClass(Object tag) throws Exception{
228.6715 +		if(tag == null)
228.6716 +			return Object.class;
228.6717 +		Class c = null;
228.6718 +		if(tag instanceof Symbol)
228.6719 +			c = primClass((Symbol) tag);
228.6720 +		if(c == null)
228.6721 +			c = HostExpr.tagToClass(tag);
228.6722 +		return c;
228.6723 +	}
228.6724 +
228.6725 +static public class MethodParamExpr implements Expr, MaybePrimitiveExpr{
228.6726 +	final Class c;
228.6727 +
228.6728 +	public MethodParamExpr(Class c){
228.6729 +		this.c = c;
228.6730 +	}
228.6731 +
228.6732 +	public Object eval() throws Exception{
228.6733 +		throw new Exception("Can't eval");
228.6734 +	}
228.6735 +
228.6736 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.6737 +		throw new RuntimeException("Can't emit");
228.6738 +	}
228.6739 +
228.6740 +	public boolean hasJavaClass() throws Exception{
228.6741 +		return c != null;
228.6742 +	}
228.6743 +
228.6744 +	public Class getJavaClass() throws Exception{
228.6745 +		return c;
228.6746 +	}
228.6747 +
228.6748 +	public boolean canEmitPrimitive(){
228.6749 +		return Util.isPrimitive(c);
228.6750 +	}
228.6751 +
228.6752 +	public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){
228.6753 +		throw new RuntimeException("Can't emit");
228.6754 +	}
228.6755 +}
228.6756 +
228.6757 +public static class CaseExpr extends UntypedExpr{
228.6758 +	public final LocalBindingExpr expr;
228.6759 +	public final int shift, mask, low, high;
228.6760 +	public final Expr defaultExpr;
228.6761 +	public final HashMap<Integer,Expr> tests;
228.6762 +	public final HashMap<Integer,Expr> thens;
228.6763 +	public final boolean allKeywords;
228.6764 +
228.6765 +	public final int line;
228.6766 +
228.6767 +	final static Method hashMethod = Method.getMethod("int hash(Object)");
228.6768 +	final static Method hashCodeMethod = Method.getMethod("int hashCode()");
228.6769 +	final static Method equalsMethod = Method.getMethod("boolean equals(Object, Object)");
228.6770 +
228.6771 +
228.6772 +	public CaseExpr(int line, LocalBindingExpr expr, int shift, int mask, int low, int high, Expr defaultExpr,
228.6773 +	                HashMap<Integer,Expr> tests,HashMap<Integer,Expr> thens, boolean allKeywords){
228.6774 +		this.expr = expr;
228.6775 +		this.shift = shift;
228.6776 +		this.mask = mask;
228.6777 +		this.low = low;
228.6778 +		this.high = high;
228.6779 +		this.defaultExpr = defaultExpr;
228.6780 +		this.tests = tests;
228.6781 +		this.thens = thens;
228.6782 +		this.line = line;
228.6783 +		this.allKeywords = allKeywords;
228.6784 +	}
228.6785 +
228.6786 +	public Object eval() throws Exception{
228.6787 +		throw new UnsupportedOperationException("Can't eval case");
228.6788 +	}
228.6789 +
228.6790 +	public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
228.6791 +		Label defaultLabel = gen.newLabel();
228.6792 +		Label endLabel = gen.newLabel();
228.6793 +		HashMap<Integer,Label> labels = new HashMap();
228.6794 +
228.6795 +		for(Integer i : tests.keySet())
228.6796 +			{
228.6797 +			labels.put(i, gen.newLabel());
228.6798 +			}
228.6799 +
228.6800 +		Label[] la = new Label[(high-low)+1];
228.6801 +
228.6802 +		for(int i=low;i<=high;i++)
228.6803 +			{
228.6804 +			la[i-low] = labels.containsKey(i) ? labels.get(i) : defaultLabel;
228.6805 +			}
228.6806 +
228.6807 +		gen.visitLineNumber(line, gen.mark());
228.6808 +		expr.emit(C.EXPRESSION, objx, gen);
228.6809 +			gen.invokeStatic(UTIL_TYPE,hashMethod);
228.6810 +		gen.push(shift);
228.6811 +		gen.visitInsn(ISHR);
228.6812 +		gen.push(mask);
228.6813 +		gen.visitInsn(IAND);
228.6814 +		gen.visitTableSwitchInsn(low, high, defaultLabel, la);
228.6815 +
228.6816 +		for(Integer i : labels.keySet())
228.6817 +			{
228.6818 +			gen.mark(labels.get(i));
228.6819 +			expr.emit(C.EXPRESSION, objx, gen);
228.6820 +			tests.get(i).emit(C.EXPRESSION, objx, gen);
228.6821 +			if(allKeywords)
228.6822 +				{
228.6823 +				gen.visitJumpInsn(IF_ACMPNE, defaultLabel);
228.6824 +				}
228.6825 +			else
228.6826 +				{
228.6827 +				gen.invokeStatic(UTIL_TYPE, equalsMethod);
228.6828 +				gen.ifZCmp(GeneratorAdapter.EQ, defaultLabel);
228.6829 +				}
228.6830 +			thens.get(i).emit(C.EXPRESSION,objx,gen);
228.6831 +			gen.goTo(endLabel);
228.6832 +			}
228.6833 +
228.6834 +		gen.mark(defaultLabel);
228.6835 +		defaultExpr.emit(C.EXPRESSION, objx, gen);
228.6836 +		gen.mark(endLabel);
228.6837 +		if(context == C.STATEMENT)
228.6838 +			gen.pop();
228.6839 +	}
228.6840 +
228.6841 +	static class Parser implements IParser{
228.6842 +		//(case* expr shift mask low high default map<minhash, [test then]> identity?)
228.6843 +		//prepared by case macro and presumed correct
228.6844 +		//case macro binds actual expr in let so expr is always a local,
228.6845 +		//no need to worry about multiple evaluation
228.6846 +		public Expr parse(C context, Object frm) throws Exception{
228.6847 +			ISeq form = (ISeq) frm;
228.6848 +			if(context == C.EVAL)
228.6849 +				return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
228.6850 +			PersistentVector args = PersistentVector.create(form.next());
228.6851 +			HashMap<Integer,Expr> tests = new HashMap();
228.6852 +			HashMap<Integer,Expr> thens = new HashMap();
228.6853 +
228.6854 +            LocalBindingExpr testexpr = (LocalBindingExpr) analyze(C.EXPRESSION, args.nth(0));
228.6855 +			testexpr.shouldClear = false;
228.6856 +            
228.6857 +            PathNode branch = new PathNode(PATHTYPE.BRANCH, (PathNode) CLEAR_PATH.get());
228.6858 +			for(Object o : ((Map)args.nth(6)).entrySet())
228.6859 +				{
228.6860 +				Map.Entry e = (Map.Entry) o;
228.6861 +				Integer minhash = (Integer) e.getKey();
228.6862 +				MapEntry me = (MapEntry) e.getValue();
228.6863 +				Expr testExpr = new ConstantExpr(me.getKey());
228.6864 +				tests.put(minhash, testExpr);
228.6865 +                Expr thenExpr;
228.6866 +                try {
228.6867 +                    Var.pushThreadBindings(
228.6868 +                            RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch)));
228.6869 +                    thenExpr = analyze(context, me.getValue());
228.6870 +                    }
228.6871 +                finally{
228.6872 +                    Var.popThreadBindings();
228.6873 +                    }
228.6874 +				thens.put(minhash, thenExpr);
228.6875 +				}
228.6876 +            
228.6877 +            Expr defaultExpr;
228.6878 +            try {
228.6879 +                Var.pushThreadBindings(
228.6880 +                        RT.map(CLEAR_PATH, new PathNode(PATHTYPE.PATH,branch)));
228.6881 +                defaultExpr = analyze(context, args.nth(5));
228.6882 +                }
228.6883 +            finally{
228.6884 +                Var.popThreadBindings();
228.6885 +                }
228.6886 +
228.6887 +			return new CaseExpr((Integer) LINE.deref(),
228.6888 +			                  testexpr,
228.6889 +			                  (Integer)args.nth(1),
228.6890 +			                  (Integer)args.nth(2),
228.6891 +			                  (Integer)args.nth(3),
228.6892 +			                  (Integer)args.nth(4),
228.6893 +			                  defaultExpr,
228.6894 +			                  tests,thens,args.nth(7) != RT.F);
228.6895 +
228.6896 +		}
228.6897 +	}
228.6898 +}
228.6899 +
228.6900 +}
   229.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   229.2 +++ b/src/clojure/lang/Cons.java	Sat Aug 21 06:25:44 2010 -0400
   229.3 @@ -0,0 +1,55 @@
   229.4 +/**
   229.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   229.6 + *   The use and distribution terms for this software are covered by the
   229.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   229.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   229.9 + *   By using this software in any fashion, you are agreeing to be bound by
  229.10 + * 	 the terms of this license.
  229.11 + *   You must not remove this notice, or any other, from this software.
  229.12 + **/
  229.13 +
  229.14 +/* rich Mar 25, 2006 11:01:29 AM */
  229.15 +
  229.16 +package clojure.lang;
  229.17 +
  229.18 +import java.io.Serializable;
  229.19 +
  229.20 +final public class Cons extends ASeq implements Serializable {
  229.21 +
  229.22 +private final Object _first;
  229.23 +private final ISeq _more;
  229.24 +
  229.25 +public Cons(Object first, ISeq _more){
  229.26 +	this._first = first;
  229.27 +	this._more = _more;
  229.28 +}
  229.29 +
  229.30 +
  229.31 +public Cons(IPersistentMap meta, Object _first, ISeq _more){
  229.32 +	super(meta);
  229.33 +	this._first = _first;
  229.34 +	this._more = _more;
  229.35 +}
  229.36 +
  229.37 +public Object first(){
  229.38 +	return _first;
  229.39 +}
  229.40 +
  229.41 +public ISeq next(){
  229.42 +	return more().seq();
  229.43 +}
  229.44 +
  229.45 +public ISeq more(){
  229.46 +	if(_more == null)
  229.47 +		return PersistentList.EMPTY;
  229.48 +	return _more;
  229.49 +}
  229.50 +
  229.51 +public int count(){
  229.52 +	return 1 + RT.count(_more);
  229.53 +}
  229.54 +
  229.55 +public Cons withMeta(IPersistentMap meta){
  229.56 +	return new Cons(meta, _first, _more);
  229.57 +}
  229.58 +}
   230.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   230.2 +++ b/src/clojure/lang/Counted.java	Sat Aug 21 06:25:44 2010 -0400
   230.3 @@ -0,0 +1,18 @@
   230.4 +package clojure.lang;
   230.5 +
   230.6 +/**
   230.7 + * Copyright (c) Rich Hickey. All rights reserved.
   230.8 + * The use and distribution terms for this software are covered by the
   230.9 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  230.10 + * which can be found in the file epl-v10.html at the root of this distribution.
  230.11 + * By using this software in any fashion, you are agreeing to be bound by
  230.12 + * the terms of this license.
  230.13 + * You must not remove this notice, or any other, from this software.
  230.14 + */
  230.15 +
  230.16 +/* A class that implements Counted promises that it is a collection
  230.17 + * that implement a constant-time count() */
  230.18 +
  230.19 +public interface Counted {
  230.20 +    int count();
  230.21 +}
   231.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   231.2 +++ b/src/clojure/lang/Delay.java	Sat Aug 21 06:25:44 2010 -0400
   231.3 @@ -0,0 +1,38 @@
   231.4 +/**
   231.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   231.6 + *   The use and distribution terms for this software are covered by the
   231.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   231.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   231.9 + *   By using this software in any fashion, you are agreeing to be bound by
  231.10 + * 	 the terms of this license.
  231.11 + *   You must not remove this notice, or any other, from this software.
  231.12 + **/
  231.13 +
  231.14 +/* rich Jun 28, 2007 */
  231.15 +
  231.16 +package clojure.lang;
  231.17 +
  231.18 +public class Delay implements IDeref{
  231.19 +Object val;
  231.20 +IFn fn;
  231.21 +
  231.22 +public Delay(IFn fn){
  231.23 +	this.fn = fn;
  231.24 +	this.val = null;
  231.25 +}
  231.26 +
  231.27 +static public Object force(Object x) throws Exception{
  231.28 +	return (x instanceof Delay) ?
  231.29 +	       ((Delay) x).deref()
  231.30 +	       : x;
  231.31 +}
  231.32 +
  231.33 +synchronized public Object deref() throws Exception{
  231.34 +	if(fn != null)
  231.35 +		{
  231.36 +		val = fn.invoke();
  231.37 +		fn = null;
  231.38 +		}
  231.39 +	return val;
  231.40 +}
  231.41 +}
   232.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   232.2 +++ b/src/clojure/lang/DynamicClassLoader.java	Sat Aug 21 06:25:44 2010 -0400
   232.3 @@ -0,0 +1,73 @@
   232.4 +/**
   232.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   232.6 + *   The use and distribution terms for this software are covered by the
   232.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   232.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   232.9 + *   By using this software in any fashion, you are agreeing to be bound by
  232.10 + * 	 the terms of this license.
  232.11 + *   You must not remove this notice, or any other, from this software.
  232.12 + **/
  232.13 +
  232.14 +/* rich Aug 21, 2007 */
  232.15 +
  232.16 +package clojure.lang;
  232.17 +
  232.18 +import java.util.HashMap;
  232.19 +import java.util.Map;
  232.20 +import java.util.concurrent.ConcurrentHashMap;
  232.21 +import java.net.URLClassLoader;
  232.22 +import java.net.URL;
  232.23 +import java.lang.ref.ReferenceQueue;
  232.24 +import java.lang.ref.SoftReference;
  232.25 +
  232.26 +public class DynamicClassLoader extends URLClassLoader{
  232.27 +HashMap<Integer, Object[]> constantVals = new HashMap<Integer, Object[]>();
  232.28 +static ConcurrentHashMap<String, SoftReference<Class>>classCache =
  232.29 +        new ConcurrentHashMap<String, SoftReference<Class> >();
  232.30 +
  232.31 +static final URL[] EMPTY_URLS = new URL[]{};
  232.32 +
  232.33 +static final ReferenceQueue rq = new ReferenceQueue();
  232.34 +
  232.35 +public DynamicClassLoader(){
  232.36 +    //pseudo test in lieu of hasContextClassLoader()
  232.37 +	super(EMPTY_URLS,(Thread.currentThread().getContextClassLoader() == null ||
  232.38 +                Thread.currentThread().getContextClassLoader() == ClassLoader.getSystemClassLoader())?
  232.39 +                Compiler.class.getClassLoader():Thread.currentThread().getContextClassLoader());
  232.40 +}
  232.41 +
  232.42 +public DynamicClassLoader(ClassLoader parent){
  232.43 +	super(EMPTY_URLS,parent);
  232.44 +}
  232.45 +
  232.46 +public Class defineClass(String name, byte[] bytes, Object srcForm){
  232.47 +	Util.clearCache(rq, classCache);
  232.48 +	Class c = defineClass(name, bytes, 0, bytes.length);
  232.49 +    classCache.put(name, new SoftReference(c,rq));
  232.50 +    return c;
  232.51 +}
  232.52 +
  232.53 +protected Class<?> findClass(String name) throws ClassNotFoundException{
  232.54 +    SoftReference<Class> cr = classCache.get(name);
  232.55 +	if(cr != null)
  232.56 +		{
  232.57 +		Class c = cr.get();
  232.58 +        if(c != null)
  232.59 +            return c;
  232.60 +		}
  232.61 +	return super.findClass(name);
  232.62 +}
  232.63 +
  232.64 +public void registerConstants(int id, Object[] val){
  232.65 +	constantVals.put(id, val);
  232.66 +}
  232.67 +
  232.68 +public Object[] getConstants(int id){
  232.69 +	return constantVals.get(id);
  232.70 +}
  232.71 +
  232.72 +public void addURL(URL url){
  232.73 +	super.addURL(url);
  232.74 +}
  232.75 +
  232.76 +}
   233.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   233.2 +++ b/src/clojure/lang/EnumerationSeq.java	Sat Aug 21 06:25:44 2010 -0400
   233.3 @@ -0,0 +1,78 @@
   233.4 +/**
   233.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   233.6 + *   The use and distribution terms for this software are covered by the
   233.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   233.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   233.9 + *   By using this software in any fashion, you are agreeing to be bound by
  233.10 + * 	 the terms of this license.
  233.11 + *   You must not remove this notice, or any other, from this software.
  233.12 + **/
  233.13 +
  233.14 +/* rich Mar 3, 2008 */
  233.15 +
  233.16 +package clojure.lang;
  233.17 +
  233.18 +import java.io.IOException;
  233.19 +import java.io.NotSerializableException;
  233.20 +import java.util.Enumeration;
  233.21 +
  233.22 +public class EnumerationSeq extends ASeq{
  233.23 +final Enumeration iter;
  233.24 +final State state;
  233.25 +
  233.26 +    static class State{
  233.27 +	volatile Object val;
  233.28 +	volatile Object _rest;
  233.29 +}
  233.30 +
  233.31 +public static EnumerationSeq create(Enumeration iter){
  233.32 +	if(iter.hasMoreElements())
  233.33 +		return new EnumerationSeq(iter);
  233.34 +	return null;
  233.35 +}
  233.36 +
  233.37 +EnumerationSeq(Enumeration iter){
  233.38 +	this.iter = iter;
  233.39 +	state = new State();
  233.40 +	this.state.val = state;
  233.41 +	this.state._rest = state;
  233.42 +}
  233.43 +
  233.44 +EnumerationSeq(IPersistentMap meta, Enumeration iter, State state){
  233.45 +	super(meta);
  233.46 +	this.iter = iter;
  233.47 +	this.state = state;
  233.48 +}
  233.49 +
  233.50 +public Object first(){
  233.51 +	if(state.val == state)
  233.52 +		synchronized(state)
  233.53 +			{
  233.54 +			if(state.val == state)
  233.55 +				state.val = iter.nextElement();
  233.56 +			}
  233.57 +	return state.val;
  233.58 +}
  233.59 +
  233.60 +public ISeq next(){
  233.61 +	if(state._rest == state)
  233.62 +		synchronized(state)
  233.63 +			{
  233.64 +			if(state._rest == state)
  233.65 +				{
  233.66 +				first();
  233.67 +				state._rest = create(iter);
  233.68 +				}
  233.69 +			}
  233.70 +	return (ISeq) state._rest;
  233.71 +}
  233.72 +
  233.73 +public EnumerationSeq withMeta(IPersistentMap meta){
  233.74 +	return new EnumerationSeq(meta, iter, state);
  233.75 +}
  233.76 +
  233.77 +private void writeObject (java.io.ObjectOutputStream out) throws IOException {
  233.78 +    throw new NotSerializableException(getClass().getName());
  233.79 +}
  233.80 +
  233.81 +}
   234.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   234.2 +++ b/src/clojure/lang/Fn.java	Sat Aug 21 06:25:44 2010 -0400
   234.3 @@ -0,0 +1,16 @@
   234.4 +/**
   234.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   234.6 + *   The use and distribution terms for this software are covered by the
   234.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   234.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   234.9 + *   By using this software in any fashion, you are agreeing to be bound by
  234.10 + * 	 the terms of this license.
  234.11 + *   You must not remove this notice, or any other, from this software.
  234.12 + **/
  234.13 +
  234.14 +/* rich Nov 25, 2008 */
  234.15 +
  234.16 +package clojure.lang;
  234.17 +
  234.18 +public interface Fn{
  234.19 +}
   235.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   235.2 +++ b/src/clojure/lang/IChunk.java	Sat Aug 21 06:25:44 2010 -0400
   235.3 @@ -0,0 +1,20 @@
   235.4 +/**
   235.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   235.6 + *   The use and distribution terms for this software are covered by the
   235.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   235.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   235.9 + *   By using this software in any fashion, you are agreeing to be bound by
  235.10 + * 	 the terms of this license.
  235.11 + *   You must not remove this notice, or any other, from this software.
  235.12 + **/
  235.13 +
  235.14 +/* rich Jun 18, 2009 */
  235.15 +
  235.16 +package clojure.lang;
  235.17 +
  235.18 +public interface IChunk extends Indexed{
  235.19 +
  235.20 +IChunk dropFirst();
  235.21 +
  235.22 +Object reduce(IFn f, Object start) throws Exception;
  235.23 +}
   236.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   236.2 +++ b/src/clojure/lang/IChunkedSeq.java	Sat Aug 21 06:25:44 2010 -0400
   236.3 @@ -0,0 +1,23 @@
   236.4 +/**
   236.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   236.6 + *   The use and distribution terms for this software are covered by the
   236.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   236.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   236.9 + *   By using this software in any fashion, you are agreeing to be bound by
  236.10 + * 	 the terms of this license.
  236.11 + *   You must not remove this notice, or any other, from this software.
  236.12 + **/
  236.13 +
  236.14 +/* rich May 24, 2009 */
  236.15 +
  236.16 +package clojure.lang;
  236.17 +
  236.18 +public interface IChunkedSeq extends ISeq{
  236.19 +
  236.20 +IChunk chunkedFirst() throws Exception;
  236.21 +
  236.22 +ISeq chunkedNext() throws Exception;
  236.23 +
  236.24 +ISeq chunkedMore() throws Exception;
  236.25 +
  236.26 +}
   237.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   237.2 +++ b/src/clojure/lang/IDeref.java	Sat Aug 21 06:25:44 2010 -0400
   237.3 @@ -0,0 +1,17 @@
   237.4 +/**
   237.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   237.6 + *   The use and distribution terms for this software are covered by the
   237.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   237.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   237.9 + *   By using this software in any fashion, you are agreeing to be bound by
  237.10 + * 	 the terms of this license.
  237.11 + *   You must not remove this notice, or any other, from this software.
  237.12 + **/
  237.13 +
  237.14 +/* rich Feb 9, 2009 */
  237.15 +
  237.16 +package clojure.lang;
  237.17 +
  237.18 +public interface IDeref{
  237.19 +Object deref() throws Exception;
  237.20 +}
   238.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   238.2 +++ b/src/clojure/lang/IEditableCollection.java	Sat Aug 21 06:25:44 2010 -0400
   238.3 @@ -0,0 +1,17 @@
   238.4 +/**
   238.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   238.6 + *   The use and distribution terms for this software are covered by the
   238.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   238.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   238.9 + *   By using this software in any fashion, you are agreeing to be bound by
  238.10 + * 	 the terms of this license.
  238.11 + *   You must not remove this notice, or any other, from this software.
  238.12 + **/
  238.13 +
  238.14 +/* rich Jul 17, 2009 */
  238.15 +
  238.16 +package clojure.lang;
  238.17 +
  238.18 +public interface IEditableCollection{
  238.19 +ITransientCollection asTransient();
  238.20 +}
   239.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   239.2 +++ b/src/clojure/lang/IFn.java	Sat Aug 21 06:25:44 2010 -0400
   239.3 @@ -0,0 +1,90 @@
   239.4 +/**
   239.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   239.6 + *   The use and distribution terms for this software are covered by the
   239.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   239.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   239.9 + *   By using this software in any fashion, you are agreeing to be bound by
  239.10 + * 	 the terms of this license.
  239.11 + *   You must not remove this notice, or any other, from this software.
  239.12 + **/
  239.13 +
  239.14 +/* rich Mar 25, 2006 3:54:03 PM */
  239.15 +
  239.16 +package clojure.lang;
  239.17 +
  239.18 +import java.util.concurrent.Callable;
  239.19 +
  239.20 +public interface IFn extends Callable, Runnable{
  239.21 +
  239.22 +public Object invoke() throws Exception;
  239.23 +
  239.24 +public Object invoke(Object arg1) throws Exception;
  239.25 +
  239.26 +public Object invoke(Object arg1, Object arg2) throws Exception;
  239.27 +
  239.28 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception;
  239.29 +
  239.30 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception;
  239.31 +
  239.32 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception;
  239.33 +
  239.34 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception;
  239.35 +
  239.36 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
  239.37 +		throws Exception;
  239.38 +
  239.39 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.40 +                     Object arg8) throws Exception;
  239.41 +
  239.42 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.43 +                     Object arg8, Object arg9) throws Exception;
  239.44 +
  239.45 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.46 +                     Object arg8, Object arg9, Object arg10) throws Exception;
  239.47 +
  239.48 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.49 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception;
  239.50 +
  239.51 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.52 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception;
  239.53 +
  239.54 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.55 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception;
  239.56 +
  239.57 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.58 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
  239.59 +		throws Exception;
  239.60 +
  239.61 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.62 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.63 +                     Object arg15) throws Exception;
  239.64 +
  239.65 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.66 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.67 +                     Object arg15, Object arg16) throws Exception;
  239.68 +
  239.69 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.70 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.71 +                     Object arg15, Object arg16, Object arg17) throws Exception;
  239.72 +
  239.73 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.74 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.75 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception;
  239.76 +
  239.77 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.78 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.79 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception;
  239.80 +
  239.81 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.82 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.83 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
  239.84 +		throws Exception;
  239.85 +
  239.86 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  239.87 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
  239.88 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20,
  239.89 +                     Object... args)
  239.90 +		throws Exception;
  239.91 +
  239.92 +public Object applyTo(ISeq arglist) throws Exception;
  239.93 +}
   240.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   240.2 +++ b/src/clojure/lang/IKeywordLookup.java	Sat Aug 21 06:25:44 2010 -0400
   240.3 @@ -0,0 +1,17 @@
   240.4 +/**
   240.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   240.6 + *   The use and distribution terms for this software are covered by the
   240.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   240.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   240.9 + *   By using this software in any fashion, you are agreeing to be bound by
  240.10 + * 	 the terms of this license.
  240.11 + *   You must not remove this notice, or any other, from this software.
  240.12 + **/
  240.13 +
  240.14 +/* rich Oct 31, 2009 */
  240.15 +
  240.16 +package clojure.lang;
  240.17 +
  240.18 +public interface IKeywordLookup{
  240.19 +ILookupThunk getLookupThunk(Keyword k);
  240.20 +}
   241.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   241.2 +++ b/src/clojure/lang/ILookup.java	Sat Aug 21 06:25:44 2010 -0400
   241.3 @@ -0,0 +1,19 @@
   241.4 +/**
   241.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   241.6 + *   The use and distribution terms for this software are covered by the
   241.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   241.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   241.9 + *   By using this software in any fashion, you are agreeing to be bound by
  241.10 + * 	 the terms of this license.
  241.11 + *   You must not remove this notice, or any other, from this software.
  241.12 + **/
  241.13 +
  241.14 +/* rich Aug 2, 2009 */
  241.15 +
  241.16 +package clojure.lang;
  241.17 +
  241.18 +public interface ILookup{
  241.19 +Object valAt(Object key);
  241.20 +
  241.21 +Object valAt(Object key, Object notFound);
  241.22 +}
   242.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   242.2 +++ b/src/clojure/lang/ILookupHost.java	Sat Aug 21 06:25:44 2010 -0400
   242.3 @@ -0,0 +1,19 @@
   242.4 +/**
   242.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   242.6 + *   The use and distribution terms for this software are covered by the
   242.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   242.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   242.9 + *   By using this software in any fashion, you are agreeing to be bound by
  242.10 + * 	 the terms of this license.
  242.11 + *   You must not remove this notice, or any other, from this software.
  242.12 + **/
  242.13 +
  242.14 +/* rich Nov 2, 2009 */
  242.15 +
  242.16 +package clojure.lang;
  242.17 +
  242.18 +public interface ILookupHost{
  242.19 +
  242.20 +void swapThunk(int n, ILookupThunk thunk);
  242.21 +
  242.22 +}
   243.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   243.2 +++ b/src/clojure/lang/ILookupSite.java	Sat Aug 21 06:25:44 2010 -0400
   243.3 @@ -0,0 +1,19 @@
   243.4 +/**
   243.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   243.6 + *   The use and distribution terms for this software are covered by the
   243.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   243.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   243.9 + *   By using this software in any fashion, you are agreeing to be bound by
  243.10 + * 	 the terms of this license.
  243.11 + *   You must not remove this notice, or any other, from this software.
  243.12 + **/
  243.13 +
  243.14 +/* rich Nov 2, 2009 */
  243.15 +
  243.16 +package clojure.lang;
  243.17 +
  243.18 +public interface ILookupSite{
  243.19 +
  243.20 +Object fault(Object target, ILookupHost host);
  243.21 +
  243.22 +}
   244.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   244.2 +++ b/src/clojure/lang/ILookupThunk.java	Sat Aug 21 06:25:44 2010 -0400
   244.3 @@ -0,0 +1,19 @@
   244.4 +/**
   244.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   244.6 + *   The use and distribution terms for this software are covered by the
   244.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   244.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   244.9 + *   By using this software in any fashion, you are agreeing to be bound by
  244.10 + * 	 the terms of this license.
  244.11 + *   You must not remove this notice, or any other, from this software.
  244.12 + **/
  244.13 +
  244.14 +/* rich Nov 2, 2009 */
  244.15 +
  244.16 +package clojure.lang;
  244.17 +
  244.18 +public interface ILookupThunk{
  244.19 +
  244.20 +Object get(Object target);
  244.21 +
  244.22 +}
   245.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   245.2 +++ b/src/clojure/lang/IMapEntry.java	Sat Aug 21 06:25:44 2010 -0400
   245.3 @@ -0,0 +1,19 @@
   245.4 +/**
   245.5 + * Copyright (c) Rich Hickey. All rights reserved.
   245.6 + * The use and distribution terms for this software are covered by the
   245.7 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   245.8 + * which can be found in the file epl-v10.html at the root of this distribution.
   245.9 + * By using this software in any fashion, you are agreeing to be bound by
  245.10 + * the terms of this license.
  245.11 + * You must not remove this notice, or any other, from this software.
  245.12 + */
  245.13 +
  245.14 +package clojure.lang;
  245.15 +
  245.16 +import java.util.Map;
  245.17 +
  245.18 +public interface IMapEntry extends Map.Entry{
  245.19 +Object key();
  245.20 +
  245.21 +Object val();
  245.22 +}
   246.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   246.2 +++ b/src/clojure/lang/IMeta.java	Sat Aug 21 06:25:44 2010 -0400
   246.3 @@ -0,0 +1,17 @@
   246.4 +/**
   246.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   246.6 + *   The use and distribution terms for this software are covered by the
   246.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   246.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   246.9 + *   By using this software in any fashion, you are agreeing to be bound by
  246.10 + * 	 the terms of this license.
  246.11 + *   You must not remove this notice, or any other, from this software.
  246.12 + **/
  246.13 +
  246.14 +/* rich Dec 31, 2008 */
  246.15 +
  246.16 +package clojure.lang;
  246.17 +
  246.18 +public interface IMeta {
  246.19 +    IPersistentMap meta();
  246.20 +}
   247.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   247.2 +++ b/src/clojure/lang/IObj.java	Sat Aug 21 06:25:44 2010 -0400
   247.3 @@ -0,0 +1,18 @@
   247.4 +/**
   247.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   247.6 + *   The use and distribution terms for this software are covered by the
   247.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   247.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   247.9 + *   By using this software in any fashion, you are agreeing to be bound by
  247.10 + * 	 the terms of this license.
  247.11 + *   You must not remove this notice, or any other, from this software.
  247.12 + **/
  247.13 +
  247.14 +package clojure.lang;
  247.15 +
  247.16 +
  247.17 +public interface IObj extends IMeta {
  247.18 +
  247.19 +    public IObj withMeta(IPersistentMap meta);
  247.20 +
  247.21 +}
   248.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   248.2 +++ b/src/clojure/lang/IPersistentCollection.java	Sat Aug 21 06:25:44 2010 -0400
   248.3 @@ -0,0 +1,23 @@
   248.4 +package clojure.lang;
   248.5 +
   248.6 +/**
   248.7 + * Copyright (c) Rich Hickey. All rights reserved.
   248.8 + * The use and distribution terms for this software are covered by the
   248.9 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  248.10 + * which can be found in the file epl-v10.html at the root of this distribution.
  248.11 + * By using this software in any fashion, you are agreeing to be bound by
  248.12 + * the terms of this license.
  248.13 + * You must not remove this notice, or any other, from this software.
  248.14 + */
  248.15 +
  248.16 +
  248.17 +public interface IPersistentCollection extends Seqable {
  248.18 +
  248.19 +int count();
  248.20 +
  248.21 +IPersistentCollection cons(Object o);
  248.22 +
  248.23 +IPersistentCollection empty();
  248.24 +
  248.25 +boolean equiv(Object o);
  248.26 +}
   249.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   249.2 +++ b/src/clojure/lang/IPersistentList.java	Sat Aug 21 06:25:44 2010 -0400
   249.3 @@ -0,0 +1,16 @@
   249.4 +/**
   249.5 + * Copyright (c) Rich Hickey. All rights reserved.
   249.6 + * The use and distribution terms for this software are covered by the
   249.7 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   249.8 + * which can be found in the file epl-v10.html at the root of this distribution.
   249.9 + * By using this software in any fashion, you are agreeing to be bound by
  249.10 + * the terms of this license.
  249.11 + * You must not remove this notice, or any other, from this software.
  249.12 + */
  249.13 +
  249.14 +package clojure.lang;
  249.15 +
  249.16 +
  249.17 +public interface IPersistentList extends Sequential, IPersistentStack{
  249.18 +
  249.19 +}
   250.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   250.2 +++ b/src/clojure/lang/IPersistentMap.java	Sat Aug 21 06:25:44 2010 -0400
   250.3 @@ -0,0 +1,23 @@
   250.4 +/**
   250.5 + * Copyright (c) Rich Hickey. All rights reserved.
   250.6 + * The use and distribution terms for this software are covered by the
   250.7 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   250.8 + * which can be found in the file epl-v10.html at the root of this distribution.
   250.9 + * By using this software in any fashion, you are agreeing to be bound by
  250.10 + * the terms of this license.
  250.11 + * You must not remove this notice, or any other, from this software.
  250.12 + */
  250.13 +
  250.14 +package clojure.lang;
  250.15 +
  250.16 +
  250.17 +public interface IPersistentMap extends Iterable, Associative, Counted{
  250.18 +
  250.19 +
  250.20 +IPersistentMap assoc(Object key, Object val);
  250.21 +
  250.22 +IPersistentMap assocEx(Object key, Object val) throws Exception;
  250.23 +
  250.24 +IPersistentMap without(Object key) throws Exception;
  250.25 +
  250.26 +}
   251.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   251.2 +++ b/src/clojure/lang/IPersistentSet.java	Sat Aug 21 06:25:44 2010 -0400
   251.3 @@ -0,0 +1,19 @@
   251.4 +/**
   251.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   251.6 + *   The use and distribution terms for this software are covered by the
   251.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   251.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   251.9 + *   By using this software in any fashion, you are agreeing to be bound by
  251.10 + * 	 the terms of this license.
  251.11 + *   You must not remove this notice, or any other, from this software.
  251.12 + **/
  251.13 +
  251.14 +/* rich Mar 3, 2008 */
  251.15 +
  251.16 +package clojure.lang;
  251.17 +
  251.18 +public interface IPersistentSet extends IPersistentCollection, Counted{
  251.19 +	public IPersistentSet disjoin(Object key) throws Exception;
  251.20 +	public boolean contains(Object key);
  251.21 +	public Object get(Object key);
  251.22 +}
   252.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   252.2 +++ b/src/clojure/lang/IPersistentStack.java	Sat Aug 21 06:25:44 2010 -0400
   252.3 @@ -0,0 +1,19 @@
   252.4 +/**
   252.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   252.6 + *   The use and distribution terms for this software are covered by the
   252.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   252.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   252.9 + *   By using this software in any fashion, you are agreeing to be bound by
  252.10 + * 	 the terms of this license.
  252.11 + *   You must not remove this notice, or any other, from this software.
  252.12 + **/
  252.13 +
  252.14 +/* rich Sep 19, 2007 */
  252.15 +
  252.16 +package clojure.lang;
  252.17 +
  252.18 +public interface IPersistentStack extends IPersistentCollection{
  252.19 +Object peek();
  252.20 +
  252.21 +IPersistentStack pop();
  252.22 +}
   253.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   253.2 +++ b/src/clojure/lang/IPersistentVector.java	Sat Aug 21 06:25:44 2010 -0400
   253.3 @@ -0,0 +1,20 @@
   253.4 +package clojure.lang;
   253.5 +
   253.6 +/**
   253.7 + * Copyright (c) Rich Hickey. All rights reserved.
   253.8 + * The use and distribution terms for this software are covered by the
   253.9 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  253.10 + * which can be found in the file epl-v10.html at the root of this distribution.
  253.11 + * By using this software in any fashion, you are agreeing to be bound by
  253.12 + * the terms of this license.
  253.13 + * You must not remove this notice, or any other, from this software.
  253.14 + */
  253.15 +
  253.16 +public interface IPersistentVector extends Associative, Sequential, IPersistentStack, Reversible, Indexed{
  253.17 +int length();
  253.18 +
  253.19 +IPersistentVector assocN(int i, Object val);
  253.20 +
  253.21 +IPersistentVector cons(Object o);
  253.22 +
  253.23 +}
   254.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   254.2 +++ b/src/clojure/lang/IProxy.java	Sat Aug 21 06:25:44 2010 -0400
   254.3 @@ -0,0 +1,21 @@
   254.4 +/**
   254.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   254.6 + *   The use and distribution terms for this software are covered by the
   254.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   254.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   254.9 + *   By using this software in any fashion, you are agreeing to be bound by
  254.10 + * 	 the terms of this license.
  254.11 + *   You must not remove this notice, or any other, from this software.
  254.12 + **/
  254.13 +
  254.14 +/* rich Feb 27, 2008 */
  254.15 +
  254.16 +package clojure.lang;
  254.17 +
  254.18 +public interface IProxy{
  254.19 +
  254.20 +    public void __initClojureFnMappings(IPersistentMap m);
  254.21 +    public void __updateClojureFnMappings(IPersistentMap m);
  254.22 +    public IPersistentMap __getClojureFnMappings();
  254.23 +
  254.24 +}
   255.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   255.2 +++ b/src/clojure/lang/IReduce.java	Sat Aug 21 06:25:44 2010 -0400
   255.3 @@ -0,0 +1,19 @@
   255.4 +/**
   255.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   255.6 + *   The use and distribution terms for this software are covered by the
   255.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   255.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   255.9 + *   By using this software in any fashion, you are agreeing to be bound by
  255.10 + * 	 the terms of this license.
  255.11 + *   You must not remove this notice, or any other, from this software.
  255.12 + **/
  255.13 +
  255.14 +/* rich Jun 11, 2008 */
  255.15 +
  255.16 +package clojure.lang;
  255.17 +
  255.18 +public interface IReduce{
  255.19 +Object reduce(IFn f) throws Exception;
  255.20 +
  255.21 +Object reduce(IFn f, Object start) throws Exception;
  255.22 +}
   256.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   256.2 +++ b/src/clojure/lang/IRef.java	Sat Aug 21 06:25:44 2010 -0400
   256.3 @@ -0,0 +1,27 @@
   256.4 +/**
   256.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   256.6 + *   The use and distribution terms for this software are covered by the
   256.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   256.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   256.9 + *   By using this software in any fashion, you are agreeing to be bound by
  256.10 + * 	 the terms of this license.
  256.11 + *   You must not remove this notice, or any other, from this software.
  256.12 + **/
  256.13 +
  256.14 +/* rich Nov 18, 2007 */
  256.15 +
  256.16 +package clojure.lang;
  256.17 +
  256.18 +public interface IRef extends IDeref{
  256.19 +
  256.20 +	void setValidator(IFn vf);
  256.21 +
  256.22 +    IFn getValidator();
  256.23 +
  256.24 +    IPersistentMap getWatches();
  256.25 +
  256.26 +    IRef addWatch(Object key, IFn callback);
  256.27 +
  256.28 +    IRef removeWatch(Object key);
  256.29 +
  256.30 +}
   257.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   257.2 +++ b/src/clojure/lang/IReference.java	Sat Aug 21 06:25:44 2010 -0400
   257.3 @@ -0,0 +1,18 @@
   257.4 +/**
   257.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   257.6 + *   The use and distribution terms for this software are covered by the
   257.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   257.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   257.9 + *   By using this software in any fashion, you are agreeing to be bound by
  257.10 + * 	 the terms of this license.
  257.11 + *   You must not remove this notice, or any other, from this software.
  257.12 + **/
  257.13 +
  257.14 +/* rich Dec 31, 2008 */
  257.15 +
  257.16 +package clojure.lang;
  257.17 +
  257.18 +public interface IReference extends IMeta {
  257.19 +    IPersistentMap alterMeta(IFn alter, ISeq args) throws Exception;
  257.20 +    IPersistentMap resetMeta(IPersistentMap m);
  257.21 +}
   258.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   258.2 +++ b/src/clojure/lang/ISeq.java	Sat Aug 21 06:25:44 2010 -0400
   258.3 @@ -0,0 +1,29 @@
   258.4 +/**
   258.5 + * Copyright (c) Rich Hickey. All rights reserved.
   258.6 + * The use and distribution terms for this software are covered by the
   258.7 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   258.8 + * which can be found in the file epl-v10.html at the root of this distribution.
   258.9 + * By using this software in any fashion, you are agreeing to be bound by
  258.10 + * the terms of this license.
  258.11 + * You must not remove this notice, or any other, from this software.
  258.12 + */
  258.13 +
  258.14 +package clojure.lang;
  258.15 +
  258.16 +/**
  258.17 + * A persistent, functional, sequence interface
  258.18 + * <p/>
  258.19 + * ISeqs are immutable values, i.e. neither first(), nor rest() changes
  258.20 + * or invalidates the ISeq
  258.21 + */
  258.22 +public interface ISeq extends IPersistentCollection, Sequential{
  258.23 +
  258.24 +Object first();
  258.25 +
  258.26 +ISeq next();
  258.27 +
  258.28 +ISeq more();
  258.29 +
  258.30 +ISeq cons(Object o);
  258.31 +
  258.32 +}
   259.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   259.2 +++ b/src/clojure/lang/ITransientAssociative.java	Sat Aug 21 06:25:44 2010 -0400
   259.3 @@ -0,0 +1,18 @@
   259.4 +/**
   259.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   259.6 + *   The use and distribution terms for this software are covered by the
   259.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   259.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   259.9 + *   By using this software in any fashion, you are agreeing to be bound by
  259.10 + * 	 the terms of this license.
  259.11 + *   You must not remove this notice, or any other, from this software.
  259.12 + **/
  259.13 +
  259.14 +/* rich Jul 17, 2009 */
  259.15 +
  259.16 +package clojure.lang;
  259.17 +
  259.18 +public interface ITransientAssociative extends ITransientCollection, ILookup{
  259.19 +
  259.20 +ITransientAssociative assoc(Object key, Object val);
  259.21 +}
   260.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   260.2 +++ b/src/clojure/lang/ITransientCollection.java	Sat Aug 21 06:25:44 2010 -0400
   260.3 @@ -0,0 +1,20 @@
   260.4 +/**
   260.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   260.6 + *   The use and distribution terms for this software are covered by the
   260.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   260.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   260.9 + *   By using this software in any fashion, you are agreeing to be bound by
  260.10 + * 	 the terms of this license.
  260.11 + *   You must not remove this notice, or any other, from this software.
  260.12 + **/
  260.13 +
  260.14 +/* rich Jul 17, 2009 */
  260.15 +
  260.16 +package clojure.lang;
  260.17 +
  260.18 +public interface ITransientCollection{
  260.19 +
  260.20 +ITransientCollection conj(Object val);
  260.21 +
  260.22 +IPersistentCollection persistent();
  260.23 +}
   261.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   261.2 +++ b/src/clojure/lang/ITransientMap.java	Sat Aug 21 06:25:44 2010 -0400
   261.3 @@ -0,0 +1,22 @@
   261.4 +/**
   261.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   261.6 + *   The use and distribution terms for this software are covered by the
   261.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   261.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   261.9 + *   By using this software in any fashion, you are agreeing to be bound by
  261.10 + * 	 the terms of this license.
  261.11 + *   You must not remove this notice, or any other, from this software.
  261.12 + **/
  261.13 +
  261.14 +/* rich Jul 17, 2009 */
  261.15 +
  261.16 +package clojure.lang;
  261.17 +
  261.18 +public interface ITransientMap extends ITransientAssociative, Counted{
  261.19 +	
  261.20 +ITransientMap assoc(Object key, Object val);
  261.21 +
  261.22 +ITransientMap without(Object key);
  261.23 +
  261.24 +IPersistentMap persistent();
  261.25 +}
   262.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   262.2 +++ b/src/clojure/lang/ITransientSet.java	Sat Aug 21 06:25:44 2010 -0400
   262.3 @@ -0,0 +1,19 @@
   262.4 +/**
   262.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   262.6 + *   The use and distribution terms for this software are covered by the
   262.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   262.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   262.9 + *   By using this software in any fashion, you are agreeing to be bound by
  262.10 + * 	 the terms of this license.
  262.11 + *   You must not remove this notice, or any other, from this software.
  262.12 + **/
  262.13 +
  262.14 +/* rich Mar 3, 2008 */
  262.15 +
  262.16 +package clojure.lang;
  262.17 +
  262.18 +public interface ITransientSet extends ITransientCollection, Counted{
  262.19 +	public ITransientSet disjoin(Object key) throws Exception;
  262.20 +	public boolean contains(Object key);
  262.21 +	public Object get(Object key);
  262.22 +}
   263.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   263.2 +++ b/src/clojure/lang/ITransientVector.java	Sat Aug 21 06:25:44 2010 -0400
   263.3 @@ -0,0 +1,20 @@
   263.4 +/**
   263.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   263.6 + *   The use and distribution terms for this software are covered by the
   263.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   263.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   263.9 + *   By using this software in any fashion, you are agreeing to be bound by
  263.10 + * 	 the terms of this license.
  263.11 + *   You must not remove this notice, or any other, from this software.
  263.12 + **/
  263.13 +
  263.14 +/* rich Jul 17, 2009 */
  263.15 +
  263.16 +package clojure.lang;
  263.17 +
  263.18 +public interface ITransientVector extends ITransientAssociative, Indexed{
  263.19 +
  263.20 +ITransientVector assocN(int i, Object val);
  263.21 +
  263.22 +ITransientVector pop();
  263.23 +}
   264.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   264.2 +++ b/src/clojure/lang/Indexed.java	Sat Aug 21 06:25:44 2010 -0400
   264.3 @@ -0,0 +1,19 @@
   264.4 +/**
   264.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   264.6 + *   The use and distribution terms for this software are covered by the
   264.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   264.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   264.9 + *   By using this software in any fashion, you are agreeing to be bound by
  264.10 + * 	 the terms of this license.
  264.11 + *   You must not remove this notice, or any other, from this software.
  264.12 + **/
  264.13 +
  264.14 +/* rich May 24, 2009 */
  264.15 +
  264.16 +package clojure.lang;
  264.17 +
  264.18 +public interface Indexed extends Counted{
  264.19 +Object nth(int i);
  264.20 +
  264.21 +Object nth(int i, Object notFound);
  264.22 +}
   265.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   265.2 +++ b/src/clojure/lang/IndexedSeq.java	Sat Aug 21 06:25:44 2010 -0400
   265.3 @@ -0,0 +1,16 @@
   265.4 +/**
   265.5 + * Copyright (c) Rich Hickey. All rights reserved.
   265.6 + * The use and distribution terms for this software are covered by the
   265.7 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   265.8 + * which can be found in the file epl-v10.html at the root of this distribution.
   265.9 + * By using this software in any fashion, you are agreeing to be bound by
  265.10 + * the terms of this license.
  265.11 + * You must not remove this notice, or any other, from this software.
  265.12 + */
  265.13 +
  265.14 +package clojure.lang;
  265.15 +
  265.16 +public interface IndexedSeq extends ISeq, Counted{
  265.17 +
  265.18 +public int index();
  265.19 +}
   266.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   266.2 +++ b/src/clojure/lang/IteratorSeq.java	Sat Aug 21 06:25:44 2010 -0400
   266.3 @@ -0,0 +1,75 @@
   266.4 +/**
   266.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   266.6 + *   The use and distribution terms for this software are covered by the
   266.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   266.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   266.9 + *   By using this software in any fashion, you are agreeing to be bound by
  266.10 + * 	 the terms of this license.
  266.11 + *   You must not remove this notice, or any other, from this software.
  266.12 + **/
  266.13 +
  266.14 +package clojure.lang;
  266.15 +
  266.16 +import java.io.IOException;
  266.17 +import java.io.NotSerializableException;
  266.18 +import java.util.Iterator;
  266.19 +
  266.20 +public class IteratorSeq extends ASeq{
  266.21 +final Iterator iter;
  266.22 +final State state;
  266.23 +
  266.24 +    static class State{
  266.25 +	volatile Object val;
  266.26 +	volatile Object _rest;
  266.27 +}
  266.28 +
  266.29 +public static IteratorSeq create(Iterator iter){
  266.30 +	if(iter.hasNext())
  266.31 +		return new IteratorSeq(iter);
  266.32 +	return null;
  266.33 +}
  266.34 +
  266.35 +IteratorSeq(Iterator iter){
  266.36 +	this.iter = iter;
  266.37 +	state = new State();
  266.38 +	this.state.val = state;
  266.39 +	this.state._rest = state;
  266.40 +}
  266.41 +
  266.42 +IteratorSeq(IPersistentMap meta, Iterator iter, State state){
  266.43 +	super(meta);
  266.44 +	this.iter = iter;
  266.45 +	this.state = state;
  266.46 +}
  266.47 +
  266.48 +public Object first(){
  266.49 +	if(state.val == state)
  266.50 +		synchronized(state)
  266.51 +			{
  266.52 +			if(state.val == state)
  266.53 +				state.val = iter.next();
  266.54 +			}
  266.55 +	return state.val;
  266.56 +}
  266.57 +
  266.58 +public ISeq next(){
  266.59 +	if(state._rest == state)
  266.60 +		synchronized(state)
  266.61 +			{
  266.62 +			if(state._rest == state)
  266.63 +				{
  266.64 +				first();
  266.65 +				state._rest = create(iter);
  266.66 +				}
  266.67 +			}
  266.68 +	return (ISeq) state._rest;
  266.69 +}
  266.70 +
  266.71 +public IteratorSeq withMeta(IPersistentMap meta){
  266.72 +	return new IteratorSeq(meta, iter, state);
  266.73 +}
  266.74 +
  266.75 +private void writeObject (java.io.ObjectOutputStream out) throws IOException {
  266.76 +    throw new NotSerializableException(getClass().getName());
  266.77 +}
  266.78 +}
   267.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   267.2 +++ b/src/clojure/lang/Keyword.java	Sat Aug 21 06:25:44 2010 -0400
   267.3 @@ -0,0 +1,225 @@
   267.4 +/**
   267.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   267.6 + *   The use and distribution terms for this software are covered by the
   267.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   267.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   267.9 + *   By using this software in any fashion, you are agreeing to be bound by
  267.10 + * 	 the terms of this license.
  267.11 + *   You must not remove this notice, or any other, from this software.
  267.12 + **/
  267.13 +
  267.14 +/* rich Mar 29, 2006 10:39:05 AM */
  267.15 +
  267.16 +package clojure.lang;
  267.17 +
  267.18 +import java.io.ObjectStreamException;
  267.19 +import java.io.Serializable;
  267.20 +import java.util.concurrent.ConcurrentHashMap;
  267.21 +import java.lang.ref.ReferenceQueue;
  267.22 +import java.lang.ref.SoftReference;
  267.23 +
  267.24 +
  267.25 +public final class Keyword implements IFn, Comparable, Named, Serializable {
  267.26 +
  267.27 +private static ConcurrentHashMap<Symbol, SoftReference<Keyword>> table = new ConcurrentHashMap();
  267.28 +static final ReferenceQueue rq = new ReferenceQueue();
  267.29 +public final Symbol sym;
  267.30 +final int hash;
  267.31 +
  267.32 +public static Keyword intern(Symbol sym){
  267.33 +	Util.clearCache(rq, table);
  267.34 +	Keyword k = new Keyword(sym);
  267.35 +	SoftReference<Keyword> existingRef = table.putIfAbsent(sym, new SoftReference<Keyword>(k,rq));
  267.36 +	if(existingRef == null)
  267.37 +		return k;
  267.38 +	Keyword existingk = existingRef.get();
  267.39 +	if(existingk != null)
  267.40 +		return existingk;
  267.41 +	//entry died in the interim, do over
  267.42 +	return intern(sym);
  267.43 +}
  267.44 +
  267.45 +public static Keyword intern(String ns, String name){
  267.46 +	return intern(Symbol.intern(ns, name));
  267.47 +}
  267.48 +
  267.49 +public static Keyword intern(String nsname){
  267.50 +	return intern(Symbol.intern(nsname));
  267.51 +}
  267.52 +
  267.53 +private Keyword(Symbol sym){
  267.54 +	this.sym = sym;
  267.55 +	hash = sym.hashCode() + 0x9e3779b9;
  267.56 +}
  267.57 +
  267.58 +public final int hashCode(){
  267.59 +	return hash;
  267.60 +}
  267.61 +
  267.62 +public String toString(){
  267.63 +	return ":" + sym;
  267.64 +}
  267.65 +
  267.66 +public Object throwArity(){
  267.67 +	throw new IllegalArgumentException("Wrong number of args passed to keyword: "
  267.68 +	                                   + toString());
  267.69 +}
  267.70 +
  267.71 +public Object call() throws Exception{
  267.72 +	return throwArity();
  267.73 +}
  267.74 +
  267.75 +public void run(){
  267.76 +	throw new UnsupportedOperationException();
  267.77 +}
  267.78 +
  267.79 +public Object invoke() throws Exception{
  267.80 +	return throwArity();
  267.81 +}
  267.82 +
  267.83 +public int compareTo(Object o){
  267.84 +	return sym.compareTo(((Keyword) o).sym);
  267.85 +}
  267.86 +
  267.87 +
  267.88 +public String getNamespace(){
  267.89 +	return sym.getNamespace();
  267.90 +}
  267.91 +
  267.92 +public String getName(){
  267.93 +	return sym.getName();
  267.94 +}
  267.95 +
  267.96 +private Object readResolve() throws ObjectStreamException{
  267.97 +	return intern(sym);
  267.98 +}
  267.99 +
 267.100 +/**
 267.101 + * Indexer implements IFn for attr access
 267.102 + *
 267.103 + * @param obj - must be IPersistentMap
 267.104 + * @return the value at the key or nil if not found
 267.105 + * @throws Exception
 267.106 + */
 267.107 +final public Object invoke(Object obj) throws Exception{
 267.108 +	if(obj instanceof ILookup)
 267.109 +		return ((ILookup)obj).valAt(this);
 267.110 +	return RT.get(obj, this);
 267.111 +}
 267.112 +
 267.113 +final public Object invoke(Object obj, Object notFound) throws Exception{
 267.114 +	if(obj instanceof ILookup)
 267.115 +		return ((ILookup)obj).valAt(this,notFound);
 267.116 +	return RT.get(obj, this, notFound);
 267.117 +}
 267.118 +
 267.119 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{
 267.120 +	return throwArity();
 267.121 +}
 267.122 +
 267.123 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{
 267.124 +	return throwArity();
 267.125 +}
 267.126 +
 267.127 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{
 267.128 +	return throwArity();
 267.129 +}
 267.130 +
 267.131 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{
 267.132 +	return throwArity();
 267.133 +}
 267.134 +
 267.135 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
 267.136 +		throws Exception{
 267.137 +	return throwArity();
 267.138 +}
 267.139 +
 267.140 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.141 +                     Object arg8) throws Exception{
 267.142 +	return throwArity();
 267.143 +}
 267.144 +
 267.145 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.146 +                     Object arg8, Object arg9) throws Exception{
 267.147 +	return throwArity();
 267.148 +}
 267.149 +
 267.150 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.151 +                     Object arg8, Object arg9, Object arg10) throws Exception{
 267.152 +	return throwArity();
 267.153 +}
 267.154 +
 267.155 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.156 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{
 267.157 +	return throwArity();
 267.158 +}
 267.159 +
 267.160 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.161 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{
 267.162 +	return throwArity();
 267.163 +}
 267.164 +
 267.165 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.166 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13)
 267.167 +		throws Exception{
 267.168 +	return throwArity();
 267.169 +}
 267.170 +
 267.171 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.172 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
 267.173 +		throws Exception{
 267.174 +	return throwArity();
 267.175 +}
 267.176 +
 267.177 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.178 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.179 +                     Object arg15) throws Exception{
 267.180 +	return throwArity();
 267.181 +}
 267.182 +
 267.183 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.184 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.185 +                     Object arg15, Object arg16) throws Exception{
 267.186 +	return throwArity();
 267.187 +}
 267.188 +
 267.189 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.190 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.191 +                     Object arg15, Object arg16, Object arg17) throws Exception{
 267.192 +	return throwArity();
 267.193 +}
 267.194 +
 267.195 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.196 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.197 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{
 267.198 +	return throwArity();
 267.199 +}
 267.200 +
 267.201 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.202 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.203 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{
 267.204 +	return throwArity();
 267.205 +}
 267.206 +
 267.207 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.208 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.209 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
 267.210 +		throws Exception{
 267.211 +	return throwArity();
 267.212 +}
 267.213 +
 267.214 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 267.215 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 267.216 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20,
 267.217 +                     Object... args)
 267.218 +		throws Exception{
 267.219 +	return throwArity();
 267.220 +}
 267.221 +
 267.222 +
 267.223 +public Object applyTo(ISeq arglist) throws Exception{
 267.224 +	return AFn.applyToHelper(this, arglist);
 267.225 +}
 267.226 +
 267.227 +
 267.228 +}
   268.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   268.2 +++ b/src/clojure/lang/KeywordLookupSite.java	Sat Aug 21 06:25:44 2010 -0400
   268.3 @@ -0,0 +1,65 @@
   268.4 +/**
   268.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   268.6 + *   The use and distribution terms for this software are covered by the
   268.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   268.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   268.9 + *   By using this software in any fashion, you are agreeing to be bound by
  268.10 + * 	 the terms of this license.
  268.11 + *   You must not remove this notice, or any other, from this software.
  268.12 + **/
  268.13 +
  268.14 +/* rich Nov 2, 2009 */
  268.15 +
  268.16 +package clojure.lang;
  268.17 +
  268.18 +public final class KeywordLookupSite implements ILookupSite, ILookupThunk{
  268.19 +
  268.20 +final int n;
  268.21 +final Keyword k;
  268.22 +
  268.23 +public KeywordLookupSite(int n, Keyword k){
  268.24 +	this.n = n;
  268.25 +	this.k = k;
  268.26 +}
  268.27 +
  268.28 +public Object fault(Object target, ILookupHost host){
  268.29 +	if(target instanceof IKeywordLookup)
  268.30 +		{
  268.31 +		return install(target, host);
  268.32 +		}
  268.33 +	else if(target instanceof ILookup)
  268.34 +		{
  268.35 +		host.swapThunk(n,ilookupThunk(target.getClass()));
  268.36 +		return ((ILookup) target).valAt(k);
  268.37 +		}
  268.38 +	host.swapThunk(n,this);
  268.39 +	return RT.get(target, k);
  268.40 +}
  268.41 +
  268.42 +public Object get(Object target){
  268.43 +	if(target instanceof IKeywordLookup || target instanceof ILookup)
  268.44 +		return this;
  268.45 +	return RT.get(target,k);
  268.46 +}
  268.47 +
  268.48 +private ILookupThunk ilookupThunk(final Class c){
  268.49 +	return new ILookupThunk(){
  268.50 +			public Object get(Object target){
  268.51 +				if(target != null && target.getClass() == c)
  268.52 +					return ((ILookup) target).valAt(k);
  268.53 +				return this;
  268.54 +			}
  268.55 +		};
  268.56 +}
  268.57 +
  268.58 +private Object install(Object target, ILookupHost host){
  268.59 +	ILookupThunk t = ((IKeywordLookup)target).getLookupThunk(k);
  268.60 +	if(t != null)
  268.61 +		{
  268.62 +		host.swapThunk(n,t);
  268.63 +		return t.get(target);
  268.64 +		}
  268.65 +	host.swapThunk(n,ilookupThunk(target.getClass()));
  268.66 +	return ((ILookup) target).valAt(k);
  268.67 +}
  268.68 +}
   269.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   269.2 +++ b/src/clojure/lang/LazilyPersistentVector.java	Sat Aug 21 06:25:44 2010 -0400
   269.3 @@ -0,0 +1,34 @@
   269.4 +/**
   269.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   269.6 + *   The use and distribution terms for this software are covered by the
   269.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   269.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   269.9 + *   By using this software in any fashion, you are agreeing to be bound by
  269.10 + * 	 the terms of this license.
  269.11 + *   You must not remove this notice, or any other, from this software.
  269.12 + **/
  269.13 +
  269.14 +/* rich May 14, 2008 */
  269.15 +
  269.16 +package clojure.lang;
  269.17 +
  269.18 +import java.util.Collection;
  269.19 +
  269.20 +public class LazilyPersistentVector{
  269.21 +
  269.22 +
  269.23 +static public IPersistentVector createOwning(Object... items){
  269.24 +	if(items.length == 0)
  269.25 +		return PersistentVector.EMPTY;
  269.26 +	else if(items.length <= 32)
  269.27 +		return new PersistentVector(items.length, 5, PersistentVector.EMPTY_NODE,items);
  269.28 +	return PersistentVector.create(items);
  269.29 +}
  269.30 +
  269.31 +static public IPersistentVector create(Collection coll){
  269.32 +	if(!(coll instanceof ISeq) && coll.size() <= 32)
  269.33 +		return createOwning(coll.toArray());
  269.34 +	return PersistentVector.create(RT.seq(coll));
  269.35 +}
  269.36 +
  269.37 +}
   270.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   270.2 +++ b/src/clojure/lang/LazySeq.java	Sat Aug 21 06:25:44 2010 -0400
   270.3 @@ -0,0 +1,251 @@
   270.4 +/**
   270.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   270.6 + *   The use and distribution terms for this software are covered by the
   270.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   270.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   270.9 + *   By using this software in any fashion, you are agreeing to be bound by
  270.10 + * 	 the terms of this license.
  270.11 + *   You must not remove this notice, or any other, from this software.
  270.12 + **/
  270.13 +
  270.14 +/* rich Jan 31, 2009 */
  270.15 +
  270.16 +package clojure.lang;
  270.17 +
  270.18 +import java.util.*;
  270.19 +
  270.20 +public final class LazySeq extends Obj implements ISeq, List{
  270.21 +
  270.22 +private IFn fn;
  270.23 +private Object sv;
  270.24 +private ISeq s;
  270.25 +
  270.26 +public LazySeq(IFn fn){
  270.27 +	this.fn = fn;
  270.28 +}
  270.29 +
  270.30 +private LazySeq(IPersistentMap meta, ISeq s){
  270.31 +	super(meta);
  270.32 +	this.fn = null;
  270.33 +	this.s = s;
  270.34 +}
  270.35 +
  270.36 +public Obj withMeta(IPersistentMap meta){
  270.37 +	return new LazySeq(meta, seq());
  270.38 +}
  270.39 +
  270.40 +final synchronized Object sval(){
  270.41 +	if(fn != null)
  270.42 +		{
  270.43 +		try
  270.44 +			{
  270.45 +			sv = fn.invoke();
  270.46 +			fn = null;
  270.47 +			}
  270.48 +		catch(Exception e)
  270.49 +			{
  270.50 +			throw new RuntimeException(e);
  270.51 +			}
  270.52 +		}
  270.53 +	if(sv != null)
  270.54 +		return sv;
  270.55 +	return s;
  270.56 +}
  270.57 +
  270.58 +final synchronized public ISeq seq(){
  270.59 +	sval();
  270.60 +	if(sv != null)
  270.61 +		{
  270.62 +		Object ls = sv;
  270.63 +		sv = null;
  270.64 +		while(ls instanceof LazySeq)
  270.65 +			{
  270.66 +			ls = ((LazySeq)ls).sval();
  270.67 +			}
  270.68 +		s = RT.seq(ls);
  270.69 +		}
  270.70 +	return s;
  270.71 +}
  270.72 +
  270.73 +public int count(){
  270.74 +	int c = 0;
  270.75 +	for(ISeq s = seq(); s != null; s = s.next())
  270.76 +		++c;                                                                                
  270.77 +	return c;
  270.78 +}
  270.79 +
  270.80 +public Object first(){
  270.81 +	seq();
  270.82 +	if(s == null)
  270.83 +		return null;
  270.84 +	return s.first();
  270.85 +}
  270.86 +
  270.87 +public ISeq next(){
  270.88 +	seq();
  270.89 +	if(s == null)
  270.90 +		return null;
  270.91 +	return s.next();	
  270.92 +}
  270.93 +
  270.94 +public ISeq more(){
  270.95 +	seq();
  270.96 +	if(s == null)
  270.97 +		return PersistentList.EMPTY;
  270.98 +	return s.more();
  270.99 +}
 270.100 +
 270.101 +public ISeq cons(Object o){
 270.102 +	return RT.cons(o, seq());
 270.103 +}
 270.104 +
 270.105 +public IPersistentCollection empty(){
 270.106 +	return PersistentList.EMPTY;
 270.107 +}
 270.108 +
 270.109 +public boolean equiv(Object o){
 270.110 +	return equals(o);
 270.111 +}
 270.112 +
 270.113 +public int hashCode(){
 270.114 +	return Util.hash(seq());
 270.115 +}
 270.116 +
 270.117 +public boolean equals(Object o){
 270.118 +	ISeq s = seq();
 270.119 +	if(s != null)
 270.120 +		return s.equiv(o);
 270.121 +	else
 270.122 +		return (o instanceof Sequential || o instanceof List) && RT.seq(o) == null;
 270.123 +}
 270.124 +
 270.125 +
 270.126 +// java.util.Collection implementation
 270.127 +
 270.128 +public Object[] toArray(){
 270.129 +	return RT.seqToArray(seq());
 270.130 +}
 270.131 +
 270.132 +public boolean add(Object o){
 270.133 +	throw new UnsupportedOperationException();
 270.134 +}
 270.135 +
 270.136 +public boolean remove(Object o){
 270.137 +	throw new UnsupportedOperationException();
 270.138 +}
 270.139 +
 270.140 +public boolean addAll(Collection c){
 270.141 +	throw new UnsupportedOperationException();
 270.142 +}
 270.143 +
 270.144 +public void clear(){
 270.145 +	throw new UnsupportedOperationException();
 270.146 +}
 270.147 +
 270.148 +public boolean retainAll(Collection c){
 270.149 +	throw new UnsupportedOperationException();
 270.150 +}
 270.151 +
 270.152 +public boolean removeAll(Collection c){
 270.153 +	throw new UnsupportedOperationException();
 270.154 +}
 270.155 +
 270.156 +public boolean containsAll(Collection c){
 270.157 +	for(Object o : c)
 270.158 +		{
 270.159 +		if(!contains(o))
 270.160 +			return false;
 270.161 +		}
 270.162 +	return true;
 270.163 +}
 270.164 +
 270.165 +public Object[] toArray(Object[] a){
 270.166 +	if(a.length >= count())
 270.167 +		{
 270.168 +		ISeq s = seq();
 270.169 +		for(int i = 0; s != null; ++i, s = s.next())
 270.170 +			{
 270.171 +			a[i] = s.first();
 270.172 +			}
 270.173 +		if(a.length > count())
 270.174 +			a[count()] = null;
 270.175 +		return a;
 270.176 +		}
 270.177 +	else
 270.178 +		return toArray();
 270.179 +}
 270.180 +
 270.181 +public int size(){
 270.182 +	return count();
 270.183 +}
 270.184 +
 270.185 +public boolean isEmpty(){
 270.186 +	return seq() == null;
 270.187 +}
 270.188 +
 270.189 +public boolean contains(Object o){
 270.190 +	for(ISeq s = seq(); s != null; s = s.next())
 270.191 +		{
 270.192 +		if(Util.equiv(s.first(), o))
 270.193 +			return true;
 270.194 +		}
 270.195 +	return false;
 270.196 +}
 270.197 +
 270.198 +public Iterator iterator(){
 270.199 +	return new SeqIterator(seq());
 270.200 +}
 270.201 +
 270.202 +//////////// List stuff /////////////////
 270.203 +private List reify(){
 270.204 +	return new ArrayList(this);
 270.205 +}
 270.206 +
 270.207 +public List subList(int fromIndex, int toIndex){
 270.208 +	return reify().subList(fromIndex, toIndex);
 270.209 +}
 270.210 +
 270.211 +public Object set(int index, Object element){
 270.212 +	throw new UnsupportedOperationException();
 270.213 +}
 270.214 +
 270.215 +public Object remove(int index){
 270.216 +	throw new UnsupportedOperationException();
 270.217 +}
 270.218 +
 270.219 +public int indexOf(Object o){
 270.220 +	ISeq s = seq();
 270.221 +	for(int i = 0; s != null; s = s.next(), i++)
 270.222 +		{
 270.223 +		if(Util.equiv(s.first(), o))
 270.224 +			return i;
 270.225 +		}
 270.226 +	return -1;
 270.227 +}
 270.228 +
 270.229 +public int lastIndexOf(Object o){
 270.230 +	return reify().lastIndexOf(o);
 270.231 +}
 270.232 +
 270.233 +public ListIterator listIterator(){
 270.234 +	return reify().listIterator();
 270.235 +}
 270.236 +
 270.237 +public ListIterator listIterator(int index){
 270.238 +	return reify().listIterator(index);
 270.239 +}
 270.240 +
 270.241 +public Object get(int index){
 270.242 +	return RT.nth(this, index);
 270.243 +}
 270.244 +
 270.245 +public void add(int index, Object element){
 270.246 +	throw new UnsupportedOperationException();
 270.247 +}
 270.248 +
 270.249 +public boolean addAll(int index, Collection c){
 270.250 +	throw new UnsupportedOperationException();
 270.251 +}
 270.252 +
 270.253 +
 270.254 +}
   271.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   271.2 +++ b/src/clojure/lang/LineNumberingPushbackReader.java	Sat Aug 21 06:25:44 2010 -0400
   271.3 @@ -0,0 +1,75 @@
   271.4 +/**
   271.5 + * Copyright (c) Rich Hickey. All rights reserved.
   271.6 + * The use and distribution terms for this software are covered by the
   271.7 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   271.8 + * which can be found in the file epl-v10.html at the root of this distribution.
   271.9 + * By using this software in any fashion, you are agreeing to be bound by
  271.10 + * the terms of this license.
  271.11 + * You must not remove this notice, or any other, from this software.
  271.12 + */
  271.13 +
  271.14 +package clojure.lang;
  271.15 +
  271.16 +import java.io.PushbackReader;
  271.17 +import java.io.Reader;
  271.18 +import java.io.LineNumberReader;
  271.19 +import java.io.IOException;
  271.20 +
  271.21 +
  271.22 +public class LineNumberingPushbackReader extends PushbackReader{
  271.23 +
  271.24 +// This class is a PushbackReader that wraps a LineNumberReader. The code
  271.25 +// here to handle line terminators only mentions '\n' because
  271.26 +// LineNumberReader collapses all occurrences of CR, LF, and CRLF into a
  271.27 +// single '\n'.
  271.28 +
  271.29 +private static final int newline = (int) '\n';
  271.30 +
  271.31 +private boolean _atLineStart = true;
  271.32 +private boolean _prev;
  271.33 +
  271.34 +public LineNumberingPushbackReader(Reader r){
  271.35 +	super(new LineNumberReader(r));
  271.36 +}
  271.37 +
  271.38 +public int getLineNumber(){
  271.39 +	return ((LineNumberReader) in).getLineNumber() + 1;
  271.40 +}
  271.41 +
  271.42 +public int read() throws IOException{
  271.43 +    int c = super.read();
  271.44 +    _prev = _atLineStart;
  271.45 +    _atLineStart = (c == newline) || (c == -1);
  271.46 +    return c;
  271.47 +}
  271.48 +
  271.49 +public void unread(int c) throws IOException{
  271.50 +    super.unread(c);
  271.51 +    _atLineStart = _prev;
  271.52 +}
  271.53 +
  271.54 +public String readLine() throws IOException{
  271.55 +    int c = read();
  271.56 +    String line;
  271.57 +    switch (c) {
  271.58 +    case -1:
  271.59 +        line = null;
  271.60 +        break;
  271.61 +    case newline:
  271.62 +        line = "";
  271.63 +        break;
  271.64 +    default:
  271.65 +        String first = String.valueOf((char) c);
  271.66 +        String rest = ((LineNumberReader)in).readLine();
  271.67 +        line = (rest == null) ? first : first + rest;
  271.68 +        _prev = false;
  271.69 +        _atLineStart = true;
  271.70 +        break;
  271.71 +    }
  271.72 +    return line;
  271.73 +}
  271.74 +
  271.75 +public boolean atLineStart(){
  271.76 +    return _atLineStart;
  271.77 +}
  271.78 +}
   272.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   272.2 +++ b/src/clojure/lang/LispReader.java	Sat Aug 21 06:25:44 2010 -0400
   272.3 @@ -0,0 +1,1103 @@
   272.4 +/**
   272.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   272.6 + *   The use and distribution terms for this software are covered by the
   272.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   272.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   272.9 + *   By using this software in any fashion, you are agreeing to be bound by
  272.10 + * 	 the terms of this license.
  272.11 + *   You must not remove this notice, or any other, from this software.
  272.12 + **/
  272.13 +
  272.14 +package clojure.lang;
  272.15 +
  272.16 +import java.io.*;
  272.17 +import java.util.regex.Pattern;
  272.18 +import java.util.regex.Matcher;
  272.19 +import java.util.ArrayList;
  272.20 +import java.util.List;
  272.21 +import java.util.Map;
  272.22 +import java.math.BigInteger;
  272.23 +import java.math.BigDecimal;
  272.24 +import java.lang.*;
  272.25 +
  272.26 +public class LispReader{
  272.27 +
  272.28 +static final Symbol QUOTE = Symbol.create("quote");
  272.29 +static final Symbol THE_VAR = Symbol.create("var");
  272.30 +//static Symbol SYNTAX_QUOTE = Symbol.create(null, "syntax-quote");
  272.31 +static Symbol UNQUOTE = Symbol.create("clojure.core", "unquote");
  272.32 +static Symbol UNQUOTE_SPLICING = Symbol.create("clojure.core", "unquote-splicing");
  272.33 +static Symbol CONCAT = Symbol.create("clojure.core", "concat");
  272.34 +static Symbol SEQ = Symbol.create("clojure.core", "seq");
  272.35 +static Symbol LIST = Symbol.create("clojure.core", "list");
  272.36 +static Symbol APPLY = Symbol.create("clojure.core", "apply");
  272.37 +static Symbol HASHMAP = Symbol.create("clojure.core", "hash-map");
  272.38 +static Symbol HASHSET = Symbol.create("clojure.core", "hash-set");
  272.39 +static Symbol VECTOR = Symbol.create("clojure.core", "vector");
  272.40 +static Symbol WITH_META = Symbol.create("clojure.core", "with-meta");
  272.41 +static Symbol META = Symbol.create("clojure.core", "meta");
  272.42 +static Symbol DEREF = Symbol.create("clojure.core", "deref");
  272.43 +//static Symbol DEREF_BANG = Symbol.create("clojure.core", "deref!");
  272.44 +
  272.45 +static IFn[] macros = new IFn[256];
  272.46 +static IFn[] dispatchMacros = new IFn[256];
  272.47 +//static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^:/]][^:/]*/)?[\\D&&[^:/]][^:/]*");
  272.48 +static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^/]].*/)?([\\D&&[^/]][^/]*)");
  272.49 +//static Pattern varPat = Pattern.compile("([\\D&&[^:\\.]][^:\\.]*):([\\D&&[^:\\.]][^:\\.]*)");
  272.50 +//static Pattern intPat = Pattern.compile("[-+]?[0-9]+\\.?");
  272.51 +static Pattern intPat =
  272.52 +		Pattern.compile(
  272.53 +				"([-+]?)(?:(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]+)");
  272.54 +static Pattern ratioPat = Pattern.compile("([-+]?[0-9]+)/([0-9]+)");
  272.55 +static Pattern floatPat = Pattern.compile("([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?");
  272.56 +static final Symbol SLASH = Symbol.create("/");
  272.57 +static final Symbol CLOJURE_SLASH = Symbol.create("clojure.core","/");
  272.58 +//static Pattern accessorPat = Pattern.compile("\\.[a-zA-Z_]\\w*");
  272.59 +//static Pattern instanceMemberPat = Pattern.compile("\\.([a-zA-Z_][\\w\\.]*)\\.([a-zA-Z_]\\w*)");
  272.60 +//static Pattern staticMemberPat = Pattern.compile("([a-zA-Z_][\\w\\.]*)\\.([a-zA-Z_]\\w*)");
  272.61 +//static Pattern classNamePat = Pattern.compile("([a-zA-Z_][\\w\\.]*)\\.");
  272.62 +
  272.63 +//symbol->gensymbol
  272.64 +static Var GENSYM_ENV = Var.create(null);
  272.65 +//sorted-map num->gensymbol
  272.66 +static Var ARG_ENV = Var.create(null);
  272.67 +
  272.68 +    static
  272.69 +	{
  272.70 +	macros['"'] = new StringReader();
  272.71 +	macros[';'] = new CommentReader();
  272.72 +	macros['\''] = new WrappingReader(QUOTE);
  272.73 +	macros['@'] = new WrappingReader(DEREF);//new DerefReader();
  272.74 +	macros['^'] = new MetaReader();
  272.75 +	macros['`'] = new SyntaxQuoteReader();
  272.76 +	macros['~'] = new UnquoteReader();
  272.77 +	macros['('] = new ListReader();
  272.78 +	macros[')'] = new UnmatchedDelimiterReader();
  272.79 +	macros['['] = new VectorReader();
  272.80 +	macros[']'] = new UnmatchedDelimiterReader();
  272.81 +	macros['{'] = new MapReader();
  272.82 +	macros['}'] = new UnmatchedDelimiterReader();
  272.83 +//	macros['|'] = new ArgVectorReader();
  272.84 +	macros['\\'] = new CharacterReader();
  272.85 +	macros['%'] = new ArgReader();
  272.86 +	macros['#'] = new DispatchReader();
  272.87 +
  272.88 +
  272.89 +	dispatchMacros['^'] = new MetaReader();
  272.90 +	dispatchMacros['\''] = new VarReader();
  272.91 +	dispatchMacros['"'] = new RegexReader();
  272.92 +	dispatchMacros['('] = new FnReader();
  272.93 +	dispatchMacros['{'] = new SetReader();
  272.94 +	dispatchMacros['='] = new EvalReader();
  272.95 +	dispatchMacros['!'] = new CommentReader();
  272.96 +	dispatchMacros['<'] = new UnreadableReader();
  272.97 +	dispatchMacros['_'] = new DiscardReader();
  272.98 +	}
  272.99 +
 272.100 +static boolean isWhitespace(int ch){
 272.101 +	return Character.isWhitespace(ch) || ch == ',';
 272.102 +}
 272.103 +
 272.104 +static void unread(PushbackReader r, int ch) throws IOException{
 272.105 +	if(ch != -1)
 272.106 +		r.unread(ch);
 272.107 +}
 272.108 +
 272.109 +public static class ReaderException extends Exception{
 272.110 +	final int line;
 272.111 +
 272.112 +	public ReaderException(int line, Throwable cause){
 272.113 +		super(cause);
 272.114 +		this.line = line;
 272.115 +	}
 272.116 +}
 272.117 +
 272.118 +static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive)
 272.119 +		throws Exception{
 272.120 +
 272.121 +	try
 272.122 +		{
 272.123 +		for(; ;)
 272.124 +			{
 272.125 +			int ch = r.read();
 272.126 +
 272.127 +			while(isWhitespace(ch))
 272.128 +				ch = r.read();
 272.129 +
 272.130 +			if(ch == -1)
 272.131 +				{
 272.132 +				if(eofIsError)
 272.133 +					throw new Exception("EOF while reading");
 272.134 +				return eofValue;
 272.135 +				}
 272.136 +
 272.137 +			if(Character.isDigit(ch))
 272.138 +				{
 272.139 +				Object n = readNumber(r, (char) ch);
 272.140 +				if(RT.suppressRead())
 272.141 +					return null;
 272.142 +				return n;
 272.143 +				}
 272.144 +
 272.145 +			IFn macroFn = getMacro(ch);
 272.146 +			if(macroFn != null)
 272.147 +				{
 272.148 +				Object ret = macroFn.invoke(r, (char) ch);
 272.149 +				if(RT.suppressRead())
 272.150 +					return null;
 272.151 +				//no op macros return the reader
 272.152 +				if(ret == r)
 272.153 +					continue;
 272.154 +				return ret;
 272.155 +				}
 272.156 +
 272.157 +			if(ch == '+' || ch == '-')
 272.158 +				{
 272.159 +				int ch2 = r.read();
 272.160 +				if(Character.isDigit(ch2))
 272.161 +					{
 272.162 +					unread(r, ch2);
 272.163 +					Object n = readNumber(r, (char) ch);
 272.164 +					if(RT.suppressRead())
 272.165 +						return null;
 272.166 +					return n;
 272.167 +					}
 272.168 +				unread(r, ch2);
 272.169 +				}
 272.170 +
 272.171 +			String token = readToken(r, (char) ch);
 272.172 +			if(RT.suppressRead())
 272.173 +				return null;
 272.174 +			return interpretToken(token);
 272.175 +			}
 272.176 +		}
 272.177 +	catch(Exception e)
 272.178 +		{
 272.179 +		if(isRecursive || !(r instanceof LineNumberingPushbackReader))
 272.180 +			throw e;
 272.181 +		LineNumberingPushbackReader rdr = (LineNumberingPushbackReader) r;
 272.182 +		//throw new Exception(String.format("ReaderError:(%d,1) %s", rdr.getLineNumber(), e.getMessage()), e);
 272.183 +		throw new ReaderException(rdr.getLineNumber(), e);
 272.184 +		}
 272.185 +}
 272.186 +
 272.187 +static private String readToken(PushbackReader r, char initch) throws Exception{
 272.188 +	StringBuilder sb = new StringBuilder();
 272.189 +	sb.append(initch);
 272.190 +
 272.191 +	for(; ;)
 272.192 +		{
 272.193 +		int ch = r.read();
 272.194 +		if(ch == -1 || isWhitespace(ch) || isTerminatingMacro(ch))
 272.195 +			{
 272.196 +			unread(r, ch);
 272.197 +			return sb.toString();
 272.198 +			}
 272.199 +		sb.append((char) ch);
 272.200 +		}
 272.201 +}
 272.202 +
 272.203 +static private Object readNumber(PushbackReader r, char initch) throws Exception{
 272.204 +	StringBuilder sb = new StringBuilder();
 272.205 +	sb.append(initch);
 272.206 +
 272.207 +	for(; ;)
 272.208 +		{
 272.209 +		int ch = r.read();
 272.210 +		if(ch == -1 || isWhitespace(ch) || isMacro(ch))
 272.211 +			{
 272.212 +			unread(r, ch);
 272.213 +			break;
 272.214 +			}
 272.215 +		sb.append((char) ch);
 272.216 +		}
 272.217 +
 272.218 +	String s = sb.toString();
 272.219 +	Object n = matchNumber(s);
 272.220 +	if(n == null)
 272.221 +		throw new NumberFormatException("Invalid number: " + s);
 272.222 +	return n;
 272.223 +}
 272.224 +
 272.225 +static private int readUnicodeChar(String token, int offset, int length, int base) throws Exception{
 272.226 +	if(token.length() != offset + length)
 272.227 +		throw new IllegalArgumentException("Invalid unicode character: \\" + token);
 272.228 +	int uc = 0;
 272.229 +	for(int i = offset; i < offset + length; ++i)
 272.230 +		{
 272.231 +		int d = Character.digit(token.charAt(i), base);
 272.232 +		if(d == -1)
 272.233 +			throw new IllegalArgumentException("Invalid digit: " + (char) d);
 272.234 +		uc = uc * base + d;
 272.235 +		}
 272.236 +	return (char) uc;
 272.237 +}
 272.238 +
 272.239 +static private int readUnicodeChar(PushbackReader r, int initch, int base, int length, boolean exact) throws Exception{
 272.240 +	int uc = Character.digit(initch, base);
 272.241 +	if(uc == -1)
 272.242 +		throw new IllegalArgumentException("Invalid digit: " + initch);
 272.243 +	int i = 1;
 272.244 +	for(; i < length; ++i)
 272.245 +		{
 272.246 +		int ch = r.read();
 272.247 +		if(ch == -1 || isWhitespace(ch) || isMacro(ch))
 272.248 +			{
 272.249 +			unread(r, ch);
 272.250 +			break;
 272.251 +			}
 272.252 +		int d = Character.digit(ch, base);
 272.253 +		if(d == -1)
 272.254 +			throw new IllegalArgumentException("Invalid digit: " + (char) ch);
 272.255 +		uc = uc * base + d;
 272.256 +		}
 272.257 +	if(i != length && exact)
 272.258 +		throw new IllegalArgumentException("Invalid character length: " + i + ", should be: " + length);
 272.259 +	return uc;
 272.260 +}
 272.261 +
 272.262 +static private Object interpretToken(String s) throws Exception{
 272.263 +	if(s.equals("nil"))
 272.264 +		{
 272.265 +		return null;
 272.266 +		}
 272.267 +	else if(s.equals("true"))
 272.268 +		{
 272.269 +		return RT.T;
 272.270 +		}
 272.271 +	else if(s.equals("false"))
 272.272 +		{
 272.273 +		return RT.F;
 272.274 +		}
 272.275 +	else if(s.equals("/"))
 272.276 +		{
 272.277 +		return SLASH;
 272.278 +		}
 272.279 +	else if(s.equals("clojure.core//"))
 272.280 +		{
 272.281 +		return CLOJURE_SLASH;
 272.282 +		}
 272.283 +	Object ret = null;
 272.284 +
 272.285 +	ret = matchSymbol(s);
 272.286 +	if(ret != null)
 272.287 +		return ret;
 272.288 +
 272.289 +	throw new Exception("Invalid token: " + s);
 272.290 +}
 272.291 +
 272.292 +
 272.293 +private static Object matchSymbol(String s){
 272.294 +	Matcher m = symbolPat.matcher(s);
 272.295 +	if(m.matches())
 272.296 +		{
 272.297 +		int gc = m.groupCount();
 272.298 +		String ns = m.group(1);
 272.299 +		String name = m.group(2);
 272.300 +		if(ns != null && ns.endsWith(":/")
 272.301 +		   || name.endsWith(":")
 272.302 +		   || s.indexOf("::", 1) != -1)
 272.303 +			return null;
 272.304 +		if(s.startsWith("::"))
 272.305 +			{
 272.306 +			Symbol ks = Symbol.intern(s.substring(2));
 272.307 +			Namespace kns;
 272.308 +			if(ks.ns != null)
 272.309 +				kns = Compiler.namespaceFor(ks);
 272.310 +			else
 272.311 +				kns = Compiler.currentNS();
 272.312 +			//auto-resolving keyword
 272.313 +            if (kns != null)
 272.314 +			    return Keyword.intern(kns.name.name,ks.name);
 272.315 +            else
 272.316 +                return null;    
 272.317 +			}
 272.318 +		boolean isKeyword = s.charAt(0) == ':';
 272.319 +		Symbol sym = Symbol.intern(s.substring(isKeyword ? 1 : 0));
 272.320 +		if(isKeyword)
 272.321 +			return Keyword.intern(sym);
 272.322 +		return sym;
 272.323 +		}
 272.324 +	return null;
 272.325 +}
 272.326 +
 272.327 +
 272.328 +private static Object matchNumber(String s){
 272.329 +	Matcher m = intPat.matcher(s);
 272.330 +	if(m.matches())
 272.331 +		{
 272.332 +		if(m.group(2) != null)
 272.333 +			return 0;
 272.334 +		boolean negate = (m.group(1).equals("-"));
 272.335 +		String n;
 272.336 +		int radix = 10;
 272.337 +		if((n = m.group(3)) != null)
 272.338 +			radix = 10;
 272.339 +		else if((n = m.group(4)) != null)
 272.340 +			radix = 16;
 272.341 +		else if((n = m.group(5)) != null)
 272.342 +			radix = 8;
 272.343 +		else if((n = m.group(7)) != null)
 272.344 +			radix = Integer.parseInt(m.group(6));
 272.345 +		if(n == null)
 272.346 +			return null;
 272.347 +		BigInteger bn = new BigInteger(n, radix);
 272.348 +		return Numbers.reduce(negate ? bn.negate() : bn);
 272.349 +		}
 272.350 +	m = floatPat.matcher(s);
 272.351 +	if(m.matches())
 272.352 +		{
 272.353 +		if(m.group(4) != null)
 272.354 +			return new BigDecimal(m.group(1));
 272.355 +		return Double.parseDouble(s);
 272.356 +		}
 272.357 +	m = ratioPat.matcher(s);
 272.358 +	if(m.matches())
 272.359 +		{
 272.360 +		return Numbers.divide(new BigInteger(m.group(1)), new BigInteger(m.group(2)));
 272.361 +		}
 272.362 +	return null;
 272.363 +}
 272.364 +
 272.365 +static private IFn getMacro(int ch){
 272.366 +	if(ch < macros.length)
 272.367 +		return macros[ch];
 272.368 +	return null;
 272.369 +}
 272.370 +
 272.371 +static private boolean isMacro(int ch){
 272.372 +	return (ch < macros.length && macros[ch] != null);
 272.373 +}
 272.374 +
 272.375 +static private boolean isTerminatingMacro(int ch){
 272.376 +	return (ch != '#' && ch < macros.length && macros[ch] != null);
 272.377 +}
 272.378 +
 272.379 +public static class RegexReader extends AFn{
 272.380 +	static StringReader stringrdr = new StringReader();
 272.381 +
 272.382 +	public Object invoke(Object reader, Object doublequote) throws Exception{
 272.383 +		StringBuilder sb = new StringBuilder();
 272.384 +		Reader r = (Reader) reader;
 272.385 +		for(int ch = r.read(); ch != '"'; ch = r.read())
 272.386 +			{
 272.387 +			if(ch == -1)
 272.388 +				throw new Exception("EOF while reading regex");
 272.389 +			sb.append( (char) ch );
 272.390 +			if(ch == '\\')	//escape
 272.391 +				{
 272.392 +				ch = r.read();
 272.393 +				if(ch == -1)
 272.394 +					throw new Exception("EOF while reading regex");
 272.395 +				sb.append( (char) ch ) ;
 272.396 +				}
 272.397 +			}
 272.398 +		return Pattern.compile(sb.toString());
 272.399 +	}
 272.400 +}
 272.401 +
 272.402 +public static class StringReader extends AFn{
 272.403 +	public Object invoke(Object reader, Object doublequote) throws Exception{
 272.404 +		StringBuilder sb = new StringBuilder();
 272.405 +		Reader r = (Reader) reader;
 272.406 +
 272.407 +		for(int ch = r.read(); ch != '"'; ch = r.read())
 272.408 +			{
 272.409 +			if(ch == -1)
 272.410 +				throw new Exception("EOF while reading string");
 272.411 +			if(ch == '\\')	//escape
 272.412 +				{
 272.413 +				ch = r.read();
 272.414 +				if(ch == -1)
 272.415 +					throw new Exception("EOF while reading string");
 272.416 +				switch(ch)
 272.417 +					{
 272.418 +					case 't':
 272.419 +						ch = '\t';
 272.420 +						break;
 272.421 +					case 'r':
 272.422 +						ch = '\r';
 272.423 +						break;
 272.424 +					case 'n':
 272.425 +						ch = '\n';
 272.426 +						break;
 272.427 +					case '\\':
 272.428 +						break;
 272.429 +					case '"':
 272.430 +						break;
 272.431 +					case 'b':
 272.432 +						ch = '\b';
 272.433 +						break;
 272.434 +					case 'f':
 272.435 +						ch = '\f';
 272.436 +						break;
 272.437 +					case 'u':
 272.438 +					{
 272.439 +					ch = r.read();
 272.440 +					if (Character.digit(ch, 16) == -1)
 272.441 +					    throw new Exception("Invalid unicode escape: \\u" + (char) ch);
 272.442 +					ch = readUnicodeChar((PushbackReader) r, ch, 16, 4, true);
 272.443 +					break;
 272.444 +					}
 272.445 +					default:
 272.446 +					{
 272.447 +					if(Character.isDigit(ch))
 272.448 +						{
 272.449 +						ch = readUnicodeChar((PushbackReader) r, ch, 8, 3, false);
 272.450 +						if(ch > 0377)
 272.451 +							throw new Exception("Octal escape sequence must be in range [0, 377].");
 272.452 +						}
 272.453 +					else
 272.454 +						throw new Exception("Unsupported escape character: \\" + (char) ch);
 272.455 +					}
 272.456 +					}
 272.457 +				}
 272.458 +			sb.append((char) ch);
 272.459 +			}
 272.460 +		return sb.toString();
 272.461 +	}
 272.462 +}
 272.463 +
 272.464 +public static class CommentReader extends AFn{
 272.465 +	public Object invoke(Object reader, Object semicolon) throws Exception{
 272.466 +		Reader r = (Reader) reader;
 272.467 +		int ch;
 272.468 +		do
 272.469 +			{
 272.470 +			ch = r.read();
 272.471 +			} while(ch != -1 && ch != '\n' && ch != '\r');
 272.472 +		return r;
 272.473 +	}
 272.474 +
 272.475 +}
 272.476 +
 272.477 +public static class DiscardReader extends AFn{
 272.478 +	public Object invoke(Object reader, Object underscore) throws Exception{
 272.479 +		PushbackReader r = (PushbackReader) reader;
 272.480 +		read(r, true, null, true);
 272.481 +		return r;
 272.482 +	}
 272.483 +}
 272.484 +
 272.485 +public static class WrappingReader extends AFn{
 272.486 +	final Symbol sym;
 272.487 +
 272.488 +	public WrappingReader(Symbol sym){
 272.489 +		this.sym = sym;
 272.490 +	}
 272.491 +
 272.492 +	public Object invoke(Object reader, Object quote) throws Exception{
 272.493 +		PushbackReader r = (PushbackReader) reader;
 272.494 +		Object o = read(r, true, null, true);
 272.495 +		return RT.list(sym, o);
 272.496 +	}
 272.497 +
 272.498 +}
 272.499 +
 272.500 +public static class DeprecatedWrappingReader extends AFn{
 272.501 +	final Symbol sym;
 272.502 +        final String macro;
 272.503 +
 272.504 +	public DeprecatedWrappingReader(Symbol sym, String macro){
 272.505 +		this.sym = sym;
 272.506 +                this.macro = macro;
 272.507 +	}
 272.508 +
 272.509 +	public Object invoke(Object reader, Object quote) throws Exception{
 272.510 +                System.out.println("WARNING: reader macro " + macro +
 272.511 +                                   " is deprecated; use " + sym.getName() +
 272.512 +                                   " instead");
 272.513 +		PushbackReader r = (PushbackReader) reader;
 272.514 +		Object o = read(r, true, null, true);
 272.515 +		return RT.list(sym, o);
 272.516 +	}
 272.517 +
 272.518 +}
 272.519 +
 272.520 +public static class VarReader extends AFn{
 272.521 +	public Object invoke(Object reader, Object quote) throws Exception{
 272.522 +		PushbackReader r = (PushbackReader) reader;
 272.523 +		Object o = read(r, true, null, true);
 272.524 +//		if(o instanceof Symbol)
 272.525 +//			{
 272.526 +//			Object v = Compiler.maybeResolveIn(Compiler.currentNS(), (Symbol) o);
 272.527 +//			if(v instanceof Var)
 272.528 +//				return v;
 272.529 +//			}
 272.530 +		return RT.list(THE_VAR, o);
 272.531 +	}
 272.532 +}
 272.533 +
 272.534 +/*
 272.535 +static class DerefReader extends AFn{
 272.536 +
 272.537 +	public Object invoke(Object reader, Object quote) throws Exception{
 272.538 +		PushbackReader r = (PushbackReader) reader;
 272.539 +		int ch = r.read();
 272.540 +		if(ch == -1)
 272.541 +			throw new Exception("EOF while reading character");
 272.542 +		if(ch == '!')
 272.543 +			{
 272.544 +			Object o = read(r, true, null, true);
 272.545 +			return RT.list(DEREF_BANG, o);
 272.546 +			}
 272.547 +		else
 272.548 +			{
 272.549 +			r.unread(ch);
 272.550 +			Object o = read(r, true, null, true);
 272.551 +			return RT.list(DEREF, o);
 272.552 +			}
 272.553 +	}
 272.554 +
 272.555 +}
 272.556 +*/
 272.557 +
 272.558 +public static class DispatchReader extends AFn{
 272.559 +	public Object invoke(Object reader, Object hash) throws Exception{
 272.560 +		int ch = ((Reader) reader).read();
 272.561 +		if(ch == -1)
 272.562 +			throw new Exception("EOF while reading character");
 272.563 +		IFn fn = dispatchMacros[ch];
 272.564 +		if(fn == null)
 272.565 +			throw new Exception(String.format("No dispatch macro for: %c", (char) ch));
 272.566 +		return fn.invoke(reader, ch);
 272.567 +	}
 272.568 +}
 272.569 +
 272.570 +static Symbol garg(int n){
 272.571 +	return Symbol.intern(null, (n == -1 ? "rest" : ("p" + n)) + "__" + RT.nextID() + "#");
 272.572 +}
 272.573 +
 272.574 +public static class FnReader extends AFn{
 272.575 +	public Object invoke(Object reader, Object lparen) throws Exception{
 272.576 +		PushbackReader r = (PushbackReader) reader;
 272.577 +		if(ARG_ENV.deref() != null)
 272.578 +			throw new IllegalStateException("Nested #()s are not allowed");
 272.579 +		try
 272.580 +			{
 272.581 +			Var.pushThreadBindings(
 272.582 +					RT.map(ARG_ENV, PersistentTreeMap.EMPTY));
 272.583 +			r.unread('(');
 272.584 +			Object form = read(r, true, null, true);
 272.585 +
 272.586 +			PersistentVector args = PersistentVector.EMPTY;
 272.587 +			PersistentTreeMap argsyms = (PersistentTreeMap) ARG_ENV.deref();
 272.588 +			ISeq rargs = argsyms.rseq();
 272.589 +			if(rargs != null)
 272.590 +				{
 272.591 +				int higharg = (Integer) ((Map.Entry) rargs.first()).getKey();
 272.592 +				if(higharg > 0)
 272.593 +					{
 272.594 +					for(int i = 1; i <= higharg; ++i)
 272.595 +						{
 272.596 +						Object sym = argsyms.valAt(i);
 272.597 +						if(sym == null)
 272.598 +							sym = garg(i);
 272.599 +						args = args.cons(sym);
 272.600 +						}
 272.601 +					}
 272.602 +				Object restsym = argsyms.valAt(-1);
 272.603 +				if(restsym != null)
 272.604 +					{
 272.605 +					args = args.cons(Compiler._AMP_);
 272.606 +					args = args.cons(restsym);
 272.607 +					}
 272.608 +				}
 272.609 +			return RT.list(Compiler.FN, args, form);
 272.610 +			}
 272.611 +		finally
 272.612 +			{
 272.613 +			Var.popThreadBindings();
 272.614 +			}
 272.615 +	}
 272.616 +}
 272.617 +
 272.618 +static Symbol registerArg(int n){
 272.619 +	PersistentTreeMap argsyms = (PersistentTreeMap) ARG_ENV.deref();
 272.620 +	if(argsyms == null)
 272.621 +		{
 272.622 +		throw new IllegalStateException("arg literal not in #()");
 272.623 +		}
 272.624 +	Symbol ret = (Symbol) argsyms.valAt(n);
 272.625 +	if(ret == null)
 272.626 +		{
 272.627 +		ret = garg(n);
 272.628 +		ARG_ENV.set(argsyms.assoc(n, ret));
 272.629 +		}
 272.630 +	return ret;
 272.631 +}
 272.632 +
 272.633 +static class ArgReader extends AFn{
 272.634 +	public Object invoke(Object reader, Object pct) throws Exception{
 272.635 +		PushbackReader r = (PushbackReader) reader;
 272.636 +		if(ARG_ENV.deref() == null)
 272.637 +			{
 272.638 +			return interpretToken(readToken(r, '%'));
 272.639 +			}
 272.640 +		int ch = r.read();
 272.641 +		unread(r, ch);
 272.642 +		//% alone is first arg
 272.643 +		if(ch == -1 || isWhitespace(ch) || isTerminatingMacro(ch))
 272.644 +			{
 272.645 +			return registerArg(1);
 272.646 +			}
 272.647 +		Object n = read(r, true, null, true);
 272.648 +		if(n.equals(Compiler._AMP_))
 272.649 +			return registerArg(-1);
 272.650 +		if(!(n instanceof Number))
 272.651 +			throw new IllegalStateException("arg literal must be %, %& or %integer");
 272.652 +		return registerArg(((Number) n).intValue());
 272.653 +	}
 272.654 +}
 272.655 +
 272.656 +public static class MetaReader extends AFn{
 272.657 +	public Object invoke(Object reader, Object caret) throws Exception{
 272.658 +		PushbackReader r = (PushbackReader) reader;
 272.659 +		int line = -1;
 272.660 +		if(r instanceof LineNumberingPushbackReader)
 272.661 +			line = ((LineNumberingPushbackReader) r).getLineNumber();
 272.662 +		Object meta = read(r, true, null, true);
 272.663 +		if(meta instanceof Symbol || meta instanceof Keyword || meta instanceof String)
 272.664 +			meta = RT.map(RT.TAG_KEY, meta);
 272.665 +		else if(!(meta instanceof IPersistentMap))
 272.666 +			throw new IllegalArgumentException("Metadata must be Symbol,Keyword,String or Map");
 272.667 +
 272.668 +		Object o = read(r, true, null, true);
 272.669 +		if(o instanceof IMeta)
 272.670 +			{
 272.671 +			if(line != -1 && o instanceof ISeq)
 272.672 +				meta = ((IPersistentMap) meta).assoc(RT.LINE_KEY, line);
 272.673 +			if(o instanceof IReference)
 272.674 +				{
 272.675 +				((IReference)o).resetMeta((IPersistentMap) meta);
 272.676 +				return o;
 272.677 +				}
 272.678 +			return ((IObj) o).withMeta((IPersistentMap) meta);
 272.679 +			}
 272.680 +		else
 272.681 +			throw new IllegalArgumentException("Metadata can only be applied to IMetas");
 272.682 +	}
 272.683 +
 272.684 +}
 272.685 +
 272.686 +public static class SyntaxQuoteReader extends AFn{
 272.687 +	public Object invoke(Object reader, Object backquote) throws Exception{
 272.688 +		PushbackReader r = (PushbackReader) reader;
 272.689 +		try
 272.690 +			{
 272.691 +			Var.pushThreadBindings(
 272.692 +					RT.map(GENSYM_ENV, PersistentHashMap.EMPTY));
 272.693 +
 272.694 +			Object form = read(r, true, null, true);
 272.695 +			return syntaxQuote(form);
 272.696 +			}
 272.697 +		finally
 272.698 +			{
 272.699 +			Var.popThreadBindings();
 272.700 +			}
 272.701 +	}
 272.702 +
 272.703 +	static Object syntaxQuote(Object form) throws Exception{
 272.704 +		Object ret;
 272.705 +		if(Compiler.isSpecial(form))
 272.706 +			ret = RT.list(Compiler.QUOTE, form);
 272.707 +		else if(form instanceof Symbol)
 272.708 +			{
 272.709 +			Symbol sym = (Symbol) form;
 272.710 +			if(sym.ns == null && sym.name.endsWith("#"))
 272.711 +				{
 272.712 +				IPersistentMap gmap = (IPersistentMap) GENSYM_ENV.deref();
 272.713 +				if(gmap == null)
 272.714 +					throw new IllegalStateException("Gensym literal not in syntax-quote");
 272.715 +				Symbol gs = (Symbol) gmap.valAt(sym);
 272.716 +				if(gs == null)
 272.717 +					GENSYM_ENV.set(gmap.assoc(sym, gs = Symbol.intern(null,
 272.718 +					                                                  sym.name.substring(0, sym.name.length() - 1)
 272.719 +					                                                  + "__" + RT.nextID() + "__auto__")));
 272.720 +				sym = gs;
 272.721 +				}
 272.722 +			else if(sym.ns == null && sym.name.endsWith("."))
 272.723 +				{
 272.724 +				Symbol csym = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1));
 272.725 +				csym = Compiler.resolveSymbol(csym);
 272.726 +				sym = Symbol.intern(null, csym.name.concat("."));
 272.727 +				}
 272.728 +			else if(sym.ns == null && sym.name.startsWith("."))
 272.729 +				{
 272.730 +				// Simply quote method names.
 272.731 + 				}
 272.732 +            else
 272.733 +				{
 272.734 +					Object maybeClass = null;
 272.735 +					if(sym.ns != null)
 272.736 +						maybeClass = Compiler.currentNS().getMapping(
 272.737 +								Symbol.intern(null, sym.ns));
 272.738 +					if(maybeClass instanceof Class)
 272.739 +						{
 272.740 +						// Classname/foo -> package.qualified.Classname/foo
 272.741 +						sym = Symbol.intern(
 272.742 +								((Class)maybeClass).getName(), sym.name);
 272.743 +						}
 272.744 +					else
 272.745 +						sym = Compiler.resolveSymbol(sym);
 272.746 +				}
 272.747 +			ret = RT.list(Compiler.QUOTE, sym);
 272.748 +			}
 272.749 +		else if(isUnquote(form))
 272.750 +			return RT.second(form);
 272.751 +		else if(isUnquoteSplicing(form))
 272.752 +			throw new IllegalStateException("splice not in list");
 272.753 +		else if(form instanceof IPersistentCollection)
 272.754 +			{
 272.755 +			if(form instanceof IPersistentMap)
 272.756 +				{
 272.757 +				IPersistentVector keyvals = flattenMap(form);
 272.758 +                ret = RT.list(APPLY, HASHMAP, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(keyvals.seq()))));
 272.759 +				}
 272.760 +			else if(form instanceof IPersistentVector)
 272.761 +                {
 272.762 +                ret = RT.list(APPLY, VECTOR, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(((IPersistentVector) form).seq()))));
 272.763 +                }
 272.764 +			else if(form instanceof IPersistentSet)
 272.765 +                    {
 272.766 +                    ret = RT.list(APPLY, HASHSET, RT.list(SEQ, RT.cons(CONCAT, sqExpandList(((IPersistentSet) form).seq()))));
 272.767 +                    }
 272.768 +			else if(form instanceof ISeq || form instanceof IPersistentList)
 272.769 +				{
 272.770 +				ISeq seq = RT.seq(form);
 272.771 +                if(seq == null)
 272.772 +                    ret = RT.cons(LIST,null);
 272.773 +                else
 272.774 +                    ret = RT.list(SEQ, RT.cons(CONCAT, sqExpandList(seq)));
 272.775 +				}
 272.776 +			else
 272.777 +				throw new UnsupportedOperationException("Unknown Collection type");
 272.778 +			}
 272.779 +		else if(form instanceof Keyword
 272.780 +		        || form instanceof Number
 272.781 +		        || form instanceof Character
 272.782 +		        || form instanceof String)
 272.783 +			ret = form;
 272.784 +		else
 272.785 +			ret = RT.list(Compiler.QUOTE, form);
 272.786 +
 272.787 +		if(form instanceof IObj && RT.meta(form) != null)
 272.788 +			{
 272.789 +			//filter line numbers
 272.790 +			IPersistentMap newMeta = ((IObj) form).meta().without(RT.LINE_KEY);
 272.791 +			if(newMeta.count() > 0)
 272.792 +				return RT.list(WITH_META, ret, syntaxQuote(((IObj) form).meta()));
 272.793 +			}
 272.794 +		return ret;
 272.795 +	}
 272.796 +
 272.797 +	private static ISeq sqExpandList(ISeq seq) throws Exception{
 272.798 +		PersistentVector ret = PersistentVector.EMPTY;
 272.799 +		for(; seq != null; seq = seq.next())
 272.800 +			{
 272.801 +			Object item = seq.first();
 272.802 +			if(isUnquote(item))
 272.803 +				ret = ret.cons(RT.list(LIST, RT.second(item)));
 272.804 +			else if(isUnquoteSplicing(item))
 272.805 +				ret = ret.cons(RT.second(item));
 272.806 +			else
 272.807 +				ret = ret.cons(RT.list(LIST, syntaxQuote(item)));
 272.808 +			}
 272.809 +		return ret.seq();
 272.810 +	}
 272.811 +
 272.812 +	private static IPersistentVector flattenMap(Object form){
 272.813 +		IPersistentVector keyvals = PersistentVector.EMPTY;
 272.814 +		for(ISeq s = RT.seq(form); s != null; s = s.next())
 272.815 +			{
 272.816 +			IMapEntry e = (IMapEntry) s.first();
 272.817 +			keyvals = (IPersistentVector) keyvals.cons(e.key());
 272.818 +			keyvals = (IPersistentVector) keyvals.cons(e.val());
 272.819 +			}
 272.820 +		return keyvals;
 272.821 +	}
 272.822 +
 272.823 +}
 272.824 +
 272.825 +static boolean isUnquoteSplicing(Object form){
 272.826 +	return form instanceof ISeq && Util.equals(RT.first(form),UNQUOTE_SPLICING);
 272.827 +}
 272.828 +
 272.829 +static boolean isUnquote(Object form){
 272.830 +	return form instanceof ISeq && Util.equals(RT.first(form),UNQUOTE);
 272.831 +}
 272.832 +
 272.833 +static class UnquoteReader extends AFn{
 272.834 +	public Object invoke(Object reader, Object comma) throws Exception{
 272.835 +		PushbackReader r = (PushbackReader) reader;
 272.836 +		int ch = r.read();
 272.837 +		if(ch == -1)
 272.838 +			throw new Exception("EOF while reading character");
 272.839 +		if(ch == '@')
 272.840 +			{
 272.841 +			Object o = read(r, true, null, true);
 272.842 +			return RT.list(UNQUOTE_SPLICING, o);
 272.843 +			}
 272.844 +		else
 272.845 +			{
 272.846 +			unread(r, ch);
 272.847 +			Object o = read(r, true, null, true);
 272.848 +			return RT.list(UNQUOTE, o);
 272.849 +			}
 272.850 +	}
 272.851 +
 272.852 +}
 272.853 +
 272.854 +public static class CharacterReader extends AFn{
 272.855 +	public Object invoke(Object reader, Object backslash) throws Exception{
 272.856 +		PushbackReader r = (PushbackReader) reader;
 272.857 +		int ch = r.read();
 272.858 +		if(ch == -1)
 272.859 +			throw new Exception("EOF while reading character");
 272.860 +		String token = readToken(r, (char) ch);
 272.861 +		if(token.length() == 1)
 272.862 +			return Character.valueOf(token.charAt(0));
 272.863 +		else if(token.equals("newline"))
 272.864 +			return '\n';
 272.865 +		else if(token.equals("space"))
 272.866 +			return ' ';
 272.867 +		else if(token.equals("tab"))
 272.868 +			return '\t';
 272.869 +		else if(token.equals("backspace"))
 272.870 +			return '\b';
 272.871 +		else if(token.equals("formfeed"))
 272.872 +			return '\f';
 272.873 +		else if(token.equals("return"))
 272.874 +			return '\r';
 272.875 +		else if(token.startsWith("u"))
 272.876 +		    {
 272.877 +			 char c = (char) readUnicodeChar(token, 1, 4, 16);
 272.878 +			 if(c >= '\uD800' && c <= '\uDFFF') // surrogate code unit?
 272.879 +			     throw new Exception("Invalid character constant: \\u" + Integer.toString(c, 16));
 272.880 +			 return c;
 272.881 +		    }
 272.882 +		else if(token.startsWith("o"))
 272.883 +			{
 272.884 +			int len = token.length() - 1;
 272.885 +			if(len > 3)
 272.886 +				throw new Exception("Invalid octal escape sequence length: " + len);
 272.887 +			int uc = readUnicodeChar(token, 1, len, 8);
 272.888 +			if(uc > 0377)
 272.889 +				throw new Exception("Octal escape sequence must be in range [0, 377].");
 272.890 +			return (char) uc;
 272.891 +			}
 272.892 +		throw new Exception("Unsupported character: \\" + token);
 272.893 +	}
 272.894 +
 272.895 +}
 272.896 +
 272.897 +public static class ListReader extends AFn{
 272.898 +	public Object invoke(Object reader, Object leftparen) throws Exception{
 272.899 +		PushbackReader r = (PushbackReader) reader;
 272.900 +		int line = -1;
 272.901 +		if(r instanceof LineNumberingPushbackReader)
 272.902 +			line = ((LineNumberingPushbackReader) r).getLineNumber();
 272.903 +		List list = readDelimitedList(')', r, true);
 272.904 +		if(list.isEmpty())
 272.905 +			return PersistentList.EMPTY;
 272.906 +		IObj s = (IObj) PersistentList.create(list);
 272.907 +//		IObj s = (IObj) RT.seq(list);
 272.908 +		if(line != -1)
 272.909 +			return s.withMeta(RT.map(RT.LINE_KEY, line));
 272.910 +		else
 272.911 +			return s;
 272.912 +	}
 272.913 +
 272.914 +}
 272.915 +
 272.916 +static class CtorReader extends AFn{
 272.917 +	static final Symbol cls = Symbol.create("class");
 272.918 +
 272.919 +	public Object invoke(Object reader, Object leftangle) throws Exception{
 272.920 +		PushbackReader r = (PushbackReader) reader;
 272.921 +		// #<class classname>
 272.922 +		// #<classname args*>
 272.923 +		// #<classname/staticMethod args*>
 272.924 +		List list = readDelimitedList('>', r, true);
 272.925 +		if(list.isEmpty())
 272.926 +			throw new Exception("Must supply 'class', classname or classname/staticMethod");
 272.927 +		Symbol s = (Symbol) list.get(0);
 272.928 +		Object[] args = list.subList(1, list.size()).toArray();
 272.929 +		if(s.equals(cls))
 272.930 +			{
 272.931 +			return RT.classForName(args[0].toString());
 272.932 +			}
 272.933 +		else if(s.ns != null) //static method
 272.934 +			{
 272.935 +			String classname = s.ns;
 272.936 +			String method = s.name;
 272.937 +			return Reflector.invokeStaticMethod(classname, method, args);
 272.938 +			}
 272.939 +		else
 272.940 +			{
 272.941 +			return Reflector.invokeConstructor(RT.classForName(s.name), args);
 272.942 +			}
 272.943 +	}
 272.944 +
 272.945 +}
 272.946 +
 272.947 +public static class EvalReader extends AFn{
 272.948 +	public Object invoke(Object reader, Object eq) throws Exception{
 272.949 +		if (!RT.booleanCast(RT.READEVAL.deref()))
 272.950 +	    {
 272.951 +		  throw new Exception("EvalReader not allowed when *read-eval* is false.");
 272.952 +	    }
 272.953 +		
 272.954 +		PushbackReader r = (PushbackReader) reader;
 272.955 +		Object o = read(r, true, null, true);
 272.956 +		if(o instanceof Symbol)
 272.957 +			{
 272.958 +			return RT.classForName(o.toString());
 272.959 +			}
 272.960 +		else if(o instanceof IPersistentList)
 272.961 +			{
 272.962 +			Symbol fs = (Symbol) RT.first(o);
 272.963 +			if(fs.equals(THE_VAR))
 272.964 +				{
 272.965 +				Symbol vs = (Symbol) RT.second(o);
 272.966 +				return RT.var(vs.ns, vs.name);  //Compiler.resolve((Symbol) RT.second(o),true);
 272.967 +				}
 272.968 +			if(fs.name.endsWith("."))
 272.969 +				{
 272.970 +				Object[] args = RT.toArray(RT.next(o));
 272.971 +				return Reflector.invokeConstructor(RT.classForName(fs.name.substring(0, fs.name.length() - 1)), args);
 272.972 +				}
 272.973 +			if(Compiler.namesStaticMember(fs))
 272.974 +				{
 272.975 +				Object[] args = RT.toArray(RT.next(o));
 272.976 +				return Reflector.invokeStaticMethod(fs.ns, fs.name, args);
 272.977 +				}
 272.978 +			Object v = Compiler.maybeResolveIn(Compiler.currentNS(), fs);
 272.979 +			if(v instanceof Var)
 272.980 +				{
 272.981 +				return ((IFn) v).applyTo(RT.next(o));
 272.982 +				}
 272.983 +			throw new Exception("Can't resolve " + fs);
 272.984 +			}
 272.985 +		else
 272.986 +			throw new IllegalArgumentException("Unsupported #= form");
 272.987 +	}
 272.988 +}
 272.989 +
 272.990 +//static class ArgVectorReader extends AFn{
 272.991 +//	public Object invoke(Object reader, Object leftparen) throws Exception{
 272.992 +//		PushbackReader r = (PushbackReader) reader;
 272.993 +//		return ArgVector.create(readDelimitedList('|', r, true));
 272.994 +//	}
 272.995 +//
 272.996 +//}
 272.997 +
 272.998 +public static class VectorReader extends AFn{
 272.999 +	public Object invoke(Object reader, Object leftparen) throws Exception{
272.1000 +		PushbackReader r = (PushbackReader) reader;
272.1001 +		return LazilyPersistentVector.create(readDelimitedList(']', r, true));
272.1002 +	}
272.1003 +
272.1004 +}
272.1005 +
272.1006 +public static class MapReader extends AFn{
272.1007 +	public Object invoke(Object reader, Object leftparen) throws Exception{
272.1008 +		PushbackReader r = (PushbackReader) reader;
272.1009 +		return RT.map(readDelimitedList('}', r, true).toArray());
272.1010 +	}
272.1011 +
272.1012 +}
272.1013 +
272.1014 +public static class SetReader extends AFn{
272.1015 +	public Object invoke(Object reader, Object leftbracket) throws Exception{
272.1016 +		PushbackReader r = (PushbackReader) reader;
272.1017 +		return PersistentHashSet.createWithCheck(readDelimitedList('}', r, true));
272.1018 +	}
272.1019 +
272.1020 +}
272.1021 +
272.1022 +public static class UnmatchedDelimiterReader extends AFn{
272.1023 +	public Object invoke(Object reader, Object rightdelim) throws Exception{
272.1024 +		throw new Exception("Unmatched delimiter: " + rightdelim);
272.1025 +	}
272.1026 +
272.1027 +}
272.1028 +
272.1029 +public static class UnreadableReader extends AFn{
272.1030 +	public Object invoke(Object reader, Object leftangle) throws Exception{
272.1031 +		throw new Exception("Unreadable form");
272.1032 +	}
272.1033 +}
272.1034 +
272.1035 +public static List readDelimitedList(char delim, PushbackReader r, boolean isRecursive) throws Exception{
272.1036 +	ArrayList a = new ArrayList();
272.1037 +
272.1038 +	for(; ;)
272.1039 +		{
272.1040 +		int ch = r.read();
272.1041 +
272.1042 +		while(isWhitespace(ch))
272.1043 +			ch = r.read();
272.1044 +
272.1045 +		if(ch == -1)
272.1046 +			throw new Exception("EOF while reading");
272.1047 +
272.1048 +		if(ch == delim)
272.1049 +			break;
272.1050 +
272.1051 +		IFn macroFn = getMacro(ch);
272.1052 +		if(macroFn != null)
272.1053 +			{
272.1054 +			Object mret = macroFn.invoke(r, (char) ch);
272.1055 +			//no op macros return the reader
272.1056 +			if(mret != r)
272.1057 +				a.add(mret);
272.1058 +			}
272.1059 +		else
272.1060 +			{
272.1061 +			unread(r, ch);
272.1062 +
272.1063 +			Object o = read(r, true, null, isRecursive);
272.1064 +			if(o != r)
272.1065 +				a.add(o);
272.1066 +			}
272.1067 +		}
272.1068 +
272.1069 +
272.1070 +	return a;
272.1071 +}
272.1072 +
272.1073 +/*
272.1074 +public static void main(String[] args) throws Exception{
272.1075 +	//RT.init();
272.1076 +	PushbackReader rdr = new PushbackReader( new java.io.StringReader( "(+ 21 21)" ) );
272.1077 +	Object input = LispReader.read(rdr, false, new Object(), false );
272.1078 +	System.out.println(Compiler.eval(input));
272.1079 +}
272.1080 +
272.1081 +public static void main(String[] args){
272.1082 +	LineNumberingPushbackReader r = new LineNumberingPushbackReader(new InputStreamReader(System.in));
272.1083 +	OutputStreamWriter w = new OutputStreamWriter(System.out);
272.1084 +	Object ret = null;
272.1085 +	try
272.1086 +		{
272.1087 +		for(; ;)
272.1088 +			{
272.1089 +			ret = LispReader.read(r, true, null, false);
272.1090 +			RT.print(ret, w);
272.1091 +			w.write('\n');
272.1092 +			if(ret != null)
272.1093 +				w.write(ret.getClass().toString());
272.1094 +			w.write('\n');
272.1095 +			w.flush();
272.1096 +			}
272.1097 +		}
272.1098 +	catch(Exception e)
272.1099 +		{
272.1100 +		e.printStackTrace();
272.1101 +		}
272.1102 +}
272.1103 + */
272.1104 +
272.1105 +}
272.1106 +
   273.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   273.2 +++ b/src/clojure/lang/LockingTransaction.java	Sat Aug 21 06:25:44 2010 -0400
   273.3 @@ -0,0 +1,645 @@
   273.4 +/**
   273.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   273.6 + *   The use and distribution terms for this software are covered by the
   273.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   273.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   273.9 + *   By using this software in any fashion, you are agreeing to be bound by
  273.10 + * 	 the terms of this license.
  273.11 + *   You must not remove this notice, or any other, from this software.
  273.12 + **/
  273.13 +
  273.14 +/* rich Jul 26, 2007 */
  273.15 +
  273.16 +package clojure.lang;
  273.17 +
  273.18 +import java.util.*;
  273.19 +import java.util.concurrent.atomic.AtomicInteger;
  273.20 +import java.util.concurrent.atomic.AtomicLong;
  273.21 +import java.util.concurrent.Callable;
  273.22 +import java.util.concurrent.TimeUnit;
  273.23 +import java.util.concurrent.CountDownLatch;
  273.24 +
  273.25 +@SuppressWarnings({"SynchronizeOnNonFinalField"})
  273.26 +public class LockingTransaction{
  273.27 +
  273.28 +public static final int RETRY_LIMIT = 10000;
  273.29 +public static final int LOCK_WAIT_MSECS = 100;
  273.30 +public static final long BARGE_WAIT_NANOS = 10 * 1000000;
  273.31 +//public static int COMMUTE_RETRY_LIMIT = 10;
  273.32 +
  273.33 +static final int RUNNING = 0;
  273.34 +static final int COMMITTING = 1;
  273.35 +static final int RETRY = 2;
  273.36 +static final int KILLED = 3;
  273.37 +static final int COMMITTED = 4;
  273.38 +
  273.39 +final static ThreadLocal<LockingTransaction> transaction = new ThreadLocal<LockingTransaction>();
  273.40 +
  273.41 +
  273.42 +static class RetryEx extends Error{
  273.43 +}
  273.44 +
  273.45 +static class AbortException extends Exception{
  273.46 +}
  273.47 +
  273.48 +public static class Info{
  273.49 +	final AtomicInteger status;
  273.50 +	final long startPoint;
  273.51 +	final CountDownLatch latch;
  273.52 +
  273.53 +
  273.54 +	public Info(int status, long startPoint){
  273.55 +		this.status = new AtomicInteger(status);
  273.56 +		this.startPoint = startPoint;
  273.57 +		this.latch = new CountDownLatch(1);
  273.58 +	}
  273.59 +
  273.60 +	public boolean running(){
  273.61 +		int s = status.get();
  273.62 +		return s == RUNNING || s == COMMITTING;
  273.63 +	}
  273.64 +}
  273.65 +
  273.66 +static class CFn{
  273.67 +	final IFn fn;
  273.68 +	final ISeq args;
  273.69 +
  273.70 +	public CFn(IFn fn, ISeq args){
  273.71 +		this.fn = fn;
  273.72 +		this.args = args;
  273.73 +	}
  273.74 +}
  273.75 +//total order on transactions
  273.76 +//transactions will consume a point for init, for each retry, and on commit if writing
  273.77 +final private static AtomicLong lastPoint = new AtomicLong();
  273.78 +
  273.79 +void getReadPoint(){
  273.80 +	readPoint = lastPoint.incrementAndGet();
  273.81 +}
  273.82 +
  273.83 +long getCommitPoint(){
  273.84 +	return lastPoint.incrementAndGet();
  273.85 +}
  273.86 +
  273.87 +void stop(int status){
  273.88 +	if(info != null)
  273.89 +		{
  273.90 +		synchronized(info)
  273.91 +			{
  273.92 +			info.status.set(status);
  273.93 +			info.latch.countDown();
  273.94 +			}
  273.95 +		info = null;
  273.96 +		vals.clear();
  273.97 +		sets.clear();
  273.98 +		commutes.clear();
  273.99 +		//actions.clear();
 273.100 +		}
 273.101 +}
 273.102 +
 273.103 +
 273.104 +Info info;
 273.105 +long readPoint;
 273.106 +long startPoint;
 273.107 +long startTime;
 273.108 +final RetryEx retryex = new RetryEx();
 273.109 +final ArrayList<Agent.Action> actions = new ArrayList<Agent.Action>();
 273.110 +final HashMap<Ref, Object> vals = new HashMap<Ref, Object>();
 273.111 +final HashSet<Ref> sets = new HashSet<Ref>();
 273.112 +final TreeMap<Ref, ArrayList<CFn>> commutes = new TreeMap<Ref, ArrayList<CFn>>();
 273.113 +
 273.114 +final HashSet<Ref> ensures = new HashSet<Ref>();   //all hold readLock
 273.115 +
 273.116 +
 273.117 +void tryWriteLock(Ref ref){
 273.118 +	try
 273.119 +		{
 273.120 +		if(!ref.lock.writeLock().tryLock(LOCK_WAIT_MSECS, TimeUnit.MILLISECONDS))
 273.121 +			throw retryex;
 273.122 +		}
 273.123 +	catch(InterruptedException e)
 273.124 +		{
 273.125 +		throw retryex;
 273.126 +		}
 273.127 +}
 273.128 +
 273.129 +//returns the most recent val
 273.130 +Object lock(Ref ref){
 273.131 +	//can't upgrade readLock, so release it
 273.132 +	releaseIfEnsured(ref);
 273.133 +
 273.134 +	boolean unlocked = true;
 273.135 +	try
 273.136 +		{
 273.137 +		tryWriteLock(ref);
 273.138 +		unlocked = false;
 273.139 +
 273.140 +		if(ref.tvals != null && ref.tvals.point > readPoint)
 273.141 +			throw retryex;
 273.142 +		Info refinfo = ref.tinfo;
 273.143 +
 273.144 +		//write lock conflict
 273.145 +		if(refinfo != null && refinfo != info && refinfo.running())
 273.146 +			{
 273.147 +			if(!barge(refinfo))
 273.148 +				{
 273.149 +				ref.lock.writeLock().unlock();
 273.150 +				unlocked = true;
 273.151 +				return blockAndBail(refinfo);
 273.152 +				}
 273.153 +			}
 273.154 +		ref.tinfo = info;
 273.155 +		return ref.tvals == null ? null : ref.tvals.val;
 273.156 +		}
 273.157 +	finally
 273.158 +		{
 273.159 +		if(!unlocked)
 273.160 +			ref.lock.writeLock().unlock();
 273.161 +		}
 273.162 +}
 273.163 +
 273.164 +private Object blockAndBail(Info refinfo){
 273.165 +//stop prior to blocking
 273.166 +	stop(RETRY);
 273.167 +	try
 273.168 +		{
 273.169 +		refinfo.latch.await(LOCK_WAIT_MSECS, TimeUnit.MILLISECONDS);
 273.170 +		}
 273.171 +	catch(InterruptedException e)
 273.172 +		{
 273.173 +		//ignore
 273.174 +		}
 273.175 +	throw retryex;
 273.176 +}
 273.177 +
 273.178 +private void releaseIfEnsured(Ref ref){
 273.179 +	if(ensures.contains(ref))
 273.180 +		{
 273.181 +		ensures.remove(ref);
 273.182 +		ref.lock.readLock().unlock();
 273.183 +		}
 273.184 +}
 273.185 +
 273.186 +void abort() throws AbortException{
 273.187 +	stop(KILLED);
 273.188 +	throw new AbortException();
 273.189 +}
 273.190 +
 273.191 +private boolean bargeTimeElapsed(){
 273.192 +	return System.nanoTime() - startTime > BARGE_WAIT_NANOS;
 273.193 +}
 273.194 +
 273.195 +private boolean barge(Info refinfo){
 273.196 +	boolean barged = false;
 273.197 +	//if this transaction is older
 273.198 +	//  try to abort the other
 273.199 +	if(bargeTimeElapsed() && startPoint < refinfo.startPoint)
 273.200 +		{
 273.201 +        barged = refinfo.status.compareAndSet(RUNNING, KILLED);
 273.202 +        if(barged)
 273.203 +            refinfo.latch.countDown();
 273.204 +		}
 273.205 +	return barged;
 273.206 +}
 273.207 +
 273.208 +static LockingTransaction getEx(){
 273.209 +	LockingTransaction t = transaction.get();
 273.210 +	if(t == null || t.info == null)
 273.211 +		throw new IllegalStateException("No transaction running");
 273.212 +	return t;
 273.213 +}
 273.214 +
 273.215 +static public boolean isRunning(){
 273.216 +	return getRunning() != null;
 273.217 +}
 273.218 +
 273.219 +static LockingTransaction getRunning(){
 273.220 +	LockingTransaction t = transaction.get();
 273.221 +	if(t == null || t.info == null)
 273.222 +		return null;
 273.223 +	return t;
 273.224 +}
 273.225 +
 273.226 +static public Object runInTransaction(Callable fn) throws Exception{
 273.227 +	LockingTransaction t = transaction.get();
 273.228 +	if(t == null)
 273.229 +		transaction.set(t = new LockingTransaction());
 273.230 +
 273.231 +	if(t.info != null)
 273.232 +		return fn.call();
 273.233 +
 273.234 +	return t.run(fn);
 273.235 +}
 273.236 +
 273.237 +static class Notify{
 273.238 +	final public Ref ref;
 273.239 +	final public Object oldval;
 273.240 +	final public Object newval;
 273.241 +
 273.242 +	Notify(Ref ref, Object oldval, Object newval){
 273.243 +		this.ref = ref;
 273.244 +		this.oldval = oldval;
 273.245 +		this.newval = newval;
 273.246 +	}
 273.247 +}
 273.248 +
 273.249 +Object run(Callable fn) throws Exception{
 273.250 +	boolean done = false;
 273.251 +	Object ret = null;
 273.252 +	ArrayList<Ref> locked = new ArrayList<Ref>();
 273.253 +	ArrayList<Notify> notify = new ArrayList<Notify>();
 273.254 +
 273.255 +	for(int i = 0; !done && i < RETRY_LIMIT; i++)
 273.256 +		{
 273.257 +		try
 273.258 +			{
 273.259 +			getReadPoint();
 273.260 +			if(i == 0)
 273.261 +				{
 273.262 +				startPoint = readPoint;
 273.263 +				startTime = System.nanoTime();
 273.264 +				}
 273.265 +			info = new Info(RUNNING, startPoint);
 273.266 +			ret = fn.call();
 273.267 +			//make sure no one has killed us before this point, and can't from now on
 273.268 +			if(info.status.compareAndSet(RUNNING, COMMITTING))
 273.269 +				{
 273.270 +				for(Map.Entry<Ref, ArrayList<CFn>> e : commutes.entrySet())
 273.271 +					{
 273.272 +					Ref ref = e.getKey();
 273.273 +					if(sets.contains(ref)) continue;
 273.274 +					
 273.275 +					boolean wasEnsured = ensures.contains(ref);
 273.276 +					//can't upgrade readLock, so release it
 273.277 +					releaseIfEnsured(ref);
 273.278 +					tryWriteLock(ref);
 273.279 +					locked.add(ref);
 273.280 +					if(wasEnsured && ref.tvals != null && ref.tvals.point > readPoint)
 273.281 +						throw retryex;
 273.282 +
 273.283 +					Info refinfo = ref.tinfo;
 273.284 +					if(refinfo != null && refinfo != info && refinfo.running())
 273.285 +						{
 273.286 +						if(!barge(refinfo))
 273.287 +							throw retryex;
 273.288 +						}
 273.289 +					Object val = ref.tvals == null ? null : ref.tvals.val;
 273.290 +					vals.put(ref, val);
 273.291 +					for(CFn f : e.getValue())
 273.292 +						{
 273.293 +						vals.put(ref, f.fn.applyTo(RT.cons(vals.get(ref), f.args)));
 273.294 +						}
 273.295 +					}
 273.296 +				for(Ref ref : sets)
 273.297 +					{
 273.298 +					tryWriteLock(ref);
 273.299 +					locked.add(ref);
 273.300 +					}
 273.301 +
 273.302 +				//validate and enqueue notifications
 273.303 +				for(Map.Entry<Ref, Object> e : vals.entrySet())
 273.304 +					{
 273.305 +					Ref ref = e.getKey();
 273.306 +					ref.validate(ref.getValidator(), e.getValue());
 273.307 +					}
 273.308 +
 273.309 +				//at this point, all values calced, all refs to be written locked
 273.310 +				//no more client code to be called
 273.311 +				long msecs = System.currentTimeMillis();
 273.312 +				long commitPoint = getCommitPoint();
 273.313 +				for(Map.Entry<Ref, Object> e : vals.entrySet())
 273.314 +					{
 273.315 +					Ref ref = e.getKey();
 273.316 +					Object oldval = ref.tvals == null ? null : ref.tvals.val;
 273.317 +					Object newval = e.getValue();
 273.318 +					int hcount = ref.histCount();
 273.319 +
 273.320 +					if(ref.tvals == null)
 273.321 +						{
 273.322 +						ref.tvals = new Ref.TVal(newval, commitPoint, msecs);
 273.323 +						}
 273.324 +					else if((ref.faults.get() > 0 && hcount < ref.maxHistory)
 273.325 +							|| hcount < ref.minHistory)
 273.326 +						{
 273.327 +						ref.tvals = new Ref.TVal(newval, commitPoint, msecs, ref.tvals);
 273.328 +						ref.faults.set(0);
 273.329 +						}
 273.330 +					else
 273.331 +						{
 273.332 +						ref.tvals = ref.tvals.next;
 273.333 +						ref.tvals.val = newval;
 273.334 +						ref.tvals.point = commitPoint;
 273.335 +						ref.tvals.msecs = msecs;
 273.336 +						}
 273.337 +					if(ref.getWatches().count() > 0)
 273.338 +						notify.add(new Notify(ref, oldval, newval));
 273.339 +					}
 273.340 +
 273.341 +				done = true;
 273.342 +				info.status.set(COMMITTED);
 273.343 +				}
 273.344 +			}
 273.345 +		catch(RetryEx retry)
 273.346 +			{
 273.347 +			//eat this so we retry rather than fall out
 273.348 +			}
 273.349 +		finally
 273.350 +			{
 273.351 +			for(int k = locked.size() - 1; k >= 0; --k)
 273.352 +				{
 273.353 +				locked.get(k).lock.writeLock().unlock();
 273.354 +				}
 273.355 +			locked.clear();
 273.356 +			for(Ref r : ensures)
 273.357 +				{
 273.358 +				r.lock.readLock().unlock();
 273.359 +				}
 273.360 +			ensures.clear();
 273.361 +			stop(done ? COMMITTED : RETRY);
 273.362 +			try
 273.363 +				{
 273.364 +				if(done) //re-dispatch out of transaction
 273.365 +					{
 273.366 +					for(Notify n : notify)
 273.367 +						{
 273.368 +						n.ref.notifyWatches(n.oldval, n.newval);
 273.369 +						}
 273.370 +					for(Agent.Action action : actions)
 273.371 +						{
 273.372 +						Agent.dispatchAction(action);
 273.373 +						}
 273.374 +					}
 273.375 +				}
 273.376 +			finally
 273.377 +				{
 273.378 +				notify.clear();
 273.379 +				actions.clear();
 273.380 +				}
 273.381 +			}
 273.382 +		}
 273.383 +	if(!done)
 273.384 +		throw new Exception("Transaction failed after reaching retry limit");
 273.385 +	return ret;
 273.386 +}
 273.387 +
 273.388 +public void enqueue(Agent.Action action){
 273.389 +	actions.add(action);
 273.390 +}
 273.391 +
 273.392 +Object doGet(Ref ref){
 273.393 +	if(!info.running())
 273.394 +		throw retryex;
 273.395 +	if(vals.containsKey(ref))
 273.396 +		return vals.get(ref);
 273.397 +	try
 273.398 +		{
 273.399 +		ref.lock.readLock().lock();
 273.400 +		if(ref.tvals == null)
 273.401 +			throw new IllegalStateException(ref.toString() + " is unbound.");
 273.402 +		Ref.TVal ver = ref.tvals;
 273.403 +		do
 273.404 +			{
 273.405 +			if(ver.point <= readPoint)
 273.406 +				return ver.val;
 273.407 +			} while((ver = ver.prior) != ref.tvals);
 273.408 +		}
 273.409 +	finally
 273.410 +		{
 273.411 +		ref.lock.readLock().unlock();
 273.412 +		}
 273.413 +	//no version of val precedes the read point
 273.414 +	ref.faults.incrementAndGet();
 273.415 +	throw retryex;
 273.416 +
 273.417 +}
 273.418 +
 273.419 +Object doSet(Ref ref, Object val){
 273.420 +	if(!info.running())
 273.421 +		throw retryex;
 273.422 +	if(commutes.containsKey(ref))
 273.423 +		throw new IllegalStateException("Can't set after commute");
 273.424 +	if(!sets.contains(ref))
 273.425 +		{
 273.426 +		sets.add(ref);
 273.427 +		lock(ref);
 273.428 +		}
 273.429 +	vals.put(ref, val);
 273.430 +	return val;
 273.431 +}
 273.432 +
 273.433 +void doEnsure(Ref ref){
 273.434 +	if(!info.running())
 273.435 +		throw retryex;
 273.436 +	if(ensures.contains(ref))
 273.437 +		return;
 273.438 +	ref.lock.readLock().lock();
 273.439 +
 273.440 +	//someone completed a write after our snapshot
 273.441 +	if(ref.tvals != null && ref.tvals.point > readPoint) {
 273.442 +        ref.lock.readLock().unlock();
 273.443 +        throw retryex;
 273.444 +    }
 273.445 +
 273.446 +	Info refinfo = ref.tinfo;
 273.447 +
 273.448 +	//writer exists
 273.449 +	if(refinfo != null && refinfo.running())
 273.450 +		{
 273.451 +		ref.lock.readLock().unlock();
 273.452 +
 273.453 +		if(refinfo != info) //not us, ensure is doomed
 273.454 +			{
 273.455 +			blockAndBail(refinfo); 
 273.456 +			}
 273.457 +		}
 273.458 +	else
 273.459 +		ensures.add(ref);
 273.460 +}
 273.461 +
 273.462 +Object doCommute(Ref ref, IFn fn, ISeq args) throws Exception{
 273.463 +	if(!info.running())
 273.464 +		throw retryex;
 273.465 +	if(!vals.containsKey(ref))
 273.466 +		{
 273.467 +		Object val = null;
 273.468 +		try
 273.469 +			{
 273.470 +			ref.lock.readLock().lock();
 273.471 +			val = ref.tvals == null ? null : ref.tvals.val;
 273.472 +			}
 273.473 +		finally
 273.474 +			{
 273.475 +			ref.lock.readLock().unlock();
 273.476 +			}
 273.477 +		vals.put(ref, val);
 273.478 +		}
 273.479 +	ArrayList<CFn> fns = commutes.get(ref);
 273.480 +	if(fns == null)
 273.481 +		commutes.put(ref, fns = new ArrayList<CFn>());
 273.482 +	fns.add(new CFn(fn, args));
 273.483 +	Object ret = fn.applyTo(RT.cons(vals.get(ref), args));
 273.484 +	vals.put(ref, ret);
 273.485 +	return ret;
 273.486 +}
 273.487 +
 273.488 +/*
 273.489 +//for test
 273.490 +static CyclicBarrier barrier;
 273.491 +static ArrayList<Ref> items;
 273.492 +
 273.493 +public static void main(String[] args){
 273.494 +	try
 273.495 +		{
 273.496 +		if(args.length != 4)
 273.497 +			System.err.println("Usage: LockingTransaction nthreads nitems niters ninstances");
 273.498 +		int nthreads = Integer.parseInt(args[0]);
 273.499 +		int nitems = Integer.parseInt(args[1]);
 273.500 +		int niters = Integer.parseInt(args[2]);
 273.501 +		int ninstances = Integer.parseInt(args[3]);
 273.502 +
 273.503 +		if(items == null)
 273.504 +			{
 273.505 +			ArrayList<Ref> temp = new ArrayList(nitems);
 273.506 +			for(int i = 0; i < nitems; i++)
 273.507 +				temp.add(new Ref(0));
 273.508 +			items = temp;
 273.509 +			}
 273.510 +
 273.511 +		class Incr extends AFn{
 273.512 +			public Object invoke(Object arg1) throws Exception{
 273.513 +				Integer i = (Integer) arg1;
 273.514 +				return i + 1;
 273.515 +			}
 273.516 +
 273.517 +			public Obj withMeta(IPersistentMap meta){
 273.518 +				throw new UnsupportedOperationException();
 273.519 +
 273.520 +			}
 273.521 +		}
 273.522 +
 273.523 +		class Commuter extends AFn implements Callable{
 273.524 +			int niters;
 273.525 +			List<Ref> items;
 273.526 +			Incr incr;
 273.527 +
 273.528 +
 273.529 +			public Commuter(int niters, List<Ref> items){
 273.530 +				this.niters = niters;
 273.531 +				this.items = items;
 273.532 +				this.incr = new Incr();
 273.533 +			}
 273.534 +
 273.535 +			public Object call() throws Exception{
 273.536 +				long nanos = 0;
 273.537 +				for(int i = 0; i < niters; i++)
 273.538 +					{
 273.539 +					long start = System.nanoTime();
 273.540 +					LockingTransaction.runInTransaction(this);
 273.541 +					nanos += System.nanoTime() - start;
 273.542 +					}
 273.543 +				return nanos;
 273.544 +			}
 273.545 +
 273.546 +			public Object invoke() throws Exception{
 273.547 +				for(Ref tref : items)
 273.548 +					{
 273.549 +					LockingTransaction.getEx().doCommute(tref, incr);
 273.550 +					}
 273.551 +				return null;
 273.552 +			}
 273.553 +
 273.554 +			public Obj withMeta(IPersistentMap meta){
 273.555 +				throw new UnsupportedOperationException();
 273.556 +
 273.557 +			}
 273.558 +		}
 273.559 +
 273.560 +		class Incrementer extends AFn implements Callable{
 273.561 +			int niters;
 273.562 +			List<Ref> items;
 273.563 +
 273.564 +
 273.565 +			public Incrementer(int niters, List<Ref> items){
 273.566 +				this.niters = niters;
 273.567 +				this.items = items;
 273.568 +			}
 273.569 +
 273.570 +			public Object call() throws Exception{
 273.571 +				long nanos = 0;
 273.572 +				for(int i = 0; i < niters; i++)
 273.573 +					{
 273.574 +					long start = System.nanoTime();
 273.575 +					LockingTransaction.runInTransaction(this);
 273.576 +					nanos += System.nanoTime() - start;
 273.577 +					}
 273.578 +				return nanos;
 273.579 +			}
 273.580 +
 273.581 +			public Object invoke() throws Exception{
 273.582 +				for(Ref tref : items)
 273.583 +					{
 273.584 +					//Transaction.get().doTouch(tref);
 273.585 +//					LockingTransaction t = LockingTransaction.getEx();
 273.586 +//					int val = (Integer) t.doGet(tref);
 273.587 +//					t.doSet(tref, val + 1);
 273.588 +					int val = (Integer) tref.get();
 273.589 +					tref.set(val + 1);
 273.590 +					}
 273.591 +				return null;
 273.592 +			}
 273.593 +
 273.594 +			public Obj withMeta(IPersistentMap meta){
 273.595 +				throw new UnsupportedOperationException();
 273.596 +
 273.597 +			}
 273.598 +		}
 273.599 +
 273.600 +		ArrayList<Callable<Long>> tasks = new ArrayList(nthreads);
 273.601 +		for(int i = 0; i < nthreads; i++)
 273.602 +			{
 273.603 +			ArrayList<Ref> si;
 273.604 +			synchronized(items)
 273.605 +				{
 273.606 +				si = (ArrayList<Ref>) items.clone();
 273.607 +				}
 273.608 +			Collections.shuffle(si);
 273.609 +			tasks.add(new Incrementer(niters, si));
 273.610 +			//tasks.add(new Commuter(niters, si));
 273.611 +			}
 273.612 +		ExecutorService e = Executors.newFixedThreadPool(nthreads);
 273.613 +
 273.614 +		if(barrier == null)
 273.615 +			barrier = new CyclicBarrier(ninstances);
 273.616 +		System.out.println("waiting for other instances...");
 273.617 +		barrier.await();
 273.618 +		System.out.println("starting");
 273.619 +		long start = System.nanoTime();
 273.620 +		List<Future<Long>> results = e.invokeAll(tasks);
 273.621 +		long estimatedTime = System.nanoTime() - start;
 273.622 +		System.out.printf("nthreads: %d, nitems: %d, niters: %d, time: %d%n", nthreads, nitems, niters,
 273.623 +		                  estimatedTime / 1000000);
 273.624 +		e.shutdown();
 273.625 +		for(Future<Long> result : results)
 273.626 +			{
 273.627 +			System.out.printf("%d, ", result.get() / 1000000);
 273.628 +			}
 273.629 +		System.out.println();
 273.630 +		System.out.println("waiting for other instances...");
 273.631 +		barrier.await();
 273.632 +		synchronized(items)
 273.633 +			{
 273.634 +			for(Ref item : items)
 273.635 +				{
 273.636 +				System.out.printf("%d, ", (Integer) item.currentVal());
 273.637 +				}
 273.638 +			}
 273.639 +		System.out.println("\ndone");
 273.640 +		System.out.flush();
 273.641 +		}
 273.642 +	catch(Exception ex)
 273.643 +		{
 273.644 +		ex.printStackTrace();
 273.645 +		}
 273.646 +}
 273.647 +*/
 273.648 +}
   274.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   274.2 +++ b/src/clojure/lang/MapEntry.java	Sat Aug 21 06:25:44 2010 -0400
   274.3 @@ -0,0 +1,40 @@
   274.4 +/**
   274.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   274.6 + *   The use and distribution terms for this software are covered by the
   274.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   274.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   274.9 + *   By using this software in any fashion, you are agreeing to be bound by
  274.10 + * 	 the terms of this license.
  274.11 + *   You must not remove this notice, or any other, from this software.
  274.12 + **/
  274.13 +
  274.14 +package clojure.lang;
  274.15 +
  274.16 +import java.util.Iterator;
  274.17 +
  274.18 +public class MapEntry extends AMapEntry{
  274.19 +final Object _key;
  274.20 +final Object _val;
  274.21 +
  274.22 +public MapEntry(Object key, Object val){
  274.23 +	this._key = key;
  274.24 +	this._val = val;
  274.25 +}
  274.26 +
  274.27 +public Object key(){
  274.28 +	return _key;
  274.29 +}
  274.30 +
  274.31 +public Object val(){
  274.32 +	return _val;
  274.33 +}
  274.34 +
  274.35 +public Object getKey(){
  274.36 +	return key();
  274.37 +}
  274.38 +
  274.39 +public Object getValue(){
  274.40 +	return val();
  274.41 +}
  274.42 +
  274.43 +}
   275.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   275.2 +++ b/src/clojure/lang/MapEquivalence.java	Sat Aug 21 06:25:44 2010 -0400
   275.3 @@ -0,0 +1,17 @@
   275.4 +/**
   275.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   275.6 + *   The use and distribution terms for this software are covered by the
   275.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   275.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   275.9 + *   By using this software in any fashion, you are agreeing to be bound by
  275.10 + * 	 the terms of this license.
  275.11 + *   You must not remove this notice, or any other, from this software.
  275.12 + **/
  275.13 +
  275.14 +/* rich Aug 4, 2010 */
  275.15 +
  275.16 +package clojure.lang;
  275.17 +
  275.18 +//marker interface
  275.19 +public interface MapEquivalence{
  275.20 +}
   276.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   276.2 +++ b/src/clojure/lang/MethodImplCache.java	Sat Aug 21 06:25:44 2010 -0400
   276.3 @@ -0,0 +1,66 @@
   276.4 +/**
   276.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   276.6 + *   The use and distribution terms for this software are covered by the
   276.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   276.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   276.9 + *   By using this software in any fashion, you are agreeing to be bound by
  276.10 + * 	 the terms of this license.
  276.11 + *   You must not remove this notice, or any other, from this software.
  276.12 + **/
  276.13 +
  276.14 +/* rich Nov 8, 2009 */
  276.15 +
  276.16 +package clojure.lang;
  276.17 +
  276.18 +public final class MethodImplCache{
  276.19 +
  276.20 +static public class Entry{
  276.21 +	final public Class c;
  276.22 +	final public IFn fn;
  276.23 +
  276.24 +	public Entry(Class c, IFn fn){
  276.25 +		this.c = c;
  276.26 +		this.fn = fn;
  276.27 +	}
  276.28 +}
  276.29 +
  276.30 +public final IPersistentMap protocol;
  276.31 +public final Keyword methodk;
  276.32 +public final int shift;
  276.33 +public final int mask;
  276.34 +public final Object[] table;    //[class, entry. class, entry ...]
  276.35 +
  276.36 +volatile Entry mre = null;
  276.37 +
  276.38 +public MethodImplCache(IPersistentMap protocol, Keyword methodk){
  276.39 +	this(protocol, methodk, 0, 0, RT.EMPTY_ARRAY);
  276.40 +}
  276.41 +
  276.42 +public MethodImplCache(IPersistentMap protocol, Keyword methodk, int shift, int mask, Object[] table){
  276.43 +	this.protocol = protocol;
  276.44 +	this.methodk = methodk;
  276.45 +	this.shift = shift;
  276.46 +	this.mask = mask;
  276.47 +	this.table = table;
  276.48 +}
  276.49 +
  276.50 +public IFn fnFor(Class c){
  276.51 +	Entry last = mre;
  276.52 +	if(last != null && last.c == c)
  276.53 +		return last.fn;
  276.54 +	return findFnFor(c);
  276.55 +}
  276.56 +
  276.57 +IFn findFnFor(Class c){
  276.58 +	int idx = ((Util.hash(c) >> shift) & mask) << 1;
  276.59 +	if(idx < table.length && table[idx] == c)
  276.60 +		{
  276.61 +		Entry e = ((Entry) table[idx + 1]);
  276.62 +		mre = e;
  276.63 +		return  e != null ? e.fn : null;
  276.64 +		}
  276.65 +	return null;
  276.66 +}
  276.67 +
  276.68 +
  276.69 +}
   277.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   277.2 +++ b/src/clojure/lang/MultiFn.java	Sat Aug 21 06:25:44 2010 -0400
   277.3 @@ -0,0 +1,314 @@
   277.4 +/**
   277.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   277.6 + *   The use and distribution terms for this software are covered by the
   277.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   277.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   277.9 + *   By using this software in any fashion, you are agreeing to be bound by
  277.10 + * 	 the terms of this license.
  277.11 + *   You must not remove this notice, or any other, from this software.
  277.12 + **/
  277.13 +
  277.14 +/* rich Sep 13, 2007 */
  277.15 +
  277.16 +package clojure.lang;
  277.17 +
  277.18 +import java.util.Map;
  277.19 +
  277.20 +public class MultiFn extends AFn{
  277.21 +final public IFn dispatchFn;
  277.22 +final public Object defaultDispatchVal;
  277.23 +final public IRef hierarchy;
  277.24 +final String name;
  277.25 +IPersistentMap methodTable;
  277.26 +IPersistentMap preferTable;
  277.27 +IPersistentMap methodCache;
  277.28 +Object cachedHierarchy;
  277.29 +
  277.30 +static final Var assoc = RT.var("clojure.core", "assoc");
  277.31 +static final Var dissoc = RT.var("clojure.core", "dissoc");
  277.32 +static final Var isa = RT.var("clojure.core", "isa?");
  277.33 +static final Var parents = RT.var("clojure.core", "parents");
  277.34 +
  277.35 +public MultiFn(String name, IFn dispatchFn, Object defaultDispatchVal, IRef hierarchy) throws Exception{
  277.36 +	this.name = name;
  277.37 +	this.dispatchFn = dispatchFn;
  277.38 +	this.defaultDispatchVal = defaultDispatchVal;
  277.39 +	this.methodTable = PersistentHashMap.EMPTY;
  277.40 +	this.methodCache = getMethodTable();
  277.41 +	this.preferTable = PersistentHashMap.EMPTY;
  277.42 +    this.hierarchy = hierarchy;
  277.43 +	cachedHierarchy = null;
  277.44 +}
  277.45 +
  277.46 +synchronized public MultiFn reset(){
  277.47 +	methodTable = methodCache = preferTable = PersistentHashMap.EMPTY;
  277.48 +	cachedHierarchy = null;
  277.49 +	return this;
  277.50 +}
  277.51 +
  277.52 +synchronized public MultiFn addMethod(Object dispatchVal, IFn method) throws Exception{
  277.53 +	methodTable = getMethodTable().assoc(dispatchVal, method);
  277.54 +	resetCache();
  277.55 +	return this;
  277.56 +}
  277.57 +
  277.58 +synchronized public MultiFn removeMethod(Object dispatchVal) throws Exception{
  277.59 +	methodTable = getMethodTable().without(dispatchVal);
  277.60 +	resetCache();
  277.61 +	return this;
  277.62 +}
  277.63 +
  277.64 +synchronized public MultiFn preferMethod(Object dispatchValX, Object dispatchValY) throws Exception{
  277.65 +	if(prefers(dispatchValY, dispatchValX))
  277.66 +		throw new IllegalStateException(
  277.67 +				String.format("Preference conflict in multimethod '%s': %s is already preferred to %s",
  277.68 +				              name, dispatchValY, dispatchValX));
  277.69 +	preferTable = getPreferTable().assoc(dispatchValX, RT.conj((IPersistentCollection) RT.get(getPreferTable(),
  277.70 +	                                                                                     dispatchValX,
  277.71 +	                                                                                     PersistentHashSet.EMPTY),
  277.72 +	                                                      dispatchValY));
  277.73 +	resetCache();
  277.74 +	return this;
  277.75 +}
  277.76 +
  277.77 +private boolean prefers(Object x, Object y) throws Exception{
  277.78 +	IPersistentSet xprefs = (IPersistentSet) getPreferTable().valAt(x);
  277.79 +	if(xprefs != null && xprefs.contains(y))
  277.80 +		return true;
  277.81 +	for(ISeq ps = RT.seq(parents.invoke(y)); ps != null; ps = ps.next())
  277.82 +		{
  277.83 +		if(prefers(x, ps.first()))
  277.84 +			return true;
  277.85 +		}
  277.86 +	for(ISeq ps = RT.seq(parents.invoke(x)); ps != null; ps = ps.next())
  277.87 +		{
  277.88 +		if(prefers(ps.first(), y))
  277.89 +			return true;
  277.90 +		}
  277.91 +	return false;
  277.92 +}
  277.93 +
  277.94 +private boolean isA(Object x, Object y) throws Exception{
  277.95 +    return RT.booleanCast(isa.invoke(hierarchy.deref(), x, y));
  277.96 +}
  277.97 +
  277.98 +private boolean dominates(Object x, Object y) throws Exception{
  277.99 +	return prefers(x, y) || isA(x, y);
 277.100 +}
 277.101 +
 277.102 +private IPersistentMap resetCache() throws Exception{
 277.103 +	methodCache = getMethodTable();
 277.104 +	cachedHierarchy = hierarchy.deref();
 277.105 +	return methodCache;
 277.106 +}
 277.107 +
 277.108 +synchronized public IFn getMethod(Object dispatchVal) throws Exception{
 277.109 +	if(cachedHierarchy != hierarchy.deref())
 277.110 +		resetCache();
 277.111 +	IFn targetFn = (IFn) methodCache.valAt(dispatchVal);
 277.112 +	if(targetFn != null)
 277.113 +		return targetFn;
 277.114 +	targetFn = findAndCacheBestMethod(dispatchVal);
 277.115 +	if(targetFn != null)
 277.116 +		return targetFn;
 277.117 +	targetFn = (IFn) getMethodTable().valAt(defaultDispatchVal);
 277.118 +	return targetFn;
 277.119 +}
 277.120 +
 277.121 +private IFn getFn(Object dispatchVal) throws Exception{
 277.122 +	IFn targetFn = getMethod(dispatchVal);
 277.123 +	if(targetFn == null)
 277.124 +		throw new IllegalArgumentException(String.format("No method in multimethod '%s' for dispatch value: %s",
 277.125 +		                                                 name, dispatchVal));
 277.126 +	return targetFn;
 277.127 +}
 277.128 +
 277.129 +private IFn findAndCacheBestMethod(Object dispatchVal) throws Exception{
 277.130 +	Map.Entry bestEntry = null;
 277.131 +	for(Object o : getMethodTable())
 277.132 +		{
 277.133 +		Map.Entry e = (Map.Entry) o;
 277.134 +		if(isA(dispatchVal, e.getKey()))
 277.135 +			{
 277.136 +			if(bestEntry == null || dominates(e.getKey(), bestEntry.getKey()))
 277.137 +				bestEntry = e;
 277.138 +			if(!dominates(bestEntry.getKey(), e.getKey()))
 277.139 +				throw new IllegalArgumentException(
 277.140 +						String.format(
 277.141 +								"Multiple methods in multimethod '%s' match dispatch value: %s -> %s and %s, and neither is preferred",
 277.142 +								name, dispatchVal, e.getKey(), bestEntry.getKey()));
 277.143 +			}
 277.144 +		}
 277.145 +	if(bestEntry == null)
 277.146 +		return null;
 277.147 +	//ensure basis has stayed stable throughout, else redo
 277.148 +	if(cachedHierarchy == hierarchy.deref())
 277.149 +		{
 277.150 +		//place in cache
 277.151 +		methodCache = methodCache.assoc(dispatchVal, bestEntry.getValue());
 277.152 +		return (IFn) bestEntry.getValue();
 277.153 +		}
 277.154 +	else
 277.155 +		{
 277.156 +		resetCache();
 277.157 +		return findAndCacheBestMethod(dispatchVal);
 277.158 +		}
 277.159 +}
 277.160 +
 277.161 +public Object invoke() throws Exception{
 277.162 +	return getFn(dispatchFn.invoke()).invoke();
 277.163 +}
 277.164 +
 277.165 +public Object invoke(Object arg1) throws Exception{
 277.166 +	return getFn(dispatchFn.invoke(arg1)).invoke(arg1);
 277.167 +}
 277.168 +
 277.169 +public Object invoke(Object arg1, Object arg2) throws Exception{
 277.170 +	return getFn(dispatchFn.invoke(arg1, arg2)).invoke(arg1, arg2);
 277.171 +}
 277.172 +
 277.173 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{
 277.174 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3)).invoke(arg1, arg2, arg3);
 277.175 +}
 277.176 +
 277.177 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{
 277.178 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4)).invoke(arg1, arg2, arg3, arg4);
 277.179 +}
 277.180 +
 277.181 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{
 277.182 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5)).invoke(arg1, arg2, arg3, arg4, arg5);
 277.183 +}
 277.184 +
 277.185 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{
 277.186 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6)).invoke(arg1, arg2, arg3, arg4, arg5, arg6);
 277.187 +}
 277.188 +
 277.189 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
 277.190 +		throws Exception{
 277.191 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7))
 277.192 +			.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
 277.193 +}
 277.194 +
 277.195 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.196 +                     Object arg8) throws Exception{
 277.197 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)).
 277.198 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
 277.199 +}
 277.200 +
 277.201 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.202 +                     Object arg8, Object arg9) throws Exception{
 277.203 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)).
 277.204 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
 277.205 +}
 277.206 +
 277.207 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.208 +                     Object arg8, Object arg9, Object arg10) throws Exception{
 277.209 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)).
 277.210 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10);
 277.211 +}
 277.212 +
 277.213 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.214 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{
 277.215 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)).
 277.216 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11);
 277.217 +}
 277.218 +
 277.219 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.220 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{
 277.221 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12)).
 277.222 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12);
 277.223 +}
 277.224 +
 277.225 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.226 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) throws Exception{
 277.227 +	return getFn(dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13)).
 277.228 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13);
 277.229 +}
 277.230 +
 277.231 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.232 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
 277.233 +		throws Exception{
 277.234 +	return getFn(
 277.235 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14)).
 277.236 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14);
 277.237 +}
 277.238 +
 277.239 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.240 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.241 +                     Object arg15) throws Exception{
 277.242 +	return getFn(
 277.243 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.244 +			                  arg15))
 277.245 +			.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15);
 277.246 +}
 277.247 +
 277.248 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.249 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.250 +                     Object arg15, Object arg16) throws Exception{
 277.251 +	return getFn(
 277.252 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.253 +			                  arg15, arg16))
 277.254 +			.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.255 +			        arg15, arg16);
 277.256 +}
 277.257 +
 277.258 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.259 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.260 +                     Object arg15, Object arg16, Object arg17) throws Exception{
 277.261 +	return getFn(
 277.262 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.263 +			                  arg15, arg16, arg17))
 277.264 +			.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.265 +			        arg15, arg16, arg17);
 277.266 +}
 277.267 +
 277.268 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.269 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.270 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{
 277.271 +	return getFn(
 277.272 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.273 +			                  arg15, arg16, arg17, arg18)).
 277.274 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.275 +			       arg15, arg16, arg17, arg18);
 277.276 +}
 277.277 +
 277.278 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.279 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.280 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{
 277.281 +	return getFn(
 277.282 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.283 +			                  arg15, arg16, arg17, arg18, arg19)).
 277.284 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.285 +			       arg15, arg16, arg17, arg18, arg19);
 277.286 +}
 277.287 +
 277.288 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.289 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.290 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
 277.291 +		throws Exception{
 277.292 +	return getFn(
 277.293 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.294 +			                  arg15, arg16, arg17, arg18, arg19, arg20)).
 277.295 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.296 +			       arg15, arg16, arg17, arg18, arg19, arg20);
 277.297 +}
 277.298 +
 277.299 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 277.300 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 277.301 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args)
 277.302 +		throws Exception{
 277.303 +	return getFn(
 277.304 +			dispatchFn.invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.305 +			                  arg15, arg16, arg17, arg18, arg19, arg20, args)).
 277.306 +			invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 277.307 +			       arg15, arg16, arg17, arg18, arg19, arg20, args);
 277.308 +}
 277.309 +
 277.310 +    public IPersistentMap getMethodTable() {
 277.311 +        return methodTable;
 277.312 +    }
 277.313 +
 277.314 +    public IPersistentMap getPreferTable() {
 277.315 +        return preferTable;
 277.316 +    }
 277.317 +}
   278.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   278.2 +++ b/src/clojure/lang/Named.java	Sat Aug 21 06:25:44 2010 -0400
   278.3 @@ -0,0 +1,19 @@
   278.4 +/**
   278.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   278.6 + *   The use and distribution terms for this software are covered by the
   278.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   278.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   278.9 + *   By using this software in any fashion, you are agreeing to be bound by
  278.10 + * 	 the terms of this license.
  278.11 + *   You must not remove this notice, or any other, from this software.
  278.12 + **/
  278.13 +
  278.14 +/* rich Sep 20, 2007 */
  278.15 +
  278.16 +package clojure.lang;
  278.17 +
  278.18 +public interface Named{
  278.19 +String getNamespace();
  278.20 +
  278.21 +String getName();
  278.22 +}
   279.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   279.2 +++ b/src/clojure/lang/Namespace.java	Sat Aug 21 06:25:44 2010 -0400
   279.3 @@ -0,0 +1,243 @@
   279.4 +/**
   279.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   279.6 + *   The use and distribution terms for this software are covered by the
   279.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   279.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   279.9 + *   By using this software in any fashion, you are agreeing to be bound by
  279.10 + * 	 the terms of this license.
  279.11 + *   You must not remove this notice, or any other, from this software.
  279.12 + **/
  279.13 +
  279.14 +/* rich Jan 23, 2008 */
  279.15 +
  279.16 +package clojure.lang;
  279.17 +
  279.18 +import java.io.ObjectStreamException;
  279.19 +import java.io.Serializable;
  279.20 +import java.util.concurrent.ConcurrentHashMap;
  279.21 +import java.util.concurrent.atomic.AtomicReference;
  279.22 +
  279.23 +public class Namespace extends AReference implements Serializable {
  279.24 +final public Symbol name;
  279.25 +transient final AtomicReference<IPersistentMap> mappings = new AtomicReference<IPersistentMap>();
  279.26 +transient final AtomicReference<IPersistentMap> aliases = new AtomicReference<IPersistentMap>();
  279.27 +
  279.28 +final static ConcurrentHashMap<Symbol, Namespace> namespaces = new ConcurrentHashMap<Symbol, Namespace>();
  279.29 +
  279.30 +public String toString(){
  279.31 +	return name.toString();
  279.32 +}
  279.33 +
  279.34 +Namespace(Symbol name){
  279.35 +	super(name.meta());
  279.36 +	this.name = name;
  279.37 +	mappings.set(RT.DEFAULT_IMPORTS);
  279.38 +	aliases.set(RT.map());
  279.39 +}
  279.40 +
  279.41 +public static ISeq all(){
  279.42 +	return RT.seq(namespaces.values());
  279.43 +}
  279.44 +
  279.45 +public Symbol getName(){
  279.46 +	return name;
  279.47 +}
  279.48 +
  279.49 +public IPersistentMap getMappings(){
  279.50 +	return mappings.get();
  279.51 +}
  279.52 +
  279.53 +public Var intern(Symbol sym){
  279.54 +	if(sym.ns != null)
  279.55 +		{
  279.56 +		throw new IllegalArgumentException("Can't intern namespace-qualified symbol");
  279.57 +		}
  279.58 +	IPersistentMap map = getMappings();
  279.59 +	Object o;
  279.60 +	Var v = null;
  279.61 +	while((o = map.valAt(sym)) == null)
  279.62 +		{
  279.63 +		if(v == null)
  279.64 +			v = new Var(this, sym);
  279.65 +		IPersistentMap newMap = map.assoc(sym, v);
  279.66 +		mappings.compareAndSet(map, newMap);
  279.67 +		map = getMappings();
  279.68 +		}
  279.69 +	if(o instanceof Var && ((Var) o).ns == this)
  279.70 +		return (Var) o;
  279.71 +
  279.72 +	if(v == null)
  279.73 +		v = new Var(this, sym);
  279.74 +
  279.75 +	warnOrFailOnReplace(sym, o, v);
  279.76 +
  279.77 +
  279.78 +	while(!mappings.compareAndSet(map, map.assoc(sym, v)))
  279.79 +		map = getMappings();
  279.80 +
  279.81 +	return v;
  279.82 +}
  279.83 +
  279.84 +private void warnOrFailOnReplace(Symbol sym, Object o, Object v){
  279.85 +    if (o instanceof Var)
  279.86 +        {
  279.87 +        Namespace ns = ((Var)o).ns;
  279.88 +        if (ns == this)
  279.89 +            return;
  279.90 +        if (ns != RT.CLOJURE_NS)
  279.91 +            throw new IllegalStateException(sym + " already refers to: " + o + " in namespace: " + name);
  279.92 +        }
  279.93 +	RT.errPrintWriter().println("WARNING: " + sym + " already refers to: " + o + " in namespace: " + name
  279.94 +		+ ", being replaced by: " + v);
  279.95 +}
  279.96 +
  279.97 +Object reference(Symbol sym, Object val){
  279.98 +	if(sym.ns != null)
  279.99 +		{
 279.100 +		throw new IllegalArgumentException("Can't intern namespace-qualified symbol");
 279.101 +		}
 279.102 +	IPersistentMap map = getMappings();
 279.103 +	Object o;
 279.104 +	while((o = map.valAt(sym)) == null)
 279.105 +		{
 279.106 +		IPersistentMap newMap = map.assoc(sym, val);
 279.107 +		mappings.compareAndSet(map, newMap);
 279.108 +		map = getMappings();
 279.109 +		}
 279.110 +	if(o == val)
 279.111 +		return o;
 279.112 +
 279.113 +	warnOrFailOnReplace(sym, o, val);
 279.114 +
 279.115 +	while(!mappings.compareAndSet(map, map.assoc(sym, val)))
 279.116 +		map = getMappings();
 279.117 +
 279.118 +	return val;
 279.119 +
 279.120 +}
 279.121 +
 279.122 +public static boolean areDifferentInstancesOfSameClassName(Class cls1, Class cls2) {
 279.123 +    return (cls1 != cls2) && (cls1.getName().equals(cls2.getName()));
 279.124 +}
 279.125 +
 279.126 +Class referenceClass(Symbol sym, Class val){
 279.127 +    if(sym.ns != null)
 279.128 +        {
 279.129 +        throw new IllegalArgumentException("Can't intern namespace-qualified symbol");
 279.130 +        }
 279.131 +    IPersistentMap map = getMappings();
 279.132 +    Class c = (Class) map.valAt(sym);
 279.133 +    while((c == null) || (areDifferentInstancesOfSameClassName(c, val)))
 279.134 +        {
 279.135 +        IPersistentMap newMap = map.assoc(sym, val);
 279.136 +        mappings.compareAndSet(map, newMap);
 279.137 +        map = getMappings();
 279.138 +        c = (Class) map.valAt(sym);
 279.139 +        }
 279.140 +    if(c == val)
 279.141 +        return c;
 279.142 +
 279.143 +    throw new IllegalStateException(sym + " already refers to: " + c + " in namespace: " + name);
 279.144 +}
 279.145 +
 279.146 +public void unmap(Symbol sym) throws Exception{
 279.147 +	if(sym.ns != null)
 279.148 +		{
 279.149 +		throw new IllegalArgumentException("Can't unintern namespace-qualified symbol");
 279.150 +		}
 279.151 +	IPersistentMap map = getMappings();
 279.152 +	while(map.containsKey(sym))
 279.153 +		{
 279.154 +		IPersistentMap newMap = map.without(sym);
 279.155 +		mappings.compareAndSet(map, newMap);
 279.156 +		map = getMappings();
 279.157 +		}
 279.158 +}
 279.159 +
 279.160 +public Class importClass(Symbol sym, Class c){
 279.161 +	return referenceClass(sym, c);
 279.162 +
 279.163 +}
 279.164 +
 279.165 +public Class importClass(Class c){
 279.166 +	String n = c.getName();
 279.167 +	return importClass(Symbol.intern(n.substring(n.lastIndexOf('.') + 1)), c);
 279.168 +}
 279.169 +
 279.170 +public Var refer(Symbol sym, Var var){
 279.171 +	return (Var) reference(sym, var);
 279.172 +
 279.173 +}
 279.174 +
 279.175 +public static Namespace findOrCreate(Symbol name){
 279.176 +	Namespace ns = namespaces.get(name);
 279.177 +	if(ns != null)
 279.178 +		return ns;
 279.179 +	Namespace newns = new Namespace(name);
 279.180 +	ns = namespaces.putIfAbsent(name, newns);
 279.181 +	return ns == null ? newns : ns;
 279.182 +}
 279.183 +
 279.184 +public static Namespace remove(Symbol name){
 279.185 +	if(name.equals(RT.CLOJURE_NS.name))
 279.186 +		throw new IllegalArgumentException("Cannot remove clojure namespace");
 279.187 +	return namespaces.remove(name);
 279.188 +}
 279.189 +
 279.190 +public static Namespace find(Symbol name){
 279.191 +	return namespaces.get(name);
 279.192 +}
 279.193 +
 279.194 +public Object getMapping(Symbol name){
 279.195 +	return mappings.get().valAt(name);
 279.196 +}
 279.197 +
 279.198 +public Var findInternedVar(Symbol symbol){
 279.199 +	Object o = mappings.get().valAt(symbol);
 279.200 +	if(o != null && o instanceof Var && ((Var) o).ns == this)
 279.201 +		return (Var) o;
 279.202 +	return null;
 279.203 +}
 279.204 +
 279.205 +
 279.206 +public IPersistentMap getAliases(){
 279.207 +	return aliases.get();
 279.208 +}
 279.209 +
 279.210 +public Namespace lookupAlias(Symbol alias){
 279.211 +	IPersistentMap map = getAliases();
 279.212 +	return (Namespace) map.valAt(alias);
 279.213 +}
 279.214 +
 279.215 +public void addAlias(Symbol alias, Namespace ns){
 279.216 +	if (alias == null || ns == null)
 279.217 +		throw new NullPointerException("Expecting Symbol + Namespace");
 279.218 +	IPersistentMap map = getAliases();
 279.219 +	while(!map.containsKey(alias))
 279.220 +		{
 279.221 +		IPersistentMap newMap = map.assoc(alias, ns);
 279.222 +		aliases.compareAndSet(map, newMap);
 279.223 +		map = getAliases();
 279.224 +		}
 279.225 +	// you can rebind an alias, but only to the initially-aliased namespace.
 279.226 +	if(!map.valAt(alias).equals(ns))
 279.227 +		throw new IllegalStateException("Alias " + alias + " already exists in namespace "
 279.228 +		                                   + name + ", aliasing " + map.valAt(alias));
 279.229 +}
 279.230 +
 279.231 +public void removeAlias(Symbol alias) throws Exception{
 279.232 +	IPersistentMap map = getAliases();
 279.233 +	while(map.containsKey(alias))
 279.234 +		{
 279.235 +		IPersistentMap newMap = map.without(alias);
 279.236 +		aliases.compareAndSet(map, newMap);
 279.237 +		map = getAliases();
 279.238 +		}
 279.239 +}
 279.240 +
 279.241 +private Object readResolve() throws ObjectStreamException {
 279.242 +    // ensures that serialized namespaces are "deserialized" to the
 279.243 +    // namespace in the present runtime
 279.244 +    return findOrCreate(name);
 279.245 +}
 279.246 +}
   280.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   280.2 +++ b/src/clojure/lang/Numbers.java	Sat Aug 21 06:25:44 2010 -0400
   280.3 @@ -0,0 +1,4527 @@
   280.4 +/**
   280.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   280.6 + *   The use and distribution terms for this software are covered by the
   280.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   280.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   280.9 + *   By using this software in any fashion, you are agreeing to be bound by
  280.10 + * 	 the terms of this license.
  280.11 + *   You must not remove this notice, or any other, from this software.
  280.12 + **/
  280.13 +
  280.14 +/* rich Mar 31, 2008 */
  280.15 +
  280.16 +package clojure.lang;
  280.17 +
  280.18 +import java.math.BigInteger;
  280.19 +import java.math.BigDecimal;
  280.20 +import java.math.MathContext;
  280.21 +
  280.22 +public class Numbers{
  280.23 +
  280.24 +static interface Ops{
  280.25 +	Ops combine(Ops y);
  280.26 +
  280.27 +	Ops opsWith(IntegerOps x);
  280.28 +
  280.29 +	Ops opsWith(LongOps x);
  280.30 +
  280.31 +	Ops opsWith(FloatOps x);
  280.32 +
  280.33 +	Ops opsWith(DoubleOps x);
  280.34 +
  280.35 +	Ops opsWith(RatioOps x);
  280.36 +
  280.37 +	Ops opsWith(BigIntegerOps x);
  280.38 +
  280.39 +	Ops opsWith(BigDecimalOps x);
  280.40 +
  280.41 +	public boolean isZero(Number x);
  280.42 +
  280.43 +	public boolean isPos(Number x);
  280.44 +
  280.45 +	public boolean isNeg(Number x);
  280.46 +
  280.47 +	public Number add(Number x, Number y);
  280.48 +
  280.49 +	public Number multiply(Number x, Number y);
  280.50 +
  280.51 +	public Number divide(Number x, Number y);
  280.52 +
  280.53 +	public Number quotient(Number x, Number y);
  280.54 +
  280.55 +	public Number remainder(Number x, Number y);
  280.56 +
  280.57 +	public boolean equiv(Number x, Number y);
  280.58 +
  280.59 +	public boolean lt(Number x, Number y);
  280.60 +
  280.61 +	public Number negate(Number x);
  280.62 +
  280.63 +	public Number inc(Number x);
  280.64 +
  280.65 +	public Number dec(Number x);
  280.66 +}
  280.67 +
  280.68 +static interface BitOps{
  280.69 +	BitOps combine(BitOps y);
  280.70 +
  280.71 +	BitOps bitOpsWith(IntegerBitOps x);
  280.72 +
  280.73 +	BitOps bitOpsWith(LongBitOps x);
  280.74 +
  280.75 +	BitOps bitOpsWith(BigIntegerBitOps x);
  280.76 +
  280.77 +	public Number not(Number x);
  280.78 +
  280.79 +	public Number and(Number x, Number y);
  280.80 +
  280.81 +	public Number or(Number x, Number y);
  280.82 +
  280.83 +	public Number xor(Number x, Number y);
  280.84 +
  280.85 +	public Number andNot(Number x, Number y);
  280.86 +
  280.87 +	public Number clearBit(Number x, int n);
  280.88 +
  280.89 +	public Number setBit(Number x, int n);
  280.90 +
  280.91 +	public Number flipBit(Number x, int n);
  280.92 +
  280.93 +	public boolean testBit(Number x, int n);
  280.94 +
  280.95 +	public Number shiftLeft(Number x, int n);
  280.96 +
  280.97 +	public Number shiftRight(Number x, int n);
  280.98 +}
  280.99 +
 280.100 +
 280.101 +static public boolean isZero(Object x){
 280.102 +	return ops(x).isZero((Number)x);
 280.103 +}
 280.104 +
 280.105 +static public boolean isPos(Object x){
 280.106 +	return ops(x).isPos((Number)x);
 280.107 +}
 280.108 +
 280.109 +static public boolean isNeg(Object x){
 280.110 +	return ops(x).isNeg((Number)x);
 280.111 +}
 280.112 +
 280.113 +static public Number minus(Object x){
 280.114 +	return ops(x).negate((Number)x);
 280.115 +}
 280.116 +
 280.117 +static public Number inc(Object x){
 280.118 +	return ops(x).inc((Number)x);
 280.119 +}
 280.120 +
 280.121 +static public Number dec(Object x){
 280.122 +	return ops(x).dec((Number)x);
 280.123 +}
 280.124 +
 280.125 +static public Number add(Object x, Object y){
 280.126 +	return ops(x).combine(ops(y)).add((Number)x, (Number)y);
 280.127 +}
 280.128 +
 280.129 +static public Number minus(Object x, Object y){
 280.130 +	Ops yops = ops(y);
 280.131 +	return ops(x).combine(yops).add((Number)x, yops.negate((Number)y));
 280.132 +}
 280.133 +
 280.134 +static public Number multiply(Object x, Object y){
 280.135 +	return ops(x).combine(ops(y)).multiply((Number)x, (Number)y);
 280.136 +}
 280.137 +
 280.138 +static public Number divide(Object x, Object y){
 280.139 +	Ops yops = ops(y);
 280.140 +	if(yops.isZero((Number)y))
 280.141 +		throw new ArithmeticException("Divide by zero");
 280.142 +	return ops(x).combine(yops).divide((Number)x, (Number)y);
 280.143 +}
 280.144 +
 280.145 +static public Number quotient(Number x, Number y){
 280.146 +	Ops yops = ops(y);
 280.147 +	if(yops.isZero(y))
 280.148 +		throw new ArithmeticException("Divide by zero");
 280.149 +	return reduce(ops(x).combine(yops).quotient(x, y));
 280.150 +}
 280.151 +
 280.152 +static public Number remainder(Number x, Number y){
 280.153 +	Ops yops = ops(y);
 280.154 +	if(yops.isZero(y))
 280.155 +		throw new ArithmeticException("Divide by zero");
 280.156 +	return reduce(ops(x).combine(yops).remainder(x, y));
 280.157 +}
 280.158 +
 280.159 +static Number quotient(double n, double d){
 280.160 +	double q = n / d;
 280.161 +	if(q <= Integer.MAX_VALUE && q >= Integer.MIN_VALUE)
 280.162 +		{
 280.163 +		return (int) q;
 280.164 +		}
 280.165 +	else
 280.166 +		{ //bigint quotient
 280.167 +		return reduce(new BigDecimal(q).toBigInteger());
 280.168 +		}
 280.169 +}
 280.170 +
 280.171 +static Number remainder(double n, double d){
 280.172 +	double q = n / d;
 280.173 +	if(q <= Integer.MAX_VALUE && q >= Integer.MIN_VALUE)
 280.174 +		{
 280.175 +		return (n - ((int) q) * d);
 280.176 +		}
 280.177 +	else
 280.178 +		{ //bigint quotient
 280.179 +		Number bq = reduce(new BigDecimal(q).toBigInteger());
 280.180 +		return (n - bq.doubleValue() * d);
 280.181 +		}
 280.182 +}
 280.183 +
 280.184 +static public boolean equiv(Object x, Object y){
 280.185 +	return equiv((Number) x, (Number) y);
 280.186 +}
 280.187 +
 280.188 +static public boolean equiv(Number x, Number y){
 280.189 +	return ops(x).combine(ops(y)).equiv(x, y);
 280.190 +}
 280.191 +
 280.192 +static public boolean lt(Object x, Object y){
 280.193 +	return ops(x).combine(ops(y)).lt((Number)x, (Number)y);
 280.194 +}
 280.195 +
 280.196 +static public boolean lte(Object x, Object y){
 280.197 +	return !ops(x).combine(ops(y)).lt((Number)y, (Number)x);
 280.198 +}
 280.199 +
 280.200 +static public boolean gt(Object x, Object y){
 280.201 +	return ops(x).combine(ops(y)).lt((Number)y, (Number)x);
 280.202 +}
 280.203 +
 280.204 +static public boolean gte(Object x, Object y){
 280.205 +	return !ops(x).combine(ops(y)).lt((Number)x, (Number)y);
 280.206 +}
 280.207 +
 280.208 +static public int compare(Number x, Number y){
 280.209 +	Ops ops = ops(x).combine(ops(y));
 280.210 +	if(ops.lt(x, y))
 280.211 +		return -1;
 280.212 +	else if(ops.lt(y, x))
 280.213 +		return 1;
 280.214 +	return 0;
 280.215 +}
 280.216 +
 280.217 +static BigInteger toBigInteger(Object x){
 280.218 +	if(x instanceof BigInteger)
 280.219 +		return (BigInteger) x;
 280.220 +	else
 280.221 +		return BigInteger.valueOf(((Number) x).longValue());
 280.222 +}
 280.223 +
 280.224 +static BigDecimal toBigDecimal(Object x){
 280.225 +	if(x instanceof BigDecimal)
 280.226 +		return (BigDecimal) x;
 280.227 +	else if(x instanceof BigInteger)
 280.228 +		return new BigDecimal((BigInteger) x);
 280.229 +	else
 280.230 +		return BigDecimal.valueOf(((Number) x).longValue());
 280.231 +}
 280.232 +
 280.233 +static Ratio toRatio(Object x){
 280.234 +	if(x instanceof Ratio)
 280.235 +		return (Ratio) x;
 280.236 +	else if(x instanceof BigDecimal)
 280.237 +		{
 280.238 +		BigDecimal bx = (BigDecimal) x;
 280.239 +		BigInteger bv = bx.unscaledValue();
 280.240 +		int scale = bx.scale();
 280.241 +		if(scale < 0)
 280.242 +			return new Ratio(bv.multiply(BigInteger.TEN.pow(-scale)), BigInteger.ONE);
 280.243 +		else
 280.244 +			return new Ratio(bv, BigInteger.TEN.pow(scale));
 280.245 +		}
 280.246 +	return new Ratio(toBigInteger(x), BigInteger.ONE);
 280.247 +}
 280.248 +
 280.249 +static public Number rationalize(Number x){
 280.250 +	if(x instanceof Float || x instanceof Double)
 280.251 +		return rationalize(BigDecimal.valueOf(x.doubleValue()));
 280.252 +	else if(x instanceof BigDecimal)
 280.253 +		{
 280.254 +		BigDecimal bx = (BigDecimal) x;
 280.255 +		BigInteger bv = bx.unscaledValue();
 280.256 +		int scale = bx.scale();
 280.257 +		if(scale < 0)
 280.258 +			return bv.multiply(BigInteger.TEN.pow(-scale));
 280.259 +		else
 280.260 +			return divide(bv, BigInteger.TEN.pow(scale));
 280.261 +		}
 280.262 +	return x;
 280.263 +}
 280.264 +
 280.265 +static public Number reduce(Number val){
 280.266 +	if(val instanceof Long)
 280.267 +		return reduce(val.longValue());
 280.268 +	else if (val instanceof BigInteger)
 280.269 +		return reduce((BigInteger) val);
 280.270 +	return val;
 280.271 +}
 280.272 +
 280.273 +static public Number reduce(BigInteger val){
 280.274 +	int bitLength = val.bitLength();
 280.275 +	if(bitLength < 32)
 280.276 +		return val.intValue();
 280.277 +	else if(bitLength < 64)
 280.278 +		return val.longValue();
 280.279 +	else
 280.280 +		return val;
 280.281 +}
 280.282 +
 280.283 +static public Number reduce(long val){
 280.284 +	if(val >= Integer.MIN_VALUE && val <= Integer.MAX_VALUE)
 280.285 +		return (int) val;
 280.286 +	else
 280.287 +		return val;
 280.288 +}
 280.289 +
 280.290 +static public Number divide(BigInteger n, BigInteger d){
 280.291 +	if(d.equals(BigInteger.ZERO))
 280.292 +		throw new ArithmeticException("Divide by zero");
 280.293 +	BigInteger gcd = n.gcd(d);
 280.294 +	if(gcd.equals(BigInteger.ZERO))
 280.295 +		return 0;
 280.296 +	n = n.divide(gcd);
 280.297 +	d = d.divide(gcd);
 280.298 +	if(d.equals(BigInteger.ONE))
 280.299 +		return reduce(n);
 280.300 +	else if(d.equals(BigInteger.ONE.negate()))
 280.301 +		return reduce(n.negate());
 280.302 +	return new Ratio((d.signum() < 0 ? n.negate() : n),
 280.303 +	                 (d.signum() < 0 ? d.negate() : d));
 280.304 +}
 280.305 +
 280.306 +static public Number not(Object x){
 280.307 +	return bitOps(x).not((Number)x);
 280.308 +}
 280.309 +
 280.310 +
 280.311 +static public Number and(Object x, Object y){
 280.312 +	return bitOps(x).combine(bitOps(y)).and((Number)x, (Number)y);
 280.313 +}
 280.314 +
 280.315 +static public Number or(Object x, Object y){
 280.316 +	return bitOps(x).combine(bitOps(y)).or((Number)x, (Number)y);
 280.317 +}
 280.318 +
 280.319 +static public Number xor(Object x, Object y){
 280.320 +	return bitOps(x).combine(bitOps(y)).xor((Number)x, (Number)y);
 280.321 +}
 280.322 +
 280.323 +static public Number andNot(Number x, Number y){
 280.324 +	return bitOps(x).combine(bitOps(y)).andNot(x, y);
 280.325 +}
 280.326 +
 280.327 +static public Number clearBit(Number x, int n){
 280.328 +	if(n < 0)
 280.329 +		throw new ArithmeticException("Negative bit index");
 280.330 +	return bitOps(x).clearBit(x, n);
 280.331 +}
 280.332 +
 280.333 +static public Number setBit(Number x, int n){
 280.334 +	if(n < 0)
 280.335 +		throw new ArithmeticException("Negative bit index");
 280.336 +	return bitOps(x).setBit(x, n);
 280.337 +}
 280.338 +
 280.339 +static public Number flipBit(Number x, int n){
 280.340 +	if(n < 0)
 280.341 +		throw new ArithmeticException("Negative bit index");
 280.342 +	return bitOps(x).flipBit(x, n);
 280.343 +}
 280.344 +
 280.345 +static public boolean testBit(Number x, int n){
 280.346 +	if(n < 0)
 280.347 +		throw new ArithmeticException("Negative bit index");
 280.348 +	return bitOps(x).testBit(x, n);
 280.349 +}
 280.350 +
 280.351 +static public Number shiftLeft(Object x, Object n){
 280.352 +	return bitOps(x).shiftLeft((Number)x, ((Number)n).intValue());
 280.353 +}
 280.354 +
 280.355 +static public int shiftLeft(int x, int n){
 280.356 +	return x << n;
 280.357 +}
 280.358 +
 280.359 +static public Number shiftRight(Object x, Object n){
 280.360 +	return bitOps(x).shiftRight((Number)x, ((Number)n).intValue());
 280.361 +}
 280.362 +
 280.363 +static public int shiftRight(int x, int n){
 280.364 +	return x >> n;
 280.365 +}
 280.366 +
 280.367 +final static class IntegerOps implements Ops{
 280.368 +	public Ops combine(Ops y){
 280.369 +		return y.opsWith(this);
 280.370 +	}
 280.371 +
 280.372 +	final public Ops opsWith(IntegerOps x){
 280.373 +		return this;
 280.374 +	}
 280.375 +
 280.376 +	final public Ops opsWith(LongOps x){
 280.377 +		return LONG_OPS;
 280.378 +	}
 280.379 +
 280.380 +	final public Ops opsWith(FloatOps x){
 280.381 +		return FLOAT_OPS;
 280.382 +	}
 280.383 +
 280.384 +	final public Ops opsWith(DoubleOps x){
 280.385 +		return DOUBLE_OPS;
 280.386 +	}
 280.387 +
 280.388 +	final public Ops opsWith(RatioOps x){
 280.389 +		return RATIO_OPS;
 280.390 +	}
 280.391 +
 280.392 +	final public Ops opsWith(BigIntegerOps x){
 280.393 +		return BIGINTEGER_OPS;
 280.394 +	}
 280.395 +
 280.396 +	final public Ops opsWith(BigDecimalOps x){
 280.397 +		return BIGDECIMAL_OPS;
 280.398 +	}
 280.399 +
 280.400 +	public boolean isZero(Number x){
 280.401 +		return x.intValue() == 0;
 280.402 +	}
 280.403 +
 280.404 +	public boolean isPos(Number x){
 280.405 +		return x.intValue() > 0;
 280.406 +	}
 280.407 +
 280.408 +	public boolean isNeg(Number x){
 280.409 +		return x.intValue() < 0;
 280.410 +	}
 280.411 +
 280.412 +	final public Number add(Number x, Number y){
 280.413 +		long ret = x.longValue() + y.longValue();
 280.414 +		if(ret <= Integer.MAX_VALUE && ret >= Integer.MIN_VALUE)
 280.415 +			return (int) ret;
 280.416 +		return ret;
 280.417 +	}
 280.418 +
 280.419 +	final public Number multiply(Number x, Number y){
 280.420 +		long ret = x.longValue() * y.longValue();
 280.421 +		if(ret <= Integer.MAX_VALUE && ret >= Integer.MIN_VALUE)
 280.422 +			return (int) ret;
 280.423 +		return ret;
 280.424 +	}
 280.425 +
 280.426 +	static int gcd(int u, int v){
 280.427 +		while(v != 0)
 280.428 +			{
 280.429 +			int r = u % v;
 280.430 +			u = v;
 280.431 +			v = r;
 280.432 +			}
 280.433 +		return u;
 280.434 +	}
 280.435 +
 280.436 +	public Number divide(Number x, Number y){
 280.437 +		int n = x.intValue();
 280.438 +		int val = y.intValue();
 280.439 +		int gcd = gcd(n, val);
 280.440 +		if(gcd == 0)
 280.441 +			return 0;
 280.442 +
 280.443 +		n = n / gcd;
 280.444 +		int d = val / gcd;
 280.445 +		if(d == 1)
 280.446 +			return n;
 280.447 +		if(d < 0)
 280.448 +			{
 280.449 +			n = -n;
 280.450 +			d = -d;
 280.451 +			}
 280.452 +		return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d));
 280.453 +	}
 280.454 +
 280.455 +	public Number quotient(Number x, Number y){
 280.456 +		return x.intValue() / y.intValue();
 280.457 +	}
 280.458 +
 280.459 +	public Number remainder(Number x, Number y){
 280.460 +		return x.intValue() % y.intValue();
 280.461 +	}
 280.462 +
 280.463 +	public boolean equiv(Number x, Number y){
 280.464 +		return x.intValue() == y.intValue();
 280.465 +	}
 280.466 +
 280.467 +	public boolean lt(Number x, Number y){
 280.468 +		return x.intValue() < y.intValue();
 280.469 +	}
 280.470 +
 280.471 +	//public Number subtract(Number x, Number y);
 280.472 +	final public Number negate(Number x){
 280.473 +		int val = x.intValue();
 280.474 +		if(val > Integer.MIN_VALUE)
 280.475 +			return -val;
 280.476 +		return -((long) val);
 280.477 +	}
 280.478 +
 280.479 +	public Number inc(Number x){
 280.480 +		int val = x.intValue();
 280.481 +		if(val < Integer.MAX_VALUE)
 280.482 +			return val + 1;
 280.483 +		return (long) val + 1;
 280.484 +	}
 280.485 +
 280.486 +	public Number dec(Number x){
 280.487 +		int val = x.intValue();
 280.488 +		if(val > Integer.MIN_VALUE)
 280.489 +			return val - 1;
 280.490 +		return (long) val - 1;
 280.491 +	}
 280.492 +}
 280.493 +
 280.494 +final static class LongOps implements Ops{
 280.495 +	public Ops combine(Ops y){
 280.496 +		return y.opsWith(this);
 280.497 +	}
 280.498 +
 280.499 +	final public Ops opsWith(IntegerOps x){
 280.500 +		return this;
 280.501 +	}
 280.502 +
 280.503 +	final public Ops opsWith(LongOps x){
 280.504 +		return this;
 280.505 +	}
 280.506 +
 280.507 +	final public Ops opsWith(FloatOps x){
 280.508 +		return FLOAT_OPS;
 280.509 +	}
 280.510 +
 280.511 +	final public Ops opsWith(DoubleOps x){
 280.512 +		return DOUBLE_OPS;
 280.513 +	}
 280.514 +
 280.515 +	final public Ops opsWith(RatioOps x){
 280.516 +		return RATIO_OPS;
 280.517 +	}
 280.518 +
 280.519 +	final public Ops opsWith(BigIntegerOps x){
 280.520 +		return BIGINTEGER_OPS;
 280.521 +	}
 280.522 +
 280.523 +	final public Ops opsWith(BigDecimalOps x){
 280.524 +		return BIGDECIMAL_OPS;
 280.525 +	}
 280.526 +
 280.527 +	public boolean isZero(Number x){
 280.528 +		return x.longValue() == 0;
 280.529 +	}
 280.530 +
 280.531 +	public boolean isPos(Number x){
 280.532 +		return x.longValue() > 0;
 280.533 +	}
 280.534 +
 280.535 +	public boolean isNeg(Number x){
 280.536 +		return x.longValue() < 0;
 280.537 +	}
 280.538 +
 280.539 +	final public Number add(Number x, Number y){
 280.540 +		long lx = x.longValue(), ly = y.longValue();
 280.541 +		long ret = lx + ly;
 280.542 +		if ((ret ^ lx) < 0 && (ret ^ ly) < 0)
 280.543 +			return BIGINTEGER_OPS.add(x, y);
 280.544 +		return ret;
 280.545 +	}
 280.546 +
 280.547 +	final public Number multiply(Number x, Number y){
 280.548 +		long lx = x.longValue(), ly = y.longValue();
 280.549 +		long ret = lx * ly;
 280.550 +		if (ly != 0 && ret/ly != lx)
 280.551 +			return BIGINTEGER_OPS.multiply(x, y);
 280.552 +		return ret;
 280.553 +	}
 280.554 +
 280.555 +	static long gcd(long u, long v){
 280.556 +		while(v != 0)
 280.557 +			{
 280.558 +			long r = u % v;
 280.559 +			u = v;
 280.560 +			v = r;
 280.561 +			}
 280.562 +		return u;
 280.563 +	}
 280.564 +
 280.565 +	public Number divide(Number x, Number y){
 280.566 +		long n = x.longValue();
 280.567 +		long val = y.longValue();
 280.568 +		long gcd = gcd(n, val);
 280.569 +		if(gcd == 0)
 280.570 +			return 0;
 280.571 +
 280.572 +		n = n / gcd;
 280.573 +		long d = val / gcd;
 280.574 +		if(d == 1)
 280.575 +			return n;
 280.576 +		if(d < 0)
 280.577 +			{
 280.578 +			n = -n;
 280.579 +			d = -d;
 280.580 +			}
 280.581 +		return new Ratio(BigInteger.valueOf(n), BigInteger.valueOf(d));
 280.582 +	}
 280.583 +
 280.584 +	public Number quotient(Number x, Number y){
 280.585 +		return x.longValue() / y.longValue();
 280.586 +	}
 280.587 +
 280.588 +	public Number remainder(Number x, Number y){
 280.589 +		return x.longValue() % y.longValue();
 280.590 +	}
 280.591 +
 280.592 +	public boolean equiv(Number x, Number y){
 280.593 +		return x.longValue() == y.longValue();
 280.594 +	}
 280.595 +
 280.596 +	public boolean lt(Number x, Number y){
 280.597 +		return x.longValue() < y.longValue();
 280.598 +	}
 280.599 +
 280.600 +	//public Number subtract(Number x, Number y);
 280.601 +	final public Number negate(Number x){
 280.602 +		long val = x.longValue();
 280.603 +		if(val > Long.MIN_VALUE)
 280.604 +			return -val;
 280.605 +		return BigInteger.valueOf(val).negate();
 280.606 +	}
 280.607 +
 280.608 +	public Number inc(Number x){
 280.609 +		long val = x.longValue();
 280.610 +		if(val < Long.MAX_VALUE)
 280.611 +			return val + 1;
 280.612 +		return BIGINTEGER_OPS.inc(x);
 280.613 +	}
 280.614 +
 280.615 +	public Number dec(Number x){
 280.616 +		long val = x.longValue();
 280.617 +		if(val > Long.MIN_VALUE)
 280.618 +			return val - 1;
 280.619 +		return BIGINTEGER_OPS.dec(x);
 280.620 +	}
 280.621 +}
 280.622 +
 280.623 +final static class FloatOps implements Ops{
 280.624 +	public Ops combine(Ops y){
 280.625 +		return y.opsWith(this);
 280.626 +	}
 280.627 +
 280.628 +	final public Ops opsWith(IntegerOps x){
 280.629 +		return this;
 280.630 +	}
 280.631 +
 280.632 +	final public Ops opsWith(LongOps x){
 280.633 +		return this;
 280.634 +	}
 280.635 +
 280.636 +	final public Ops opsWith(FloatOps x){
 280.637 +		return this;
 280.638 +	}
 280.639 +
 280.640 +	final public Ops opsWith(DoubleOps x){
 280.641 +		return DOUBLE_OPS;
 280.642 +	}
 280.643 +
 280.644 +	final public Ops opsWith(RatioOps x){
 280.645 +		return this;
 280.646 +	}
 280.647 +
 280.648 +	final public Ops opsWith(BigIntegerOps x){
 280.649 +		return this;
 280.650 +	}
 280.651 +
 280.652 +	final public Ops opsWith(BigDecimalOps x){
 280.653 +		return this;
 280.654 +	}
 280.655 +
 280.656 +	public boolean isZero(Number x){
 280.657 +		return x.floatValue() == 0;
 280.658 +	}
 280.659 +
 280.660 +	public boolean isPos(Number x){
 280.661 +		return x.floatValue() > 0;
 280.662 +	}
 280.663 +
 280.664 +	public boolean isNeg(Number x){
 280.665 +		return x.floatValue() < 0;
 280.666 +	}
 280.667 +
 280.668 +	final public Number add(Number x, Number y){
 280.669 +		return x.floatValue() + y.floatValue();
 280.670 +	}
 280.671 +
 280.672 +	final public Number multiply(Number x, Number y){
 280.673 +		return x.floatValue() * y.floatValue();
 280.674 +	}
 280.675 +
 280.676 +	public Number divide(Number x, Number y){
 280.677 +		return x.floatValue() / y.floatValue();
 280.678 +	}
 280.679 +
 280.680 +	public Number quotient(Number x, Number y){
 280.681 +		return Numbers.quotient(x.doubleValue(), y.doubleValue());
 280.682 +	}
 280.683 +
 280.684 +	public Number remainder(Number x, Number y){
 280.685 +		return Numbers.remainder(x.doubleValue(), y.doubleValue());
 280.686 +	}
 280.687 +
 280.688 +	public boolean equiv(Number x, Number y){
 280.689 +		return x.floatValue() == y.floatValue();
 280.690 +	}
 280.691 +
 280.692 +	public boolean lt(Number x, Number y){
 280.693 +		return x.floatValue() < y.floatValue();
 280.694 +	}
 280.695 +
 280.696 +	//public Number subtract(Number x, Number y);
 280.697 +	final public Number negate(Number x){
 280.698 +		return -x.floatValue();
 280.699 +	}
 280.700 +
 280.701 +	public Number inc(Number x){
 280.702 +		return x.floatValue() + 1;
 280.703 +	}
 280.704 +
 280.705 +	public Number dec(Number x){
 280.706 +		return x.floatValue() - 1;
 280.707 +	}
 280.708 +}
 280.709 +
 280.710 +final static class DoubleOps implements Ops{
 280.711 +	public Ops combine(Ops y){
 280.712 +		return y.opsWith(this);
 280.713 +	}
 280.714 +
 280.715 +	final public Ops opsWith(IntegerOps x){
 280.716 +		return this;
 280.717 +	}
 280.718 +
 280.719 +	final public Ops opsWith(LongOps x){
 280.720 +		return this;
 280.721 +	}
 280.722 +
 280.723 +	final public Ops opsWith(FloatOps x){
 280.724 +		return this;
 280.725 +	}
 280.726 +
 280.727 +	final public Ops opsWith(DoubleOps x){
 280.728 +		return this;
 280.729 +	}
 280.730 +
 280.731 +	final public Ops opsWith(RatioOps x){
 280.732 +		return this;
 280.733 +	}
 280.734 +
 280.735 +	final public Ops opsWith(BigIntegerOps x){
 280.736 +		return this;
 280.737 +	}
 280.738 +
 280.739 +	final public Ops opsWith(BigDecimalOps x){
 280.740 +		return this;
 280.741 +	}
 280.742 +
 280.743 +	public boolean isZero(Number x){
 280.744 +		return x.doubleValue() == 0;
 280.745 +	}
 280.746 +
 280.747 +	public boolean isPos(Number x){
 280.748 +		return x.doubleValue() > 0;
 280.749 +	}
 280.750 +
 280.751 +	public boolean isNeg(Number x){
 280.752 +		return x.doubleValue() < 0;
 280.753 +	}
 280.754 +
 280.755 +	final public Number add(Number x, Number y){
 280.756 +		return x.doubleValue() + y.doubleValue();
 280.757 +	}
 280.758 +
 280.759 +	final public Number multiply(Number x, Number y){
 280.760 +		return x.doubleValue() * y.doubleValue();
 280.761 +	}
 280.762 +
 280.763 +	public Number divide(Number x, Number y){
 280.764 +		return x.doubleValue() / y.doubleValue();
 280.765 +	}
 280.766 +
 280.767 +	public Number quotient(Number x, Number y){
 280.768 +		return Numbers.quotient(x.doubleValue(), y.doubleValue());
 280.769 +	}
 280.770 +
 280.771 +	public Number remainder(Number x, Number y){
 280.772 +		return Numbers.remainder(x.doubleValue(), y.doubleValue());
 280.773 +	}
 280.774 +
 280.775 +	public boolean equiv(Number x, Number y){
 280.776 +		return x.doubleValue() == y.doubleValue();
 280.777 +	}
 280.778 +
 280.779 +	public boolean lt(Number x, Number y){
 280.780 +		return x.doubleValue() < y.doubleValue();
 280.781 +	}
 280.782 +
 280.783 +	//public Number subtract(Number x, Number y);
 280.784 +	final public Number negate(Number x){
 280.785 +		return -x.doubleValue();
 280.786 +	}
 280.787 +
 280.788 +	public Number inc(Number x){
 280.789 +		return x.doubleValue() + 1;
 280.790 +	}
 280.791 +
 280.792 +	public Number dec(Number x){
 280.793 +		return x.doubleValue() - 1;
 280.794 +	}
 280.795 +}
 280.796 +
 280.797 +final static class RatioOps implements Ops{
 280.798 +	public Ops combine(Ops y){
 280.799 +		return y.opsWith(this);
 280.800 +	}
 280.801 +
 280.802 +	final public Ops opsWith(IntegerOps x){
 280.803 +		return this;
 280.804 +	}
 280.805 +
 280.806 +	final public Ops opsWith(LongOps x){
 280.807 +		return this;
 280.808 +	}
 280.809 +
 280.810 +	final public Ops opsWith(FloatOps x){
 280.811 +		return FLOAT_OPS;
 280.812 +	}
 280.813 +
 280.814 +	final public Ops opsWith(DoubleOps x){
 280.815 +		return DOUBLE_OPS;
 280.816 +	}
 280.817 +
 280.818 +	final public Ops opsWith(RatioOps x){
 280.819 +		return this;
 280.820 +	}
 280.821 +
 280.822 +	final public Ops opsWith(BigIntegerOps x){
 280.823 +		return this;
 280.824 +	}
 280.825 +
 280.826 +	final public Ops opsWith(BigDecimalOps x){
 280.827 +		return this;
 280.828 +	}
 280.829 +
 280.830 +	public boolean isZero(Number x){
 280.831 +		Ratio r = (Ratio) x;
 280.832 +		return r.numerator.signum() == 0;
 280.833 +	}
 280.834 +
 280.835 +	public boolean isPos(Number x){
 280.836 +		Ratio r = (Ratio) x;
 280.837 +		return r.numerator.signum() > 0;
 280.838 +	}
 280.839 +
 280.840 +	public boolean isNeg(Number x){
 280.841 +		Ratio r = (Ratio) x;
 280.842 +		return r.numerator.signum() < 0;
 280.843 +	}
 280.844 +
 280.845 +	final public Number add(Number x, Number y){
 280.846 +		Ratio rx = toRatio(x);
 280.847 +		Ratio ry = toRatio(y);
 280.848 +		return divide(ry.numerator.multiply(rx.denominator)
 280.849 +				.add(rx.numerator.multiply(ry.denominator))
 280.850 +				, ry.denominator.multiply(rx.denominator));
 280.851 +	}
 280.852 +
 280.853 +	final public Number multiply(Number x, Number y){
 280.854 +		Ratio rx = toRatio(x);
 280.855 +		Ratio ry = toRatio(y);
 280.856 +		return Numbers.divide(ry.numerator.multiply(rx.numerator)
 280.857 +				, ry.denominator.multiply(rx.denominator));
 280.858 +	}
 280.859 +
 280.860 +	public Number divide(Number x, Number y){
 280.861 +		Ratio rx = toRatio(x);
 280.862 +		Ratio ry = toRatio(y);
 280.863 +		return Numbers.divide(ry.denominator.multiply(rx.numerator)
 280.864 +				, ry.numerator.multiply(rx.denominator));
 280.865 +	}
 280.866 +
 280.867 +	public Number quotient(Number x, Number y){
 280.868 +		Ratio rx = toRatio(x);
 280.869 +		Ratio ry = toRatio(y);
 280.870 +		BigInteger q = rx.numerator.multiply(ry.denominator).divide(
 280.871 +				rx.denominator.multiply(ry.numerator));
 280.872 +		return reduce(q);
 280.873 +	}
 280.874 +
 280.875 +	public Number remainder(Number x, Number y){
 280.876 +		Ratio rx = toRatio(x);
 280.877 +		Ratio ry = toRatio(y);
 280.878 +		BigInteger q = rx.numerator.multiply(ry.denominator).divide(
 280.879 +				rx.denominator.multiply(ry.numerator));
 280.880 +		return Numbers.minus(x, Numbers.multiply(q, y));
 280.881 +	}
 280.882 +
 280.883 +	public boolean equiv(Number x, Number y){
 280.884 +		Ratio rx = toRatio(x);
 280.885 +		Ratio ry = toRatio(y);
 280.886 +		return rx.numerator.equals(ry.numerator)
 280.887 +		       && rx.denominator.equals(ry.denominator);
 280.888 +	}
 280.889 +
 280.890 +	public boolean lt(Number x, Number y){
 280.891 +		Ratio rx = toRatio(x);
 280.892 +		Ratio ry = toRatio(y);
 280.893 +		return Numbers.lt(rx.numerator.multiply(ry.denominator), ry.numerator.multiply(rx.denominator));
 280.894 +	}
 280.895 +
 280.896 +	//public Number subtract(Number x, Number y);
 280.897 +	final public Number negate(Number x){
 280.898 +		Ratio r = (Ratio) x;
 280.899 +		return new Ratio(r.numerator.negate(), r.denominator);
 280.900 +	}
 280.901 +
 280.902 +	public Number inc(Number x){
 280.903 +		return Numbers.add(x, 1);
 280.904 +	}
 280.905 +
 280.906 +	public Number dec(Number x){
 280.907 +		return Numbers.add(x, -1);
 280.908 +	}
 280.909 +
 280.910 +}
 280.911 +
 280.912 +final static class BigIntegerOps implements Ops{
 280.913 +	public Ops combine(Ops y){
 280.914 +		return y.opsWith(this);
 280.915 +	}
 280.916 +
 280.917 +	final public Ops opsWith(IntegerOps x){
 280.918 +		return this;
 280.919 +	}
 280.920 +
 280.921 +	final public Ops opsWith(LongOps x){
 280.922 +		return this;
 280.923 +	}
 280.924 +
 280.925 +	final public Ops opsWith(FloatOps x){
 280.926 +		return FLOAT_OPS;
 280.927 +	}
 280.928 +
 280.929 +	final public Ops opsWith(DoubleOps x){
 280.930 +		return DOUBLE_OPS;
 280.931 +	}
 280.932 +
 280.933 +	final public Ops opsWith(RatioOps x){
 280.934 +		return RATIO_OPS;
 280.935 +	}
 280.936 +
 280.937 +	final public Ops opsWith(BigIntegerOps x){
 280.938 +		return this;
 280.939 +	}
 280.940 +
 280.941 +	final public Ops opsWith(BigDecimalOps x){
 280.942 +		return BIGDECIMAL_OPS;
 280.943 +	}
 280.944 +
 280.945 +	public boolean isZero(Number x){
 280.946 +		BigInteger bx = toBigInteger(x);
 280.947 +		return bx.signum() == 0;
 280.948 +	}
 280.949 +
 280.950 +	public boolean isPos(Number x){
 280.951 +		BigInteger bx = toBigInteger(x);
 280.952 +		return bx.signum() > 0;
 280.953 +	}
 280.954 +
 280.955 +	public boolean isNeg(Number x){
 280.956 +		BigInteger bx = toBigInteger(x);
 280.957 +		return bx.signum() < 0;
 280.958 +	}
 280.959 +
 280.960 +	final public Number add(Number x, Number y){
 280.961 +		return reduce(toBigInteger(x).add(toBigInteger(y)));
 280.962 +	}
 280.963 +
 280.964 +	final public Number multiply(Number x, Number y){
 280.965 +		return reduce(toBigInteger(x).multiply(toBigInteger(y)));
 280.966 +	}
 280.967 +
 280.968 +	public Number divide(Number x, Number y){
 280.969 +		return Numbers.divide(toBigInteger(x), toBigInteger(y));
 280.970 +	}
 280.971 +
 280.972 +	public Number quotient(Number x, Number y){
 280.973 +		return toBigInteger(x).divide(toBigInteger(y));
 280.974 +	}
 280.975 +
 280.976 +	public Number remainder(Number x, Number y){
 280.977 +		return toBigInteger(x).remainder(toBigInteger(y));
 280.978 +	}
 280.979 +
 280.980 +	public boolean equiv(Number x, Number y){
 280.981 +		return toBigInteger(x).equals(toBigInteger(y));
 280.982 +	}
 280.983 +
 280.984 +	public boolean lt(Number x, Number y){
 280.985 +		return toBigInteger(x).compareTo(toBigInteger(y)) < 0;
 280.986 +	}
 280.987 +
 280.988 +	//public Number subtract(Number x, Number y);
 280.989 +	final public Number negate(Number x){
 280.990 +		return toBigInteger(x).negate();
 280.991 +	}
 280.992 +
 280.993 +	public Number inc(Number x){
 280.994 +		BigInteger bx = toBigInteger(x);
 280.995 +		return reduce(bx.add(BigInteger.ONE));
 280.996 +	}
 280.997 +
 280.998 +	public Number dec(Number x){
 280.999 +		BigInteger bx = toBigInteger(x);
280.1000 +		return reduce(bx.subtract(BigInteger.ONE));
280.1001 +	}
280.1002 +}
280.1003 +
280.1004 +final static class BigDecimalOps implements Ops{
280.1005 +	final static Var MATH_CONTEXT = RT.MATH_CONTEXT;
280.1006 +
280.1007 +	public Ops combine(Ops y){
280.1008 +		return y.opsWith(this);
280.1009 +	}
280.1010 +
280.1011 +	final public Ops opsWith(IntegerOps x){
280.1012 +		return this;
280.1013 +	}
280.1014 +
280.1015 +	final public Ops opsWith(LongOps x){
280.1016 +		return this;
280.1017 +	}
280.1018 +
280.1019 +	final public Ops opsWith(FloatOps x){
280.1020 +		return FLOAT_OPS;
280.1021 +	}
280.1022 +
280.1023 +	final public Ops opsWith(DoubleOps x){
280.1024 +		return DOUBLE_OPS;
280.1025 +	}
280.1026 +
280.1027 +	final public Ops opsWith(RatioOps x){
280.1028 +		return RATIO_OPS;
280.1029 +	}
280.1030 +
280.1031 +	final public Ops opsWith(BigIntegerOps x){
280.1032 +		return this;
280.1033 +	}
280.1034 +
280.1035 +	final public Ops opsWith(BigDecimalOps x){
280.1036 +		return this;
280.1037 +	}
280.1038 +
280.1039 +	public boolean isZero(Number x){
280.1040 +		BigDecimal bx = (BigDecimal) x;
280.1041 +		return bx.signum() == 0;
280.1042 +	}
280.1043 +
280.1044 +	public boolean isPos(Number x){
280.1045 +		BigDecimal bx = (BigDecimal) x;
280.1046 +		return bx.signum() > 0;
280.1047 +	}
280.1048 +
280.1049 +	public boolean isNeg(Number x){
280.1050 +		BigDecimal bx = (BigDecimal) x;
280.1051 +		return bx.signum() < 0;
280.1052 +	}
280.1053 +
280.1054 +	final public Number add(Number x, Number y){
280.1055 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1056 +		return mc == null
280.1057 +		       ? toBigDecimal(x).add(toBigDecimal(y))
280.1058 +		       : toBigDecimal(x).add(toBigDecimal(y), mc);
280.1059 +	}
280.1060 +
280.1061 +	final public Number multiply(Number x, Number y){
280.1062 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1063 +		return mc == null
280.1064 +		       ? toBigDecimal(x).multiply(toBigDecimal(y))
280.1065 +		       : toBigDecimal(x).multiply(toBigDecimal(y), mc);
280.1066 +	}
280.1067 +
280.1068 +	public Number divide(Number x, Number y){
280.1069 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1070 +		return mc == null
280.1071 +		       ? toBigDecimal(x).divide(toBigDecimal(y))
280.1072 +		       : toBigDecimal(x).divide(toBigDecimal(y), mc);
280.1073 +	}
280.1074 +
280.1075 +	public Number quotient(Number x, Number y){
280.1076 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1077 +		return mc == null
280.1078 +		       ? toBigDecimal(x).divideToIntegralValue(toBigDecimal(y))
280.1079 +		       : toBigDecimal(x).divideToIntegralValue(toBigDecimal(y), mc);
280.1080 +	}
280.1081 +
280.1082 +	public Number remainder(Number x, Number y){
280.1083 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1084 +		return mc == null
280.1085 +		       ? toBigDecimal(x).remainder(toBigDecimal(y))
280.1086 +		       : toBigDecimal(x).remainder(toBigDecimal(y), mc);
280.1087 +	}
280.1088 +
280.1089 +	public boolean equiv(Number x, Number y){
280.1090 +		return toBigDecimal(x).equals(toBigDecimal(y));
280.1091 +	}
280.1092 +
280.1093 +	public boolean lt(Number x, Number y){
280.1094 +		return toBigDecimal(x).compareTo(toBigDecimal(y)) < 0;
280.1095 +	}
280.1096 +
280.1097 +	//public Number subtract(Number x, Number y);
280.1098 +	final public Number negate(Number x){
280.1099 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1100 +		return mc == null
280.1101 +		       ? ((BigDecimal) x).negate()
280.1102 +		       : ((BigDecimal) x).negate(mc);
280.1103 +	}
280.1104 +
280.1105 +	public Number inc(Number x){
280.1106 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1107 +		BigDecimal bx = (BigDecimal) x;
280.1108 +		return mc == null
280.1109 +		       ? bx.add(BigDecimal.ONE)
280.1110 +		       : bx.add(BigDecimal.ONE, mc);
280.1111 +	}
280.1112 +
280.1113 +	public Number dec(Number x){
280.1114 +		MathContext mc = (MathContext) MATH_CONTEXT.deref();
280.1115 +		BigDecimal bx = (BigDecimal) x;
280.1116 +		return mc == null
280.1117 +		       ? bx.subtract(BigDecimal.ONE)
280.1118 +		       : bx.subtract(BigDecimal.ONE, mc);
280.1119 +	}
280.1120 +}
280.1121 +
280.1122 +final static class IntegerBitOps implements BitOps{
280.1123 +	public BitOps combine(BitOps y){
280.1124 +		return y.bitOpsWith(this);
280.1125 +	}
280.1126 +
280.1127 +	final public BitOps bitOpsWith(IntegerBitOps x){
280.1128 +		return this;
280.1129 +	}
280.1130 +
280.1131 +	final public BitOps bitOpsWith(LongBitOps x){
280.1132 +		return LONG_BITOPS;
280.1133 +	}
280.1134 +
280.1135 +	final public BitOps bitOpsWith(BigIntegerBitOps x){
280.1136 +		return BIGINTEGER_BITOPS;
280.1137 +	}
280.1138 +
280.1139 +
280.1140 +	public Number not(Number x){
280.1141 +		return ~x.intValue();
280.1142 +	}
280.1143 +
280.1144 +	public Number and(Number x, Number y){
280.1145 +		return x.intValue() & y.intValue();
280.1146 +	}
280.1147 +
280.1148 +	public Number or(Number x, Number y){
280.1149 +		return x.intValue() | y.intValue();
280.1150 +	}
280.1151 +
280.1152 +	public Number xor(Number x, Number y){
280.1153 +		return x.intValue() ^ y.intValue();
280.1154 +	}
280.1155 +
280.1156 +	public Number andNot(Number x, Number y){
280.1157 +		return x.intValue() & ~y.intValue();
280.1158 +	}
280.1159 +
280.1160 +	public Number clearBit(Number x, int n){
280.1161 +		if(n < 31)
280.1162 +			return x.intValue() & ~(1 << n);
280.1163 +		else if(n < 63)
280.1164 +			return x.longValue() & ~(1L << n);
280.1165 +		else
280.1166 +			return toBigInteger(x).clearBit(n);
280.1167 +	}
280.1168 +
280.1169 +	public Number setBit(Number x, int n){
280.1170 +		if(n < 31)
280.1171 +			return x.intValue() | (1 << n);
280.1172 +		else if(n < 63)
280.1173 +			return x.longValue() | (1L << n);
280.1174 +		else
280.1175 +			return toBigInteger(x).setBit(n);
280.1176 +	}
280.1177 +
280.1178 +	public Number flipBit(Number x, int n){
280.1179 +		if(n < 31)
280.1180 +			return x.intValue() ^ (1 << n);
280.1181 +		else if(n < 63)
280.1182 +			return x.longValue() ^ (1L << n);
280.1183 +		else
280.1184 +			return toBigInteger(x).flipBit(n);
280.1185 +	}
280.1186 +
280.1187 +	public boolean testBit(Number x, int n){
280.1188 +		if(n < 32)
280.1189 +			return (x.intValue() & (1 << n)) != 0;
280.1190 +		else if(n < 64)
280.1191 +			return (x.longValue() & (1L << n)) != 0;
280.1192 +		else
280.1193 +			return toBigInteger(x).testBit(n);
280.1194 +	}
280.1195 +
280.1196 +	public Number shiftLeft(Number x, int n){
280.1197 +		if(n < 32)
280.1198 +			{
280.1199 +			if(n < 0)
280.1200 +				return shiftRight(x, -n);
280.1201 +			return reduce(x.longValue() << n);
280.1202 +			}
280.1203 +		else
280.1204 +			return reduce(toBigInteger(x).shiftLeft(n));
280.1205 +	}
280.1206 +
280.1207 +	public Number shiftRight(Number x, int n){
280.1208 +		if(n < 0)
280.1209 +			return shiftLeft(x, -n);
280.1210 +		return x.intValue() >> n;
280.1211 +	}
280.1212 +}
280.1213 +
280.1214 +final static class LongBitOps implements BitOps{
280.1215 +	public BitOps combine(BitOps y){
280.1216 +		return y.bitOpsWith(this);
280.1217 +	}
280.1218 +
280.1219 +	final public BitOps bitOpsWith(IntegerBitOps x){
280.1220 +		return this;
280.1221 +	}
280.1222 +
280.1223 +	final public BitOps bitOpsWith(LongBitOps x){
280.1224 +		return this;
280.1225 +	}
280.1226 +
280.1227 +	final public BitOps bitOpsWith(BigIntegerBitOps x){
280.1228 +		return BIGINTEGER_BITOPS;
280.1229 +	}
280.1230 +
280.1231 +	public Number not(Number x){
280.1232 +		return ~x.longValue();
280.1233 +	}
280.1234 +
280.1235 +	public Number and(Number x, Number y){
280.1236 +		return x.longValue() & y.longValue();
280.1237 +	}
280.1238 +
280.1239 +	public Number or(Number x, Number y){
280.1240 +		return x.longValue() | y.longValue();
280.1241 +	}
280.1242 +
280.1243 +	public Number xor(Number x, Number y){
280.1244 +		return x.longValue() ^ y.longValue();
280.1245 +	}
280.1246 +
280.1247 +	public Number andNot(Number x, Number y){
280.1248 +		return x.longValue() & ~y.longValue();
280.1249 +	}
280.1250 +
280.1251 +	public Number clearBit(Number x, int n){
280.1252 +		if(n < 63)
280.1253 +			return x.longValue() & ~(1L << n);
280.1254 +		else
280.1255 +			return toBigInteger(x).clearBit(n);
280.1256 +	}
280.1257 +
280.1258 +	public Number setBit(Number x, int n){
280.1259 +		if(n < 63)
280.1260 +			return x.longValue() | (1L << n);
280.1261 +		else
280.1262 +			return toBigInteger(x).setBit(n);
280.1263 +	}
280.1264 +
280.1265 +	public Number flipBit(Number x, int n){
280.1266 +		if(n < 63)
280.1267 +			return x.longValue() ^ (1L << n);
280.1268 +		else
280.1269 +			return toBigInteger(x).flipBit(n);
280.1270 +	}
280.1271 +
280.1272 +	public boolean testBit(Number x, int n){
280.1273 +		if(n < 64)
280.1274 +			return (x.longValue() & (1L << n)) != 0;
280.1275 +		else
280.1276 +			return toBigInteger(x).testBit(n);
280.1277 +	}
280.1278 +
280.1279 +	public Number shiftLeft(Number x, int n){
280.1280 +		if(n < 0)
280.1281 +			return shiftRight(x, -n);
280.1282 +		return reduce(toBigInteger(x).shiftLeft(n));
280.1283 +	}
280.1284 +
280.1285 +	public Number shiftRight(Number x, int n){
280.1286 +		if(n < 0)
280.1287 +			return shiftLeft(x, -n);
280.1288 +		return x.longValue() >> n;
280.1289 +	}
280.1290 +}
280.1291 +
280.1292 +final static class BigIntegerBitOps implements BitOps{
280.1293 +	public BitOps combine(BitOps y){
280.1294 +		return y.bitOpsWith(this);
280.1295 +	}
280.1296 +
280.1297 +	final public BitOps bitOpsWith(IntegerBitOps x){
280.1298 +		return this;
280.1299 +	}
280.1300 +
280.1301 +	final public BitOps bitOpsWith(LongBitOps x){
280.1302 +		return this;
280.1303 +	}
280.1304 +
280.1305 +	final public BitOps bitOpsWith(BigIntegerBitOps x){
280.1306 +		return this;
280.1307 +	}
280.1308 +
280.1309 +	public Number not(Number x){
280.1310 +		return toBigInteger(x).not();
280.1311 +	}
280.1312 +
280.1313 +	public Number and(Number x, Number y){
280.1314 +		return toBigInteger(x).and(toBigInteger(y));
280.1315 +	}
280.1316 +
280.1317 +	public Number or(Number x, Number y){
280.1318 +		return toBigInteger(x).or(toBigInteger(y));
280.1319 +	}
280.1320 +
280.1321 +	public Number xor(Number x, Number y){
280.1322 +		return toBigInteger(x).xor(toBigInteger(y));
280.1323 +	}
280.1324 +
280.1325 +	public Number andNot(Number x, Number y){
280.1326 +		return toBigInteger(x).andNot(toBigInteger(y));
280.1327 +	}
280.1328 +
280.1329 +	public Number clearBit(Number x, int n){
280.1330 +		return toBigInteger(x).clearBit(n);
280.1331 +	}
280.1332 +
280.1333 +	public Number setBit(Number x, int n){
280.1334 +		return toBigInteger(x).setBit(n);
280.1335 +	}
280.1336 +
280.1337 +	public Number flipBit(Number x, int n){
280.1338 +		return toBigInteger(x).flipBit(n);
280.1339 +	}
280.1340 +
280.1341 +	public boolean testBit(Number x, int n){
280.1342 +		return toBigInteger(x).testBit(n);
280.1343 +	}
280.1344 +
280.1345 +	public Number shiftLeft(Number x, int n){
280.1346 +		return toBigInteger(x).shiftLeft(n);
280.1347 +	}
280.1348 +
280.1349 +	public Number shiftRight(Number x, int n){
280.1350 +		return toBigInteger(x).shiftRight(n);
280.1351 +	}
280.1352 +}
280.1353 +
280.1354 +static final IntegerOps INTEGER_OPS = new IntegerOps();
280.1355 +static final LongOps LONG_OPS = new LongOps();
280.1356 +static final FloatOps FLOAT_OPS = new FloatOps();
280.1357 +static final DoubleOps DOUBLE_OPS = new DoubleOps();
280.1358 +static final RatioOps RATIO_OPS = new RatioOps();
280.1359 +static final BigIntegerOps BIGINTEGER_OPS = new BigIntegerOps();
280.1360 +static final BigDecimalOps BIGDECIMAL_OPS = new BigDecimalOps();
280.1361 +
280.1362 +static final IntegerBitOps INTEGER_BITOPS = new IntegerBitOps();
280.1363 +static final LongBitOps LONG_BITOPS = new LongBitOps();
280.1364 +static final BigIntegerBitOps BIGINTEGER_BITOPS = new BigIntegerBitOps();
280.1365 +
280.1366 +static Ops ops(Object x){
280.1367 +	Class xc = x.getClass();
280.1368 +
280.1369 +	if(xc == Integer.class)
280.1370 +		return INTEGER_OPS;
280.1371 +	else if(xc == Double.class)
280.1372 +		return DOUBLE_OPS;
280.1373 +	else if(xc == Float.class)
280.1374 +		return FLOAT_OPS;
280.1375 +	else if(xc == BigInteger.class)
280.1376 +		return BIGINTEGER_OPS;
280.1377 +	else if(xc == Long.class)
280.1378 +		return LONG_OPS;
280.1379 +	else if(xc == Ratio.class)
280.1380 +		return RATIO_OPS;
280.1381 +	else if(xc == BigDecimal.class)
280.1382 +		return BIGDECIMAL_OPS;
280.1383 +	else
280.1384 +		return INTEGER_OPS;
280.1385 +}
280.1386 +
280.1387 +static BitOps bitOps(Object x){
280.1388 +	Class xc = x.getClass();
280.1389 +
280.1390 +	if(xc == Integer.class)
280.1391 +		return INTEGER_BITOPS;
280.1392 +	else if(xc == Long.class)
280.1393 +		return LONG_BITOPS;
280.1394 +	else if(xc == BigInteger.class)
280.1395 +		return BIGINTEGER_BITOPS;
280.1396 +	else if(xc == Double.class || xc == Float.class || xc == BigDecimalOps.class || xc == Ratio.class)
280.1397 +		throw new ArithmeticException("bit operation on non integer type: " + xc);
280.1398 +	else
280.1399 +		return INTEGER_BITOPS;
280.1400 +}
280.1401 +
280.1402 +//final static ExecutorService executor = Executors.newCachedThreadPool();
280.1403 +//static public int minChunk = 100;
280.1404 +//static int chunkSize(int alength){
280.1405 +//	return Math.max(alength / Runtime.getRuntime().availableProcessors(), minChunk);
280.1406 +//}
280.1407 +
280.1408 +//		}
280.1409 +//	else
280.1410 +//		{
280.1411 +//		LinkedList<Callable<Float>> ops = new LinkedList<Callable<Float>>();
280.1412 +//		for(int offset = 0;offset < xs.length;offset+=chunk)
280.1413 +//			{
280.1414 +//			final int start = offset;
280.1415 +//			final int end = Math.min(xs.length, start + chunk);
280.1416 +//			ops.add(new Callable<Float>(){
280.1417 +//				public Float call() throws Exception{
280.1418 +//					for(int i=start;i<end;i++)
280.1419 +//						xs[i] += ys[i];
280.1420 +//					return null;
280.1421 +//				}});
280.1422 +//			}
280.1423 +//		executor.invokeAll(ops);
280.1424 +//		}
280.1425 +
280.1426 +
280.1427 +	static public float[] float_array(int size, Object init){
280.1428 +		float[] ret = new float[size];
280.1429 +		if(init instanceof Number)
280.1430 +			{
280.1431 +			float f = ((Number) init).floatValue();
280.1432 +			for(int i = 0; i < ret.length; i++)
280.1433 +				ret[i] = f;
280.1434 +			}
280.1435 +		else
280.1436 +			{
280.1437 +			ISeq s = RT.seq(init);
280.1438 +			for(int i = 0; i < size && s != null; i++, s = s.next())
280.1439 +				ret[i] = ((Number) s.first()).floatValue();
280.1440 +			}
280.1441 +		return ret;
280.1442 +	}
280.1443 +
280.1444 +	static public float[] float_array(Object sizeOrSeq){
280.1445 +		if(sizeOrSeq instanceof Number)
280.1446 +			return new float[((Number) sizeOrSeq).intValue()];
280.1447 +		else
280.1448 +			{
280.1449 +			ISeq s = RT.seq(sizeOrSeq);
280.1450 +			int size = RT.count(s);
280.1451 +			float[] ret = new float[size];
280.1452 +			for(int i = 0; i < size && s != null; i++, s = s.next())
280.1453 +				ret[i] = ((Number) s.first()).floatValue();
280.1454 +			return ret;
280.1455 +			}
280.1456 +	}
280.1457 +
280.1458 +static public double[] double_array(int size, Object init){
280.1459 +	double[] ret = new double[size];
280.1460 +	if(init instanceof Number)
280.1461 +		{
280.1462 +		double f = ((Number) init).doubleValue();
280.1463 +		for(int i = 0; i < ret.length; i++)
280.1464 +			ret[i] = f;
280.1465 +		}
280.1466 +	else
280.1467 +		{
280.1468 +		ISeq s = RT.seq(init);
280.1469 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1470 +			ret[i] = ((Number) s.first()).doubleValue();
280.1471 +		}
280.1472 +	return ret;
280.1473 +}
280.1474 +
280.1475 +static public double[] double_array(Object sizeOrSeq){
280.1476 +	if(sizeOrSeq instanceof Number)
280.1477 +		return new double[((Number) sizeOrSeq).intValue()];
280.1478 +	else
280.1479 +		{
280.1480 +		ISeq s = RT.seq(sizeOrSeq);
280.1481 +		int size = RT.count(s);
280.1482 +		double[] ret = new double[size];
280.1483 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1484 +			ret[i] = ((Number) s.first()).doubleValue();
280.1485 +		return ret;
280.1486 +		}
280.1487 +}
280.1488 +
280.1489 +static public int[] int_array(int size, Object init){
280.1490 +	int[] ret = new int[size];
280.1491 +	if(init instanceof Number)
280.1492 +		{
280.1493 +		int f = ((Number) init).intValue();
280.1494 +		for(int i = 0; i < ret.length; i++)
280.1495 +			ret[i] = f;
280.1496 +		}
280.1497 +	else
280.1498 +		{
280.1499 +		ISeq s = RT.seq(init);
280.1500 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1501 +			ret[i] = ((Number) s.first()).intValue();
280.1502 +		}
280.1503 +	return ret;
280.1504 +}
280.1505 +
280.1506 +static public int[] int_array(Object sizeOrSeq){
280.1507 +	if(sizeOrSeq instanceof Number)
280.1508 +		return new int[((Number) sizeOrSeq).intValue()];
280.1509 +	else
280.1510 +		{
280.1511 +		ISeq s = RT.seq(sizeOrSeq);
280.1512 +		int size = RT.count(s);
280.1513 +		int[] ret = new int[size];
280.1514 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1515 +			ret[i] = ((Number) s.first()).intValue();
280.1516 +		return ret;
280.1517 +		}
280.1518 +}
280.1519 +
280.1520 +static public long[] long_array(int size, Object init){
280.1521 +	long[] ret = new long[size];
280.1522 +	if(init instanceof Number)
280.1523 +		{
280.1524 +		long f = ((Number) init).longValue();
280.1525 +		for(int i = 0; i < ret.length; i++)
280.1526 +			ret[i] = f;
280.1527 +		}
280.1528 +	else
280.1529 +		{
280.1530 +		ISeq s = RT.seq(init);
280.1531 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1532 +			ret[i] = ((Number) s.first()).longValue();
280.1533 +		}
280.1534 +	return ret;
280.1535 +}
280.1536 +
280.1537 +static public long[] long_array(Object sizeOrSeq){
280.1538 +	if(sizeOrSeq instanceof Number)
280.1539 +		return new long[((Number) sizeOrSeq).intValue()];
280.1540 +	else
280.1541 +		{
280.1542 +		ISeq s = RT.seq(sizeOrSeq);
280.1543 +		int size = RT.count(s);
280.1544 +		long[] ret = new long[size];
280.1545 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1546 +			ret[i] = ((Number) s.first()).longValue();
280.1547 +		return ret;
280.1548 +		}
280.1549 +}
280.1550 +
280.1551 +static public short[] short_array(int size, Object init){
280.1552 +	short[] ret = new short[size];
280.1553 +	if(init instanceof Short)
280.1554 +		{
280.1555 +		short s = (Short) init;
280.1556 +		for(int i = 0; i < ret.length; i++)
280.1557 +			ret[i] = s;
280.1558 +		}
280.1559 +	else
280.1560 +		{
280.1561 +		ISeq s = RT.seq(init);
280.1562 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1563 +			ret[i] = (Short) s.first();
280.1564 +		}
280.1565 +	return ret;
280.1566 +}
280.1567 +
280.1568 +static public short[] short_array(Object sizeOrSeq){
280.1569 +	if(sizeOrSeq instanceof Number)
280.1570 +		return new short[((Number) sizeOrSeq).intValue()];
280.1571 +	else
280.1572 +		{
280.1573 +		ISeq s = RT.seq(sizeOrSeq);
280.1574 +		int size = RT.count(s);
280.1575 +		short[] ret = new short[size];
280.1576 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1577 +			ret[i] = (Short) s.first();
280.1578 +		return ret;
280.1579 +		}
280.1580 +}
280.1581 +
280.1582 +static public char[] char_array(int size, Object init){
280.1583 +	char[] ret = new char[size];
280.1584 +	if(init instanceof Character)
280.1585 +		{
280.1586 +		char c = (Character) init;
280.1587 +		for(int i = 0; i < ret.length; i++)
280.1588 +			ret[i] = c;
280.1589 +		}
280.1590 +	else
280.1591 +		{
280.1592 +		ISeq s = RT.seq(init);
280.1593 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1594 +			ret[i] = (Character) s.first();
280.1595 +		}
280.1596 +	return ret;
280.1597 +}
280.1598 +
280.1599 +static public char[] char_array(Object sizeOrSeq){
280.1600 +	if(sizeOrSeq instanceof Number)
280.1601 +		return new char[((Number) sizeOrSeq).intValue()];
280.1602 +	else
280.1603 +		{
280.1604 +		ISeq s = RT.seq(sizeOrSeq);
280.1605 +		int size = RT.count(s);
280.1606 +		char[] ret = new char[size];
280.1607 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1608 +			ret[i] = (Character) s.first();
280.1609 +		return ret;
280.1610 +		}
280.1611 +}
280.1612 +
280.1613 +static public byte[] byte_array(int size, Object init){
280.1614 +	byte[] ret = new byte[size];
280.1615 +	if(init instanceof Byte)
280.1616 +		{
280.1617 +		byte b = (Byte) init;
280.1618 +		for(int i = 0; i < ret.length; i++)
280.1619 +			ret[i] = b;
280.1620 +		}
280.1621 +	else
280.1622 +		{
280.1623 +		ISeq s = RT.seq(init);
280.1624 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1625 +			ret[i] = (Byte) s.first();
280.1626 +		}
280.1627 +	return ret;
280.1628 +}
280.1629 +
280.1630 +static public byte[] byte_array(Object sizeOrSeq){
280.1631 +	if(sizeOrSeq instanceof Number)
280.1632 +		return new byte[((Number) sizeOrSeq).intValue()];
280.1633 +	else
280.1634 +		{
280.1635 +		ISeq s = RT.seq(sizeOrSeq);
280.1636 +		int size = RT.count(s);
280.1637 +		byte[] ret = new byte[size];
280.1638 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1639 +			ret[i] = (Byte)s.first();
280.1640 +		return ret;
280.1641 +		}
280.1642 +}
280.1643 +
280.1644 +static public boolean[] boolean_array(int size, Object init){
280.1645 +	boolean[] ret = new boolean[size];
280.1646 +	if(init instanceof Boolean)
280.1647 +		{
280.1648 +		boolean b = (Boolean) init;
280.1649 +		for(int i = 0; i < ret.length; i++)
280.1650 +			ret[i] = b;
280.1651 +		}
280.1652 +	else
280.1653 +		{
280.1654 +		ISeq s = RT.seq(init);
280.1655 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1656 +			ret[i] = (Boolean)s.first();
280.1657 +		}
280.1658 +	return ret;
280.1659 +}
280.1660 +
280.1661 +static public boolean[] boolean_array(Object sizeOrSeq){
280.1662 +	if(sizeOrSeq instanceof Number)
280.1663 +		return new boolean[((Number) sizeOrSeq).intValue()];
280.1664 +	else
280.1665 +		{
280.1666 +		ISeq s = RT.seq(sizeOrSeq);
280.1667 +		int size = RT.count(s);
280.1668 +		boolean[] ret = new boolean[size];
280.1669 +		for(int i = 0; i < size && s != null; i++, s = s.next())
280.1670 +			ret[i] = (Boolean)s.first();
280.1671 +		return ret;
280.1672 +		}
280.1673 +}
280.1674 +
280.1675 +static public boolean[] booleans(Object array){
280.1676 +	return (boolean[]) array;
280.1677 +}
280.1678 +
280.1679 +static public byte[] bytes(Object array){
280.1680 +	return (byte[]) array;
280.1681 +}
280.1682 +
280.1683 +static public char[] chars(Object array){
280.1684 +	return (char[]) array;
280.1685 +}
280.1686 +
280.1687 +static public short[] shorts(Object array){
280.1688 +	return (short[]) array;
280.1689 +}
280.1690 +
280.1691 +static public float[] floats(Object array){
280.1692 +	return (float[]) array;
280.1693 +}
280.1694 +
280.1695 +static public double[] doubles(Object array){
280.1696 +	return (double[]) array;
280.1697 +}
280.1698 +
280.1699 +static public int[] ints(Object array){
280.1700 +	return (int[]) array;
280.1701 +}
280.1702 +
280.1703 +static public long[] longs(Object array){
280.1704 +	return (long[]) array;
280.1705 +}
280.1706 +
280.1707 +static public Number num(Object x){
280.1708 +	return (Number) x;
280.1709 +}
280.1710 +
280.1711 +static public Number num(float x){
280.1712 +	return x;
280.1713 +}
280.1714 +
280.1715 +static public float add(float x, float y){
280.1716 +	return x + y;
280.1717 +}
280.1718 +
280.1719 +static public float minus(float x, float y){
280.1720 +	return x - y;
280.1721 +}
280.1722 +
280.1723 +static public float minus(float x){
280.1724 +	return -x;
280.1725 +}
280.1726 +
280.1727 +static public float inc(float x){
280.1728 +	return x + 1;
280.1729 +}
280.1730 +
280.1731 +static public float dec(float x){
280.1732 +	return x - 1;
280.1733 +}
280.1734 +
280.1735 +static public float multiply(float x, float y){
280.1736 +	return x * y;
280.1737 +}
280.1738 +
280.1739 +static public float divide(float x, float y){
280.1740 +	return x / y;
280.1741 +}
280.1742 +
280.1743 +static public boolean equiv(float x, float y){
280.1744 +	return x == y;
280.1745 +}
280.1746 +
280.1747 +static public boolean lt(float x, float y){
280.1748 +	return x < y;
280.1749 +}
280.1750 +
280.1751 +static public boolean lte(float x, float y){
280.1752 +	return x <= y;
280.1753 +}
280.1754 +
280.1755 +static public boolean gt(float x, float y){
280.1756 +	return x > y;
280.1757 +}
280.1758 +
280.1759 +static public boolean gte(float x, float y){
280.1760 +	return x >= y;
280.1761 +}
280.1762 +
280.1763 +static public boolean isPos(float x){
280.1764 +	return x > 0;
280.1765 +}
280.1766 +
280.1767 +static public boolean isNeg(float x){
280.1768 +	return x < 0;
280.1769 +}
280.1770 +
280.1771 +static public boolean isZero(float x){
280.1772 +	return x == 0;
280.1773 +}
280.1774 +
280.1775 +static public Number num(double x){
280.1776 +	return x;
280.1777 +}
280.1778 +
280.1779 +static public double add(double x, double y){
280.1780 +	return x + y;
280.1781 +}
280.1782 +
280.1783 +static public double minus(double x, double y){
280.1784 +	return x - y;
280.1785 +}
280.1786 +
280.1787 +static public double minus(double x){
280.1788 +	return -x;
280.1789 +}
280.1790 +
280.1791 +static public double inc(double x){
280.1792 +	return x + 1;
280.1793 +}
280.1794 +
280.1795 +static public double dec(double x){
280.1796 +	return x - 1;
280.1797 +}
280.1798 +
280.1799 +static public double multiply(double x, double y){
280.1800 +	return x * y;
280.1801 +}
280.1802 +
280.1803 +static public double divide(double x, double y){
280.1804 +	return x / y;
280.1805 +}
280.1806 +
280.1807 +static public boolean equiv(double x, double y){
280.1808 +	return x == y;
280.1809 +}
280.1810 +
280.1811 +static public boolean lt(double x, double y){
280.1812 +	return x < y;
280.1813 +}
280.1814 +
280.1815 +static public boolean lte(double x, double y){
280.1816 +	return x <= y;
280.1817 +}
280.1818 +
280.1819 +static public boolean gt(double x, double y){
280.1820 +	return x > y;
280.1821 +}
280.1822 +
280.1823 +static public boolean gte(double x, double y){
280.1824 +	return x >= y;
280.1825 +}
280.1826 +
280.1827 +static public boolean isPos(double x){
280.1828 +	return x > 0;
280.1829 +}
280.1830 +
280.1831 +static public boolean isNeg(double x){
280.1832 +	return x < 0;
280.1833 +}
280.1834 +
280.1835 +static public boolean isZero(double x){
280.1836 +	return x == 0;
280.1837 +}
280.1838 +
280.1839 +static int throwIntOverflow(){
280.1840 +	throw new ArithmeticException("integer overflow");
280.1841 +}
280.1842 +
280.1843 +static public Number num(int x){
280.1844 +	return x;
280.1845 +}
280.1846 +
280.1847 +static public int unchecked_add(int x, int y){
280.1848 +	return x + y;
280.1849 +}
280.1850 +
280.1851 +static public int unchecked_subtract(int x, int y){
280.1852 +	return x - y;
280.1853 +}
280.1854 +
280.1855 +static public int unchecked_negate(int x){
280.1856 +	return -x;
280.1857 +}
280.1858 +
280.1859 +static public int unchecked_inc(int x){
280.1860 +	return x + 1;
280.1861 +}
280.1862 +
280.1863 +static public int unchecked_dec(int x){
280.1864 +	return x - 1;
280.1865 +}
280.1866 +
280.1867 +static public int unchecked_multiply(int x, int y){
280.1868 +	return x * y;
280.1869 +}
280.1870 +
280.1871 +static public int add(int x, int y){
280.1872 +	int ret = x + y;
280.1873 +	if ((ret ^ x) < 0 && (ret ^ y) < 0)
280.1874 +		return throwIntOverflow();
280.1875 +	return ret;
280.1876 +}
280.1877 +
280.1878 +static public int not(int x){
280.1879 +	return ~x;
280.1880 +}
280.1881 +
280.1882 +static public int and(int x, int y){
280.1883 +	return x & y;
280.1884 +}
280.1885 +
280.1886 +static public int or(int x, int y){
280.1887 +	return x | y;
280.1888 +}
280.1889 +
280.1890 +static public int xor(int x, int y){
280.1891 +	return x ^ y;
280.1892 +}
280.1893 +
280.1894 +static public int minus(int x, int y){
280.1895 +	int ret = x - y;
280.1896 +	if (((ret ^ x) < 0 && (ret ^ ~y) < 0))
280.1897 +		return throwIntOverflow();
280.1898 +	return ret;
280.1899 +}
280.1900 +
280.1901 +static public int minus(int x){
280.1902 +	if(x == Integer.MIN_VALUE)
280.1903 +		return throwIntOverflow();
280.1904 +	return -x;
280.1905 +}
280.1906 +
280.1907 +static public int inc(int x){
280.1908 +	if(x == Integer.MAX_VALUE)
280.1909 +		return throwIntOverflow();
280.1910 +	return x + 1;
280.1911 +}
280.1912 +
280.1913 +static public int dec(int x){
280.1914 +	if(x == Integer.MIN_VALUE)
280.1915 +		return throwIntOverflow();
280.1916 +	return x - 1;
280.1917 +}
280.1918 +
280.1919 +static public int multiply(int x, int y){
280.1920 +	int ret = x * y;
280.1921 +	if (y != 0 && ret/y != x)
280.1922 +		return throwIntOverflow();
280.1923 +	return ret;
280.1924 +}
280.1925 +
280.1926 +static public int unchecked_divide(int x, int y){
280.1927 +	return x / y;
280.1928 +}
280.1929 +
280.1930 +static public int unchecked_remainder(int x, int y){
280.1931 +	return x % y;
280.1932 +}
280.1933 +
280.1934 +static public boolean equiv(int x, int y){
280.1935 +	return x == y;
280.1936 +}
280.1937 +
280.1938 +static public boolean lt(int x, int y){
280.1939 +	return x < y;
280.1940 +}
280.1941 +
280.1942 +static public boolean lte(int x, int y){
280.1943 +	return x <= y;
280.1944 +}
280.1945 +
280.1946 +static public boolean gt(int x, int y){
280.1947 +	return x > y;
280.1948 +}
280.1949 +
280.1950 +static public boolean gte(int x, int y){
280.1951 +	return x >= y;
280.1952 +}
280.1953 +
280.1954 +static public boolean isPos(int x){
280.1955 +	return x > 0;
280.1956 +}
280.1957 +
280.1958 +static public boolean isNeg(int x){
280.1959 +	return x < 0;
280.1960 +}
280.1961 +
280.1962 +static public boolean isZero(int x){
280.1963 +	return x == 0;
280.1964 +}
280.1965 +
280.1966 +static public Number num(long x){
280.1967 +	return x;
280.1968 +}
280.1969 +
280.1970 +static public long unchecked_add(long x, long y){
280.1971 +	return x + y;
280.1972 +}
280.1973 +
280.1974 +static public long unchecked_subtract(long x, long y){
280.1975 +	return x - y;
280.1976 +}
280.1977 +
280.1978 +static public long unchecked_negate(long x){
280.1979 +	return -x;
280.1980 +}
280.1981 +
280.1982 +static public long unchecked_inc(long x){
280.1983 +	return x + 1;
280.1984 +}
280.1985 +
280.1986 +static public long unchecked_dec(long x){
280.1987 +	return x - 1;
280.1988 +}
280.1989 +
280.1990 +static public long unchecked_multiply(long x, long y){
280.1991 +	return x * y;
280.1992 +}
280.1993 +
280.1994 +static public long add(long x, long y){
280.1995 +	long ret = x + y;
280.1996 +	if ((ret ^ x) < 0 && (ret ^ y) < 0)
280.1997 +		return throwIntOverflow();
280.1998 +	return ret;
280.1999 +}
280.2000 +
280.2001 +static public long minus(long x, long y){
280.2002 +	long ret = x - y;
280.2003 +	if (((ret ^ x) < 0 && (ret ^ ~y) < 0))
280.2004 +		return throwIntOverflow();
280.2005 +	return ret;
280.2006 +}
280.2007 +
280.2008 +static public long minus(long x){
280.2009 +	if(x == Long.MIN_VALUE)
280.2010 +		return throwIntOverflow();
280.2011 +	return -x;
280.2012 +}
280.2013 +
280.2014 +static public long inc(long x){
280.2015 +	if(x == Long.MAX_VALUE)
280.2016 +		return throwIntOverflow();
280.2017 +	return x + 1;
280.2018 +}
280.2019 +
280.2020 +static public long dec(long x){
280.2021 +	if(x == Long.MIN_VALUE)
280.2022 +		return throwIntOverflow();
280.2023 +	return x - 1;
280.2024 +}
280.2025 +
280.2026 +static public long multiply(long x, long y){
280.2027 +	long ret = x * y;
280.2028 +	if (y != 0 && ret/y != x)
280.2029 +		return throwIntOverflow();
280.2030 +	return ret;
280.2031 +}
280.2032 +
280.2033 +static public long unchecked_divide(long x, long y){
280.2034 +	return x / y;
280.2035 +}
280.2036 +
280.2037 +static public long unchecked_remainder(long x, long y){
280.2038 +	return x % y;
280.2039 +}
280.2040 +
280.2041 +static public boolean equiv(long x, long y){
280.2042 +	return x == y;
280.2043 +}
280.2044 +
280.2045 +static public boolean lt(long x, long y){
280.2046 +	return x < y;
280.2047 +}
280.2048 +
280.2049 +static public boolean lte(long x, long y){
280.2050 +	return x <= y;
280.2051 +}
280.2052 +
280.2053 +static public boolean gt(long x, long y){
280.2054 +	return x > y;
280.2055 +}
280.2056 +
280.2057 +static public boolean gte(long x, long y){
280.2058 +	return x >= y;
280.2059 +}
280.2060 +
280.2061 +static public boolean isPos(long x){
280.2062 +	return x > 0;
280.2063 +}
280.2064 +
280.2065 +static public boolean isNeg(long x){
280.2066 +	return x < 0;
280.2067 +}
280.2068 +
280.2069 +static public boolean isZero(long x){
280.2070 +	return x == 0;
280.2071 +}
280.2072 +
280.2073 +/*
280.2074 +static public class F{
280.2075 +	static public float add(float x, float y){
280.2076 +		return x + y;
280.2077 +	}
280.2078 +
280.2079 +	static public float subtract(float x, float y){
280.2080 +		return x - y;
280.2081 +	}
280.2082 +
280.2083 +	static public float negate(float x){
280.2084 +		return -x;
280.2085 +	}
280.2086 +
280.2087 +	static public float inc(float x){
280.2088 +		return x + 1;
280.2089 +	}
280.2090 +
280.2091 +	static public float dec(float x){
280.2092 +		return x - 1;
280.2093 +	}
280.2094 +
280.2095 +	static public float multiply(float x, float y){
280.2096 +		return x * y;
280.2097 +	}
280.2098 +
280.2099 +	static public float divide(float x, float y){
280.2100 +		return x / y;
280.2101 +	}
280.2102 +
280.2103 +	static public boolean equiv(float x, float y){
280.2104 +		return x == y;
280.2105 +	}
280.2106 +
280.2107 +	static public boolean lt(float x, float y){
280.2108 +		return x < y;
280.2109 +	}
280.2110 +
280.2111 +	static public boolean lte(float x, float y){
280.2112 +		return x <= y;
280.2113 +	}
280.2114 +
280.2115 +	static public boolean gt(float x, float y){
280.2116 +		return x > y;
280.2117 +	}
280.2118 +
280.2119 +	static public boolean gte(float x, float y){
280.2120 +		return x >= y;
280.2121 +	}
280.2122 +
280.2123 +	static public boolean pos(float x){
280.2124 +		return x > 0;
280.2125 +	}
280.2126 +
280.2127 +	static public boolean neg(float x){
280.2128 +		return x < 0;
280.2129 +	}
280.2130 +
280.2131 +	static public boolean zero(float x){
280.2132 +		return x == 0;
280.2133 +	}
280.2134 +
280.2135 +	static public float aget(float[] xs, int i){
280.2136 +		return xs[i];
280.2137 +	}
280.2138 +
280.2139 +	static public float aset(float[] xs, int i, float v){
280.2140 +		xs[i] = v;
280.2141 +		return v;
280.2142 +	}
280.2143 +
280.2144 +	static public int alength(float[] xs){
280.2145 +		return xs.length;
280.2146 +	}
280.2147 +
280.2148 +	static public float[] aclone(float[] xs){
280.2149 +		return xs.clone();
280.2150 +	}
280.2151 +
280.2152 +	static public float[] vec(int size, Object init){
280.2153 +		float[] ret = new float[size];
280.2154 +		if(init instanceof Number)
280.2155 +			{
280.2156 +			float f = ((Number) init).floatValue();
280.2157 +			for(int i = 0; i < ret.length; i++)
280.2158 +				ret[i] = f;
280.2159 +			}
280.2160 +		else
280.2161 +			{
280.2162 +			ISeq s = RT.seq(init);
280.2163 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.2164 +				ret[i] = ((Number) s.first()).floatValue();
280.2165 +			}
280.2166 +		return ret;
280.2167 +	}
280.2168 +
280.2169 +	static public float[] vec(Object sizeOrSeq){
280.2170 +		if(sizeOrSeq instanceof Number)
280.2171 +			return new float[((Number) sizeOrSeq).intValue()];
280.2172 +		else
280.2173 +			{
280.2174 +			ISeq s = RT.seq(sizeOrSeq);
280.2175 +			int size = s.count();
280.2176 +			float[] ret = new float[size];
280.2177 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.2178 +				ret[i] = ((Number) s.first()).intValue();
280.2179 +			return ret;
280.2180 +			}
280.2181 +	}
280.2182 +
280.2183 +
280.2184 +	static public float[] vsadd(float[] x, float y){
280.2185 +		final float[] xs = x.clone();
280.2186 +		for(int i = 0; i < xs.length; i++)
280.2187 +			xs[i] += y;
280.2188 +		return xs;
280.2189 +	}
280.2190 +
280.2191 +	static public float[] vssub(float[] x, float y){
280.2192 +		final float[] xs = x.clone();
280.2193 +		for(int i = 0; i < xs.length; i++)
280.2194 +			xs[i] -= y;
280.2195 +		return xs;
280.2196 +	}
280.2197 +
280.2198 +	static public float[] vsdiv(float[] x, float y){
280.2199 +		final float[] xs = x.clone();
280.2200 +		for(int i = 0; i < xs.length; i++)
280.2201 +			xs[i] /= y;
280.2202 +		return xs;
280.2203 +	}
280.2204 +
280.2205 +	static public float[] vsmul(float[] x, float y){
280.2206 +		final float[] xs = x.clone();
280.2207 +		for(int i = 0; i < xs.length; i++)
280.2208 +			xs[i] *= y;
280.2209 +		return xs;
280.2210 +	}
280.2211 +
280.2212 +	static public float[] svdiv(float y, float[] x){
280.2213 +		final float[] xs = x.clone();
280.2214 +		for(int i = 0; i < xs.length; i++)
280.2215 +			xs[i] = y / xs[i];
280.2216 +		return xs;
280.2217 +	}
280.2218 +
280.2219 +	static public float[] vsmuladd(float[] x, float y, float[] zs){
280.2220 +		final float[] xs = x.clone();
280.2221 +		for(int i = 0; i < xs.length; i++)
280.2222 +			xs[i] = xs[i] * y + zs[i];
280.2223 +		return xs;
280.2224 +	}
280.2225 +
280.2226 +	static public float[] vsmulsub(float[] x, float y, float[] zs){
280.2227 +		final float[] xs = x.clone();
280.2228 +		for(int i = 0; i < xs.length; i++)
280.2229 +			xs[i] = xs[i] * y - zs[i];
280.2230 +		return xs;
280.2231 +	}
280.2232 +
280.2233 +	static public float[] vsmulsadd(float[] x, float y, float z){
280.2234 +		final float[] xs = x.clone();
280.2235 +		for(int i = 0; i < xs.length; i++)
280.2236 +			xs[i] = xs[i] * y + z;
280.2237 +		return xs;
280.2238 +	}
280.2239 +
280.2240 +	static public float[] vsmulssub(float[] x, float y, float z){
280.2241 +		final float[] xs = x.clone();
280.2242 +		for(int i = 0; i < xs.length; i++)
280.2243 +			xs[i] = xs[i] * y - z;
280.2244 +		return xs;
280.2245 +	}
280.2246 +
280.2247 +	static public float[] vabs(float[] x){
280.2248 +		final float[] xs = x.clone();
280.2249 +		for(int i = 0; i < xs.length; i++)
280.2250 +			xs[i] = Math.abs(xs[i]);
280.2251 +		return xs;
280.2252 +	}
280.2253 +
280.2254 +	static public float[] vnegabs(float[] x){
280.2255 +		final float[] xs = x.clone();
280.2256 +		for(int i = 0; i < xs.length; i++)
280.2257 +			xs[i] = -Math.abs(xs[i]);
280.2258 +		return xs;
280.2259 +	}
280.2260 +
280.2261 +	static public float[] vneg(float[] x){
280.2262 +		final float[] xs = x.clone();
280.2263 +		for(int i = 0; i < xs.length; i++)
280.2264 +			xs[i] = -xs[i];
280.2265 +		return xs;
280.2266 +	}
280.2267 +
280.2268 +	static public float[] vsqr(float[] x){
280.2269 +		final float[] xs = x.clone();
280.2270 +		for(int i = 0; i < xs.length; i++)
280.2271 +			xs[i] *= xs[i];
280.2272 +		return xs;
280.2273 +	}
280.2274 +
280.2275 +	static public float[] vsignedsqr(float[] x){
280.2276 +		final float[] xs = x.clone();
280.2277 +		for(int i = 0; i < xs.length; i++)
280.2278 +			xs[i] *= Math.abs(xs[i]);
280.2279 +		return xs;
280.2280 +	}
280.2281 +
280.2282 +	static public float[] vclip(float[] x, float low, float high){
280.2283 +		final float[] xs = x.clone();
280.2284 +		for(int i = 0; i < xs.length; i++)
280.2285 +			{
280.2286 +			if(xs[i] < low)
280.2287 +				xs[i] = low;
280.2288 +			else if(xs[i] > high)
280.2289 +				xs[i] = high;
280.2290 +			}
280.2291 +		return xs;
280.2292 +	}
280.2293 +
280.2294 +	static public IPersistentVector vclipcounts(float[] x, float low, float high){
280.2295 +		final float[] xs = x.clone();
280.2296 +		int lowc = 0;
280.2297 +		int highc = 0;
280.2298 +
280.2299 +		for(int i = 0; i < xs.length; i++)
280.2300 +			{
280.2301 +			if(xs[i] < low)
280.2302 +				{
280.2303 +				++lowc;
280.2304 +				xs[i] = low;
280.2305 +				}
280.2306 +			else if(xs[i] > high)
280.2307 +				{
280.2308 +				++highc;
280.2309 +				xs[i] = high;
280.2310 +				}
280.2311 +			}
280.2312 +		return RT.vector(xs, lowc, highc);
280.2313 +	}
280.2314 +
280.2315 +	static public float[] vthresh(float[] x, float thresh, float otherwise){
280.2316 +		final float[] xs = x.clone();
280.2317 +		for(int i = 0; i < xs.length; i++)
280.2318 +			{
280.2319 +			if(xs[i] < thresh)
280.2320 +				xs[i] = otherwise;
280.2321 +			}
280.2322 +		return xs;
280.2323 +	}
280.2324 +
280.2325 +	static public float[] vreverse(float[] x){
280.2326 +		final float[] xs = x.clone();
280.2327 +		for(int i = 0; i < xs.length; i++)
280.2328 +			xs[i] = xs[xs.length - i - 1];
280.2329 +		return xs;
280.2330 +	}
280.2331 +
280.2332 +	static public float[] vrunningsum(float[] x){
280.2333 +		final float[] xs = x.clone();
280.2334 +		for(int i = 1; i < xs.length; i++)
280.2335 +			xs[i] = xs[i - 1] + xs[i];
280.2336 +		return xs;
280.2337 +	}
280.2338 +
280.2339 +	static public float[] vsort(float[] x){
280.2340 +		final float[] xs = x.clone();
280.2341 +		Arrays.sort(xs);
280.2342 +		return xs;
280.2343 +	}
280.2344 +
280.2345 +	static public float vdot(float[] xs, float[] ys){
280.2346 +		float ret = 0;
280.2347 +		for(int i = 0; i < xs.length; i++)
280.2348 +			ret += xs[i] * ys[i];
280.2349 +		return ret;
280.2350 +	}
280.2351 +
280.2352 +	static public float vmax(float[] xs){
280.2353 +		if(xs.length == 0)
280.2354 +			return 0;
280.2355 +		float ret = xs[0];
280.2356 +		for(int i = 0; i < xs.length; i++)
280.2357 +			ret = Math.max(ret, xs[i]);
280.2358 +		return ret;
280.2359 +	}
280.2360 +
280.2361 +	static public float vmin(float[] xs){
280.2362 +		if(xs.length == 0)
280.2363 +			return 0;
280.2364 +		float ret = xs[0];
280.2365 +		for(int i = 0; i < xs.length; i++)
280.2366 +			ret = Math.min(ret, xs[i]);
280.2367 +		return ret;
280.2368 +	}
280.2369 +
280.2370 +	static public float vmean(float[] xs){
280.2371 +		if(xs.length == 0)
280.2372 +			return 0;
280.2373 +		return vsum(xs) / xs.length;
280.2374 +	}
280.2375 +
280.2376 +	static public double vrms(float[] xs){
280.2377 +		if(xs.length == 0)
280.2378 +			return 0;
280.2379 +		float ret = 0;
280.2380 +		for(int i = 0; i < xs.length; i++)
280.2381 +			ret += xs[i] * xs[i];
280.2382 +		return Math.sqrt(ret / xs.length);
280.2383 +	}
280.2384 +
280.2385 +	static public float vsum(float[] xs){
280.2386 +		float ret = 0;
280.2387 +		for(int i = 0; i < xs.length; i++)
280.2388 +			ret += xs[i];
280.2389 +		return ret;
280.2390 +	}
280.2391 +
280.2392 +	static public boolean vequiv(float[] xs, float[] ys){
280.2393 +		return Arrays.equals(xs, ys);
280.2394 +	}
280.2395 +
280.2396 +	static public float[] vadd(float[] x, float[] ys){
280.2397 +		final float[] xs = x.clone();
280.2398 +		for(int i = 0; i < xs.length; i++)
280.2399 +			xs[i] += ys[i];
280.2400 +		return xs;
280.2401 +	}
280.2402 +
280.2403 +	static public float[] vsub(float[] x, float[] ys){
280.2404 +		final float[] xs = x.clone();
280.2405 +		for(int i = 0; i < xs.length; i++)
280.2406 +			xs[i] -= ys[i];
280.2407 +		return xs;
280.2408 +	}
280.2409 +
280.2410 +	static public float[] vaddmul(float[] x, float[] ys, float[] zs){
280.2411 +		final float[] xs = x.clone();
280.2412 +		for(int i = 0; i < xs.length; i++)
280.2413 +			xs[i] = (xs[i] + ys[i]) * zs[i];
280.2414 +		return xs;
280.2415 +	}
280.2416 +
280.2417 +	static public float[] vsubmul(float[] x, float[] ys, float[] zs){
280.2418 +		final float[] xs = x.clone();
280.2419 +		for(int i = 0; i < xs.length; i++)
280.2420 +			xs[i] = (xs[i] - ys[i]) * zs[i];
280.2421 +		return xs;
280.2422 +	}
280.2423 +
280.2424 +	static public float[] vaddsmul(float[] x, float[] ys, float z){
280.2425 +		final float[] xs = x.clone();
280.2426 +		for(int i = 0; i < xs.length; i++)
280.2427 +			xs[i] = (xs[i] + ys[i]) * z;
280.2428 +		return xs;
280.2429 +	}
280.2430 +
280.2431 +	static public float[] vsubsmul(float[] x, float[] ys, float z){
280.2432 +		final float[] xs = x.clone();
280.2433 +		for(int i = 0; i < xs.length; i++)
280.2434 +			xs[i] = (xs[i] - ys[i]) * z;
280.2435 +		return xs;
280.2436 +	}
280.2437 +
280.2438 +	static public float[] vmulsadd(float[] x, float[] ys, float z){
280.2439 +		final float[] xs = x.clone();
280.2440 +		for(int i = 0; i < xs.length; i++)
280.2441 +			xs[i] = (xs[i] * ys[i]) + z;
280.2442 +		return xs;
280.2443 +	}
280.2444 +
280.2445 +	static public float[] vdiv(float[] x, float[] ys){
280.2446 +		final float[] xs = x.clone();
280.2447 +		for(int i = 0; i < xs.length; i++)
280.2448 +			xs[i] /= ys[i];
280.2449 +		return xs;
280.2450 +	}
280.2451 +
280.2452 +	static public float[] vmul(float[] x, float[] ys){
280.2453 +		final float[] xs = x.clone();
280.2454 +		for(int i = 0; i < xs.length; i++)
280.2455 +			xs[i] *= ys[i];
280.2456 +		return xs;
280.2457 +	}
280.2458 +
280.2459 +	static public float[] vmuladd(float[] x, float[] ys, float[] zs){
280.2460 +		final float[] xs = x.clone();
280.2461 +		for(int i = 0; i < xs.length; i++)
280.2462 +			xs[i] = (xs[i] * ys[i]) + zs[i];
280.2463 +		return xs;
280.2464 +	}
280.2465 +
280.2466 +	static public float[] vmulsub(float[] x, float[] ys, float[] zs){
280.2467 +		final float[] xs = x.clone();
280.2468 +		for(int i = 0; i < xs.length; i++)
280.2469 +			xs[i] = (xs[i] * ys[i]) - zs[i];
280.2470 +		return xs;
280.2471 +	}
280.2472 +
280.2473 +	static public float[] vmax(float[] x, float[] ys){
280.2474 +		final float[] xs = x.clone();
280.2475 +		for(int i = 0; i < xs.length; i++)
280.2476 +			xs[i] = Math.max(xs[i], ys[i]);
280.2477 +		return xs;
280.2478 +	}
280.2479 +
280.2480 +	static public float[] vmin(float[] x, float[] ys){
280.2481 +		final float[] xs = x.clone();
280.2482 +		for(int i = 0; i < xs.length; i++)
280.2483 +			xs[i] = Math.min(xs[i], ys[i]);
280.2484 +		return xs;
280.2485 +	}
280.2486 +
280.2487 +	static public float[] vmap(IFn fn, float[] x) throws Exception{
280.2488 +		float[] xs = x.clone();
280.2489 +		for(int i = 0; i < xs.length; i++)
280.2490 +			xs[i] = ((Number) fn.invoke(xs[i])).floatValue();
280.2491 +		return xs;
280.2492 +	}
280.2493 +
280.2494 +	static public float[] vmap(IFn fn, float[] x, float[] ys) throws Exception{
280.2495 +		float[] xs = x.clone();
280.2496 +		for(int i = 0; i < xs.length; i++)
280.2497 +			xs[i] = ((Number) fn.invoke(xs[i], ys[i])).floatValue();
280.2498 +		return xs;
280.2499 +	}
280.2500 +
280.2501 +}
280.2502 +
280.2503 +static public class D{
280.2504 +	static public double add(double x, double y){
280.2505 +		return x + y;
280.2506 +	}
280.2507 +
280.2508 +	static public double subtract(double x, double y){
280.2509 +		return x - y;
280.2510 +	}
280.2511 +
280.2512 +	static public double negate(double x){
280.2513 +		return -x;
280.2514 +	}
280.2515 +
280.2516 +	static public double inc(double x){
280.2517 +		return x + 1;
280.2518 +	}
280.2519 +
280.2520 +	static public double dec(double x){
280.2521 +		return x - 1;
280.2522 +	}
280.2523 +
280.2524 +	static public double multiply(double x, double y){
280.2525 +		return x * y;
280.2526 +	}
280.2527 +
280.2528 +	static public double divide(double x, double y){
280.2529 +		return x / y;
280.2530 +	}
280.2531 +
280.2532 +	static public boolean equiv(double x, double y){
280.2533 +		return x == y;
280.2534 +	}
280.2535 +
280.2536 +	static public boolean lt(double x, double y){
280.2537 +		return x < y;
280.2538 +	}
280.2539 +
280.2540 +	static public boolean lte(double x, double y){
280.2541 +		return x <= y;
280.2542 +	}
280.2543 +
280.2544 +	static public boolean gt(double x, double y){
280.2545 +		return x > y;
280.2546 +	}
280.2547 +
280.2548 +	static public boolean gte(double x, double y){
280.2549 +		return x >= y;
280.2550 +	}
280.2551 +
280.2552 +	static public boolean pos(double x){
280.2553 +		return x > 0;
280.2554 +	}
280.2555 +
280.2556 +	static public boolean neg(double x){
280.2557 +		return x < 0;
280.2558 +	}
280.2559 +
280.2560 +	static public boolean zero(double x){
280.2561 +		return x == 0;
280.2562 +	}
280.2563 +
280.2564 +	static public double aget(double[] xs, int i){
280.2565 +		return xs[i];
280.2566 +	}
280.2567 +
280.2568 +	static public double aset(double[] xs, int i, double v){
280.2569 +		xs[i] = v;
280.2570 +		return v;
280.2571 +	}
280.2572 +
280.2573 +	static public int alength(double[] xs){
280.2574 +		return xs.length;
280.2575 +	}
280.2576 +
280.2577 +	static public double[] aclone(double[] xs){
280.2578 +		return xs.clone();
280.2579 +	}
280.2580 +
280.2581 +	static public double[] vec(int size, Object init){
280.2582 +		double[] ret = new double[size];
280.2583 +		if(init instanceof Number)
280.2584 +			{
280.2585 +			double f = ((Number) init).doubleValue();
280.2586 +			for(int i = 0; i < ret.length; i++)
280.2587 +				ret[i] = f;
280.2588 +			}
280.2589 +		else
280.2590 +			{
280.2591 +			ISeq s = RT.seq(init);
280.2592 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.2593 +				ret[i] = ((Number) s.first()).doubleValue();
280.2594 +			}
280.2595 +		return ret;
280.2596 +	}
280.2597 +
280.2598 +	static public double[] vec(Object sizeOrSeq){
280.2599 +		if(sizeOrSeq instanceof Number)
280.2600 +			return new double[((Number) sizeOrSeq).intValue()];
280.2601 +		else
280.2602 +			{
280.2603 +			ISeq s = RT.seq(sizeOrSeq);
280.2604 +			int size = s.count();
280.2605 +			double[] ret = new double[size];
280.2606 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.2607 +				ret[i] = ((Number) s.first()).intValue();
280.2608 +			return ret;
280.2609 +			}
280.2610 +	}
280.2611 +
280.2612 +	static public double[] vsadd(double[] x, double y){
280.2613 +		final double[] xs = x.clone();
280.2614 +		for(int i = 0; i < xs.length; i++)
280.2615 +			xs[i] += y;
280.2616 +		return xs;
280.2617 +	}
280.2618 +
280.2619 +	static public double[] vssub(double[] x, double y){
280.2620 +		final double[] xs = x.clone();
280.2621 +		for(int i = 0; i < xs.length; i++)
280.2622 +			xs[i] -= y;
280.2623 +		return xs;
280.2624 +	}
280.2625 +
280.2626 +	static public double[] vsdiv(double[] x, double y){
280.2627 +		final double[] xs = x.clone();
280.2628 +		for(int i = 0; i < xs.length; i++)
280.2629 +			xs[i] /= y;
280.2630 +		return xs;
280.2631 +	}
280.2632 +
280.2633 +	static public double[] vsmul(double[] x, double y){
280.2634 +		final double[] xs = x.clone();
280.2635 +		for(int i = 0; i < xs.length; i++)
280.2636 +			xs[i] *= y;
280.2637 +		return xs;
280.2638 +	}
280.2639 +
280.2640 +	static public double[] svdiv(double y, double[] x){
280.2641 +		final double[] xs = x.clone();
280.2642 +		for(int i = 0; i < xs.length; i++)
280.2643 +			xs[i] = y / xs[i];
280.2644 +		return xs;
280.2645 +	}
280.2646 +
280.2647 +	static public double[] vsmuladd(double[] x, double y, double[] zs){
280.2648 +		final double[] xs = x.clone();
280.2649 +		for(int i = 0; i < xs.length; i++)
280.2650 +			xs[i] = xs[i] * y + zs[i];
280.2651 +		return xs;
280.2652 +	}
280.2653 +
280.2654 +	static public double[] vsmulsub(double[] x, double y, double[] zs){
280.2655 +		final double[] xs = x.clone();
280.2656 +		for(int i = 0; i < xs.length; i++)
280.2657 +			xs[i] = xs[i] * y - zs[i];
280.2658 +		return xs;
280.2659 +	}
280.2660 +
280.2661 +	static public double[] vsmulsadd(double[] x, double y, double z){
280.2662 +		final double[] xs = x.clone();
280.2663 +		for(int i = 0; i < xs.length; i++)
280.2664 +			xs[i] = xs[i] * y + z;
280.2665 +		return xs;
280.2666 +	}
280.2667 +
280.2668 +	static public double[] vsmulssub(double[] x, double y, double z){
280.2669 +		final double[] xs = x.clone();
280.2670 +		for(int i = 0; i < xs.length; i++)
280.2671 +			xs[i] = xs[i] * y - z;
280.2672 +		return xs;
280.2673 +	}
280.2674 +
280.2675 +	static public double[] vabs(double[] x){
280.2676 +		final double[] xs = x.clone();
280.2677 +		for(int i = 0; i < xs.length; i++)
280.2678 +			xs[i] = Math.abs(xs[i]);
280.2679 +		return xs;
280.2680 +	}
280.2681 +
280.2682 +	static public double[] vnegabs(double[] x){
280.2683 +		final double[] xs = x.clone();
280.2684 +		for(int i = 0; i < xs.length; i++)
280.2685 +			xs[i] = -Math.abs(xs[i]);
280.2686 +		return xs;
280.2687 +	}
280.2688 +
280.2689 +	static public double[] vneg(double[] x){
280.2690 +		final double[] xs = x.clone();
280.2691 +		for(int i = 0; i < xs.length; i++)
280.2692 +			xs[i] = -xs[i];
280.2693 +		return xs;
280.2694 +	}
280.2695 +
280.2696 +	static public double[] vsqr(double[] x){
280.2697 +		final double[] xs = x.clone();
280.2698 +		for(int i = 0; i < xs.length; i++)
280.2699 +			xs[i] *= xs[i];
280.2700 +		return xs;
280.2701 +	}
280.2702 +
280.2703 +	static public double[] vsignedsqr(double[] x){
280.2704 +		final double[] xs = x.clone();
280.2705 +		for(int i = 0; i < xs.length; i++)
280.2706 +			xs[i] *= Math.abs(xs[i]);
280.2707 +		return xs;
280.2708 +	}
280.2709 +
280.2710 +	static public double[] vclip(double[] x, double low, double high){
280.2711 +		final double[] xs = x.clone();
280.2712 +		for(int i = 0; i < xs.length; i++)
280.2713 +			{
280.2714 +			if(xs[i] < low)
280.2715 +				xs[i] = low;
280.2716 +			else if(xs[i] > high)
280.2717 +				xs[i] = high;
280.2718 +			}
280.2719 +		return xs;
280.2720 +	}
280.2721 +
280.2722 +	static public IPersistentVector vclipcounts(double[] x, double low, double high){
280.2723 +		final double[] xs = x.clone();
280.2724 +		int lowc = 0;
280.2725 +		int highc = 0;
280.2726 +
280.2727 +		for(int i = 0; i < xs.length; i++)
280.2728 +			{
280.2729 +			if(xs[i] < low)
280.2730 +				{
280.2731 +				++lowc;
280.2732 +				xs[i] = low;
280.2733 +				}
280.2734 +			else if(xs[i] > high)
280.2735 +				{
280.2736 +				++highc;
280.2737 +				xs[i] = high;
280.2738 +				}
280.2739 +			}
280.2740 +		return RT.vector(xs, lowc, highc);
280.2741 +	}
280.2742 +
280.2743 +	static public double[] vthresh(double[] x, double thresh, double otherwise){
280.2744 +		final double[] xs = x.clone();
280.2745 +		for(int i = 0; i < xs.length; i++)
280.2746 +			{
280.2747 +			if(xs[i] < thresh)
280.2748 +				xs[i] = otherwise;
280.2749 +			}
280.2750 +		return xs;
280.2751 +	}
280.2752 +
280.2753 +	static public double[] vreverse(double[] x){
280.2754 +		final double[] xs = x.clone();
280.2755 +		for(int i = 0; i < xs.length; i++)
280.2756 +			xs[i] = xs[xs.length - i - 1];
280.2757 +		return xs;
280.2758 +	}
280.2759 +
280.2760 +	static public double[] vrunningsum(double[] x){
280.2761 +		final double[] xs = x.clone();
280.2762 +		for(int i = 1; i < xs.length; i++)
280.2763 +			xs[i] = xs[i - 1] + xs[i];
280.2764 +		return xs;
280.2765 +	}
280.2766 +
280.2767 +	static public double[] vsort(double[] x){
280.2768 +		final double[] xs = x.clone();
280.2769 +		Arrays.sort(xs);
280.2770 +		return xs;
280.2771 +	}
280.2772 +
280.2773 +	static public double vdot(double[] xs, double[] ys){
280.2774 +		double ret = 0;
280.2775 +		for(int i = 0; i < xs.length; i++)
280.2776 +			ret += xs[i] * ys[i];
280.2777 +		return ret;
280.2778 +	}
280.2779 +
280.2780 +	static public double vmax(double[] xs){
280.2781 +		if(xs.length == 0)
280.2782 +			return 0;
280.2783 +		double ret = xs[0];
280.2784 +		for(int i = 0; i < xs.length; i++)
280.2785 +			ret = Math.max(ret, xs[i]);
280.2786 +		return ret;
280.2787 +	}
280.2788 +
280.2789 +	static public double vmin(double[] xs){
280.2790 +		if(xs.length == 0)
280.2791 +			return 0;
280.2792 +		double ret = xs[0];
280.2793 +		for(int i = 0; i < xs.length; i++)
280.2794 +			ret = Math.min(ret, xs[i]);
280.2795 +		return ret;
280.2796 +	}
280.2797 +
280.2798 +	static public double vmean(double[] xs){
280.2799 +		if(xs.length == 0)
280.2800 +			return 0;
280.2801 +		return vsum(xs) / xs.length;
280.2802 +	}
280.2803 +
280.2804 +	static public double vrms(double[] xs){
280.2805 +		if(xs.length == 0)
280.2806 +			return 0;
280.2807 +		double ret = 0;
280.2808 +		for(int i = 0; i < xs.length; i++)
280.2809 +			ret += xs[i] * xs[i];
280.2810 +		return Math.sqrt(ret / xs.length);
280.2811 +	}
280.2812 +
280.2813 +	static public double vsum(double[] xs){
280.2814 +		double ret = 0;
280.2815 +		for(int i = 0; i < xs.length; i++)
280.2816 +			ret += xs[i];
280.2817 +		return ret;
280.2818 +	}
280.2819 +
280.2820 +	static public boolean vequiv(double[] xs, double[] ys){
280.2821 +		return Arrays.equals(xs, ys);
280.2822 +	}
280.2823 +
280.2824 +	static public double[] vadd(double[] x, double[] ys){
280.2825 +		final double[] xs = x.clone();
280.2826 +		for(int i = 0; i < xs.length; i++)
280.2827 +			xs[i] += ys[i];
280.2828 +		return xs;
280.2829 +	}
280.2830 +
280.2831 +	static public double[] vsub(double[] x, double[] ys){
280.2832 +		final double[] xs = x.clone();
280.2833 +		for(int i = 0; i < xs.length; i++)
280.2834 +			xs[i] -= ys[i];
280.2835 +		return xs;
280.2836 +	}
280.2837 +
280.2838 +	static public double[] vaddmul(double[] x, double[] ys, double[] zs){
280.2839 +		final double[] xs = x.clone();
280.2840 +		for(int i = 0; i < xs.length; i++)
280.2841 +			xs[i] = (xs[i] + ys[i]) * zs[i];
280.2842 +		return xs;
280.2843 +	}
280.2844 +
280.2845 +	static public double[] vsubmul(double[] x, double[] ys, double[] zs){
280.2846 +		final double[] xs = x.clone();
280.2847 +		for(int i = 0; i < xs.length; i++)
280.2848 +			xs[i] = (xs[i] - ys[i]) * zs[i];
280.2849 +		return xs;
280.2850 +	}
280.2851 +
280.2852 +	static public double[] vaddsmul(double[] x, double[] ys, double z){
280.2853 +		final double[] xs = x.clone();
280.2854 +		for(int i = 0; i < xs.length; i++)
280.2855 +			xs[i] = (xs[i] + ys[i]) * z;
280.2856 +		return xs;
280.2857 +	}
280.2858 +
280.2859 +	static public double[] vsubsmul(double[] x, double[] ys, double z){
280.2860 +		final double[] xs = x.clone();
280.2861 +		for(int i = 0; i < xs.length; i++)
280.2862 +			xs[i] = (xs[i] - ys[i]) * z;
280.2863 +		return xs;
280.2864 +	}
280.2865 +
280.2866 +	static public double[] vmulsadd(double[] x, double[] ys, double z){
280.2867 +		final double[] xs = x.clone();
280.2868 +		for(int i = 0; i < xs.length; i++)
280.2869 +			xs[i] = (xs[i] * ys[i]) + z;
280.2870 +		return xs;
280.2871 +	}
280.2872 +
280.2873 +	static public double[] vdiv(double[] x, double[] ys){
280.2874 +		final double[] xs = x.clone();
280.2875 +		for(int i = 0; i < xs.length; i++)
280.2876 +			xs[i] /= ys[i];
280.2877 +		return xs;
280.2878 +	}
280.2879 +
280.2880 +	static public double[] vmul(double[] x, double[] ys){
280.2881 +		final double[] xs = x.clone();
280.2882 +		for(int i = 0; i < xs.length; i++)
280.2883 +			xs[i] *= ys[i];
280.2884 +		return xs;
280.2885 +	}
280.2886 +
280.2887 +	static public double[] vmuladd(double[] x, double[] ys, double[] zs){
280.2888 +		final double[] xs = x.clone();
280.2889 +		for(int i = 0; i < xs.length; i++)
280.2890 +			xs[i] = (xs[i] * ys[i]) + zs[i];
280.2891 +		return xs;
280.2892 +	}
280.2893 +
280.2894 +	static public double[] vmulsub(double[] x, double[] ys, double[] zs){
280.2895 +		final double[] xs = x.clone();
280.2896 +		for(int i = 0; i < xs.length; i++)
280.2897 +			xs[i] = (xs[i] * ys[i]) - zs[i];
280.2898 +		return xs;
280.2899 +	}
280.2900 +
280.2901 +	static public double[] vmax(double[] x, double[] ys){
280.2902 +		final double[] xs = x.clone();
280.2903 +		for(int i = 0; i < xs.length; i++)
280.2904 +			xs[i] = Math.max(xs[i], ys[i]);
280.2905 +		return xs;
280.2906 +	}
280.2907 +
280.2908 +	static public double[] vmin(double[] x, double[] ys){
280.2909 +		final double[] xs = x.clone();
280.2910 +		for(int i = 0; i < xs.length; i++)
280.2911 +			xs[i] = Math.min(xs[i], ys[i]);
280.2912 +		return xs;
280.2913 +	}
280.2914 +
280.2915 +	static public double[] vmap(IFn fn, double[] x) throws Exception{
280.2916 +		double[] xs = x.clone();
280.2917 +		for(int i = 0; i < xs.length; i++)
280.2918 +			xs[i] = ((Number) fn.invoke(xs[i])).doubleValue();
280.2919 +		return xs;
280.2920 +	}
280.2921 +
280.2922 +	static public double[] vmap(IFn fn, double[] x, double[] ys) throws Exception{
280.2923 +		double[] xs = x.clone();
280.2924 +		for(int i = 0; i < xs.length; i++)
280.2925 +			xs[i] = ((Number) fn.invoke(xs[i], ys[i])).doubleValue();
280.2926 +		return xs;
280.2927 +	}
280.2928 +}
280.2929 +
280.2930 +static public class I{
280.2931 +	static public int add(int x, int y){
280.2932 +		return x + y;
280.2933 +	}
280.2934 +
280.2935 +	static public int subtract(int x, int y){
280.2936 +		return x - y;
280.2937 +	}
280.2938 +
280.2939 +	static public int negate(int x){
280.2940 +		return -x;
280.2941 +	}
280.2942 +
280.2943 +	static public int inc(int x){
280.2944 +		return x + 1;
280.2945 +	}
280.2946 +
280.2947 +	static public int dec(int x){
280.2948 +		return x - 1;
280.2949 +	}
280.2950 +
280.2951 +	static public int multiply(int x, int y){
280.2952 +		return x * y;
280.2953 +	}
280.2954 +
280.2955 +	static public int divide(int x, int y){
280.2956 +		return x / y;
280.2957 +	}
280.2958 +
280.2959 +	static public boolean equiv(int x, int y){
280.2960 +		return x == y;
280.2961 +	}
280.2962 +
280.2963 +	static public boolean lt(int x, int y){
280.2964 +		return x < y;
280.2965 +	}
280.2966 +
280.2967 +	static public boolean lte(int x, int y){
280.2968 +		return x <= y;
280.2969 +	}
280.2970 +
280.2971 +	static public boolean gt(int x, int y){
280.2972 +		return x > y;
280.2973 +	}
280.2974 +
280.2975 +	static public boolean gte(int x, int y){
280.2976 +		return x >= y;
280.2977 +	}
280.2978 +
280.2979 +	static public boolean pos(int x){
280.2980 +		return x > 0;
280.2981 +	}
280.2982 +
280.2983 +	static public boolean neg(int x){
280.2984 +		return x < 0;
280.2985 +	}
280.2986 +
280.2987 +	static public boolean zero(int x){
280.2988 +		return x == 0;
280.2989 +	}
280.2990 +
280.2991 +	static public int aget(int[] xs, int i){
280.2992 +		return xs[i];
280.2993 +	}
280.2994 +
280.2995 +	static public int aset(int[] xs, int i, int v){
280.2996 +		xs[i] = v;
280.2997 +		return v;
280.2998 +	}
280.2999 +
280.3000 +	static public int alength(int[] xs){
280.3001 +		return xs.length;
280.3002 +	}
280.3003 +
280.3004 +	static public int[] aclone(int[] xs){
280.3005 +		return xs.clone();
280.3006 +	}
280.3007 +
280.3008 +	static public int[] vec(int size, Object init){
280.3009 +		int[] ret = new int[size];
280.3010 +		if(init instanceof Number)
280.3011 +			{
280.3012 +			int f = ((Number) init).intValue();
280.3013 +			for(int i = 0; i < ret.length; i++)
280.3014 +				ret[i] = f;
280.3015 +			}
280.3016 +		else
280.3017 +			{
280.3018 +			ISeq s = RT.seq(init);
280.3019 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.3020 +				ret[i] = ((Number) s.first()).intValue();
280.3021 +			}
280.3022 +		return ret;
280.3023 +	}
280.3024 +
280.3025 +	static public int[] vec(Object sizeOrSeq){
280.3026 +		if(sizeOrSeq instanceof Number)
280.3027 +			return new int[((Number) sizeOrSeq).intValue()];
280.3028 +		else
280.3029 +			{
280.3030 +			ISeq s = RT.seq(sizeOrSeq);
280.3031 +			int size = s.count();
280.3032 +			int[] ret = new int[size];
280.3033 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.3034 +				ret[i] = ((Number) s.first()).intValue();
280.3035 +			return ret;
280.3036 +			}
280.3037 +	}
280.3038 +
280.3039 +	static public int[] vsadd(int[] x, int y){
280.3040 +		final int[] xs = x.clone();
280.3041 +		for(int i = 0; i < xs.length; i++)
280.3042 +			xs[i] += y;
280.3043 +		return xs;
280.3044 +	}
280.3045 +
280.3046 +	static public int[] vssub(int[] x, int y){
280.3047 +		final int[] xs = x.clone();
280.3048 +		for(int i = 0; i < xs.length; i++)
280.3049 +			xs[i] -= y;
280.3050 +		return xs;
280.3051 +	}
280.3052 +
280.3053 +	static public int[] vsdiv(int[] x, int y){
280.3054 +		final int[] xs = x.clone();
280.3055 +		for(int i = 0; i < xs.length; i++)
280.3056 +			xs[i] /= y;
280.3057 +		return xs;
280.3058 +	}
280.3059 +
280.3060 +	static public int[] vsmul(int[] x, int y){
280.3061 +		final int[] xs = x.clone();
280.3062 +		for(int i = 0; i < xs.length; i++)
280.3063 +			xs[i] *= y;
280.3064 +		return xs;
280.3065 +	}
280.3066 +
280.3067 +	static public int[] svdiv(int y, int[] x){
280.3068 +		final int[] xs = x.clone();
280.3069 +		for(int i = 0; i < xs.length; i++)
280.3070 +			xs[i] = y / xs[i];
280.3071 +		return xs;
280.3072 +	}
280.3073 +
280.3074 +	static public int[] vsmuladd(int[] x, int y, int[] zs){
280.3075 +		final int[] xs = x.clone();
280.3076 +		for(int i = 0; i < xs.length; i++)
280.3077 +			xs[i] = xs[i] * y + zs[i];
280.3078 +		return xs;
280.3079 +	}
280.3080 +
280.3081 +	static public int[] vsmulsub(int[] x, int y, int[] zs){
280.3082 +		final int[] xs = x.clone();
280.3083 +		for(int i = 0; i < xs.length; i++)
280.3084 +			xs[i] = xs[i] * y - zs[i];
280.3085 +		return xs;
280.3086 +	}
280.3087 +
280.3088 +	static public int[] vsmulsadd(int[] x, int y, int z){
280.3089 +		final int[] xs = x.clone();
280.3090 +		for(int i = 0; i < xs.length; i++)
280.3091 +			xs[i] = xs[i] * y + z;
280.3092 +		return xs;
280.3093 +	}
280.3094 +
280.3095 +	static public int[] vsmulssub(int[] x, int y, int z){
280.3096 +		final int[] xs = x.clone();
280.3097 +		for(int i = 0; i < xs.length; i++)
280.3098 +			xs[i] = xs[i] * y - z;
280.3099 +		return xs;
280.3100 +	}
280.3101 +
280.3102 +	static public int[] vabs(int[] x){
280.3103 +		final int[] xs = x.clone();
280.3104 +		for(int i = 0; i < xs.length; i++)
280.3105 +			xs[i] = Math.abs(xs[i]);
280.3106 +		return xs;
280.3107 +	}
280.3108 +
280.3109 +	static public int[] vnegabs(int[] x){
280.3110 +		final int[] xs = x.clone();
280.3111 +		for(int i = 0; i < xs.length; i++)
280.3112 +			xs[i] = -Math.abs(xs[i]);
280.3113 +		return xs;
280.3114 +	}
280.3115 +
280.3116 +	static public int[] vneg(int[] x){
280.3117 +		final int[] xs = x.clone();
280.3118 +		for(int i = 0; i < xs.length; i++)
280.3119 +			xs[i] = -xs[i];
280.3120 +		return xs;
280.3121 +	}
280.3122 +
280.3123 +	static public int[] vsqr(int[] x){
280.3124 +		final int[] xs = x.clone();
280.3125 +		for(int i = 0; i < xs.length; i++)
280.3126 +			xs[i] *= xs[i];
280.3127 +		return xs;
280.3128 +	}
280.3129 +
280.3130 +	static public int[] vsignedsqr(int[] x){
280.3131 +		final int[] xs = x.clone();
280.3132 +		for(int i = 0; i < xs.length; i++)
280.3133 +			xs[i] *= Math.abs(xs[i]);
280.3134 +		return xs;
280.3135 +	}
280.3136 +
280.3137 +	static public int[] vclip(int[] x, int low, int high){
280.3138 +		final int[] xs = x.clone();
280.3139 +		for(int i = 0; i < xs.length; i++)
280.3140 +			{
280.3141 +			if(xs[i] < low)
280.3142 +				xs[i] = low;
280.3143 +			else if(xs[i] > high)
280.3144 +				xs[i] = high;
280.3145 +			}
280.3146 +		return xs;
280.3147 +	}
280.3148 +
280.3149 +	static public IPersistentVector vclipcounts(int[] x, int low, int high){
280.3150 +		final int[] xs = x.clone();
280.3151 +		int lowc = 0;
280.3152 +		int highc = 0;
280.3153 +
280.3154 +		for(int i = 0; i < xs.length; i++)
280.3155 +			{
280.3156 +			if(xs[i] < low)
280.3157 +				{
280.3158 +				++lowc;
280.3159 +				xs[i] = low;
280.3160 +				}
280.3161 +			else if(xs[i] > high)
280.3162 +				{
280.3163 +				++highc;
280.3164 +				xs[i] = high;
280.3165 +				}
280.3166 +			}
280.3167 +		return RT.vector(xs, lowc, highc);
280.3168 +	}
280.3169 +
280.3170 +	static public int[] vthresh(int[] x, int thresh, int otherwise){
280.3171 +		final int[] xs = x.clone();
280.3172 +		for(int i = 0; i < xs.length; i++)
280.3173 +			{
280.3174 +			if(xs[i] < thresh)
280.3175 +				xs[i] = otherwise;
280.3176 +			}
280.3177 +		return xs;
280.3178 +	}
280.3179 +
280.3180 +	static public int[] vreverse(int[] x){
280.3181 +		final int[] xs = x.clone();
280.3182 +		for(int i = 0; i < xs.length; i++)
280.3183 +			xs[i] = xs[xs.length - i - 1];
280.3184 +		return xs;
280.3185 +	}
280.3186 +
280.3187 +	static public int[] vrunningsum(int[] x){
280.3188 +		final int[] xs = x.clone();
280.3189 +		for(int i = 1; i < xs.length; i++)
280.3190 +			xs[i] = xs[i - 1] + xs[i];
280.3191 +		return xs;
280.3192 +	}
280.3193 +
280.3194 +	static public int[] vsort(int[] x){
280.3195 +		final int[] xs = x.clone();
280.3196 +		Arrays.sort(xs);
280.3197 +		return xs;
280.3198 +	}
280.3199 +
280.3200 +	static public int vdot(int[] xs, int[] ys){
280.3201 +		int ret = 0;
280.3202 +		for(int i = 0; i < xs.length; i++)
280.3203 +			ret += xs[i] * ys[i];
280.3204 +		return ret;
280.3205 +	}
280.3206 +
280.3207 +	static public int vmax(int[] xs){
280.3208 +		if(xs.length == 0)
280.3209 +			return 0;
280.3210 +		int ret = xs[0];
280.3211 +		for(int i = 0; i < xs.length; i++)
280.3212 +			ret = Math.max(ret, xs[i]);
280.3213 +		return ret;
280.3214 +	}
280.3215 +
280.3216 +	static public int vmin(int[] xs){
280.3217 +		if(xs.length == 0)
280.3218 +			return 0;
280.3219 +		int ret = xs[0];
280.3220 +		for(int i = 0; i < xs.length; i++)
280.3221 +			ret = Math.min(ret, xs[i]);
280.3222 +		return ret;
280.3223 +	}
280.3224 +
280.3225 +	static public double vmean(int[] xs){
280.3226 +		if(xs.length == 0)
280.3227 +			return 0;
280.3228 +		return vsum(xs) / (double) xs.length;
280.3229 +	}
280.3230 +
280.3231 +	static public double vrms(int[] xs){
280.3232 +		if(xs.length == 0)
280.3233 +			return 0;
280.3234 +		int ret = 0;
280.3235 +		for(int i = 0; i < xs.length; i++)
280.3236 +			ret += xs[i] * xs[i];
280.3237 +		return Math.sqrt(ret / (double) xs.length);
280.3238 +	}
280.3239 +
280.3240 +	static public int vsum(int[] xs){
280.3241 +		int ret = 0;
280.3242 +		for(int i = 0; i < xs.length; i++)
280.3243 +			ret += xs[i];
280.3244 +		return ret;
280.3245 +	}
280.3246 +
280.3247 +	static public boolean vequiv(int[] xs, int[] ys){
280.3248 +		return Arrays.equals(xs, ys);
280.3249 +	}
280.3250 +
280.3251 +	static public int[] vadd(int[] x, int[] ys){
280.3252 +		final int[] xs = x.clone();
280.3253 +		for(int i = 0; i < xs.length; i++)
280.3254 +			xs[i] += ys[i];
280.3255 +		return xs;
280.3256 +	}
280.3257 +
280.3258 +	static public int[] vsub(int[] x, int[] ys){
280.3259 +		final int[] xs = x.clone();
280.3260 +		for(int i = 0; i < xs.length; i++)
280.3261 +			xs[i] -= ys[i];
280.3262 +		return xs;
280.3263 +	}
280.3264 +
280.3265 +	static public int[] vaddmul(int[] x, int[] ys, int[] zs){
280.3266 +		final int[] xs = x.clone();
280.3267 +		for(int i = 0; i < xs.length; i++)
280.3268 +			xs[i] = (xs[i] + ys[i]) * zs[i];
280.3269 +		return xs;
280.3270 +	}
280.3271 +
280.3272 +	static public int[] vsubmul(int[] x, int[] ys, int[] zs){
280.3273 +		final int[] xs = x.clone();
280.3274 +		for(int i = 0; i < xs.length; i++)
280.3275 +			xs[i] = (xs[i] - ys[i]) * zs[i];
280.3276 +		return xs;
280.3277 +	}
280.3278 +
280.3279 +	static public int[] vaddsmul(int[] x, int[] ys, int z){
280.3280 +		final int[] xs = x.clone();
280.3281 +		for(int i = 0; i < xs.length; i++)
280.3282 +			xs[i] = (xs[i] + ys[i]) * z;
280.3283 +		return xs;
280.3284 +	}
280.3285 +
280.3286 +	static public int[] vsubsmul(int[] x, int[] ys, int z){
280.3287 +		final int[] xs = x.clone();
280.3288 +		for(int i = 0; i < xs.length; i++)
280.3289 +			xs[i] = (xs[i] - ys[i]) * z;
280.3290 +		return xs;
280.3291 +	}
280.3292 +
280.3293 +	static public int[] vmulsadd(int[] x, int[] ys, int z){
280.3294 +		final int[] xs = x.clone();
280.3295 +		for(int i = 0; i < xs.length; i++)
280.3296 +			xs[i] = (xs[i] * ys[i]) + z;
280.3297 +		return xs;
280.3298 +	}
280.3299 +
280.3300 +	static public int[] vdiv(int[] x, int[] ys){
280.3301 +		final int[] xs = x.clone();
280.3302 +		for(int i = 0; i < xs.length; i++)
280.3303 +			xs[i] /= ys[i];
280.3304 +		return xs;
280.3305 +	}
280.3306 +
280.3307 +	static public int[] vmul(int[] x, int[] ys){
280.3308 +		final int[] xs = x.clone();
280.3309 +		for(int i = 0; i < xs.length; i++)
280.3310 +			xs[i] *= ys[i];
280.3311 +		return xs;
280.3312 +	}
280.3313 +
280.3314 +	static public int[] vmuladd(int[] x, int[] ys, int[] zs){
280.3315 +		final int[] xs = x.clone();
280.3316 +		for(int i = 0; i < xs.length; i++)
280.3317 +			xs[i] = (xs[i] * ys[i]) + zs[i];
280.3318 +		return xs;
280.3319 +	}
280.3320 +
280.3321 +	static public int[] vmulsub(int[] x, int[] ys, int[] zs){
280.3322 +		final int[] xs = x.clone();
280.3323 +		for(int i = 0; i < xs.length; i++)
280.3324 +			xs[i] = (xs[i] * ys[i]) - zs[i];
280.3325 +		return xs;
280.3326 +	}
280.3327 +
280.3328 +	static public int[] vmax(int[] x, int[] ys){
280.3329 +		final int[] xs = x.clone();
280.3330 +		for(int i = 0; i < xs.length; i++)
280.3331 +			xs[i] = Math.max(xs[i], ys[i]);
280.3332 +		return xs;
280.3333 +	}
280.3334 +
280.3335 +	static public int[] vmin(int[] x, int[] ys){
280.3336 +		final int[] xs = x.clone();
280.3337 +		for(int i = 0; i < xs.length; i++)
280.3338 +			xs[i] = Math.min(xs[i], ys[i]);
280.3339 +		return xs;
280.3340 +	}
280.3341 +
280.3342 +	static public int[] vmap(IFn fn, int[] x) throws Exception{
280.3343 +		int[] xs = x.clone();
280.3344 +		for(int i = 0; i < xs.length; i++)
280.3345 +			xs[i] = ((Number) fn.invoke(xs[i])).intValue();
280.3346 +		return xs;
280.3347 +	}
280.3348 +
280.3349 +	static public int[] vmap(IFn fn, int[] x, int[] ys) throws Exception{
280.3350 +		int[] xs = x.clone();
280.3351 +		for(int i = 0; i < xs.length; i++)
280.3352 +			xs[i] = ((Number) fn.invoke(xs[i], ys[i])).intValue();
280.3353 +		return xs;
280.3354 +	}
280.3355 +
280.3356 +}
280.3357 +
280.3358 +static public class L{
280.3359 +	static public long add(long x, long y){
280.3360 +		return x + y;
280.3361 +	}
280.3362 +
280.3363 +	static public long subtract(long x, long y){
280.3364 +		return x - y;
280.3365 +	}
280.3366 +
280.3367 +	static public long negate(long x){
280.3368 +		return -x;
280.3369 +	}
280.3370 +
280.3371 +	static public long inc(long x){
280.3372 +		return x + 1;
280.3373 +	}
280.3374 +
280.3375 +	static public long dec(long x){
280.3376 +		return x - 1;
280.3377 +	}
280.3378 +
280.3379 +	static public long multiply(long x, long y){
280.3380 +		return x * y;
280.3381 +	}
280.3382 +
280.3383 +	static public long divide(long x, long y){
280.3384 +		return x / y;
280.3385 +	}
280.3386 +
280.3387 +	static public boolean equiv(long x, long y){
280.3388 +		return x == y;
280.3389 +	}
280.3390 +
280.3391 +	static public boolean lt(long x, long y){
280.3392 +		return x < y;
280.3393 +	}
280.3394 +
280.3395 +	static public boolean lte(long x, long y){
280.3396 +		return x <= y;
280.3397 +	}
280.3398 +
280.3399 +	static public boolean gt(long x, long y){
280.3400 +		return x > y;
280.3401 +	}
280.3402 +
280.3403 +	static public boolean gte(long x, long y){
280.3404 +		return x >= y;
280.3405 +	}
280.3406 +
280.3407 +	static public boolean pos(long x){
280.3408 +		return x > 0;
280.3409 +	}
280.3410 +
280.3411 +	static public boolean neg(long x){
280.3412 +		return x < 0;
280.3413 +	}
280.3414 +
280.3415 +	static public boolean zero(long x){
280.3416 +		return x == 0;
280.3417 +	}
280.3418 +
280.3419 +	static public long aget(long[] xs, int i){
280.3420 +		return xs[i];
280.3421 +	}
280.3422 +
280.3423 +	static public long aset(long[] xs, int i, long v){
280.3424 +		xs[i] = v;
280.3425 +		return v;
280.3426 +	}
280.3427 +
280.3428 +	static public int alength(long[] xs){
280.3429 +		return xs.length;
280.3430 +	}
280.3431 +
280.3432 +	static public long[] aclone(long[] xs){
280.3433 +		return xs.clone();
280.3434 +	}
280.3435 +
280.3436 +	static public long[] vec(int size, Object init){
280.3437 +		long[] ret = new long[size];
280.3438 +		if(init instanceof Number)
280.3439 +			{
280.3440 +			long f = ((Number) init).longValue();
280.3441 +			for(int i = 0; i < ret.length; i++)
280.3442 +				ret[i] = f;
280.3443 +			}
280.3444 +		else
280.3445 +			{
280.3446 +			ISeq s = RT.seq(init);
280.3447 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.3448 +				ret[i] = ((Number) s.first()).longValue();
280.3449 +			}
280.3450 +		return ret;
280.3451 +	}
280.3452 +
280.3453 +	static public long[] vec(Object sizeOrSeq){
280.3454 +		if(sizeOrSeq instanceof Number)
280.3455 +			return new long[((Number) sizeOrSeq).intValue()];
280.3456 +		else
280.3457 +			{
280.3458 +			ISeq s = RT.seq(sizeOrSeq);
280.3459 +			int size = s.count();
280.3460 +			long[] ret = new long[size];
280.3461 +			for(int i = 0; i < size && s != null; i++, s = s.rest())
280.3462 +				ret[i] = ((Number) s.first()).intValue();
280.3463 +			return ret;
280.3464 +			}
280.3465 +	}
280.3466 +
280.3467 +
280.3468 +	static public long[] vsadd(long[] x, long y){
280.3469 +		final long[] xs = x.clone();
280.3470 +		for(int i = 0; i < xs.length; i++)
280.3471 +			xs[i] += y;
280.3472 +		return xs;
280.3473 +	}
280.3474 +
280.3475 +	static public long[] vssub(long[] x, long y){
280.3476 +		final long[] xs = x.clone();
280.3477 +		for(int i = 0; i < xs.length; i++)
280.3478 +			xs[i] -= y;
280.3479 +		return xs;
280.3480 +	}
280.3481 +
280.3482 +	static public long[] vsdiv(long[] x, long y){
280.3483 +		final long[] xs = x.clone();
280.3484 +		for(int i = 0; i < xs.length; i++)
280.3485 +			xs[i] /= y;
280.3486 +		return xs;
280.3487 +	}
280.3488 +
280.3489 +	static public long[] vsmul(long[] x, long y){
280.3490 +		final long[] xs = x.clone();
280.3491 +		for(int i = 0; i < xs.length; i++)
280.3492 +			xs[i] *= y;
280.3493 +		return xs;
280.3494 +	}
280.3495 +
280.3496 +	static public long[] svdiv(long y, long[] x){
280.3497 +		final long[] xs = x.clone();
280.3498 +		for(int i = 0; i < xs.length; i++)
280.3499 +			xs[i] = y / xs[i];
280.3500 +		return xs;
280.3501 +	}
280.3502 +
280.3503 +	static public long[] vsmuladd(long[] x, long y, long[] zs){
280.3504 +		final long[] xs = x.clone();
280.3505 +		for(int i = 0; i < xs.length; i++)
280.3506 +			xs[i] = xs[i] * y + zs[i];
280.3507 +		return xs;
280.3508 +	}
280.3509 +
280.3510 +	static public long[] vsmulsub(long[] x, long y, long[] zs){
280.3511 +		final long[] xs = x.clone();
280.3512 +		for(int i = 0; i < xs.length; i++)
280.3513 +			xs[i] = xs[i] * y - zs[i];
280.3514 +		return xs;
280.3515 +	}
280.3516 +
280.3517 +	static public long[] vsmulsadd(long[] x, long y, long z){
280.3518 +		final long[] xs = x.clone();
280.3519 +		for(int i = 0; i < xs.length; i++)
280.3520 +			xs[i] = xs[i] * y + z;
280.3521 +		return xs;
280.3522 +	}
280.3523 +
280.3524 +	static public long[] vsmulssub(long[] x, long y, long z){
280.3525 +		final long[] xs = x.clone();
280.3526 +		for(int i = 0; i < xs.length; i++)
280.3527 +			xs[i] = xs[i] * y - z;
280.3528 +		return xs;
280.3529 +	}
280.3530 +
280.3531 +	static public long[] vabs(long[] x){
280.3532 +		final long[] xs = x.clone();
280.3533 +		for(int i = 0; i < xs.length; i++)
280.3534 +			xs[i] = Math.abs(xs[i]);
280.3535 +		return xs;
280.3536 +	}
280.3537 +
280.3538 +	static public long[] vnegabs(long[] x){
280.3539 +		final long[] xs = x.clone();
280.3540 +		for(int i = 0; i < xs.length; i++)
280.3541 +			xs[i] = -Math.abs(xs[i]);
280.3542 +		return xs;
280.3543 +	}
280.3544 +
280.3545 +	static public long[] vneg(long[] x){
280.3546 +		final long[] xs = x.clone();
280.3547 +		for(int i = 0; i < xs.length; i++)
280.3548 +			xs[i] = -xs[i];
280.3549 +		return xs;
280.3550 +	}
280.3551 +
280.3552 +	static public long[] vsqr(long[] x){
280.3553 +		final long[] xs = x.clone();
280.3554 +		for(int i = 0; i < xs.length; i++)
280.3555 +			xs[i] *= xs[i];
280.3556 +		return xs;
280.3557 +	}
280.3558 +
280.3559 +	static public long[] vsignedsqr(long[] x){
280.3560 +		final long[] xs = x.clone();
280.3561 +		for(int i = 0; i < xs.length; i++)
280.3562 +			xs[i] *= Math.abs(xs[i]);
280.3563 +		return xs;
280.3564 +	}
280.3565 +
280.3566 +	static public long[] vclip(long[] x, long low, long high){
280.3567 +		final long[] xs = x.clone();
280.3568 +		for(int i = 0; i < xs.length; i++)
280.3569 +			{
280.3570 +			if(xs[i] < low)
280.3571 +				xs[i] = low;
280.3572 +			else if(xs[i] > high)
280.3573 +				xs[i] = high;
280.3574 +			}
280.3575 +		return xs;
280.3576 +	}
280.3577 +
280.3578 +	static public IPersistentVector vclipcounts(long[] x, long low, long high){
280.3579 +		final long[] xs = x.clone();
280.3580 +		int lowc = 0;
280.3581 +		int highc = 0;
280.3582 +
280.3583 +		for(int i = 0; i < xs.length; i++)
280.3584 +			{
280.3585 +			if(xs[i] < low)
280.3586 +				{
280.3587 +				++lowc;
280.3588 +				xs[i] = low;
280.3589 +				}
280.3590 +			else if(xs[i] > high)
280.3591 +				{
280.3592 +				++highc;
280.3593 +				xs[i] = high;
280.3594 +				}
280.3595 +			}
280.3596 +		return RT.vector(xs, lowc, highc);
280.3597 +	}
280.3598 +
280.3599 +	static public long[] vthresh(long[] x, long thresh, long otherwise){
280.3600 +		final long[] xs = x.clone();
280.3601 +		for(int i = 0; i < xs.length; i++)
280.3602 +			{
280.3603 +			if(xs[i] < thresh)
280.3604 +				xs[i] = otherwise;
280.3605 +			}
280.3606 +		return xs;
280.3607 +	}
280.3608 +
280.3609 +	static public long[] vreverse(long[] x){
280.3610 +		final long[] xs = x.clone();
280.3611 +		for(int i = 0; i < xs.length; i++)
280.3612 +			xs[i] = xs[xs.length - i - 1];
280.3613 +		return xs;
280.3614 +	}
280.3615 +
280.3616 +	static public long[] vrunningsum(long[] x){
280.3617 +		final long[] xs = x.clone();
280.3618 +		for(int i = 1; i < xs.length; i++)
280.3619 +			xs[i] = xs[i - 1] + xs[i];
280.3620 +		return xs;
280.3621 +	}
280.3622 +
280.3623 +	static public long[] vsort(long[] x){
280.3624 +		final long[] xs = x.clone();
280.3625 +		Arrays.sort(xs);
280.3626 +		return xs;
280.3627 +	}
280.3628 +
280.3629 +	static public long vdot(long[] xs, long[] ys){
280.3630 +		long ret = 0;
280.3631 +		for(int i = 0; i < xs.length; i++)
280.3632 +			ret += xs[i] * ys[i];
280.3633 +		return ret;
280.3634 +	}
280.3635 +
280.3636 +	static public long vmax(long[] xs){
280.3637 +		if(xs.length == 0)
280.3638 +			return 0;
280.3639 +		long ret = xs[0];
280.3640 +		for(int i = 0; i < xs.length; i++)
280.3641 +			ret = Math.max(ret, xs[i]);
280.3642 +		return ret;
280.3643 +	}
280.3644 +
280.3645 +	static public long vmin(long[] xs){
280.3646 +		if(xs.length == 0)
280.3647 +			return 0;
280.3648 +		long ret = xs[0];
280.3649 +		for(int i = 0; i < xs.length; i++)
280.3650 +			ret = Math.min(ret, xs[i]);
280.3651 +		return ret;
280.3652 +	}
280.3653 +
280.3654 +	static public double vmean(long[] xs){
280.3655 +		if(xs.length == 0)
280.3656 +			return 0;
280.3657 +		return vsum(xs) / (double) xs.length;
280.3658 +	}
280.3659 +
280.3660 +	static public double vrms(long[] xs){
280.3661 +		if(xs.length == 0)
280.3662 +			return 0;
280.3663 +		long ret = 0;
280.3664 +		for(int i = 0; i < xs.length; i++)
280.3665 +			ret += xs[i] * xs[i];
280.3666 +		return Math.sqrt(ret / (double) xs.length);
280.3667 +	}
280.3668 +
280.3669 +	static public long vsum(long[] xs){
280.3670 +		long ret = 0;
280.3671 +		for(int i = 0; i < xs.length; i++)
280.3672 +			ret += xs[i];
280.3673 +		return ret;
280.3674 +	}
280.3675 +
280.3676 +	static public boolean vequiv(long[] xs, long[] ys){
280.3677 +		return Arrays.equals(xs, ys);
280.3678 +	}
280.3679 +
280.3680 +	static public long[] vadd(long[] x, long[] ys){
280.3681 +		final long[] xs = x.clone();
280.3682 +		for(int i = 0; i < xs.length; i++)
280.3683 +			xs[i] += ys[i];
280.3684 +		return xs;
280.3685 +	}
280.3686 +
280.3687 +	static public long[] vsub(long[] x, long[] ys){
280.3688 +		final long[] xs = x.clone();
280.3689 +		for(int i = 0; i < xs.length; i++)
280.3690 +			xs[i] -= ys[i];
280.3691 +		return xs;
280.3692 +	}
280.3693 +
280.3694 +	static public long[] vaddmul(long[] x, long[] ys, long[] zs){
280.3695 +		final long[] xs = x.clone();
280.3696 +		for(int i = 0; i < xs.length; i++)
280.3697 +			xs[i] = (xs[i] + ys[i]) * zs[i];
280.3698 +		return xs;
280.3699 +	}
280.3700 +
280.3701 +	static public long[] vsubmul(long[] x, long[] ys, long[] zs){
280.3702 +		final long[] xs = x.clone();
280.3703 +		for(int i = 0; i < xs.length; i++)
280.3704 +			xs[i] = (xs[i] - ys[i]) * zs[i];
280.3705 +		return xs;
280.3706 +	}
280.3707 +
280.3708 +	static public long[] vaddsmul(long[] x, long[] ys, long z){
280.3709 +		final long[] xs = x.clone();
280.3710 +		for(int i = 0; i < xs.length; i++)
280.3711 +			xs[i] = (xs[i] + ys[i]) * z;
280.3712 +		return xs;
280.3713 +	}
280.3714 +
280.3715 +	static public long[] vsubsmul(long[] x, long[] ys, long z){
280.3716 +		final long[] xs = x.clone();
280.3717 +		for(int i = 0; i < xs.length; i++)
280.3718 +			xs[i] = (xs[i] - ys[i]) * z;
280.3719 +		return xs;
280.3720 +	}
280.3721 +
280.3722 +	static public long[] vmulsadd(long[] x, long[] ys, long z){
280.3723 +		final long[] xs = x.clone();
280.3724 +		for(int i = 0; i < xs.length; i++)
280.3725 +			xs[i] = (xs[i] * ys[i]) + z;
280.3726 +		return xs;
280.3727 +	}
280.3728 +
280.3729 +	static public long[] vdiv(long[] x, long[] ys){
280.3730 +		final long[] xs = x.clone();
280.3731 +		for(int i = 0; i < xs.length; i++)
280.3732 +			xs[i] /= ys[i];
280.3733 +		return xs;
280.3734 +	}
280.3735 +
280.3736 +	static public long[] vmul(long[] x, long[] ys){
280.3737 +		final long[] xs = x.clone();
280.3738 +		for(int i = 0; i < xs.length; i++)
280.3739 +			xs[i] *= ys[i];
280.3740 +		return xs;
280.3741 +	}
280.3742 +
280.3743 +	static public long[] vmuladd(long[] x, long[] ys, long[] zs){
280.3744 +		final long[] xs = x.clone();
280.3745 +		for(int i = 0; i < xs.length; i++)
280.3746 +			xs[i] = (xs[i] * ys[i]) + zs[i];
280.3747 +		return xs;
280.3748 +	}
280.3749 +
280.3750 +	static public long[] vmulsub(long[] x, long[] ys, long[] zs){
280.3751 +		final long[] xs = x.clone();
280.3752 +		for(int i = 0; i < xs.length; i++)
280.3753 +			xs[i] = (xs[i] * ys[i]) - zs[i];
280.3754 +		return xs;
280.3755 +	}
280.3756 +
280.3757 +	static public long[] vmax(long[] x, long[] ys){
280.3758 +		final long[] xs = x.clone();
280.3759 +		for(int i = 0; i < xs.length; i++)
280.3760 +			xs[i] = Math.max(xs[i], ys[i]);
280.3761 +		return xs;
280.3762 +	}
280.3763 +
280.3764 +	static public long[] vmin(long[] x, long[] ys){
280.3765 +		final long[] xs = x.clone();
280.3766 +		for(int i = 0; i < xs.length; i++)
280.3767 +			xs[i] = Math.min(xs[i], ys[i]);
280.3768 +		return xs;
280.3769 +	}
280.3770 +
280.3771 +	static public long[] vmap(IFn fn, long[] x) throws Exception{
280.3772 +		long[] xs = x.clone();
280.3773 +		for(int i = 0; i < xs.length; i++)
280.3774 +			xs[i] = ((Number) fn.invoke(xs[i])).longValue();
280.3775 +		return xs;
280.3776 +	}
280.3777 +
280.3778 +	static public long[] vmap(IFn fn, long[] x, long[] ys) throws Exception{
280.3779 +		long[] xs = x.clone();
280.3780 +		for(int i = 0; i < xs.length; i++)
280.3781 +			xs[i] = ((Number) fn.invoke(xs[i], ys[i])).longValue();
280.3782 +		return xs;
280.3783 +	}
280.3784 +
280.3785 +}
280.3786 +*/
280.3787 +
280.3788 +
280.3789 +//overload resolution
280.3790 +
280.3791 +static public Number add(int x, Object y){
280.3792 +	return add((Object)x,y);
280.3793 +}
280.3794 +
280.3795 +static public Number add(Object x, int y){
280.3796 +	return add(x,(Object)y);
280.3797 +}
280.3798 +
280.3799 +static public Number and(int x, Object y){
280.3800 +	return and((Object)x,y);
280.3801 +}
280.3802 +
280.3803 +static public Number and(Object x, int y){
280.3804 +	return and(x,(Object)y);
280.3805 +}
280.3806 +
280.3807 +static public Number or(int x, Object y){
280.3808 +	return or((Object)x,y);
280.3809 +}
280.3810 +
280.3811 +static public Number or(Object x, int y){
280.3812 +	return or(x,(Object)y);
280.3813 +}
280.3814 +
280.3815 +static public Number xor(int x, Object y){
280.3816 +	return xor((Object)x,y);
280.3817 +}
280.3818 +
280.3819 +static public Number xor(Object x, int y){
280.3820 +	return xor(x,(Object)y);
280.3821 +}
280.3822 +
280.3823 +static public Number add(float x, Object y){
280.3824 +	return add((Object)x,y);
280.3825 +}
280.3826 +
280.3827 +static public Number add(Object x, float y){
280.3828 +	return add(x,(Object)y);
280.3829 +}
280.3830 +
280.3831 +static public Number add(long x, Object y){
280.3832 +	return add((Object)x,y);
280.3833 +}
280.3834 +
280.3835 +static public Number add(Object x, long y){
280.3836 +	return add(x,(Object)y);
280.3837 +}
280.3838 +
280.3839 +static public Number add(double x, Object y){
280.3840 +	return add((Object)x,y);
280.3841 +}
280.3842 +
280.3843 +static public Number add(Object x, double y){
280.3844 +	return add(x,(Object)y);
280.3845 +}
280.3846 +
280.3847 +static public Number minus(int x, Object y){
280.3848 +	return minus((Object)x,y);
280.3849 +}
280.3850 +
280.3851 +static public Number minus(Object x, int y){
280.3852 +	return minus(x,(Object)y);
280.3853 +}
280.3854 +
280.3855 +static public Number minus(float x, Object y){
280.3856 +	return minus((Object)x,y);
280.3857 +}
280.3858 +
280.3859 +static public Number minus(Object x, float y){
280.3860 +	return minus(x,(Object)y);
280.3861 +}
280.3862 +
280.3863 +static public Number minus(long x, Object y){
280.3864 +	return minus((Object)x,y);
280.3865 +}
280.3866 +
280.3867 +static public Number minus(Object x, long y){
280.3868 +	return minus(x,(Object)y);
280.3869 +}
280.3870 +
280.3871 +static public Number minus(double x, Object y){
280.3872 +	return minus((Object)x,y);
280.3873 +}
280.3874 +
280.3875 +static public Number minus(Object x, double y){
280.3876 +	return minus(x,(Object)y);
280.3877 +}
280.3878 +
280.3879 +static public Number multiply(int x, Object y){
280.3880 +	return multiply((Object)x,y);
280.3881 +}
280.3882 +
280.3883 +static public Number multiply(Object x, int y){
280.3884 +	return multiply(x,(Object)y);
280.3885 +}
280.3886 +
280.3887 +static public Number multiply(float x, Object y){
280.3888 +	return multiply((Object)x,y);
280.3889 +}
280.3890 +
280.3891 +static public Number multiply(Object x, float y){
280.3892 +	return multiply(x,(Object)y);
280.3893 +}
280.3894 +
280.3895 +static public Number multiply(long x, Object y){
280.3896 +	return multiply((Object)x,y);
280.3897 +}
280.3898 +
280.3899 +static public Number multiply(Object x, long y){
280.3900 +	return multiply(x,(Object)y);
280.3901 +}
280.3902 +
280.3903 +static public Number multiply(double x, Object y){
280.3904 +	return multiply((Object)x,y);
280.3905 +}
280.3906 +
280.3907 +static public Number multiply(Object x, double y){
280.3908 +	return multiply(x,(Object)y);
280.3909 +}
280.3910 +
280.3911 +static public Number divide(int x, Object y){
280.3912 +	return divide((Object)x,y);
280.3913 +}
280.3914 +
280.3915 +static public Number divide(Object x, int y){
280.3916 +	return divide(x,(Object)y);
280.3917 +}
280.3918 +
280.3919 +static public Number divide(float x, Object y){
280.3920 +	return divide((Object)x,y);
280.3921 +}
280.3922 +
280.3923 +static public Number divide(Object x, float y){
280.3924 +	return divide(x,(Object)y);
280.3925 +}
280.3926 +
280.3927 +static public Number divide(long x, Object y){
280.3928 +	return divide((Object)x,y);
280.3929 +}
280.3930 +
280.3931 +static public Number divide(Object x, long y){
280.3932 +	return divide(x,(Object)y);
280.3933 +}
280.3934 +
280.3935 +static public Number divide(double x, Object y){
280.3936 +	return divide((Object)x,y);
280.3937 +}
280.3938 +
280.3939 +static public Number divide(Object x, double y){
280.3940 +	return divide(x,(Object)y);
280.3941 +}
280.3942 +
280.3943 +static public boolean lt(int x, Object y){
280.3944 +	return lt((Object)x,y);
280.3945 +}
280.3946 +
280.3947 +static public boolean lt(Object x, int y){
280.3948 +	return lt(x,(Object)y);
280.3949 +}
280.3950 +
280.3951 +static public boolean lt(float x, Object y){
280.3952 +	return lt((Object)x,y);
280.3953 +}
280.3954 +
280.3955 +static public boolean lt(Object x, float y){
280.3956 +	return lt(x,(Object)y);
280.3957 +}
280.3958 +
280.3959 +static public boolean lt(long x, Object y){
280.3960 +	return lt((Object)x,y);
280.3961 +}
280.3962 +
280.3963 +static public boolean lt(Object x, long y){
280.3964 +	return lt(x,(Object)y);
280.3965 +}
280.3966 +
280.3967 +static public boolean lt(double x, Object y){
280.3968 +	return lt((Object)x,y);
280.3969 +}
280.3970 +
280.3971 +static public boolean lt(Object x, double y){
280.3972 +	return lt(x,(Object)y);
280.3973 +}
280.3974 +
280.3975 +static public boolean lte(int x, Object y){
280.3976 +	return lte((Object)x,y);
280.3977 +}
280.3978 +
280.3979 +static public boolean lte(Object x, int y){
280.3980 +	return lte(x,(Object)y);
280.3981 +}
280.3982 +
280.3983 +static public boolean lte(float x, Object y){
280.3984 +	return lte((Object)x,y);
280.3985 +}
280.3986 +
280.3987 +static public boolean lte(Object x, float y){
280.3988 +	return lte(x,(Object)y);
280.3989 +}
280.3990 +
280.3991 +static public boolean lte(long x, Object y){
280.3992 +	return lte((Object)x,y);
280.3993 +}
280.3994 +
280.3995 +static public boolean lte(Object x, long y){
280.3996 +	return lte(x,(Object)y);
280.3997 +}
280.3998 +
280.3999 +static public boolean lte(double x, Object y){
280.4000 +	return lte((Object)x,y);
280.4001 +}
280.4002 +
280.4003 +static public boolean lte(Object x, double y){
280.4004 +	return lte(x,(Object)y);
280.4005 +}
280.4006 +
280.4007 +static public boolean gt(int x, Object y){
280.4008 +	return gt((Object)x,y);
280.4009 +}
280.4010 +
280.4011 +static public boolean gt(Object x, int y){
280.4012 +	return gt(x,(Object)y);
280.4013 +}
280.4014 +
280.4015 +static public boolean gt(float x, Object y){
280.4016 +	return gt((Object)x,y);
280.4017 +}
280.4018 +
280.4019 +static public boolean gt(Object x, float y){
280.4020 +	return gt(x,(Object)y);
280.4021 +}
280.4022 +
280.4023 +static public boolean gt(long x, Object y){
280.4024 +	return gt((Object)x,y);
280.4025 +}
280.4026 +
280.4027 +static public boolean gt(Object x, long y){
280.4028 +	return gt(x,(Object)y);
280.4029 +}
280.4030 +
280.4031 +static public boolean gt(double x, Object y){
280.4032 +	return gt((Object)x,y);
280.4033 +}
280.4034 +
280.4035 +static public boolean gt(Object x, double y){
280.4036 +	return gt(x,(Object)y);
280.4037 +}
280.4038 +
280.4039 +static public boolean gte(int x, Object y){
280.4040 +	return gte((Object)x,y);
280.4041 +}
280.4042 +
280.4043 +static public boolean gte(Object x, int y){
280.4044 +	return gte(x,(Object)y);
280.4045 +}
280.4046 +
280.4047 +static public boolean gte(float x, Object y){
280.4048 +	return gte((Object)x,y);
280.4049 +}
280.4050 +
280.4051 +static public boolean gte(Object x, float y){
280.4052 +	return gte(x,(Object)y);
280.4053 +}
280.4054 +
280.4055 +static public boolean gte(long x, Object y){
280.4056 +	return gte((Object)x,y);
280.4057 +}
280.4058 +
280.4059 +static public boolean gte(Object x, long y){
280.4060 +	return gte(x,(Object)y);
280.4061 +}
280.4062 +
280.4063 +static public boolean gte(double x, Object y){
280.4064 +	return gte((Object)x,y);
280.4065 +}
280.4066 +
280.4067 +static public boolean gte(Object x, double y){
280.4068 +	return gte(x,(Object)y);
280.4069 +}
280.4070 +
280.4071 +
280.4072 +static public boolean equiv(int x, Object y){
280.4073 +	return equiv((Object)x,y);
280.4074 +}
280.4075 +
280.4076 +static public boolean equiv(Object x, int y){
280.4077 +	return equiv(x,(Object)y);
280.4078 +}
280.4079 +
280.4080 +static public boolean equiv(float x, Object y){
280.4081 +	return equiv((Object)x,y);
280.4082 +}
280.4083 +
280.4084 +static public boolean equiv(Object x, float y){
280.4085 +	return equiv(x,(Object)y);
280.4086 +}
280.4087 +
280.4088 +static public boolean equiv(long x, Object y){
280.4089 +	return equiv((Object)x,y);
280.4090 +}
280.4091 +
280.4092 +static public boolean equiv(Object x, long y){
280.4093 +	return equiv(x,(Object)y);
280.4094 +}
280.4095 +
280.4096 +static public boolean equiv(double x, Object y){
280.4097 +	return equiv((Object)x,y);
280.4098 +}
280.4099 +
280.4100 +static public boolean equiv(Object x, double y){
280.4101 +	return equiv(x,(Object)y);
280.4102 +}
280.4103 +
280.4104 +
280.4105 +static public float add(int x, float y){
280.4106 +	return add((float)x,y);
280.4107 +}
280.4108 +
280.4109 +static public float add(float x, int y){
280.4110 +	return add(x,(float)y);
280.4111 +}
280.4112 +
280.4113 +static public double add(int x, double y){
280.4114 +	return add((double)x,y);
280.4115 +}
280.4116 +
280.4117 +static public double add(double x, int y){
280.4118 +	return add(x,(double)y);
280.4119 +}
280.4120 +
280.4121 +static public long add(int x, long y){
280.4122 +	return add((long)x,y);
280.4123 +}
280.4124 +
280.4125 +static public long add(long x, int y){
280.4126 +	return add(x,(long)y);
280.4127 +}
280.4128 +
280.4129 +static public float add(long x, float y){
280.4130 +	return add((float)x,y);
280.4131 +}
280.4132 +
280.4133 +static public float add(float x, long y){
280.4134 +	return add(x,(float)y);
280.4135 +}
280.4136 +
280.4137 +static public double add(long x, double y){
280.4138 +	return add((double)x,y);
280.4139 +}
280.4140 +
280.4141 +static public double add(double x, long y){
280.4142 +	return add(x,(double)y);
280.4143 +}
280.4144 +
280.4145 +static public double add(float x, double y){
280.4146 +	return add((double)x,y);
280.4147 +}
280.4148 +
280.4149 +static public double add(double x, float y){
280.4150 +	return add(x,(double)y);
280.4151 +}
280.4152 +
280.4153 +static public float minus(int x, float y){
280.4154 +	return minus((float)x,y);
280.4155 +}
280.4156 +
280.4157 +static public float minus(float x, int y){
280.4158 +	return minus(x,(float)y);
280.4159 +}
280.4160 +
280.4161 +static public double minus(int x, double y){
280.4162 +	return minus((double)x,y);
280.4163 +}
280.4164 +
280.4165 +static public double minus(double x, int y){
280.4166 +	return minus(x,(double)y);
280.4167 +}
280.4168 +
280.4169 +static public long minus(int x, long y){
280.4170 +	return minus((long)x,y);
280.4171 +}
280.4172 +
280.4173 +static public long minus(long x, int y){
280.4174 +	return minus(x,(long)y);
280.4175 +}
280.4176 +
280.4177 +static public float minus(long x, float y){
280.4178 +	return minus((float)x,y);
280.4179 +}
280.4180 +
280.4181 +static public float minus(float x, long y){
280.4182 +	return minus(x,(float)y);
280.4183 +}
280.4184 +
280.4185 +static public double minus(long x, double y){
280.4186 +	return minus((double)x,y);
280.4187 +}
280.4188 +
280.4189 +static public double minus(double x, long y){
280.4190 +	return minus(x,(double)y);
280.4191 +}
280.4192 +
280.4193 +static public double minus(float x, double y){
280.4194 +	return minus((double)x,y);
280.4195 +}
280.4196 +
280.4197 +static public double minus(double x, float y){
280.4198 +	return minus(x,(double)y);
280.4199 +}
280.4200 +
280.4201 +static public float multiply(int x, float y){
280.4202 +	return multiply((float)x,y);
280.4203 +}
280.4204 +
280.4205 +static public float multiply(float x, int y){
280.4206 +	return multiply(x,(float)y);
280.4207 +}
280.4208 +
280.4209 +static public double multiply(int x, double y){
280.4210 +	return multiply((double)x,y);
280.4211 +}
280.4212 +
280.4213 +static public double multiply(double x, int y){
280.4214 +	return multiply(x,(double)y);
280.4215 +}
280.4216 +
280.4217 +static public long multiply(int x, long y){
280.4218 +	return multiply((long)x,y);
280.4219 +}
280.4220 +
280.4221 +static public long multiply(long x, int y){
280.4222 +	return multiply(x,(long)y);
280.4223 +}
280.4224 +
280.4225 +static public float multiply(long x, float y){
280.4226 +	return multiply((float)x,y);
280.4227 +}
280.4228 +
280.4229 +static public float multiply(float x, long y){
280.4230 +	return multiply(x,(float)y);
280.4231 +}
280.4232 +
280.4233 +static public double multiply(long x, double y){
280.4234 +	return multiply((double)x,y);
280.4235 +}
280.4236 +
280.4237 +static public double multiply(double x, long y){
280.4238 +	return multiply(x,(double)y);
280.4239 +}
280.4240 +
280.4241 +static public double multiply(float x, double y){
280.4242 +	return multiply((double)x,y);
280.4243 +}
280.4244 +
280.4245 +static public double multiply(double x, float y){
280.4246 +	return multiply(x,(double)y);
280.4247 +}
280.4248 +
280.4249 +static public float divide(int x, float y){
280.4250 +	return divide((float)x,y);
280.4251 +}
280.4252 +
280.4253 +static public float divide(float x, int y){
280.4254 +	return divide(x,(float)y);
280.4255 +}
280.4256 +
280.4257 +static public double divide(int x, double y){
280.4258 +	return divide((double)x,y);
280.4259 +}
280.4260 +
280.4261 +static public double divide(double x, int y){
280.4262 +	return divide(x,(double)y);
280.4263 +}
280.4264 +
280.4265 +static public float divide(long x, float y){
280.4266 +	return divide((float)x,y);
280.4267 +}
280.4268 +
280.4269 +static public float divide(float x, long y){
280.4270 +	return divide(x,(float)y);
280.4271 +}
280.4272 +
280.4273 +static public double divide(long x, double y){
280.4274 +	return divide((double)x,y);
280.4275 +}
280.4276 +
280.4277 +static public double divide(double x, long y){
280.4278 +	return divide(x,(double)y);
280.4279 +}
280.4280 +
280.4281 +static public double divide(float x, double y){
280.4282 +	return divide((double)x,y);
280.4283 +}
280.4284 +
280.4285 +static public double divide(double x, float y){
280.4286 +	return divide(x,(double)y);
280.4287 +}
280.4288 +
280.4289 +static public boolean lt(int x, float y){
280.4290 +	return lt((float)x,y);
280.4291 +}
280.4292 +
280.4293 +static public boolean lt(float x, int y){
280.4294 +	return lt(x,(float)y);
280.4295 +}
280.4296 +
280.4297 +static public boolean lt(int x, double y){
280.4298 +	return lt((double)x,y);
280.4299 +}
280.4300 +
280.4301 +static public boolean lt(double x, int y){
280.4302 +	return lt(x,(double)y);
280.4303 +}
280.4304 +
280.4305 +static public boolean lt(int x, long y){
280.4306 +	return lt((long)x,y);
280.4307 +}
280.4308 +
280.4309 +static public boolean lt(long x, int y){
280.4310 +	return lt(x,(long)y);
280.4311 +}
280.4312 +
280.4313 +static public boolean lt(long x, float y){
280.4314 +	return lt((float)x,y);
280.4315 +}
280.4316 +
280.4317 +static public boolean lt(float x, long y){
280.4318 +	return lt(x,(float)y);
280.4319 +}
280.4320 +
280.4321 +static public boolean lt(long x, double y){
280.4322 +	return lt((double)x,y);
280.4323 +}
280.4324 +
280.4325 +static public boolean lt(double x, long y){
280.4326 +	return lt(x,(double)y);
280.4327 +}
280.4328 +
280.4329 +static public boolean lt(float x, double y){
280.4330 +	return lt((double)x,y);
280.4331 +}
280.4332 +
280.4333 +static public boolean lt(double x, float y){
280.4334 +	return lt(x,(double)y);
280.4335 +}
280.4336 +
280.4337 +
280.4338 +static public boolean lte(int x, float y){
280.4339 +	return lte((float)x,y);
280.4340 +}
280.4341 +
280.4342 +static public boolean lte(float x, int y){
280.4343 +	return lte(x,(float)y);
280.4344 +}
280.4345 +
280.4346 +static public boolean lte(int x, double y){
280.4347 +	return lte((double)x,y);
280.4348 +}
280.4349 +
280.4350 +static public boolean lte(double x, int y){
280.4351 +	return lte(x,(double)y);
280.4352 +}
280.4353 +
280.4354 +static public boolean lte(int x, long y){
280.4355 +	return lte((long)x,y);
280.4356 +}
280.4357 +
280.4358 +static public boolean lte(long x, int y){
280.4359 +	return lte(x,(long)y);
280.4360 +}
280.4361 +
280.4362 +static public boolean lte(long x, float y){
280.4363 +	return lte((float)x,y);
280.4364 +}
280.4365 +
280.4366 +static public boolean lte(float x, long y){
280.4367 +	return lte(x,(float)y);
280.4368 +}
280.4369 +
280.4370 +static public boolean lte(long x, double y){
280.4371 +	return lte((double)x,y);
280.4372 +}
280.4373 +
280.4374 +static public boolean lte(double x, long y){
280.4375 +	return lte(x,(double)y);
280.4376 +}
280.4377 +
280.4378 +static public boolean lte(float x, double y){
280.4379 +	return lte((double)x,y);
280.4380 +}
280.4381 +
280.4382 +static public boolean lte(double x, float y){
280.4383 +	return lte(x,(double)y);
280.4384 +}
280.4385 +
280.4386 +static public boolean gt(int x, float y){
280.4387 +	return gt((float)x,y);
280.4388 +}
280.4389 +
280.4390 +static public boolean gt(float x, int y){
280.4391 +	return gt(x,(float)y);
280.4392 +}
280.4393 +
280.4394 +static public boolean gt(int x, double y){
280.4395 +	return gt((double)x,y);
280.4396 +}
280.4397 +
280.4398 +static public boolean gt(double x, int y){
280.4399 +	return gt(x,(double)y);
280.4400 +}
280.4401 +
280.4402 +static public boolean gt(int x, long y){
280.4403 +	return gt((long)x,y);
280.4404 +}
280.4405 +
280.4406 +static public boolean gt(long x, int y){
280.4407 +	return gt(x,(long)y);
280.4408 +}
280.4409 +
280.4410 +static public boolean gt(long x, float y){
280.4411 +	return gt((float)x,y);
280.4412 +}
280.4413 +
280.4414 +static public boolean gt(float x, long y){
280.4415 +	return gt(x,(float)y);
280.4416 +}
280.4417 +
280.4418 +static public boolean gt(long x, double y){
280.4419 +	return gt((double)x,y);
280.4420 +}
280.4421 +
280.4422 +static public boolean gt(double x, long y){
280.4423 +	return gt(x,(double)y);
280.4424 +}
280.4425 +
280.4426 +static public boolean gt(float x, double y){
280.4427 +	return gt((double)x,y);
280.4428 +}
280.4429 +
280.4430 +static public boolean gt(double x, float y){
280.4431 +	return gt(x,(double)y);
280.4432 +}
280.4433 +
280.4434 +static public boolean gte(int x, float y){
280.4435 +	return gte((float)x,y);
280.4436 +}
280.4437 +
280.4438 +static public boolean gte(float x, int y){
280.4439 +	return gte(x,(float)y);
280.4440 +}
280.4441 +
280.4442 +static public boolean gte(int x, double y){
280.4443 +	return gte((double)x,y);
280.4444 +}
280.4445 +
280.4446 +static public boolean gte(double x, int y){
280.4447 +	return gte(x,(double)y);
280.4448 +}
280.4449 +
280.4450 +static public boolean gte(int x, long y){
280.4451 +	return gte((long)x,y);
280.4452 +}
280.4453 +
280.4454 +static public boolean gte(long x, int y){
280.4455 +	return gte(x,(long)y);
280.4456 +}
280.4457 +
280.4458 +static public boolean gte(long x, float y){
280.4459 +	return gte((float)x,y);
280.4460 +}
280.4461 +
280.4462 +static public boolean gte(float x, long y){
280.4463 +	return gte(x,(float)y);
280.4464 +}
280.4465 +
280.4466 +static public boolean gte(long x, double y){
280.4467 +	return gte((double)x,y);
280.4468 +}
280.4469 +
280.4470 +static public boolean gte(double x, long y){
280.4471 +	return gte(x,(double)y);
280.4472 +}
280.4473 +
280.4474 +static public boolean gte(float x, double y){
280.4475 +	return gte((double)x,y);
280.4476 +}
280.4477 +
280.4478 +static public boolean gte(double x, float y){
280.4479 +	return gte(x,(double)y);
280.4480 +}
280.4481 +
280.4482 +static public boolean equiv(int x, float y){
280.4483 +	return equiv((float)x,y);
280.4484 +}
280.4485 +
280.4486 +static public boolean equiv(float x, int y){
280.4487 +	return equiv(x,(float)y);
280.4488 +}
280.4489 +
280.4490 +static public boolean equiv(int x, double y){
280.4491 +	return equiv((double)x,y);
280.4492 +}
280.4493 +
280.4494 +static public boolean equiv(double x, int y){
280.4495 +	return equiv(x,(double)y);
280.4496 +}
280.4497 +
280.4498 +static public boolean equiv(int x, long y){
280.4499 +	return equiv((long)x,y);
280.4500 +}
280.4501 +
280.4502 +static public boolean equiv(long x, int y){
280.4503 +	return equiv(x,(long)y);
280.4504 +}
280.4505 +
280.4506 +static public boolean equiv(long x, float y){
280.4507 +	return equiv((float)x,y);
280.4508 +}
280.4509 +
280.4510 +static public boolean equiv(float x, long y){
280.4511 +	return equiv(x,(float)y);
280.4512 +}
280.4513 +
280.4514 +static public boolean equiv(long x, double y){
280.4515 +	return equiv((double)x,y);
280.4516 +}
280.4517 +
280.4518 +static public boolean equiv(double x, long y){
280.4519 +	return equiv(x,(double)y);
280.4520 +}
280.4521 +
280.4522 +static public boolean equiv(float x, double y){
280.4523 +	return equiv((double)x,y);
280.4524 +}
280.4525 +
280.4526 +static public boolean equiv(double x, float y){
280.4527 +	return equiv(x,(double)y);
280.4528 +}
280.4529 +
280.4530 +}
   281.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   281.2 +++ b/src/clojure/lang/Obj.java	Sat Aug 21 06:25:44 2010 -0400
   281.3 @@ -0,0 +1,35 @@
   281.4 +/**
   281.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   281.6 + *   The use and distribution terms for this software are covered by the
   281.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   281.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   281.9 + *   By using this software in any fashion, you are agreeing to be bound by
  281.10 + * 	 the terms of this license.
  281.11 + *   You must not remove this notice, or any other, from this software.
  281.12 + **/
  281.13 +
  281.14 +/* rich Mar 25, 2006 3:44:58 PM */
  281.15 +
  281.16 +package clojure.lang;
  281.17 +
  281.18 +import java.io.Serializable;
  281.19 +
  281.20 +public abstract class Obj implements IObj, Serializable {
  281.21 +
  281.22 +final IPersistentMap _meta;
  281.23 +
  281.24 +public Obj(IPersistentMap meta){
  281.25 +	this._meta = meta;
  281.26 +}
  281.27 +
  281.28 +public Obj(){
  281.29 +	_meta = null;
  281.30 +}
  281.31 +
  281.32 +final public IPersistentMap meta(){
  281.33 +	return _meta;
  281.34 +}
  281.35 +
  281.36 +abstract public Obj withMeta(IPersistentMap meta);
  281.37 +
  281.38 +}
   282.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   282.2 +++ b/src/clojure/lang/PersistentArrayMap.java	Sat Aug 21 06:25:44 2010 -0400
   282.3 @@ -0,0 +1,367 @@
   282.4 +/**
   282.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   282.6 + *   The use and distribution terms for this software are covered by the
   282.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   282.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   282.9 + *   By using this software in any fashion, you are agreeing to be bound by
  282.10 + * 	 the terms of this license.
  282.11 + *   You must not remove this notice, or any other, from this software.
  282.12 + **/
  282.13 +
  282.14 +package clojure.lang;
  282.15 +
  282.16 +import java.io.Serializable;
  282.17 +import java.util.Arrays;
  282.18 +import java.util.Iterator;
  282.19 +import java.util.Map;
  282.20 +
  282.21 +/**
  282.22 + * Simple implementation of persistent map on an array
  282.23 + * <p/>
  282.24 + * Note that instances of this class are constant values
  282.25 + * i.e. add/remove etc return new values
  282.26 + * <p/>
  282.27 + * Copies array on every change, so only appropriate for _very_small_ maps
  282.28 + * <p/>
  282.29 + * null keys and values are ok, but you won't be able to distinguish a null value via valAt - use contains/entryAt
  282.30 + */
  282.31 +
  282.32 +public class PersistentArrayMap extends APersistentMap implements IObj, IEditableCollection {
  282.33 +
  282.34 +final Object[] array;
  282.35 +static final int HASHTABLE_THRESHOLD = 16;
  282.36 +
  282.37 +public static final PersistentArrayMap EMPTY = new PersistentArrayMap();
  282.38 +private final IPersistentMap _meta;
  282.39 +
  282.40 +static public IPersistentMap create(Map other){
  282.41 +	ITransientMap ret = EMPTY.asTransient();
  282.42 +	for(Object o : other.entrySet())
  282.43 +		{
  282.44 +		Map.Entry e = (Entry) o;
  282.45 +		ret = ret.assoc(e.getKey(), e.getValue());
  282.46 +		}
  282.47 +	return ret.persistent();
  282.48 +}
  282.49 +
  282.50 +protected PersistentArrayMap(){
  282.51 +	this.array = new Object[]{};
  282.52 +	this._meta = null;
  282.53 +}
  282.54 +
  282.55 +public PersistentArrayMap withMeta(IPersistentMap meta){
  282.56 +	return new PersistentArrayMap(meta, array);
  282.57 +}
  282.58 +
  282.59 +PersistentArrayMap create(Object... init){
  282.60 +	return new PersistentArrayMap(meta(), init);
  282.61 +}
  282.62 +
  282.63 +IPersistentMap createHT(Object[] init){
  282.64 +	return PersistentHashMap.create(meta(), init);
  282.65 +}
  282.66 +
  282.67 +static public PersistentArrayMap createWithCheck(Object[] init){
  282.68 +	for(int i=0;i< init.length;i += 2)
  282.69 +		{
  282.70 +		for(int j=i+2;j<init.length;j += 2)
  282.71 +			{
  282.72 +			if(equalKey(init[i],init[j]))
  282.73 +				throw new IllegalArgumentException("Duplicate key: " + init[i]);
  282.74 +			}
  282.75 +		}
  282.76 +	return new PersistentArrayMap(init);
  282.77 +}
  282.78 +/**
  282.79 + * This ctor captures/aliases the passed array, so do not modify later
  282.80 + *
  282.81 + * @param init {key1,val1,key2,val2,...}
  282.82 + */
  282.83 +public PersistentArrayMap(Object[] init){
  282.84 +	this.array = init;
  282.85 +	this._meta = null;
  282.86 +}
  282.87 +
  282.88 +
  282.89 +public PersistentArrayMap(IPersistentMap meta, Object[] init){
  282.90 +	this._meta = meta;
  282.91 +	this.array = init;
  282.92 +}
  282.93 +
  282.94 +public int count(){
  282.95 +	return array.length / 2;
  282.96 +}
  282.97 +
  282.98 +public boolean containsKey(Object key){
  282.99 +	return indexOf(key) >= 0;
 282.100 +}
 282.101 +
 282.102 +public IMapEntry entryAt(Object key){
 282.103 +	int i = indexOf(key);
 282.104 +	if(i >= 0)
 282.105 +		return new MapEntry(array[i],array[i+1]);
 282.106 +	return null;
 282.107 +}
 282.108 +
 282.109 +public IPersistentMap assocEx(Object key, Object val) throws Exception{
 282.110 +	int i = indexOf(key);
 282.111 +	Object[] newArray;
 282.112 +	if(i >= 0)
 282.113 +		{
 282.114 +		throw new Exception("Key already present");
 282.115 +		}
 282.116 +	else //didn't have key, grow
 282.117 +		{
 282.118 +		if(array.length > HASHTABLE_THRESHOLD)
 282.119 +			return createHT(array).assocEx(key, val);
 282.120 +		newArray = new Object[array.length + 2];
 282.121 +		if(array.length > 0)
 282.122 +			System.arraycopy(array, 0, newArray, 2, array.length);
 282.123 +		newArray[0] = key;
 282.124 +		newArray[1] = val;
 282.125 +		}
 282.126 +	return create(newArray);
 282.127 +}
 282.128 +
 282.129 +public IPersistentMap assoc(Object key, Object val){
 282.130 +	int i = indexOf(key);
 282.131 +	Object[] newArray;
 282.132 +	if(i >= 0) //already have key, same-sized replacement
 282.133 +		{
 282.134 +		if(array[i + 1] == val) //no change, no op
 282.135 +			return this;
 282.136 +		newArray = array.clone();
 282.137 +		newArray[i + 1] = val;
 282.138 +		}
 282.139 +	else //didn't have key, grow
 282.140 +		{
 282.141 +		if(array.length > HASHTABLE_THRESHOLD)
 282.142 +			return createHT(array).assoc(key, val);
 282.143 +		newArray = new Object[array.length + 2];
 282.144 +		if(array.length > 0)
 282.145 +			System.arraycopy(array, 0, newArray, 2, array.length);
 282.146 +		newArray[0] = key;
 282.147 +		newArray[1] = val;
 282.148 +		}
 282.149 +	return create(newArray);
 282.150 +}
 282.151 +
 282.152 +public IPersistentMap without(Object key){
 282.153 +	int i = indexOf(key);
 282.154 +	if(i >= 0) //have key, will remove
 282.155 +		{
 282.156 +		int newlen = array.length - 2;
 282.157 +		if(newlen == 0)
 282.158 +			return empty();
 282.159 +		Object[] newArray = new Object[newlen];
 282.160 +		for(int s = 0, d = 0; s < array.length; s += 2)
 282.161 +			{
 282.162 +			if(!equalKey(array[s], key)) //skip removal key
 282.163 +				{
 282.164 +				newArray[d] = array[s];
 282.165 +				newArray[d + 1] = array[s + 1];
 282.166 +				d += 2;
 282.167 +				}
 282.168 +			}
 282.169 +		return create(newArray);
 282.170 +		}
 282.171 +	//don't have key, no op
 282.172 +	return this;
 282.173 +}
 282.174 +
 282.175 +public IPersistentMap empty(){
 282.176 +	return (IPersistentMap) EMPTY.withMeta(meta());
 282.177 +}
 282.178 +
 282.179 +final public Object valAt(Object key, Object notFound){
 282.180 +	int i = indexOf(key);
 282.181 +	if(i >= 0)
 282.182 +		return array[i + 1];
 282.183 +	return notFound;
 282.184 +}
 282.185 +
 282.186 +public Object valAt(Object key){
 282.187 +	return valAt(key, null);
 282.188 +}
 282.189 +
 282.190 +public int capacity(){
 282.191 +	return count();
 282.192 +}
 282.193 +
 282.194 +private int indexOf(Object key){
 282.195 +	for(int i = 0; i < array.length; i += 2)
 282.196 +		{
 282.197 +		if(equalKey(array[i], key))
 282.198 +			return i;
 282.199 +		}
 282.200 +	return -1;
 282.201 +}
 282.202 +
 282.203 +static boolean equalKey(Object k1, Object k2){
 282.204 +	if(k1 == null)
 282.205 +		return k2 == null;
 282.206 +	return k1.equals(k2);
 282.207 +}
 282.208 +
 282.209 +public Iterator iterator(){
 282.210 +	return new Iter(array);
 282.211 +}
 282.212 +
 282.213 +public ISeq seq(){
 282.214 +	if(array.length > 0)
 282.215 +		return new Seq(array, 0);
 282.216 +	return null;
 282.217 +}
 282.218 +
 282.219 +public IPersistentMap meta(){
 282.220 +	return _meta;
 282.221 +}
 282.222 +
 282.223 +static class Seq extends ASeq implements Counted{
 282.224 +	final Object[] array;
 282.225 +	final int i;
 282.226 +
 282.227 +	Seq(Object[] array, int i){
 282.228 +		this.array = array;
 282.229 +		this.i = i;
 282.230 +	}
 282.231 +
 282.232 +	public Seq(IPersistentMap meta, Object[] array, int i){
 282.233 +		super(meta);
 282.234 +		this.array = array;
 282.235 +		this.i = i;
 282.236 +	}
 282.237 +
 282.238 +	public Object first(){
 282.239 +		return new MapEntry(array[i],array[i+1]);
 282.240 +	}
 282.241 +
 282.242 +	public ISeq next(){
 282.243 +		if(i + 2 < array.length)
 282.244 +			return new Seq(array, i + 2);
 282.245 +		return null;
 282.246 +	}
 282.247 +
 282.248 +	public int count(){
 282.249 +		return (array.length - i) / 2;
 282.250 +	}
 282.251 +
 282.252 +	public Obj withMeta(IPersistentMap meta){
 282.253 +		return new Seq(meta, array, i);
 282.254 +	}
 282.255 +}
 282.256 +
 282.257 +static class Iter implements Iterator{
 282.258 +	Object[] array;
 282.259 +	int i;
 282.260 +
 282.261 +	//for iterator
 282.262 +	Iter(Object[] array){
 282.263 +		this(array, -2);
 282.264 +	}
 282.265 +
 282.266 +	//for entryAt
 282.267 +	Iter(Object[] array, int i){
 282.268 +		this.array = array;
 282.269 +		this.i = i;
 282.270 +	}
 282.271 +
 282.272 +	public boolean hasNext(){
 282.273 +		return i < array.length - 2;
 282.274 +	}
 282.275 +
 282.276 +	public Object next(){
 282.277 +		i += 2;
 282.278 +		return new MapEntry(array[i],array[i+1]);
 282.279 +	}
 282.280 +
 282.281 +	public void remove(){
 282.282 +		throw new UnsupportedOperationException();
 282.283 +	}
 282.284 +
 282.285 +}
 282.286 +
 282.287 +public ITransientMap asTransient(){
 282.288 +	return new TransientArrayMap(array);
 282.289 +}
 282.290 +
 282.291 +static final class TransientArrayMap extends ATransientMap {
 282.292 +	int len;
 282.293 +	final Object[] array;
 282.294 +	Thread owner;
 282.295 +
 282.296 +	public TransientArrayMap(Object[] array){
 282.297 +		this.owner = Thread.currentThread();
 282.298 +		this.array = new Object[Math.max(HASHTABLE_THRESHOLD, array.length)];
 282.299 +		System.arraycopy(array, 0, this.array, 0, array.length);
 282.300 +		this.len = array.length;
 282.301 +	}
 282.302 +	
 282.303 +	private int indexOf(Object key){
 282.304 +		for(int i = 0; i < len; i += 2)
 282.305 +			{
 282.306 +			if(equalKey(array[i], key))
 282.307 +				return i;
 282.308 +			}
 282.309 +		return -1;
 282.310 +	}
 282.311 +
 282.312 +	ITransientMap doAssoc(Object key, Object val){
 282.313 +		int i = indexOf(key);
 282.314 +		if(i >= 0) //already have key,
 282.315 +			{
 282.316 +			if(array[i + 1] != val) //no change, no op
 282.317 +				array[i + 1] = val;
 282.318 +			}
 282.319 +		else //didn't have key, grow
 282.320 +			{
 282.321 +			if(len >= array.length)
 282.322 +				return PersistentHashMap.create(array).asTransient().assoc(key, val);
 282.323 +			array[len++] = key;
 282.324 +			array[len++] = val;
 282.325 +			}
 282.326 +		return this;
 282.327 +	}
 282.328 +
 282.329 +	ITransientMap doWithout(Object key) {
 282.330 +		int i = indexOf(key);
 282.331 +		if(i >= 0) //have key, will remove
 282.332 +			{
 282.333 +			if (len >= 2)
 282.334 +				{
 282.335 +					array[i] = array[len - 2];
 282.336 +					array[i + 1] = array[len - 1];
 282.337 +				}
 282.338 +			len -= 2;
 282.339 +			}
 282.340 +		return this;
 282.341 +	}
 282.342 +
 282.343 +	Object doValAt(Object key, Object notFound) {
 282.344 +		int i = indexOf(key);
 282.345 +		if (i >= 0)
 282.346 +			return array[i + 1];
 282.347 +		return notFound;
 282.348 +	}
 282.349 +
 282.350 +	int doCount() {
 282.351 +		return len / 2;
 282.352 +	}
 282.353 +	
 282.354 +	IPersistentMap doPersistent(){
 282.355 +		ensureEditable();
 282.356 +		owner = null;
 282.357 +		Object[] a = new Object[len];
 282.358 +		System.arraycopy(array,0,a,0,len);
 282.359 +		return new PersistentArrayMap(a);
 282.360 +	}
 282.361 +
 282.362 +	void ensureEditable(){
 282.363 +		if(owner == Thread.currentThread())
 282.364 +			return;
 282.365 +		if(owner != null)
 282.366 +			throw new IllegalAccessError("Transient used by non-owner thread");
 282.367 +		throw new IllegalAccessError("Transient used after persistent! call");
 282.368 +	}
 282.369 +}
 282.370 +}
   283.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   283.2 +++ b/src/clojure/lang/PersistentHashMap.java	Sat Aug 21 06:25:44 2010 -0400
   283.3 @@ -0,0 +1,1054 @@
   283.4 +/**
   283.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   283.6 + *   The use and distribution terms for this software are covered by the
   283.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   283.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   283.9 + *   By using this software in any fashion, you are agreeing to be bound by
  283.10 + * 	 the terms of this license.
  283.11 + *   You must not remove this notice, or any other, from this software.
  283.12 + **/
  283.13 +
  283.14 +package clojure.lang;
  283.15 +
  283.16 +import java.io.Serializable;
  283.17 +import java.util.Iterator;
  283.18 +import java.util.List;
  283.19 +import java.util.Map;
  283.20 +import java.util.concurrent.atomic.AtomicReference;
  283.21 +
  283.22 +/*
  283.23 + A persistent rendition of Phil Bagwell's Hash Array Mapped Trie
  283.24 +
  283.25 + Uses path copying for persistence
  283.26 + HashCollision leaves vs. extended hashing
  283.27 + Node polymorphism vs. conditionals
  283.28 + No sub-tree pools or root-resizing
  283.29 + Any errors are my own
  283.30 + */
  283.31 +
  283.32 +public class PersistentHashMap extends APersistentMap implements IEditableCollection, IObj {
  283.33 +
  283.34 +final int count;
  283.35 +final INode root;
  283.36 +final boolean hasNull;
  283.37 +final Object nullValue;
  283.38 +final IPersistentMap _meta;
  283.39 +
  283.40 +final public static PersistentHashMap EMPTY = new PersistentHashMap(0, null, false, null);
  283.41 +final private static Object NOT_FOUND = new Object();
  283.42 +
  283.43 +static public IPersistentMap create(Map other){
  283.44 +	ITransientMap ret = EMPTY.asTransient();
  283.45 +	for(Object o : other.entrySet())
  283.46 +		{
  283.47 +		Map.Entry e = (Entry) o;
  283.48 +		ret = ret.assoc(e.getKey(), e.getValue());
  283.49 +		}
  283.50 +	return ret.persistent();
  283.51 +}
  283.52 +
  283.53 +/*
  283.54 + * @param init {key1,val1,key2,val2,...}
  283.55 + */
  283.56 +public static PersistentHashMap create(Object... init){
  283.57 +	ITransientMap ret = EMPTY.asTransient();
  283.58 +	for(int i = 0; i < init.length; i += 2)
  283.59 +		{
  283.60 +		ret = ret.assoc(init[i], init[i + 1]);
  283.61 +		}
  283.62 +	return (PersistentHashMap) ret.persistent();
  283.63 +}
  283.64 +
  283.65 +public static PersistentHashMap createWithCheck(Object... init){
  283.66 +	ITransientMap ret = EMPTY.asTransient();
  283.67 +	for(int i = 0; i < init.length; i += 2)
  283.68 +		{
  283.69 +		ret = ret.assoc(init[i], init[i + 1]);
  283.70 +		if(ret.count() != i/2 + 1)
  283.71 +			throw new IllegalArgumentException("Duplicate key: " + init[i]);
  283.72 +		}
  283.73 +	return (PersistentHashMap) ret.persistent();
  283.74 +}
  283.75 +
  283.76 +static public PersistentHashMap create(ISeq items){
  283.77 +	ITransientMap ret = EMPTY.asTransient();
  283.78 +	for(; items != null; items = items.next().next())
  283.79 +		{
  283.80 +		if(items.next() == null)
  283.81 +			throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first()));
  283.82 +		ret = ret.assoc(items.first(), RT.second(items));
  283.83 +		}
  283.84 +	return (PersistentHashMap) ret.persistent();
  283.85 +}
  283.86 +
  283.87 +static public PersistentHashMap createWithCheck(ISeq items){
  283.88 +	ITransientMap ret = EMPTY.asTransient();
  283.89 +	for(int i=0; items != null; items = items.next().next(), ++i)
  283.90 +		{
  283.91 +		if(items.next() == null)
  283.92 +			throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first()));
  283.93 +		ret = ret.assoc(items.first(), RT.second(items));
  283.94 +		if(ret.count() != i + 1)
  283.95 +			throw new IllegalArgumentException("Duplicate key: " + items.first());
  283.96 +		}
  283.97 +	return (PersistentHashMap) ret.persistent();
  283.98 +}
  283.99 +
 283.100 +/*
 283.101 + * @param init {key1,val1,key2,val2,...}
 283.102 + */
 283.103 +public static PersistentHashMap create(IPersistentMap meta, Object... init){
 283.104 +	return create(init).withMeta(meta);
 283.105 +}
 283.106 +
 283.107 +PersistentHashMap(int count, INode root, boolean hasNull, Object nullValue){
 283.108 +	this.count = count;
 283.109 +	this.root = root;
 283.110 +	this.hasNull = hasNull;
 283.111 +	this.nullValue = nullValue;
 283.112 +	this._meta = null;
 283.113 +}
 283.114 +
 283.115 +public PersistentHashMap(IPersistentMap meta, int count, INode root, boolean hasNull, Object nullValue){
 283.116 +	this._meta = meta;
 283.117 +	this.count = count;
 283.118 +	this.root = root;
 283.119 +	this.hasNull = hasNull;
 283.120 +	this.nullValue = nullValue;
 283.121 +}
 283.122 +
 283.123 +public boolean containsKey(Object key){
 283.124 +	if(key == null)
 283.125 +		return hasNull;
 283.126 +	return (root != null) ? root.find(0, Util.hash(key), key, NOT_FOUND) != NOT_FOUND : false;
 283.127 +}
 283.128 +
 283.129 +public IMapEntry entryAt(Object key){
 283.130 +	if(key == null)
 283.131 +		return hasNull ? new MapEntry(null, nullValue) : null;
 283.132 +	return (root != null) ? root.find(0, Util.hash(key), key) : null;
 283.133 +}
 283.134 +
 283.135 +public IPersistentMap assoc(Object key, Object val){
 283.136 +	if(key == null) {
 283.137 +		if(hasNull && val == nullValue)
 283.138 +			return this;
 283.139 +		return new PersistentHashMap(meta(), hasNull ? count : count + 1, root, true, val);
 283.140 +	}
 283.141 +	Box addedLeaf = new Box(null);
 283.142 +	INode newroot = (root == null ? BitmapIndexedNode.EMPTY : root) 
 283.143 +			.assoc(0, Util.hash(key), key, val, addedLeaf);
 283.144 +	if(newroot == root)
 283.145 +		return this;
 283.146 +	return new PersistentHashMap(meta(), addedLeaf.val == null ? count : count + 1, newroot, hasNull, nullValue);
 283.147 +}
 283.148 +
 283.149 +public Object valAt(Object key, Object notFound){
 283.150 +	if(key == null)
 283.151 +		return hasNull ? nullValue : notFound;
 283.152 +	return root != null ? root.find(0, Util.hash(key), key, notFound) : notFound;
 283.153 +}
 283.154 +
 283.155 +public Object valAt(Object key){
 283.156 +	return valAt(key, null);
 283.157 +}
 283.158 +
 283.159 +public IPersistentMap assocEx(Object key, Object val) throws Exception{
 283.160 +	if(containsKey(key))
 283.161 +		throw new Exception("Key already present");
 283.162 +	return assoc(key, val);
 283.163 +}
 283.164 +
 283.165 +public IPersistentMap without(Object key){
 283.166 +	if(key == null)
 283.167 +		return hasNull ? new PersistentHashMap(meta(), count - 1, root, false, null) : this;
 283.168 +	if(root == null)
 283.169 +		return this;
 283.170 +	INode newroot = root.without(0, Util.hash(key), key);
 283.171 +	if(newroot == root)
 283.172 +		return this;
 283.173 +	return new PersistentHashMap(meta(), count - 1, newroot, hasNull, nullValue); 
 283.174 +}
 283.175 +
 283.176 +public Iterator iterator(){
 283.177 +	return new SeqIterator(seq());
 283.178 +}
 283.179 +
 283.180 +public int count(){
 283.181 +	return count;
 283.182 +}
 283.183 +
 283.184 +public ISeq seq(){
 283.185 +	ISeq s = root != null ? root.nodeSeq() : null; 
 283.186 +	return hasNull ? new Cons(new MapEntry(null, nullValue), s) : s;
 283.187 +}
 283.188 +
 283.189 +public IPersistentCollection empty(){
 283.190 +	return EMPTY.withMeta(meta());	
 283.191 +}
 283.192 +
 283.193 +static int mask(int hash, int shift){
 283.194 +	//return ((hash << shift) >>> 27);// & 0x01f;
 283.195 +	return (hash >>> shift) & 0x01f;
 283.196 +}
 283.197 +
 283.198 +public PersistentHashMap withMeta(IPersistentMap meta){
 283.199 +	return new PersistentHashMap(meta, count, root, hasNull, nullValue);
 283.200 +}
 283.201 +
 283.202 +public TransientHashMap asTransient() {
 283.203 +	return new TransientHashMap(this);
 283.204 +}
 283.205 +
 283.206 +public IPersistentMap meta(){
 283.207 +	return _meta;
 283.208 +}
 283.209 +
 283.210 +static final class TransientHashMap extends ATransientMap {
 283.211 +	AtomicReference<Thread> edit;
 283.212 +	INode root;
 283.213 +	int count;
 283.214 +	boolean hasNull;
 283.215 +	Object nullValue;
 283.216 +	final Box leafFlag = new Box(null);
 283.217 +
 283.218 +
 283.219 +	TransientHashMap(PersistentHashMap m) {
 283.220 +		this(new AtomicReference<Thread>(Thread.currentThread()), m.root, m.count, m.hasNull, m.nullValue);
 283.221 +	}
 283.222 +	
 283.223 +	TransientHashMap(AtomicReference<Thread> edit, INode root, int count, boolean hasNull, Object nullValue) {
 283.224 +		this.edit = edit;
 283.225 +		this.root = root; 
 283.226 +		this.count = count; 
 283.227 +		this.hasNull = hasNull;
 283.228 +		this.nullValue = nullValue;
 283.229 +	}
 283.230 +
 283.231 +	ITransientMap doAssoc(Object key, Object val) {
 283.232 +		if (key == null) {
 283.233 +			if (this.nullValue != val)
 283.234 +				this.nullValue = val;
 283.235 +			if (!hasNull) {
 283.236 +				this.count++;
 283.237 +				this.hasNull = true;
 283.238 +			}
 283.239 +			return this;
 283.240 +		}
 283.241 +//		Box leafFlag = new Box(null);
 283.242 +		leafFlag.val = null;
 283.243 +		INode n = (root == null ? BitmapIndexedNode.EMPTY : root)
 283.244 +			.assoc(edit, 0, Util.hash(key), key, val, leafFlag);
 283.245 +		if (n != this.root)
 283.246 +			this.root = n; 
 283.247 +		if(leafFlag.val != null) this.count++;
 283.248 +		return this;
 283.249 +	}
 283.250 +
 283.251 +	ITransientMap doWithout(Object key) {
 283.252 +		if (key == null) {
 283.253 +			if (!hasNull) return this;
 283.254 +			hasNull = false;
 283.255 +			nullValue = null;
 283.256 +			this.count--;
 283.257 +			return this;
 283.258 +		}
 283.259 +		if (root == null) return this;
 283.260 +//		Box leafFlag = new Box(null);
 283.261 +		leafFlag.val = null;
 283.262 +		INode n = root.without(edit, 0, Util.hash(key), key, leafFlag);
 283.263 +		if (n != root)
 283.264 +			this.root = n;
 283.265 +		if(leafFlag.val != null) this.count--;
 283.266 +		return this;
 283.267 +	}
 283.268 +
 283.269 +	IPersistentMap doPersistent() {
 283.270 +		edit.set(null);
 283.271 +		return new PersistentHashMap(count, root, hasNull, nullValue);
 283.272 +	}
 283.273 +
 283.274 +	Object doValAt(Object key, Object notFound) {
 283.275 +		if (key == null)
 283.276 +			if (hasNull)
 283.277 +				return nullValue;
 283.278 +			else
 283.279 +				return notFound;
 283.280 +		if (root == null)
 283.281 +			return null;
 283.282 +		return root.find(0, Util.hash(key), key, notFound);
 283.283 +	}
 283.284 +
 283.285 +	int doCount() {
 283.286 +		return count;
 283.287 +	}
 283.288 +	
 283.289 +	void ensureEditable(){
 283.290 +		Thread owner = edit.get();
 283.291 +		if(owner == Thread.currentThread())
 283.292 +			return;
 283.293 +		if(owner != null)
 283.294 +			throw new IllegalAccessError("Transient used by non-owner thread");
 283.295 +		throw new IllegalAccessError("Transient used after persistent! call");
 283.296 +	}
 283.297 +}
 283.298 +
 283.299 +static interface INode extends Serializable {
 283.300 +	INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf);
 283.301 +
 283.302 +	INode without(int shift, int hash, Object key);
 283.303 +
 283.304 +	IMapEntry find(int shift, int hash, Object key);
 283.305 +
 283.306 +	Object find(int shift, int hash, Object key, Object notFound);
 283.307 +
 283.308 +	ISeq nodeSeq();
 283.309 +
 283.310 +	INode assoc(AtomicReference<Thread> edit, int shift, int hash, Object key, Object val, Box addedLeaf);
 283.311 +
 283.312 +	INode without(AtomicReference<Thread> edit, int shift, int hash, Object key, Box removedLeaf);
 283.313 +}
 283.314 +
 283.315 +final static class ArrayNode implements INode{
 283.316 +	int count;
 283.317 +	final INode[] array;
 283.318 +	final AtomicReference<Thread> edit;
 283.319 +
 283.320 +	ArrayNode(AtomicReference<Thread> edit, int count, INode[] array){
 283.321 +		this.array = array;
 283.322 +		this.edit = edit;
 283.323 +		this.count = count;
 283.324 +	}
 283.325 +
 283.326 +	public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){
 283.327 +		int idx = mask(hash, shift);
 283.328 +		INode node = array[idx];
 283.329 +		if(node == null)
 283.330 +			return new ArrayNode(null, count + 1, cloneAndSet(array, idx, BitmapIndexedNode.EMPTY.assoc(shift + 5, hash, key, val, addedLeaf)));			
 283.331 +		INode n = node.assoc(shift + 5, hash, key, val, addedLeaf);
 283.332 +		if(n == node)
 283.333 +			return this;
 283.334 +		return new ArrayNode(null, count, cloneAndSet(array, idx, n));
 283.335 +	}
 283.336 +
 283.337 +	public INode without(int shift, int hash, Object key){
 283.338 +		int idx = mask(hash, shift);
 283.339 +		INode node = array[idx];
 283.340 +		if(node == null)
 283.341 +			return this;
 283.342 +		INode n = node.without(shift + 5, hash, key);
 283.343 +		if(n == node)
 283.344 +			return this;
 283.345 +		if (n == null) {
 283.346 +			if (count <= 8) // shrink
 283.347 +				return pack(null, idx);
 283.348 +			return new ArrayNode(null, count - 1, cloneAndSet(array, idx, n));
 283.349 +		} else 
 283.350 +			return new ArrayNode(null, count, cloneAndSet(array, idx, n));
 283.351 +	}
 283.352 +
 283.353 +	public IMapEntry find(int shift, int hash, Object key){
 283.354 +		int idx = mask(hash, shift);
 283.355 +		INode node = array[idx];
 283.356 +		if(node == null)
 283.357 +			return null;
 283.358 +		return node.find(shift + 5, hash, key); 
 283.359 +	}
 283.360 +
 283.361 +	public Object find(int shift, int hash, Object key, Object notFound){
 283.362 +		int idx = mask(hash, shift);
 283.363 +		INode node = array[idx];
 283.364 +		if(node == null)
 283.365 +			return notFound;
 283.366 +		return node.find(shift + 5, hash, key, notFound); 
 283.367 +	}
 283.368 +	
 283.369 +	public ISeq nodeSeq(){
 283.370 +		return Seq.create(array);
 283.371 +	}
 283.372 +
 283.373 +	private ArrayNode ensureEditable(AtomicReference<Thread> edit){
 283.374 +		if(this.edit == edit)
 283.375 +			return this;
 283.376 +		return new ArrayNode(edit, count, this.array.clone());
 283.377 +	}
 283.378 +	
 283.379 +	private ArrayNode editAndSet(AtomicReference<Thread> edit, int i, INode n){
 283.380 +		ArrayNode editable = ensureEditable(edit);
 283.381 +		editable.array[i] = n;
 283.382 +		return editable;
 283.383 +	}
 283.384 +
 283.385 +
 283.386 +	private INode pack(AtomicReference<Thread> edit, int idx) {
 283.387 +		Object[] newArray = new Object[2*(count - 1)];
 283.388 +		int j = 1;
 283.389 +		int bitmap = 0;
 283.390 +		for(int i = 0; i < idx; i++)
 283.391 +			if (array[i] != null) {
 283.392 +				newArray[j] = array[i];
 283.393 +				bitmap |= 1 << i;
 283.394 +				j += 2;
 283.395 +			}
 283.396 +		for(int i = idx + 1; i < array.length; i++)
 283.397 +			if (array[i] != null) {
 283.398 +				newArray[j] = array[i];
 283.399 +				bitmap |= 1 << i;
 283.400 +				j += 2;
 283.401 +			}
 283.402 +		return new BitmapIndexedNode(edit, bitmap, newArray);
 283.403 +	}
 283.404 +
 283.405 +	public INode assoc(AtomicReference<Thread> edit, int shift, int hash, Object key, Object val, Box addedLeaf){
 283.406 +		int idx = mask(hash, shift);
 283.407 +		INode node = array[idx];
 283.408 +		if(node == null) {
 283.409 +			ArrayNode editable = editAndSet(edit, idx, BitmapIndexedNode.EMPTY.assoc(edit, shift + 5, hash, key, val, addedLeaf));
 283.410 +			editable.count++;
 283.411 +			return editable;			
 283.412 +		}
 283.413 +		INode n = node.assoc(edit, shift + 5, hash, key, val, addedLeaf);
 283.414 +		if(n == node)
 283.415 +			return this;
 283.416 +		return editAndSet(edit, idx, n);
 283.417 +	}	
 283.418 +
 283.419 +	public INode without(AtomicReference<Thread> edit, int shift, int hash, Object key, Box removedLeaf){
 283.420 +		int idx = mask(hash, shift);
 283.421 +		INode node = array[idx];
 283.422 +		if(node == null)
 283.423 +			return this;
 283.424 +		INode n = node.without(edit, shift + 5, hash, key, removedLeaf);
 283.425 +		if(n == node)
 283.426 +			return this;
 283.427 +		if(n == null) {
 283.428 +			if (count <= 8) // shrink
 283.429 +				return pack(edit, idx);
 283.430 +			ArrayNode editable = editAndSet(edit, idx, n);
 283.431 +			editable.count--;
 283.432 +			return editable;
 283.433 +		}
 283.434 +		return editAndSet(edit, idx, n);
 283.435 +	}
 283.436 +	
 283.437 +	static class Seq extends ASeq {
 283.438 +		final INode[] nodes;
 283.439 +		final int i;
 283.440 +		final ISeq s; 
 283.441 +		
 283.442 +		static ISeq create(INode[] nodes) {
 283.443 +			return create(null, nodes, 0, null);
 283.444 +		}
 283.445 +		
 283.446 +		private static ISeq create(IPersistentMap meta, INode[] nodes, int i, ISeq s) {
 283.447 +			if (s != null)
 283.448 +				return new Seq(meta, nodes, i, s);
 283.449 +			for(int j = i; j < nodes.length; j++)
 283.450 +				if (nodes[j] != null) {
 283.451 +					ISeq ns = nodes[j].nodeSeq();
 283.452 +					if (ns != null)
 283.453 +						return new Seq(meta, nodes, j + 1, ns);
 283.454 +				}
 283.455 +			return null;
 283.456 +		}
 283.457 +		
 283.458 +		private Seq(IPersistentMap meta, INode[] nodes, int i, ISeq s) {
 283.459 +			super(meta);
 283.460 +			this.nodes = nodes;
 283.461 +			this.i = i;
 283.462 +			this.s = s;
 283.463 +		}
 283.464 +
 283.465 +		public Obj withMeta(IPersistentMap meta) {
 283.466 +			return new Seq(meta, nodes, i, s);
 283.467 +		}
 283.468 +
 283.469 +		public Object first() {
 283.470 +			return s.first();
 283.471 +		}
 283.472 +
 283.473 +		public ISeq next() {
 283.474 +			return create(null, nodes, i, s.next());
 283.475 +		}
 283.476 +		
 283.477 +	}
 283.478 +}
 283.479 +
 283.480 +final static class BitmapIndexedNode implements INode{
 283.481 +	static final BitmapIndexedNode EMPTY = new BitmapIndexedNode(null, 0, new Object[0]);
 283.482 +	
 283.483 +	int bitmap;
 283.484 +	Object[] array;
 283.485 +	final AtomicReference<Thread> edit;
 283.486 +
 283.487 +	final int index(int bit){
 283.488 +		return Integer.bitCount(bitmap & (bit - 1));
 283.489 +	}
 283.490 +
 283.491 +	BitmapIndexedNode(AtomicReference<Thread> edit, int bitmap, Object[] array){
 283.492 +		this.bitmap = bitmap;
 283.493 +		this.array = array;
 283.494 +		this.edit = edit;
 283.495 +	}
 283.496 +
 283.497 +	public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){
 283.498 +		int bit = bitpos(hash, shift);
 283.499 +		int idx = index(bit);
 283.500 +		if((bitmap & bit) != 0) {
 283.501 +			Object keyOrNull = array[2*idx];
 283.502 +			Object valOrNode = array[2*idx+1];
 283.503 +			if(keyOrNull == null) {
 283.504 +				INode n = ((INode) valOrNode).assoc(shift + 5, hash, key, val, addedLeaf);
 283.505 +				if(n == valOrNode)
 283.506 +					return this;
 283.507 +				return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, n));
 283.508 +			} 
 283.509 +			if(Util.equals(key, keyOrNull)) {
 283.510 +				if(val == valOrNode)
 283.511 +					return this;
 283.512 +				return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, val));
 283.513 +			} 
 283.514 +			addedLeaf.val = addedLeaf;
 283.515 +			return new BitmapIndexedNode(null, bitmap, 
 283.516 +					cloneAndSet(array, 
 283.517 +							2*idx, null, 
 283.518 +							2*idx+1, createNode(shift + 5, keyOrNull, valOrNode, hash, key, val)));
 283.519 +		} else {
 283.520 +			int n = Integer.bitCount(bitmap);
 283.521 +			if(n >= 16) {
 283.522 +				INode[] nodes = new INode[32];
 283.523 +				int jdx = mask(hash, shift);
 283.524 +				nodes[jdx] = EMPTY.assoc(shift + 5, hash, key, val, addedLeaf);  
 283.525 +				int j = 0;
 283.526 +				for(int i = 0; i < 32; i++)
 283.527 +					if(((bitmap >>> i) & 1) != 0) {
 283.528 +						if (array[j] == null)
 283.529 +							nodes[i] = (INode) array[j+1];
 283.530 +						else
 283.531 +							nodes[i] = EMPTY.assoc(shift + 5, Util.hash(array[j]), array[j], array[j+1], addedLeaf);
 283.532 +						j += 2;
 283.533 +					}
 283.534 +				return new ArrayNode(null, n + 1, nodes);
 283.535 +			} else {
 283.536 +				Object[] newArray = new Object[2*(n+1)];
 283.537 +				System.arraycopy(array, 0, newArray, 0, 2*idx);
 283.538 +				newArray[2*idx] = key;
 283.539 +				addedLeaf.val = addedLeaf; 
 283.540 +				newArray[2*idx+1] = val;
 283.541 +				System.arraycopy(array, 2*idx, newArray, 2*(idx+1), 2*(n-idx));
 283.542 +				return new BitmapIndexedNode(null, bitmap | bit, newArray);
 283.543 +			}
 283.544 +		}
 283.545 +	}
 283.546 +
 283.547 +	public INode without(int shift, int hash, Object key){
 283.548 +		int bit = bitpos(hash, shift);
 283.549 +		if((bitmap & bit) == 0)
 283.550 +			return this;
 283.551 +		int idx = index(bit);
 283.552 +		Object keyOrNull = array[2*idx];
 283.553 +		Object valOrNode = array[2*idx+1];
 283.554 +		if(keyOrNull == null) {
 283.555 +			INode n = ((INode) valOrNode).without(shift + 5, hash, key);
 283.556 +			if (n == valOrNode)
 283.557 +				return this;
 283.558 +			if (n != null)
 283.559 +				return new BitmapIndexedNode(null, bitmap, cloneAndSet(array, 2*idx+1, n));
 283.560 +			if (bitmap == bit) 
 283.561 +				return null;
 283.562 +			return new BitmapIndexedNode(null, bitmap ^ bit, removePair(array, idx));
 283.563 +		}
 283.564 +		if(Util.equals(key, keyOrNull))
 283.565 +			// TODO: collapse
 283.566 +			return new BitmapIndexedNode(null, bitmap ^ bit, removePair(array, idx));
 283.567 +		return this;
 283.568 +	}
 283.569 +	
 283.570 +	public IMapEntry find(int shift, int hash, Object key){
 283.571 +		int bit = bitpos(hash, shift);
 283.572 +		if((bitmap & bit) == 0)
 283.573 +			return null;
 283.574 +		int idx = index(bit);
 283.575 +		Object keyOrNull = array[2*idx];
 283.576 +		Object valOrNode = array[2*idx+1];
 283.577 +		if(keyOrNull == null)
 283.578 +			return ((INode) valOrNode).find(shift + 5, hash, key);
 283.579 +		if(Util.equals(key, keyOrNull))
 283.580 +			return new MapEntry(keyOrNull, valOrNode);
 283.581 +		return null;
 283.582 +	}
 283.583 +
 283.584 +	public Object find(int shift, int hash, Object key, Object notFound){
 283.585 +		int bit = bitpos(hash, shift);
 283.586 +		if((bitmap & bit) == 0)
 283.587 +			return notFound;
 283.588 +		int idx = index(bit);
 283.589 +		Object keyOrNull = array[2*idx];
 283.590 +		Object valOrNode = array[2*idx+1];
 283.591 +		if(keyOrNull == null)
 283.592 +			return ((INode) valOrNode).find(shift + 5, hash, key, notFound);
 283.593 +		if(Util.equals(key, keyOrNull))
 283.594 +			return valOrNode;
 283.595 +		return notFound;
 283.596 +	}
 283.597 +
 283.598 +	public ISeq nodeSeq(){
 283.599 +		return NodeSeq.create(array);
 283.600 +	}
 283.601 +
 283.602 +	private BitmapIndexedNode ensureEditable(AtomicReference<Thread> edit){
 283.603 +		if(this.edit == edit)
 283.604 +			return this;
 283.605 +		int n = Integer.bitCount(bitmap);
 283.606 +		Object[] newArray = new Object[n >= 0 ? 2*(n+1) : 4]; // make room for next assoc
 283.607 +		System.arraycopy(array, 0, newArray, 0, 2*n);
 283.608 +		return new BitmapIndexedNode(edit, bitmap, newArray);
 283.609 +	}
 283.610 +	
 283.611 +	private BitmapIndexedNode editAndSet(AtomicReference<Thread> edit, int i, Object a) {
 283.612 +		BitmapIndexedNode editable = ensureEditable(edit);
 283.613 +		editable.array[i] = a;
 283.614 +		return editable;
 283.615 +	}
 283.616 +
 283.617 +	private BitmapIndexedNode editAndSet(AtomicReference<Thread> edit, int i, Object a, int j, Object b) {
 283.618 +		BitmapIndexedNode editable = ensureEditable(edit);
 283.619 +		editable.array[i] = a;
 283.620 +		editable.array[j] = b;
 283.621 +		return editable;
 283.622 +	}
 283.623 +
 283.624 +	private BitmapIndexedNode editAndRemovePair(AtomicReference<Thread> edit, int bit, int i) {
 283.625 +		if (bitmap == bit) 
 283.626 +			return null;
 283.627 +		BitmapIndexedNode editable = ensureEditable(edit);
 283.628 +		editable.bitmap ^= bit;
 283.629 +		System.arraycopy(editable.array, 2*(i+1), editable.array, 2*i, editable.array.length - 2*(i+1));
 283.630 +		editable.array[editable.array.length - 2] = null;
 283.631 +		editable.array[editable.array.length - 1] = null;
 283.632 +		return editable;
 283.633 +	}
 283.634 +
 283.635 +	public INode assoc(AtomicReference<Thread> edit, int shift, int hash, Object key, Object val, Box addedLeaf){
 283.636 +		int bit = bitpos(hash, shift);
 283.637 +		int idx = index(bit);
 283.638 +		if((bitmap & bit) != 0) {
 283.639 +			Object keyOrNull = array[2*idx];
 283.640 +			Object valOrNode = array[2*idx+1];
 283.641 +			if(keyOrNull == null) {
 283.642 +				INode n = ((INode) valOrNode).assoc(edit, shift + 5, hash, key, val, addedLeaf);
 283.643 +				if(n == valOrNode)
 283.644 +					return this;
 283.645 +				return editAndSet(edit, 2*idx+1, n);
 283.646 +			} 
 283.647 +			if(Util.equals(key, keyOrNull)) {
 283.648 +				if(val == valOrNode)
 283.649 +					return this;
 283.650 +				return editAndSet(edit, 2*idx+1, val);
 283.651 +			} 
 283.652 +			addedLeaf.val = addedLeaf;
 283.653 +			return editAndSet(edit, 2*idx, null, 2*idx+1, 
 283.654 +					createNode(edit, shift + 5, keyOrNull, valOrNode, hash, key, val)); 
 283.655 +		} else {
 283.656 +			int n = Integer.bitCount(bitmap);
 283.657 +			if(n*2 < array.length) {
 283.658 +				addedLeaf.val = addedLeaf;
 283.659 +				BitmapIndexedNode editable = ensureEditable(edit);
 283.660 +				System.arraycopy(editable.array, 2*idx, editable.array, 2*(idx+1), 2*(n-idx));
 283.661 +				editable.array[2*idx] = key;
 283.662 +				editable.array[2*idx+1] = val;
 283.663 +				editable.bitmap |= bit;
 283.664 +				return editable;
 283.665 +			}
 283.666 +			if(n >= 16) {
 283.667 +				INode[] nodes = new INode[32];
 283.668 +				int jdx = mask(hash, shift);
 283.669 +				nodes[jdx] = EMPTY.assoc(edit, shift + 5, hash, key, val, addedLeaf);  
 283.670 +				int j = 0;
 283.671 +				for(int i = 0; i < 32; i++)
 283.672 +					if(((bitmap >>> i) & 1) != 0) {
 283.673 +						if (array[j] == null)
 283.674 +							nodes[i] = (INode) array[j+1];
 283.675 +						else
 283.676 +							nodes[i] = EMPTY.assoc(edit, shift + 5, Util.hash(array[j]), array[j], array[j+1], addedLeaf);
 283.677 +						j += 2;
 283.678 +					}
 283.679 +				return new ArrayNode(edit, n + 1, nodes);
 283.680 +			} else {
 283.681 +				Object[] newArray = new Object[2*(n+4)];
 283.682 +				System.arraycopy(array, 0, newArray, 0, 2*idx);
 283.683 +				newArray[2*idx] = key;
 283.684 +				addedLeaf.val = addedLeaf; 
 283.685 +				newArray[2*idx+1] = val;
 283.686 +				System.arraycopy(array, 2*idx, newArray, 2*(idx+1), 2*(n-idx));
 283.687 +				BitmapIndexedNode editable = ensureEditable(edit);
 283.688 +				editable.array = newArray;
 283.689 +				editable.bitmap |= bit;
 283.690 +				return editable;
 283.691 +			}
 283.692 +		}
 283.693 +	}
 283.694 +
 283.695 +	public INode without(AtomicReference<Thread> edit, int shift, int hash, Object key, Box removedLeaf){
 283.696 +		int bit = bitpos(hash, shift);
 283.697 +		if((bitmap & bit) == 0)
 283.698 +			return this;
 283.699 +		int idx = index(bit);
 283.700 +		Object keyOrNull = array[2*idx];
 283.701 +		Object valOrNode = array[2*idx+1];
 283.702 +		if(keyOrNull == null) {
 283.703 +			INode n = ((INode) valOrNode).without(edit, shift + 5, hash, key, removedLeaf);
 283.704 +			if (n == valOrNode)
 283.705 +				return this;
 283.706 +			if (n != null)
 283.707 +				return editAndSet(edit, 2*idx+1, n); 
 283.708 +			if (bitmap == bit) 
 283.709 +				return null;
 283.710 +			removedLeaf.val = removedLeaf;
 283.711 +			return editAndRemovePair(edit, bit, idx); 
 283.712 +		}
 283.713 +		if(Util.equals(key, keyOrNull)) {
 283.714 +			removedLeaf.val = removedLeaf;
 283.715 +			// TODO: collapse
 283.716 +			return editAndRemovePair(edit, bit, idx); 			
 283.717 +		}
 283.718 +		return this;
 283.719 +	}
 283.720 +}
 283.721 +
 283.722 +final static class HashCollisionNode implements INode{
 283.723 +
 283.724 +	final int hash;
 283.725 +	int count;
 283.726 +	Object[] array;
 283.727 +	final AtomicReference<Thread> edit;
 283.728 +
 283.729 +	HashCollisionNode(AtomicReference<Thread> edit, int hash, int count, Object... array){
 283.730 +		this.edit = edit;
 283.731 +		this.hash = hash;
 283.732 +		this.count = count;
 283.733 +		this.array = array;
 283.734 +	}
 283.735 +
 283.736 +	public INode assoc(int shift, int hash, Object key, Object val, Box addedLeaf){
 283.737 +		if(hash == this.hash) {
 283.738 +			int idx = findIndex(key);
 283.739 +			if(idx != -1) {
 283.740 +				if(array[idx + 1] == val)
 283.741 +					return this;
 283.742 +				return new HashCollisionNode(null, hash, count, cloneAndSet(array, idx + 1, val));
 283.743 +			}
 283.744 +			Object[] newArray = new Object[array.length + 2];
 283.745 +			System.arraycopy(array, 0, newArray, 0, array.length);
 283.746 +			newArray[array.length] = key;
 283.747 +			newArray[array.length + 1] = val;
 283.748 +			addedLeaf.val = addedLeaf;
 283.749 +			return new HashCollisionNode(edit, hash, count + 1, newArray);
 283.750 +		}
 283.751 +		// nest it in a bitmap node
 283.752 +		return new BitmapIndexedNode(null, bitpos(this.hash, shift), new Object[] {null, this})
 283.753 +			.assoc(shift, hash, key, val, addedLeaf);
 283.754 +	}
 283.755 +
 283.756 +	public INode without(int shift, int hash, Object key){
 283.757 +		int idx = findIndex(key);
 283.758 +		if(idx == -1)
 283.759 +			return this;
 283.760 +		if(count == 1)
 283.761 +			return null;
 283.762 +		return new HashCollisionNode(null, hash, count - 1, removePair(array, idx/2));
 283.763 +	}
 283.764 +
 283.765 +	public IMapEntry find(int shift, int hash, Object key){
 283.766 +		int idx = findIndex(key);
 283.767 +		if(idx < 0)
 283.768 +			return null;
 283.769 +		if(Util.equals(key, array[idx]))
 283.770 +			return new MapEntry(array[idx], array[idx+1]);
 283.771 +		return null;
 283.772 +	}
 283.773 +
 283.774 +	public Object find(int shift, int hash, Object key, Object notFound){
 283.775 +		int idx = findIndex(key);
 283.776 +		if(idx < 0)
 283.777 +			return notFound;
 283.778 +		if(Util.equals(key, array[idx]))
 283.779 +			return array[idx+1];
 283.780 +		return notFound;
 283.781 +	}
 283.782 +
 283.783 +	public ISeq nodeSeq(){
 283.784 +		return NodeSeq.create(array);
 283.785 +	}
 283.786 +
 283.787 +	public int findIndex(Object key){
 283.788 +		for(int i = 0; i < 2*count; i+=2)
 283.789 +			{
 283.790 +			if(Util.equals(key, array[i]))
 283.791 +				return i;
 283.792 +			}
 283.793 +		return -1;
 283.794 +	}
 283.795 +
 283.796 +	private HashCollisionNode ensureEditable(AtomicReference<Thread> edit){
 283.797 +		if(this.edit == edit)
 283.798 +			return this;
 283.799 +		return new HashCollisionNode(edit, hash, count, array);
 283.800 +	}
 283.801 +
 283.802 +	private HashCollisionNode ensureEditable(AtomicReference<Thread> edit, int count, Object[] array){
 283.803 +		if(this.edit == edit) {
 283.804 +			this.array = array;
 283.805 +			this.count = count;
 283.806 +			return this;
 283.807 +		}
 283.808 +		return new HashCollisionNode(edit, hash, count, array);
 283.809 +	}
 283.810 +
 283.811 +	private HashCollisionNode editAndSet(AtomicReference<Thread> edit, int i, Object a) {
 283.812 +		HashCollisionNode editable = ensureEditable(edit);
 283.813 +		editable.array[i] = a;
 283.814 +		return editable;
 283.815 +	}
 283.816 +
 283.817 +	private HashCollisionNode editAndSet(AtomicReference<Thread> edit, int i, Object a, int j, Object b) {
 283.818 +		HashCollisionNode editable = ensureEditable(edit);
 283.819 +		editable.array[i] = a;
 283.820 +		editable.array[j] = b;
 283.821 +		return editable;
 283.822 +	}
 283.823 +
 283.824 +
 283.825 +	public INode assoc(AtomicReference<Thread> edit, int shift, int hash, Object key, Object val, Box addedLeaf){
 283.826 +		if(hash == this.hash) {
 283.827 +			int idx = findIndex(key);
 283.828 +			if(idx != -1) {
 283.829 +				if(array[idx + 1] == val)
 283.830 +					return this;
 283.831 +				return editAndSet(edit, idx+1, val); 
 283.832 +			}
 283.833 +			if (array.length > 2*count) {
 283.834 +				addedLeaf.val = addedLeaf;
 283.835 +				HashCollisionNode editable = editAndSet(edit, 2*count, key, 2*count+1, val);
 283.836 +				editable.count++;
 283.837 +				return editable;
 283.838 +			}
 283.839 +			Object[] newArray = new Object[array.length + 2];
 283.840 +			System.arraycopy(array, 0, newArray, 0, array.length);
 283.841 +			newArray[array.length] = key;
 283.842 +			newArray[array.length + 1] = val;
 283.843 +			addedLeaf.val = addedLeaf;
 283.844 +			return ensureEditable(edit, count + 1, newArray);
 283.845 +		}
 283.846 +		// nest it in a bitmap node
 283.847 +		return new BitmapIndexedNode(edit, bitpos(this.hash, shift), new Object[] {null, this, null, null})
 283.848 +			.assoc(edit, shift, hash, key, val, addedLeaf);
 283.849 +	}	
 283.850 +
 283.851 +	public INode without(AtomicReference<Thread> edit, int shift, int hash, Object key, Box removedLeaf){
 283.852 +		int idx = findIndex(key);
 283.853 +		if(idx == -1)
 283.854 +			return this;
 283.855 +		if(count == 1)
 283.856 +			return null;
 283.857 +		HashCollisionNode editable = ensureEditable(edit);
 283.858 +		editable.array[idx] = editable.array[2*count-2];
 283.859 +		editable.array[idx+1] = editable.array[2*count-1];
 283.860 +		editable.array[2*count-2] = editable.array[2*count-1] = null;
 283.861 +		editable.count--;
 283.862 +		return editable;
 283.863 +	}
 283.864 +}
 283.865 +
 283.866 +/*
 283.867 +public static void main(String[] args){
 283.868 +	try
 283.869 +		{
 283.870 +		ArrayList words = new ArrayList();
 283.871 +		Scanner s = new Scanner(new File(args[0]));
 283.872 +		s.useDelimiter(Pattern.compile("\\W"));
 283.873 +		while(s.hasNext())
 283.874 +			{
 283.875 +			String word = s.next();
 283.876 +			words.add(word);
 283.877 +			}
 283.878 +		System.out.println("words: " + words.size());
 283.879 +		IPersistentMap map = PersistentHashMap.EMPTY;
 283.880 +		//IPersistentMap map = new PersistentTreeMap();
 283.881 +		//Map ht = new Hashtable();
 283.882 +		Map ht = new HashMap();
 283.883 +		Random rand;
 283.884 +
 283.885 +		System.out.println("Building map");
 283.886 +		long startTime = System.nanoTime();
 283.887 +		for(Object word5 : words)
 283.888 +			{
 283.889 +			map = map.assoc(word5, word5);
 283.890 +			}
 283.891 +		rand = new Random(42);
 283.892 +		IPersistentMap snapshotMap = map;
 283.893 +		for(int i = 0; i < words.size() / 200; i++)
 283.894 +			{
 283.895 +			map = map.without(words.get(rand.nextInt(words.size() / 2)));
 283.896 +			}
 283.897 +		long estimatedTime = System.nanoTime() - startTime;
 283.898 +		System.out.println("count = " + map.count() + ", time: " + estimatedTime / 1000000);
 283.899 +
 283.900 +		System.out.println("Building ht");
 283.901 +		startTime = System.nanoTime();
 283.902 +		for(Object word1 : words)
 283.903 +			{
 283.904 +			ht.put(word1, word1);
 283.905 +			}
 283.906 +		rand = new Random(42);
 283.907 +		for(int i = 0; i < words.size() / 200; i++)
 283.908 +			{
 283.909 +			ht.remove(words.get(rand.nextInt(words.size() / 2)));
 283.910 +			}
 283.911 +		estimatedTime = System.nanoTime() - startTime;
 283.912 +		System.out.println("count = " + ht.size() + ", time: " + estimatedTime / 1000000);
 283.913 +
 283.914 +		System.out.println("map lookup");
 283.915 +		startTime = System.nanoTime();
 283.916 +		int c = 0;
 283.917 +		for(Object word2 : words)
 283.918 +			{
 283.919 +			if(!map.contains(word2))
 283.920 +				++c;
 283.921 +			}
 283.922 +		estimatedTime = System.nanoTime() - startTime;
 283.923 +		System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000);
 283.924 +		System.out.println("ht lookup");
 283.925 +		startTime = System.nanoTime();
 283.926 +		c = 0;
 283.927 +		for(Object word3 : words)
 283.928 +			{
 283.929 +			if(!ht.containsKey(word3))
 283.930 +				++c;
 283.931 +			}
 283.932 +		estimatedTime = System.nanoTime() - startTime;
 283.933 +		System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000);
 283.934 +		System.out.println("snapshotMap lookup");
 283.935 +		startTime = System.nanoTime();
 283.936 +		c = 0;
 283.937 +		for(Object word4 : words)
 283.938 +			{
 283.939 +			if(!snapshotMap.contains(word4))
 283.940 +				++c;
 283.941 +			}
 283.942 +		estimatedTime = System.nanoTime() - startTime;
 283.943 +		System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000);
 283.944 +		}
 283.945 +	catch(FileNotFoundException e)
 283.946 +		{
 283.947 +		e.printStackTrace();
 283.948 +		}
 283.949 +
 283.950 +}
 283.951 +*/
 283.952 +
 283.953 +private static INode[] cloneAndSet(INode[] array, int i, INode a) {
 283.954 +	INode[] clone = array.clone();
 283.955 +	clone[i] = a;
 283.956 +	return clone;
 283.957 +}
 283.958 +
 283.959 +private static Object[] cloneAndSet(Object[] array, int i, Object a) {
 283.960 +	Object[] clone = array.clone();
 283.961 +	clone[i] = a;
 283.962 +	return clone;
 283.963 +}
 283.964 +
 283.965 +private static Object[] cloneAndSet(Object[] array, int i, Object a, int j, Object b) {
 283.966 +	Object[] clone = array.clone();
 283.967 +	clone[i] = a;
 283.968 +	clone[j] = b;
 283.969 +	return clone;
 283.970 +}
 283.971 +
 283.972 +private static Object[] removePair(Object[] array, int i) {
 283.973 +	Object[] newArray = new Object[array.length - 2];
 283.974 +	System.arraycopy(array, 0, newArray, 0, 2*i);
 283.975 +	System.arraycopy(array, 2*(i+1), newArray, 2*i, newArray.length - 2*i);
 283.976 +	return newArray;
 283.977 +}
 283.978 +
 283.979 +private static INode createNode(int shift, Object key1, Object val1, int key2hash, Object key2, Object val2) {
 283.980 +	int key1hash = Util.hash(key1);
 283.981 +	if(key1hash == key2hash)
 283.982 +		return new HashCollisionNode(null, key1hash, 2, new Object[] {key1, val1, key2, val2});
 283.983 +	Box _ = new Box(null);
 283.984 +	AtomicReference<Thread> edit = new AtomicReference<Thread>();
 283.985 +	return BitmapIndexedNode.EMPTY
 283.986 +		.assoc(edit, shift, key1hash, key1, val1, _)
 283.987 +		.assoc(edit, shift, key2hash, key2, val2, _);
 283.988 +}
 283.989 +
 283.990 +private static INode createNode(AtomicReference<Thread> edit, int shift, Object key1, Object val1, int key2hash, Object key2, Object val2) {
 283.991 +	int key1hash = Util.hash(key1);
 283.992 +	if(key1hash == key2hash)
 283.993 +		return new HashCollisionNode(null, key1hash, 2, new Object[] {key1, val1, key2, val2});
 283.994 +	Box _ = new Box(null);
 283.995 +	return BitmapIndexedNode.EMPTY
 283.996 +		.assoc(edit, shift, key1hash, key1, val1, _)
 283.997 +		.assoc(edit, shift, key2hash, key2, val2, _);
 283.998 +}
 283.999 +
283.1000 +private static int bitpos(int hash, int shift){
283.1001 +	return 1 << mask(hash, shift);
283.1002 +}
283.1003 +
283.1004 +static final class NodeSeq extends ASeq {
283.1005 +	final Object[] array;
283.1006 +	final int i;
283.1007 +	final ISeq s;
283.1008 +	
283.1009 +	NodeSeq(Object[] array, int i) {
283.1010 +		this(null, array, i, null);
283.1011 +	}
283.1012 +
283.1013 +	static ISeq create(Object[] array) {
283.1014 +		return create(array, 0, null);
283.1015 +	}
283.1016 +
283.1017 +	private static ISeq create(Object[] array, int i, ISeq s) {
283.1018 +		if(s != null)
283.1019 +			return new NodeSeq(null, array, i, s);
283.1020 +		for(int j = i; j < array.length; j+=2) {
283.1021 +			if(array[j] != null)
283.1022 +				return new NodeSeq(null, array, j, null);
283.1023 +			INode node = (INode) array[j+1];
283.1024 +			if (node != null) {
283.1025 +				ISeq nodeSeq = node.nodeSeq();
283.1026 +				if(nodeSeq != null)
283.1027 +					return new NodeSeq(null, array, j + 2, nodeSeq);
283.1028 +			}
283.1029 +		}
283.1030 +		return null;
283.1031 +	}
283.1032 +	
283.1033 +	NodeSeq(IPersistentMap meta, Object[] array, int i, ISeq s) {
283.1034 +		super(meta);
283.1035 +		this.array = array;
283.1036 +		this.i = i;
283.1037 +		this.s = s;
283.1038 +	}
283.1039 +
283.1040 +	public Obj withMeta(IPersistentMap meta) {
283.1041 +		return new NodeSeq(meta, array, i, s);
283.1042 +	}
283.1043 +
283.1044 +	public Object first() {
283.1045 +		if(s != null)
283.1046 +			return s.first();
283.1047 +		return new MapEntry(array[i], array[i+1]);
283.1048 +	}
283.1049 +
283.1050 +	public ISeq next() {
283.1051 +		if(s != null)
283.1052 +			return create(array, i, s.next());
283.1053 +		return create(array, i + 2, null);
283.1054 +	}
283.1055 +}
283.1056 +
283.1057 +}
283.1058 \ No newline at end of file
   284.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   284.2 +++ b/src/clojure/lang/PersistentHashSet.java	Sat Aug 21 06:25:44 2010 -0400
   284.3 @@ -0,0 +1,128 @@
   284.4 +/**
   284.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   284.6 + *   The use and distribution terms for this software are covered by the
   284.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   284.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   284.9 + *   By using this software in any fashion, you are agreeing to be bound by
  284.10 + * 	 the terms of this license.
  284.11 + *   You must not remove this notice, or any other, from this software.
  284.12 + **/
  284.13 +
  284.14 +/* rich Mar 3, 2008 */
  284.15 +
  284.16 +package clojure.lang;
  284.17 +
  284.18 +import java.util.List;
  284.19 +
  284.20 +public class PersistentHashSet extends APersistentSet implements IObj, IEditableCollection {
  284.21 +
  284.22 +static public final PersistentHashSet EMPTY = new PersistentHashSet(null, PersistentHashMap.EMPTY);
  284.23 +
  284.24 +final IPersistentMap _meta;
  284.25 +
  284.26 +public static PersistentHashSet create(Object... init){
  284.27 +	PersistentHashSet ret = EMPTY;
  284.28 +	for(int i = 0; i < init.length; i++)
  284.29 +		{
  284.30 +		ret = (PersistentHashSet) ret.cons(init[i]);
  284.31 +		}
  284.32 +	return ret;
  284.33 +}
  284.34 +
  284.35 +public static PersistentHashSet create(List init){
  284.36 +	PersistentHashSet ret = EMPTY;
  284.37 +	for(Object key : init)
  284.38 +		{
  284.39 +		ret = (PersistentHashSet) ret.cons(key);
  284.40 +		}
  284.41 +	return ret;
  284.42 +}
  284.43 +
  284.44 +static public PersistentHashSet create(ISeq items){
  284.45 +	PersistentHashSet ret = EMPTY;
  284.46 +	for(; items != null; items = items.next())
  284.47 +		{
  284.48 +		ret = (PersistentHashSet) ret.cons(items.first());
  284.49 +		}
  284.50 +	return ret;
  284.51 +}
  284.52 +
  284.53 +public static PersistentHashSet createWithCheck(Object... init){
  284.54 +	PersistentHashSet ret = EMPTY;
  284.55 +	for(int i = 0; i < init.length; i++)
  284.56 +		{
  284.57 +		ret = (PersistentHashSet) ret.cons(init[i]);
  284.58 +		if(ret.count() != i + 1)
  284.59 +			throw new IllegalArgumentException("Duplicate key: " + init[i]);
  284.60 +		}
  284.61 +	return ret;
  284.62 +}
  284.63 +
  284.64 +public static PersistentHashSet createWithCheck(List init){
  284.65 +	PersistentHashSet ret = EMPTY;
  284.66 +	int i=0;
  284.67 +	for(Object key : init)
  284.68 +		{
  284.69 +		ret = (PersistentHashSet) ret.cons(key);
  284.70 +		if(ret.count() != i + 1)
  284.71 +			throw new IllegalArgumentException("Duplicate key: " + key);		
  284.72 +		++i;
  284.73 +		}
  284.74 +	return ret;
  284.75 +}
  284.76 +
  284.77 +static public PersistentHashSet createWithCheck(ISeq items){
  284.78 +	PersistentHashSet ret = EMPTY;
  284.79 +	for(int i=0; items != null; items = items.next(), ++i)
  284.80 +		{
  284.81 +		ret = (PersistentHashSet) ret.cons(items.first());
  284.82 +		if(ret.count() != i + 1)
  284.83 +			throw new IllegalArgumentException("Duplicate key: " + items.first());
  284.84 +		}
  284.85 +	return ret;
  284.86 +}
  284.87 +
  284.88 +PersistentHashSet(IPersistentMap meta, IPersistentMap impl){
  284.89 +	super(impl);
  284.90 +	this._meta = meta;
  284.91 +}
  284.92 +
  284.93 +public IPersistentSet disjoin(Object key) throws Exception{
  284.94 +	if(contains(key))
  284.95 +		return new PersistentHashSet(meta(),impl.without(key));
  284.96 +	return this;
  284.97 +}
  284.98 +
  284.99 +public IPersistentSet cons(Object o){
 284.100 +	if(contains(o))
 284.101 +		return this;
 284.102 +	return new PersistentHashSet(meta(),impl.assoc(o,o));
 284.103 +}
 284.104 +
 284.105 +public IPersistentCollection empty(){
 284.106 +	return EMPTY.withMeta(meta());	
 284.107 +}
 284.108 +
 284.109 +public PersistentHashSet withMeta(IPersistentMap meta){
 284.110 +	return new PersistentHashSet(meta, impl);
 284.111 +}
 284.112 +
 284.113 +public ITransientCollection asTransient() {
 284.114 +	return new TransientHashSet(((PersistentHashMap) impl).asTransient());
 284.115 +}
 284.116 +
 284.117 +public IPersistentMap meta(){
 284.118 +	return _meta;
 284.119 +}
 284.120 +
 284.121 +static final class TransientHashSet extends ATransientSet {
 284.122 +	TransientHashSet(ITransientMap impl) {
 284.123 +		super(impl);
 284.124 +	}
 284.125 +
 284.126 +	public IPersistentCollection persistent() {
 284.127 +		return new PersistentHashSet(null, impl.persistent());
 284.128 +	}
 284.129 +}
 284.130 +
 284.131 +}
   285.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   285.2 +++ b/src/clojure/lang/PersistentList.java	Sat Aug 21 06:25:44 2010 -0400
   285.3 @@ -0,0 +1,311 @@
   285.4 +/**
   285.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   285.6 + *   The use and distribution terms for this software are covered by the
   285.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   285.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   285.9 + *   By using this software in any fashion, you are agreeing to be bound by
  285.10 + * 	 the terms of this license.
  285.11 + *   You must not remove this notice, or any other, from this software.
  285.12 + **/
  285.13 +
  285.14 +package clojure.lang;
  285.15 +
  285.16 +import java.io.Serializable;
  285.17 +import java.util.*;
  285.18 +
  285.19 +public class PersistentList extends ASeq implements IPersistentList, IReduce, List, Counted {
  285.20 +
  285.21 +private final Object _first;
  285.22 +private final IPersistentList _rest;
  285.23 +private final int _count;
  285.24 +
  285.25 +public static IFn creator = new RestFn(){
  285.26 +	final public int getRequiredArity(){
  285.27 +		return 0;
  285.28 +	}
  285.29 +
  285.30 +	final protected Object doInvoke(Object args) throws Exception{
  285.31 +		if(args instanceof ArraySeq)
  285.32 +			{
  285.33 +			Object[] argsarray = (Object[]) ((ArraySeq) args).array;
  285.34 +			IPersistentList ret = EMPTY;
  285.35 +			for(int i = argsarray.length - 1; i >= 0; --i)
  285.36 +				ret = (IPersistentList) ret.cons(argsarray[i]);
  285.37 +			return ret;
  285.38 +			}
  285.39 +		LinkedList list = new LinkedList();
  285.40 +		for(ISeq s = RT.seq(args); s != null; s = s.next())
  285.41 +			list.add(s.first());
  285.42 +		return create(list);
  285.43 +	}
  285.44 +
  285.45 +	public IObj withMeta(IPersistentMap meta){
  285.46 +		throw new UnsupportedOperationException();
  285.47 +	}
  285.48 +
  285.49 +	public IPersistentMap meta(){
  285.50 +		return null;
  285.51 +	}
  285.52 +};
  285.53 +
  285.54 +final public static EmptyList EMPTY = new EmptyList(null);
  285.55 +
  285.56 +public PersistentList(Object first){
  285.57 +	this._first = first;
  285.58 +	this._rest = null;
  285.59 +
  285.60 +	this._count = 1;
  285.61 +}
  285.62 +
  285.63 +PersistentList(IPersistentMap meta, Object _first, IPersistentList _rest, int _count){
  285.64 +	super(meta);
  285.65 +	this._first = _first;
  285.66 +	this._rest = _rest;
  285.67 +	this._count = _count;
  285.68 +}
  285.69 +
  285.70 +public static IPersistentList create(List init){
  285.71 +	IPersistentList ret = EMPTY;
  285.72 +	for(ListIterator i = init.listIterator(init.size()); i.hasPrevious();)
  285.73 +		{
  285.74 +		ret = (IPersistentList) ret.cons(i.previous());
  285.75 +		}
  285.76 +	return ret;
  285.77 +}
  285.78 +
  285.79 +public Object first(){
  285.80 +	return _first;
  285.81 +}
  285.82 +
  285.83 +public ISeq next(){
  285.84 +	if(_count == 1)
  285.85 +		return null;
  285.86 +	return (ISeq) _rest;
  285.87 +}
  285.88 +
  285.89 +public Object peek(){
  285.90 +	return first();
  285.91 +}
  285.92 +
  285.93 +public IPersistentList pop(){
  285.94 +	if(_rest == null)
  285.95 +		return EMPTY.withMeta(_meta);
  285.96 +	return _rest;
  285.97 +}
  285.98 +
  285.99 +public int count(){
 285.100 +	return _count;
 285.101 +}
 285.102 +
 285.103 +public PersistentList cons(Object o){
 285.104 +	return new PersistentList(meta(), o, this, _count + 1);
 285.105 +}
 285.106 +
 285.107 +public IPersistentCollection empty(){
 285.108 +	return EMPTY.withMeta(meta());
 285.109 +}
 285.110 +
 285.111 +public PersistentList withMeta(IPersistentMap meta){
 285.112 +	if(meta != _meta)
 285.113 +		return new PersistentList(meta, _first, _rest, _count);
 285.114 +	return this;
 285.115 +}
 285.116 +
 285.117 +public Object reduce(IFn f) throws Exception{
 285.118 +	Object ret = first();
 285.119 +	for(ISeq s = next(); s != null; s = s.next())
 285.120 +		ret = f.invoke(ret, s.first());
 285.121 +	return ret;
 285.122 +}
 285.123 +
 285.124 +public Object reduce(IFn f, Object start) throws Exception{
 285.125 +	Object ret = f.invoke(start, first());
 285.126 +	for(ISeq s = next(); s != null; s = s.next())
 285.127 +		ret = f.invoke(ret, s.first());
 285.128 +	return ret;
 285.129 +}
 285.130 +
 285.131 +
 285.132 +    static class EmptyList extends Obj implements IPersistentList, List, ISeq, Counted{
 285.133 +
 285.134 +	public int hashCode(){
 285.135 +		return 1;
 285.136 +	}
 285.137 +
 285.138 +    public boolean equals(Object o) {
 285.139 +        return (o instanceof Sequential || o instanceof List) && RT.seq(o) == null;
 285.140 +    }
 285.141 +
 285.142 +	public boolean equiv(Object o){
 285.143 +		return equals(o);
 285.144 +	}
 285.145 +	
 285.146 +    EmptyList(IPersistentMap meta){
 285.147 +		super(meta);
 285.148 +	}
 285.149 +
 285.150 +        public Object first() {
 285.151 +            return null;
 285.152 +        }
 285.153 +
 285.154 +        public ISeq next() {
 285.155 +            return null;
 285.156 +        }
 285.157 +
 285.158 +        public ISeq more() {
 285.159 +            return this;
 285.160 +        }
 285.161 +
 285.162 +        public PersistentList cons(Object o){
 285.163 +		return new PersistentList(meta(), o, null, 1);
 285.164 +	}
 285.165 +
 285.166 +	public IPersistentCollection empty(){
 285.167 +		return this;
 285.168 +	}
 285.169 +
 285.170 +	public EmptyList withMeta(IPersistentMap meta){
 285.171 +		if(meta != meta())
 285.172 +			return new EmptyList(meta);
 285.173 +		return this;
 285.174 +	}
 285.175 +
 285.176 +	public Object peek(){
 285.177 +		return null;
 285.178 +	}
 285.179 +
 285.180 +	public IPersistentList pop(){
 285.181 +		throw new IllegalStateException("Can't pop empty list");
 285.182 +	}
 285.183 +
 285.184 +	public int count(){
 285.185 +		return 0;
 285.186 +	}
 285.187 +
 285.188 +	public ISeq seq(){
 285.189 +		return null;
 285.190 +	}
 285.191 +
 285.192 +
 285.193 +	public int size(){
 285.194 +		return 0;
 285.195 +	}
 285.196 +
 285.197 +	public boolean isEmpty(){
 285.198 +		return true;
 285.199 +	}
 285.200 +
 285.201 +	public boolean contains(Object o){
 285.202 +		return false;
 285.203 +	}
 285.204 +
 285.205 +	public Iterator iterator(){
 285.206 +		return new Iterator(){
 285.207 +
 285.208 +			public boolean hasNext(){
 285.209 +				return false;
 285.210 +			}
 285.211 +
 285.212 +			public Object next(){
 285.213 +				throw new NoSuchElementException();
 285.214 +			}
 285.215 +
 285.216 +			public void remove(){
 285.217 +				throw new UnsupportedOperationException();
 285.218 +			}
 285.219 +		};
 285.220 +	}
 285.221 +
 285.222 +	public Object[] toArray(){
 285.223 +		return RT.EMPTY_ARRAY;
 285.224 +	}
 285.225 +
 285.226 +	public boolean add(Object o){
 285.227 +		throw new UnsupportedOperationException();
 285.228 +	}
 285.229 +
 285.230 +	public boolean remove(Object o){
 285.231 +		throw new UnsupportedOperationException();
 285.232 +	}
 285.233 +
 285.234 +	public boolean addAll(Collection collection){
 285.235 +		throw new UnsupportedOperationException();
 285.236 +	}
 285.237 +
 285.238 +	public void clear(){
 285.239 +		throw new UnsupportedOperationException();
 285.240 +	}
 285.241 +
 285.242 +	public boolean retainAll(Collection collection){
 285.243 +		throw new UnsupportedOperationException();
 285.244 +	}
 285.245 +
 285.246 +	public boolean removeAll(Collection collection){
 285.247 +		throw new UnsupportedOperationException();
 285.248 +	}
 285.249 +
 285.250 +	public boolean containsAll(Collection collection){
 285.251 +		return collection.isEmpty();
 285.252 +	}
 285.253 +
 285.254 +	public Object[] toArray(Object[] objects){
 285.255 +		if(objects.length > 0)
 285.256 +			objects[0] = null;
 285.257 +		return objects;
 285.258 +	}
 285.259 +
 285.260 +	//////////// List stuff /////////////////
 285.261 +	private List reify(){
 285.262 +		return Collections.unmodifiableList(new ArrayList(this));
 285.263 +	}
 285.264 +
 285.265 +	public List subList(int fromIndex, int toIndex){
 285.266 +		return reify().subList(fromIndex, toIndex);
 285.267 +	}
 285.268 +
 285.269 +	public Object set(int index, Object element){
 285.270 +		throw new UnsupportedOperationException();
 285.271 +	}
 285.272 +
 285.273 +	public Object remove(int index){
 285.274 +		throw new UnsupportedOperationException();
 285.275 +	}
 285.276 +
 285.277 +	public int indexOf(Object o){
 285.278 +		ISeq s = seq();
 285.279 +		for(int i = 0; s != null; s = s.next(), i++)
 285.280 +			{
 285.281 +			if(Util.equiv(s.first(), o))
 285.282 +				return i;
 285.283 +			}
 285.284 +		return -1;
 285.285 +	}
 285.286 +
 285.287 +	public int lastIndexOf(Object o){
 285.288 +		return reify().lastIndexOf(o);
 285.289 +	}
 285.290 +
 285.291 +	public ListIterator listIterator(){
 285.292 +		return reify().listIterator();
 285.293 +	}
 285.294 +
 285.295 +	public ListIterator listIterator(int index){
 285.296 +		return reify().listIterator(index);
 285.297 +	}
 285.298 +
 285.299 +	public Object get(int index){
 285.300 +		return RT.nth(this, index);
 285.301 +	}
 285.302 +
 285.303 +	public void add(int index, Object element){
 285.304 +		throw new UnsupportedOperationException();
 285.305 +	}
 285.306 +
 285.307 +	public boolean addAll(int index, Collection c){
 285.308 +		throw new UnsupportedOperationException();
 285.309 +	}
 285.310 +
 285.311 +
 285.312 +}
 285.313 +
 285.314 +}
   286.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   286.2 +++ b/src/clojure/lang/PersistentQueue.java	Sat Aug 21 06:25:44 2010 -0400
   286.3 @@ -0,0 +1,304 @@
   286.4 +/**
   286.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   286.6 + *   The use and distribution terms for this software are covered by the
   286.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   286.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   286.9 + *   By using this software in any fashion, you are agreeing to be bound by
  286.10 + * 	 the terms of this license.
  286.11 + *   You must not remove this notice, or any other, from this software.
  286.12 + **/
  286.13 +
  286.14 +package clojure.lang;
  286.15 +
  286.16 +import java.util.Collection;
  286.17 +import java.util.Iterator;
  286.18 +//import java.util.concurrent.ConcurrentLinkedQueue;
  286.19 +
  286.20 +/**
  286.21 + * conses onto rear, peeks/pops from front
  286.22 + * See Okasaki's Batched Queues
  286.23 + * This differs in that it uses a PersistentArrayList as the rear, which is in-order,
  286.24 + * so no reversing or suspensions required for persistent use
  286.25 + */
  286.26 +
  286.27 +public class PersistentQueue extends Obj implements IPersistentList, Collection{
  286.28 +
  286.29 +final public static PersistentQueue EMPTY = new PersistentQueue(null, null, null);
  286.30 +
  286.31 +//*
  286.32 +final ISeq f;
  286.33 +final PersistentVector r;
  286.34 +//static final int INITIAL_REAR_SIZE = 4;
  286.35 +int _hash = -1;
  286.36 +
  286.37 +PersistentQueue(IPersistentMap meta, ISeq f, PersistentVector r){
  286.38 +	super(meta);
  286.39 +	this.f = f;
  286.40 +	this.r = r;
  286.41 +}
  286.42 +
  286.43 +public boolean equiv(Object obj){
  286.44 +
  286.45 +	if(!(obj instanceof Sequential))
  286.46 +		return false;
  286.47 +	ISeq ms = RT.seq(obj);
  286.48 +	for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next())
  286.49 +		{
  286.50 +		if(ms == null || !Util.equiv(s.first(), ms.first()))
  286.51 +			return false;
  286.52 +		}
  286.53 +	return ms == null;
  286.54 +
  286.55 +}
  286.56 +
  286.57 +public boolean equals(Object obj){
  286.58 +
  286.59 +	if(!(obj instanceof Sequential))
  286.60 +		return false;
  286.61 +	ISeq ms = RT.seq(obj);
  286.62 +	for(ISeq s = seq(); s != null; s = s.next(), ms = ms.next())
  286.63 +		{
  286.64 +		if(ms == null || !Util.equals(s.first(), ms.first()))
  286.65 +			return false;
  286.66 +		}
  286.67 +	return ms == null;
  286.68 +
  286.69 +}
  286.70 +
  286.71 +public int hashCode(){
  286.72 +	if(_hash == -1)
  286.73 +		{
  286.74 +		int hash = 0;
  286.75 +		for(ISeq s = seq(); s != null; s = s.next())
  286.76 +			{
  286.77 +			hash = Util.hashCombine(hash, Util.hash(s.first()));
  286.78 +			}
  286.79 +		this._hash = hash;
  286.80 +		}
  286.81 +	return _hash;
  286.82 +}
  286.83 +
  286.84 +public Object peek(){
  286.85 +	return RT.first(f);
  286.86 +}
  286.87 +
  286.88 +public PersistentQueue pop(){
  286.89 +	if(f == null)  //hmmm... pop of empty queue -> empty queue?
  286.90 +		return this;
  286.91 +	//throw new IllegalStateException("popping empty queue");
  286.92 +	ISeq f1 = f.next();
  286.93 +	PersistentVector r1 = r;
  286.94 +	if(f1 == null)
  286.95 +		{
  286.96 +		f1 = RT.seq(r);
  286.97 +		r1 = null;
  286.98 +		}
  286.99 +	return new PersistentQueue(meta(), f1, r1);
 286.100 +}
 286.101 +
 286.102 +public int count(){
 286.103 +	return RT.count(f) + RT.count(r);
 286.104 +}
 286.105 +
 286.106 +public ISeq seq(){
 286.107 +	if(f == null)
 286.108 +		return null;
 286.109 +	return new Seq(f, RT.seq(r));
 286.110 +}
 286.111 +
 286.112 +public PersistentQueue cons(Object o){
 286.113 +	if(f == null)     //empty
 286.114 +		return new PersistentQueue(meta(), RT.list(o), null);
 286.115 +	else
 286.116 +		return new PersistentQueue(meta(), f, (r != null ? r : PersistentVector.EMPTY).cons(o));
 286.117 +}
 286.118 +
 286.119 +public IPersistentCollection empty(){
 286.120 +	return EMPTY.withMeta(meta());	
 286.121 +}
 286.122 +
 286.123 +public PersistentQueue withMeta(IPersistentMap meta){
 286.124 +	return new PersistentQueue(meta, f, r);
 286.125 +}
 286.126 +
 286.127 +static class Seq extends ASeq{
 286.128 +	final ISeq f;
 286.129 +	final ISeq rseq;
 286.130 +
 286.131 +	Seq(ISeq f, ISeq rseq){
 286.132 +		this.f = f;
 286.133 +		this.rseq = rseq;
 286.134 +	}
 286.135 +
 286.136 +	Seq(IPersistentMap meta, ISeq f, ISeq rseq){
 286.137 +		super(meta);
 286.138 +		this.f = f;
 286.139 +		this.rseq = rseq;
 286.140 +	}
 286.141 +
 286.142 +	public Object first(){
 286.143 +		return f.first();
 286.144 +	}
 286.145 +
 286.146 +	public ISeq next(){
 286.147 +		ISeq f1 = f.next();
 286.148 +		ISeq r1 = rseq;
 286.149 +		if(f1 == null)
 286.150 +			{
 286.151 +			if(rseq == null)
 286.152 +				return null;
 286.153 +			f1 = rseq;
 286.154 +			r1 = null;
 286.155 +			}
 286.156 +		return new Seq(f1, r1);
 286.157 +	}
 286.158 +
 286.159 +	public int count(){
 286.160 +		return RT.count(f) + RT.count(rseq);
 286.161 +	}
 286.162 +
 286.163 +	public Seq withMeta(IPersistentMap meta){
 286.164 +		return new Seq(meta, f, rseq);
 286.165 +	}
 286.166 +}
 286.167 +
 286.168 +// java.util.Collection implementation
 286.169 +
 286.170 +public Object[] toArray(){
 286.171 +	return RT.seqToArray(seq());
 286.172 +}
 286.173 +
 286.174 +public boolean add(Object o){
 286.175 +	throw new UnsupportedOperationException();
 286.176 +}
 286.177 +
 286.178 +public boolean remove(Object o){
 286.179 +	throw new UnsupportedOperationException();
 286.180 +}
 286.181 +
 286.182 +public boolean addAll(Collection c){
 286.183 +	throw new UnsupportedOperationException();
 286.184 +}
 286.185 +
 286.186 +public void clear(){
 286.187 +	throw new UnsupportedOperationException();
 286.188 +}
 286.189 +
 286.190 +public boolean retainAll(Collection c){
 286.191 +	throw new UnsupportedOperationException();
 286.192 +}
 286.193 +
 286.194 +public boolean removeAll(Collection c){
 286.195 +	throw new UnsupportedOperationException();
 286.196 +}
 286.197 +
 286.198 +public boolean containsAll(Collection c){
 286.199 +	for(Object o : c)
 286.200 +		{
 286.201 +		if(contains(o))
 286.202 +			return true;
 286.203 +		}
 286.204 +	return false;
 286.205 +}
 286.206 +
 286.207 +public Object[] toArray(Object[] a){
 286.208 +	if(a.length >= count())
 286.209 +		{
 286.210 +		ISeq s = seq();
 286.211 +		for(int i = 0; s != null; ++i, s = s.next())
 286.212 +			{
 286.213 +			a[i] = s.first();
 286.214 +			}
 286.215 +		if(a.length >= count())
 286.216 +			a[count()] = null;
 286.217 +		return a;
 286.218 +		}
 286.219 +	else
 286.220 +		return toArray();
 286.221 +}
 286.222 +
 286.223 +public int size(){
 286.224 +	return count();
 286.225 +}
 286.226 +
 286.227 +public boolean isEmpty(){
 286.228 +	return count() == 0;
 286.229 +}
 286.230 +
 286.231 +public boolean contains(Object o){
 286.232 +	for(ISeq s = seq(); s != null; s = s.next())
 286.233 +		{
 286.234 +		if(Util.equiv(s.first(), o))
 286.235 +			return true;
 286.236 +		}
 286.237 +	return false;
 286.238 +}
 286.239 +
 286.240 +public Iterator iterator(){
 286.241 +	return new SeqIterator(seq());
 286.242 +}
 286.243 +
 286.244 +/*
 286.245 +public static void main(String[] args){
 286.246 +	if(args.length != 1)
 286.247 +		{
 286.248 +		System.err.println("Usage: PersistentQueue n");
 286.249 +		return;
 286.250 +		}
 286.251 +	int n = Integer.parseInt(args[0]);
 286.252 +
 286.253 +
 286.254 +	long startTime, estimatedTime;
 286.255 +
 286.256 +	Queue list = new LinkedList();
 286.257 +	//Queue list = new ConcurrentLinkedQueue();
 286.258 +	System.out.println("Queue");
 286.259 +	startTime = System.nanoTime();
 286.260 +	for(int i = 0; i < n; i++)
 286.261 +		{
 286.262 +		list.add(i);
 286.263 +		list.add(i);
 286.264 +		list.remove();
 286.265 +		}
 286.266 +	for(int i = 0; i < n - 10; i++)
 286.267 +		{
 286.268 +		list.remove();
 286.269 +		}
 286.270 +	estimatedTime = System.nanoTime() - startTime;
 286.271 +	System.out.println("time: " + estimatedTime / 1000000);
 286.272 +	System.out.println("peek: " + list.peek());
 286.273 +
 286.274 +
 286.275 +	PersistentQueue q = PersistentQueue.EMPTY;
 286.276 +	System.out.println("PersistentQueue");
 286.277 +	startTime = System.nanoTime();
 286.278 +	for(int i = 0; i < n; i++)
 286.279 +		{
 286.280 +		q = q.cons(i);
 286.281 +		q = q.cons(i);
 286.282 +		q = q.pop();
 286.283 +		}
 286.284 +//    IPersistentList lastq = null;
 286.285 +//    IPersistentList lastq2;
 286.286 +	for(int i = 0; i < n - 10; i++)
 286.287 +		{
 286.288 +		//lastq2 = lastq;
 286.289 +		//lastq = q;
 286.290 +		q = q.pop();
 286.291 +		}
 286.292 +	estimatedTime = System.nanoTime() - startTime;
 286.293 +	System.out.println("time: " + estimatedTime / 1000000);
 286.294 +	System.out.println("peek: " + q.peek());
 286.295 +
 286.296 +	IPersistentList q2 = q;
 286.297 +	for(int i = 0; i < 10; i++)
 286.298 +		{
 286.299 +		q2 = (IPersistentList) q2.cons(i);
 286.300 +		}
 286.301 +//    for(ISeq s = q.seq();s != null;s = s.rest())
 286.302 +//        System.out.println("q: " + s.first().toString());
 286.303 +//    for(ISeq s = q2.seq();s != null;s = s.rest())
 286.304 +//        System.out.println("q2: " + s.first().toString());
 286.305 +}
 286.306 +*/
 286.307 +}
   287.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   287.2 +++ b/src/clojure/lang/PersistentStructMap.java	Sat Aug 21 06:25:44 2010 -0400
   287.3 @@ -0,0 +1,233 @@
   287.4 +/**
   287.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   287.6 + *   The use and distribution terms for this software are covered by the
   287.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   287.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   287.9 + *   By using this software in any fashion, you are agreeing to be bound by
  287.10 + * 	 the terms of this license.
  287.11 + *   You must not remove this notice, or any other, from this software.
  287.12 + **/
  287.13 +
  287.14 +/* rich Dec 16, 2007 */
  287.15 +
  287.16 +package clojure.lang;
  287.17 +
  287.18 +import java.util.Iterator;
  287.19 +import java.util.Map;
  287.20 +import java.io.Serializable;
  287.21 +
  287.22 +public class PersistentStructMap extends APersistentMap implements IObj{
  287.23 +
  287.24 +public static class Def implements Serializable{
  287.25 +	final ISeq keys;
  287.26 +	final IPersistentMap keyslots;
  287.27 +
  287.28 +	Def(ISeq keys, IPersistentMap keyslots){
  287.29 +		this.keys = keys;
  287.30 +		this.keyslots = keyslots;
  287.31 +	}
  287.32 +}
  287.33 +
  287.34 +final Def def;
  287.35 +final Object[] vals;
  287.36 +final IPersistentMap ext;
  287.37 +final IPersistentMap _meta;
  287.38 +
  287.39 +
  287.40 +static public Def createSlotMap(ISeq keys){
  287.41 +	if(keys == null)
  287.42 +		throw new IllegalArgumentException("Must supply keys");
  287.43 +	int c = RT.count(keys);
  287.44 +	Object[] v = new Object[2*c];
  287.45 +	int i = 0;
  287.46 +	for(ISeq s = keys; s != null; s = s.next(), i++)
  287.47 +		{
  287.48 +		v[2*i] =  s.first();
  287.49 +		v[2*i+1] = i;
  287.50 +		}
  287.51 +	return new Def(keys, RT.map(v));
  287.52 +}
  287.53 +
  287.54 +static public PersistentStructMap create(Def def, ISeq keyvals){
  287.55 +	Object[] vals = new Object[def.keyslots.count()];
  287.56 +	IPersistentMap ext = PersistentHashMap.EMPTY;
  287.57 +	for(; keyvals != null; keyvals = keyvals.next().next())
  287.58 +		{
  287.59 +		if(keyvals.next() == null)
  287.60 +			throw new IllegalArgumentException(String.format("No value supplied for key: %s", keyvals.first()));
  287.61 +		Object k = keyvals.first();
  287.62 +		Object v = RT.second(keyvals);
  287.63 +		Map.Entry e = def.keyslots.entryAt(k);
  287.64 +		if(e != null)
  287.65 +			vals[(Integer) e.getValue()] = v;
  287.66 +		else
  287.67 +			ext = ext.assoc(k, v);
  287.68 +		}
  287.69 +	return new PersistentStructMap(null, def, vals, ext);
  287.70 +}
  287.71 +
  287.72 +static public PersistentStructMap construct(Def def, ISeq valseq){
  287.73 +	Object[] vals = new Object[def.keyslots.count()];
  287.74 +	IPersistentMap ext = PersistentHashMap.EMPTY;
  287.75 +	for(int i = 0; i < vals.length && valseq != null; valseq = valseq.next(), i++)
  287.76 +		{
  287.77 +		vals[i] = valseq.first();
  287.78 +		}
  287.79 +	if(valseq != null)
  287.80 +		throw new IllegalArgumentException("Too many arguments to struct constructor");
  287.81 +	return new PersistentStructMap(null, def, vals, ext);
  287.82 +}
  287.83 +
  287.84 +static public IFn getAccessor(final Def def, Object key){
  287.85 +	Map.Entry e = def.keyslots.entryAt(key);
  287.86 +	if(e != null)
  287.87 +		{
  287.88 +		final int i = (Integer) e.getValue();
  287.89 +		return new AFn(){
  287.90 +			public Object invoke(Object arg1) throws Exception{
  287.91 +				PersistentStructMap m = (PersistentStructMap) arg1;
  287.92 +				if(m.def != def)
  287.93 +					throw new Exception("Accessor/struct mismatch");
  287.94 +				return m.vals[i];
  287.95 +			}
  287.96 +		};
  287.97 +		}
  287.98 +	throw new IllegalArgumentException("Not a key of struct");
  287.99 +}
 287.100 +
 287.101 +protected PersistentStructMap(IPersistentMap meta, Def def, Object[] vals, IPersistentMap ext){
 287.102 +	this._meta = meta;
 287.103 +	this.ext = ext;
 287.104 +	this.def = def;
 287.105 +	this.vals = vals;
 287.106 +}
 287.107 +
 287.108 +/**
 287.109 + * Returns a new instance of PersistentStructMap using the given parameters.
 287.110 + * This function is used instead of the PersistentStructMap constructor by
 287.111 + * all methods that return a new PersistentStructMap.  This is done so as to
 287.112 + * allow subclasses to return instances of their class from all
 287.113 + * PersistentStructMap methods.
 287.114 + */
 287.115 +protected PersistentStructMap makeNew(IPersistentMap meta, Def def, Object[] vals, IPersistentMap ext){
 287.116 +	return new PersistentStructMap(meta, def, vals, ext);
 287.117 +}
 287.118 +
 287.119 +public IObj withMeta(IPersistentMap meta){
 287.120 +	if(meta == _meta)
 287.121 +		return this;
 287.122 +	return makeNew(meta, def, vals, ext);
 287.123 +}
 287.124 +
 287.125 +public IPersistentMap meta(){
 287.126 +	return _meta;
 287.127 +}
 287.128 +
 287.129 +public boolean containsKey(Object key){
 287.130 +	return def.keyslots.containsKey(key) || ext.containsKey(key);
 287.131 +}
 287.132 +
 287.133 +public IMapEntry entryAt(Object key){
 287.134 +	Map.Entry e = def.keyslots.entryAt(key);
 287.135 +	if(e != null)
 287.136 +		{
 287.137 +		return new MapEntry(e.getKey(), vals[(Integer) e.getValue()]);
 287.138 +		}
 287.139 +	return ext.entryAt(key);
 287.140 +}
 287.141 +
 287.142 +public IPersistentMap assoc(Object key, Object val){
 287.143 +	Map.Entry e = def.keyslots.entryAt(key);
 287.144 +	if(e != null)
 287.145 +		{
 287.146 +		int i = (Integer) e.getValue();
 287.147 +		Object[] newVals = vals.clone();
 287.148 +		newVals[i] = val;
 287.149 +		return makeNew(_meta, def, newVals, ext);
 287.150 +		}
 287.151 +	return makeNew(_meta, def, vals, ext.assoc(key, val));
 287.152 +}
 287.153 +
 287.154 +public Object valAt(Object key){
 287.155 +	Integer i = (Integer) def.keyslots.valAt(key);
 287.156 +	if(i != null)
 287.157 +		{
 287.158 +		return vals[i];
 287.159 +		}
 287.160 +	return ext.valAt(key);
 287.161 +}
 287.162 +
 287.163 +public Object valAt(Object key, Object notFound){
 287.164 +	Integer i = (Integer) def.keyslots.valAt(key);
 287.165 +	if(i != null)
 287.166 +		{
 287.167 +		return vals[i];
 287.168 +		}
 287.169 +	return ext.valAt(key, notFound);
 287.170 +}
 287.171 +
 287.172 +public IPersistentMap assocEx(Object key, Object val) throws Exception{
 287.173 +	if(containsKey(key))
 287.174 +		throw new Exception("Key already present");
 287.175 +	return assoc(key, val);
 287.176 +}
 287.177 +
 287.178 +public IPersistentMap without(Object key) throws Exception{
 287.179 +	Map.Entry e = def.keyslots.entryAt(key);
 287.180 +	if(e != null)
 287.181 +		throw new Exception("Can't remove struct key");
 287.182 +	IPersistentMap newExt = ext.without(key);
 287.183 +	if(newExt == ext)
 287.184 +		return this;
 287.185 +	return makeNew(_meta, def, vals, newExt);
 287.186 +}
 287.187 +
 287.188 +public Iterator iterator(){
 287.189 +	return new SeqIterator(seq());
 287.190 +}
 287.191 +
 287.192 +
 287.193 +public int count(){
 287.194 +	return vals.length + RT.count(ext);
 287.195 +}
 287.196 +
 287.197 +public ISeq seq(){
 287.198 +	return new Seq(null, def.keys, vals, 0, ext);
 287.199 +}
 287.200 +
 287.201 +public IPersistentCollection empty(){
 287.202 +	return construct(def, null);
 287.203 +}
 287.204 +
 287.205 +static class Seq extends ASeq{
 287.206 +	final int i;
 287.207 +	final ISeq keys;
 287.208 +	final Object[] vals;
 287.209 +	final IPersistentMap ext;
 287.210 +
 287.211 +
 287.212 +	public Seq(IPersistentMap meta, ISeq keys, Object[] vals, int i, IPersistentMap ext){
 287.213 +		super(meta);
 287.214 +		this.i = i;
 287.215 +		this.keys = keys;
 287.216 +		this.vals = vals;
 287.217 +		this.ext = ext;
 287.218 +	}
 287.219 +
 287.220 +	public Obj withMeta(IPersistentMap meta){
 287.221 +		if(meta != _meta)
 287.222 +			return new Seq(meta, keys, vals, i, ext);
 287.223 +		return this;
 287.224 +	}
 287.225 +
 287.226 +	public Object first(){
 287.227 +		return new MapEntry(keys.first(), vals[i]);
 287.228 +	}
 287.229 +
 287.230 +	public ISeq next(){
 287.231 +		if(i + 1 < vals.length)
 287.232 +			return new Seq(_meta, keys.next(), vals, i + 1, ext);
 287.233 +		return ext.seq();
 287.234 +	}
 287.235 +}
 287.236 +}
   288.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   288.2 +++ b/src/clojure/lang/PersistentTreeMap.java	Sat Aug 21 06:25:44 2010 -0400
   288.3 @@ -0,0 +1,1003 @@
   288.4 +/**
   288.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   288.6 + *   The use and distribution terms for this software are covered by the
   288.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   288.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   288.9 + *   By using this software in any fashion, you are agreeing to be bound by
  288.10 + * 	 the terms of this license.
  288.11 + *   You must not remove this notice, or any other, from this software.
  288.12 + **/
  288.13 +
  288.14 +/* rich May 20, 2006 */
  288.15 +
  288.16 +package clojure.lang;
  288.17 +
  288.18 +import java.util.*;
  288.19 +
  288.20 +/**
  288.21 + * Persistent Red Black Tree
  288.22 + * Note that instances of this class are constant values
  288.23 + * i.e. add/remove etc return new values
  288.24 + * <p/>
  288.25 + * See Okasaki, Kahrs, Larsen et al
  288.26 + */
  288.27 +
  288.28 +public class PersistentTreeMap extends APersistentMap implements IObj, Reversible, Sorted{
  288.29 +
  288.30 +public final Comparator comp;
  288.31 +public final Node tree;
  288.32 +public final int _count;
  288.33 +final IPersistentMap _meta;
  288.34 +
  288.35 +final static public PersistentTreeMap EMPTY = new PersistentTreeMap();
  288.36 +
  288.37 +static public IPersistentMap create(Map other){
  288.38 +	IPersistentMap ret = EMPTY;
  288.39 +	for(Object o : other.entrySet())
  288.40 +		{
  288.41 +		Map.Entry e = (Entry) o;
  288.42 +		ret = ret.assoc(e.getKey(), e.getValue());
  288.43 +		}
  288.44 +	return ret;
  288.45 +}
  288.46 +
  288.47 +public PersistentTreeMap(){
  288.48 +	this(RT.DEFAULT_COMPARATOR);
  288.49 +}
  288.50 +
  288.51 +public PersistentTreeMap withMeta(IPersistentMap meta){
  288.52 +	return new PersistentTreeMap(meta, comp, tree, _count);
  288.53 +}
  288.54 +
  288.55 +private PersistentTreeMap(Comparator comp){
  288.56 +	this(null, comp);
  288.57 +}
  288.58 +
  288.59 +
  288.60 +public PersistentTreeMap(IPersistentMap meta, Comparator comp){
  288.61 +	this.comp = comp;
  288.62 +	this._meta = meta;
  288.63 +	tree = null;
  288.64 +	_count = 0;
  288.65 +}
  288.66 +
  288.67 +PersistentTreeMap(IPersistentMap meta, Comparator comp, Node tree, int _count){
  288.68 +	this._meta = meta;
  288.69 +	this.comp = comp;
  288.70 +	this.tree = tree;
  288.71 +	this._count = _count;
  288.72 +}
  288.73 +
  288.74 +static public PersistentTreeMap create(ISeq items){
  288.75 +	IPersistentMap ret = EMPTY;
  288.76 +	for(; items != null; items = items.next().next())
  288.77 +		{
  288.78 +		if(items.next() == null)
  288.79 +			throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first()));
  288.80 +		ret = ret.assoc(items.first(), RT.second(items));
  288.81 +		}
  288.82 +	return (PersistentTreeMap) ret;
  288.83 +}
  288.84 +
  288.85 +static public PersistentTreeMap create(Comparator comp, ISeq items){
  288.86 +	IPersistentMap ret = new PersistentTreeMap(comp);
  288.87 +	for(; items != null; items = items.next().next())
  288.88 +		{
  288.89 +		if(items.next() == null)
  288.90 +			throw new IllegalArgumentException(String.format("No value supplied for key: %s", items.first()));
  288.91 +		ret = ret.assoc(items.first(), RT.second(items));
  288.92 +		}
  288.93 +	return (PersistentTreeMap) ret;
  288.94 +}
  288.95 +
  288.96 +public boolean containsKey(Object key){
  288.97 +	return entryAt(key) != null;
  288.98 +}
  288.99 +
 288.100 +public PersistentTreeMap assocEx(Object key, Object val) throws Exception{
 288.101 +	Box found = new Box(null);
 288.102 +	Node t = add(tree, key, val, found);
 288.103 +	if(t == null)   //null == already contains key
 288.104 +		{
 288.105 +		throw new Exception("Key already present");
 288.106 +		}
 288.107 +	return new PersistentTreeMap(comp, t.blacken(), _count + 1, meta());
 288.108 +}
 288.109 +
 288.110 +public PersistentTreeMap assoc(Object key, Object val){
 288.111 +	Box found = new Box(null);
 288.112 +	Node t = add(tree, key, val, found);
 288.113 +	if(t == null)   //null == already contains key
 288.114 +		{
 288.115 +		Node foundNode = (Node) found.val;
 288.116 +		if(foundNode.val() == val)  //note only get same collection on identity of val, not equals()
 288.117 +			return this;
 288.118 +		return new PersistentTreeMap(comp, replace(tree, key, val), _count, meta());
 288.119 +		}
 288.120 +	return new PersistentTreeMap(comp, t.blacken(), _count + 1, meta());
 288.121 +}
 288.122 +
 288.123 +
 288.124 +public PersistentTreeMap without(Object key){
 288.125 +	Box found = new Box(null);
 288.126 +	Node t = remove(tree, key, found);
 288.127 +	if(t == null)
 288.128 +		{
 288.129 +		if(found.val == null)//null == doesn't contain key
 288.130 +			return this;
 288.131 +		//empty
 288.132 +		return new PersistentTreeMap(meta(), comp);
 288.133 +		}
 288.134 +	return new PersistentTreeMap(comp, t.blacken(), _count - 1, meta());
 288.135 +}
 288.136 +
 288.137 +public ISeq seq(){
 288.138 +	if(_count > 0)
 288.139 +		return Seq.create(tree, true, _count);
 288.140 +	return null;
 288.141 +}
 288.142 +
 288.143 +public IPersistentCollection empty(){
 288.144 +	return new PersistentTreeMap(meta(), comp);	
 288.145 +}
 288.146 +
 288.147 +public ISeq rseq() throws Exception{
 288.148 +	if(_count > 0)
 288.149 +		return Seq.create(tree, false, _count);
 288.150 +	return null;
 288.151 +}
 288.152 +
 288.153 +public Comparator comparator(){
 288.154 +	return comp;
 288.155 +}
 288.156 +
 288.157 +public Object entryKey(Object entry){
 288.158 +	return ((IMapEntry) entry).key();
 288.159 +}
 288.160 +
 288.161 +public ISeq seq(boolean ascending){
 288.162 +	if(_count > 0)
 288.163 +		return Seq.create(tree, ascending, _count);
 288.164 +	return null;
 288.165 +}
 288.166 +
 288.167 +public ISeq seqFrom(Object key, boolean ascending){
 288.168 +	if(_count > 0)
 288.169 +		{
 288.170 +		ISeq stack = null;
 288.171 +		Node t = tree;
 288.172 +		while(t != null)
 288.173 +			{
 288.174 +			int c = doCompare(key, t.key);
 288.175 +			if(c == 0)
 288.176 +				{
 288.177 +				stack = RT.cons(t, stack);
 288.178 +				return new Seq(stack, ascending);
 288.179 +				}
 288.180 +			else if(ascending)
 288.181 +				{
 288.182 +				if(c < 0)
 288.183 +					{
 288.184 +					stack = RT.cons(t, stack);
 288.185 +					t = t.left();
 288.186 +					}
 288.187 +				else
 288.188 +					t = t.right();
 288.189 +				}
 288.190 +			else
 288.191 +				{
 288.192 +				if(c > 0)
 288.193 +					{
 288.194 +					stack = RT.cons(t, stack);
 288.195 +					t = t.right();
 288.196 +					}
 288.197 +				else
 288.198 +					t = t.left();
 288.199 +				}
 288.200 +			}
 288.201 +		if(stack != null)
 288.202 +			return new Seq(stack, ascending);
 288.203 +		}
 288.204 +	return null;
 288.205 +}
 288.206 +
 288.207 +public NodeIterator iterator(){
 288.208 +	return new NodeIterator(tree, true);
 288.209 +}
 288.210 +
 288.211 +public NodeIterator reverseIterator(){
 288.212 +	return new NodeIterator(tree, false);
 288.213 +}
 288.214 +
 288.215 +public Iterator keys(){
 288.216 +	return keys(iterator());
 288.217 +}
 288.218 +
 288.219 +public Iterator vals(){
 288.220 +	return vals(iterator());
 288.221 +}
 288.222 +
 288.223 +public Iterator keys(NodeIterator it){
 288.224 +	return new KeyIterator(it);
 288.225 +}
 288.226 +
 288.227 +public Iterator vals(NodeIterator it){
 288.228 +	return new ValIterator(it);
 288.229 +}
 288.230 +
 288.231 +public Object minKey(){
 288.232 +	Node t = min();
 288.233 +	return t != null ? t.key : null;
 288.234 +}
 288.235 +
 288.236 +public Node min(){
 288.237 +	Node t = tree;
 288.238 +	if(t != null)
 288.239 +		{
 288.240 +		while(t.left() != null)
 288.241 +			t = t.left();
 288.242 +		}
 288.243 +	return t;
 288.244 +}
 288.245 +
 288.246 +public Object maxKey(){
 288.247 +	Node t = max();
 288.248 +	return t != null ? t.key : null;
 288.249 +}
 288.250 +
 288.251 +public Node max(){
 288.252 +	Node t = tree;
 288.253 +	if(t != null)
 288.254 +		{
 288.255 +		while(t.right() != null)
 288.256 +			t = t.right();
 288.257 +		}
 288.258 +	return t;
 288.259 +}
 288.260 +
 288.261 +public int depth(){
 288.262 +	return depth(tree);
 288.263 +}
 288.264 +
 288.265 +int depth(Node t){
 288.266 +	if(t == null)
 288.267 +		return 0;
 288.268 +	return 1 + Math.max(depth(t.left()), depth(t.right()));
 288.269 +}
 288.270 +
 288.271 +public Object valAt(Object key, Object notFound){
 288.272 +	Node n = entryAt(key);
 288.273 +	return (n != null) ? n.val() : notFound;
 288.274 +}
 288.275 +
 288.276 +public Object valAt(Object key){
 288.277 +	return valAt(key, null);
 288.278 +}
 288.279 +
 288.280 +public int capacity(){
 288.281 +	return _count;
 288.282 +}
 288.283 +
 288.284 +public int count(){
 288.285 +	return _count;
 288.286 +}
 288.287 +
 288.288 +public Node entryAt(Object key){
 288.289 +	Node t = tree;
 288.290 +	while(t != null)
 288.291 +		{
 288.292 +		int c = doCompare(key, t.key);
 288.293 +		if(c == 0)
 288.294 +			return t;
 288.295 +		else if(c < 0)
 288.296 +			t = t.left();
 288.297 +		else
 288.298 +			t = t.right();
 288.299 +		}
 288.300 +	return t;
 288.301 +}
 288.302 +
 288.303 +public int doCompare(Object k1, Object k2){
 288.304 +//	if(comp != null)
 288.305 +		return comp.compare(k1, k2);
 288.306 +//	return ((Comparable) k1).compareTo(k2);
 288.307 +}
 288.308 +
 288.309 +Node add(Node t, Object key, Object val, Box found){
 288.310 +	if(t == null)
 288.311 +		{
 288.312 +		if(val == null)
 288.313 +			return new Red(key);
 288.314 +		return new RedVal(key, val);
 288.315 +		}
 288.316 +	int c = doCompare(key, t.key);
 288.317 +	if(c == 0)
 288.318 +		{
 288.319 +		found.val = t;
 288.320 +		return null;
 288.321 +		}
 288.322 +	Node ins = c < 0 ? add(t.left(), key, val, found) : add(t.right(), key, val, found);
 288.323 +	if(ins == null) //found below
 288.324 +		return null;
 288.325 +	if(c < 0)
 288.326 +		return t.addLeft(ins);
 288.327 +	return t.addRight(ins);
 288.328 +}
 288.329 +
 288.330 +Node remove(Node t, Object key, Box found){
 288.331 +	if(t == null)
 288.332 +		return null; //not found indicator
 288.333 +	int c = doCompare(key, t.key);
 288.334 +	if(c == 0)
 288.335 +		{
 288.336 +		found.val = t;
 288.337 +		return append(t.left(), t.right());
 288.338 +		}
 288.339 +	Node del = c < 0 ? remove(t.left(), key, found) : remove(t.right(), key, found);
 288.340 +	if(del == null && found.val == null) //not found below
 288.341 +		return null;
 288.342 +	if(c < 0)
 288.343 +		{
 288.344 +		if(t.left() instanceof Black)
 288.345 +			return balanceLeftDel(t.key, t.val(), del, t.right());
 288.346 +		else
 288.347 +			return red(t.key, t.val(), del, t.right());
 288.348 +		}
 288.349 +	if(t.right() instanceof Black)
 288.350 +		return balanceRightDel(t.key, t.val(), t.left(), del);
 288.351 +	return red(t.key, t.val(), t.left(), del);
 288.352 +//		return t.removeLeft(del);
 288.353 +//	return t.removeRight(del);
 288.354 +}
 288.355 +
 288.356 +static Node append(Node left, Node right){
 288.357 +	if(left == null)
 288.358 +		return right;
 288.359 +	else if(right == null)
 288.360 +		return left;
 288.361 +	else if(left instanceof Red)
 288.362 +		{
 288.363 +		if(right instanceof Red)
 288.364 +			{
 288.365 +			Node app = append(left.right(), right.left());
 288.366 +			if(app instanceof Red)
 288.367 +				return red(app.key, app.val(),
 288.368 +				           red(left.key, left.val(), left.left(), app.left()),
 288.369 +				           red(right.key, right.val(), app.right(), right.right()));
 288.370 +			else
 288.371 +				return red(left.key, left.val(), left.left(), red(right.key, right.val(), app, right.right()));
 288.372 +			}
 288.373 +		else
 288.374 +			return red(left.key, left.val(), left.left(), append(left.right(), right));
 288.375 +		}
 288.376 +	else if(right instanceof Red)
 288.377 +		return red(right.key, right.val(), append(left, right.left()), right.right());
 288.378 +	else //black/black
 288.379 +		{
 288.380 +		Node app = append(left.right(), right.left());
 288.381 +		if(app instanceof Red)
 288.382 +			return red(app.key, app.val(),
 288.383 +			           black(left.key, left.val(), left.left(), app.left()),
 288.384 +			           black(right.key, right.val(), app.right(), right.right()));
 288.385 +		else
 288.386 +			return balanceLeftDel(left.key, left.val(), left.left(), black(right.key, right.val(), app, right.right()));
 288.387 +		}
 288.388 +}
 288.389 +
 288.390 +static Node balanceLeftDel(Object key, Object val, Node del, Node right){
 288.391 +	if(del instanceof Red)
 288.392 +		return red(key, val, del.blacken(), right);
 288.393 +	else if(right instanceof Black)
 288.394 +		return rightBalance(key, val, del, right.redden());
 288.395 +	else if(right instanceof Red && right.left() instanceof Black)
 288.396 +		return red(right.left().key, right.left().val(),
 288.397 +		           black(key, val, del, right.left().left()),
 288.398 +		           rightBalance(right.key, right.val(), right.left().right(), right.right().redden()));
 288.399 +	else
 288.400 +		throw new UnsupportedOperationException("Invariant violation");
 288.401 +}
 288.402 +
 288.403 +static Node balanceRightDel(Object key, Object val, Node left, Node del){
 288.404 +	if(del instanceof Red)
 288.405 +		return red(key, val, left, del.blacken());
 288.406 +	else if(left instanceof Black)
 288.407 +		return leftBalance(key, val, left.redden(), del);
 288.408 +	else if(left instanceof Red && left.right() instanceof Black)
 288.409 +		return red(left.right().key, left.right().val(),
 288.410 +		           leftBalance(left.key, left.val(), left.left().redden(), left.right().left()),
 288.411 +		           black(key, val, left.right().right(), del));
 288.412 +	else
 288.413 +		throw new UnsupportedOperationException("Invariant violation");
 288.414 +}
 288.415 +
 288.416 +static Node leftBalance(Object key, Object val, Node ins, Node right){
 288.417 +	if(ins instanceof Red && ins.left() instanceof Red)
 288.418 +		return red(ins.key, ins.val(), ins.left().blacken(), black(key, val, ins.right(), right));
 288.419 +	else if(ins instanceof Red && ins.right() instanceof Red)
 288.420 +		return red(ins.right().key, ins.right().val(),
 288.421 +		           black(ins.key, ins.val(), ins.left(), ins.right().left()),
 288.422 +		           black(key, val, ins.right().right(), right));
 288.423 +	else
 288.424 +		return black(key, val, ins, right);
 288.425 +}
 288.426 +
 288.427 +
 288.428 +static Node rightBalance(Object key, Object val, Node left, Node ins){
 288.429 +	if(ins instanceof Red && ins.right() instanceof Red)
 288.430 +		return red(ins.key, ins.val(), black(key, val, left, ins.left()), ins.right().blacken());
 288.431 +	else if(ins instanceof Red && ins.left() instanceof Red)
 288.432 +		return red(ins.left().key, ins.left().val(),
 288.433 +		           black(key, val, left, ins.left().left()),
 288.434 +		           black(ins.key, ins.val(), ins.left().right(), ins.right()));
 288.435 +	else
 288.436 +		return black(key, val, left, ins);
 288.437 +}
 288.438 +
 288.439 +Node replace(Node t, Object key, Object val){
 288.440 +	int c = doCompare(key, t.key);
 288.441 +	return t.replace(t.key,
 288.442 +	                 c == 0 ? val : t.val(),
 288.443 +	                 c < 0 ? replace(t.left(), key, val) : t.left(),
 288.444 +	                 c > 0 ? replace(t.right(), key, val) : t.right());
 288.445 +}
 288.446 +
 288.447 +PersistentTreeMap(Comparator comp, Node tree, int count, IPersistentMap meta){
 288.448 +	this._meta = meta;
 288.449 +	this.comp = comp;
 288.450 +	this.tree = tree;
 288.451 +	this._count = count;
 288.452 +}
 288.453 +
 288.454 +static Red red(Object key, Object val, Node left, Node right){
 288.455 +	if(left == null && right == null)
 288.456 +		{
 288.457 +		if(val == null)
 288.458 +			return new Red(key);
 288.459 +		return new RedVal(key, val);
 288.460 +		}
 288.461 +	if(val == null)
 288.462 +		return new RedBranch(key, left, right);
 288.463 +	return new RedBranchVal(key, val, left, right);
 288.464 +}
 288.465 +
 288.466 +static Black black(Object key, Object val, Node left, Node right){
 288.467 +	if(left == null && right == null)
 288.468 +		{
 288.469 +		if(val == null)
 288.470 +			return new Black(key);
 288.471 +		return new BlackVal(key, val);
 288.472 +		}
 288.473 +	if(val == null)
 288.474 +		return new BlackBranch(key, left, right);
 288.475 +	return new BlackBranchVal(key, val, left, right);
 288.476 +}
 288.477 +
 288.478 +public IPersistentMap meta(){
 288.479 +	return _meta;
 288.480 +}
 288.481 +
 288.482 +static abstract class Node extends AMapEntry{
 288.483 +	final Object key;
 288.484 +
 288.485 +	Node(Object key){
 288.486 +		this.key = key;
 288.487 +	}
 288.488 +
 288.489 +	public Object key(){
 288.490 +		return key;
 288.491 +	}
 288.492 +
 288.493 +	public Object val(){
 288.494 +		return null;
 288.495 +	}
 288.496 +
 288.497 +	public Object getKey(){
 288.498 +		return key();
 288.499 +	}
 288.500 +
 288.501 +	public Object getValue(){
 288.502 +		return val();
 288.503 +	}
 288.504 +
 288.505 +	Node left(){
 288.506 +		return null;
 288.507 +	}
 288.508 +
 288.509 +	Node right(){
 288.510 +		return null;
 288.511 +	}
 288.512 +
 288.513 +	abstract Node addLeft(Node ins);
 288.514 +
 288.515 +	abstract Node addRight(Node ins);
 288.516 +
 288.517 +	abstract Node removeLeft(Node del);
 288.518 +
 288.519 +	abstract Node removeRight(Node del);
 288.520 +
 288.521 +	abstract Node blacken();
 288.522 +
 288.523 +	abstract Node redden();
 288.524 +
 288.525 +	Node balanceLeft(Node parent){
 288.526 +		return black(parent.key, parent.val(), this, parent.right());
 288.527 +	}
 288.528 +
 288.529 +	Node balanceRight(Node parent){
 288.530 +		return black(parent.key, parent.val(), parent.left(), this);
 288.531 +	}
 288.532 +
 288.533 +	abstract Node replace(Object key, Object val, Node left, Node right);
 288.534 +
 288.535 +}
 288.536 +
 288.537 +static class Black extends Node{
 288.538 +	public Black(Object key){
 288.539 +		super(key);
 288.540 +	}
 288.541 +
 288.542 +	Node addLeft(Node ins){
 288.543 +		return ins.balanceLeft(this);
 288.544 +	}
 288.545 +
 288.546 +	Node addRight(Node ins){
 288.547 +		return ins.balanceRight(this);
 288.548 +	}
 288.549 +
 288.550 +	Node removeLeft(Node del){
 288.551 +		return balanceLeftDel(key, val(), del, right());
 288.552 +	}
 288.553 +
 288.554 +	Node removeRight(Node del){
 288.555 +		return balanceRightDel(key, val(), left(), del);
 288.556 +	}
 288.557 +
 288.558 +	Node blacken(){
 288.559 +		return this;
 288.560 +	}
 288.561 +
 288.562 +	Node redden(){
 288.563 +		return new Red(key);
 288.564 +	}
 288.565 +
 288.566 +	Node replace(Object key, Object val, Node left, Node right){
 288.567 +		return black(key, val, left, right);
 288.568 +	}
 288.569 +
 288.570 +}
 288.571 +
 288.572 +static class BlackVal extends Black{
 288.573 +	final Object val;
 288.574 +
 288.575 +	public BlackVal(Object key, Object val){
 288.576 +		super(key);
 288.577 +		this.val = val;
 288.578 +	}
 288.579 +
 288.580 +	public Object val(){
 288.581 +		return val;
 288.582 +	}
 288.583 +
 288.584 +	Node redden(){
 288.585 +		return new RedVal(key, val);
 288.586 +	}
 288.587 +
 288.588 +}
 288.589 +
 288.590 +static class BlackBranch extends Black{
 288.591 +	final Node left;
 288.592 +
 288.593 +	final Node right;
 288.594 +
 288.595 +	public BlackBranch(Object key, Node left, Node right){
 288.596 +		super(key);
 288.597 +		this.left = left;
 288.598 +		this.right = right;
 288.599 +	}
 288.600 +
 288.601 +	public Node left(){
 288.602 +		return left;
 288.603 +	}
 288.604 +
 288.605 +	public Node right(){
 288.606 +		return right;
 288.607 +	}
 288.608 +
 288.609 +	Node redden(){
 288.610 +		return new RedBranch(key, left, right);
 288.611 +	}
 288.612 +
 288.613 +}
 288.614 +
 288.615 +static class BlackBranchVal extends BlackBranch{
 288.616 +	final Object val;
 288.617 +
 288.618 +	public BlackBranchVal(Object key, Object val, Node left, Node right){
 288.619 +		super(key, left, right);
 288.620 +		this.val = val;
 288.621 +	}
 288.622 +
 288.623 +	public Object val(){
 288.624 +		return val;
 288.625 +	}
 288.626 +
 288.627 +	Node redden(){
 288.628 +		return new RedBranchVal(key, val, left, right);
 288.629 +	}
 288.630 +
 288.631 +}
 288.632 +
 288.633 +static class Red extends Node{
 288.634 +	public Red(Object key){
 288.635 +		super(key);
 288.636 +	}
 288.637 +
 288.638 +	Node addLeft(Node ins){
 288.639 +		return red(key, val(), ins, right());
 288.640 +	}
 288.641 +
 288.642 +	Node addRight(Node ins){
 288.643 +		return red(key, val(), left(), ins);
 288.644 +	}
 288.645 +
 288.646 +	Node removeLeft(Node del){
 288.647 +		return red(key, val(), del, right());
 288.648 +	}
 288.649 +
 288.650 +	Node removeRight(Node del){
 288.651 +		return red(key, val(), left(), del);
 288.652 +	}
 288.653 +
 288.654 +	Node blacken(){
 288.655 +		return new Black(key);
 288.656 +	}
 288.657 +
 288.658 +	Node redden(){
 288.659 +		throw new UnsupportedOperationException("Invariant violation");
 288.660 +	}
 288.661 +
 288.662 +	Node replace(Object key, Object val, Node left, Node right){
 288.663 +		return red(key, val, left, right);
 288.664 +	}
 288.665 +
 288.666 +}
 288.667 +
 288.668 +static class RedVal extends Red{
 288.669 +	final Object val;
 288.670 +
 288.671 +	public RedVal(Object key, Object val){
 288.672 +		super(key);
 288.673 +		this.val = val;
 288.674 +	}
 288.675 +
 288.676 +	public Object val(){
 288.677 +		return val;
 288.678 +	}
 288.679 +
 288.680 +	Node blacken(){
 288.681 +		return new BlackVal(key, val);
 288.682 +	}
 288.683 +
 288.684 +}
 288.685 +
 288.686 +static class RedBranch extends Red{
 288.687 +	final Node left;
 288.688 +
 288.689 +	final Node right;
 288.690 +
 288.691 +	public RedBranch(Object key, Node left, Node right){
 288.692 +		super(key);
 288.693 +		this.left = left;
 288.694 +		this.right = right;
 288.695 +	}
 288.696 +
 288.697 +	public Node left(){
 288.698 +		return left;
 288.699 +	}
 288.700 +
 288.701 +	public Node right(){
 288.702 +		return right;
 288.703 +	}
 288.704 +
 288.705 +	Node balanceLeft(Node parent){
 288.706 +		if(left instanceof Red)
 288.707 +			return red(key, val(), left.blacken(), black(parent.key, parent.val(), right, parent.right()));
 288.708 +		else if(right instanceof Red)
 288.709 +			return red(right.key, right.val(), black(key, val(), left, right.left()),
 288.710 +			           black(parent.key, parent.val(), right.right(), parent.right()));
 288.711 +		else
 288.712 +			return super.balanceLeft(parent);
 288.713 +
 288.714 +	}
 288.715 +
 288.716 +	Node balanceRight(Node parent){
 288.717 +		if(right instanceof Red)
 288.718 +			return red(key, val(), black(parent.key, parent.val(), parent.left(), left), right.blacken());
 288.719 +		else if(left instanceof Red)
 288.720 +			return red(left.key, left.val(), black(parent.key, parent.val(), parent.left(), left.left()),
 288.721 +			           black(key, val(), left.right(), right));
 288.722 +		else
 288.723 +			return super.balanceRight(parent);
 288.724 +	}
 288.725 +
 288.726 +	Node blacken(){
 288.727 +		return new BlackBranch(key, left, right);
 288.728 +	}
 288.729 +
 288.730 +}
 288.731 +
 288.732 +
 288.733 +static class RedBranchVal extends RedBranch{
 288.734 +	final Object val;
 288.735 +
 288.736 +	public RedBranchVal(Object key, Object val, Node left, Node right){
 288.737 +		super(key, left, right);
 288.738 +		this.val = val;
 288.739 +	}
 288.740 +
 288.741 +	public Object val(){
 288.742 +		return val;
 288.743 +	}
 288.744 +
 288.745 +	Node blacken(){
 288.746 +		return new BlackBranchVal(key, val, left, right);
 288.747 +	}
 288.748 +}
 288.749 +
 288.750 +
 288.751 +static public class Seq extends ASeq{
 288.752 +	final ISeq stack;
 288.753 +	final boolean asc;
 288.754 +	final int cnt;
 288.755 +
 288.756 +	public Seq(ISeq stack, boolean asc){
 288.757 +		this.stack = stack;
 288.758 +		this.asc = asc;
 288.759 +		this.cnt = -1;
 288.760 +	}
 288.761 +
 288.762 +	public Seq(ISeq stack, boolean asc, int cnt){
 288.763 +		this.stack = stack;
 288.764 +		this.asc = asc;
 288.765 +		this.cnt = cnt;
 288.766 +	}
 288.767 +
 288.768 +	Seq(IPersistentMap meta, ISeq stack, boolean asc, int cnt){
 288.769 +		super(meta);
 288.770 +		this.stack = stack;
 288.771 +		this.asc = asc;
 288.772 +		this.cnt = cnt;
 288.773 +	}
 288.774 +
 288.775 +	static Seq create(Node t, boolean asc, int cnt){
 288.776 +		return new Seq(push(t, null, asc), asc, cnt);
 288.777 +	}
 288.778 +
 288.779 +	static ISeq push(Node t, ISeq stack, boolean asc){
 288.780 +		while(t != null)
 288.781 +			{
 288.782 +			stack = RT.cons(t, stack);
 288.783 +			t = asc ? t.left() : t.right();
 288.784 +			}
 288.785 +		return stack;
 288.786 +	}
 288.787 +
 288.788 +	public Object first(){
 288.789 +		return stack.first();
 288.790 +	}
 288.791 +
 288.792 +	public ISeq next(){
 288.793 +		Node t = (Node) stack.first();
 288.794 +		ISeq nextstack = push(asc ? t.right() : t.left(), stack.next(), asc);
 288.795 +		if(nextstack != null)
 288.796 +			{
 288.797 +			return new Seq(nextstack, asc, cnt - 1);
 288.798 +			}
 288.799 +		return null;
 288.800 +	}
 288.801 +
 288.802 +	public int count(){
 288.803 +		if(cnt < 0)
 288.804 +			return super.count();
 288.805 +		return cnt;
 288.806 +	}
 288.807 +
 288.808 +	public Obj withMeta(IPersistentMap meta){
 288.809 +		return new Seq(meta, stack, asc, cnt);
 288.810 +	}
 288.811 +}
 288.812 +
 288.813 +static public class NodeIterator implements Iterator{
 288.814 +	Stack stack = new Stack();
 288.815 +	boolean asc;
 288.816 +
 288.817 +	NodeIterator(Node t, boolean asc){
 288.818 +		this.asc = asc;
 288.819 +		push(t);
 288.820 +	}
 288.821 +
 288.822 +	void push(Node t){
 288.823 +		while(t != null)
 288.824 +			{
 288.825 +			stack.push(t);
 288.826 +			t = asc ? t.left() : t.right();
 288.827 +			}
 288.828 +	}
 288.829 +
 288.830 +	public boolean hasNext(){
 288.831 +		return !stack.isEmpty();
 288.832 +	}
 288.833 +
 288.834 +	public Object next(){
 288.835 +		Node t = (Node) stack.pop();
 288.836 +		push(asc ? t.right() : t.left());
 288.837 +		return t;
 288.838 +	}
 288.839 +
 288.840 +	public void remove(){
 288.841 +		throw new UnsupportedOperationException();
 288.842 +	}
 288.843 +}
 288.844 +
 288.845 +static class KeyIterator implements Iterator{
 288.846 +	NodeIterator it;
 288.847 +
 288.848 +	KeyIterator(NodeIterator it){
 288.849 +		this.it = it;
 288.850 +	}
 288.851 +
 288.852 +	public boolean hasNext(){
 288.853 +		return it.hasNext();
 288.854 +	}
 288.855 +
 288.856 +	public Object next(){
 288.857 +		return ((Node) it.next()).key;
 288.858 +	}
 288.859 +
 288.860 +	public void remove(){
 288.861 +		throw new UnsupportedOperationException();
 288.862 +	}
 288.863 +}
 288.864 +
 288.865 +static class ValIterator implements Iterator{
 288.866 +	NodeIterator it;
 288.867 +
 288.868 +	ValIterator(NodeIterator it){
 288.869 +		this.it = it;
 288.870 +	}
 288.871 +
 288.872 +	public boolean hasNext(){
 288.873 +		return it.hasNext();
 288.874 +	}
 288.875 +
 288.876 +	public Object next(){
 288.877 +		return ((Node) it.next()).val();
 288.878 +	}
 288.879 +
 288.880 +	public void remove(){
 288.881 +		throw new UnsupportedOperationException();
 288.882 +	}
 288.883 +}
 288.884 +/*
 288.885 +static public void main(String args[]){
 288.886 +	if(args.length != 1)
 288.887 +		System.err.println("Usage: RBTree n");
 288.888 +	int n = Integer.parseInt(args[0]);
 288.889 +	Integer[] ints = new Integer[n];
 288.890 +	for(int i = 0; i < ints.length; i++)
 288.891 +		{
 288.892 +		ints[i] = i;
 288.893 +		}
 288.894 +	Collections.shuffle(Arrays.asList(ints));
 288.895 +	//force the ListMap class loading now
 288.896 +//	try
 288.897 +//		{
 288.898 +//
 288.899 +//		//PersistentListMap.EMPTY.assocEx(1, null).assocEx(2,null).assocEx(3,null);
 288.900 +//		}
 288.901 +//	catch(Exception e)
 288.902 +//		{
 288.903 +//		e.printStackTrace();  //To change body of catch statement use File | Settings | File Templates.
 288.904 +//		}
 288.905 +	System.out.println("Building set");
 288.906 +	//IPersistentMap set = new PersistentArrayMap();
 288.907 +	//IPersistentMap set = new PersistentHashtableMap(1001);
 288.908 +	IPersistentMap set = PersistentHashMap.EMPTY;
 288.909 +	//IPersistentMap set = new ListMap();
 288.910 +	//IPersistentMap set = new ArrayMap();
 288.911 +	//IPersistentMap set = new PersistentTreeMap();
 288.912 +//	for(int i = 0; i < ints.length; i++)
 288.913 +//		{
 288.914 +//		Integer anInt = ints[i];
 288.915 +//		set = set.add(anInt);
 288.916 +//		}
 288.917 +	long startTime = System.nanoTime();
 288.918 +	for(Integer anInt : ints)
 288.919 +		{
 288.920 +		set = set.assoc(anInt, anInt);
 288.921 +		}
 288.922 +	//System.out.println("_count = " + set.count());
 288.923 +
 288.924 +//	System.out.println("_count = " + set._count + ", min: " + set.minKey() + ", max: " + set.maxKey()
 288.925 +//	                   + ", depth: " + set.depth());
 288.926 +	for(Object aSet : set)
 288.927 +		{
 288.928 +		IMapEntry o = (IMapEntry) aSet;
 288.929 +		if(!set.contains(o.key()))
 288.930 +			System.err.println("Can't find: " + o.key());
 288.931 +		//else if(n < 2000)
 288.932 +		//	System.out.print(o.key().toString() + ",");
 288.933 +		}
 288.934 +
 288.935 +	Random rand = new Random(42);
 288.936 +	for(int i = 0; i < ints.length / 2; i++)
 288.937 +		{
 288.938 +		Integer anInt = ints[rand.nextInt(n)];
 288.939 +		set = set.without(anInt);
 288.940 +		}
 288.941 +
 288.942 +	long estimatedTime = System.nanoTime() - startTime;
 288.943 +	System.out.println();
 288.944 +
 288.945 +	System.out.println("_count = " + set.count() + ", time: " + estimatedTime / 1000000);
 288.946 +
 288.947 +	System.out.println("Building ht");
 288.948 +	Hashtable ht = new Hashtable(1001);
 288.949 +	startTime = System.nanoTime();
 288.950 +//	for(int i = 0; i < ints.length; i++)
 288.951 +//		{
 288.952 +//		Integer anInt = ints[i];
 288.953 +//		ht.put(anInt,null);
 288.954 +//		}
 288.955 +	for(Integer anInt : ints)
 288.956 +		{
 288.957 +		ht.put(anInt, anInt);
 288.958 +		}
 288.959 +	//System.out.println("size = " + ht.size());
 288.960 +	//Iterator it = ht.entrySet().iterator();
 288.961 +	for(Object o1 : ht.entrySet())
 288.962 +		{
 288.963 +		Map.Entry o = (Map.Entry) o1;
 288.964 +		if(!ht.containsKey(o.getKey()))
 288.965 +			System.err.println("Can't find: " + o);
 288.966 +		//else if(n < 2000)
 288.967 +		//	System.out.print(o.toString() + ",");
 288.968 +		}
 288.969 +
 288.970 +	rand = new Random(42);
 288.971 +	for(int i = 0; i < ints.length / 2; i++)
 288.972 +		{
 288.973 +		Integer anInt = ints[rand.nextInt(n)];
 288.974 +		ht.remove(anInt);
 288.975 +		}
 288.976 +	estimatedTime = System.nanoTime() - startTime;
 288.977 +	System.out.println();
 288.978 +	System.out.println("size = " + ht.size() + ", time: " + estimatedTime / 1000000);
 288.979 +
 288.980 +	System.out.println("set lookup");
 288.981 +	startTime = System.nanoTime();
 288.982 +	int c = 0;
 288.983 +	for(Integer anInt : ints)
 288.984 +		{
 288.985 +		if(!set.contains(anInt))
 288.986 +			++c;
 288.987 +		}
 288.988 +	estimatedTime = System.nanoTime() - startTime;
 288.989 +	System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000);
 288.990 +
 288.991 +	System.out.println("ht lookup");
 288.992 +	startTime = System.nanoTime();
 288.993 +	c = 0;
 288.994 +	for(Integer anInt : ints)
 288.995 +		{
 288.996 +		if(!ht.containsKey(anInt))
 288.997 +			++c;
 288.998 +		}
 288.999 +	estimatedTime = System.nanoTime() - startTime;
288.1000 +	System.out.println("notfound = " + c + ", time: " + estimatedTime / 1000000);
288.1001 +
288.1002 +//	System.out.println("_count = " + set._count + ", min: " + set.minKey() + ", max: " + set.maxKey()
288.1003 +//	                   + ", depth: " + set.depth());
288.1004 +}
288.1005 +*/
288.1006 +}
   289.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   289.2 +++ b/src/clojure/lang/PersistentTreeSet.java	Sat Aug 21 06:25:44 2010 -0400
   289.3 @@ -0,0 +1,90 @@
   289.4 +/**
   289.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   289.6 + *   The use and distribution terms for this software are covered by the
   289.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   289.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   289.9 + *   By using this software in any fashion, you are agreeing to be bound by
  289.10 + * 	 the terms of this license.
  289.11 + *   You must not remove this notice, or any other, from this software.
  289.12 + **/
  289.13 +
  289.14 +/* rich Mar 3, 2008 */
  289.15 +
  289.16 +package clojure.lang;
  289.17 +
  289.18 +import java.util.Comparator;
  289.19 +
  289.20 +public class PersistentTreeSet extends APersistentSet implements IObj, Reversible, Sorted{
  289.21 +static public final PersistentTreeSet EMPTY = new PersistentTreeSet(null, PersistentTreeMap.EMPTY);
  289.22 +final IPersistentMap _meta;
  289.23 +
  289.24 +
  289.25 +static public PersistentTreeSet create(ISeq items){
  289.26 +	PersistentTreeSet ret = EMPTY;
  289.27 +	for(; items != null; items = items.next())
  289.28 +		{
  289.29 +		ret = (PersistentTreeSet) ret.cons(items.first());
  289.30 +		}
  289.31 +	return ret;
  289.32 +}
  289.33 +
  289.34 +static public PersistentTreeSet create(Comparator comp, ISeq items){
  289.35 +	PersistentTreeSet ret = new PersistentTreeSet(null, new PersistentTreeMap(null, comp));
  289.36 +	for(; items != null; items = items.next())
  289.37 +		{
  289.38 +		ret = (PersistentTreeSet) ret.cons(items.first());
  289.39 +		}
  289.40 +	return ret;
  289.41 +}
  289.42 +
  289.43 +PersistentTreeSet(IPersistentMap meta, IPersistentMap impl){
  289.44 +	super(impl);
  289.45 +	this._meta = meta;
  289.46 +}
  289.47 +
  289.48 +public IPersistentSet disjoin(Object key) throws Exception{
  289.49 +	if(contains(key))
  289.50 +		return new PersistentTreeSet(meta(),impl.without(key));
  289.51 +	return this;
  289.52 +}
  289.53 +
  289.54 +public IPersistentSet cons(Object o){
  289.55 +	if(contains(o))
  289.56 +		return this;
  289.57 +	return new PersistentTreeSet(meta(),impl.assoc(o,o));
  289.58 +}
  289.59 +
  289.60 +public IPersistentCollection empty(){
  289.61 +	return new PersistentTreeSet(meta(),(PersistentTreeMap)impl.empty());
  289.62 +}
  289.63 +
  289.64 +public ISeq rseq() throws Exception{
  289.65 +	return APersistentMap.KeySeq.create(((Reversible) impl).rseq());
  289.66 +}
  289.67 +
  289.68 +public PersistentTreeSet withMeta(IPersistentMap meta){
  289.69 +	return new PersistentTreeSet(meta, impl);
  289.70 +}
  289.71 +
  289.72 +public Comparator comparator(){
  289.73 +	return ((Sorted)impl).comparator();
  289.74 +}
  289.75 +
  289.76 +public Object entryKey(Object entry){
  289.77 +	return entry;
  289.78 +}
  289.79 +
  289.80 +public ISeq seq(boolean ascending){
  289.81 +	PersistentTreeMap m = (PersistentTreeMap) impl;
  289.82 +	return RT.keys(m.seq(ascending));
  289.83 +}
  289.84 +
  289.85 +public ISeq seqFrom(Object key, boolean ascending){
  289.86 +	PersistentTreeMap m = (PersistentTreeMap) impl;
  289.87 +	return RT.keys(m.seqFrom(key,ascending));
  289.88 +}
  289.89 +
  289.90 +public IPersistentMap meta(){
  289.91 +	return _meta;
  289.92 +}
  289.93 +}
   290.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   290.2 +++ b/src/clojure/lang/PersistentVector.java	Sat Aug 21 06:25:44 2010 -0400
   290.3 @@ -0,0 +1,748 @@
   290.4 +/**
   290.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   290.6 + *   The use and distribution terms for this software are covered by the
   290.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   290.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   290.9 + *   By using this software in any fashion, you are agreeing to be bound by
  290.10 + * 	 the terms of this license.
  290.11 + *   You must not remove this notice, or any other, from this software.
  290.12 + **/
  290.13 +
  290.14 +/* rich Jul 5, 2007 */
  290.15 +
  290.16 +package clojure.lang;
  290.17 +
  290.18 +import java.io.Serializable;
  290.19 +import java.util.List;
  290.20 +import java.util.concurrent.atomic.AtomicReference;
  290.21 +
  290.22 +public class PersistentVector extends APersistentVector implements IObj, IEditableCollection{
  290.23 +
  290.24 +static class Node implements Serializable {
  290.25 +	transient final AtomicReference<Thread> edit;
  290.26 +	final Object[] array;
  290.27 +
  290.28 +	Node(AtomicReference<Thread> edit, Object[] array){
  290.29 +		this.edit = edit;
  290.30 +		this.array = array;
  290.31 +	}
  290.32 +
  290.33 +	Node(AtomicReference<Thread> edit){
  290.34 +		this.edit = edit;
  290.35 +		this.array = new Object[32];
  290.36 +	}
  290.37 +}
  290.38 +
  290.39 +final static AtomicReference<Thread> NOEDIT = new AtomicReference<Thread>(null);
  290.40 +final static Node EMPTY_NODE = new Node(NOEDIT, new Object[32]);
  290.41 +
  290.42 +final int cnt;
  290.43 +final int shift;
  290.44 +final Node root;
  290.45 +final Object[] tail;
  290.46 +final IPersistentMap _meta;
  290.47 +
  290.48 +
  290.49 +public final static PersistentVector EMPTY = new PersistentVector(0, 5, EMPTY_NODE, new Object[]{});
  290.50 +
  290.51 +static public PersistentVector create(ISeq items){
  290.52 +	TransientVector ret = EMPTY.asTransient();
  290.53 +	for(; items != null; items = items.next())
  290.54 +		ret = ret.conj(items.first());
  290.55 +	return ret.persistent();
  290.56 +}
  290.57 +
  290.58 +static public PersistentVector create(List items){
  290.59 +	TransientVector ret = EMPTY.asTransient();
  290.60 +	for(Object item : items)
  290.61 +		ret = ret.conj(item);
  290.62 +	return ret.persistent();
  290.63 +}
  290.64 +
  290.65 +static public PersistentVector create(Object... items){
  290.66 +	TransientVector ret = EMPTY.asTransient();
  290.67 +	for(Object item : items)
  290.68 +		ret = ret.conj(item);
  290.69 +	return ret.persistent();
  290.70 +}
  290.71 +
  290.72 +PersistentVector(int cnt, int shift, Node root, Object[] tail){
  290.73 +	this._meta = null;
  290.74 +	this.cnt = cnt;
  290.75 +	this.shift = shift;
  290.76 +	this.root = root;
  290.77 +	this.tail = tail;
  290.78 +}
  290.79 +
  290.80 +
  290.81 +PersistentVector(IPersistentMap meta, int cnt, int shift, Node root, Object[] tail){
  290.82 +	this._meta = meta;
  290.83 +	this.cnt = cnt;
  290.84 +	this.shift = shift;
  290.85 +	this.root = root;
  290.86 +	this.tail = tail;
  290.87 +}
  290.88 +
  290.89 +public TransientVector asTransient(){
  290.90 +	return new TransientVector(this);
  290.91 +}
  290.92 +
  290.93 +final int tailoff(){
  290.94 +	if(cnt < 32)
  290.95 +		return 0;
  290.96 +	return ((cnt - 1) >>> 5) << 5;
  290.97 +}
  290.98 +
  290.99 +public Object[] arrayFor(int i){
 290.100 +	if(i >= 0 && i < cnt)
 290.101 +		{
 290.102 +		if(i >= tailoff())
 290.103 +			return tail;
 290.104 +		Node node = root;
 290.105 +		for(int level = shift; level > 0; level -= 5)
 290.106 +			node = (Node) node.array[(i >>> level) & 0x01f];
 290.107 +		return node.array;
 290.108 +		}
 290.109 +	throw new IndexOutOfBoundsException();
 290.110 +}
 290.111 +
 290.112 +public Object nth(int i){
 290.113 +	Object[] node = arrayFor(i);
 290.114 +	return node[i & 0x01f];
 290.115 +}
 290.116 +
 290.117 +public Object nth(int i, Object notFound){
 290.118 +	if(i >= 0 && i < cnt)
 290.119 +		return nth(i);
 290.120 +	return notFound;
 290.121 +}
 290.122 +
 290.123 +public PersistentVector assocN(int i, Object val){
 290.124 +	if(i >= 0 && i < cnt)
 290.125 +		{
 290.126 +		if(i >= tailoff())
 290.127 +			{
 290.128 +			Object[] newTail = new Object[tail.length];
 290.129 +			System.arraycopy(tail, 0, newTail, 0, tail.length);
 290.130 +			newTail[i & 0x01f] = val;
 290.131 +
 290.132 +			return new PersistentVector(meta(), cnt, shift, root, newTail);
 290.133 +			}
 290.134 +
 290.135 +		return new PersistentVector(meta(), cnt, shift, doAssoc(shift, root, i, val), tail);
 290.136 +		}
 290.137 +	if(i == cnt)
 290.138 +		return cons(val);
 290.139 +	throw new IndexOutOfBoundsException();
 290.140 +}
 290.141 +
 290.142 +private static Node doAssoc(int level, Node node, int i, Object val){
 290.143 +	Node ret = new Node(node.edit,node.array.clone());
 290.144 +	if(level == 0)
 290.145 +		{
 290.146 +		ret.array[i & 0x01f] = val;
 290.147 +		}
 290.148 +	else
 290.149 +		{
 290.150 +		int subidx = (i >>> level) & 0x01f;
 290.151 +		ret.array[subidx] = doAssoc(level - 5, (Node) node.array[subidx], i, val);
 290.152 +		}
 290.153 +	return ret;
 290.154 +}
 290.155 +
 290.156 +public int count(){
 290.157 +	return cnt;
 290.158 +}
 290.159 +
 290.160 +public PersistentVector withMeta(IPersistentMap meta){
 290.161 +	return new PersistentVector(meta, cnt, shift, root, tail);
 290.162 +}
 290.163 +
 290.164 +public IPersistentMap meta(){
 290.165 +	return _meta;
 290.166 +}
 290.167 +
 290.168 +
 290.169 +public PersistentVector cons(Object val){
 290.170 +	int i = cnt;
 290.171 +	//room in tail?
 290.172 +//	if(tail.length < 32)
 290.173 +	if(cnt - tailoff() < 32)
 290.174 +		{
 290.175 +		Object[] newTail = new Object[tail.length + 1];
 290.176 +		System.arraycopy(tail, 0, newTail, 0, tail.length);
 290.177 +		newTail[tail.length] = val;
 290.178 +		return new PersistentVector(meta(), cnt + 1, shift, root, newTail);
 290.179 +		}
 290.180 +	//full tail, push into tree
 290.181 +	Node newroot;
 290.182 +	Node tailnode = new Node(root.edit,tail);
 290.183 +	int newshift = shift;
 290.184 +	//overflow root?
 290.185 +	if((cnt >>> 5) > (1 << shift))
 290.186 +		{
 290.187 +		newroot = new Node(root.edit);
 290.188 +		newroot.array[0] = root;
 290.189 +		newroot.array[1] = newPath(root.edit,shift, tailnode);
 290.190 +		newshift += 5;
 290.191 +		}
 290.192 +	else
 290.193 +		newroot = pushTail(shift, root, tailnode);
 290.194 +	return new PersistentVector(meta(), cnt + 1, newshift, newroot, new Object[]{val});
 290.195 +}
 290.196 +
 290.197 +private Node pushTail(int level, Node parent, Node tailnode){
 290.198 +	//if parent is leaf, insert node,
 290.199 +	// else does it map to an existing child? -> nodeToInsert = pushNode one more level
 290.200 +	// else alloc new path
 290.201 +	//return  nodeToInsert placed in copy of parent
 290.202 +	int subidx = ((cnt - 1) >>> level) & 0x01f;
 290.203 +	Node ret = new Node(parent.edit, parent.array.clone());
 290.204 +	Node nodeToInsert;
 290.205 +	if(level == 5)
 290.206 +		{
 290.207 +		nodeToInsert = tailnode;
 290.208 +		}
 290.209 +	else
 290.210 +		{
 290.211 +		Node child = (Node) parent.array[subidx];
 290.212 +		nodeToInsert = (child != null)?
 290.213 +		                pushTail(level-5,child, tailnode)
 290.214 +		                :newPath(root.edit,level-5, tailnode);
 290.215 +		}
 290.216 +	ret.array[subidx] = nodeToInsert;
 290.217 +	return ret;
 290.218 +}
 290.219 +
 290.220 +private static Node newPath(AtomicReference<Thread> edit,int level, Node node){
 290.221 +	if(level == 0)
 290.222 +		return node;
 290.223 +	Node ret = new Node(edit);
 290.224 +	ret.array[0] = newPath(edit, level - 5, node);
 290.225 +	return ret;
 290.226 +}
 290.227 +
 290.228 +public IChunkedSeq chunkedSeq(){
 290.229 +	if(count() == 0)
 290.230 +		return null;
 290.231 +	return new ChunkedSeq(this,0,0);
 290.232 +}
 290.233 +
 290.234 +public ISeq seq(){
 290.235 +	return chunkedSeq();
 290.236 +}
 290.237 +
 290.238 +static public final class ChunkedSeq extends ASeq implements IChunkedSeq{
 290.239 +
 290.240 +	public final PersistentVector vec;
 290.241 +	final Object[] node;
 290.242 +	final int i;
 290.243 +	public final int offset;
 290.244 +
 290.245 +	public ChunkedSeq(PersistentVector vec, int i, int offset){
 290.246 +		this.vec = vec;
 290.247 +		this.i = i;
 290.248 +		this.offset = offset;
 290.249 +		this.node = vec.arrayFor(i);
 290.250 +	}
 290.251 +
 290.252 +	ChunkedSeq(IPersistentMap meta, PersistentVector vec, Object[] node, int i, int offset){
 290.253 +		super(meta);
 290.254 +		this.vec = vec;
 290.255 +		this.node = node;
 290.256 +		this.i = i;
 290.257 +		this.offset = offset;
 290.258 +	}
 290.259 +
 290.260 +	ChunkedSeq(PersistentVector vec, Object[] node, int i, int offset){
 290.261 +		this.vec = vec;
 290.262 +		this.node = node;
 290.263 +		this.i = i;
 290.264 +		this.offset = offset;
 290.265 +	}
 290.266 +
 290.267 +	public IChunk chunkedFirst() throws Exception{
 290.268 +		return new ArrayChunk(node, offset);
 290.269 +		}
 290.270 +
 290.271 +	public ISeq chunkedNext(){
 290.272 +		if(i + node.length < vec.cnt)
 290.273 +			return new ChunkedSeq(vec,i+ node.length,0);
 290.274 +		return null;
 290.275 +		}
 290.276 +
 290.277 +	public ISeq chunkedMore(){
 290.278 +		ISeq s = chunkedNext();
 290.279 +		if(s == null)
 290.280 +			return PersistentList.EMPTY;
 290.281 +		return s;
 290.282 +	}
 290.283 +
 290.284 +	public Obj withMeta(IPersistentMap meta){
 290.285 +		if(meta == this._meta)
 290.286 +			return this;
 290.287 +		return new ChunkedSeq(meta, vec, node, i, offset);
 290.288 +	}
 290.289 +
 290.290 +	public Object first(){
 290.291 +		return node[offset];
 290.292 +	}
 290.293 +
 290.294 +	public ISeq next(){
 290.295 +		if(offset + 1 < node.length)
 290.296 +			return new ChunkedSeq(vec, node, i, offset + 1);
 290.297 +		return chunkedNext();
 290.298 +	}
 290.299 +}
 290.300 +
 290.301 +public IPersistentCollection empty(){
 290.302 +	return EMPTY.withMeta(meta());
 290.303 +}
 290.304 +
 290.305 +//private Node pushTail(int level, Node node, Object[] tailNode, Box expansion){
 290.306 +//	Object newchild;
 290.307 +//	if(level == 0)
 290.308 +//		{
 290.309 +//		newchild = tailNode;
 290.310 +//		}
 290.311 +//	else
 290.312 +//		{
 290.313 +//		newchild = pushTail(level - 5, (Object[]) arr[arr.length - 1], tailNode, expansion);
 290.314 +//		if(expansion.val == null)
 290.315 +//			{
 290.316 +//			Object[] ret = arr.clone();
 290.317 +//			ret[arr.length - 1] = newchild;
 290.318 +//			return ret;
 290.319 +//			}
 290.320 +//		else
 290.321 +//			newchild = expansion.val;
 290.322 +//		}
 290.323 +//	//expansion
 290.324 +//	if(arr.length == 32)
 290.325 +//		{
 290.326 +//		expansion.val = new Object[]{newchild};
 290.327 +//		return arr;
 290.328 +//		}
 290.329 +//	Object[] ret = new Object[arr.length + 1];
 290.330 +//	System.arraycopy(arr, 0, ret, 0, arr.length);
 290.331 +//	ret[arr.length] = newchild;
 290.332 +//	expansion.val = null;
 290.333 +//	return ret;
 290.334 +//}
 290.335 +
 290.336 +public PersistentVector pop(){
 290.337 +	if(cnt == 0)
 290.338 +		throw new IllegalStateException("Can't pop empty vector");
 290.339 +	if(cnt == 1)
 290.340 +		return EMPTY.withMeta(meta());
 290.341 +	//if(tail.length > 1)
 290.342 +	if(cnt-tailoff() > 1)
 290.343 +		{
 290.344 +		Object[] newTail = new Object[tail.length - 1];
 290.345 +		System.arraycopy(tail, 0, newTail, 0, newTail.length);
 290.346 +		return new PersistentVector(meta(), cnt - 1, shift, root, newTail);
 290.347 +		}
 290.348 +	Object[] newtail = arrayFor(cnt - 2);
 290.349 +
 290.350 +	Node newroot = popTail(shift, root);
 290.351 +	int newshift = shift;
 290.352 +	if(newroot == null)
 290.353 +		{
 290.354 +		newroot = EMPTY_NODE;
 290.355 +		}
 290.356 +	if(shift > 5 && newroot.array[1] == null)
 290.357 +		{
 290.358 +		newroot = (Node) newroot.array[0];
 290.359 +		newshift -= 5;
 290.360 +		}
 290.361 +	return new PersistentVector(meta(), cnt - 1, newshift, newroot, newtail);
 290.362 +}
 290.363 +
 290.364 +private Node popTail(int level, Node node){
 290.365 +	int subidx = ((cnt-2) >>> level) & 0x01f;
 290.366 +	if(level > 5)
 290.367 +		{
 290.368 +		Node newchild = popTail(level - 5, (Node) node.array[subidx]);
 290.369 +		if(newchild == null && subidx == 0)
 290.370 +			return null;
 290.371 +		else
 290.372 +			{
 290.373 +			Node ret = new Node(root.edit, node.array.clone());
 290.374 +			ret.array[subidx] = newchild;
 290.375 +			return ret;
 290.376 +			}
 290.377 +		}
 290.378 +	else if(subidx == 0)
 290.379 +		return null;
 290.380 +	else
 290.381 +		{
 290.382 +		Node ret = new Node(root.edit, node.array.clone());
 290.383 +		ret.array[subidx] = null;
 290.384 +		return ret;
 290.385 +		}
 290.386 +}
 290.387 +
 290.388 +static final class TransientVector extends AFn implements ITransientVector, Counted{
 290.389 +	int cnt;
 290.390 +	int shift;
 290.391 +	Node root;
 290.392 +	Object[] tail;
 290.393 +
 290.394 +	TransientVector(int cnt, int shift, Node root, Object[] tail){
 290.395 +		this.cnt = cnt;
 290.396 +		this.shift = shift;
 290.397 +		this.root = root;
 290.398 +		this.tail = tail;
 290.399 +	}
 290.400 +
 290.401 +	TransientVector(PersistentVector v){
 290.402 +		this(v.cnt, v.shift, editableRoot(v.root), editableTail(v.tail));
 290.403 +	}
 290.404 +
 290.405 +	public int count(){
 290.406 +		ensureEditable();
 290.407 +		return cnt;
 290.408 +	}
 290.409 +	
 290.410 +	Node ensureEditable(Node node){
 290.411 +		if(node.edit == root.edit)
 290.412 +			return node;
 290.413 +		return new Node(root.edit, node.array.clone());
 290.414 +	}
 290.415 +
 290.416 +	void ensureEditable(){
 290.417 +		Thread owner = root.edit.get();
 290.418 +		if(owner == Thread.currentThread())
 290.419 +			return;
 290.420 +		if(owner != null)
 290.421 +			throw new IllegalAccessError("Transient used by non-owner thread");
 290.422 +		throw new IllegalAccessError("Transient used after persistent! call");
 290.423 +
 290.424 +//		root = editableRoot(root);
 290.425 +//		tail = editableTail(tail);
 290.426 +	}
 290.427 +
 290.428 +	static Node editableRoot(Node node){
 290.429 +		return new Node(new AtomicReference<Thread>(Thread.currentThread()), node.array.clone());
 290.430 +	}
 290.431 +
 290.432 +	public PersistentVector persistent(){
 290.433 +		ensureEditable();
 290.434 +//		Thread owner = root.edit.get();
 290.435 +//		if(owner != null && owner != Thread.currentThread())
 290.436 +//			{
 290.437 +//			throw new IllegalAccessError("Mutation release by non-owner thread");
 290.438 +//			}
 290.439 +		root.edit.set(null);
 290.440 +		Object[] trimmedTail = new Object[cnt-tailoff()];
 290.441 +		System.arraycopy(tail,0,trimmedTail,0,trimmedTail.length);
 290.442 +		return new PersistentVector(cnt, shift, root, trimmedTail);
 290.443 +	}
 290.444 +
 290.445 +	static Object[] editableTail(Object[] tl){
 290.446 +		Object[] ret = new Object[32];
 290.447 +		System.arraycopy(tl,0,ret,0,tl.length);
 290.448 +		return ret;
 290.449 +	}
 290.450 +
 290.451 +	public TransientVector conj(Object val){
 290.452 +		ensureEditable();
 290.453 +		int i = cnt;
 290.454 +		//room in tail?
 290.455 +		if(i - tailoff() < 32)
 290.456 +			{
 290.457 +			tail[i & 0x01f] = val;
 290.458 +			++cnt;
 290.459 +			return this;
 290.460 +			}
 290.461 +		//full tail, push into tree
 290.462 +		Node newroot;
 290.463 +		Node tailnode = new Node(root.edit, tail);
 290.464 +		tail = new Object[32];
 290.465 +		tail[0] = val;
 290.466 +		int newshift = shift;
 290.467 +		//overflow root?
 290.468 +		if((cnt >>> 5) > (1 << shift))
 290.469 +			{
 290.470 +			newroot = new Node(root.edit);
 290.471 +			newroot.array[0] = root;
 290.472 +			newroot.array[1] = newPath(root.edit,shift, tailnode);
 290.473 +			newshift += 5;
 290.474 +			}
 290.475 +		else
 290.476 +			newroot = pushTail(shift, root, tailnode);
 290.477 +		root = newroot;
 290.478 +		shift = newshift;
 290.479 +		++cnt;
 290.480 +		return this;
 290.481 +	}
 290.482 +
 290.483 +	private Node pushTail(int level, Node parent, Node tailnode){
 290.484 +		//if parent is leaf, insert node,
 290.485 +		// else does it map to an existing child? -> nodeToInsert = pushNode one more level
 290.486 +		// else alloc new path
 290.487 +		//return  nodeToInsert placed in parent
 290.488 +		parent = ensureEditable(parent);
 290.489 +		int subidx = ((cnt - 1) >>> level) & 0x01f;
 290.490 +		Node ret = parent;
 290.491 +		Node nodeToInsert;
 290.492 +		if(level == 5)
 290.493 +			{
 290.494 +			nodeToInsert = tailnode;
 290.495 +			}
 290.496 +		else
 290.497 +			{
 290.498 +			Node child = (Node) parent.array[subidx];
 290.499 +			nodeToInsert = (child != null) ?
 290.500 +			               pushTail(level - 5, child, tailnode)
 290.501 +			                               : newPath(root.edit, level - 5, tailnode);
 290.502 +			}
 290.503 +		ret.array[subidx] = nodeToInsert;
 290.504 +		return ret;
 290.505 +	}
 290.506 +
 290.507 +	final private int tailoff(){
 290.508 +		if(cnt < 32)
 290.509 +			return 0;
 290.510 +		return ((cnt-1) >>> 5) << 5;
 290.511 +	}
 290.512 +
 290.513 +	private Object[] arrayFor(int i){
 290.514 +		if(i >= 0 && i < cnt)
 290.515 +			{
 290.516 +			if(i >= tailoff())
 290.517 +				return tail;
 290.518 +			Node node = root;
 290.519 +			for(int level = shift; level > 0; level -= 5)
 290.520 +				node = (Node) node.array[(i >>> level) & 0x01f];
 290.521 +			return node.array;
 290.522 +			}
 290.523 +		throw new IndexOutOfBoundsException();
 290.524 +	}
 290.525 +
 290.526 +	public Object valAt(Object key){
 290.527 +		//note - relies on ensureEditable in 2-arg valAt
 290.528 +		return valAt(key, null);
 290.529 +	}
 290.530 +
 290.531 +	public Object valAt(Object key, Object notFound){
 290.532 +		ensureEditable();
 290.533 +		if(Util.isInteger(key))
 290.534 +			{
 290.535 +			int i = ((Number) key).intValue();
 290.536 +			if(i >= 0 && i < cnt)
 290.537 +				return nth(i);
 290.538 +			}
 290.539 +		return notFound;
 290.540 +	}
 290.541 +
 290.542 +	public Object invoke(Object arg1) throws Exception{
 290.543 +		//note - relies on ensureEditable in nth
 290.544 +		if(Util.isInteger(arg1))
 290.545 +			return nth(((Number) arg1).intValue());
 290.546 +		throw new IllegalArgumentException("Key must be integer");
 290.547 +	}
 290.548 +
 290.549 +	public Object nth(int i){
 290.550 +		ensureEditable();
 290.551 +		Object[] node = arrayFor(i);
 290.552 +		return node[i & 0x01f];
 290.553 +	}
 290.554 +
 290.555 +	public Object nth(int i, Object notFound){
 290.556 +		if(i >= 0 && i < count())
 290.557 +			return nth(i);
 290.558 +		return notFound;
 290.559 +	}
 290.560 +
 290.561 +	public TransientVector assocN(int i, Object val){
 290.562 +		ensureEditable();
 290.563 +		if(i >= 0 && i < cnt)
 290.564 +			{
 290.565 +			if(i >= tailoff())
 290.566 +				{
 290.567 +				tail[i & 0x01f] = val;
 290.568 +				return this;
 290.569 +				}
 290.570 +
 290.571 +			root = doAssoc(shift, root, i, val);
 290.572 +			return this;
 290.573 +			}
 290.574 +		if(i == cnt)
 290.575 +			return conj(val);
 290.576 +		throw new IndexOutOfBoundsException();
 290.577 +	}
 290.578 +
 290.579 +	public TransientVector assoc(Object key, Object val){
 290.580 +		//note - relies on ensureEditable in assocN
 290.581 +		if(Util.isInteger(key))
 290.582 +			{
 290.583 +			int i = ((Number) key).intValue();
 290.584 +			return assocN(i, val);
 290.585 +			}
 290.586 +		throw new IllegalArgumentException("Key must be integer");
 290.587 +	}
 290.588 +
 290.589 +	private Node doAssoc(int level, Node node, int i, Object val){
 290.590 +		node = ensureEditable(node);
 290.591 +		Node ret = node;
 290.592 +		if(level == 0)
 290.593 +			{
 290.594 +			ret.array[i & 0x01f] = val;
 290.595 +			}
 290.596 +		else
 290.597 +			{
 290.598 +			int subidx = (i >>> level) & 0x01f;
 290.599 +			ret.array[subidx] = doAssoc(level - 5, (Node) node.array[subidx], i, val);
 290.600 +			}
 290.601 +		return ret;
 290.602 +	}
 290.603 +
 290.604 +	public TransientVector pop(){
 290.605 +		ensureEditable();
 290.606 +		if(cnt == 0)
 290.607 +			throw new IllegalStateException("Can't pop empty vector");
 290.608 +		if(cnt == 1)
 290.609 +			{
 290.610 +			cnt = 0;
 290.611 +			return this;
 290.612 +			}
 290.613 +		int i = cnt - 1;
 290.614 +		//pop in tail?
 290.615 +		if((i & 0x01f) > 0)
 290.616 +			{
 290.617 +			--cnt;
 290.618 +			return this;
 290.619 +			}
 290.620 +
 290.621 +		Object[] newtail = arrayFor(cnt - 2);
 290.622 +
 290.623 +		Node newroot = popTail(shift, root);
 290.624 +		int newshift = shift;
 290.625 +		if(newroot == null)
 290.626 +			{
 290.627 +			newroot = new Node(root.edit);
 290.628 +			}
 290.629 +		if(shift > 5 && newroot.array[1] == null)
 290.630 +			{
 290.631 +			newroot = ensureEditable((Node) newroot.array[0]);
 290.632 +			newshift -= 5;
 290.633 +			}
 290.634 +		root = newroot;
 290.635 +		shift = newshift;
 290.636 +		--cnt;
 290.637 +		tail = newtail;
 290.638 +		return this;
 290.639 +	}
 290.640 +
 290.641 +	private Node popTail(int level, Node node){
 290.642 +		node = ensureEditable(node);
 290.643 +		int subidx = ((cnt - 2) >>> level) & 0x01f;
 290.644 +		if(level > 5)
 290.645 +			{
 290.646 +			Node newchild = popTail(level - 5, (Node) node.array[subidx]);
 290.647 +			if(newchild == null && subidx == 0)
 290.648 +				return null;
 290.649 +			else
 290.650 +				{
 290.651 +				Node ret = node;
 290.652 +				ret.array[subidx] = newchild;
 290.653 +				return ret;
 290.654 +				}
 290.655 +			}
 290.656 +		else if(subidx == 0)
 290.657 +			return null;
 290.658 +		else
 290.659 +			{
 290.660 +			Node ret = node;
 290.661 +			ret.array[subidx] = null;
 290.662 +			return ret;
 290.663 +			}
 290.664 +	}
 290.665 +}
 290.666 +/*
 290.667 +static public void main(String[] args){
 290.668 +	if(args.length != 3)
 290.669 +		{
 290.670 +		System.err.println("Usage: PersistentVector size writes reads");
 290.671 +		return;
 290.672 +		}
 290.673 +	int size = Integer.parseInt(args[0]);
 290.674 +	int writes = Integer.parseInt(args[1]);
 290.675 +	int reads = Integer.parseInt(args[2]);
 290.676 +//	Vector v = new Vector(size);
 290.677 +	ArrayList v = new ArrayList(size);
 290.678 +//	v.setSize(size);
 290.679 +	//PersistentArray p = new PersistentArray(size);
 290.680 +	PersistentVector p = PersistentVector.EMPTY;
 290.681 +//	MutableVector mp = p.mutable();
 290.682 +
 290.683 +	for(int i = 0; i < size; i++)
 290.684 +		{
 290.685 +		v.add(i);
 290.686 +//		v.set(i, i);
 290.687 +		//p = p.set(i, 0);
 290.688 +		p = p.cons(i);
 290.689 +//		mp = mp.conj(i);
 290.690 +		}
 290.691 +
 290.692 +	Random rand;
 290.693 +
 290.694 +	rand = new Random(42);
 290.695 +	long tv = 0;
 290.696 +	System.out.println("ArrayList");
 290.697 +	long startTime = System.nanoTime();
 290.698 +	for(int i = 0; i < writes; i++)
 290.699 +		{
 290.700 +		v.set(rand.nextInt(size), i);
 290.701 +		}
 290.702 +	for(int i = 0; i < reads; i++)
 290.703 +		{
 290.704 +		tv += (Integer) v.get(rand.nextInt(size));
 290.705 +		}
 290.706 +	long estimatedTime = System.nanoTime() - startTime;
 290.707 +	System.out.println("time: " + estimatedTime / 1000000);
 290.708 +	System.out.println("PersistentVector");
 290.709 +	rand = new Random(42);
 290.710 +	startTime = System.nanoTime();
 290.711 +	long tp = 0;
 290.712 +
 290.713 +//	PersistentVector oldp = p;
 290.714 +	//Random rand2 = new Random(42);
 290.715 +
 290.716 +	MutableVector mp = p.mutable();
 290.717 +	for(int i = 0; i < writes; i++)
 290.718 +		{
 290.719 +//		p = p.assocN(rand.nextInt(size), i);
 290.720 +		mp = mp.assocN(rand.nextInt(size), i);
 290.721 +//		mp = mp.assoc(rand.nextInt(size), i);
 290.722 +		//dummy set to force perverse branching
 290.723 +		//oldp =	oldp.assocN(rand2.nextInt(size), i);
 290.724 +		}
 290.725 +	for(int i = 0; i < reads; i++)
 290.726 +		{
 290.727 +//		tp += (Integer) p.nth(rand.nextInt(size));
 290.728 +		tp += (Integer) mp.nth(rand.nextInt(size));
 290.729 +		}
 290.730 +//	p = mp.immutable();
 290.731 +	//mp.cons(42);
 290.732 +	estimatedTime = System.nanoTime() - startTime;
 290.733 +	System.out.println("time: " + estimatedTime / 1000000);
 290.734 +	for(int i = 0; i < size / 2; i++)
 290.735 +		{
 290.736 +		mp = mp.pop();
 290.737 +//		p = p.pop();
 290.738 +		v.remove(v.size() - 1);
 290.739 +		}
 290.740 +	p = (PersistentVector) mp.immutable();
 290.741 +	//mp.pop();  //should fail
 290.742 +	for(int i = 0; i < size / 2; i++)
 290.743 +		{
 290.744 +		tp += (Integer) p.nth(i);
 290.745 +		tv += (Integer) v.get(i);
 290.746 +		}
 290.747 +	System.out.println("Done: " + tv + ", " + tp);
 290.748 +
 290.749 +}
 290.750 +//  */
 290.751 +}
   291.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   291.2 +++ b/src/clojure/lang/ProxyHandler.java	Sat Aug 21 06:25:44 2010 -0400
   291.3 @@ -0,0 +1,72 @@
   291.4 +/**
   291.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   291.6 + *   The use and distribution terms for this software are covered by the
   291.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   291.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   291.9 + *   By using this software in any fashion, you are agreeing to be bound by
  291.10 + * 	 the terms of this license.
  291.11 + *   You must not remove this notice, or any other, from this software.
  291.12 + **/
  291.13 +
  291.14 +/* rich Oct 4, 2007 */
  291.15 +
  291.16 +package clojure.lang;
  291.17 +
  291.18 +import java.lang.reflect.InvocationHandler;
  291.19 +import java.lang.reflect.Method;
  291.20 +
  291.21 +public class ProxyHandler implements InvocationHandler{
  291.22 +//method-name-string->fn
  291.23 +final IPersistentMap fns;
  291.24 +
  291.25 +
  291.26 +public ProxyHandler(IPersistentMap fns){
  291.27 +	this.fns = fns;
  291.28 +}
  291.29 +
  291.30 +public Object invoke(Object proxy, Method method, Object[] args) throws Throwable{
  291.31 +	Class rt = method.getReturnType();
  291.32 +	IFn fn = (IFn) fns.valAt(method.getName());
  291.33 +	if(fn == null)
  291.34 +		{
  291.35 +		if(rt == Void.TYPE)
  291.36 +			return null;
  291.37 +		else if(method.getName().equals("equals"))
  291.38 +			{
  291.39 +			return proxy == args[0];
  291.40 +			}
  291.41 +		else if(method.getName().equals("hashCode"))
  291.42 +			{
  291.43 +			return System.identityHashCode(proxy);
  291.44 +			}
  291.45 +		else if(method.getName().equals("toString"))
  291.46 +			{
  291.47 +			return "Proxy: " + System.identityHashCode(proxy);
  291.48 +			}
  291.49 +		throw new UnsupportedOperationException();
  291.50 +		}
  291.51 +	Object ret = fn.applyTo(ArraySeq.create(args));
  291.52 +	if(rt == Void.TYPE)
  291.53 +		return null;
  291.54 +	else if(rt.isPrimitive())
  291.55 +		{
  291.56 +		if(rt == Character.TYPE)
  291.57 +			return ret;
  291.58 +		else if(rt == Integer.TYPE)
  291.59 +			return ((Number) ret).intValue();
  291.60 +		else if(rt == Long.TYPE)
  291.61 +			return ((Number) ret).longValue();
  291.62 +		else if(rt == Float.TYPE)
  291.63 +			return ((Number) ret).floatValue();
  291.64 +		else if(rt == Double.TYPE)
  291.65 +			return ((Number) ret).doubleValue();
  291.66 +		else if(rt == Boolean.TYPE && !(ret instanceof Boolean))
  291.67 +			return ret == null ? Boolean.FALSE : Boolean.TRUE;
  291.68 +		else if(rt == Byte.TYPE)
  291.69 +			return (byte) ((Number) ret).intValue();
  291.70 +		else if(rt == Short.TYPE)
  291.71 +			return (short) ((Number) ret).intValue();
  291.72 +		}
  291.73 +	return ret;
  291.74 +}
  291.75 +}
   292.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   292.2 +++ b/src/clojure/lang/RT.java	Sat Aug 21 06:25:44 2010 -0400
   292.3 @@ -0,0 +1,1735 @@
   292.4 +/**
   292.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   292.6 + *   The use and distribution terms for this software are covered by the
   292.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   292.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   292.9 + *   By using this software in any fashion, you are agreeing to be bound by
  292.10 + * 	 the terms of this license.
  292.11 + *   You must not remove this notice, or any other, from this software.
  292.12 + **/
  292.13 +
  292.14 +/* rich Mar 25, 2006 4:28:27 PM */
  292.15 +
  292.16 +package clojure.lang;
  292.17 +
  292.18 +import java.util.concurrent.atomic.AtomicInteger;
  292.19 +import java.util.concurrent.Callable;
  292.20 +import java.util.*;
  292.21 +import java.util.regex.Matcher;
  292.22 +import java.util.regex.Pattern;
  292.23 +import java.io.*;
  292.24 +import java.lang.reflect.Array;
  292.25 +import java.math.BigDecimal;
  292.26 +import java.math.BigInteger;
  292.27 +import java.security.AccessController;
  292.28 +import java.security.PrivilegedAction;
  292.29 +import java.net.URL;
  292.30 +import java.net.JarURLConnection;
  292.31 +import java.nio.charset.Charset;
  292.32 +
  292.33 +public class RT{
  292.34 +
  292.35 +static final public Boolean T = Boolean.TRUE;//Keyword.intern(Symbol.create(null, "t"));
  292.36 +static final public Boolean F = Boolean.FALSE;//Keyword.intern(Symbol.create(null, "t"));
  292.37 +static final public String LOADER_SUFFIX = "__init";
  292.38 +
  292.39 +//simple-symbol->class
  292.40 +final static IPersistentMap DEFAULT_IMPORTS = map(
  292.41 +//												  Symbol.create("RT"), "clojure.lang.RT",
  292.42 +//                                                  Symbol.create("Num"), "clojure.lang.Num",
  292.43 +//                                                  Symbol.create("Symbol"), "clojure.lang.Symbol",
  292.44 +//                                                  Symbol.create("Keyword"), "clojure.lang.Keyword",
  292.45 +//                                                  Symbol.create("Var"), "clojure.lang.Var",
  292.46 +//                                                  Symbol.create("Ref"), "clojure.lang.Ref",
  292.47 +//                                                  Symbol.create("IFn"), "clojure.lang.IFn",
  292.48 +//                                                  Symbol.create("IObj"), "clojure.lang.IObj",
  292.49 +//                                                  Symbol.create("ISeq"), "clojure.lang.ISeq",
  292.50 +//                                                  Symbol.create("IPersistentCollection"),
  292.51 +//                                                  "clojure.lang.IPersistentCollection",
  292.52 +//                                                  Symbol.create("IPersistentMap"), "clojure.lang.IPersistentMap",
  292.53 +//                                                  Symbol.create("IPersistentList"), "clojure.lang.IPersistentList",
  292.54 +//                                                  Symbol.create("IPersistentVector"), "clojure.lang.IPersistentVector",
  292.55 +Symbol.create("Boolean"), Boolean.class,
  292.56 +Symbol.create("Byte"), Byte.class,
  292.57 +Symbol.create("Character"), Character.class,
  292.58 +Symbol.create("Class"), Class.class,
  292.59 +Symbol.create("ClassLoader"), ClassLoader.class,
  292.60 +Symbol.create("Compiler"), Compiler.class,
  292.61 +Symbol.create("Double"), Double.class,
  292.62 +Symbol.create("Enum"), Enum.class,
  292.63 +Symbol.create("Float"), Float.class,
  292.64 +Symbol.create("InheritableThreadLocal"), InheritableThreadLocal.class,
  292.65 +Symbol.create("Integer"), Integer.class,
  292.66 +Symbol.create("Long"), Long.class,
  292.67 +Symbol.create("Math"), Math.class,
  292.68 +Symbol.create("Number"), Number.class,
  292.69 +Symbol.create("Object"), Object.class,
  292.70 +Symbol.create("Package"), Package.class,
  292.71 +Symbol.create("Process"), Process.class,
  292.72 +Symbol.create("ProcessBuilder"), ProcessBuilder.class,
  292.73 +Symbol.create("Runtime"), Runtime.class,
  292.74 +Symbol.create("RuntimePermission"), RuntimePermission.class,
  292.75 +Symbol.create("SecurityManager"), SecurityManager.class,
  292.76 +Symbol.create("Short"), Short.class,
  292.77 +Symbol.create("StackTraceElement"), StackTraceElement.class,
  292.78 +Symbol.create("StrictMath"), StrictMath.class,
  292.79 +Symbol.create("String"), String.class,
  292.80 +Symbol.create("StringBuffer"), StringBuffer.class,
  292.81 +Symbol.create("StringBuilder"), StringBuilder.class,
  292.82 +Symbol.create("System"), System.class,
  292.83 +Symbol.create("Thread"), Thread.class,
  292.84 +Symbol.create("ThreadGroup"), ThreadGroup.class,
  292.85 +Symbol.create("ThreadLocal"), ThreadLocal.class,
  292.86 +Symbol.create("Throwable"), Throwable.class,
  292.87 +Symbol.create("Void"), Void.class,
  292.88 +Symbol.create("Appendable"), Appendable.class,
  292.89 +Symbol.create("CharSequence"), CharSequence.class,
  292.90 +Symbol.create("Cloneable"), Cloneable.class,
  292.91 +Symbol.create("Comparable"), Comparable.class,
  292.92 +Symbol.create("Iterable"), Iterable.class,
  292.93 +Symbol.create("Readable"), Readable.class,
  292.94 +Symbol.create("Runnable"), Runnable.class,
  292.95 +Symbol.create("Callable"), Callable.class,
  292.96 +Symbol.create("BigInteger"), BigInteger.class,
  292.97 +Symbol.create("BigDecimal"), BigDecimal.class,
  292.98 +Symbol.create("ArithmeticException"), ArithmeticException.class,
  292.99 +Symbol.create("ArrayIndexOutOfBoundsException"), ArrayIndexOutOfBoundsException.class,
 292.100 +Symbol.create("ArrayStoreException"), ArrayStoreException.class,
 292.101 +Symbol.create("ClassCastException"), ClassCastException.class,
 292.102 +Symbol.create("ClassNotFoundException"), ClassNotFoundException.class,
 292.103 +Symbol.create("CloneNotSupportedException"), CloneNotSupportedException.class,
 292.104 +Symbol.create("EnumConstantNotPresentException"), EnumConstantNotPresentException.class,
 292.105 +Symbol.create("Exception"), Exception.class,
 292.106 +Symbol.create("IllegalAccessException"), IllegalAccessException.class,
 292.107 +Symbol.create("IllegalArgumentException"), IllegalArgumentException.class,
 292.108 +Symbol.create("IllegalMonitorStateException"), IllegalMonitorStateException.class,
 292.109 +Symbol.create("IllegalStateException"), IllegalStateException.class,
 292.110 +Symbol.create("IllegalThreadStateException"), IllegalThreadStateException.class,
 292.111 +Symbol.create("IndexOutOfBoundsException"), IndexOutOfBoundsException.class,
 292.112 +Symbol.create("InstantiationException"), InstantiationException.class,
 292.113 +Symbol.create("InterruptedException"), InterruptedException.class,
 292.114 +Symbol.create("NegativeArraySizeException"), NegativeArraySizeException.class,
 292.115 +Symbol.create("NoSuchFieldException"), NoSuchFieldException.class,
 292.116 +Symbol.create("NoSuchMethodException"), NoSuchMethodException.class,
 292.117 +Symbol.create("NullPointerException"), NullPointerException.class,
 292.118 +Symbol.create("NumberFormatException"), NumberFormatException.class,
 292.119 +Symbol.create("RuntimeException"), RuntimeException.class,
 292.120 +Symbol.create("SecurityException"), SecurityException.class,
 292.121 +Symbol.create("StringIndexOutOfBoundsException"), StringIndexOutOfBoundsException.class,
 292.122 +Symbol.create("TypeNotPresentException"), TypeNotPresentException.class,
 292.123 +Symbol.create("UnsupportedOperationException"), UnsupportedOperationException.class,
 292.124 +Symbol.create("AbstractMethodError"), AbstractMethodError.class,
 292.125 +Symbol.create("AssertionError"), AssertionError.class,
 292.126 +Symbol.create("ClassCircularityError"), ClassCircularityError.class,
 292.127 +Symbol.create("ClassFormatError"), ClassFormatError.class,
 292.128 +Symbol.create("Error"), Error.class,
 292.129 +Symbol.create("ExceptionInInitializerError"), ExceptionInInitializerError.class,
 292.130 +Symbol.create("IllegalAccessError"), IllegalAccessError.class,
 292.131 +Symbol.create("IncompatibleClassChangeError"), IncompatibleClassChangeError.class,
 292.132 +Symbol.create("InstantiationError"), InstantiationError.class,
 292.133 +Symbol.create("InternalError"), InternalError.class,
 292.134 +Symbol.create("LinkageError"), LinkageError.class,
 292.135 +Symbol.create("NoClassDefFoundError"), NoClassDefFoundError.class,
 292.136 +Symbol.create("NoSuchFieldError"), NoSuchFieldError.class,
 292.137 +Symbol.create("NoSuchMethodError"), NoSuchMethodError.class,
 292.138 +Symbol.create("OutOfMemoryError"), OutOfMemoryError.class,
 292.139 +Symbol.create("StackOverflowError"), StackOverflowError.class,
 292.140 +Symbol.create("ThreadDeath"), ThreadDeath.class,
 292.141 +Symbol.create("UnknownError"), UnknownError.class,
 292.142 +Symbol.create("UnsatisfiedLinkError"), UnsatisfiedLinkError.class,
 292.143 +Symbol.create("UnsupportedClassVersionError"), UnsupportedClassVersionError.class,
 292.144 +Symbol.create("VerifyError"), VerifyError.class,
 292.145 +Symbol.create("VirtualMachineError"), VirtualMachineError.class,
 292.146 +Symbol.create("Thread$UncaughtExceptionHandler"), Thread.UncaughtExceptionHandler.class,
 292.147 +Symbol.create("Thread$State"), Thread.State.class,
 292.148 +Symbol.create("Deprecated"), Deprecated.class,
 292.149 +Symbol.create("Override"), Override.class,
 292.150 +Symbol.create("SuppressWarnings"), SuppressWarnings.class
 292.151 +
 292.152 +//                                                  Symbol.create("Collection"), "java.util.Collection",
 292.153 +//                                                  Symbol.create("Comparator"), "java.util.Comparator",
 292.154 +//                                                  Symbol.create("Enumeration"), "java.util.Enumeration",
 292.155 +//                                                  Symbol.create("EventListener"), "java.util.EventListener",
 292.156 +//                                                  Symbol.create("Formattable"), "java.util.Formattable",
 292.157 +//                                                  Symbol.create("Iterator"), "java.util.Iterator",
 292.158 +//                                                  Symbol.create("List"), "java.util.List",
 292.159 +//                                                  Symbol.create("ListIterator"), "java.util.ListIterator",
 292.160 +//                                                  Symbol.create("Map"), "java.util.Map",
 292.161 +//                                                  Symbol.create("Map$Entry"), "java.util.Map$Entry",
 292.162 +//                                                  Symbol.create("Observer"), "java.util.Observer",
 292.163 +//                                                  Symbol.create("Queue"), "java.util.Queue",
 292.164 +//                                                  Symbol.create("RandomAccess"), "java.util.RandomAccess",
 292.165 +//                                                  Symbol.create("Set"), "java.util.Set",
 292.166 +//                                                  Symbol.create("SortedMap"), "java.util.SortedMap",
 292.167 +//                                                  Symbol.create("SortedSet"), "java.util.SortedSet"
 292.168 +);
 292.169 +
 292.170 +// single instance of UTF-8 Charset, so as to avoid catching UnsupportedCharsetExceptions everywhere
 292.171 +static public Charset UTF8 = Charset.forName("UTF-8");
 292.172 +
 292.173 +static public final Namespace CLOJURE_NS = Namespace.findOrCreate(Symbol.create("clojure.core"));
 292.174 +//static final Namespace USER_NS = Namespace.findOrCreate(Symbol.create("user"));
 292.175 +final static public Var OUT =
 292.176 +		Var.intern(CLOJURE_NS, Symbol.create("*out*"), new OutputStreamWriter(System.out));
 292.177 +final static public Var IN =
 292.178 +		Var.intern(CLOJURE_NS, Symbol.create("*in*"),
 292.179 +		           new LineNumberingPushbackReader(new InputStreamReader(System.in)));
 292.180 +final static public Var ERR =
 292.181 +		Var.intern(CLOJURE_NS, Symbol.create("*err*"),
 292.182 +		           new PrintWriter(new OutputStreamWriter(System.err), true));
 292.183 +final static Keyword TAG_KEY = Keyword.intern(null, "tag");
 292.184 +final static public Var AGENT = Var.intern(CLOJURE_NS, Symbol.create("*agent*"), null);
 292.185 +final static public Var READEVAL = Var.intern(CLOJURE_NS, Symbol.create("*read-eval*"), T);
 292.186 +final static public Var ASSERT = Var.intern(CLOJURE_NS, Symbol.create("*assert*"), T);
 292.187 +final static public Var MATH_CONTEXT = Var.intern(CLOJURE_NS, Symbol.create("*math-context*"), null);
 292.188 +static Keyword LINE_KEY = Keyword.intern(null, "line");
 292.189 +static Keyword FILE_KEY = Keyword.intern(null, "file");
 292.190 +static Keyword DECLARED_KEY = Keyword.intern(null, "declared");
 292.191 +final static public Var USE_CONTEXT_CLASSLOADER =
 292.192 +		Var.intern(CLOJURE_NS, Symbol.create("*use-context-classloader*"), T);
 292.193 +//final static public Var CURRENT_MODULE = Var.intern(Symbol.create("clojure.core", "current-module"),
 292.194 +//                                                    Module.findOrCreateModule("clojure/user"));
 292.195 +
 292.196 +final static Symbol LOAD_FILE = Symbol.create("load-file");
 292.197 +final static Symbol IN_NAMESPACE = Symbol.create("in-ns");
 292.198 +final static Symbol NAMESPACE = Symbol.create("ns");
 292.199 +static final Symbol IDENTICAL = Symbol.create("identical?");
 292.200 +final static Var CMD_LINE_ARGS = Var.intern(CLOJURE_NS, Symbol.create("*command-line-args*"), null);
 292.201 +//symbol
 292.202 +final public static Var CURRENT_NS = Var.intern(CLOJURE_NS, Symbol.create("*ns*"),
 292.203 +                                                CLOJURE_NS);
 292.204 +
 292.205 +final static Var FLUSH_ON_NEWLINE = Var.intern(CLOJURE_NS, Symbol.create("*flush-on-newline*"), T);
 292.206 +final static Var PRINT_META = Var.intern(CLOJURE_NS, Symbol.create("*print-meta*"), F);
 292.207 +final static Var PRINT_READABLY = Var.intern(CLOJURE_NS, Symbol.create("*print-readably*"), T);
 292.208 +final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.create("*print-dup*"), F);
 292.209 +final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.create("*warn-on-reflection*"), F);
 292.210 +final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.create("*allow-unresolved-vars*"), F);
 292.211 +
 292.212 +final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("in-ns"), F);
 292.213 +final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.create("ns"), F);
 292.214 +static final Var PRINT_INITIALIZED = Var.intern(CLOJURE_NS, Symbol.create("print-initialized"));
 292.215 +static final Var PR_ON = Var.intern(CLOJURE_NS, Symbol.create("pr-on"));
 292.216 +//final static Var IMPORTS = Var.intern(CLOJURE_NS, Symbol.create("*imports*"), DEFAULT_IMPORTS);
 292.217 +final static IFn inNamespace = new AFn(){
 292.218 +	public Object invoke(Object arg1) throws Exception{
 292.219 +		Symbol nsname = (Symbol) arg1;
 292.220 +		Namespace ns = Namespace.findOrCreate(nsname);
 292.221 +		CURRENT_NS.set(ns);
 292.222 +		return ns;
 292.223 +	}
 292.224 +};
 292.225 +
 292.226 +final static IFn bootNamespace = new AFn(){
 292.227 +	public Object invoke(Object __form, Object __env,Object arg1) throws Exception{
 292.228 +		Symbol nsname = (Symbol) arg1;
 292.229 +		Namespace ns = Namespace.findOrCreate(nsname);
 292.230 +		CURRENT_NS.set(ns);
 292.231 +		return ns;
 292.232 +	}
 292.233 +};
 292.234 +
 292.235 +public static List<String> processCommandLine(String[] args){
 292.236 +	List<String> arglist = Arrays.asList(args);
 292.237 +	int split = arglist.indexOf("--");
 292.238 +	if(split >= 0) {
 292.239 +		CMD_LINE_ARGS.bindRoot(RT.seq(arglist.subList(split + 1, args.length)));
 292.240 +		return arglist.subList(0, split);
 292.241 +	}
 292.242 +	return arglist;
 292.243 +}
 292.244 +
 292.245 +// duck typing stderr plays nice with e.g. swank 
 292.246 +public static PrintWriter errPrintWriter(){
 292.247 +    Writer w = (Writer) ERR.deref();
 292.248 +    if (w instanceof PrintWriter) {
 292.249 +        return (PrintWriter) w;
 292.250 +    } else {
 292.251 +        return new PrintWriter(w);
 292.252 +    }
 292.253 +}
 292.254 +
 292.255 +static public final Object[] EMPTY_ARRAY = new Object[]{};
 292.256 +static public final Comparator DEFAULT_COMPARATOR = new DefaultComparator();
 292.257 +
 292.258 +private static final class DefaultComparator implements Comparator, Serializable {
 292.259 +    public int compare(Object o1, Object o2){
 292.260 +		return Util.compare(o1, o2);
 292.261 +	}
 292.262 +
 292.263 +    private Object readResolve() throws ObjectStreamException {
 292.264 +        // ensures that we aren't hanging onto a new default comparator for every
 292.265 +        // sorted set, etc., we deserialize
 292.266 +        return DEFAULT_COMPARATOR;
 292.267 +    }
 292.268 +}
 292.269 +
 292.270 +static AtomicInteger id = new AtomicInteger(1);
 292.271 +
 292.272 +static public void addURL(Object url) throws Exception{
 292.273 +	URL u = (url instanceof String) ? (new URL((String) url)) : (URL) url;
 292.274 +	ClassLoader ccl = Thread.currentThread().getContextClassLoader();
 292.275 +	if(ccl instanceof DynamicClassLoader)
 292.276 +		((DynamicClassLoader)ccl).addURL(u);
 292.277 +	else
 292.278 +		throw new IllegalAccessError("Context classloader is not a DynamicClassLoader");
 292.279 +}
 292.280 +
 292.281 +static{
 292.282 +	Keyword dockw = Keyword.intern(null, "doc");
 292.283 +	Keyword arglistskw = Keyword.intern(null, "arglists");
 292.284 +	Symbol namesym = Symbol.create("name");
 292.285 +	OUT.setTag(Symbol.create("java.io.Writer"));
 292.286 +	CURRENT_NS.setTag(Symbol.create("clojure.lang.Namespace"));
 292.287 +	AGENT.setMeta(map(dockw, "The agent currently running an action on this thread, else nil"));
 292.288 +	AGENT.setTag(Symbol.create("clojure.lang.Agent"));
 292.289 +	MATH_CONTEXT.setTag(Symbol.create("java.math.MathContext"));
 292.290 +	Var nv = Var.intern(CLOJURE_NS, NAMESPACE, bootNamespace);
 292.291 +	nv.setMacro();
 292.292 +	Var v;
 292.293 +	v = Var.intern(CLOJURE_NS, IN_NAMESPACE, inNamespace);
 292.294 +	v.setMeta(map(dockw, "Sets *ns* to the namespace named by the symbol, creating it if needed.",
 292.295 +	              arglistskw, list(vector(namesym))));
 292.296 +	v = Var.intern(CLOJURE_NS, LOAD_FILE,
 292.297 +	               new AFn(){
 292.298 +		               public Object invoke(Object arg1) throws Exception{
 292.299 +			               return Compiler.loadFile((String) arg1);
 292.300 +		               }
 292.301 +	               });
 292.302 +	v.setMeta(map(dockw, "Sequentially read and evaluate the set of forms contained in the file.",
 292.303 +	              arglistskw, list(vector(namesym))));
 292.304 +	try {
 292.305 +		doInit();
 292.306 +	}
 292.307 +	catch(Exception e) {
 292.308 +		throw new RuntimeException(e);
 292.309 +	}
 292.310 +}
 292.311 +
 292.312 +
 292.313 +static public Var var(String ns, String name){
 292.314 +	return Var.intern(Namespace.findOrCreate(Symbol.intern(null, ns)), Symbol.intern(null, name));
 292.315 +}
 292.316 +
 292.317 +static public Var var(String ns, String name, Object init){
 292.318 +	return Var.intern(Namespace.findOrCreate(Symbol.intern(null, ns)), Symbol.intern(null, name), init);
 292.319 +}
 292.320 +
 292.321 +public static void loadResourceScript(String name) throws Exception{
 292.322 +	loadResourceScript(name, true);
 292.323 +}
 292.324 +
 292.325 +public static void maybeLoadResourceScript(String name) throws Exception{
 292.326 +	loadResourceScript(name, false);
 292.327 +}
 292.328 +
 292.329 +public static void loadResourceScript(String name, boolean failIfNotFound) throws Exception{
 292.330 +	loadResourceScript(RT.class, name, failIfNotFound);
 292.331 +}
 292.332 +
 292.333 +public static void loadResourceScript(Class c, String name) throws Exception{
 292.334 +	loadResourceScript(c, name, true);
 292.335 +}
 292.336 +
 292.337 +public static void loadResourceScript(Class c, String name, boolean failIfNotFound) throws Exception{
 292.338 +	int slash = name.lastIndexOf('/');
 292.339 +	String file = slash >= 0 ? name.substring(slash + 1) : name;
 292.340 +	InputStream ins = baseLoader().getResourceAsStream(name);
 292.341 +	if(ins != null) {
 292.342 +		try {
 292.343 +			Compiler.load(new InputStreamReader(ins, UTF8), name, file);
 292.344 +		}
 292.345 +		finally {
 292.346 +			ins.close();
 292.347 +		}
 292.348 +	}
 292.349 +	else if(failIfNotFound) {
 292.350 +		throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + name);
 292.351 +	}
 292.352 +}
 292.353 +
 292.354 +static public void init() throws Exception{
 292.355 +	RT.errPrintWriter().println("No need to call RT.init() anymore");
 292.356 +}
 292.357 +
 292.358 +static public long lastModified(URL url, String libfile) throws Exception{
 292.359 +	if(url.getProtocol().equals("jar")) {
 292.360 +		return ((JarURLConnection) url.openConnection()).getJarFile().getEntry(libfile).getTime();
 292.361 +	}
 292.362 +	else {
 292.363 +		return url.openConnection().getLastModified();
 292.364 +	}
 292.365 +}
 292.366 +
 292.367 +static void compile(String cljfile) throws Exception{
 292.368 +	InputStream ins = baseLoader().getResourceAsStream(cljfile);
 292.369 +	if(ins != null) {
 292.370 +		try {
 292.371 +			Compiler.compile(new InputStreamReader(ins, UTF8), cljfile,
 292.372 +			                 cljfile.substring(1 + cljfile.lastIndexOf("/")));
 292.373 +		}
 292.374 +		finally {
 292.375 +			ins.close();
 292.376 +		}
 292.377 +
 292.378 +	}
 292.379 +	else
 292.380 +		throw new FileNotFoundException("Could not locate Clojure resource on classpath: " + cljfile);
 292.381 +}
 292.382 +
 292.383 +static public void load(String scriptbase) throws Exception{
 292.384 +	load(scriptbase, true);
 292.385 +}
 292.386 +
 292.387 +static public void load(String scriptbase, boolean failIfNotFound) throws Exception{
 292.388 +	String classfile = scriptbase + LOADER_SUFFIX + ".class";
 292.389 +	String cljfile = scriptbase + ".clj";
 292.390 +	URL classURL = baseLoader().getResource(classfile);
 292.391 +	URL cljURL = baseLoader().getResource(cljfile);
 292.392 +	boolean loaded = false;
 292.393 +
 292.394 +	if((classURL != null &&
 292.395 +	    (cljURL == null
 292.396 +	     || lastModified(classURL, classfile) > lastModified(cljURL, cljfile)))
 292.397 +	   || classURL == null) {
 292.398 +		try {
 292.399 +			Var.pushThreadBindings(
 292.400 +					RT.map(CURRENT_NS, CURRENT_NS.deref(),
 292.401 +					       WARN_ON_REFLECTION, WARN_ON_REFLECTION.deref()));
 292.402 +			loaded = (loadClassForName(scriptbase.replace('/', '.') + LOADER_SUFFIX) != null);
 292.403 +		}
 292.404 +		finally {
 292.405 +			Var.popThreadBindings();
 292.406 +		}
 292.407 +	}
 292.408 +	if(!loaded && cljURL != null) {
 292.409 +		if(booleanCast(Compiler.COMPILE_FILES.deref()))
 292.410 +			compile(cljfile);
 292.411 +		else
 292.412 +			loadResourceScript(RT.class, cljfile);
 292.413 +	}
 292.414 +	else if(!loaded && failIfNotFound)
 292.415 +		throw new FileNotFoundException(String.format("Could not locate %s or %s on classpath: ", classfile, cljfile));
 292.416 +}
 292.417 +
 292.418 +static void doInit() throws Exception{
 292.419 +	load("clojure/core");
 292.420 +	load("clojure/zip", false);
 292.421 +	load("clojure/xml", false);
 292.422 +	load("clojure/set", false);
 292.423 +
 292.424 +	Var.pushThreadBindings(
 292.425 +			RT.map(CURRENT_NS, CURRENT_NS.deref(),
 292.426 +			       WARN_ON_REFLECTION, WARN_ON_REFLECTION.deref()));
 292.427 +	try {
 292.428 +		Symbol USER = Symbol.create("user");
 292.429 +		Symbol CLOJURE = Symbol.create("clojure.core");
 292.430 +
 292.431 +		Var in_ns = var("clojure.core", "in-ns");
 292.432 +		Var refer = var("clojure.core", "refer");
 292.433 +		in_ns.invoke(USER);
 292.434 +		refer.invoke(CLOJURE);
 292.435 +		maybeLoadResourceScript("user.clj");
 292.436 +	}
 292.437 +	finally {
 292.438 +		Var.popThreadBindings();
 292.439 +	}
 292.440 +}
 292.441 +
 292.442 +static public int nextID(){
 292.443 +	return id.getAndIncrement();
 292.444 +}
 292.445 +
 292.446 +
 292.447 +////////////// Collections support /////////////////////////////////
 292.448 +
 292.449 +static public ISeq seq(Object coll){
 292.450 +	if(coll instanceof ASeq)
 292.451 +		return (ASeq) coll;
 292.452 +	else if(coll instanceof LazySeq)
 292.453 +		return ((LazySeq) coll).seq();
 292.454 +	else
 292.455 +		return seqFrom(coll);
 292.456 +}
 292.457 +
 292.458 +static ISeq seqFrom(Object coll){
 292.459 +	if(coll instanceof Seqable)
 292.460 +		return ((Seqable) coll).seq();
 292.461 +	else if(coll == null)
 292.462 +		return null;
 292.463 +	else if(coll instanceof Iterable)
 292.464 +		return IteratorSeq.create(((Iterable) coll).iterator());
 292.465 +	else if(coll.getClass().isArray())
 292.466 +		return ArraySeq.createFromObject(coll);
 292.467 +	else if(coll instanceof CharSequence)
 292.468 +		return StringSeq.create((CharSequence) coll);
 292.469 +	else if(coll instanceof Map)
 292.470 +		return seq(((Map) coll).entrySet());
 292.471 +	else {
 292.472 +		Class c = coll.getClass();
 292.473 +		Class sc = c.getSuperclass();
 292.474 +		throw new IllegalArgumentException("Don't know how to create ISeq from: " + c.getName());
 292.475 +	}
 292.476 +}
 292.477 +
 292.478 +static public ISeq keys(Object coll){
 292.479 +	return APersistentMap.KeySeq.create(seq(coll));
 292.480 +}
 292.481 +
 292.482 +static public ISeq vals(Object coll){
 292.483 +	return APersistentMap.ValSeq.create(seq(coll));
 292.484 +}
 292.485 +
 292.486 +static public IPersistentMap meta(Object x){
 292.487 +	if(x instanceof IMeta)
 292.488 +		return ((IMeta) x).meta();
 292.489 +	return null;
 292.490 +}
 292.491 +
 292.492 +public static int count(Object o){
 292.493 +	if(o instanceof Counted)
 292.494 +		return ((Counted) o).count();
 292.495 +	return countFrom(Util.ret1(o, o = null));
 292.496 +}
 292.497 +
 292.498 +static int countFrom(Object o){
 292.499 +	if(o == null)
 292.500 +		return 0;
 292.501 +	else if(o instanceof IPersistentCollection) {
 292.502 +		ISeq s = seq(o);
 292.503 +		o = null;
 292.504 +		int i = 0;
 292.505 +		for(; s != null; s = s.next()) {
 292.506 +			if(s instanceof Counted)
 292.507 +				return i + s.count();
 292.508 +			i++;
 292.509 +		}
 292.510 +		return i;
 292.511 +	}
 292.512 +	else if(o instanceof CharSequence)
 292.513 +		return ((CharSequence) o).length();
 292.514 +	else if(o instanceof Collection)
 292.515 +		return ((Collection) o).size();
 292.516 +	else if(o instanceof Map)
 292.517 +		return ((Map) o).size();
 292.518 +	else if(o.getClass().isArray())
 292.519 +		return Array.getLength(o);
 292.520 +
 292.521 +	throw new UnsupportedOperationException("count not supported on this type: " + o.getClass().getSimpleName());
 292.522 +}
 292.523 +
 292.524 +static public IPersistentCollection conj(IPersistentCollection coll, Object x){
 292.525 +	if(coll == null)
 292.526 +		return new PersistentList(x);
 292.527 +	return coll.cons(x);
 292.528 +}
 292.529 +
 292.530 +static public ISeq cons(Object x, Object coll){
 292.531 +	//ISeq y = seq(coll);
 292.532 +	if(coll == null)
 292.533 +		return new PersistentList(x);
 292.534 +	else if(coll instanceof ISeq)
 292.535 +		return new Cons(x, (ISeq) coll);
 292.536 +	else
 292.537 +		return new Cons(x, seq(coll));
 292.538 +}
 292.539 +
 292.540 +static public Object first(Object x){
 292.541 +	if(x instanceof ISeq)
 292.542 +		return ((ISeq) x).first();
 292.543 +	ISeq seq = seq(x);
 292.544 +	if(seq == null)
 292.545 +		return null;
 292.546 +	return seq.first();
 292.547 +}
 292.548 +
 292.549 +static public Object second(Object x){
 292.550 +	return first(next(x));
 292.551 +}
 292.552 +
 292.553 +static public Object third(Object x){
 292.554 +	return first(next(next(x)));
 292.555 +}
 292.556 +
 292.557 +static public Object fourth(Object x){
 292.558 +	return first(next(next(next(x))));
 292.559 +}
 292.560 +
 292.561 +static public ISeq next(Object x){
 292.562 +	if(x instanceof ISeq)
 292.563 +		return ((ISeq) x).next();
 292.564 +	ISeq seq = seq(x);
 292.565 +	if(seq == null)
 292.566 +		return null;
 292.567 +	return seq.next();
 292.568 +}
 292.569 +
 292.570 +static public ISeq more(Object x){
 292.571 +	if(x instanceof ISeq)
 292.572 +		return ((ISeq) x).more();
 292.573 +	ISeq seq = seq(x);
 292.574 +	if(seq == null)
 292.575 +		return PersistentList.EMPTY;
 292.576 +	return seq.more();
 292.577 +}
 292.578 +
 292.579 +//static public Seqable more(Object x){
 292.580 +//    Seqable ret = null;
 292.581 +//	if(x instanceof ISeq)
 292.582 +//		ret = ((ISeq) x).more();
 292.583 +//    else
 292.584 +//        {
 292.585 +//	    ISeq seq = seq(x);
 292.586 +//	    if(seq == null)
 292.587 +//		    ret = PersistentList.EMPTY;
 292.588 +//	    else
 292.589 +//            ret = seq.more();
 292.590 +//        }
 292.591 +//    if(ret == null)
 292.592 +//        ret = PersistentList.EMPTY;
 292.593 +//    return ret;
 292.594 +//}
 292.595 +
 292.596 +static public Object peek(Object x){
 292.597 +	if(x == null)
 292.598 +		return null;
 292.599 +	return ((IPersistentStack) x).peek();
 292.600 +}
 292.601 +
 292.602 +static public Object pop(Object x){
 292.603 +	if(x == null)
 292.604 +		return null;
 292.605 +	return ((IPersistentStack) x).pop();
 292.606 +}
 292.607 +
 292.608 +static public Object get(Object coll, Object key){
 292.609 +	if(coll instanceof ILookup)
 292.610 +		return ((ILookup) coll).valAt(key);
 292.611 +	return getFrom(coll, key);
 292.612 +}
 292.613 +
 292.614 +static Object getFrom(Object coll, Object key){
 292.615 +	if(coll == null)
 292.616 +		return null;
 292.617 +	else if(coll instanceof Map) {
 292.618 +		Map m = (Map) coll;
 292.619 +		return m.get(key);
 292.620 +	}
 292.621 +	else if(coll instanceof IPersistentSet) {
 292.622 +		IPersistentSet set = (IPersistentSet) coll;
 292.623 +		return set.get(key);
 292.624 +	}
 292.625 +	else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) {
 292.626 +		int n = ((Number) key).intValue();
 292.627 +		if(n >= 0 && n < count(coll))
 292.628 +			return nth(coll, n);
 292.629 +		return null;
 292.630 +	}
 292.631 +
 292.632 +	return null;
 292.633 +}
 292.634 +
 292.635 +static public Object get(Object coll, Object key, Object notFound){
 292.636 +	if(coll instanceof ILookup)
 292.637 +		return ((ILookup) coll).valAt(key, notFound);
 292.638 +	return getFrom(coll, key, notFound);
 292.639 +}
 292.640 +
 292.641 +static Object getFrom(Object coll, Object key, Object notFound){
 292.642 +	if(coll == null)
 292.643 +		return notFound;
 292.644 +	else if(coll instanceof Map) {
 292.645 +		Map m = (Map) coll;
 292.646 +		if(m.containsKey(key))
 292.647 +			return m.get(key);
 292.648 +		return notFound;
 292.649 +	}
 292.650 +	else if(coll instanceof IPersistentSet) {
 292.651 +		IPersistentSet set = (IPersistentSet) coll;
 292.652 +		if(set.contains(key))
 292.653 +			return set.get(key);
 292.654 +		return notFound;
 292.655 +	}
 292.656 +	else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) {
 292.657 +		int n = ((Number) key).intValue();
 292.658 +		return n >= 0 && n < count(coll) ? nth(coll, n) : notFound;
 292.659 +	}
 292.660 +	return notFound;
 292.661 +
 292.662 +}
 292.663 +
 292.664 +static public Associative assoc(Object coll, Object key, Object val){
 292.665 +	if(coll == null)
 292.666 +		return new PersistentArrayMap(new Object[]{key, val});
 292.667 +	return ((Associative) coll).assoc(key, val);
 292.668 +}
 292.669 +
 292.670 +static public Object contains(Object coll, Object key){
 292.671 +	if(coll == null)
 292.672 +		return F;
 292.673 +	else if(coll instanceof Associative)
 292.674 +		return ((Associative) coll).containsKey(key) ? T : F;
 292.675 +	else if(coll instanceof IPersistentSet)
 292.676 +		return ((IPersistentSet) coll).contains(key) ? T : F;
 292.677 +	else if(coll instanceof Map) {
 292.678 +		Map m = (Map) coll;
 292.679 +		return m.containsKey(key) ? T : F;
 292.680 +	}
 292.681 +	else if(key instanceof Number && (coll instanceof String || coll.getClass().isArray())) {
 292.682 +		int n = ((Number) key).intValue();
 292.683 +		return n >= 0 && n < count(coll);
 292.684 +	}
 292.685 +	return F;
 292.686 +}
 292.687 +
 292.688 +static public Object find(Object coll, Object key){
 292.689 +	if(coll == null)
 292.690 +		return null;
 292.691 +	else if(coll instanceof Associative)
 292.692 +		return ((Associative) coll).entryAt(key);
 292.693 +	else {
 292.694 +		Map m = (Map) coll;
 292.695 +		if(m.containsKey(key))
 292.696 +			return new MapEntry(key, m.get(key));
 292.697 +		return null;
 292.698 +	}
 292.699 +}
 292.700 +
 292.701 +//takes a seq of key,val,key,val
 292.702 +
 292.703 +//returns tail starting at val of matching key if found, else null
 292.704 +static public ISeq findKey(Keyword key, ISeq keyvals) throws Exception{
 292.705 +	while(keyvals != null) {
 292.706 +		ISeq r = keyvals.next();
 292.707 +		if(r == null)
 292.708 +			throw new Exception("Malformed keyword argslist");
 292.709 +		if(keyvals.first() == key)
 292.710 +			return r;
 292.711 +		keyvals = r.next();
 292.712 +	}
 292.713 +	return null;
 292.714 +}
 292.715 +
 292.716 +static public Object dissoc(Object coll, Object key) throws Exception{
 292.717 +	if(coll == null)
 292.718 +		return null;
 292.719 +	return ((IPersistentMap) coll).without(key);
 292.720 +}
 292.721 +
 292.722 +static public Object nth(Object coll, int n){
 292.723 +	if(coll instanceof Indexed)
 292.724 +		return ((Indexed) coll).nth(n);
 292.725 +	return nthFrom(Util.ret1(coll, coll = null), n);
 292.726 +}
 292.727 +
 292.728 +static Object nthFrom(Object coll, int n){
 292.729 +	if(coll == null)
 292.730 +		return null;
 292.731 +	else if(coll instanceof CharSequence)
 292.732 +		return Character.valueOf(((CharSequence) coll).charAt(n));
 292.733 +	else if(coll.getClass().isArray())
 292.734 +		return Reflector.prepRet(Array.get(coll, n));
 292.735 +	else if(coll instanceof RandomAccess)
 292.736 +		return ((List) coll).get(n);
 292.737 +	else if(coll instanceof Matcher)
 292.738 +		return ((Matcher) coll).group(n);
 292.739 +
 292.740 +	else if(coll instanceof Map.Entry) {
 292.741 +		Map.Entry e = (Map.Entry) coll;
 292.742 +		if(n == 0)
 292.743 +			return e.getKey();
 292.744 +		else if(n == 1)
 292.745 +			return e.getValue();
 292.746 +		throw new IndexOutOfBoundsException();
 292.747 +	}
 292.748 +
 292.749 +	else if(coll instanceof Sequential) {
 292.750 +		ISeq seq = RT.seq(coll);
 292.751 +		coll = null;
 292.752 +		for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) {
 292.753 +			if(i == n)
 292.754 +				return seq.first();
 292.755 +		}
 292.756 +		throw new IndexOutOfBoundsException();
 292.757 +	}
 292.758 +	else
 292.759 +		throw new UnsupportedOperationException(
 292.760 +				"nth not supported on this type: " + coll.getClass().getSimpleName());
 292.761 +}
 292.762 +
 292.763 +static public Object nth(Object coll, int n, Object notFound){
 292.764 +	if(coll instanceof Indexed) {
 292.765 +		Indexed v = (Indexed) coll;
 292.766 +			return v.nth(n, notFound);
 292.767 +	}
 292.768 +	return nthFrom(coll, n, notFound);
 292.769 +}
 292.770 +
 292.771 +static Object nthFrom(Object coll, int n, Object notFound){
 292.772 +	if(coll == null)
 292.773 +		return notFound;
 292.774 +	else if(n < 0)
 292.775 +		return notFound;
 292.776 +
 292.777 +	else if(coll instanceof CharSequence) {
 292.778 +		CharSequence s = (CharSequence) coll;
 292.779 +		if(n < s.length())
 292.780 +			return Character.valueOf(s.charAt(n));
 292.781 +		return notFound;
 292.782 +	}
 292.783 +	else if(coll.getClass().isArray()) {
 292.784 +		if(n < Array.getLength(coll))
 292.785 +			return Reflector.prepRet(Array.get(coll, n));
 292.786 +		return notFound;
 292.787 +	}
 292.788 +	else if(coll instanceof RandomAccess) {
 292.789 +		List list = (List) coll;
 292.790 +		if(n < list.size())
 292.791 +			return list.get(n);
 292.792 +		return notFound;
 292.793 +	}
 292.794 +	else if(coll instanceof Matcher) {
 292.795 +		Matcher m = (Matcher) coll;
 292.796 +		if(n < m.groupCount())
 292.797 +			return m.group(n);
 292.798 +		return notFound;
 292.799 +	}
 292.800 +	else if(coll instanceof Map.Entry) {
 292.801 +		Map.Entry e = (Map.Entry) coll;
 292.802 +		if(n == 0)
 292.803 +			return e.getKey();
 292.804 +		else if(n == 1)
 292.805 +			return e.getValue();
 292.806 +		return notFound;
 292.807 +	}
 292.808 +	else if(coll instanceof Sequential) {
 292.809 +		ISeq seq = RT.seq(coll);
 292.810 +		coll = null;
 292.811 +		for(int i = 0; i <= n && seq != null; ++i, seq = seq.next()) {
 292.812 +			if(i == n)
 292.813 +				return seq.first();
 292.814 +		}
 292.815 +		return notFound;
 292.816 +	}
 292.817 +	else
 292.818 +		throw new UnsupportedOperationException(
 292.819 +				"nth not supported on this type: " + coll.getClass().getSimpleName());
 292.820 +}
 292.821 +
 292.822 +static public Object assocN(int n, Object val, Object coll){
 292.823 +	if(coll == null)
 292.824 +		return null;
 292.825 +	else if(coll instanceof IPersistentVector)
 292.826 +		return ((IPersistentVector) coll).assocN(n, val);
 292.827 +	else if(coll instanceof Object[]) {
 292.828 +		//hmm... this is not persistent
 292.829 +		Object[] array = ((Object[]) coll);
 292.830 +		array[n] = val;
 292.831 +		return array;
 292.832 +	}
 292.833 +	else
 292.834 +		return null;
 292.835 +}
 292.836 +
 292.837 +static boolean hasTag(Object o, Object tag){
 292.838 +	return Util.equals(tag, RT.get(RT.meta(o), TAG_KEY));
 292.839 +}
 292.840 +
 292.841 +/**
 292.842 + * ********************* Boxing/casts ******************************
 292.843 + */
 292.844 +static public Object box(Object x){
 292.845 +	return x;
 292.846 +}
 292.847 +
 292.848 +static public Character box(char x){
 292.849 +	return Character.valueOf(x);
 292.850 +}
 292.851 +
 292.852 +static public Object box(boolean x){
 292.853 +	return x ? T : F;
 292.854 +}
 292.855 +
 292.856 +static public Object box(Boolean x){
 292.857 +	return x;// ? T : null;
 292.858 +}
 292.859 +
 292.860 +static public Number box(byte x){
 292.861 +	return x;//Num.from(x);
 292.862 +}
 292.863 +
 292.864 +static public Number box(short x){
 292.865 +	return x;//Num.from(x);
 292.866 +}
 292.867 +
 292.868 +static public Number box(int x){
 292.869 +	return x;//Num.from(x);
 292.870 +}
 292.871 +
 292.872 +static public Number box(long x){
 292.873 +	return x;//Num.from(x);
 292.874 +}
 292.875 +
 292.876 +static public Number box(float x){
 292.877 +	return x;//Num.from(x);
 292.878 +}
 292.879 +
 292.880 +static public Number box(double x){
 292.881 +	return x;//Num.from(x);
 292.882 +}
 292.883 +
 292.884 +static public char charCast(Object x){
 292.885 +	if(x instanceof Character)
 292.886 +		return ((Character) x).charValue();
 292.887 +
 292.888 +	long n = ((Number) x).longValue();
 292.889 +	if(n < Character.MIN_VALUE || n > Character.MAX_VALUE)
 292.890 +		throw new IllegalArgumentException("Value out of range for char: " + x);
 292.891 +
 292.892 +	return (char) n;
 292.893 +}
 292.894 +
 292.895 +static public boolean booleanCast(Object x){
 292.896 +	if(x instanceof Boolean)
 292.897 +		return ((Boolean) x).booleanValue();
 292.898 +	return x != null;
 292.899 +}
 292.900 +
 292.901 +static public boolean booleanCast(boolean x){
 292.902 +	return x;
 292.903 +}
 292.904 +
 292.905 +static public byte byteCast(Object x){
 292.906 +	long n = ((Number) x).longValue();
 292.907 +	if(n < Byte.MIN_VALUE || n > Byte.MAX_VALUE)
 292.908 +		throw new IllegalArgumentException("Value out of range for byte: " + x);
 292.909 +
 292.910 +	return (byte) n;
 292.911 +}
 292.912 +
 292.913 +static public short shortCast(Object x){
 292.914 +	long n = ((Number) x).longValue();
 292.915 +	if(n < Short.MIN_VALUE || n > Short.MAX_VALUE)
 292.916 +		throw new IllegalArgumentException("Value out of range for short: " + x);
 292.917 +
 292.918 +	return (short) n;
 292.919 +}
 292.920 +
 292.921 +static public int intCast(Object x){
 292.922 +	if(x instanceof Integer)
 292.923 +		return ((Integer)x).intValue();
 292.924 +	if(x instanceof Number)
 292.925 +		return intCast(((Number) x).longValue());
 292.926 +	return ((Character) x).charValue();
 292.927 +}
 292.928 +
 292.929 +static public int intCast(char x){
 292.930 +	return x;
 292.931 +}
 292.932 +
 292.933 +static public int intCast(byte x){
 292.934 +	return x;
 292.935 +}
 292.936 +
 292.937 +static public int intCast(short x){
 292.938 +	return x;
 292.939 +}
 292.940 +
 292.941 +static public int intCast(int x){
 292.942 +	return x;
 292.943 +}
 292.944 +
 292.945 +static public int intCast(float x){
 292.946 +	if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE)
 292.947 +		throw new IllegalArgumentException("Value out of range for int: " + x);
 292.948 +	return (int) x;
 292.949 +}
 292.950 +
 292.951 +static public int intCast(long x){
 292.952 +	if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE)
 292.953 +		throw new IllegalArgumentException("Value out of range for int: " + x);
 292.954 +	return (int) x;
 292.955 +}
 292.956 +
 292.957 +static public int intCast(double x){
 292.958 +	if(x < Integer.MIN_VALUE || x > Integer.MAX_VALUE)
 292.959 +		throw new IllegalArgumentException("Value out of range for int: " + x);
 292.960 +	return (int) x;
 292.961 +}
 292.962 +
 292.963 +static public long longCast(Object x){
 292.964 +	return ((Number) x).longValue();
 292.965 +}
 292.966 +
 292.967 +static public long longCast(int x){
 292.968 +	return x;
 292.969 +}
 292.970 +
 292.971 +static public long longCast(float x){
 292.972 +	if(x < Long.MIN_VALUE || x > Long.MAX_VALUE)
 292.973 +		throw new IllegalArgumentException("Value out of range for long: " + x);
 292.974 +	return (long) x;
 292.975 +}
 292.976 +
 292.977 +static public long longCast(long x){
 292.978 +	return x;
 292.979 +}
 292.980 +
 292.981 +static public long longCast(double x){
 292.982 +	if(x < Long.MIN_VALUE || x > Long.MAX_VALUE)
 292.983 +		throw new IllegalArgumentException("Value out of range for long: " + x);
 292.984 +	return (long) x;
 292.985 +}
 292.986 +
 292.987 +static public float floatCast(Object x){
 292.988 +	if(x instanceof Float)
 292.989 +		return ((Float) x).floatValue();
 292.990 +
 292.991 +	double n = ((Number) x).doubleValue();
 292.992 +	if(n < -Float.MAX_VALUE || n > Float.MAX_VALUE)
 292.993 +		throw new IllegalArgumentException("Value out of range for float: " + x);
 292.994 +
 292.995 +	return (float) n;
 292.996 +
 292.997 +}
 292.998 +
 292.999 +static public float floatCast(int x){
292.1000 +	return x;
292.1001 +}
292.1002 +
292.1003 +static public float floatCast(float x){
292.1004 +	return x;
292.1005 +}
292.1006 +
292.1007 +static public float floatCast(long x){
292.1008 +	return x;
292.1009 +}
292.1010 +
292.1011 +static public float floatCast(double x){
292.1012 +	if(x < -Float.MAX_VALUE || x > Float.MAX_VALUE)
292.1013 +		throw new IllegalArgumentException("Value out of range for float: " + x);
292.1014 +	
292.1015 +	return (float) x;
292.1016 +}
292.1017 +
292.1018 +static public double doubleCast(Object x){
292.1019 +	return ((Number) x).doubleValue();
292.1020 +}
292.1021 +
292.1022 +static public double doubleCast(int x){
292.1023 +	return x;
292.1024 +}
292.1025 +
292.1026 +static public double doubleCast(float x){
292.1027 +	return x;
292.1028 +}
292.1029 +
292.1030 +static public double doubleCast(long x){
292.1031 +	return x;
292.1032 +}
292.1033 +
292.1034 +static public double doubleCast(double x){
292.1035 +	return x;
292.1036 +}
292.1037 +
292.1038 +static public IPersistentMap map(Object... init){
292.1039 +	if(init == null)
292.1040 +		return PersistentArrayMap.EMPTY;
292.1041 +	else if(init.length <= PersistentArrayMap.HASHTABLE_THRESHOLD)
292.1042 +		return PersistentArrayMap.createWithCheck(init);
292.1043 +	return PersistentHashMap.createWithCheck(init);
292.1044 +}
292.1045 +
292.1046 +static public IPersistentSet set(Object... init){
292.1047 +	return PersistentHashSet.createWithCheck(init);
292.1048 +}
292.1049 +
292.1050 +static public IPersistentVector vector(Object... init){
292.1051 +	return LazilyPersistentVector.createOwning(init);
292.1052 +}
292.1053 +
292.1054 +static public IPersistentVector subvec(IPersistentVector v, int start, int end){
292.1055 +	if(end < start || start < 0 || end > v.count())
292.1056 +		throw new IndexOutOfBoundsException();
292.1057 +	if(start == end)
292.1058 +		return PersistentVector.EMPTY;
292.1059 +	return new APersistentVector.SubVector(null, v, start, end);
292.1060 +}
292.1061 +
292.1062 +/**
292.1063 + * **************************************** list support *******************************
292.1064 + */
292.1065 +
292.1066 +
292.1067 +static public ISeq list(){
292.1068 +	return null;
292.1069 +}
292.1070 +
292.1071 +static public ISeq list(Object arg1){
292.1072 +	return new PersistentList(arg1);
292.1073 +}
292.1074 +
292.1075 +static public ISeq list(Object arg1, Object arg2){
292.1076 +	return listStar(arg1, arg2, null);
292.1077 +}
292.1078 +
292.1079 +static public ISeq list(Object arg1, Object arg2, Object arg3){
292.1080 +	return listStar(arg1, arg2, arg3, null);
292.1081 +}
292.1082 +
292.1083 +static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4){
292.1084 +	return listStar(arg1, arg2, arg3, arg4, null);
292.1085 +}
292.1086 +
292.1087 +static public ISeq list(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5){
292.1088 +	return listStar(arg1, arg2, arg3, arg4, arg5, null);
292.1089 +}
292.1090 +
292.1091 +static public ISeq listStar(Object arg1, ISeq rest){
292.1092 +	return (ISeq) cons(arg1, rest);
292.1093 +}
292.1094 +
292.1095 +static public ISeq listStar(Object arg1, Object arg2, ISeq rest){
292.1096 +	return (ISeq) cons(arg1, cons(arg2, rest));
292.1097 +}
292.1098 +
292.1099 +static public ISeq listStar(Object arg1, Object arg2, Object arg3, ISeq rest){
292.1100 +	return (ISeq) cons(arg1, cons(arg2, cons(arg3, rest)));
292.1101 +}
292.1102 +
292.1103 +static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, ISeq rest){
292.1104 +	return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, rest))));
292.1105 +}
292.1106 +
292.1107 +static public ISeq listStar(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, ISeq rest){
292.1108 +	return (ISeq) cons(arg1, cons(arg2, cons(arg3, cons(arg4, cons(arg5, rest)))));
292.1109 +}
292.1110 +
292.1111 +static public ISeq arrayToList(Object[] a) throws Exception{
292.1112 +	ISeq ret = null;
292.1113 +	for(int i = a.length - 1; i >= 0; --i)
292.1114 +		ret = (ISeq) cons(a[i], ret);
292.1115 +	return ret;
292.1116 +}
292.1117 +
292.1118 +static public Object[] object_array(Object sizeOrSeq){
292.1119 +	if(sizeOrSeq instanceof Number)
292.1120 +		return new Object[((Number) sizeOrSeq).intValue()];
292.1121 +	else
292.1122 +		{
292.1123 +		ISeq s = RT.seq(sizeOrSeq);
292.1124 +		int size = RT.count(s);
292.1125 +		Object[] ret = new Object[size];
292.1126 +		for(int i = 0; i < size && s != null; i++, s = s.next())
292.1127 +			ret[i] = s.first();
292.1128 +		return ret;
292.1129 +		}
292.1130 +}
292.1131 +
292.1132 +static public Object[] toArray(Object coll) throws Exception{
292.1133 +	if(coll == null)
292.1134 +		return EMPTY_ARRAY;
292.1135 +	else if(coll instanceof Object[])
292.1136 +		return (Object[]) coll;
292.1137 +	else if(coll instanceof Collection)
292.1138 +		return ((Collection) coll).toArray();
292.1139 +	else if(coll instanceof Map)
292.1140 +		return ((Map) coll).entrySet().toArray();
292.1141 +	else if(coll instanceof String) {
292.1142 +		char[] chars = ((String) coll).toCharArray();
292.1143 +		Object[] ret = new Object[chars.length];
292.1144 +		for(int i = 0; i < chars.length; i++)
292.1145 +			ret[i] = chars[i];
292.1146 +		return ret;
292.1147 +	}
292.1148 +	else if(coll.getClass().isArray()) {
292.1149 +		ISeq s = (seq(coll));
292.1150 +		Object[] ret = new Object[count(s)];
292.1151 +		for(int i = 0; i < ret.length; i++, s = s.next())
292.1152 +			ret[i] = s.first();
292.1153 +		return ret;
292.1154 +	}
292.1155 +	else
292.1156 +		throw new Exception("Unable to convert: " + coll.getClass() + " to Object[]");
292.1157 +}
292.1158 +
292.1159 +static public Object[] seqToArray(ISeq seq){
292.1160 +	int len = length(seq);
292.1161 +	Object[] ret = new Object[len];
292.1162 +	for(int i = 0; seq != null; ++i, seq = seq.next())
292.1163 +		ret[i] = seq.first();
292.1164 +	return ret;
292.1165 +}
292.1166 +
292.1167 +static public Object seqToTypedArray(ISeq seq) throws Exception{
292.1168 +	Class type = (seq != null) ? seq.first().getClass() : Object.class;
292.1169 +	return seqToTypedArray(type, seq);
292.1170 +}
292.1171 +
292.1172 +static public Object seqToTypedArray(Class type, ISeq seq) throws Exception{
292.1173 +	Object ret = Array.newInstance(type, length(seq));
292.1174 +	for(int i = 0; seq != null; ++i, seq = seq.next())
292.1175 +		Array.set(ret, i, seq.first());
292.1176 +	return ret;
292.1177 +}
292.1178 +
292.1179 +static public int length(ISeq list){
292.1180 +	int i = 0;
292.1181 +	for(ISeq c = list; c != null; c = c.next()) {
292.1182 +		i++;
292.1183 +	}
292.1184 +	return i;
292.1185 +}
292.1186 +
292.1187 +static public int boundedLength(ISeq list, int limit) throws Exception{
292.1188 +	int i = 0;
292.1189 +	for(ISeq c = list; c != null && i <= limit; c = c.next()) {
292.1190 +		i++;
292.1191 +	}
292.1192 +	return i;
292.1193 +}
292.1194 +
292.1195 +///////////////////////////////// reader support ////////////////////////////////
292.1196 +
292.1197 +static Character readRet(int ret){
292.1198 +	if(ret == -1)
292.1199 +		return null;
292.1200 +	return box((char) ret);
292.1201 +}
292.1202 +
292.1203 +static public Character readChar(Reader r) throws Exception{
292.1204 +	int ret = r.read();
292.1205 +	return readRet(ret);
292.1206 +}
292.1207 +
292.1208 +static public Character peekChar(Reader r) throws Exception{
292.1209 +	int ret;
292.1210 +	if(r instanceof PushbackReader) {
292.1211 +		ret = r.read();
292.1212 +		((PushbackReader) r).unread(ret);
292.1213 +	}
292.1214 +	else {
292.1215 +		r.mark(1);
292.1216 +		ret = r.read();
292.1217 +		r.reset();
292.1218 +	}
292.1219 +
292.1220 +	return readRet(ret);
292.1221 +}
292.1222 +
292.1223 +static public int getLineNumber(Reader r){
292.1224 +	if(r instanceof LineNumberingPushbackReader)
292.1225 +		return ((LineNumberingPushbackReader) r).getLineNumber();
292.1226 +	return 0;
292.1227 +}
292.1228 +
292.1229 +static public LineNumberingPushbackReader getLineNumberingReader(Reader r){
292.1230 +	if(isLineNumberingReader(r))
292.1231 +		return (LineNumberingPushbackReader) r;
292.1232 +	return new LineNumberingPushbackReader(r);
292.1233 +}
292.1234 +
292.1235 +static public boolean isLineNumberingReader(Reader r){
292.1236 +	return r instanceof LineNumberingPushbackReader;
292.1237 +}
292.1238 +
292.1239 +static public String resolveClassNameInContext(String className){
292.1240 +	//todo - look up in context var
292.1241 +	return className;
292.1242 +}
292.1243 +
292.1244 +static public boolean suppressRead(){
292.1245 +	//todo - look up in suppress-read var
292.1246 +	return false;
292.1247 +}
292.1248 +
292.1249 +static public String printString(Object x){
292.1250 +	try {
292.1251 +		StringWriter sw = new StringWriter();
292.1252 +		print(x, sw);
292.1253 +		return sw.toString();
292.1254 +	}
292.1255 +	catch(Exception e) {
292.1256 +		throw new RuntimeException(e);
292.1257 +	}
292.1258 +}
292.1259 +
292.1260 +static public Object readString(String s){
292.1261 +	PushbackReader r = new PushbackReader(new StringReader(s));
292.1262 +	try {
292.1263 +		return LispReader.read(r, true, null, false);
292.1264 +	}
292.1265 +	catch(Exception e) {
292.1266 +		throw new RuntimeException(e);
292.1267 +	}
292.1268 +}
292.1269 +
292.1270 +static public void print(Object x, Writer w) throws Exception{
292.1271 +	//call multimethod
292.1272 +	if(PRINT_INITIALIZED.isBound() && RT.booleanCast(PRINT_INITIALIZED.deref()))
292.1273 +		PR_ON.invoke(x, w);
292.1274 +//*
292.1275 +	else {
292.1276 +		boolean readably = booleanCast(PRINT_READABLY.deref());
292.1277 +		if(x instanceof Obj) {
292.1278 +			Obj o = (Obj) x;
292.1279 +			if(RT.count(o.meta()) > 0 &&
292.1280 +			   ((readably && booleanCast(PRINT_META.deref()))
292.1281 +			    || booleanCast(PRINT_DUP.deref()))) {
292.1282 +				IPersistentMap meta = o.meta();
292.1283 +				w.write("#^");
292.1284 +				if(meta.count() == 1 && meta.containsKey(TAG_KEY))
292.1285 +					print(meta.valAt(TAG_KEY), w);
292.1286 +				else
292.1287 +					print(meta, w);
292.1288 +				w.write(' ');
292.1289 +			}
292.1290 +		}
292.1291 +		if(x == null)
292.1292 +			w.write("nil");
292.1293 +		else if(x instanceof ISeq || x instanceof IPersistentList) {
292.1294 +			w.write('(');
292.1295 +			printInnerSeq(seq(x), w);
292.1296 +			w.write(')');
292.1297 +		}
292.1298 +		else if(x instanceof String) {
292.1299 +			String s = (String) x;
292.1300 +			if(!readably)
292.1301 +				w.write(s);
292.1302 +			else {
292.1303 +				w.write('"');
292.1304 +				//w.write(x.toString());
292.1305 +				for(int i = 0; i < s.length(); i++) {
292.1306 +					char c = s.charAt(i);
292.1307 +					switch(c) {
292.1308 +						case '\n':
292.1309 +							w.write("\\n");
292.1310 +							break;
292.1311 +						case '\t':
292.1312 +							w.write("\\t");
292.1313 +							break;
292.1314 +						case '\r':
292.1315 +							w.write("\\r");
292.1316 +							break;
292.1317 +						case '"':
292.1318 +							w.write("\\\"");
292.1319 +							break;
292.1320 +						case '\\':
292.1321 +							w.write("\\\\");
292.1322 +							break;
292.1323 +						case '\f':
292.1324 +							w.write("\\f");
292.1325 +							break;
292.1326 +						case '\b':
292.1327 +							w.write("\\b");
292.1328 +							break;
292.1329 +						default:
292.1330 +							w.write(c);
292.1331 +					}
292.1332 +				}
292.1333 +				w.write('"');
292.1334 +			}
292.1335 +		}
292.1336 +		else if(x instanceof IPersistentMap) {
292.1337 +			w.write('{');
292.1338 +			for(ISeq s = seq(x); s != null; s = s.next()) {
292.1339 +				IMapEntry e = (IMapEntry) s.first();
292.1340 +				print(e.key(), w);
292.1341 +				w.write(' ');
292.1342 +				print(e.val(), w);
292.1343 +				if(s.next() != null)
292.1344 +					w.write(", ");
292.1345 +			}
292.1346 +			w.write('}');
292.1347 +		}
292.1348 +		else if(x instanceof IPersistentVector) {
292.1349 +			IPersistentVector a = (IPersistentVector) x;
292.1350 +			w.write('[');
292.1351 +			for(int i = 0; i < a.count(); i++) {
292.1352 +				print(a.nth(i), w);
292.1353 +				if(i < a.count() - 1)
292.1354 +					w.write(' ');
292.1355 +			}
292.1356 +			w.write(']');
292.1357 +		}
292.1358 +		else if(x instanceof IPersistentSet) {
292.1359 +			w.write("#{");
292.1360 +			for(ISeq s = seq(x); s != null; s = s.next()) {
292.1361 +				print(s.first(), w);
292.1362 +				if(s.next() != null)
292.1363 +					w.write(" ");
292.1364 +			}
292.1365 +			w.write('}');
292.1366 +		}
292.1367 +		else if(x instanceof Character) {
292.1368 +			char c = ((Character) x).charValue();
292.1369 +			if(!readably)
292.1370 +				w.write(c);
292.1371 +			else {
292.1372 +				w.write('\\');
292.1373 +				switch(c) {
292.1374 +					case '\n':
292.1375 +						w.write("newline");
292.1376 +						break;
292.1377 +					case '\t':
292.1378 +						w.write("tab");
292.1379 +						break;
292.1380 +					case ' ':
292.1381 +						w.write("space");
292.1382 +						break;
292.1383 +					case '\b':
292.1384 +						w.write("backspace");
292.1385 +						break;
292.1386 +					case '\f':
292.1387 +						w.write("formfeed");
292.1388 +						break;
292.1389 +					case '\r':
292.1390 +						w.write("return");
292.1391 +						break;
292.1392 +					default:
292.1393 +						w.write(c);
292.1394 +				}
292.1395 +			}
292.1396 +		}
292.1397 +		else if(x instanceof Class) {
292.1398 +			w.write("#=");
292.1399 +			w.write(((Class) x).getName());
292.1400 +		}
292.1401 +		else if(x instanceof BigDecimal && readably) {
292.1402 +			w.write(x.toString());
292.1403 +			w.write('M');
292.1404 +		}
292.1405 +		else if(x instanceof Var) {
292.1406 +			Var v = (Var) x;
292.1407 +			w.write("#=(var " + v.ns.name + "/" + v.sym + ")");
292.1408 +		}
292.1409 +		else if(x instanceof Pattern) {
292.1410 +			Pattern p = (Pattern) x;
292.1411 +			w.write("#\"" + p.pattern() + "\"");
292.1412 +		}
292.1413 +		else w.write(x.toString());
292.1414 +	}
292.1415 +	//*/
292.1416 +}
292.1417 +
292.1418 +private static void printInnerSeq(ISeq x, Writer w) throws Exception{
292.1419 +	for(ISeq s = x; s != null; s = s.next()) {
292.1420 +		print(s.first(), w);
292.1421 +		if(s.next() != null)
292.1422 +			w.write(' ');
292.1423 +	}
292.1424 +}
292.1425 +
292.1426 +static public void formatAesthetic(Writer w, Object obj) throws IOException{
292.1427 +	if(obj == null)
292.1428 +		w.write("null");
292.1429 +	else
292.1430 +		w.write(obj.toString());
292.1431 +}
292.1432 +
292.1433 +static public void formatStandard(Writer w, Object obj) throws IOException{
292.1434 +	if(obj == null)
292.1435 +		w.write("null");
292.1436 +	else if(obj instanceof String) {
292.1437 +		w.write('"');
292.1438 +		w.write((String) obj);
292.1439 +		w.write('"');
292.1440 +	}
292.1441 +	else if(obj instanceof Character) {
292.1442 +		w.write('\\');
292.1443 +		char c = ((Character) obj).charValue();
292.1444 +		switch(c) {
292.1445 +			case '\n':
292.1446 +				w.write("newline");
292.1447 +				break;
292.1448 +			case '\t':
292.1449 +				w.write("tab");
292.1450 +				break;
292.1451 +			case ' ':
292.1452 +				w.write("space");
292.1453 +				break;
292.1454 +			case '\b':
292.1455 +				w.write("backspace");
292.1456 +				break;
292.1457 +			case '\f':
292.1458 +				w.write("formfeed");
292.1459 +				break;
292.1460 +			default:
292.1461 +				w.write(c);
292.1462 +		}
292.1463 +	}
292.1464 +	else
292.1465 +		w.write(obj.toString());
292.1466 +}
292.1467 +
292.1468 +static public Object format(Object o, String s, Object... args) throws Exception{
292.1469 +	Writer w;
292.1470 +	if(o == null)
292.1471 +		w = new StringWriter();
292.1472 +	else if(Util.equals(o, T))
292.1473 +		w = (Writer) OUT.deref();
292.1474 +	else
292.1475 +		w = (Writer) o;
292.1476 +	doFormat(w, s, ArraySeq.create(args));
292.1477 +	if(o == null)
292.1478 +		return w.toString();
292.1479 +	return null;
292.1480 +}
292.1481 +
292.1482 +static public ISeq doFormat(Writer w, String s, ISeq args) throws Exception{
292.1483 +	for(int i = 0; i < s.length();) {
292.1484 +		char c = s.charAt(i++);
292.1485 +		switch(Character.toLowerCase(c)) {
292.1486 +			case '~':
292.1487 +				char d = s.charAt(i++);
292.1488 +				switch(Character.toLowerCase(d)) {
292.1489 +					case '%':
292.1490 +						w.write('\n');
292.1491 +						break;
292.1492 +					case 't':
292.1493 +						w.write('\t');
292.1494 +						break;
292.1495 +					case 'a':
292.1496 +						if(args == null)
292.1497 +							throw new IllegalArgumentException("Missing argument");
292.1498 +						RT.formatAesthetic(w, RT.first(args));
292.1499 +						args = RT.next(args);
292.1500 +						break;
292.1501 +					case 's':
292.1502 +						if(args == null)
292.1503 +							throw new IllegalArgumentException("Missing argument");
292.1504 +						RT.formatStandard(w, RT.first(args));
292.1505 +						args = RT.next(args);
292.1506 +						break;
292.1507 +					case '{':
292.1508 +						int j = s.indexOf("~}", i);    //note - does not nest
292.1509 +						if(j == -1)
292.1510 +							throw new IllegalArgumentException("Missing ~}");
292.1511 +						String subs = s.substring(i, j);
292.1512 +						for(ISeq sargs = RT.seq(RT.first(args)); sargs != null;)
292.1513 +							sargs = doFormat(w, subs, sargs);
292.1514 +						args = RT.next(args);
292.1515 +						i = j + 2; //skip ~}
292.1516 +						break;
292.1517 +					case '^':
292.1518 +						if(args == null)
292.1519 +							return null;
292.1520 +						break;
292.1521 +					case '~':
292.1522 +						w.write('~');
292.1523 +						break;
292.1524 +					default:
292.1525 +						throw new IllegalArgumentException("Unsupported ~ directive: " + d);
292.1526 +				}
292.1527 +				break;
292.1528 +			default:
292.1529 +				w.write(c);
292.1530 +		}
292.1531 +	}
292.1532 +	return args;
292.1533 +}
292.1534 +///////////////////////////////// values //////////////////////////
292.1535 +
292.1536 +static public Object[] setValues(Object... vals){
292.1537 +	//ThreadLocalData.setValues(vals);
292.1538 +	if(vals.length > 0)
292.1539 +		return vals;//[0];
292.1540 +	return null;
292.1541 +}
292.1542 +
292.1543 +
292.1544 +static public ClassLoader makeClassLoader(){
292.1545 +	return (ClassLoader) AccessController.doPrivileged(new PrivilegedAction(){
292.1546 +		public Object run(){
292.1547 +            try{
292.1548 +            Var.pushThreadBindings(RT.map(USE_CONTEXT_CLASSLOADER, RT.T));
292.1549 +//			getRootClassLoader();
292.1550 +			return new DynamicClassLoader(baseLoader());
292.1551 +            }
292.1552 +                finally{
292.1553 +            Var.popThreadBindings();
292.1554 +            }
292.1555 +		}
292.1556 +	});
292.1557 +}
292.1558 +
292.1559 +static public ClassLoader baseLoader(){
292.1560 +	if(Compiler.LOADER.isBound())
292.1561 +		return (ClassLoader) Compiler.LOADER.deref();
292.1562 +	else if(booleanCast(USE_CONTEXT_CLASSLOADER.deref()))
292.1563 +		return Thread.currentThread().getContextClassLoader();
292.1564 +	return Compiler.class.getClassLoader();
292.1565 +}
292.1566 +
292.1567 +static public Class classForName(String name) throws ClassNotFoundException{
292.1568 +
292.1569 +	return Class.forName(name, true, baseLoader());
292.1570 +}
292.1571 +
292.1572 +static public Class loadClassForName(String name) throws ClassNotFoundException{
292.1573 +	try
292.1574 +		{
292.1575 +		Class.forName(name, false, baseLoader());
292.1576 +		}
292.1577 +	catch(ClassNotFoundException e)
292.1578 +		{
292.1579 +		return null;
292.1580 +		}
292.1581 +	return Class.forName(name, true, baseLoader());
292.1582 +}
292.1583 +
292.1584 +static public float aget(float[] xs, int i){
292.1585 +	return xs[i];
292.1586 +}
292.1587 +
292.1588 +static public float aset(float[] xs, int i, float v){
292.1589 +	xs[i] = v;
292.1590 +	return v;
292.1591 +}
292.1592 +
292.1593 +static public int alength(float[] xs){
292.1594 +	return xs.length;
292.1595 +}
292.1596 +
292.1597 +static public float[] aclone(float[] xs){
292.1598 +	return xs.clone();
292.1599 +}
292.1600 +
292.1601 +static public double aget(double[] xs, int i){
292.1602 +	return xs[i];
292.1603 +}
292.1604 +
292.1605 +static public double aset(double[] xs, int i, double v){
292.1606 +	xs[i] = v;
292.1607 +	return v;
292.1608 +}
292.1609 +
292.1610 +static public int alength(double[] xs){
292.1611 +	return xs.length;
292.1612 +}
292.1613 +
292.1614 +static public double[] aclone(double[] xs){
292.1615 +	return xs.clone();
292.1616 +}
292.1617 +
292.1618 +static public int aget(int[] xs, int i){
292.1619 +	return xs[i];
292.1620 +}
292.1621 +
292.1622 +static public int aset(int[] xs, int i, int v){
292.1623 +	xs[i] = v;
292.1624 +	return v;
292.1625 +}
292.1626 +
292.1627 +static public int alength(int[] xs){
292.1628 +	return xs.length;
292.1629 +}
292.1630 +
292.1631 +static public int[] aclone(int[] xs){
292.1632 +	return xs.clone();
292.1633 +}
292.1634 +
292.1635 +static public long aget(long[] xs, int i){
292.1636 +	return xs[i];
292.1637 +}
292.1638 +
292.1639 +static public long aset(long[] xs, int i, long v){
292.1640 +	xs[i] = v;
292.1641 +	return v;
292.1642 +}
292.1643 +
292.1644 +static public int alength(long[] xs){
292.1645 +	return xs.length;
292.1646 +}
292.1647 +
292.1648 +static public long[] aclone(long[] xs){
292.1649 +	return xs.clone();
292.1650 +}
292.1651 +
292.1652 +static public char aget(char[] xs, int i){
292.1653 +	return xs[i];
292.1654 +}
292.1655 +
292.1656 +static public char aset(char[] xs, int i, char v){
292.1657 +	xs[i] = v;
292.1658 +	return v;
292.1659 +}
292.1660 +
292.1661 +static public int alength(char[] xs){
292.1662 +	return xs.length;
292.1663 +}
292.1664 +
292.1665 +static public char[] aclone(char[] xs){
292.1666 +	return xs.clone();
292.1667 +}
292.1668 +
292.1669 +static public byte aget(byte[] xs, int i){
292.1670 +	return xs[i];
292.1671 +}
292.1672 +
292.1673 +static public byte aset(byte[] xs, int i, byte v){
292.1674 +	xs[i] = v;
292.1675 +	return v;
292.1676 +}
292.1677 +
292.1678 +static public int alength(byte[] xs){
292.1679 +	return xs.length;
292.1680 +}
292.1681 +
292.1682 +static public byte[] aclone(byte[] xs){
292.1683 +	return xs.clone();
292.1684 +}
292.1685 +
292.1686 +static public short aget(short[] xs, int i){
292.1687 +	return xs[i];
292.1688 +}
292.1689 +
292.1690 +static public short aset(short[] xs, int i, short v){
292.1691 +	xs[i] = v;
292.1692 +	return v;
292.1693 +}
292.1694 +
292.1695 +static public int alength(short[] xs){
292.1696 +	return xs.length;
292.1697 +}
292.1698 +
292.1699 +static public short[] aclone(short[] xs){
292.1700 +	return xs.clone();
292.1701 +}
292.1702 +
292.1703 +static public boolean aget(boolean[] xs, int i){
292.1704 +	return xs[i];
292.1705 +}
292.1706 +
292.1707 +static public boolean aset(boolean[] xs, int i, boolean v){
292.1708 +	xs[i] = v;
292.1709 +	return v;
292.1710 +}
292.1711 +
292.1712 +static public int alength(boolean[] xs){
292.1713 +	return xs.length;
292.1714 +}
292.1715 +
292.1716 +static public boolean[] aclone(boolean[] xs){
292.1717 +	return xs.clone();
292.1718 +}
292.1719 +
292.1720 +static public Object aget(Object[] xs, int i){
292.1721 +	return xs[i];
292.1722 +}
292.1723 +
292.1724 +static public Object aset(Object[] xs, int i, Object v){
292.1725 +	xs[i] = v;
292.1726 +	return v;
292.1727 +}
292.1728 +
292.1729 +static public int alength(Object[] xs){
292.1730 +	return xs.length;
292.1731 +}
292.1732 +
292.1733 +static public Object[] aclone(Object[] xs){
292.1734 +	return xs.clone();
292.1735 +}
292.1736 +
292.1737 +
292.1738 +}
   293.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   293.2 +++ b/src/clojure/lang/Range.java	Sat Aug 21 06:25:44 2010 -0400
   293.3 @@ -0,0 +1,64 @@
   293.4 +/**
   293.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   293.6 + *   The use and distribution terms for this software are covered by the
   293.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   293.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   293.9 + *   By using this software in any fashion, you are agreeing to be bound by
  293.10 + * 	 the terms of this license.
  293.11 + *   You must not remove this notice, or any other, from this software.
  293.12 + **/
  293.13 +
  293.14 +/* rich Apr 1, 2008 */
  293.15 +
  293.16 +package clojure.lang;
  293.17 +
  293.18 +public class Range extends ASeq implements IReduce, Counted{
  293.19 +final int end;
  293.20 +final int n;
  293.21 +
  293.22 +public Range(int start, int end){
  293.23 +	this.end = end;
  293.24 +	this.n = start;
  293.25 +}
  293.26 +
  293.27 +public Range(IPersistentMap meta, int start, int end){
  293.28 +	super(meta);
  293.29 +	this.end = end;
  293.30 +	this.n = start;
  293.31 +}
  293.32 +
  293.33 +public Obj withMeta(IPersistentMap meta){
  293.34 +	if(meta == meta())
  293.35 +		return this;
  293.36 +	return new Range(meta(), end, n);
  293.37 +}
  293.38 +
  293.39 +public Object first(){
  293.40 +	return n;
  293.41 +}
  293.42 +
  293.43 +public ISeq next(){
  293.44 +	if(n < end-1)
  293.45 +		return new Range(_meta, n + 1, end);
  293.46 +	return null;
  293.47 +}
  293.48 +
  293.49 +public Object reduce(IFn f) throws Exception{
  293.50 +	Object ret = n;
  293.51 +	for(int x = n+1;x < end;x++)
  293.52 +		ret = f.invoke(ret, x);
  293.53 +	return ret;
  293.54 +}
  293.55 +
  293.56 +public Object reduce(IFn f, Object start) throws Exception{
  293.57 +	Object ret = f.invoke(start,n);
  293.58 +	for(int x = n+1;x < end;x++)
  293.59 +		ret = f.invoke(ret, x);
  293.60 +	return ret;
  293.61 +}
  293.62 +
  293.63 +public int count() {
  293.64 +    return end - n;
  293.65 +    }
  293.66 +
  293.67 +}
   294.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   294.2 +++ b/src/clojure/lang/Ratio.java	Sat Aug 21 06:25:44 2010 -0400
   294.3 @@ -0,0 +1,78 @@
   294.4 +/**
   294.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   294.6 + *   The use and distribution terms for this software are covered by the
   294.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   294.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   294.9 + *   By using this software in any fashion, you are agreeing to be bound by
  294.10 + * 	 the terms of this license.
  294.11 + *   You must not remove this notice, or any other, from this software.
  294.12 + **/
  294.13 +
  294.14 +/* rich Mar 31, 2008 */
  294.15 +
  294.16 +package clojure.lang;
  294.17 +
  294.18 +import java.math.BigInteger;
  294.19 +import java.math.BigDecimal;
  294.20 +import java.math.MathContext;
  294.21 +
  294.22 +public class Ratio extends Number implements Comparable{
  294.23 +final public BigInteger numerator;
  294.24 +final public BigInteger denominator;
  294.25 +
  294.26 +public Ratio(BigInteger numerator, BigInteger denominator){
  294.27 +	this.numerator = numerator;
  294.28 +	this.denominator = denominator;
  294.29 +}
  294.30 +
  294.31 +public boolean equals(Object arg0){
  294.32 +	return arg0 != null
  294.33 +	       && arg0 instanceof Ratio
  294.34 +	       && ((Ratio) arg0).numerator.equals(numerator)
  294.35 +	       && ((Ratio) arg0).denominator.equals(denominator);
  294.36 +}
  294.37 +
  294.38 +public int hashCode(){
  294.39 +	return numerator.hashCode() ^ denominator.hashCode();
  294.40 +}
  294.41 +
  294.42 +public String toString(){
  294.43 +	return numerator.toString() + "/" + denominator.toString();
  294.44 +}
  294.45 +
  294.46 +public int intValue(){
  294.47 +	return (int) doubleValue();
  294.48 +}
  294.49 +
  294.50 +public long longValue(){
  294.51 +	return bigIntegerValue().longValue();
  294.52 +}
  294.53 +
  294.54 +public float floatValue(){
  294.55 +	return (float)doubleValue();
  294.56 +}
  294.57 +
  294.58 +public double doubleValue(){
  294.59 +	return decimalValue(MathContext.DECIMAL64).doubleValue();
  294.60 +}
  294.61 +
  294.62 +public BigDecimal decimalValue(){
  294.63 +	return decimalValue(MathContext.UNLIMITED);
  294.64 +}
  294.65 +
  294.66 +public BigDecimal decimalValue(MathContext mc){
  294.67 +	BigDecimal numerator = new BigDecimal(this.numerator);
  294.68 +	BigDecimal denominator = new BigDecimal(this.denominator);
  294.69 +
  294.70 +	return numerator.divide(denominator, mc);
  294.71 +}
  294.72 +
  294.73 +public BigInteger bigIntegerValue(){
  294.74 +	return numerator.divide(denominator);
  294.75 +}
  294.76 +
  294.77 +public int compareTo(Object o){
  294.78 +	Number other = (Number)o;
  294.79 +	return Numbers.compare(this, other);
  294.80 +}
  294.81 +}
   295.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   295.2 +++ b/src/clojure/lang/Ref.java	Sat Aug 21 06:25:44 2010 -0400
   295.3 @@ -0,0 +1,379 @@
   295.4 +/**
   295.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   295.6 + *   The use and distribution terms for this software are covered by the
   295.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   295.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   295.9 + *   By using this software in any fashion, you are agreeing to be bound by
  295.10 + * 	 the terms of this license.
  295.11 + *   You must not remove this notice, or any other, from this software.
  295.12 + **/
  295.13 +
  295.14 +/* rich Jul 25, 2007 */
  295.15 +
  295.16 +package clojure.lang;
  295.17 +
  295.18 +import java.util.concurrent.atomic.AtomicInteger;
  295.19 +import java.util.concurrent.atomic.AtomicLong;
  295.20 +import java.util.concurrent.locks.ReentrantReadWriteLock;
  295.21 +
  295.22 +public class Ref extends ARef implements IFn, Comparable<Ref>, IRef{
  295.23 +    public int compareTo(Ref ref) {
  295.24 +        if(this.id == ref.id)
  295.25 +            return 0;
  295.26 +        else if(this.id < ref.id)
  295.27 +            return -1;
  295.28 +        else
  295.29 +            return 1;
  295.30 +    }
  295.31 +
  295.32 +public int getMinHistory(){
  295.33 +	return minHistory;
  295.34 +}
  295.35 +
  295.36 +public Ref setMinHistory(int minHistory){
  295.37 +	this.minHistory = minHistory;
  295.38 +	return this;
  295.39 +}
  295.40 +
  295.41 +public int getMaxHistory(){
  295.42 +	return maxHistory;
  295.43 +}
  295.44 +
  295.45 +public Ref setMaxHistory(int maxHistory){
  295.46 +	this.maxHistory = maxHistory;
  295.47 +	return this;
  295.48 +}
  295.49 +
  295.50 +public static class TVal{
  295.51 +	Object val;
  295.52 +	long point;
  295.53 +	long msecs;
  295.54 +	TVal prior;
  295.55 +	TVal next;
  295.56 +
  295.57 +	TVal(Object val, long point, long msecs, TVal prior){
  295.58 +		this.val = val;
  295.59 +		this.point = point;
  295.60 +		this.msecs = msecs;
  295.61 +		this.prior = prior;
  295.62 +		this.next = prior.next;
  295.63 +		this.prior.next = this;
  295.64 +		this.next.prior = this;
  295.65 +	}
  295.66 +
  295.67 +	TVal(Object val, long point, long msecs){
  295.68 +		this.val = val;
  295.69 +		this.point = point;
  295.70 +		this.msecs = msecs;
  295.71 +		this.next = this;
  295.72 +		this.prior = this;
  295.73 +	}
  295.74 +
  295.75 +}
  295.76 +
  295.77 +TVal tvals;
  295.78 +final AtomicInteger faults;
  295.79 +final ReentrantReadWriteLock lock;
  295.80 +LockingTransaction.Info tinfo;
  295.81 +//IFn validator;
  295.82 +final long id;
  295.83 +
  295.84 +volatile int minHistory = 0;
  295.85 +volatile int maxHistory = 10;
  295.86 +
  295.87 +static final AtomicLong ids = new AtomicLong();
  295.88 +
  295.89 +public Ref(Object initVal) throws Exception{
  295.90 +	this(initVal, null);
  295.91 +}
  295.92 +
  295.93 +public Ref(Object initVal,IPersistentMap meta) throws Exception{
  295.94 +    super(meta);
  295.95 +    this.id = ids.getAndIncrement();
  295.96 +	this.faults = new AtomicInteger();
  295.97 +	this.lock = new ReentrantReadWriteLock();
  295.98 +	tvals = new TVal(initVal, 0, System.currentTimeMillis());
  295.99 +}
 295.100 +
 295.101 +//the latest val
 295.102 +
 295.103 +// ok out of transaction
 295.104 +Object currentVal(){
 295.105 +	try
 295.106 +		{
 295.107 +		lock.readLock().lock();
 295.108 +		if(tvals != null)
 295.109 +			return tvals.val;
 295.110 +		throw new IllegalStateException(this.toString() + " is unbound.");
 295.111 +		}
 295.112 +	finally
 295.113 +		{
 295.114 +		lock.readLock().unlock();
 295.115 +		}
 295.116 +}
 295.117 +
 295.118 +//*
 295.119 +
 295.120 +public Object deref(){
 295.121 +	LockingTransaction t = LockingTransaction.getRunning();
 295.122 +	if(t == null)
 295.123 +		return currentVal();
 295.124 +	return t.doGet(this);
 295.125 +}
 295.126 +
 295.127 +//void validate(IFn vf, Object val){
 295.128 +//	try{
 295.129 +//		if(vf != null && !RT.booleanCast(vf.invoke(val)))
 295.130 +//            throw new IllegalStateException("Invalid ref state");
 295.131 +//		}
 295.132 +//    catch(RuntimeException re)
 295.133 +//        {
 295.134 +//        throw re;
 295.135 +//        }
 295.136 +//	catch(Exception e)
 295.137 +//		{
 295.138 +//		throw new IllegalStateException("Invalid ref state", e);
 295.139 +//		}
 295.140 +//}
 295.141 +//
 295.142 +//public void setValidator(IFn vf){
 295.143 +//	try
 295.144 +//		{
 295.145 +//		lock.writeLock().lock();
 295.146 +//		validate(vf,currentVal());
 295.147 +//		validator = vf;
 295.148 +//		}
 295.149 +//	finally
 295.150 +//		{
 295.151 +//		lock.writeLock().unlock();
 295.152 +//		}
 295.153 +//}
 295.154 +//
 295.155 +//public IFn getValidator(){
 295.156 +//	try
 295.157 +//		{
 295.158 +//		lock.readLock().lock();
 295.159 +//		return validator;
 295.160 +//		}
 295.161 +//	finally
 295.162 +//		{
 295.163 +//		lock.readLock().unlock();
 295.164 +//		}
 295.165 +//}
 295.166 +
 295.167 +public Object set(Object val){
 295.168 +	return LockingTransaction.getEx().doSet(this, val);
 295.169 +}
 295.170 +
 295.171 +public Object commute(IFn fn, ISeq args) throws Exception{
 295.172 +	return LockingTransaction.getEx().doCommute(this, fn, args);
 295.173 +}
 295.174 +
 295.175 +public Object alter(IFn fn, ISeq args) throws Exception{
 295.176 +	LockingTransaction t = LockingTransaction.getEx();
 295.177 +	return t.doSet(this, fn.applyTo(RT.cons(t.doGet(this), args)));
 295.178 +}
 295.179 +
 295.180 +public void touch(){
 295.181 +	LockingTransaction.getEx().doEnsure(this);
 295.182 +}
 295.183 +
 295.184 +//*/
 295.185 +boolean isBound(){
 295.186 +	try
 295.187 +		{
 295.188 +		lock.readLock().lock();
 295.189 +		return tvals != null;
 295.190 +		}
 295.191 +	finally
 295.192 +		{
 295.193 +		lock.readLock().unlock();
 295.194 +		}
 295.195 +}
 295.196 +
 295.197 +
 295.198 +public void trimHistory(){
 295.199 +	try
 295.200 +		{
 295.201 +		lock.writeLock().lock();
 295.202 +		if(tvals != null)
 295.203 +			{
 295.204 +			tvals.next = tvals;
 295.205 +			tvals.prior = tvals;
 295.206 +			}
 295.207 +		}
 295.208 +	finally
 295.209 +		{
 295.210 +		lock.writeLock().unlock();
 295.211 +		}
 295.212 +}
 295.213 +
 295.214 +public int getHistoryCount(){
 295.215 +	try
 295.216 +		{
 295.217 +		lock.writeLock().lock();
 295.218 +		return histCount();
 295.219 +		}
 295.220 +	finally
 295.221 +		{
 295.222 +		lock.writeLock().unlock();
 295.223 +		}	
 295.224 +}
 295.225 +
 295.226 +int histCount(){
 295.227 +	if(tvals == null)
 295.228 +		return 0;
 295.229 +	else
 295.230 +		{
 295.231 +		int count = 0;
 295.232 +		for(TVal tv = tvals.next;tv != tvals;tv = tv.next)
 295.233 +			count++;
 295.234 +		return count;
 295.235 +		}
 295.236 +}
 295.237 +
 295.238 +final public IFn fn(){
 295.239 +	return (IFn) deref();
 295.240 +}
 295.241 +
 295.242 +public Object call() throws Exception{
 295.243 +	return invoke();
 295.244 +}
 295.245 +
 295.246 +public void run(){
 295.247 +	try
 295.248 +		{
 295.249 +		invoke();
 295.250 +		}
 295.251 +	catch(Exception e)
 295.252 +		{
 295.253 +		throw new RuntimeException(e);
 295.254 +		}
 295.255 +}
 295.256 +
 295.257 +public Object invoke() throws Exception{
 295.258 +	return fn().invoke();
 295.259 +}
 295.260 +
 295.261 +public Object invoke(Object arg1) throws Exception{
 295.262 +	return fn().invoke(arg1);
 295.263 +}
 295.264 +
 295.265 +public Object invoke(Object arg1, Object arg2) throws Exception{
 295.266 +	return fn().invoke(arg1, arg2);
 295.267 +}
 295.268 +
 295.269 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{
 295.270 +	return fn().invoke(arg1, arg2, arg3);
 295.271 +}
 295.272 +
 295.273 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{
 295.274 +	return fn().invoke(arg1, arg2, arg3, arg4);
 295.275 +}
 295.276 +
 295.277 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{
 295.278 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5);
 295.279 +}
 295.280 +
 295.281 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{
 295.282 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6);
 295.283 +}
 295.284 +
 295.285 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
 295.286 +		throws Exception{
 295.287 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
 295.288 +}
 295.289 +
 295.290 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.291 +                     Object arg8) throws Exception{
 295.292 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
 295.293 +}
 295.294 +
 295.295 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.296 +                     Object arg8, Object arg9) throws Exception{
 295.297 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
 295.298 +}
 295.299 +
 295.300 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.301 +                     Object arg8, Object arg9, Object arg10) throws Exception{
 295.302 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10);
 295.303 +}
 295.304 +
 295.305 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.306 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{
 295.307 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11);
 295.308 +}
 295.309 +
 295.310 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.311 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{
 295.312 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12);
 295.313 +}
 295.314 +
 295.315 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.316 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13)
 295.317 +		throws Exception{
 295.318 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13);
 295.319 +}
 295.320 +
 295.321 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.322 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
 295.323 +		throws Exception{
 295.324 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14);
 295.325 +}
 295.326 +
 295.327 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.328 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.329 +                     Object arg15) throws Exception{
 295.330 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15);
 295.331 +}
 295.332 +
 295.333 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.334 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.335 +                     Object arg15, Object arg16) throws Exception{
 295.336 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 295.337 +	                   arg16);
 295.338 +}
 295.339 +
 295.340 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.341 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.342 +                     Object arg15, Object arg16, Object arg17) throws Exception{
 295.343 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 295.344 +	                   arg16, arg17);
 295.345 +}
 295.346 +
 295.347 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.348 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.349 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{
 295.350 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 295.351 +	                   arg16, arg17, arg18);
 295.352 +}
 295.353 +
 295.354 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.355 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.356 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{
 295.357 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 295.358 +	                   arg16, arg17, arg18, arg19);
 295.359 +}
 295.360 +
 295.361 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.362 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.363 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
 295.364 +		throws Exception{
 295.365 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 295.366 +	                   arg16, arg17, arg18, arg19, arg20);
 295.367 +}
 295.368 +
 295.369 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 295.370 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 295.371 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20,
 295.372 +                     Object... args)
 295.373 +		throws Exception{
 295.374 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 295.375 +	                   arg16, arg17, arg18, arg19, arg20, args);
 295.376 +}
 295.377 +
 295.378 +public Object applyTo(ISeq arglist) throws Exception{
 295.379 +	return AFn.applyToHelper(this, arglist);
 295.380 +}
 295.381 +
 295.382 +}
   296.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   296.2 +++ b/src/clojure/lang/Reflector.java	Sat Aug 21 06:25:44 2010 -0400
   296.3 @@ -0,0 +1,451 @@
   296.4 +/**
   296.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   296.6 + *   The use and distribution terms for this software are covered by the
   296.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   296.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   296.9 + *   By using this software in any fashion, you are agreeing to be bound by
  296.10 + * 	 the terms of this license.
  296.11 + *   You must not remove this notice, or any other, from this software.
  296.12 + **/
  296.13 +
  296.14 +/* rich Apr 19, 2006 */
  296.15 +
  296.16 +package clojure.lang;
  296.17 +
  296.18 +import java.lang.reflect.*;
  296.19 +import java.util.ArrayList;
  296.20 +import java.util.Iterator;
  296.21 +import java.util.List;
  296.22 +import java.util.Arrays;
  296.23 +
  296.24 +public class Reflector{
  296.25 +
  296.26 +public static Object invokeInstanceMethod(Object target, String methodName, Object[] args) throws Exception{
  296.27 +	try
  296.28 +		{
  296.29 +		Class c = target.getClass();
  296.30 +		List methods = getMethods(c, args.length, methodName, false);
  296.31 +		return invokeMatchingMethod(methodName, methods, target, args);
  296.32 +		}
  296.33 +	catch(InvocationTargetException e)
  296.34 +		{
  296.35 +		if(e.getCause() instanceof Exception)
  296.36 +			throw (Exception) e.getCause();
  296.37 +		else if(e.getCause() instanceof Error)
  296.38 +			throw (Error) e.getCause();
  296.39 +		throw e;
  296.40 +		}
  296.41 +}
  296.42 +
  296.43 +private static String noMethodReport(String methodName, Object target){
  296.44 +	 return "No matching method found: " + methodName
  296.45 +			+ (target==null?"":" for " + target.getClass());
  296.46 +}
  296.47 +static Object invokeMatchingMethod(String methodName, List methods, Object target, Object[] args)
  296.48 +		throws Exception{
  296.49 +	Method m = null;
  296.50 +	Object[] boxedArgs = null;
  296.51 +	if(methods.isEmpty())
  296.52 +		{
  296.53 +		throw new IllegalArgumentException(noMethodReport(methodName,target));
  296.54 +		}
  296.55 +	else if(methods.size() == 1)
  296.56 +		{
  296.57 +		m = (Method) methods.get(0);
  296.58 +		boxedArgs = boxArgs(m.getParameterTypes(), args);
  296.59 +		}
  296.60 +	else //overloaded w/same arity
  296.61 +		{
  296.62 +		Method foundm = null;
  296.63 +		for(Iterator i = methods.iterator(); i.hasNext();)
  296.64 +			{
  296.65 +			m = (Method) i.next();
  296.66 +
  296.67 +			Class[] params = m.getParameterTypes();
  296.68 +			if(isCongruent(params, args))
  296.69 +				{
  296.70 +				if(foundm == null || Compiler.subsumes(params, foundm.getParameterTypes()))
  296.71 +					{
  296.72 +					foundm = m;
  296.73 +					boxedArgs = boxArgs(params, args);
  296.74 +					}
  296.75 +				}
  296.76 +			}
  296.77 +		m = foundm;
  296.78 +		}
  296.79 +	if(m == null)
  296.80 +		throw new IllegalArgumentException(noMethodReport(methodName,target));
  296.81 +
  296.82 +	if(!Modifier.isPublic(m.getDeclaringClass().getModifiers()))
  296.83 +		{
  296.84 +		//public method of non-public class, try to find it in hierarchy
  296.85 +		Method oldm = m;
  296.86 +		m = getAsMethodOfPublicBase(m.getDeclaringClass(), m);
  296.87 +		if(m == null)
  296.88 +			throw new IllegalArgumentException("Can't call public method of non-public class: " +
  296.89 +			                                    oldm.toString());
  296.90 +		}
  296.91 +	try
  296.92 +		{
  296.93 +		return prepRet(m.invoke(target, boxedArgs));
  296.94 +		}
  296.95 +	catch(InvocationTargetException e)
  296.96 +		{
  296.97 +		if(e.getCause() instanceof Exception)
  296.98 +			throw (Exception) e.getCause();
  296.99 +		else if(e.getCause() instanceof Error)
 296.100 +			throw (Error) e.getCause();
 296.101 +		throw e;
 296.102 +		}
 296.103 +
 296.104 +}
 296.105 +
 296.106 +public static Method getAsMethodOfPublicBase(Class c, Method m){
 296.107 +	for(Class iface : c.getInterfaces())
 296.108 +		{
 296.109 +		for(Method im : iface.getMethods())
 296.110 +			{
 296.111 +			if(im.getName().equals(m.getName())
 296.112 +			   && Arrays.equals(m.getParameterTypes(), im.getParameterTypes()))
 296.113 +				{
 296.114 +				return im;
 296.115 +				}
 296.116 +			}
 296.117 +		}
 296.118 +	Class sc = c.getSuperclass();
 296.119 +	if(sc == null)
 296.120 +		return null;
 296.121 +	for(Method scm : sc.getMethods())
 296.122 +		{
 296.123 +		if(scm.getName().equals(m.getName())
 296.124 +		   && Arrays.equals(m.getParameterTypes(), scm.getParameterTypes())
 296.125 +		   && Modifier.isPublic(scm.getDeclaringClass().getModifiers()))
 296.126 +			{
 296.127 +			return scm;
 296.128 +			}
 296.129 +		}
 296.130 +	return getAsMethodOfPublicBase(sc, m);
 296.131 +}
 296.132 +
 296.133 +public static Object invokeConstructor(Class c, Object[] args) throws Exception{
 296.134 +	try
 296.135 +		{
 296.136 +		Constructor[] allctors = c.getConstructors();
 296.137 +		ArrayList ctors = new ArrayList();
 296.138 +		for(int i = 0; i < allctors.length; i++)
 296.139 +			{
 296.140 +			Constructor ctor = allctors[i];
 296.141 +			if(ctor.getParameterTypes().length == args.length)
 296.142 +				ctors.add(ctor);
 296.143 +			}
 296.144 +		if(ctors.isEmpty())
 296.145 +			{
 296.146 +			throw new IllegalArgumentException("No matching ctor found"
 296.147 +				+ " for " + c);
 296.148 +			}
 296.149 +		else if(ctors.size() == 1)
 296.150 +			{
 296.151 +			Constructor ctor = (Constructor) ctors.get(0);
 296.152 +			return ctor.newInstance(boxArgs(ctor.getParameterTypes(), args));
 296.153 +			}
 296.154 +		else //overloaded w/same arity
 296.155 +			{
 296.156 +			for(Iterator iterator = ctors.iterator(); iterator.hasNext();)
 296.157 +				{
 296.158 +				Constructor ctor = (Constructor) iterator.next();
 296.159 +				Class[] params = ctor.getParameterTypes();
 296.160 +				if(isCongruent(params, args))
 296.161 +					{
 296.162 +					Object[] boxedArgs = boxArgs(params, args);
 296.163 +					return ctor.newInstance(boxedArgs);
 296.164 +					}
 296.165 +				}
 296.166 +			throw new IllegalArgumentException("No matching ctor found"
 296.167 +				+ " for " + c);
 296.168 +			}
 296.169 +		}
 296.170 +	catch(InvocationTargetException e)
 296.171 +		{
 296.172 +		if(e.getCause() instanceof Exception)
 296.173 +			throw (Exception) e.getCause();
 296.174 +		else if(e.getCause() instanceof Error)
 296.175 +			throw (Error) e.getCause();
 296.176 +		throw e;
 296.177 +		}
 296.178 +}
 296.179 +
 296.180 +public static Object invokeStaticMethodVariadic(String className, String methodName, Object... args) throws Exception{
 296.181 +	return invokeStaticMethod(className, methodName, args);
 296.182 +
 296.183 +}
 296.184 +
 296.185 +public static Object invokeStaticMethod(String className, String methodName, Object[] args) throws Exception{
 296.186 +	Class c = RT.classForName(className);
 296.187 +	try
 296.188 +		{
 296.189 +		return invokeStaticMethod(c, methodName, args);
 296.190 +		}
 296.191 +	catch(InvocationTargetException e)
 296.192 +		{
 296.193 +		if(e.getCause() instanceof Exception)
 296.194 +			throw (Exception) e.getCause();
 296.195 +		else if(e.getCause() instanceof Error)
 296.196 +			throw (Error) e.getCause();
 296.197 +		throw e;
 296.198 +		}
 296.199 +}
 296.200 +
 296.201 +public static Object invokeStaticMethod(Class c, String methodName, Object[] args) throws Exception{
 296.202 +	if(methodName.equals("new"))
 296.203 +		return invokeConstructor(c, args);
 296.204 +	List methods = getMethods(c, args.length, methodName, true);
 296.205 +	return invokeMatchingMethod(methodName, methods, null, args);
 296.206 +}
 296.207 +
 296.208 +public static Object getStaticField(String className, String fieldName) throws Exception{
 296.209 +	Class c = RT.classForName(className);
 296.210 +	return getStaticField(c, fieldName);
 296.211 +}
 296.212 +
 296.213 +public static Object getStaticField(Class c, String fieldName) throws Exception{
 296.214 +//	if(fieldName.equals("class"))
 296.215 +//		return c;
 296.216 +	Field f = getField(c, fieldName, true);
 296.217 +	if(f != null)
 296.218 +		{
 296.219 +		return prepRet(f.get(null));
 296.220 +		}
 296.221 +	throw new IllegalArgumentException("No matching field found: " + fieldName
 296.222 +		+ " for " + c);
 296.223 +}
 296.224 +
 296.225 +public static Object setStaticField(String className, String fieldName, Object val) throws Exception{
 296.226 +	Class c = RT.classForName(className);
 296.227 +	return setStaticField(c, fieldName, val);
 296.228 +}
 296.229 +
 296.230 +public static Object setStaticField(Class c, String fieldName, Object val) throws Exception{
 296.231 +	Field f = getField(c, fieldName, true);
 296.232 +	if(f != null)
 296.233 +		{
 296.234 +		f.set(null, boxArg(f.getType(), val));
 296.235 +		return val;
 296.236 +		}
 296.237 +	throw new IllegalArgumentException("No matching field found: " + fieldName
 296.238 +		+ " for " + c);
 296.239 +}
 296.240 +
 296.241 +public static Object getInstanceField(Object target, String fieldName) throws Exception{
 296.242 +	Class c = target.getClass();
 296.243 +	Field f = getField(c, fieldName, false);
 296.244 +	if(f != null)
 296.245 +		{
 296.246 +		return prepRet(f.get(target));
 296.247 +		}
 296.248 +	throw new IllegalArgumentException("No matching field found: " + fieldName
 296.249 +		+ " for " + target.getClass());
 296.250 +}
 296.251 +
 296.252 +public static Object setInstanceField(Object target, String fieldName, Object val) throws Exception{
 296.253 +	Class c = target.getClass();
 296.254 +	Field f = getField(c, fieldName, false);
 296.255 +	if(f != null)
 296.256 +		{
 296.257 +		f.set(target, boxArg(f.getType(), val));
 296.258 +		return val;
 296.259 +		}
 296.260 +	throw new IllegalArgumentException("No matching field found: " + fieldName
 296.261 +		+ " for " + target.getClass());
 296.262 +}
 296.263 +
 296.264 +public static Object invokeNoArgInstanceMember(Object target, String name) throws Exception{
 296.265 +	//favor method over field
 296.266 +	List meths = getMethods(target.getClass(), 0, name, false);
 296.267 +	if(meths.size() > 0)
 296.268 +		return invokeMatchingMethod(name, meths, target, RT.EMPTY_ARRAY);
 296.269 +	else
 296.270 +		return getInstanceField(target, name);
 296.271 +}
 296.272 +
 296.273 +public static Object invokeInstanceMember(Object target, String name) throws Exception{
 296.274 +	//check for field first
 296.275 +	Class c = target.getClass();
 296.276 +	Field f = getField(c, name, false);
 296.277 +	if(f != null)  //field get
 296.278 +		{
 296.279 +		return prepRet(f.get(target));
 296.280 +		}
 296.281 +	return invokeInstanceMethod(target, name, RT.EMPTY_ARRAY);
 296.282 +}
 296.283 +
 296.284 +public static Object invokeInstanceMember(String name, Object target, Object arg1) throws Exception{
 296.285 +	//check for field first
 296.286 +	Class c = target.getClass();
 296.287 +	Field f = getField(c, name, false);
 296.288 +	if(f != null)  //field set
 296.289 +		{
 296.290 +		f.set(target, boxArg(f.getType(), arg1));
 296.291 +		return arg1;
 296.292 +		}
 296.293 +	return invokeInstanceMethod(target, name, new Object[]{arg1});
 296.294 +}
 296.295 +
 296.296 +public static Object invokeInstanceMember(String name, Object target, Object... args) throws Exception{
 296.297 +	return invokeInstanceMethod(target, name, args);
 296.298 +}
 296.299 +
 296.300 +
 296.301 +static public Field getField(Class c, String name, boolean getStatics){
 296.302 +	Field[] allfields = c.getFields();
 296.303 +	for(int i = 0; i < allfields.length; i++)
 296.304 +		{
 296.305 +		if(name.equals(allfields[i].getName())
 296.306 +		   && Modifier.isStatic(allfields[i].getModifiers()) == getStatics)
 296.307 +			return allfields[i];
 296.308 +		}
 296.309 +	return null;
 296.310 +}
 296.311 +
 296.312 +static public List getMethods(Class c, int arity, String name, boolean getStatics){
 296.313 +	Method[] allmethods = c.getMethods();
 296.314 +	ArrayList methods = new ArrayList();
 296.315 +	ArrayList bridgeMethods = new ArrayList();
 296.316 +	for(int i = 0; i < allmethods.length; i++)
 296.317 +		{
 296.318 +		Method method = allmethods[i];
 296.319 +		if(name.equals(method.getName())
 296.320 +		   && Modifier.isStatic(method.getModifiers()) == getStatics
 296.321 +		   && method.getParameterTypes().length == arity)
 296.322 +			{
 296.323 +			try
 296.324 +				{
 296.325 +				if(method.isBridge()
 296.326 +				   && c.getMethod(method.getName(), method.getParameterTypes())
 296.327 +						.equals(method))
 296.328 +					bridgeMethods.add(method);
 296.329 +				else
 296.330 +					methods.add(method);
 296.331 +				}
 296.332 +			catch(NoSuchMethodException e)
 296.333 +				{
 296.334 +				}
 296.335 +			}
 296.336 +//			   && (!method.isBridge()
 296.337 +//			       || (c == StringBuilder.class &&
 296.338 +//			          c.getMethod(method.getName(), method.getParameterTypes())
 296.339 +//					.equals(method))))
 296.340 +//				{
 296.341 +//				methods.add(allmethods[i]);
 296.342 +//				}
 296.343 +		}
 296.344 +
 296.345 +	if(methods.isEmpty())
 296.346 +		methods.addAll(bridgeMethods);
 296.347 +	
 296.348 +	if(!getStatics && c.isInterface())
 296.349 +		{
 296.350 +		allmethods = Object.class.getMethods();
 296.351 +		for(int i = 0; i < allmethods.length; i++)
 296.352 +			{
 296.353 +			if(name.equals(allmethods[i].getName())
 296.354 +			   && Modifier.isStatic(allmethods[i].getModifiers()) == getStatics
 296.355 +			   && allmethods[i].getParameterTypes().length == arity)
 296.356 +				{
 296.357 +				methods.add(allmethods[i]);
 296.358 +				}
 296.359 +			}
 296.360 +		}
 296.361 +	return methods;
 296.362 +}
 296.363 +
 296.364 +
 296.365 +static Object boxArg(Class paramType, Object arg){
 296.366 +	if(!paramType.isPrimitive())
 296.367 +		return paramType.cast(arg);
 296.368 +	else if(paramType == boolean.class)
 296.369 +		return Boolean.class.cast(arg);
 296.370 +	else if(paramType == char.class)
 296.371 +		return Character.class.cast(arg);
 296.372 +	else if(arg instanceof Number)
 296.373 +		{
 296.374 +		Number n = (Number) arg;
 296.375 +		if(paramType == int.class)
 296.376 +			return n.intValue();
 296.377 +		else if(paramType == float.class)
 296.378 +			return n.floatValue();
 296.379 +		else if(paramType == double.class)
 296.380 +			return n.doubleValue();
 296.381 +		else if(paramType == long.class)
 296.382 +			return n.longValue();
 296.383 +		else if(paramType == short.class)
 296.384 +			return n.shortValue();
 296.385 +		else if(paramType == byte.class)
 296.386 +			return n.byteValue();
 296.387 +		}
 296.388 +	throw new IllegalArgumentException("Unexpected param type, expected: " + paramType +
 296.389 +	                                   ", given: " + arg.getClass().getName());
 296.390 +}
 296.391 +
 296.392 +static Object[] boxArgs(Class[] params, Object[] args){
 296.393 +	if(params.length == 0)
 296.394 +		return null;
 296.395 +	Object[] ret = new Object[params.length];
 296.396 +	for(int i = 0; i < params.length; i++)
 296.397 +		{
 296.398 +		Object arg = args[i];
 296.399 +		Class paramType = params[i];
 296.400 +		ret[i] = boxArg(paramType, arg);
 296.401 +		}
 296.402 +	return ret;
 296.403 +}
 296.404 +
 296.405 +static public boolean paramArgTypeMatch(Class paramType, Class argType){
 296.406 +	if(argType == null)
 296.407 +		return !paramType.isPrimitive();
 296.408 +	if(paramType == argType || paramType.isAssignableFrom(argType))
 296.409 +		return true;
 296.410 +	if(paramType == int.class)
 296.411 +		return argType == Integer.class;// || argType == FixNum.class;
 296.412 +	else if(paramType == float.class)
 296.413 +		return argType == Float.class;
 296.414 +	else if(paramType == double.class)
 296.415 +		return argType == Double.class;// || argType == DoubleNum.class;
 296.416 +	else if(paramType == long.class)
 296.417 +		return argType == Long.class;// || argType == BigNum.class;
 296.418 +	else if(paramType == char.class)
 296.419 +		return argType == Character.class;
 296.420 +	else if(paramType == short.class)
 296.421 +		return argType == Short.class;
 296.422 +	else if(paramType == byte.class)
 296.423 +		return argType == Byte.class;
 296.424 +	else if(paramType == boolean.class)
 296.425 +		return argType == Boolean.class;
 296.426 +	return false;
 296.427 +}
 296.428 +
 296.429 +static boolean isCongruent(Class[] params, Object[] args){
 296.430 +	boolean ret = false;
 296.431 +	if(args == null)
 296.432 +		return params.length == 0;
 296.433 +	if(params.length == args.length)
 296.434 +		{
 296.435 +		ret = true;
 296.436 +		for(int i = 0; ret && i < params.length; i++)
 296.437 +			{
 296.438 +			Object arg = args[i];
 296.439 +			Class argType = (arg == null) ? null : arg.getClass();
 296.440 +			Class paramType = params[i];
 296.441 +			ret = paramArgTypeMatch(paramType, argType);
 296.442 +			}
 296.443 +		}
 296.444 +	return ret;
 296.445 +}
 296.446 +
 296.447 +public static Object prepRet(Object x){
 296.448 +//	if(c == boolean.class)
 296.449 +//		return ((Boolean) x).booleanValue() ? RT.T : null;
 296.450 +	if(x instanceof Boolean)
 296.451 +		return ((Boolean) x)?Boolean.TRUE:Boolean.FALSE;
 296.452 +	return x;
 296.453 +}
 296.454 +}
   297.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   297.2 +++ b/src/clojure/lang/Repl.java	Sat Aug 21 06:25:44 2010 -0400
   297.3 @@ -0,0 +1,22 @@
   297.4 +/**
   297.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   297.6 + *   The use and distribution terms for this software are covered by the
   297.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   297.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   297.9 + *   By using this software in any fashion, you are agreeing to be bound by
  297.10 + * 	 the terms of this license.
  297.11 + *   You must not remove this notice, or any other, from this software.
  297.12 + **/
  297.13 +
  297.14 +/* rich Oct 18, 2007 */
  297.15 +
  297.16 +package clojure.lang;
  297.17 +
  297.18 +import clojure.main;
  297.19 +
  297.20 +public class Repl {
  297.21 +
  297.22 +public static void main(String[] args) throws Exception{
  297.23 +    main.legacy_repl(args);
  297.24 +}
  297.25 +}
   298.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   298.2 +++ b/src/clojure/lang/RestFn.java	Sat Aug 21 06:25:44 2010 -0400
   298.3 @@ -0,0 +1,1366 @@
   298.4 +/**
   298.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   298.6 + *   The use and distribution terms for this software are covered by the
   298.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   298.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   298.9 + *   By using this software in any fashion, you are agreeing to be bound by
  298.10 + * 	 the terms of this license.
  298.11 + *   You must not remove this notice, or any other, from this software.
  298.12 + **/
  298.13 +package clojure.lang;
  298.14 +
  298.15 +public abstract class RestFn extends AFunction{
  298.16 +
  298.17 +abstract public int getRequiredArity();
  298.18 +
  298.19 +protected Object doInvoke(Object args) throws Exception{
  298.20 +	return null;
  298.21 +}
  298.22 +
  298.23 +protected Object doInvoke(Object arg1, Object args) throws Exception{
  298.24 +	return null;
  298.25 +}
  298.26 +
  298.27 +protected Object doInvoke(Object arg1, Object arg2, Object args) throws Exception{
  298.28 +	return null;
  298.29 +}
  298.30 +
  298.31 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object args) throws Exception{
  298.32 +	return null;
  298.33 +}
  298.34 +
  298.35 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object args) throws Exception{
  298.36 +	return null;
  298.37 +}
  298.38 +
  298.39 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object args)
  298.40 +		throws Exception{
  298.41 +	return null;
  298.42 +}
  298.43 +
  298.44 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object args)
  298.45 +		throws Exception{
  298.46 +	return null;
  298.47 +}
  298.48 +
  298.49 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.50 +                          Object args) throws Exception{
  298.51 +	return null;
  298.52 +}
  298.53 +
  298.54 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.55 +                          Object arg8, Object args) throws Exception{
  298.56 +	return null;
  298.57 +}
  298.58 +
  298.59 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.60 +                          Object arg8, Object arg9, Object args) throws Exception{
  298.61 +	return null;
  298.62 +}
  298.63 +
  298.64 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.65 +                          Object arg8, Object arg9, Object arg10, Object args) throws Exception{
  298.66 +	return null;
  298.67 +}
  298.68 +
  298.69 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.70 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object args) throws Exception{
  298.71 +	return null;
  298.72 +}
  298.73 +
  298.74 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.75 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object args)
  298.76 +		throws Exception{
  298.77 +	return null;
  298.78 +}
  298.79 +
  298.80 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.81 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object args)
  298.82 +		throws Exception{
  298.83 +	return null;
  298.84 +}
  298.85 +
  298.86 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.87 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
  298.88 +                          Object arg14, Object args) throws Exception{
  298.89 +	return null;
  298.90 +}
  298.91 +
  298.92 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.93 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
  298.94 +                          Object arg14, Object arg15, Object args) throws Exception{
  298.95 +	return null;
  298.96 +}
  298.97 +
  298.98 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
  298.99 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
 298.100 +                          Object arg14, Object arg15, Object arg16, Object args) throws Exception{
 298.101 +	return null;
 298.102 +}
 298.103 +
 298.104 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.105 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
 298.106 +                          Object arg14, Object arg15, Object arg16, Object arg17, Object args) throws Exception{
 298.107 +	return null;
 298.108 +}
 298.109 +
 298.110 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.111 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
 298.112 +                          Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object args)
 298.113 +		throws Exception{
 298.114 +	return null;
 298.115 +}
 298.116 +
 298.117 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.118 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
 298.119 +                          Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19,
 298.120 +                          Object args)
 298.121 +		throws Exception{
 298.122 +	return null;
 298.123 +}
 298.124 +
 298.125 +protected Object doInvoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.126 +                          Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13,
 298.127 +                          Object arg14, Object arg15, Object arg16, Object arg17, Object arg18, Object arg19,
 298.128 +                          Object arg20, Object args) throws Exception{
 298.129 +	return null;
 298.130 +}
 298.131 +
 298.132 +
 298.133 +public Object applyTo(ISeq args) throws Exception{
 298.134 +	if(RT.boundedLength(args, getRequiredArity()) <= getRequiredArity())
 298.135 +		{
 298.136 +		return AFn.applyToHelper(this, Util.ret1(args,args = null));
 298.137 +		}
 298.138 +	switch(getRequiredArity())
 298.139 +		{
 298.140 +		case 0:
 298.141 +			return doInvoke(Util.ret1(args,args = null));
 298.142 +		case 1:
 298.143 +			return doInvoke(args.first()
 298.144 +					, Util.ret1(args.next(),args=null));
 298.145 +		case 2:
 298.146 +			return doInvoke(args.first()
 298.147 +					, (args = args.next()).first()
 298.148 +					, Util.ret1(args.next(),args=null));
 298.149 +		case 3:
 298.150 +			return doInvoke(args.first()
 298.151 +					, (args = args.next()).first()
 298.152 +					, (args = args.next()).first()
 298.153 +					, Util.ret1(args.next(),args=null));
 298.154 +		case 4:
 298.155 +			return doInvoke(args.first()
 298.156 +					, (args = args.next()).first()
 298.157 +					, (args = args.next()).first()
 298.158 +					, (args = args.next()).first()
 298.159 +					, Util.ret1(args.next(),args=null));
 298.160 +		case 5:
 298.161 +			return doInvoke(args.first()
 298.162 +					, (args = args.next()).first()
 298.163 +					, (args = args.next()).first()
 298.164 +					, (args = args.next()).first()
 298.165 +					, (args = args.next()).first()
 298.166 +					, Util.ret1(args.next(),args=null));
 298.167 +		case 6:
 298.168 +			return doInvoke(args.first()
 298.169 +					, (args = args.next()).first()
 298.170 +					, (args = args.next()).first()
 298.171 +					, (args = args.next()).first()
 298.172 +					, (args = args.next()).first()
 298.173 +					, (args = args.next()).first()
 298.174 +					, Util.ret1(args.next(),args=null));
 298.175 +		case 7:
 298.176 +			return doInvoke(args.first()
 298.177 +					, (args = args.next()).first()
 298.178 +					, (args = args.next()).first()
 298.179 +					, (args = args.next()).first()
 298.180 +					, (args = args.next()).first()
 298.181 +					, (args = args.next()).first()
 298.182 +					, (args = args.next()).first()
 298.183 +					, Util.ret1(args.next(),args=null));
 298.184 +		case 8:
 298.185 +			return doInvoke(args.first()
 298.186 +					, (args = args.next()).first()
 298.187 +					, (args = args.next()).first()
 298.188 +					, (args = args.next()).first()
 298.189 +					, (args = args.next()).first()
 298.190 +					, (args = args.next()).first()
 298.191 +					, (args = args.next()).first()
 298.192 +					, (args = args.next()).first()
 298.193 +					, Util.ret1(args.next(),args=null));
 298.194 +		case 9:
 298.195 +			return doInvoke(args.first()
 298.196 +					, (args = args.next()).first()
 298.197 +					, (args = args.next()).first()
 298.198 +					, (args = args.next()).first()
 298.199 +					, (args = args.next()).first()
 298.200 +					, (args = args.next()).first()
 298.201 +					, (args = args.next()).first()
 298.202 +					, (args = args.next()).first()
 298.203 +					, (args = args.next()).first()
 298.204 +					, Util.ret1(args.next(),args=null));
 298.205 +		case 10:
 298.206 +			return doInvoke(args.first()
 298.207 +					, (args = args.next()).first()
 298.208 +					, (args = args.next()).first()
 298.209 +					, (args = args.next()).first()
 298.210 +					, (args = args.next()).first()
 298.211 +					, (args = args.next()).first()
 298.212 +					, (args = args.next()).first()
 298.213 +					, (args = args.next()).first()
 298.214 +					, (args = args.next()).first()
 298.215 +					, (args = args.next()).first()
 298.216 +					, Util.ret1(args.next(),args=null));
 298.217 +		case 11:
 298.218 +			return doInvoke(args.first()
 298.219 +					, (args = args.next()).first()
 298.220 +					, (args = args.next()).first()
 298.221 +					, (args = args.next()).first()
 298.222 +					, (args = args.next()).first()
 298.223 +					, (args = args.next()).first()
 298.224 +					, (args = args.next()).first()
 298.225 +					, (args = args.next()).first()
 298.226 +					, (args = args.next()).first()
 298.227 +					, (args = args.next()).first()
 298.228 +					, (args = args.next()).first()
 298.229 +					, Util.ret1(args.next(),args=null));
 298.230 +		case 12:
 298.231 +			return doInvoke(args.first()
 298.232 +					, (args = args.next()).first()
 298.233 +					, (args = args.next()).first()
 298.234 +					, (args = args.next()).first()
 298.235 +					, (args = args.next()).first()
 298.236 +					, (args = args.next()).first()
 298.237 +					, (args = args.next()).first()
 298.238 +					, (args = args.next()).first()
 298.239 +					, (args = args.next()).first()
 298.240 +					, (args = args.next()).first()
 298.241 +					, (args = args.next()).first()
 298.242 +					, (args = args.next()).first()
 298.243 +					, Util.ret1(args.next(),args=null));
 298.244 +		case 13:
 298.245 +			return doInvoke(args.first()
 298.246 +					, (args = args.next()).first()
 298.247 +					, (args = args.next()).first()
 298.248 +					, (args = args.next()).first()
 298.249 +					, (args = args.next()).first()
 298.250 +					, (args = args.next()).first()
 298.251 +					, (args = args.next()).first()
 298.252 +					, (args = args.next()).first()
 298.253 +					, (args = args.next()).first()
 298.254 +					, (args = args.next()).first()
 298.255 +					, (args = args.next()).first()
 298.256 +					, (args = args.next()).first()
 298.257 +					, (args = args.next()).first()
 298.258 +					, Util.ret1(args.next(),args=null));
 298.259 +		case 14:
 298.260 +			return doInvoke(args.first()
 298.261 +					, (args = args.next()).first()
 298.262 +					, (args = args.next()).first()
 298.263 +					, (args = args.next()).first()
 298.264 +					, (args = args.next()).first()
 298.265 +					, (args = args.next()).first()
 298.266 +					, (args = args.next()).first()
 298.267 +					, (args = args.next()).first()
 298.268 +					, (args = args.next()).first()
 298.269 +					, (args = args.next()).first()
 298.270 +					, (args = args.next()).first()
 298.271 +					, (args = args.next()).first()
 298.272 +					, (args = args.next()).first()
 298.273 +					, (args = args.next()).first()
 298.274 +					, Util.ret1(args.next(),args=null));
 298.275 +		case 15:
 298.276 +			return doInvoke(args.first()
 298.277 +					, (args = args.next()).first()
 298.278 +					, (args = args.next()).first()
 298.279 +					, (args = args.next()).first()
 298.280 +					, (args = args.next()).first()
 298.281 +					, (args = args.next()).first()
 298.282 +					, (args = args.next()).first()
 298.283 +					, (args = args.next()).first()
 298.284 +					, (args = args.next()).first()
 298.285 +					, (args = args.next()).first()
 298.286 +					, (args = args.next()).first()
 298.287 +					, (args = args.next()).first()
 298.288 +					, (args = args.next()).first()
 298.289 +					, (args = args.next()).first()
 298.290 +					, (args = args.next()).first()
 298.291 +					, Util.ret1(args.next(),args=null));
 298.292 +		case 16:
 298.293 +			return doInvoke(args.first()
 298.294 +					, (args = args.next()).first()
 298.295 +					, (args = args.next()).first()
 298.296 +					, (args = args.next()).first()
 298.297 +					, (args = args.next()).first()
 298.298 +					, (args = args.next()).first()
 298.299 +					, (args = args.next()).first()
 298.300 +					, (args = args.next()).first()
 298.301 +					, (args = args.next()).first()
 298.302 +					, (args = args.next()).first()
 298.303 +					, (args = args.next()).first()
 298.304 +					, (args = args.next()).first()
 298.305 +					, (args = args.next()).first()
 298.306 +					, (args = args.next()).first()
 298.307 +					, (args = args.next()).first()
 298.308 +					, (args = args.next()).first()
 298.309 +					, Util.ret1(args.next(),args=null));
 298.310 +		case 17:
 298.311 +			return doInvoke(args.first()
 298.312 +					, (args = args.next()).first()
 298.313 +					, (args = args.next()).first()
 298.314 +					, (args = args.next()).first()
 298.315 +					, (args = args.next()).first()
 298.316 +					, (args = args.next()).first()
 298.317 +					, (args = args.next()).first()
 298.318 +					, (args = args.next()).first()
 298.319 +					, (args = args.next()).first()
 298.320 +					, (args = args.next()).first()
 298.321 +					, (args = args.next()).first()
 298.322 +					, (args = args.next()).first()
 298.323 +					, (args = args.next()).first()
 298.324 +					, (args = args.next()).first()
 298.325 +					, (args = args.next()).first()
 298.326 +					, (args = args.next()).first()
 298.327 +					, (args = args.next()).first()
 298.328 +					, Util.ret1(args.next(),args=null));
 298.329 +		case 18:
 298.330 +			return doInvoke(args.first()
 298.331 +					, (args = args.next()).first()
 298.332 +					, (args = args.next()).first()
 298.333 +					, (args = args.next()).first()
 298.334 +					, (args = args.next()).first()
 298.335 +					, (args = args.next()).first()
 298.336 +					, (args = args.next()).first()
 298.337 +					, (args = args.next()).first()
 298.338 +					, (args = args.next()).first()
 298.339 +					, (args = args.next()).first()
 298.340 +					, (args = args.next()).first()
 298.341 +					, (args = args.next()).first()
 298.342 +					, (args = args.next()).first()
 298.343 +					, (args = args.next()).first()
 298.344 +					, (args = args.next()).first()
 298.345 +					, (args = args.next()).first()
 298.346 +					, (args = args.next()).first()
 298.347 +					, (args = args.next()).first()
 298.348 +					, Util.ret1(args.next(),args=null));
 298.349 +		case 19:
 298.350 +			return doInvoke(args.first()
 298.351 +					, (args = args.next()).first()
 298.352 +					, (args = args.next()).first()
 298.353 +					, (args = args.next()).first()
 298.354 +					, (args = args.next()).first()
 298.355 +					, (args = args.next()).first()
 298.356 +					, (args = args.next()).first()
 298.357 +					, (args = args.next()).first()
 298.358 +					, (args = args.next()).first()
 298.359 +					, (args = args.next()).first()
 298.360 +					, (args = args.next()).first()
 298.361 +					, (args = args.next()).first()
 298.362 +					, (args = args.next()).first()
 298.363 +					, (args = args.next()).first()
 298.364 +					, (args = args.next()).first()
 298.365 +					, (args = args.next()).first()
 298.366 +					, (args = args.next()).first()
 298.367 +					, (args = args.next()).first()
 298.368 +					, (args = args.next()).first()
 298.369 +					, Util.ret1(args.next(),args=null));
 298.370 +		case 20:
 298.371 +			return doInvoke(args.first()
 298.372 +					, (args = args.next()).first()
 298.373 +					, (args = args.next()).first()
 298.374 +					, (args = args.next()).first()
 298.375 +					, (args = args.next()).first()
 298.376 +					, (args = args.next()).first()
 298.377 +					, (args = args.next()).first()
 298.378 +					, (args = args.next()).first()
 298.379 +					, (args = args.next()).first()
 298.380 +					, (args = args.next()).first()
 298.381 +					, (args = args.next()).first()
 298.382 +					, (args = args.next()).first()
 298.383 +					, (args = args.next()).first()
 298.384 +					, (args = args.next()).first()
 298.385 +					, (args = args.next()).first()
 298.386 +					, (args = args.next()).first()
 298.387 +					, (args = args.next()).first()
 298.388 +					, (args = args.next()).first()
 298.389 +					, (args = args.next()).first()
 298.390 +					, (args = args.next()).first()
 298.391 +					, Util.ret1(args.next(),args=null));
 298.392 +
 298.393 +		}
 298.394 +	return throwArity(-1);
 298.395 +}
 298.396 +
 298.397 +public Object invoke() throws Exception{
 298.398 +	switch(getRequiredArity())
 298.399 +		{
 298.400 +		case 0:
 298.401 +			return doInvoke(null);
 298.402 +		default:
 298.403 +			return throwArity(0);
 298.404 +		}
 298.405 +
 298.406 +}
 298.407 +
 298.408 +public Object invoke(Object arg1) throws Exception{
 298.409 +	switch(getRequiredArity())
 298.410 +		{
 298.411 +		case 0:
 298.412 +			return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null)));
 298.413 +		case 1:
 298.414 +			return doInvoke(Util.ret1(arg1, arg1 = null), null);
 298.415 +		default:
 298.416 +			return throwArity(1);
 298.417 +		}
 298.418 +
 298.419 +}
 298.420 +
 298.421 +public Object invoke(Object arg1, Object arg2) throws Exception{
 298.422 +	switch(getRequiredArity())
 298.423 +		{
 298.424 +		case 0:
 298.425 +			return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null)));
 298.426 +		case 1:
 298.427 +			return doInvoke(Util.ret1(arg1, arg1 = null), ArraySeq.create(Util.ret1(arg2, arg2 = null)));
 298.428 +		case 2:
 298.429 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), null);
 298.430 +		default:
 298.431 +			return throwArity(2);
 298.432 +		}
 298.433 +
 298.434 +}
 298.435 +
 298.436 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{
 298.437 +	switch(getRequiredArity())
 298.438 +		{
 298.439 +		case 0:
 298.440 +			return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.441 +			                                Util.ret1(arg3, arg3 = null)));
 298.442 +		case 1:
 298.443 +			return doInvoke(Util.ret1(arg1, arg1 = null),
 298.444 +			                ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null)));
 298.445 +		case 2:
 298.446 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.447 +			                ArraySeq.create(Util.ret1(arg3, arg3 = null)));
 298.448 +		case 3:
 298.449 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.450 +			                null);
 298.451 +		default:
 298.452 +			return throwArity(3);
 298.453 +		}
 298.454 +
 298.455 +}
 298.456 +
 298.457 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{
 298.458 +	switch(getRequiredArity())
 298.459 +		{
 298.460 +		case 0:
 298.461 +			return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.462 +			                                Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null)));
 298.463 +		case 1:
 298.464 +			return doInvoke(Util.ret1(arg1, arg1 = null),
 298.465 +			                ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.466 +			                                Util.ret1(arg4, arg4 = null)));
 298.467 +		case 2:
 298.468 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.469 +			                ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null)));
 298.470 +		case 3:
 298.471 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.472 +			                ArraySeq.create(Util.ret1(arg4, arg4 = null)));
 298.473 +		case 4:
 298.474 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.475 +			                Util.ret1(arg4, arg4 = null), null);
 298.476 +		default:
 298.477 +			return throwArity(4);
 298.478 +		}
 298.479 +
 298.480 +}
 298.481 +
 298.482 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{
 298.483 +	switch(getRequiredArity())
 298.484 +		{
 298.485 +		case 0:
 298.486 +			return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.487 +			                                Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null),
 298.488 +			                                Util.ret1(arg5, arg5 = null)));
 298.489 +		case 1:
 298.490 +			return doInvoke(Util.ret1(arg1, arg1 = null),
 298.491 +			                ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.492 +			                                Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null)));
 298.493 +		case 2:
 298.494 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.495 +			                ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null),
 298.496 +			                                Util.ret1(arg5, arg5 = null)));
 298.497 +		case 3:
 298.498 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.499 +			                ArraySeq.create(Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null)));
 298.500 +		case 4:
 298.501 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.502 +			                Util.ret1(arg4, arg4 = null), ArraySeq.create(Util.ret1(arg5, arg5 = null)));
 298.503 +		case 5:
 298.504 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.505 +			                Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), null);
 298.506 +		default:
 298.507 +			return throwArity(5);
 298.508 +		}
 298.509 +
 298.510 +}
 298.511 +
 298.512 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{
 298.513 +	switch(getRequiredArity())
 298.514 +		{
 298.515 +		case 0:
 298.516 +			return doInvoke(ArraySeq.create(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.517 +			                                Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null),
 298.518 +			                                Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null)));
 298.519 +		case 1:
 298.520 +			return doInvoke(Util.ret1(arg1, arg1 = null),
 298.521 +			                ArraySeq.create(Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.522 +			                                Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null),
 298.523 +			                                Util.ret1(arg6, arg6 = null)));
 298.524 +		case 2:
 298.525 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null),
 298.526 +			                ArraySeq.create(Util.ret1(arg3, arg3 = null), Util.ret1(arg4, arg4 = null),
 298.527 +			                                Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null)));
 298.528 +		case 3:
 298.529 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.530 +			                ArraySeq.create(Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null),
 298.531 +			                                Util.ret1(arg6, arg6 = null)));
 298.532 +		case 4:
 298.533 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.534 +			                Util.ret1(arg4, arg4 = null),
 298.535 +			                ArraySeq.create(Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null)));
 298.536 +		case 5:
 298.537 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.538 +			                Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null),
 298.539 +			                ArraySeq.create(Util.ret1(arg6, arg6 = null)));
 298.540 +		case 6:
 298.541 +			return doInvoke(Util.ret1(arg1, arg1 = null), Util.ret1(arg2, arg2 = null), Util.ret1(arg3, arg3 = null),
 298.542 +			                Util.ret1(arg4, arg4 = null), Util.ret1(arg5, arg5 = null), Util.ret1(arg6, arg6 = null),
 298.543 +			                null);
 298.544 +		default:
 298.545 +			return throwArity(6);
 298.546 +		}
 298.547 +
 298.548 +}
 298.549 +
 298.550 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
 298.551 +		throws Exception{
 298.552 +	switch(getRequiredArity())
 298.553 +		{
 298.554 +		case 0:
 298.555 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7));
 298.556 +		case 1:
 298.557 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7));
 298.558 +		case 2:
 298.559 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7));
 298.560 +		case 3:
 298.561 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7));
 298.562 +		case 4:
 298.563 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7));
 298.564 +		case 5:
 298.565 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7));
 298.566 +		case 6:
 298.567 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7));
 298.568 +		case 7:
 298.569 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, null);
 298.570 +		default:
 298.571 +			return throwArity(7);
 298.572 +		}
 298.573 +
 298.574 +}
 298.575 +
 298.576 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.577 +                     Object arg8) throws Exception{
 298.578 +	switch(getRequiredArity())
 298.579 +		{
 298.580 +		case 0:
 298.581 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8));
 298.582 +		case 1:
 298.583 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8));
 298.584 +		case 2:
 298.585 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8));
 298.586 +		case 3:
 298.587 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8));
 298.588 +		case 4:
 298.589 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8));
 298.590 +		case 5:
 298.591 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8));
 298.592 +		case 6:
 298.593 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8));
 298.594 +		case 7:
 298.595 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8));
 298.596 +		case 8:
 298.597 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, null);
 298.598 +		default:
 298.599 +			return throwArity(8);
 298.600 +		}
 298.601 +
 298.602 +}
 298.603 +
 298.604 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.605 +                     Object arg8, Object arg9) throws Exception{
 298.606 +	switch(getRequiredArity())
 298.607 +		{
 298.608 +		case 0:
 298.609 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9));
 298.610 +		case 1:
 298.611 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9));
 298.612 +		case 2:
 298.613 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9));
 298.614 +		case 3:
 298.615 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9));
 298.616 +		case 4:
 298.617 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9));
 298.618 +		case 5:
 298.619 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9));
 298.620 +		case 6:
 298.621 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9));
 298.622 +		case 7:
 298.623 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9));
 298.624 +		case 8:
 298.625 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9));
 298.626 +		case 9:
 298.627 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, null);
 298.628 +		default:
 298.629 +			return throwArity(9);
 298.630 +		}
 298.631 +
 298.632 +}
 298.633 +
 298.634 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.635 +                     Object arg8, Object arg9, Object arg10) throws Exception{
 298.636 +	switch(getRequiredArity())
 298.637 +		{
 298.638 +		case 0:
 298.639 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10));
 298.640 +		case 1:
 298.641 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10));
 298.642 +		case 2:
 298.643 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10));
 298.644 +		case 3:
 298.645 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10));
 298.646 +		case 4:
 298.647 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10));
 298.648 +		case 5:
 298.649 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10));
 298.650 +		case 6:
 298.651 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10));
 298.652 +		case 7:
 298.653 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10));
 298.654 +		case 8:
 298.655 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10));
 298.656 +		case 9:
 298.657 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10));
 298.658 +		case 10:
 298.659 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, null);
 298.660 +		default:
 298.661 +			return throwArity(10);
 298.662 +		}
 298.663 +
 298.664 +}
 298.665 +
 298.666 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.667 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{
 298.668 +	switch(getRequiredArity())
 298.669 +		{
 298.670 +		case 0:
 298.671 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11));
 298.672 +		case 1:
 298.673 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11));
 298.674 +		case 2:
 298.675 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11));
 298.676 +		case 3:
 298.677 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11));
 298.678 +		case 4:
 298.679 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11));
 298.680 +		case 5:
 298.681 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11));
 298.682 +		case 6:
 298.683 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11));
 298.684 +		case 7:
 298.685 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11));
 298.686 +		case 8:
 298.687 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11));
 298.688 +		case 9:
 298.689 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10, arg11));
 298.690 +		case 10:
 298.691 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, ArraySeq.create(arg11));
 298.692 +		case 11:
 298.693 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, null);
 298.694 +		default:
 298.695 +			return throwArity(11);
 298.696 +		}
 298.697 +
 298.698 +}
 298.699 +
 298.700 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.701 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{
 298.702 +	switch(getRequiredArity())
 298.703 +		{
 298.704 +		case 0:
 298.705 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12));
 298.706 +		case 1:
 298.707 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12));
 298.708 +		case 2:
 298.709 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12));
 298.710 +		case 3:
 298.711 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12));
 298.712 +		case 4:
 298.713 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12));
 298.714 +		case 5:
 298.715 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12));
 298.716 +		case 6:
 298.717 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12));
 298.718 +		case 7:
 298.719 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11, arg12));
 298.720 +		case 8:
 298.721 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11, arg12));
 298.722 +		case 9:
 298.723 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10, arg11, arg12));
 298.724 +		case 10:
 298.725 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, ArraySeq.create(arg11, arg12));
 298.726 +		case 11:
 298.727 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, ArraySeq.create(arg12));
 298.728 +		case 12:
 298.729 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, null);
 298.730 +		default:
 298.731 +			return throwArity(12);
 298.732 +		}
 298.733 +
 298.734 +}
 298.735 +
 298.736 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.737 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13)
 298.738 +		throws Exception{
 298.739 +	switch(getRequiredArity())
 298.740 +		{
 298.741 +		case 0:
 298.742 +			return doInvoke(
 298.743 +					ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13));
 298.744 +		case 1:
 298.745 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.746 +			                                      arg13));
 298.747 +		case 2:
 298.748 +			return doInvoke(arg1, arg2,
 298.749 +			                ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13));
 298.750 +		case 3:
 298.751 +			return doInvoke(arg1, arg2, arg3,
 298.752 +			                ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13));
 298.753 +		case 4:
 298.754 +			return doInvoke(arg1, arg2, arg3, arg4,
 298.755 +			                ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13));
 298.756 +		case 5:
 298.757 +			return doInvoke(arg1, arg2, arg3, arg4, arg5,
 298.758 +			                ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13));
 298.759 +		case 6:
 298.760 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6,
 298.761 +			                ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13));
 298.762 +		case 7:
 298.763 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 298.764 +			                ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13));
 298.765 +		case 8:
 298.766 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8,
 298.767 +			                ArraySeq.create(arg9, arg10, arg11, arg12, arg13));
 298.768 +		case 9:
 298.769 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
 298.770 +			                ArraySeq.create(arg10, arg11, arg12, arg13));
 298.771 +		case 10:
 298.772 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
 298.773 +			                ArraySeq.create(arg11, arg12, arg13));
 298.774 +		case 11:
 298.775 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
 298.776 +			                ArraySeq.create(arg12, arg13));
 298.777 +		case 12:
 298.778 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.779 +			                ArraySeq.create(arg13));
 298.780 +		case 13:
 298.781 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, null);
 298.782 +		default:
 298.783 +			return throwArity(13);
 298.784 +		}
 298.785 +
 298.786 +}
 298.787 +
 298.788 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.789 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
 298.790 +		throws Exception{
 298.791 +	switch(getRequiredArity())
 298.792 +		{
 298.793 +		case 0:
 298.794 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.795 +			                                arg13, arg14));
 298.796 +		case 1:
 298.797 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.798 +			                                      arg13, arg14));
 298.799 +		case 2:
 298.800 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.801 +			                                            arg13, arg14));
 298.802 +		case 3:
 298.803 +			return doInvoke(arg1, arg2, arg3,
 298.804 +			                ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14));
 298.805 +		case 4:
 298.806 +			return doInvoke(arg1, arg2, arg3, arg4,
 298.807 +			                ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14));
 298.808 +		case 5:
 298.809 +			return doInvoke(arg1, arg2, arg3, arg4, arg5,
 298.810 +			                ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14));
 298.811 +		case 6:
 298.812 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6,
 298.813 +			                ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14));
 298.814 +		case 7:
 298.815 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 298.816 +			                ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14));
 298.817 +		case 8:
 298.818 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8,
 298.819 +			                ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14));
 298.820 +		case 9:
 298.821 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
 298.822 +			                ArraySeq.create(arg10, arg11, arg12, arg13, arg14));
 298.823 +		case 10:
 298.824 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
 298.825 +			                ArraySeq.create(arg11, arg12, arg13, arg14));
 298.826 +		case 11:
 298.827 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
 298.828 +			                ArraySeq.create(arg12, arg13, arg14));
 298.829 +		case 12:
 298.830 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.831 +			                ArraySeq.create(arg13, arg14));
 298.832 +		case 13:
 298.833 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
 298.834 +			                ArraySeq.create(arg14));
 298.835 +		case 14:
 298.836 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 298.837 +			                null);
 298.838 +		default:
 298.839 +			return throwArity(14);
 298.840 +		}
 298.841 +
 298.842 +}
 298.843 +
 298.844 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.845 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 298.846 +                     Object arg15) throws Exception{
 298.847 +	switch(getRequiredArity())
 298.848 +		{
 298.849 +		case 0:
 298.850 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.851 +			                                arg13, arg14, arg15));
 298.852 +		case 1:
 298.853 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.854 +			                                      arg13, arg14, arg15));
 298.855 +		case 2:
 298.856 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.857 +			                                            arg13, arg14, arg15));
 298.858 +		case 3:
 298.859 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.860 +			                                                  arg13, arg14, arg15));
 298.861 +		case 4:
 298.862 +			return doInvoke(arg1, arg2, arg3, arg4,
 298.863 +			                ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15));
 298.864 +		case 5:
 298.865 +			return doInvoke(arg1, arg2, arg3, arg4, arg5,
 298.866 +			                ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15));
 298.867 +		case 6:
 298.868 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6,
 298.869 +			                ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15));
 298.870 +		case 7:
 298.871 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 298.872 +			                ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15));
 298.873 +		case 8:
 298.874 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8,
 298.875 +			                ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15));
 298.876 +		case 9:
 298.877 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
 298.878 +			                ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15));
 298.879 +		case 10:
 298.880 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
 298.881 +			                ArraySeq.create(arg11, arg12, arg13, arg14, arg15));
 298.882 +		case 11:
 298.883 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
 298.884 +			                ArraySeq.create(arg12, arg13, arg14, arg15));
 298.885 +		case 12:
 298.886 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.887 +			                ArraySeq.create(arg13, arg14, arg15));
 298.888 +		case 13:
 298.889 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
 298.890 +			                ArraySeq.create(arg14, arg15));
 298.891 +		case 14:
 298.892 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 298.893 +			                ArraySeq.create(arg15));
 298.894 +		case 15:
 298.895 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 298.896 +			                arg15, null);
 298.897 +		default:
 298.898 +			return throwArity(15);
 298.899 +		}
 298.900 +
 298.901 +}
 298.902 +
 298.903 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.904 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 298.905 +                     Object arg15, Object arg16) throws Exception{
 298.906 +	switch(getRequiredArity())
 298.907 +		{
 298.908 +		case 0:
 298.909 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.910 +			                                arg13, arg14, arg15, arg16));
 298.911 +		case 1:
 298.912 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.913 +			                                      arg13, arg14, arg15, arg16));
 298.914 +		case 2:
 298.915 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.916 +			                                            arg13, arg14, arg15, arg16));
 298.917 +		case 3:
 298.918 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.919 +			                                                  arg13, arg14, arg15, arg16));
 298.920 +		case 4:
 298.921 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.922 +			                                                        arg13, arg14, arg15, arg16));
 298.923 +		case 5:
 298.924 +			return doInvoke(arg1, arg2, arg3, arg4, arg5,
 298.925 +			                ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16));
 298.926 +		case 6:
 298.927 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6,
 298.928 +			                ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16));
 298.929 +		case 7:
 298.930 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 298.931 +			                ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16));
 298.932 +		case 8:
 298.933 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8,
 298.934 +			                ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16));
 298.935 +		case 9:
 298.936 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
 298.937 +			                ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16));
 298.938 +		case 10:
 298.939 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
 298.940 +			                ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16));
 298.941 +		case 11:
 298.942 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
 298.943 +			                ArraySeq.create(arg12, arg13, arg14, arg15, arg16));
 298.944 +		case 12:
 298.945 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.946 +			                ArraySeq.create(arg13, arg14, arg15, arg16));
 298.947 +		case 13:
 298.948 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
 298.949 +			                ArraySeq.create(arg14, arg15, arg16));
 298.950 +		case 14:
 298.951 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 298.952 +			                ArraySeq.create(arg15, arg16));
 298.953 +		case 15:
 298.954 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 298.955 +			                arg15, ArraySeq.create(arg16));
 298.956 +		case 16:
 298.957 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
 298.958 +			                arg15, arg16, null);
 298.959 +		default:
 298.960 +			return throwArity(16);
 298.961 +		}
 298.962 +
 298.963 +}
 298.964 +
 298.965 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 298.966 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 298.967 +                     Object arg15, Object arg16, Object arg17) throws Exception{
 298.968 +	switch(getRequiredArity())
 298.969 +		{
 298.970 +		case 0:
 298.971 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.972 +			                                arg13, arg14, arg15, arg16, arg17));
 298.973 +		case 1:
 298.974 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.975 +			                                      arg13, arg14, arg15, arg16, arg17));
 298.976 +		case 2:
 298.977 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.978 +			                                            arg13, arg14, arg15, arg16, arg17));
 298.979 +		case 3:
 298.980 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.981 +			                                                  arg13, arg14, arg15, arg16, arg17));
 298.982 +		case 4:
 298.983 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.984 +			                                                        arg13, arg14, arg15, arg16, arg17));
 298.985 +		case 5:
 298.986 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12,
 298.987 +			                                                              arg13, arg14, arg15, arg16, arg17));
 298.988 +		case 6:
 298.989 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6,
 298.990 +			                ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17));
 298.991 +		case 7:
 298.992 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 298.993 +			                ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17));
 298.994 +		case 8:
 298.995 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8,
 298.996 +			                ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17));
 298.997 +		case 9:
 298.998 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
 298.999 +			                ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17));
298.1000 +		case 10:
298.1001 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
298.1002 +			                ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17));
298.1003 +		case 11:
298.1004 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1005 +			                ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17));
298.1006 +		case 12:
298.1007 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1008 +			                ArraySeq.create(arg13, arg14, arg15, arg16, arg17));
298.1009 +		case 13:
298.1010 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
298.1011 +			                ArraySeq.create(arg14, arg15, arg16, arg17));
298.1012 +		case 14:
298.1013 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1014 +			                ArraySeq.create(arg15, arg16, arg17));
298.1015 +		case 15:
298.1016 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1017 +			                arg15, ArraySeq.create(arg16, arg17));
298.1018 +		case 16:
298.1019 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1020 +			                arg15, arg16, ArraySeq.create(arg17));
298.1021 +		case 17:
298.1022 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1023 +			                arg15, arg16, arg17, null);
298.1024 +		default:
298.1025 +			return throwArity(17);
298.1026 +		}
298.1027 +
298.1028 +}
298.1029 +
298.1030 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
298.1031 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
298.1032 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{
298.1033 +	switch(getRequiredArity())
298.1034 +		{
298.1035 +		case 0:
298.1036 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1037 +			                                arg13, arg14, arg15, arg16, arg17, arg18));
298.1038 +		case 1:
298.1039 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1040 +			                                      arg13, arg14, arg15, arg16, arg17, arg18));
298.1041 +		case 2:
298.1042 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1043 +			                                            arg13, arg14, arg15, arg16, arg17, arg18));
298.1044 +		case 3:
298.1045 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1046 +			                                                  arg13, arg14, arg15, arg16, arg17, arg18));
298.1047 +		case 4:
298.1048 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1049 +			                                                        arg13, arg14, arg15, arg16, arg17, arg18));
298.1050 +		case 5:
298.1051 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1052 +			                                                              arg13, arg14, arg15, arg16, arg17, arg18));
298.1053 +		case 6:
298.1054 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12,
298.1055 +			                                                                    arg13, arg14, arg15, arg16, arg17,
298.1056 +			                                                                    arg18));
298.1057 +		case 7:
298.1058 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7,
298.1059 +			                ArraySeq.create(arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18));
298.1060 +		case 8:
298.1061 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8,
298.1062 +			                ArraySeq.create(arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18));
298.1063 +		case 9:
298.1064 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
298.1065 +			                ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18));
298.1066 +		case 10:
298.1067 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
298.1068 +			                ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18));
298.1069 +		case 11:
298.1070 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1071 +			                ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17, arg18));
298.1072 +		case 12:
298.1073 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1074 +			                ArraySeq.create(arg13, arg14, arg15, arg16, arg17, arg18));
298.1075 +		case 13:
298.1076 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
298.1077 +			                ArraySeq.create(arg14, arg15, arg16, arg17, arg18));
298.1078 +		case 14:
298.1079 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1080 +			                ArraySeq.create(arg15, arg16, arg17, arg18));
298.1081 +		case 15:
298.1082 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1083 +			                arg15, ArraySeq.create(arg16, arg17, arg18));
298.1084 +		case 16:
298.1085 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1086 +			                arg15, arg16, ArraySeq.create(arg17, arg18));
298.1087 +		case 17:
298.1088 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1089 +			                arg15, arg16, arg17, ArraySeq.create(arg18));
298.1090 +		case 18:
298.1091 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1092 +			                arg15, arg16, arg17, arg18, null);
298.1093 +		default:
298.1094 +			return throwArity(18);
298.1095 +		}
298.1096 +
298.1097 +}
298.1098 +
298.1099 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
298.1100 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
298.1101 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{
298.1102 +	switch(getRequiredArity())
298.1103 +		{
298.1104 +		case 0:
298.1105 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1106 +			                                arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1107 +		case 1:
298.1108 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1109 +			                                      arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1110 +		case 2:
298.1111 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1112 +			                                            arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1113 +		case 3:
298.1114 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1115 +			                                                  arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1116 +		case 4:
298.1117 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1118 +			                                                        arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1119 +		case 5:
298.1120 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1121 +			                                                              arg13, arg14, arg15, arg16, arg17, arg18,
298.1122 +			                                                              arg19));
298.1123 +		case 6:
298.1124 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12,
298.1125 +			                                                                    arg13, arg14, arg15, arg16, arg17,
298.1126 +			                                                                    arg18, arg19));
298.1127 +		case 7:
298.1128 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11, arg12,
298.1129 +			                                                                          arg13, arg14, arg15, arg16, arg17,
298.1130 +			                                                                          arg18, arg19));
298.1131 +		case 8:
298.1132 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11, arg12,
298.1133 +			                                                                                arg13, arg14, arg15, arg16,
298.1134 +			                                                                                arg17, arg18, arg19));
298.1135 +		case 9:
298.1136 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9,
298.1137 +			                ArraySeq.create(arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1138 +		case 10:
298.1139 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
298.1140 +			                ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1141 +		case 11:
298.1142 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1143 +			                ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1144 +		case 12:
298.1145 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1146 +			                ArraySeq.create(arg13, arg14, arg15, arg16, arg17, arg18, arg19));
298.1147 +		case 13:
298.1148 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
298.1149 +			                ArraySeq.create(arg14, arg15, arg16, arg17, arg18, arg19));
298.1150 +		case 14:
298.1151 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1152 +			                ArraySeq.create(arg15, arg16, arg17, arg18, arg19));
298.1153 +		case 15:
298.1154 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1155 +			                arg15, ArraySeq.create(arg16, arg17, arg18, arg19));
298.1156 +		case 16:
298.1157 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1158 +			                arg15, arg16, ArraySeq.create(arg17, arg18, arg19));
298.1159 +		case 17:
298.1160 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1161 +			                arg15, arg16, arg17, ArraySeq.create(arg18, arg19));
298.1162 +		case 18:
298.1163 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1164 +			                arg15, arg16, arg17, arg18, ArraySeq.create(arg19));
298.1165 +		case 19:
298.1166 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1167 +			                arg15, arg16, arg17, arg18, arg19, null);
298.1168 +		default:
298.1169 +			return throwArity(19);
298.1170 +		}
298.1171 +
298.1172 +}
298.1173 +
298.1174 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
298.1175 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
298.1176 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
298.1177 +		throws Exception{
298.1178 +	switch(getRequiredArity())
298.1179 +		{
298.1180 +		case 0:
298.1181 +			return doInvoke(ArraySeq.create(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1182 +			                                arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1183 +		case 1:
298.1184 +			return doInvoke(arg1, ArraySeq.create(arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1185 +			                                      arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1186 +		case 2:
298.1187 +			return doInvoke(arg1, arg2, ArraySeq.create(arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1188 +			                                            arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1189 +		case 3:
298.1190 +			return doInvoke(arg1, arg2, arg3, ArraySeq.create(arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1191 +			                                                  arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1192 +		case 4:
298.1193 +			return doInvoke(arg1, arg2, arg3, arg4, ArraySeq.create(arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1194 +			                                                        arg13, arg14, arg15, arg16, arg17, arg18, arg19,
298.1195 +			                                                        arg20));
298.1196 +		case 5:
298.1197 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ArraySeq.create(arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1198 +			                                                              arg13, arg14, arg15, arg16, arg17, arg18,
298.1199 +			                                                              arg19, arg20));
298.1200 +		case 6:
298.1201 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ArraySeq.create(arg7, arg8, arg9, arg10, arg11, arg12,
298.1202 +			                                                                    arg13, arg14, arg15, arg16, arg17,
298.1203 +			                                                                    arg18, arg19, arg20));
298.1204 +		case 7:
298.1205 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ArraySeq.create(arg8, arg9, arg10, arg11, arg12,
298.1206 +			                                                                          arg13, arg14, arg15, arg16, arg17,
298.1207 +			                                                                          arg18, arg19, arg20));
298.1208 +		case 8:
298.1209 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ArraySeq.create(arg9, arg10, arg11, arg12,
298.1210 +			                                                                                arg13, arg14, arg15, arg16,
298.1211 +			                                                                                arg17, arg18, arg19,
298.1212 +			                                                                                arg20));
298.1213 +		case 9:
298.1214 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ArraySeq.create(arg10, arg11, arg12,
298.1215 +			                                                                                      arg13, arg14, arg15,
298.1216 +			                                                                                      arg16, arg17, arg18,
298.1217 +			                                                                                      arg19, arg20));
298.1218 +		case 10:
298.1219 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10,
298.1220 +			                ArraySeq.create(arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1221 +		case 11:
298.1222 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1223 +			                ArraySeq.create(arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1224 +		case 12:
298.1225 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1226 +			                ArraySeq.create(arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1227 +		case 13:
298.1228 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
298.1229 +			                ArraySeq.create(arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1230 +		case 14:
298.1231 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1232 +			                ArraySeq.create(arg15, arg16, arg17, arg18, arg19, arg20));
298.1233 +		case 15:
298.1234 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1235 +			                arg15, ArraySeq.create(arg16, arg17, arg18, arg19, arg20));
298.1236 +		case 16:
298.1237 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1238 +			                arg15, arg16, ArraySeq.create(arg17, arg18, arg19, arg20));
298.1239 +		case 17:
298.1240 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1241 +			                arg15, arg16, arg17, ArraySeq.create(arg18, arg19, arg20));
298.1242 +		case 18:
298.1243 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1244 +			                arg15, arg16, arg17, arg18, ArraySeq.create(arg19, arg20));
298.1245 +		case 19:
298.1246 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1247 +			                arg15, arg16, arg17, arg18, arg19, ArraySeq.create(arg20));
298.1248 +		case 20:
298.1249 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1250 +			                arg15, arg16, arg17, arg18, arg19, arg20, null);
298.1251 +		default:
298.1252 +			return throwArity(20);
298.1253 +		}
298.1254 +
298.1255 +}
298.1256 +
298.1257 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
298.1258 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
298.1259 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, Object... args)
298.1260 +		throws Exception{
298.1261 +	switch(getRequiredArity())
298.1262 +		{
298.1263 +		case 0:
298.1264 +			return doInvoke(ontoArrayPrepend(args, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1265 +			                                 arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1266 +		case 1:
298.1267 +			return doInvoke(arg1, ontoArrayPrepend(args, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1268 +			                                       arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1269 +		case 2:
298.1270 +			return doInvoke(arg1, arg2, ontoArrayPrepend(args, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1271 +			                                             arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19,
298.1272 +			                                             arg20));
298.1273 +		case 3:
298.1274 +			return doInvoke(arg1, arg2, arg3, ontoArrayPrepend(args, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1275 +			                                                   arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19,
298.1276 +			                                                   arg20));
298.1277 +		case 4:
298.1278 +			return doInvoke(arg1, arg2, arg3, arg4, ontoArrayPrepend(args, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1279 +			                                                         arg12, arg13, arg14, arg15, arg16, arg17, arg18,
298.1280 +			                                                         arg19, arg20));
298.1281 +		case 5:
298.1282 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, ontoArrayPrepend(args, arg6, arg7, arg8, arg9, arg10, arg11,
298.1283 +			                                                               arg12, arg13, arg14, arg15, arg16, arg17,
298.1284 +			                                                               arg18, arg19, arg20));
298.1285 +		case 6:
298.1286 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, ontoArrayPrepend(args, arg7, arg8, arg9, arg10, arg11,
298.1287 +			                                                                     arg12, arg13, arg14, arg15, arg16,
298.1288 +			                                                                     arg17, arg18, arg19, arg20));
298.1289 +		case 7:
298.1290 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, ontoArrayPrepend(args, arg8, arg9, arg10, arg11,
298.1291 +			                                                                           arg12, arg13, arg14, arg15,
298.1292 +			                                                                           arg16, arg17, arg18, arg19,
298.1293 +			                                                                           arg20));
298.1294 +		case 8:
298.1295 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, ontoArrayPrepend(args, arg9, arg10, arg11,
298.1296 +			                                                                                 arg12, arg13, arg14, arg15,
298.1297 +			                                                                                 arg16, arg17, arg18, arg19,
298.1298 +			                                                                                 arg20));
298.1299 +		case 9:
298.1300 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, ontoArrayPrepend(args, arg10, arg11,
298.1301 +			                                                                                       arg12, arg13, arg14,
298.1302 +			                                                                                       arg15, arg16, arg17,
298.1303 +			                                                                                       arg18, arg19,
298.1304 +			                                                                                       arg20));
298.1305 +		case 10:
298.1306 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, ontoArrayPrepend(args, arg11,
298.1307 +			                                                                                              arg12, arg13,
298.1308 +			                                                                                              arg14, arg15,
298.1309 +			                                                                                              arg16, arg17,
298.1310 +			                                                                                              arg18, arg19,
298.1311 +			                                                                                              arg20));
298.1312 +		case 11:
298.1313 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
298.1314 +			                ontoArrayPrepend(args, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1315 +		case 12:
298.1316 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
298.1317 +			                ontoArrayPrepend(args, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1318 +		case 13:
298.1319 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13,
298.1320 +			                ontoArrayPrepend(args, arg14, arg15, arg16, arg17, arg18, arg19, arg20));
298.1321 +		case 14:
298.1322 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1323 +			                ontoArrayPrepend(args, arg15, arg16, arg17, arg18, arg19, arg20));
298.1324 +		case 15:
298.1325 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1326 +			                arg15, ontoArrayPrepend(args, arg16, arg17, arg18, arg19, arg20));
298.1327 +		case 16:
298.1328 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1329 +			                arg15, arg16, ontoArrayPrepend(args, arg17, arg18, arg19, arg20));
298.1330 +		case 17:
298.1331 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1332 +			                arg15, arg16, arg17, ontoArrayPrepend(args, arg18, arg19, arg20));
298.1333 +		case 18:
298.1334 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1335 +			                arg15, arg16, arg17, arg18, ontoArrayPrepend(args, arg19, arg20));
298.1336 +		case 19:
298.1337 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1338 +			                arg15, arg16, arg17, arg18, arg19, ontoArrayPrepend(args, arg20));
298.1339 +		case 20:
298.1340 +			return doInvoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14,
298.1341 +			                arg15, arg16, arg17, arg18, arg19, arg20, ArraySeq.create(args));
298.1342 +		default:
298.1343 +			return throwArity(21);
298.1344 +		}
298.1345 +
298.1346 +}
298.1347 +
298.1348 +
298.1349 +protected static ISeq ontoArrayPrepend(Object[] array, Object... args){
298.1350 +	ISeq ret = ArraySeq.create(array);
298.1351 +	for(int i = args.length - 1; i >= 0; --i)
298.1352 +		ret = RT.cons(args[i], ret);
298.1353 +	return ret;
298.1354 +}
298.1355 +
298.1356 +protected static ISeq findKey(Object key, ISeq args){
298.1357 +	while(args != null)
298.1358 +		{
298.1359 +		if(key == args.first())
298.1360 +			return args.next();
298.1361 +		args = RT.next(args);
298.1362 +		args = RT.next(args);
298.1363 +		}
298.1364 +	return null;
298.1365 +}
298.1366 +
298.1367 +
298.1368 +}
298.1369 +
   299.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   299.2 +++ b/src/clojure/lang/Reversible.java	Sat Aug 21 06:25:44 2010 -0400
   299.3 @@ -0,0 +1,17 @@
   299.4 +/**
   299.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   299.6 + *   The use and distribution terms for this software are covered by the
   299.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   299.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   299.9 + *   By using this software in any fashion, you are agreeing to be bound by
  299.10 + * 	 the terms of this license.
  299.11 + *   You must not remove this notice, or any other, from this software.
  299.12 + **/
  299.13 +
  299.14 +/* rich Jan 5, 2008 */
  299.15 +
  299.16 +package clojure.lang;
  299.17 +
  299.18 +public interface Reversible{
  299.19 +ISeq rseq() throws Exception;
  299.20 +}
   300.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   300.2 +++ b/src/clojure/lang/Script.java	Sat Aug 21 06:25:44 2010 -0400
   300.3 @@ -0,0 +1,22 @@
   300.4 +/**
   300.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   300.6 + *   The use and distribution terms for this software are covered by the
   300.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   300.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   300.9 + *   By using this software in any fashion, you are agreeing to be bound by
  300.10 + * 	 the terms of this license.
  300.11 + *   You must not remove this notice, or any other, from this software.
  300.12 + **/
  300.13 +
  300.14 +/* rich Oct 18, 2007 */
  300.15 +
  300.16 +package clojure.lang;
  300.17 +
  300.18 +import clojure.main;
  300.19 +
  300.20 +public class Script {
  300.21 +
  300.22 +public static void main(String[] args) throws Exception{
  300.23 +    main.legacy_script(args);
  300.24 +}
  300.25 +}
   301.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   301.2 +++ b/src/clojure/lang/SeqEnumeration.java	Sat Aug 21 06:25:44 2010 -0400
   301.3 @@ -0,0 +1,33 @@
   301.4 +/**
   301.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   301.6 + *   The use and distribution terms for this software are covered by the
   301.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   301.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   301.9 + *   By using this software in any fashion, you are agreeing to be bound by
  301.10 + * 	 the terms of this license.
  301.11 + *   You must not remove this notice, or any other, from this software.
  301.12 + **/
  301.13 +
  301.14 +/* rich Mar 3, 2008 */
  301.15 +
  301.16 +package clojure.lang;
  301.17 +
  301.18 +import java.util.Enumeration;
  301.19 +
  301.20 +public class SeqEnumeration implements Enumeration{
  301.21 +ISeq seq;
  301.22 +
  301.23 +public SeqEnumeration(ISeq seq){
  301.24 +	this.seq = seq;
  301.25 +}
  301.26 +
  301.27 +public boolean hasMoreElements(){
  301.28 +	return seq != null;
  301.29 +}
  301.30 +
  301.31 +public Object nextElement(){
  301.32 +	Object ret = RT.first(seq);
  301.33 +	seq = RT.next(seq);
  301.34 +	return ret;
  301.35 +}
  301.36 +}
   302.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   302.2 +++ b/src/clojure/lang/SeqIterator.java	Sat Aug 21 06:25:44 2010 -0400
   302.3 @@ -0,0 +1,41 @@
   302.4 +/**
   302.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   302.6 + *   The use and distribution terms for this software are covered by the
   302.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   302.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   302.9 + *   By using this software in any fashion, you are agreeing to be bound by
  302.10 + * 	 the terms of this license.
  302.11 + *   You must not remove this notice, or any other, from this software.
  302.12 + **/
  302.13 +
  302.14 +/* rich Jun 19, 2007 */
  302.15 +
  302.16 +package clojure.lang;
  302.17 +
  302.18 +import java.util.Iterator;
  302.19 +import java.util.NoSuchElementException;
  302.20 +
  302.21 +public class SeqIterator implements Iterator{
  302.22 +
  302.23 +ISeq seq;
  302.24 +
  302.25 +public SeqIterator(ISeq seq){
  302.26 +	this.seq = seq;
  302.27 +}
  302.28 +
  302.29 +public boolean hasNext(){
  302.30 +	return seq != null;
  302.31 +}
  302.32 +
  302.33 +public Object next() throws NoSuchElementException {
  302.34 +	if(seq == null)
  302.35 +		throw new NoSuchElementException();
  302.36 +	Object ret = RT.first(seq);
  302.37 +	seq = RT.next(seq);
  302.38 +	return ret;
  302.39 +}
  302.40 +
  302.41 +public void remove(){
  302.42 +throw new UnsupportedOperationException();
  302.43 +}
  302.44 +}
   303.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   303.2 +++ b/src/clojure/lang/Seqable.java	Sat Aug 21 06:25:44 2010 -0400
   303.3 @@ -0,0 +1,17 @@
   303.4 +/**
   303.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   303.6 + *   The use and distribution terms for this software are covered by the
   303.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   303.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   303.9 + *   By using this software in any fashion, you are agreeing to be bound by
  303.10 + * 	 the terms of this license.
  303.11 + *   You must not remove this notice, or any other, from this software.
  303.12 + **/
  303.13 +
  303.14 +/* rich Jan 28, 2009 */
  303.15 +
  303.16 +package clojure.lang;
  303.17 +
  303.18 +public interface Seqable {
  303.19 +    ISeq seq();
  303.20 +}
   304.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   304.2 +++ b/src/clojure/lang/Sequential.java	Sat Aug 21 06:25:44 2010 -0400
   304.3 @@ -0,0 +1,13 @@
   304.4 +package clojure.lang;
   304.5 +
   304.6 +/**
   304.7 + * Copyright (c) Rich Hickey. All rights reserved.
   304.8 + * The use and distribution terms for this software are covered by the
   304.9 + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  304.10 + * which can be found in the file epl-v10.html at the root of this distribution.
  304.11 + * By using this software in any fashion, you are agreeing to be bound by
  304.12 + * the terms of this license.
  304.13 + * You must not remove this notice, or any other, from this software.
  304.14 + */
  304.15 +public interface Sequential {
  304.16 +}
   305.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   305.2 +++ b/src/clojure/lang/Settable.java	Sat Aug 21 06:25:44 2010 -0400
   305.3 @@ -0,0 +1,18 @@
   305.4 +/**
   305.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   305.6 + *   The use and distribution terms for this software are covered by the
   305.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   305.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   305.9 + *   By using this software in any fashion, you are agreeing to be bound by
  305.10 + * 	 the terms of this license.
  305.11 + *   You must not remove this notice, or any other, from this software.
  305.12 + **/
  305.13 +
  305.14 +/* rich Dec 31, 2008 */
  305.15 +
  305.16 +package clojure.lang;
  305.17 +
  305.18 +public interface Settable {
  305.19 +    Object doSet(Object val) throws Exception;
  305.20 +    Object doReset(Object val) throws Exception;
  305.21 +}
   306.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   306.2 +++ b/src/clojure/lang/Sorted.java	Sat Aug 21 06:25:44 2010 -0400
   306.3 @@ -0,0 +1,25 @@
   306.4 +/**
   306.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   306.6 + *   The use and distribution terms for this software are covered by the
   306.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   306.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   306.9 + *   By using this software in any fashion, you are agreeing to be bound by
  306.10 + * 	 the terms of this license.
  306.11 + *   You must not remove this notice, or any other, from this software.
  306.12 + **/
  306.13 +
  306.14 +/* rich Apr 15, 2008 */
  306.15 +
  306.16 +package clojure.lang;
  306.17 +
  306.18 +import java.util.Comparator;
  306.19 +
  306.20 +public interface Sorted{
  306.21 +Comparator comparator();
  306.22 +
  306.23 +Object entryKey(Object entry);
  306.24 +
  306.25 +ISeq seq(boolean ascending);
  306.26 +
  306.27 +ISeq seqFrom(Object key, boolean ascending);
  306.28 +}
   307.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   307.2 +++ b/src/clojure/lang/StringSeq.java	Sat Aug 21 06:25:44 2010 -0400
   307.3 @@ -0,0 +1,54 @@
   307.4 +/**
   307.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   307.6 + *   The use and distribution terms for this software are covered by the
   307.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   307.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   307.9 + *   By using this software in any fashion, you are agreeing to be bound by
  307.10 + * 	 the terms of this license.
  307.11 + *   You must not remove this notice, or any other, from this software.
  307.12 + **/
  307.13 +
  307.14 +/* rich Dec 6, 2007 */
  307.15 +
  307.16 +package clojure.lang;
  307.17 +
  307.18 +public class StringSeq extends ASeq implements IndexedSeq{
  307.19 +public final CharSequence s;
  307.20 +public final int i;
  307.21 +
  307.22 +static public StringSeq create(CharSequence s){
  307.23 +	if(s.length() == 0)
  307.24 +		return null;
  307.25 +	return new StringSeq(null, s, 0);
  307.26 +}
  307.27 +
  307.28 +StringSeq(IPersistentMap meta, CharSequence s, int i){
  307.29 +	super(meta);
  307.30 +	this.s = s;
  307.31 +	this.i = i;
  307.32 +}
  307.33 +
  307.34 +public Obj withMeta(IPersistentMap meta){
  307.35 +	if(meta == meta())
  307.36 +		return this;
  307.37 +	return new StringSeq(meta, s, i);
  307.38 +}
  307.39 +
  307.40 +public Object first(){
  307.41 +	return Character.valueOf(s.charAt(i));
  307.42 +}
  307.43 +
  307.44 +public ISeq next(){
  307.45 +	if(i + 1 < s.length())
  307.46 +		return new StringSeq(_meta, s, i + 1);
  307.47 +	return null;
  307.48 +}
  307.49 +
  307.50 +public int index(){
  307.51 +	return i;
  307.52 +}
  307.53 +
  307.54 +public int count(){
  307.55 +	return s.length() - i;
  307.56 +}
  307.57 +}
   308.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   308.2 +++ b/src/clojure/lang/Symbol.java	Sat Aug 21 06:25:44 2010 -0400
   308.3 @@ -0,0 +1,126 @@
   308.4 +/**
   308.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   308.6 + *   The use and distribution terms for this software are covered by the
   308.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   308.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   308.9 + *   By using this software in any fashion, you are agreeing to be bound by
  308.10 + * 	 the terms of this license.
  308.11 + *   You must not remove this notice, or any other, from this software.
  308.12 + **/
  308.13 +
  308.14 +/* rich Mar 25, 2006 11:42:47 AM */
  308.15 +
  308.16 +package clojure.lang;
  308.17 +
  308.18 +import java.io.Serializable;
  308.19 +import java.io.ObjectStreamException;
  308.20 +
  308.21 +
  308.22 +public class Symbol extends AFn implements IObj, Comparable, Named, Serializable{
  308.23 +//these must be interned strings!
  308.24 +final String ns;
  308.25 +final String name;
  308.26 +final int hash;
  308.27 +final IPersistentMap _meta;
  308.28 +
  308.29 +public String toString(){
  308.30 +	if(ns != null)
  308.31 +		return ns + "/" + name;
  308.32 +	return name;
  308.33 +}
  308.34 +
  308.35 +public String getNamespace(){
  308.36 +	return ns;
  308.37 +}
  308.38 +
  308.39 +public String getName(){
  308.40 +	return name;
  308.41 +}
  308.42 +
  308.43 +static public Symbol intern(String ns, String name){
  308.44 +	return new Symbol(ns == null ? null : ns.intern(), name.intern());
  308.45 +}
  308.46 +
  308.47 +static public Symbol intern(String nsname){
  308.48 +	int i = nsname.lastIndexOf('/');
  308.49 +	if(i == -1 || nsname.equals("/"))
  308.50 +		return new Symbol(null, nsname.intern());
  308.51 +	else
  308.52 +		return new Symbol(nsname.substring(0, i).intern(), nsname.substring(i + 1).intern());
  308.53 +}
  308.54 +
  308.55 +static public Symbol create(String name_interned){
  308.56 +	return new Symbol(null, name_interned);
  308.57 +}
  308.58 +
  308.59 +static public Symbol create(String ns_interned, String name_interned){
  308.60 +	return new Symbol(ns_interned, name_interned);
  308.61 +}
  308.62 +
  308.63 +private Symbol(String ns_interned, String name_interned){
  308.64 +	this.name = name_interned;
  308.65 +	this.ns = ns_interned;
  308.66 +	this.hash = Util.hashCombine(name.hashCode(), Util.hash(ns));
  308.67 +	this._meta = null;
  308.68 +}
  308.69 +
  308.70 +public boolean equals(Object o){
  308.71 +	if(this == o)
  308.72 +		return true;
  308.73 +	if(!(o instanceof Symbol))
  308.74 +		return false;
  308.75 +
  308.76 +	Symbol symbol = (Symbol) o;
  308.77 +
  308.78 +	//identity compares intended, names are interned
  308.79 +	return name == symbol.name && ns == symbol.ns;
  308.80 +}
  308.81 +
  308.82 +public int hashCode(){
  308.83 +	return hash;
  308.84 +}
  308.85 +
  308.86 +public IObj withMeta(IPersistentMap meta){
  308.87 +	return new Symbol(meta, ns, name);
  308.88 +}
  308.89 +
  308.90 +private Symbol(IPersistentMap meta, String ns, String name){
  308.91 +	this.name = name;
  308.92 +	this.ns = ns;
  308.93 +	this._meta = meta;
  308.94 +	this.hash = Util.hashCombine(name.hashCode(), Util.hash(ns));
  308.95 +}
  308.96 +
  308.97 +public int compareTo(Object o){
  308.98 +	Symbol s = (Symbol) o;
  308.99 +	if(this.equals(o))
 308.100 +		return 0;
 308.101 +	if(this.ns == null && s.ns != null)
 308.102 +		return -1;
 308.103 +	if(this.ns != null)
 308.104 +		{
 308.105 +		if(s.ns == null)
 308.106 +			return 1;
 308.107 +		int nsc = this.ns.compareTo(s.ns);
 308.108 +		if(nsc != 0)
 308.109 +			return nsc;
 308.110 +		}
 308.111 +	return this.name.compareTo(s.name);
 308.112 +}
 308.113 +
 308.114 +private Object readResolve() throws ObjectStreamException{
 308.115 +	return intern(ns, name);
 308.116 +}
 308.117 +
 308.118 +public Object invoke(Object obj) throws Exception{
 308.119 +	return RT.get(obj, this);
 308.120 +}
 308.121 +
 308.122 +public Object invoke(Object obj, Object notFound) throws Exception{
 308.123 +	return RT.get(obj, this, notFound);
 308.124 +}
 308.125 +
 308.126 +public IPersistentMap meta(){
 308.127 +	return _meta;
 308.128 +}
 308.129 +}
   309.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   309.2 +++ b/src/clojure/lang/TransactionalHashMap.java	Sat Aug 21 06:25:44 2010 -0400
   309.3 @@ -0,0 +1,197 @@
   309.4 +/**
   309.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   309.6 + *   The use and distribution terms for this software are covered by the
   309.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   309.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   309.9 + *   By using this software in any fashion, you are agreeing to be bound by
  309.10 + * 	 the terms of this license.
  309.11 + *   You must not remove this notice, or any other, from this software.
  309.12 + **/
  309.13 +
  309.14 +/* rich Jul 31, 2008 */
  309.15 +
  309.16 +package clojure.lang;
  309.17 +
  309.18 +import java.util.concurrent.ConcurrentMap;
  309.19 +import java.util.*;
  309.20 +
  309.21 +public class TransactionalHashMap<K, V> extends AbstractMap<K, V> implements ConcurrentMap<K, V>{
  309.22 +final Ref[] bins;
  309.23 +
  309.24 +IPersistentMap mapAt(int bin){
  309.25 +	return (IPersistentMap) bins[bin].deref();
  309.26 +}
  309.27 +
  309.28 +final int binFor(Object k){
  309.29 +	//spread hashes, a la Cliff Click
  309.30 +	int h = k.hashCode();
  309.31 +	h ^= (h >>> 20) ^ (h >>> 12);
  309.32 +	h ^= (h >>> 7) ^ (h >>> 4);
  309.33 +	return h % bins.length;
  309.34 +//	return k.hashCode() % bins.length;
  309.35 +}
  309.36 +
  309.37 +Entry entryAt(Object k){
  309.38 +	return mapAt(binFor(k)).entryAt(k);
  309.39 +}
  309.40 +
  309.41 +public TransactionalHashMap() throws Exception{
  309.42 +	this(421);
  309.43 +}
  309.44 +
  309.45 +public TransactionalHashMap(int nBins) throws Exception{
  309.46 +	bins = new Ref[nBins];
  309.47 +	for(int i = 0; i < nBins; i++)
  309.48 +		bins[i] = new Ref(PersistentHashMap.EMPTY);
  309.49 +}
  309.50 +
  309.51 +public TransactionalHashMap(Map<? extends K, ? extends V> m) throws Exception{
  309.52 +	this(m.size());
  309.53 +	putAll(m);
  309.54 +}
  309.55 +
  309.56 +public int size(){
  309.57 +	int n = 0;
  309.58 +	for(int i = 0; i < bins.length; i++)
  309.59 +		{
  309.60 +		n += mapAt(i).count();
  309.61 +		}
  309.62 +	return n;
  309.63 +}
  309.64 +
  309.65 +public boolean isEmpty(){
  309.66 +	return size() == 0;
  309.67 +}
  309.68 +
  309.69 +public boolean containsKey(Object k){
  309.70 +	return entryAt(k) != null;
  309.71 +}
  309.72 +
  309.73 +public V get(Object k){
  309.74 +	Entry e = entryAt(k);
  309.75 +	if(e != null)
  309.76 +		return (V) e.getValue();
  309.77 +	return null;
  309.78 +}
  309.79 +
  309.80 +public V put(K k, V v){
  309.81 +	Ref r = bins[binFor(k)];
  309.82 +	IPersistentMap map = (IPersistentMap) r.deref();
  309.83 +	Object ret = map.valAt(k);
  309.84 +	r.set(map.assoc(k, v));
  309.85 +	return (V) ret;
  309.86 +}
  309.87 +
  309.88 +public V remove(Object k){
  309.89 +	Ref r = bins[binFor(k)];
  309.90 +	IPersistentMap map = (IPersistentMap) r.deref();
  309.91 +	Object ret = map.valAt(k);
  309.92 +	//checked exceptions are a bad idea, especially in an interface
  309.93 +	try
  309.94 +		{
  309.95 +		r.set(map.without(k));
  309.96 +		}
  309.97 +	catch(Exception e)
  309.98 +		{
  309.99 +		throw new RuntimeException(e);
 309.100 +		}
 309.101 +	return (V) ret;
 309.102 +}
 309.103 +
 309.104 +public void putAll(Map<? extends K, ? extends V> map){
 309.105 +	for(Iterator i = map.entrySet().iterator(); i.hasNext();)
 309.106 +		{
 309.107 +		Entry<K, V> e = (Entry) i.next();
 309.108 +		put(e.getKey(), e.getValue());
 309.109 +		}
 309.110 +}
 309.111 +
 309.112 +public void clear(){
 309.113 +	for(int i = 0; i < bins.length; i++)
 309.114 +		{
 309.115 +		Ref r = bins[i];
 309.116 +		IPersistentMap map = (IPersistentMap) r.deref();
 309.117 +		if(map.count() > 0)
 309.118 +			{
 309.119 +			r.set(PersistentHashMap.EMPTY);
 309.120 +			}
 309.121 +		}
 309.122 +}
 309.123 +
 309.124 +public Set<Entry<K, V>> entrySet(){
 309.125 +	final ArrayList<Map.Entry<K, V>> entries = new ArrayList(bins.length);
 309.126 +	for(int i = 0; i < bins.length; i++)
 309.127 +		{
 309.128 +		IPersistentMap map = mapAt(i);
 309.129 +		if(map.count() > 0)
 309.130 +			entries.addAll((Collection) RT.seq(map));
 309.131 +		}
 309.132 +	return new AbstractSet<Entry<K, V>>(){
 309.133 +		public Iterator iterator(){
 309.134 +			return Collections.unmodifiableList(entries).iterator();
 309.135 +		}
 309.136 +
 309.137 +		public int size(){
 309.138 +			return entries.size();
 309.139 +		}
 309.140 +	};
 309.141 +}
 309.142 +
 309.143 +public V putIfAbsent(K k, V v){
 309.144 +	Ref r = bins[binFor(k)];
 309.145 +	IPersistentMap map = (IPersistentMap) r.deref();
 309.146 +	Entry e = map.entryAt(k);
 309.147 +	if(e == null)
 309.148 +		{
 309.149 +		r.set(map.assoc(k, v));
 309.150 +		return null;
 309.151 +		}
 309.152 +	else
 309.153 +		return (V) e.getValue();
 309.154 +}
 309.155 +
 309.156 +public boolean remove(Object k, Object v){
 309.157 +	Ref r = bins[binFor(k)];
 309.158 +	IPersistentMap map = (IPersistentMap) r.deref();
 309.159 +	Entry e = map.entryAt(k);
 309.160 +	if(e != null && e.getValue().equals(v))
 309.161 +		{
 309.162 +		//checked exceptions are a bad idea, especially in an interface
 309.163 +		try
 309.164 +			{
 309.165 +			r.set(map.without(k));
 309.166 +			}
 309.167 +		catch(Exception ex)
 309.168 +			{
 309.169 +			throw new RuntimeException(ex);
 309.170 +			}
 309.171 +		return true;
 309.172 +		}
 309.173 +	return false;
 309.174 +}
 309.175 +
 309.176 +public boolean replace(K k, V oldv, V newv){
 309.177 +	Ref r = bins[binFor(k)];
 309.178 +	IPersistentMap map = (IPersistentMap) r.deref();
 309.179 +	Entry e = map.entryAt(k);
 309.180 +	if(e != null && e.getValue().equals(oldv))
 309.181 +		{
 309.182 +		r.set(map.assoc(k, newv));
 309.183 +		return true;
 309.184 +		}
 309.185 +	return false;
 309.186 +}
 309.187 +
 309.188 +public V replace(K k, V v){
 309.189 +	Ref r = bins[binFor(k)];
 309.190 +	IPersistentMap map = (IPersistentMap) r.deref();
 309.191 +	Entry e = map.entryAt(k);
 309.192 +	if(e != null)
 309.193 +		{
 309.194 +		r.set(map.assoc(k, v));
 309.195 +		return (V) e.getValue();
 309.196 +		}
 309.197 +	return null;
 309.198 +}
 309.199 +
 309.200 +}
   310.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   310.2 +++ b/src/clojure/lang/Util.java	Sat Aug 21 06:25:44 2010 -0400
   310.3 @@ -0,0 +1,116 @@
   310.4 +/**
   310.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   310.6 + *   The use and distribution terms for this software are covered by the
   310.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   310.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   310.9 + *   By using this software in any fashion, you are agreeing to be bound by
  310.10 + * 	 the terms of this license.
  310.11 + *   You must not remove this notice, or any other, from this software.
  310.12 + **/
  310.13 +
  310.14 +/* rich Apr 19, 2008 */
  310.15 +
  310.16 +package clojure.lang;
  310.17 +
  310.18 +import java.math.BigInteger;
  310.19 +import java.util.Map;
  310.20 +import java.util.concurrent.ConcurrentHashMap;
  310.21 +import java.lang.ref.SoftReference;
  310.22 +import java.lang.ref.ReferenceQueue;
  310.23 +import java.lang.ref.Reference;
  310.24 +
  310.25 +public class Util{
  310.26 +static public boolean equiv(Object k1, Object k2){
  310.27 +	if(k1 == k2)
  310.28 +		return true;
  310.29 +	if(k1 != null)
  310.30 +		{
  310.31 +		if(k1 instanceof Number && k2 instanceof Number)
  310.32 +			return Numbers.equiv(k1, k2);
  310.33 +		else if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection)
  310.34 +			return pcequiv(k1,k2);
  310.35 +		return k1.equals(k2);
  310.36 +		}
  310.37 +	return false;
  310.38 +}
  310.39 +
  310.40 +static public boolean pcequiv(Object k1, Object k2){
  310.41 +	if(k1 instanceof IPersistentCollection)
  310.42 +		return ((IPersistentCollection)k1).equiv(k2);
  310.43 +	return ((IPersistentCollection)k2).equiv(k1);
  310.44 +}
  310.45 +
  310.46 +static public boolean equals(Object k1, Object k2){
  310.47 +	if(k1 == k2)
  310.48 +		return true;
  310.49 +	return k1 != null && k1.equals(k2);
  310.50 +}
  310.51 +
  310.52 +static public boolean identical(Object k1, Object k2){
  310.53 +	return k1 == k2;
  310.54 +}
  310.55 +
  310.56 +static public Class classOf(Object x){
  310.57 +	if(x != null)
  310.58 +		return x.getClass();
  310.59 +	return null;
  310.60 +}
  310.61 +
  310.62 +static public int compare(Object k1, Object k2){
  310.63 +	if(k1 == k2)
  310.64 +		return 0;
  310.65 +	if(k1 != null)
  310.66 +		{
  310.67 +		if(k2 == null)
  310.68 +			return 1;
  310.69 +		if(k1 instanceof Number)
  310.70 +			return Numbers.compare((Number) k1, (Number) k2);
  310.71 +		return ((Comparable) k1).compareTo(k2);
  310.72 +		}
  310.73 +	return -1;
  310.74 +}
  310.75 +
  310.76 +static public int hash(Object o){
  310.77 +	if(o == null)
  310.78 +		return 0;
  310.79 +	return o.hashCode();
  310.80 +}
  310.81 +
  310.82 +static public int hashCombine(int seed, int hash){
  310.83 +	//a la boost
  310.84 +	seed ^= hash + 0x9e3779b9 + (seed << 6) + (seed >> 2);
  310.85 +	return seed;
  310.86 +}
  310.87 +
  310.88 +static public boolean isPrimitive(Class c){
  310.89 +	return c != null && c.isPrimitive() && !(c == Void.TYPE);
  310.90 +}
  310.91 +
  310.92 +static public boolean isInteger(Object x){
  310.93 +	return x instanceof Integer
  310.94 +			|| x instanceof Long
  310.95 +			|| x instanceof BigInteger;
  310.96 +}
  310.97 +
  310.98 +static public Object ret1(Object ret, Object nil){
  310.99 +		return ret;
 310.100 +}
 310.101 +
 310.102 +static public ISeq ret1(ISeq ret, Object nil){
 310.103 +		return ret;
 310.104 +}
 310.105 +
 310.106 +static public <K,V> void clearCache(ReferenceQueue rq, ConcurrentHashMap<K, SoftReference<V>> cache){
 310.107 +		//cleanup any dead entries
 310.108 +	if(rq.poll() != null)
 310.109 +		{
 310.110 +		while(rq.poll() != null)
 310.111 +			;
 310.112 +		for(Map.Entry<K, SoftReference<V>> e : cache.entrySet())
 310.113 +			{
 310.114 +			if(e.getValue().get() == null)
 310.115 +				cache.remove(e.getKey(), e.getValue());
 310.116 +			}
 310.117 +		}
 310.118 +}
 310.119 +}
   311.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   311.2 +++ b/src/clojure/lang/Var.java	Sat Aug 21 06:25:44 2010 -0400
   311.3 @@ -0,0 +1,497 @@
   311.4 +/**
   311.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   311.6 + *   The use and distribution terms for this software are covered by the
   311.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   311.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   311.9 + *   By using this software in any fashion, you are agreeing to be bound by
  311.10 + * 	 the terms of this license.
  311.11 + *   You must not remove this notice, or any other, from this software.
  311.12 + **/
  311.13 +
  311.14 +/* rich Jul 31, 2007 */
  311.15 +
  311.16 +package clojure.lang;
  311.17 +
  311.18 +import java.util.concurrent.atomic.AtomicInteger;
  311.19 +
  311.20 +
  311.21 +public final class Var extends ARef implements IFn, IRef, Settable{
  311.22 +
  311.23 +
  311.24 +static class Frame{
  311.25 +	//Var->Box
  311.26 +	Associative bindings;
  311.27 +	//Var->val
  311.28 +	Associative frameBindings;
  311.29 +	Frame prev;
  311.30 +
  311.31 +
  311.32 +	public Frame(){
  311.33 +		this(PersistentHashMap.EMPTY, PersistentHashMap.EMPTY, null);
  311.34 +	}
  311.35 +
  311.36 +	public Frame(Associative frameBindings, Associative bindings, Frame prev){
  311.37 +		this.frameBindings = frameBindings;
  311.38 +		this.bindings = bindings;
  311.39 +		this.prev = prev;
  311.40 +	}
  311.41 +}
  311.42 +
  311.43 +static ThreadLocal<Frame> dvals = new ThreadLocal<Frame>(){
  311.44 +
  311.45 +	protected Frame initialValue(){
  311.46 +		return new Frame();
  311.47 +	}
  311.48 +};
  311.49 +
  311.50 +static Keyword privateKey = Keyword.intern(null, "private");
  311.51 +static IPersistentMap privateMeta = new PersistentArrayMap(new Object[]{privateKey, Boolean.TRUE});
  311.52 +static Keyword macroKey = Keyword.intern(null, "macro");
  311.53 +static Keyword nameKey = Keyword.intern(null, "name");
  311.54 +static Keyword nsKey = Keyword.intern(null, "ns");
  311.55 +//static Keyword tagKey = Keyword.intern(null, "tag");
  311.56 +
  311.57 +volatile Object root;
  311.58 +transient final AtomicInteger count;
  311.59 +public final Symbol sym;
  311.60 +public final Namespace ns;
  311.61 +
  311.62 +//IPersistentMap _meta;
  311.63 +
  311.64 +public static Var intern(Namespace ns, Symbol sym, Object root){
  311.65 +	return intern(ns, sym, root, true);
  311.66 +}
  311.67 +
  311.68 +public static Var intern(Namespace ns, Symbol sym, Object root, boolean replaceRoot){
  311.69 +	Var dvout = ns.intern(sym);
  311.70 +	if(!dvout.hasRoot() || replaceRoot)
  311.71 +		dvout.bindRoot(root);
  311.72 +	return dvout;
  311.73 +}
  311.74 +
  311.75 +
  311.76 +public String toString(){
  311.77 +	if(ns != null)
  311.78 +		return "#'" + ns.name + "/" + sym;
  311.79 +	return "#<Var: " + (sym != null ? sym.toString() : "--unnamed--") + ">";
  311.80 +}
  311.81 +
  311.82 +public static Var find(Symbol nsQualifiedSym){
  311.83 +	if(nsQualifiedSym.ns == null)
  311.84 +		throw new IllegalArgumentException("Symbol must be namespace-qualified");
  311.85 +	Namespace ns = Namespace.find(Symbol.create(nsQualifiedSym.ns));
  311.86 +	if(ns == null)
  311.87 +		throw new IllegalArgumentException("No such namespace: " + nsQualifiedSym.ns);
  311.88 +	return ns.findInternedVar(Symbol.create(nsQualifiedSym.name));
  311.89 +}
  311.90 +
  311.91 +public static Var intern(Symbol nsName, Symbol sym){
  311.92 +	Namespace ns = Namespace.findOrCreate(nsName);
  311.93 +	return intern(ns, sym);
  311.94 +}
  311.95 +
  311.96 +public static Var internPrivate(String nsName, String sym){
  311.97 +	Namespace ns = Namespace.findOrCreate(Symbol.intern(nsName));
  311.98 +	Var ret = intern(ns, Symbol.intern(sym));
  311.99 +	ret.setMeta(privateMeta);
 311.100 +	return ret;
 311.101 +}
 311.102 +
 311.103 +public static Var intern(Namespace ns, Symbol sym){
 311.104 +	return ns.intern(sym);
 311.105 +}
 311.106 +
 311.107 +
 311.108 +public static Var create(){
 311.109 +	return new Var(null, null);
 311.110 +}
 311.111 +
 311.112 +public static Var create(Object root){
 311.113 +	return new Var(null, null, root);
 311.114 +}
 311.115 +
 311.116 +Var(Namespace ns, Symbol sym){
 311.117 +	this.ns = ns;
 311.118 +	this.sym = sym;
 311.119 +	this.count = new AtomicInteger();
 311.120 +	this.root = dvals;  //use dvals as magic not-bound value
 311.121 +	setMeta(PersistentHashMap.EMPTY);
 311.122 +}
 311.123 +
 311.124 +Var(Namespace ns, Symbol sym, Object root){
 311.125 +	this(ns, sym);
 311.126 +	this.root = root;
 311.127 +}
 311.128 +
 311.129 +public boolean isBound(){
 311.130 +	return hasRoot() || (count.get() > 0 && dvals.get().bindings.containsKey(this));
 311.131 +}
 311.132 +
 311.133 +final public Object get(){
 311.134 +	if(count.get() == 0 && root != dvals)
 311.135 +		return root;
 311.136 +	return deref();
 311.137 +}
 311.138 +
 311.139 +final public Object deref(){
 311.140 +	Box b = getThreadBinding();
 311.141 +	if(b != null)
 311.142 +		return b.val;
 311.143 +	if(hasRoot())
 311.144 +		return root;
 311.145 +	throw new IllegalStateException(String.format("Var %s/%s is unbound.", ns, sym));
 311.146 +}
 311.147 +
 311.148 +public void setValidator(IFn vf){
 311.149 +	if(hasRoot())
 311.150 +		validate(vf, getRoot());
 311.151 +	validator = vf;
 311.152 +}
 311.153 +
 311.154 +public Object alter(IFn fn, ISeq args) throws Exception{
 311.155 +	set(fn.applyTo(RT.cons(deref(), args)));
 311.156 +	return this;
 311.157 +}
 311.158 +
 311.159 +public Object set(Object val){
 311.160 +	validate(getValidator(), val);
 311.161 +	Box b = getThreadBinding();
 311.162 +	if(b != null)
 311.163 +		return (b.val = val);
 311.164 +	//jury still out on this
 311.165 +//	if(hasRoot())
 311.166 +//		{
 311.167 +//		bindRoot(val);
 311.168 +//		return val;
 311.169 +//		}
 311.170 +	throw new IllegalStateException(String.format("Can't change/establish root binding of: %s with set", sym));
 311.171 +}
 311.172 +
 311.173 +public Object doSet(Object val) throws Exception {
 311.174 +    return set(val);
 311.175 +    }
 311.176 +
 311.177 +public Object doReset(Object val) throws Exception {
 311.178 +    bindRoot(val);
 311.179 +    return val;
 311.180 +    }
 311.181 +
 311.182 +public void setMeta(IPersistentMap m) {
 311.183 +    //ensure these basis keys
 311.184 +    resetMeta(m.assoc(nameKey, sym).assoc(nsKey, ns));
 311.185 +}
 311.186 +
 311.187 +public void setMacro() {
 311.188 +    try
 311.189 +        {
 311.190 +        alterMeta(assoc, RT.list(macroKey, RT.T));
 311.191 +        }
 311.192 +    catch (Exception e)
 311.193 +        {
 311.194 +        throw new RuntimeException(e);
 311.195 +        }
 311.196 +}
 311.197 +
 311.198 +public boolean isMacro(){
 311.199 +	return RT.booleanCast(meta().valAt(macroKey));
 311.200 +}
 311.201 +
 311.202 +//public void setExported(boolean state){
 311.203 +//	_meta = _meta.assoc(privateKey, state);
 311.204 +//}
 311.205 +
 311.206 +public boolean isPublic(){
 311.207 +	return !RT.booleanCast(meta().valAt(privateKey));
 311.208 +}
 311.209 +
 311.210 +public Object getRoot(){
 311.211 +	if(hasRoot())
 311.212 +		return root;
 311.213 +	throw new IllegalStateException(String.format("Var %s/%s is unbound.", ns, sym));
 311.214 +}
 311.215 +
 311.216 +public Object getRawRoot(){
 311.217 +		return root;
 311.218 +}
 311.219 +
 311.220 +public Object getTag(){
 311.221 +	return meta().valAt(RT.TAG_KEY);
 311.222 +}
 311.223 +
 311.224 +public void setTag(Symbol tag) {
 311.225 +    try
 311.226 +        {
 311.227 +        alterMeta(assoc, RT.list(RT.TAG_KEY, tag));
 311.228 +        }
 311.229 +    catch (Exception e)
 311.230 +        {
 311.231 +        throw new RuntimeException(e);
 311.232 +        }
 311.233 +}
 311.234 +
 311.235 +final public boolean hasRoot(){
 311.236 +	return root != dvals;
 311.237 +}
 311.238 +
 311.239 +//binding root always clears macro flag
 311.240 +synchronized public void bindRoot(Object root){
 311.241 +	validate(getValidator(), root);
 311.242 +	Object oldroot = hasRoot()?this.root:null;
 311.243 +	this.root = root;
 311.244 +    try
 311.245 +        {
 311.246 +        alterMeta(dissoc, RT.list(macroKey));
 311.247 +        }
 311.248 +    catch (Exception e)
 311.249 +        {
 311.250 +        throw new RuntimeException(e);
 311.251 +        }
 311.252 +    notifyWatches(oldroot,this.root);
 311.253 +}
 311.254 +
 311.255 +synchronized void swapRoot(Object root){
 311.256 +	validate(getValidator(), root);
 311.257 +	Object oldroot = hasRoot()?this.root:null;
 311.258 +	this.root = root;
 311.259 +    notifyWatches(oldroot,root);
 311.260 +}
 311.261 +
 311.262 +synchronized public void unbindRoot(){
 311.263 +	this.root = dvals;
 311.264 +}
 311.265 +
 311.266 +synchronized public void commuteRoot(IFn fn) throws Exception{
 311.267 +	Object newRoot = fn.invoke(root);
 311.268 +	validate(getValidator(), newRoot);
 311.269 +	Object oldroot = getRoot();
 311.270 +	this.root = newRoot;
 311.271 +    notifyWatches(oldroot,newRoot);
 311.272 +}
 311.273 +
 311.274 +synchronized public Object alterRoot(IFn fn, ISeq args) throws Exception{
 311.275 +	Object newRoot = fn.applyTo(RT.cons(root, args));
 311.276 +	validate(getValidator(), newRoot);
 311.277 +	Object oldroot = getRoot();
 311.278 +	this.root = newRoot;
 311.279 +    notifyWatches(oldroot,newRoot);
 311.280 +	return newRoot;
 311.281 +}
 311.282 +
 311.283 +public static void pushThreadBindings(Associative bindings){
 311.284 +	Frame f = dvals.get();
 311.285 +	Associative bmap = f.bindings;
 311.286 +	for(ISeq bs = bindings.seq(); bs != null; bs = bs.next())
 311.287 +		{
 311.288 +		IMapEntry e = (IMapEntry) bs.first();
 311.289 +		Var v = (Var) e.key();
 311.290 +		v.validate(v.getValidator(), e.val());
 311.291 +		v.count.incrementAndGet();
 311.292 +		bmap = bmap.assoc(v, new Box(e.val()));
 311.293 +		}
 311.294 +	dvals.set(new Frame(bindings, bmap, f));
 311.295 +}
 311.296 +
 311.297 +public static void popThreadBindings(){
 311.298 +	Frame f = dvals.get();
 311.299 +	if(f.prev == null)
 311.300 +		throw new IllegalStateException("Pop without matching push");
 311.301 +	for(ISeq bs = RT.keys(f.frameBindings); bs != null; bs = bs.next())
 311.302 +		{
 311.303 +		Var v = (Var) bs.first();
 311.304 +		v.count.decrementAndGet();
 311.305 +		}
 311.306 +	dvals.set(f.prev);
 311.307 +}
 311.308 +
 311.309 +public static void releaseThreadBindings(){
 311.310 +	Frame f = dvals.get();
 311.311 +	if(f.prev == null)
 311.312 +		throw new IllegalStateException("Release without full unwind");
 311.313 +	for(ISeq bs = RT.keys(f.bindings); bs != null; bs = bs.next())
 311.314 +		{
 311.315 +		Var v = (Var) bs.first();
 311.316 +		v.count.decrementAndGet();
 311.317 +		}
 311.318 +	dvals.set(null);
 311.319 +}
 311.320 +
 311.321 +public static Associative getThreadBindings(){
 311.322 +	Frame f = dvals.get();
 311.323 +	IPersistentMap ret = PersistentHashMap.EMPTY;
 311.324 +	for(ISeq bs = f.bindings.seq(); bs != null; bs = bs.next())
 311.325 +		{
 311.326 +		IMapEntry e = (IMapEntry) bs.first();
 311.327 +		Var v = (Var) e.key();
 311.328 +		Box b = (Box) e.val();
 311.329 +		ret = ret.assoc(v, b.val);
 311.330 +		}
 311.331 +	return ret;
 311.332 +}
 311.333 +
 311.334 +public final Box getThreadBinding(){
 311.335 +	if(count.get() > 0)
 311.336 +		{
 311.337 +		IMapEntry e = dvals.get().bindings.entryAt(this);
 311.338 +		if(e != null)
 311.339 +			return (Box) e.val();
 311.340 +		}
 311.341 +	return null;
 311.342 +}
 311.343 +
 311.344 +final public IFn fn(){
 311.345 +	return (IFn) deref();
 311.346 +}
 311.347 +
 311.348 +public Object call() throws Exception{
 311.349 +	return invoke();
 311.350 +}
 311.351 +
 311.352 +public void run(){
 311.353 +	try
 311.354 +		{
 311.355 +		invoke();
 311.356 +		}
 311.357 +	catch(Exception e)
 311.358 +		{
 311.359 +		throw new RuntimeException(e);
 311.360 +		}
 311.361 +}
 311.362 +
 311.363 +public Object invoke() throws Exception{
 311.364 +	return fn().invoke();
 311.365 +}
 311.366 +
 311.367 +public Object invoke(Object arg1) throws Exception{
 311.368 +	return fn().invoke(arg1);
 311.369 +}
 311.370 +
 311.371 +public Object invoke(Object arg1, Object arg2) throws Exception{
 311.372 +	return fn().invoke(arg1, arg2);
 311.373 +}
 311.374 +
 311.375 +public Object invoke(Object arg1, Object arg2, Object arg3) throws Exception{
 311.376 +	return fn().invoke(arg1, arg2, arg3);
 311.377 +}
 311.378 +
 311.379 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) throws Exception{
 311.380 +	return fn().invoke(arg1, arg2, arg3, arg4);
 311.381 +}
 311.382 +
 311.383 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) throws Exception{
 311.384 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5);
 311.385 +}
 311.386 +
 311.387 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) throws Exception{
 311.388 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6);
 311.389 +}
 311.390 +
 311.391 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
 311.392 +		throws Exception{
 311.393 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
 311.394 +}
 311.395 +
 311.396 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.397 +                     Object arg8) throws Exception{
 311.398 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
 311.399 +}
 311.400 +
 311.401 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.402 +                     Object arg8, Object arg9) throws Exception{
 311.403 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
 311.404 +}
 311.405 +
 311.406 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.407 +                     Object arg8, Object arg9, Object arg10) throws Exception{
 311.408 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10);
 311.409 +}
 311.410 +
 311.411 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.412 +                     Object arg8, Object arg9, Object arg10, Object arg11) throws Exception{
 311.413 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11);
 311.414 +}
 311.415 +
 311.416 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.417 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) throws Exception{
 311.418 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12);
 311.419 +}
 311.420 +
 311.421 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.422 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13)
 311.423 +		throws Exception{
 311.424 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13);
 311.425 +}
 311.426 +
 311.427 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.428 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
 311.429 +		throws Exception{
 311.430 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14);
 311.431 +}
 311.432 +
 311.433 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.434 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.435 +                     Object arg15) throws Exception{
 311.436 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15);
 311.437 +}
 311.438 +
 311.439 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.440 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.441 +                     Object arg15, Object arg16) throws Exception{
 311.442 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 311.443 +	                   arg16);
 311.444 +}
 311.445 +
 311.446 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.447 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.448 +                     Object arg15, Object arg16, Object arg17) throws Exception{
 311.449 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 311.450 +	                   arg16, arg17);
 311.451 +}
 311.452 +
 311.453 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.454 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.455 +                     Object arg15, Object arg16, Object arg17, Object arg18) throws Exception{
 311.456 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 311.457 +	                   arg16, arg17, arg18);
 311.458 +}
 311.459 +
 311.460 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.461 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.462 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) throws Exception{
 311.463 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 311.464 +	                   arg16, arg17, arg18, arg19);
 311.465 +}
 311.466 +
 311.467 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.468 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.469 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
 311.470 +		throws Exception{
 311.471 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 311.472 +	                   arg16, arg17, arg18, arg19, arg20);
 311.473 +}
 311.474 +
 311.475 +public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
 311.476 +                     Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
 311.477 +                     Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20,
 311.478 +                     Object... args)
 311.479 +		throws Exception{
 311.480 +	return fn().invoke(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15,
 311.481 +	                   arg16, arg17, arg18, arg19, arg20, args);
 311.482 +}
 311.483 +
 311.484 +public Object applyTo(ISeq arglist) throws Exception{
 311.485 +	return AFn.applyToHelper(this, arglist);
 311.486 +}
 311.487 +
 311.488 +static IFn assoc = new AFn(){
 311.489 +    @Override
 311.490 +    public Object invoke(Object m, Object k, Object v) throws Exception {
 311.491 +        return RT.assoc(m, k, v);
 311.492 +    }
 311.493 +};
 311.494 +static IFn dissoc = new AFn() {
 311.495 +    @Override
 311.496 +    public Object invoke(Object c, Object k) throws Exception {
 311.497 +        return RT.dissoc(c, k);
 311.498 +    }
 311.499 +};
 311.500 +}
   312.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   312.2 +++ b/src/clojure/lang/XMLHandler.java	Sat Aug 21 06:25:44 2010 -0400
   312.3 @@ -0,0 +1,89 @@
   312.4 +/**
   312.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   312.6 + *   The use and distribution terms for this software are covered by the
   312.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   312.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   312.9 + *   By using this software in any fashion, you are agreeing to be bound by
  312.10 + * 	 the terms of this license.
  312.11 + *   You must not remove this notice, or any other, from this software.
  312.12 + **/
  312.13 +
  312.14 +/* rich Dec 17, 2007 */
  312.15 +
  312.16 +package clojure.lang;
  312.17 +
  312.18 +import org.xml.sax.Attributes;
  312.19 +import org.xml.sax.ContentHandler;
  312.20 +import org.xml.sax.Locator;
  312.21 +import org.xml.sax.SAXException;
  312.22 +import org.xml.sax.helpers.DefaultHandler;
  312.23 +
  312.24 +public class XMLHandler extends DefaultHandler{
  312.25 +ContentHandler h;
  312.26 +
  312.27 +
  312.28 +public XMLHandler(ContentHandler h){
  312.29 +	this.h = h;
  312.30 +}
  312.31 +
  312.32 +public void setDocumentLocator(Locator locator){
  312.33 +	h.setDocumentLocator(locator);
  312.34 +}
  312.35 +
  312.36 +public void startDocument() throws SAXException{
  312.37 +	h.startDocument();
  312.38 +}
  312.39 +
  312.40 +public void endDocument() throws SAXException{
  312.41 +	h.endDocument();
  312.42 +}
  312.43 +
  312.44 +public void startPrefixMapping(String prefix, String uri) throws SAXException{
  312.45 +	h.startPrefixMapping(prefix, uri);
  312.46 +}
  312.47 +
  312.48 +public void endPrefixMapping(String prefix) throws SAXException{
  312.49 +	h.endPrefixMapping(prefix);
  312.50 +}
  312.51 +
  312.52 +public void startElement(String uri, String localName, String qName, Attributes atts) throws SAXException{
  312.53 +	h.startElement(uri, localName, qName, atts);
  312.54 +}
  312.55 +
  312.56 +public void endElement(String uri, String localName, String qName) throws SAXException{
  312.57 +	h.endElement(uri, localName, qName);
  312.58 +}
  312.59 +
  312.60 +public void characters(char ch[], int start, int length) throws SAXException{
  312.61 +	h.characters(ch, start, length);
  312.62 +}
  312.63 +
  312.64 +public void ignorableWhitespace(char ch[], int start, int length) throws SAXException{
  312.65 +	h.ignorableWhitespace(ch, start, length);
  312.66 +}
  312.67 +
  312.68 +public void processingInstruction(String target, String data) throws SAXException{
  312.69 +	h.processingInstruction(target, data);
  312.70 +}
  312.71 +
  312.72 +public void skippedEntity(String name) throws SAXException{
  312.73 +	h.skippedEntity(name);
  312.74 +}
  312.75 +
  312.76 +/*
  312.77 +public static void main(String[] args){
  312.78 +	try
  312.79 +		{
  312.80 +		ContentHandler dummy = new DefaultHandler();
  312.81 +		SAXParserFactory f =  SAXParserFactory.newInstance();
  312.82 +		//f.setNamespaceAware(true);
  312.83 +		SAXParser p = f.newSAXParser();
  312.84 +		p.parse("http://arstechnica.com/journals.rssx",new XMLHandler(dummy));
  312.85 +		}
  312.86 +	catch(Exception e)
  312.87 +		{
  312.88 +		e.printStackTrace();
  312.89 +		}
  312.90 +}
  312.91 +//*/
  312.92 +}
   313.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   313.2 +++ b/src/clojure/main.clj	Sat Aug 21 06:25:44 2010 -0400
   313.3 @@ -0,0 +1,358 @@
   313.4 +;; Copyright (c) Rich Hickey All rights reserved. The use and
   313.5 +;; distribution terms for this software are covered by the Eclipse Public
   313.6 +;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found
   313.7 +;; in the file epl-v10.html at the root of this distribution. By using this
   313.8 +;; software in any fashion, you are agreeing to be bound by the terms of
   313.9 +;; this license. You must not remove this notice, or any other, from this
  313.10 +;; software.
  313.11 +
  313.12 +;; Originally contributed by Stephen C. Gilardi
  313.13 +
  313.14 +(ns ^{:doc "Top-level main function for Clojure REPL and scripts."
  313.15 +       :author "Stephen C. Gilardi and Rich Hickey"}
  313.16 +  clojure.main
  313.17 +  (:refer-clojure :exclude [with-bindings])
  313.18 +  (:import (clojure.lang Compiler Compiler$CompilerException
  313.19 +                         LineNumberingPushbackReader RT)))
  313.20 +
  313.21 +(declare main)
  313.22 +
  313.23 +(defmacro with-bindings
  313.24 +  "Executes body in the context of thread-local bindings for several vars
  313.25 +  that often need to be set!: *ns* *warn-on-reflection* *math-context*
  313.26 +  *print-meta* *print-length* *print-level* *compile-path*
  313.27 +  *command-line-args* *1 *2 *3 *e"
  313.28 +  [& body]
  313.29 +  `(binding [*ns* *ns*
  313.30 +             *warn-on-reflection* *warn-on-reflection*
  313.31 +             *math-context* *math-context*
  313.32 +             *print-meta* *print-meta*
  313.33 +             *print-length* *print-length*
  313.34 +             *print-level* *print-level*
  313.35 +             *compile-path* (System/getProperty "clojure.compile.path" "classes")
  313.36 +             *command-line-args* *command-line-args*
  313.37 +             *assert* *assert*
  313.38 +             *1 nil
  313.39 +             *2 nil
  313.40 +             *3 nil
  313.41 +             *e nil]
  313.42 +     ~@body))
  313.43 +
  313.44 +(defn repl-prompt
  313.45 +  "Default :prompt hook for repl"
  313.46 +  []
  313.47 +  (printf "%s=> " (ns-name *ns*)))
  313.48 +
  313.49 +(defn skip-if-eol
  313.50 +  "If the next character on stream s is a newline, skips it, otherwise
  313.51 +  leaves the stream untouched. Returns :line-start, :stream-end, or :body
  313.52 +  to indicate the relative location of the next character on s. The stream
  313.53 +  must either be an instance of LineNumberingPushbackReader or duplicate
  313.54 +  its behavior of both supporting .unread and collapsing all of CR, LF, and
  313.55 +  CRLF to a single \\newline."
  313.56 +  [s]
  313.57 +  (let [c (.read s)]
  313.58 +    (cond
  313.59 +     (= c (int \newline)) :line-start
  313.60 +     (= c -1) :stream-end
  313.61 +     :else (do (.unread s c) :body))))
  313.62 +
  313.63 +(defn skip-whitespace
  313.64 +  "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
  313.65 +  or :body to indicate the relative location of the next character on s.
  313.66 +  Interprets comma as whitespace and semicolon as comment to end of line.
  313.67 +  Does not interpret #! as comment to end of line because only one
  313.68 +  character of lookahead is available. The stream must either be an
  313.69 +  instance of LineNumberingPushbackReader or duplicate its behavior of both
  313.70 +  supporting .unread and collapsing all of CR, LF, and CRLF to a single
  313.71 +  \\newline."
  313.72 +  [s]
  313.73 +  (loop [c (.read s)]
  313.74 +    (cond
  313.75 +     (= c (int \newline)) :line-start
  313.76 +     (= c -1) :stream-end
  313.77 +     (= c (int \;)) (do (.readLine s) :line-start)
  313.78 +     (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s))
  313.79 +     :else (do (.unread s c) :body))))
  313.80 +
  313.81 +(defn repl-read
  313.82 +  "Default :read hook for repl. Reads from *in* which must either be an
  313.83 +  instance of LineNumberingPushbackReader or duplicate its behavior of both
  313.84 +  supporting .unread and collapsing all of CR, LF, and CRLF into a single
  313.85 +  \\newline. repl-read:
  313.86 +    - skips whitespace, then
  313.87 +      - returns request-prompt on start of line, or
  313.88 +      - returns request-exit on end of stream, or
  313.89 +      - reads an object from the input stream, then
  313.90 +        - skips the next input character if it's end of line, then
  313.91 +        - returns the object."
  313.92 +  [request-prompt request-exit]
  313.93 +  (or ({:line-start request-prompt :stream-end request-exit}
  313.94 +       (skip-whitespace *in*))
  313.95 +      (let [input (read)]
  313.96 +        (skip-if-eol *in*)
  313.97 +        input)))
  313.98 +
  313.99 +(defn- root-cause
 313.100 +  "Returns the initial cause of an exception or error by peeling off all of
 313.101 +  its wrappers"
 313.102 +  [^Throwable throwable]
 313.103 +  (loop [cause throwable]
 313.104 +    (if-let [cause (.getCause cause)]
 313.105 +      (recur cause)
 313.106 +      cause)))
 313.107 +
 313.108 +(defn repl-exception
 313.109 +  "Returns CompilerExceptions in tact, but only the root cause of other
 313.110 +  throwables"
 313.111 +  [throwable]
 313.112 +  (if (instance? Compiler$CompilerException throwable)
 313.113 +    throwable
 313.114 +    (root-cause throwable)))
 313.115 +
 313.116 +(defn repl-caught
 313.117 +  "Default :caught hook for repl"
 313.118 +  [e]
 313.119 +  (.println *err* (repl-exception e)))
 313.120 +
 313.121 +(defn repl
 313.122 +  "Generic, reusable, read-eval-print loop. By default, reads from *in*,
 313.123 +  writes to *out*, and prints exception summaries to *err*. If you use the
 313.124 +  default :read hook, *in* must either be an instance of
 313.125 +  LineNumberingPushbackReader or duplicate its behavior of both supporting
 313.126 +  .unread and collapsing CR, LF, and CRLF into a single \\newline. Options
 313.127 +  are sequential keyword-value pairs. Available options and their defaults:
 313.128 +
 313.129 +     - :init, function of no arguments, initialization hook called with
 313.130 +       bindings for set!-able vars in place.
 313.131 +       default: #()
 313.132 +
 313.133 +     - :need-prompt, function of no arguments, called before each
 313.134 +       read-eval-print except the first, the user will be prompted if it
 313.135 +       returns true.
 313.136 +       default: (if (instance? LineNumberingPushbackReader *in*)
 313.137 +                  #(.atLineStart *in*)
 313.138 +                  #(identity true))
 313.139 +
 313.140 +     - :prompt, function of no arguments, prompts for more input.
 313.141 +       default: repl-prompt
 313.142 +
 313.143 +     - :flush, function of no arguments, flushes output
 313.144 +       default: flush
 313.145 +
 313.146 +     - :read, function of two arguments, reads from *in*:
 313.147 +         - returns its first argument to request a fresh prompt
 313.148 +           - depending on need-prompt, this may cause the repl to prompt
 313.149 +             before reading again
 313.150 +         - returns its second argument to request an exit from the repl
 313.151 +         - else returns the next object read from the input stream
 313.152 +       default: repl-read
 313.153 +
 313.154 +     - :eval, funtion of one argument, returns the evaluation of its
 313.155 +       argument
 313.156 +       default: eval
 313.157 +
 313.158 +     - :print, function of one argument, prints its argument to the output
 313.159 +       default: prn
 313.160 +
 313.161 +     - :caught, function of one argument, a throwable, called when
 313.162 +       read, eval, or print throws an exception or error
 313.163 +       default: repl-caught"
 313.164 +  [& options]
 313.165 +  (let [cl (.getContextClassLoader (Thread/currentThread))]
 313.166 +    (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl)))
 313.167 +  (let [{:keys [init need-prompt prompt flush read eval print caught]
 313.168 +         :or {init        #()
 313.169 +              need-prompt (if (instance? LineNumberingPushbackReader *in*)
 313.170 +                            #(.atLineStart ^LineNumberingPushbackReader *in*)
 313.171 +                            #(identity true))
 313.172 +              prompt      repl-prompt
 313.173 +              flush       flush
 313.174 +              read        repl-read
 313.175 +              eval        eval
 313.176 +              print       prn
 313.177 +              caught      repl-caught}}
 313.178 +        (apply hash-map options)
 313.179 +        request-prompt (Object.)
 313.180 +        request-exit (Object.)
 313.181 +        read-eval-print
 313.182 +        (fn []
 313.183 +          (try
 313.184 +           (let [input (read request-prompt request-exit)]
 313.185 +             (or (#{request-prompt request-exit} input)
 313.186 +                 (let [value (eval input)]
 313.187 +                   (print value)
 313.188 +                   (set! *3 *2)
 313.189 +                   (set! *2 *1)
 313.190 +                   (set! *1 value))))
 313.191 +           (catch Throwable e
 313.192 +             (caught e)
 313.193 +             (set! *e e))))]
 313.194 +    (with-bindings
 313.195 +     (try
 313.196 +      (init)
 313.197 +      (catch Throwable e
 313.198 +        (caught e)
 313.199 +        (set! *e e)))
 313.200 +     (use '[clojure.repl :only (source apropos dir)])
 313.201 +     (use '[clojure.java.javadoc :only (javadoc)])
 313.202 +     (use '[clojure.pprint :only (pp pprint)])
 313.203 +     (prompt)
 313.204 +     (flush)
 313.205 +     (loop []
 313.206 +       (when-not 
 313.207 +       	 (try (= (read-eval-print) request-exit)
 313.208 +	  (catch Throwable e
 313.209 +	   (caught e)
 313.210 +	   (set! *e e)
 313.211 +	   nil))
 313.212 +         (when (need-prompt)
 313.213 +           (prompt)
 313.214 +           (flush))
 313.215 +         (recur))))))
 313.216 +
 313.217 +(defn load-script
 313.218 +  "Loads Clojure source from a file or resource given its path. Paths
 313.219 +  beginning with @ or @/ are considered relative to classpath."
 313.220 +  [^String path]
 313.221 +  (if (.startsWith path "@")
 313.222 +    (RT/loadResourceScript
 313.223 +     (.substring path (if (.startsWith path "@/") 2 1)))
 313.224 +    (Compiler/loadFile path)))
 313.225 +
 313.226 +(defn- init-opt
 313.227 +  "Load a script"
 313.228 +  [path]
 313.229 +  (load-script path))
 313.230 +
 313.231 +(defn- eval-opt
 313.232 +  "Evals expressions in str, prints each non-nil result using prn"
 313.233 +  [str]
 313.234 +  (let [eof (Object.)
 313.235 +        reader (LineNumberingPushbackReader. (java.io.StringReader. str))]
 313.236 +      (loop [input (read reader false eof)]
 313.237 +        (when-not (= input eof)
 313.238 +          (let [value (eval input)]
 313.239 +            (when-not (nil? value)
 313.240 +              (prn value))
 313.241 +            (recur (read reader false eof)))))))
 313.242 +
 313.243 +(defn- init-dispatch
 313.244 +  "Returns the handler associated with an init opt"
 313.245 +  [opt]
 313.246 +  ({"-i"     init-opt
 313.247 +    "--init" init-opt
 313.248 +    "-e"     eval-opt
 313.249 +    "--eval" eval-opt} opt))
 313.250 +
 313.251 +(defn- initialize
 313.252 +  "Common initialize routine for repl, script, and null opts"
 313.253 +  [args inits]
 313.254 +  (in-ns 'user)
 313.255 +  (set! *command-line-args* args)
 313.256 +  (doseq [[opt arg] inits]
 313.257 +    ((init-dispatch opt) arg)))
 313.258 +
 313.259 +(defn- repl-opt
 313.260 +  "Start a repl with args and inits. Print greeting if no eval options were
 313.261 +  present"
 313.262 +  [[_ & args] inits]
 313.263 +  (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
 313.264 +    (println "Clojure" (clojure-version)))
 313.265 +  (repl :init #(initialize args inits))
 313.266 +  (prn)
 313.267 +  (System/exit 0))
 313.268 +
 313.269 +(defn- script-opt
 313.270 +  "Run a script from a file, resource, or standard in with args and inits"
 313.271 +  [[path & args] inits]
 313.272 +  (with-bindings
 313.273 +    (initialize args inits)
 313.274 +    (if (= path "-")
 313.275 +      (load-reader *in*)
 313.276 +      (load-script path))))
 313.277 +
 313.278 +(defn- null-opt
 313.279 +  "No repl or script opt present, just bind args and run inits"
 313.280 +  [args inits]
 313.281 +  (with-bindings
 313.282 +    (initialize args inits)))
 313.283 +
 313.284 +(defn- help-opt
 313.285 +  "Print help text for main"
 313.286 +  [_ _]
 313.287 +  (println (:doc (meta (var main)))))
 313.288 +
 313.289 +(defn- main-dispatch
 313.290 +  "Returns the handler associated with a main option"
 313.291 +  [opt]
 313.292 +  (or
 313.293 +   ({"-r"     repl-opt
 313.294 +     "--repl" repl-opt
 313.295 +     nil      null-opt
 313.296 +     "-h"     help-opt
 313.297 +     "--help" help-opt
 313.298 +     "-?"     help-opt} opt)
 313.299 +   script-opt))
 313.300 +
 313.301 +(defn- legacy-repl
 313.302 +  "Called by the clojure.lang.Repl.main stub to run a repl with args
 313.303 +  specified the old way"
 313.304 +  [args]
 313.305 +  (println "WARNING: clojure.lang.Repl is deprecated.
 313.306 +Instead, use clojure.main like this:
 313.307 +java -cp clojure.jar clojure.main -i init.clj -r args...")
 313.308 +  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
 313.309 +    (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits))))
 313.310 +
 313.311 +(defn- legacy-script
 313.312 +  "Called by the clojure.lang.Script.main stub to run a script with args
 313.313 +  specified the old way"
 313.314 +  [args]
 313.315 +  (println "WARNING: clojure.lang.Script is deprecated.
 313.316 +Instead, use clojure.main like this:
 313.317 +java -cp clojure.jar clojure.main -i init.clj script.clj args...")
 313.318 +  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
 313.319 +    (null-opt args (map vector (repeat "-i") inits))))
 313.320 +
 313.321 +(defn main
 313.322 +  "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*]
 313.323 +
 313.324 +  With no options or args, runs an interactive Read-Eval-Print Loop
 313.325 +
 313.326 +  init options:
 313.327 +    -i, --init path   Load a file or resource
 313.328 +    -e, --eval string Evaluate expressions in string; print non-nil values
 313.329 +
 313.330 +  main options:
 313.331 +    -r, --repl        Run a repl
 313.332 +    path              Run a script from from a file or resource
 313.333 +    -                 Run a script from standard input
 313.334 +    -h, -?, --help    Print this help message and exit
 313.335 +
 313.336 +  operation:
 313.337 +
 313.338 +    - Establishes thread-local bindings for commonly set!-able vars
 313.339 +    - Enters the user namespace
 313.340 +    - Binds *command-line-args* to a seq of strings containing command line
 313.341 +      args that appear after any main option
 313.342 +    - Runs all init options in order
 313.343 +    - Runs a repl or script if requested
 313.344 +
 313.345 +  The init options may be repeated and mixed freely, but must appear before
 313.346 +  any main option. The appearance of any eval option before running a repl
 313.347 +  suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\".
 313.348 +
 313.349 +  Paths may be absolute or relative in the filesystem or relative to
 313.350 +  classpath. Classpath-relative paths have prefix of @ or @/"
 313.351 +  [& args]
 313.352 +  (try
 313.353 +   (if args
 313.354 +     (loop [[opt arg & more :as args] args inits []]
 313.355 +       (if (init-dispatch opt)
 313.356 +         (recur more (conj inits [opt arg]))
 313.357 +         ((main-dispatch opt) args inits)))
 313.358 +     (repl-opt nil nil))
 313.359 +   (finally 
 313.360 +     (flush))))
 313.361 +
   314.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   314.2 +++ b/src/clojure/main.java	Sat Aug 21 06:25:44 2010 -0400
   314.3 @@ -0,0 +1,39 @@
   314.4 +/**
   314.5 + *   Copyright (c) Rich Hickey. All rights reserved.
   314.6 + *   The use and distribution terms for this software are covered by the
   314.7 + *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   314.8 + *   which can be found in the file epl-v10.html at the root of this distribution.
   314.9 + *   By using this software in any fashion, you are agreeing to be bound by
  314.10 + * 	 the terms of this license.
  314.11 + *   You must not remove this notice, or any other, from this software.
  314.12 + **/
  314.13 +
  314.14 +package clojure;
  314.15 +
  314.16 +import clojure.lang.Symbol;
  314.17 +import clojure.lang.Var;
  314.18 +import clojure.lang.RT;
  314.19 +
  314.20 +public class main{
  314.21 +
  314.22 +final static private Symbol CLOJURE_MAIN = Symbol.intern("clojure.main");
  314.23 +final static private Var REQUIRE = RT.var("clojure.core", "require");
  314.24 +final static private Var LEGACY_REPL = RT.var("clojure.main", "legacy-repl");
  314.25 +final static private Var LEGACY_SCRIPT = RT.var("clojure.main", "legacy-script");
  314.26 +final static private Var MAIN = RT.var("clojure.main", "main");
  314.27 +
  314.28 +public static void legacy_repl(String[] args) throws Exception{
  314.29 +    REQUIRE.invoke(CLOJURE_MAIN);
  314.30 +    LEGACY_REPL.invoke(RT.seq(args));
  314.31 +}
  314.32 +
  314.33 +public static void legacy_script(String[] args) throws Exception{
  314.34 +    REQUIRE.invoke(CLOJURE_MAIN);
  314.35 +    LEGACY_SCRIPT.invoke(RT.seq(args));
  314.36 +}
  314.37 +
  314.38 +public static void main(String[] args) throws Exception{
  314.39 +    REQUIRE.invoke(CLOJURE_MAIN);
  314.40 +    MAIN.applyTo(RT.seq(args));
  314.41 +}
  314.42 +}
   315.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   315.2 +++ b/src/clojure/parallel.clj	Sat Aug 21 06:25:44 2010 -0400
   315.3 @@ -0,0 +1,250 @@
   315.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   315.5 +;   The use and distribution terms for this software are covered by the
   315.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   315.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   315.8 +;   By using this software in any fashion, you are agreeing to be bound by
   315.9 +;   the terms of this license.
  315.10 +;   You must not remove this notice, or any other, from this software.
  315.11 +
  315.12 +(ns ^{:doc "DEPRECATED Wrapper of the ForkJoin library (JSR-166)."
  315.13 +       :author "Rich Hickey"}
  315.14 +    clojure.parallel)
  315.15 +(alias 'parallel 'clojure.parallel)
  315.16 +
  315.17 +(comment "
  315.18 +The parallel library wraps the ForkJoin library scheduled for inclusion in JDK 7:
  315.19 +
  315.20 +http://gee.cs.oswego.edu/dl/concurrency-interest/index.html
  315.21 +
  315.22 +You'll need jsr166y.jar in your classpath in order to use this
  315.23 +library.  The basic idea is that Clojure collections, and most
  315.24 +efficiently vectors, can be turned into parallel arrays for use by
  315.25 +this library with the function par, although most of the functions
  315.26 +take collections and will call par if needed, so normally you will
  315.27 +only need to call par explicitly in order to attach bound/filter/map
  315.28 +ops. Parallel arrays support the attachment of bounds, filters and
  315.29 +mapping functions prior to realization/calculation, which happens as
  315.30 +the result of any of several operations on the
  315.31 +array (pvec/psort/pfilter-nils/pfilter-dupes). Rather than perform
  315.32 +composite operations in steps, as would normally be done with
  315.33 +sequences, maps and filters are instead attached and thus composed by
  315.34 +providing ops to par. Note that there is an order sensitivity to the
  315.35 +attachments - bounds precede filters precede mappings.  All operations
  315.36 +then happen in parallel, using multiple threads and a sophisticated
  315.37 +work-stealing system supported by fork-join, either when the array is
  315.38 +realized, or to perform aggregate operations like preduce/pmin/pmax
  315.39 +etc. A parallel array can be realized into a Clojure vector using
  315.40 +pvec.
  315.41 +")
  315.42 +
  315.43 +(import '(jsr166y.forkjoin ParallelArray ParallelArrayWithBounds ParallelArrayWithFilter 
  315.44 +                           ParallelArrayWithMapping 
  315.45 +                           Ops$Op Ops$BinaryOp Ops$Reducer Ops$Predicate Ops$BinaryPredicate 
  315.46 +                           Ops$IntAndObjectPredicate Ops$IntAndObjectToObject))
  315.47 +
  315.48 +(defn- op [f]
  315.49 +  (proxy [Ops$Op] []
  315.50 +    (op [x] (f x))))
  315.51 +
  315.52 +(defn- binary-op [f]
  315.53 +  (proxy [Ops$BinaryOp] []
  315.54 +    (op [x y] (f x y))))
  315.55 +
  315.56 +(defn- int-and-object-to-object [f]
  315.57 +  (proxy [Ops$IntAndObjectToObject] []
  315.58 +    (op [i x] (f x i))))
  315.59 +
  315.60 +(defn- reducer [f]
  315.61 +  (proxy [Ops$Reducer] []
  315.62 +    (op [x y] (f x y))))
  315.63 +
  315.64 +(defn- predicate [f]
  315.65 +  (proxy [Ops$Predicate] []
  315.66 +    (op [x] (boolean (f x)))))
  315.67 +
  315.68 +(defn- binary-predicate [f]
  315.69 +  (proxy [Ops$BinaryPredicate] []
  315.70 +    (op [x y] (boolean (f x y)))))
  315.71 +
  315.72 +(defn- int-and-object-predicate [f]
  315.73 +  (proxy [Ops$IntAndObjectPredicate] []
  315.74 +    (op [i x] (boolean (f x i)))))
  315.75 +
  315.76 +(defn par
  315.77 +  "Creates a parallel array from coll. ops, if supplied, perform
  315.78 +  on-the-fly filtering or transformations during parallel realization
  315.79 +  or calculation. ops form a chain, and bounds must precede filters,
  315.80 +  must precede maps. ops must be a set of keyword value pairs of the
  315.81 +  following forms:
  315.82 +
  315.83 +     :bound [start end] 
  315.84 +
  315.85 +  Only elements from start (inclusive) to end (exclusive) will be
  315.86 +  processed when the array is realized.
  315.87 +
  315.88 +     :filter pred 
  315.89 +
  315.90 +  Filter preds remove elements from processing when the array is realized. pred
  315.91 +  must be a function of one argument whose return will be processed
  315.92 +  via boolean.
  315.93 +
  315.94 +     :filter-index pred2 
  315.95 +
  315.96 +  pred2 must be a function of two arguments, which will be an element
  315.97 +  of the collection and the corresponding index, whose return will be
  315.98 +  processed via boolean.
  315.99 +
 315.100 +     :filter-with [pred2 coll2] 
 315.101 +
 315.102 +  pred2 must be a function of two arguments, which will be
 315.103 +  corresponding elements of the 2 collections.
 315.104 +
 315.105 +     :map f 
 315.106 +
 315.107 +  Map fns will be used to transform elements when the array is
 315.108 +  realized. f must be a function of one argument.
 315.109 +
 315.110 +     :map-index f2 
 315.111 +
 315.112 +  f2 must be a function of two arguments, which will be an element of
 315.113 +  the collection and the corresponding index.
 315.114 +
 315.115 +     :map-with [f2 coll2]
 315.116 +
 315.117 +  f2 must be a function of two arguments, which will be corresponding
 315.118 +  elements of the 2 collections."
 315.119 +
 315.120 +  ([coll] 
 315.121 +     (if (instance? ParallelArrayWithMapping coll)
 315.122 +       coll
 315.123 +       (. ParallelArray createUsingHandoff  
 315.124 +        (to-array coll) 
 315.125 +        (. ParallelArray defaultExecutor))))
 315.126 +  ([coll & ops]
 315.127 +     (reduce (fn [pa [op args]] 
 315.128 +                 (cond
 315.129 +                  (= op :bound) (. pa withBounds (args 0) (args 1))
 315.130 +                  (= op :filter) (. pa withFilter (predicate args))
 315.131 +                  (= op :filter-with) (. pa withFilter (binary-predicate (args 0)) (par (args 1)))
 315.132 +                  (= op :filter-index) (. pa withIndexedFilter (int-and-object-predicate args))
 315.133 +                  (= op :map) (. pa withMapping (parallel/op args))
 315.134 +                  (= op :map-with) (. pa withMapping (binary-op (args 0)) (par (args 1)))
 315.135 +                  (= op :map-index) (. pa withIndexedMapping (int-and-object-to-object args))
 315.136 +                  :else (throw (Exception. (str "Unsupported par op: " op)))))
 315.137 +             (par coll) 
 315.138 +             (partition 2 ops))))
 315.139 +
 315.140 +;;;;;;;;;;;;;;;;;;;;; aggregate operations ;;;;;;;;;;;;;;;;;;;;;;
 315.141 +(defn pany
 315.142 +  "Returns some (random) element of the coll if it satisfies the bound/filter/map"
 315.143 +  [coll] 
 315.144 +  (. (par coll) any))
 315.145 +
 315.146 +(defn pmax
 315.147 +  "Returns the maximum element, presuming Comparable elements, unless
 315.148 +  a Comparator comp is supplied"
 315.149 +  ([coll] (. (par coll) max))
 315.150 +  ([coll comp] (. (par coll) max comp)))
 315.151 +
 315.152 +(defn pmin
 315.153 +  "Returns the minimum element, presuming Comparable elements, unless
 315.154 +  a Comparator comp is supplied"
 315.155 +  ([coll] (. (par coll) min))
 315.156 +  ([coll comp] (. (par coll) min comp)))
 315.157 +
 315.158 +(defn- summary-map [s]
 315.159 +  {:min (.min s) :max (.max s) :size (.size s) :min-index (.indexOfMin s) :max-index (.indexOfMax s)})
 315.160 +
 315.161 +(defn psummary 
 315.162 +  "Returns a map of summary statistics (min. max, size, min-index, max-index, 
 315.163 +  presuming Comparable elements, unless a Comparator comp is supplied"
 315.164 +  ([coll] (summary-map (. (par coll) summary)))
 315.165 +  ([coll comp] (summary-map (. (par coll) summary comp))))
 315.166 +
 315.167 +(defn preduce 
 315.168 +  "Returns the reduction of the realized elements of coll
 315.169 +  using function f. Note f will not necessarily be called
 315.170 +  consecutively, and so must be commutative. Also note that 
 315.171 +  (f base an-element) might be performed many times, i.e. base is not
 315.172 +  an initial value as with sequential reduce."
 315.173 +  [f base coll]
 315.174 +  (. (par coll) (reduce (reducer f) base)))
 315.175 +
 315.176 +;;;;;;;;;;;;;;;;;;;;; collection-producing operations ;;;;;;;;;;;;;;;;;;;;;;
 315.177 +
 315.178 +(defn- pa-to-vec [pa]
 315.179 +  (vec (. pa getArray)))
 315.180 +
 315.181 +(defn- pall
 315.182 +  "Realizes a copy of the coll as a parallel array, with any bounds/filters/maps applied"
 315.183 +  [coll]
 315.184 +  (if (instance? ParallelArrayWithMapping coll)
 315.185 +    (. coll all)
 315.186 +    (par coll)))
 315.187 +
 315.188 +(defn pvec 
 315.189 +  "Returns the realized contents of the parallel array pa as a Clojure vector"
 315.190 +  [pa] (pa-to-vec (pall pa)))
 315.191 +
 315.192 +(defn pdistinct
 315.193 +  "Returns a parallel array of the distinct elements of coll"
 315.194 +  [coll]
 315.195 +  (pa-to-vec (. (pall coll) allUniqueElements)))
 315.196 +
 315.197 +;this doesn't work, passes null to reducer?
 315.198 +(defn- pcumulate [coll f init]
 315.199 +  (.. (pall coll) (precumulate (reducer f) init)))
 315.200 +
 315.201 +(defn psort 
 315.202 +  "Returns a new vector consisting of the realized items in coll, sorted, 
 315.203 +  presuming Comparable elements, unless a Comparator comp is supplied"
 315.204 +  ([coll] (pa-to-vec (. (pall coll) sort)))
 315.205 +  ([coll comp] (pa-to-vec (. (pall coll) sort comp))))
 315.206 +
 315.207 +(defn pfilter-nils
 315.208 +  "Returns a vector containing the non-nil (realized) elements of coll"
 315.209 +  [coll]
 315.210 +  (pa-to-vec (. (pall coll) removeNulls)))
 315.211 +
 315.212 +(defn pfilter-dupes 
 315.213 +  "Returns a vector containing the (realized) elements of coll, 
 315.214 +  without any consecutive duplicates"
 315.215 +  [coll]
 315.216 +  (pa-to-vec (. (pall coll) removeConsecutiveDuplicates)))
 315.217 +
 315.218 +
 315.219 +(comment
 315.220 +(load-file "src/parallel.clj")
 315.221 +(refer 'parallel)
 315.222 +(pdistinct [1 2 3 2 1])
 315.223 +;(pcumulate [1 2 3 2 1] + 0) ;broken, not exposed
 315.224 +(def a (make-array Object 1000000))
 315.225 +(dotimes i (count a)
 315.226 +  (aset a i (rand-int i)))
 315.227 +(time (reduce + 0 a))
 315.228 +(time (preduce + 0 a))
 315.229 +(time (count (distinct a)))
 315.230 +(time (count (pdistinct a)))
 315.231 +
 315.232 +(preduce + 0 [1 2 3 2 1])
 315.233 +(preduce + 0 (psort a))
 315.234 +(pvec (par [11 2 3 2] :filter-index (fn [x i] (> i x))))
 315.235 +(pvec (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]]))
 315.236 +
 315.237 +(psummary ;or pvec/pmax etc
 315.238 + (par [11 2 3 2] 
 315.239 +      :filter-with [(fn [x y] (> y x)) 
 315.240 +                    [110 2 33 2]]
 315.241 +      :map #(* % 2)))
 315.242 +
 315.243 +(preduce + 0
 315.244 +  (par [11 2 3 2] 
 315.245 +       :filter-with [< [110 2 33 2]]))
 315.246 +
 315.247 +(time (reduce + 0 (map #(* % %) (range 1000000))))
 315.248 +(time (preduce + 0 (par (range 1000000) :map-index *)))
 315.249 +(def v (range 1000000))
 315.250 +(time (preduce + 0 (par v :map-index *)))
 315.251 +(time (preduce + 0 (par v :map  #(* % %))))
 315.252 +(time (reduce + 0 (map #(* % %) v)))
 315.253 +)
 315.254 \ No newline at end of file
   316.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   316.2 +++ b/src/clojure/pprint.clj	Sat Aug 21 06:25:44 2010 -0400
   316.3 @@ -0,0 +1,48 @@
   316.4 +;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure
   316.5 +
   316.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   316.7 +;   The use and distribution terms for this software are covered by the
   316.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   316.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  316.10 +;   By using this software in any fashion, you are agreeing to be bound by
  316.11 +;   the terms of this license.
  316.12 +;   You must not remove this notice, or any other, from this software.
  316.13 +
  316.14 +;; Author: Tom Faulhaber
  316.15 +;; April 3, 2009
  316.16 +
  316.17 +(ns 
  316.18 +    ^{:author "Tom Faulhaber",
  316.19 +      :doc "A Pretty Printer for Clojure
  316.20 +
  316.21 +clojure.pprint implements a flexible system for printing structured data
  316.22 +in a pleasing, easy-to-understand format. Basic use of the pretty printer is 
  316.23 +simple, just call pprint instead of println. More advanced users can use 
  316.24 +the building blocks provided to create custom output formats. 
  316.25 +
  316.26 +Out of the box, pprint supports a simple structured format for basic data 
  316.27 +and a specialized format for Clojure source code. More advanced formats, 
  316.28 +including formats that don't look like Clojure data at all like XML and 
  316.29 +JSON, can be rendered by creating custom dispatch functions. 
  316.30 +
  316.31 +In addition to the pprint function, this module contains cl-format, a text 
  316.32 +formatting function which is fully compatible with the format function in 
  316.33 +Common Lisp. Because pretty printing directives are directly integrated with
  316.34 +cl-format, it supports very concise custom dispatch. It also provides
  316.35 +a more powerful alternative to Clojure's standard format function.
  316.36 +
  316.37 +See documentation for pprint and cl-format for more information or 
  316.38 +complete documentation on the the clojure web site on github.",
  316.39 +       :added "1.2"}
  316.40 +    clojure.pprint
  316.41 +    (:refer-clojure :exclude (deftype)))
  316.42 +
  316.43 +
  316.44 +(load "pprint/utilities")
  316.45 +(load "pprint/column_writer")
  316.46 +(load "pprint/pretty_writer")
  316.47 +(load "pprint/pprint_base")
  316.48 +(load "pprint/cl_format")
  316.49 +(load "pprint/dispatch")
  316.50 +
  316.51 +nil
   317.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   317.2 +++ b/src/clojure/pprint/cl_format.clj	Sat Aug 21 06:25:44 2010 -0400
   317.3 @@ -0,0 +1,1890 @@
   317.4 +;;; cl_format.clj -- part of the pretty printer for Clojure
   317.5 +
   317.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   317.7 +;   The use and distribution terms for this software are covered by the
   317.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   317.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  317.10 +;   By using this software in any fashion, you are agreeing to be bound by
  317.11 +;   the terms of this license.
  317.12 +;   You must not remove this notice, or any other, from this software.
  317.13 +
  317.14 +;; Author: Tom Faulhaber
  317.15 +;; April 3, 2009
  317.16 +
  317.17 +
  317.18 +;; This module implements the Common Lisp compatible format function as documented
  317.19 +;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at:
  317.20 +;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000)
  317.21 +
  317.22 +(in-ns 'clojure.pprint)
  317.23 +
  317.24 +;;; Forward references
  317.25 +(declare compile-format)
  317.26 +(declare execute-format)
  317.27 +(declare init-navigator)
  317.28 +;;; End forward references
  317.29 +
  317.30 +(defn cl-format 
  317.31 +  "An implementation of a Common Lisp compatible format function. cl-format formats its
  317.32 +arguments to an output stream or string based on the format control string given. It 
  317.33 +supports sophisticated formatting of structured data.
  317.34 +
  317.35 +Writer is an instance of java.io.Writer, true to output to *out* or nil to output 
  317.36 +to a string, format-in is the format control string and the remaining arguments 
  317.37 +are the data to be formatted.
  317.38 +
  317.39 +The format control string is a string to be output with embedded 'format directives' 
  317.40 +describing how to format the various arguments passed in.
  317.41 +
  317.42 +If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format 
  317.43 +returns nil.
  317.44 +
  317.45 +For example:
  317.46 + (let [results [46 38 22]]
  317.47 +        (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" 
  317.48 +                   (count results) results))
  317.49 +
  317.50 +Prints to *out*:
  317.51 + There are 3 results: 46, 38, 22
  317.52 +
  317.53 +Detailed documentation on format control strings is available in the \"Common Lisp the 
  317.54 +Language, 2nd edition\", Chapter 22 (available online at:
  317.55 +http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) 
  317.56 +and in the Common Lisp HyperSpec at 
  317.57 +http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm
  317.58 +"
  317.59 +  {:added "1.2",
  317.60 +   :see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" 
  317.61 +               "Common Lisp the Language"]
  317.62 +              ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm"
  317.63 +               "Common Lisp HyperSpec"]]}
  317.64 +  [writer format-in & args]
  317.65 +  (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
  317.66 +        navigator (init-navigator args)]
  317.67 +    (execute-format writer compiled-format navigator)))
  317.68 +
  317.69 +(def ^{:private true} *format-str* nil)
  317.70 +
  317.71 +(defn- format-error [message offset] 
  317.72 +  (let [full-message (str message \newline *format-str* \newline 
  317.73 +                           (apply str (repeat offset \space)) "^" \newline)]
  317.74 +    (throw (RuntimeException. full-message))))
  317.75 +
  317.76 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  317.77 +;;; Argument navigators manage the argument list
  317.78 +;;; as the format statement moves through the list
  317.79 +;;; (possibly going forwards and backwards as it does so)
  317.80 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  317.81 +
  317.82 +(defstruct ^{:private true}
  317.83 +  arg-navigator :seq :rest :pos )
  317.84 +
  317.85 +(defn- init-navigator 
  317.86 +  "Create a new arg-navigator from the sequence with the position set to 0"
  317.87 +  {:skip-wiki true}
  317.88 +  [s]
  317.89 +  (let [s (seq s)]
  317.90 +    (struct arg-navigator s s 0)))
  317.91 +
  317.92 +;; TODO call format-error with offset
  317.93 +(defn- next-arg [ navigator ]
  317.94 +  (let [ rst (:rest navigator) ]
  317.95 +    (if rst
  317.96 +      [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
  317.97 +     (throw (new Exception  "Not enough arguments for format definition")))))
  317.98 +
  317.99 +(defn- next-arg-or-nil [navigator]
 317.100 +  (let [rst (:rest navigator)]
 317.101 +    (if rst
 317.102 +      [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
 317.103 +      [nil navigator])))
 317.104 +
 317.105 +;; Get an argument off the arg list and compile it if it's not already compiled
 317.106 +(defn- get-format-arg [navigator]
 317.107 +  (let [[raw-format navigator] (next-arg navigator)
 317.108 +        compiled-format (if (instance? String raw-format) 
 317.109 +                               (compile-format raw-format)
 317.110 +                               raw-format)]
 317.111 +    [compiled-format navigator]))
 317.112 +
 317.113 +(declare relative-reposition)
 317.114 +
 317.115 +(defn- absolute-reposition [navigator position]
 317.116 +  (if (>= position (:pos navigator))
 317.117 +    (relative-reposition navigator (- (:pos navigator) position))
 317.118 +    (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position)))
 317.119 +
 317.120 +(defn- relative-reposition [navigator position]
 317.121 +  (let [newpos (+ (:pos navigator) position)]
 317.122 +    (if (neg? position)
 317.123 +      (absolute-reposition navigator newpos)
 317.124 +      (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos))))
 317.125 +
 317.126 +(defstruct ^{:private true}
 317.127 +  compiled-directive :func :def :params :offset)
 317.128 +
 317.129 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.130 +;;; When looking at the parameter list, we may need to manipulate
 317.131 +;;; the argument list as well (for 'V' and '#' parameter types).
 317.132 +;;; We hide all of this behind a function, but clients need to
 317.133 +;;; manage changing arg navigator
 317.134 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.135 +
 317.136 +;; TODO: validate parameters when they come from arg list
 317.137 +(defn- realize-parameter [[param [raw-val offset]] navigator]
 317.138 +  (let [[real-param new-navigator]
 317.139 +        (cond 
 317.140 +         (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary
 317.141 +         [raw-val navigator]
 317.142 +
 317.143 +         (= raw-val :parameter-from-args) 
 317.144 +         (next-arg navigator)
 317.145 +
 317.146 +         (= raw-val :remaining-arg-count) 
 317.147 +         [(count (:rest navigator)) navigator]
 317.148 +
 317.149 +         true 
 317.150 +         [raw-val navigator])]
 317.151 +    [[param [real-param offset]] new-navigator]))
 317.152 +         
 317.153 +(defn- realize-parameter-list [parameter-map navigator]
 317.154 +  (let [[pairs new-navigator] 
 317.155 +        (map-passing-context realize-parameter navigator parameter-map)]
 317.156 +    [(into {} pairs) new-navigator]))
 317.157 +
 317.158 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.159 +;;; Functions that support individual directives
 317.160 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.161 +
 317.162 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.163 +;;; Common handling code for ~A and ~S
 317.164 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.165 +
 317.166 +(declare opt-base-str)
 317.167 +
 317.168 +(def ^{:private true}
 317.169 +     special-radix-markers {2 "#b" 8 "#o", 16 "#x"})
 317.170 +
 317.171 +(defn- format-simple-number [n]
 317.172 +  (cond 
 317.173 +    (integer? n) (if (= *print-base* 10)
 317.174 +                   (str n (if *print-radix* "."))
 317.175 +                   (str
 317.176 +                    (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
 317.177 +                    (opt-base-str *print-base* n)))
 317.178 +    (ratio? n) (str
 317.179 +                (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
 317.180 +                (opt-base-str *print-base* (.numerator n))
 317.181 +                "/"
 317.182 +                (opt-base-str *print-base* (.denominator n)))
 317.183 +    :else nil))
 317.184 +
 317.185 +(defn- format-ascii [print-func params arg-navigator offsets]
 317.186 +  (let [ [arg arg-navigator] (next-arg arg-navigator) 
 317.187 +         ^String base-output (or (format-simple-number arg) (print-func arg))
 317.188 +         base-width (.length base-output)
 317.189 +         min-width (+ base-width (:minpad params))
 317.190 +         width (if (>= min-width (:mincol params)) 
 317.191 +                 min-width
 317.192 +                 (+ min-width 
 317.193 +                    (* (+ (quot (- (:mincol params) min-width 1) 
 317.194 +                                (:colinc params) )
 317.195 +                          1)
 317.196 +                       (:colinc params))))
 317.197 +         chars (apply str (repeat (- width base-width) (:padchar params)))]
 317.198 +    (if (:at params)
 317.199 +      (print (str chars base-output))
 317.200 +      (print (str base-output chars)))
 317.201 +    arg-navigator))
 317.202 +
 317.203 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.204 +;;; Support for the integer directives ~D, ~X, ~O, ~B and some
 317.205 +;;; of ~R
 317.206 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.207 +
 317.208 +(defn- integral?
 317.209 +  "returns true if a number is actually an integer (that is, has no fractional part)"
 317.210 +  [x]
 317.211 +  (cond
 317.212 +   (integer? x) true
 317.213 +   (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part
 317.214 +   (float? x)   (= x (Math/floor x))
 317.215 +   (ratio? x)   (let [^clojure.lang.Ratio r x]
 317.216 +                  (= 0 (rem (.numerator r) (.denominator r))))
 317.217 +   :else        false))
 317.218 +
 317.219 +(defn- remainders
 317.220 +  "Return the list of remainders (essentially the 'digits') of val in the given base"
 317.221 +  [base val]
 317.222 +  (reverse 
 317.223 +   (first 
 317.224 +    (consume #(if (pos? %) 
 317.225 +                [(rem % base) (quot % base)] 
 317.226 +                [nil nil]) 
 317.227 +             val))))
 317.228 +
 317.229 +;;; TODO: xlated-val does not seem to be used here.
 317.230 +(defn- base-str
 317.231 +  "Return val as a string in the given base"
 317.232 +  [base val]
 317.233 +  (if (zero? val)
 317.234 +    "0"
 317.235 +    (let [xlated-val (cond
 317.236 +                       (float? val) (bigdec val)
 317.237 +                       (ratio? val) (let [^clojure.lang.Ratio r val] 
 317.238 +                                      (/ (.numerator r) (.denominator r)))
 317.239 +                       :else val)] 
 317.240 +      (apply str 
 317.241 +             (map 
 317.242 +              #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) 
 317.243 +              (remainders base val))))))
 317.244 +
 317.245 +(def ^{:private true}
 317.246 +     java-base-formats {8 "%o", 10 "%d", 16 "%x"})
 317.247 +
 317.248 +(defn- opt-base-str
 317.249 +  "Return val as a string in the given base, using clojure.core/format if supported
 317.250 +for improved performance"
 317.251 +  [base val]
 317.252 +  (let [format-str (get java-base-formats base)]
 317.253 +    (if (and format-str (integer? val))
 317.254 +      (clojure.core/format format-str val)
 317.255 +      (base-str base val))))
 317.256 +
 317.257 +(defn- group-by* [unit lis]
 317.258 +  (reverse
 317.259 +   (first
 317.260 +    (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis)))))
 317.261 +
 317.262 +(defn- format-integer [base params arg-navigator offsets]
 317.263 +  (let [[arg arg-navigator] (next-arg arg-navigator)]
 317.264 +    (if (integral? arg)
 317.265 +      (let [neg (neg? arg)
 317.266 +            pos-arg (if neg (- arg) arg)
 317.267 +            raw-str (opt-base-str base pos-arg)
 317.268 +            group-str (if (:colon params)
 317.269 +                        (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str))
 317.270 +                              commas (repeat (count groups) (:commachar params))]
 317.271 +                          (apply str (next (interleave commas groups))))
 317.272 +                        raw-str)
 317.273 +            ^String signed-str (cond
 317.274 +                                  neg (str "-" group-str)
 317.275 +                                  (:at params) (str "+" group-str)
 317.276 +                                  true group-str)
 317.277 +            padded-str (if (< (.length signed-str) (:mincol params))
 317.278 +                         (str (apply str (repeat (- (:mincol params) (.length signed-str)) 
 317.279 +                                                 (:padchar params)))
 317.280 +                              signed-str)
 317.281 +                         signed-str)]
 317.282 +        (print padded-str))
 317.283 +      (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 
 317.284 +                               :padchar (:padchar params) :at true} 
 317.285 +                    (init-navigator [arg]) nil))
 317.286 +    arg-navigator))
 317.287 +
 317.288 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.289 +;;; Support for english formats (~R and ~:R)
 317.290 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.291 +
 317.292 +(def ^{:private true}
 317.293 +     english-cardinal-units 
 317.294 +     ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"
 317.295 +      "ten" "eleven" "twelve" "thirteen" "fourteen"
 317.296 +      "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"])
 317.297 +
 317.298 +(def ^{:private true}
 317.299 +     english-ordinal-units 
 317.300 +     ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth"
 317.301 +      "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth"
 317.302 +      "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"])
 317.303 +
 317.304 +(def ^{:private true}
 317.305 +     english-cardinal-tens
 317.306 +     ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"])
 317.307 +
 317.308 +(def ^{:private true}
 317.309 +     english-ordinal-tens
 317.310 +     ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth"
 317.311 +      "sixtieth" "seventieth" "eightieth" "ninetieth"])
 317.312 +
 317.313 +;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales)
 317.314 +;; Number names from http://www.jimloy.com/math/billion.htm
 317.315 +;; We follow the rules for writing numbers from the Blue Book
 317.316 +;; (http://www.grammarbook.com/numbers/numbers.asp)
 317.317 +(def ^{:private true}
 317.318 +     english-scale-numbers 
 317.319 +     ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" 
 317.320 +      "sextillion" "septillion" "octillion" "nonillion" "decillion" 
 317.321 +      "undecillion" "duodecillion" "tredecillion" "quattuordecillion" 
 317.322 +      "quindecillion" "sexdecillion" "septendecillion" 
 317.323 +      "octodecillion" "novemdecillion" "vigintillion"])
 317.324 +
 317.325 +(defn- format-simple-cardinal
 317.326 +  "Convert a number less than 1000 to a cardinal english string"
 317.327 +  [num]
 317.328 +  (let [hundreds (quot num 100)
 317.329 +        tens (rem num 100)]
 317.330 +    (str
 317.331 +     (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred"))
 317.332 +     (if (and (pos? hundreds) (pos? tens)) " ")
 317.333 +     (if (pos? tens) 
 317.334 +       (if (< tens 20) 
 317.335 +         (nth english-cardinal-units tens)
 317.336 +         (let [ten-digit (quot tens 10)
 317.337 +               unit-digit (rem tens 10)]
 317.338 +           (str
 317.339 +            (if (pos? ten-digit) (nth english-cardinal-tens ten-digit))
 317.340 +            (if (and (pos? ten-digit) (pos? unit-digit)) "-")
 317.341 +            (if (pos? unit-digit) (nth english-cardinal-units unit-digit)))))))))
 317.342 +
 317.343 +(defn- add-english-scales
 317.344 +  "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string
 317.345 +offset is a factor of 10^3 to multiply by"
 317.346 +  [parts offset]
 317.347 +  (let [cnt (count parts)]
 317.348 +    (loop [acc []
 317.349 +           pos (dec cnt)
 317.350 +           this (first parts)
 317.351 +           remainder (next parts)]
 317.352 +      (if (nil? remainder)
 317.353 +        (str (apply str (interpose ", " acc))
 317.354 +             (if (and (not (empty? this)) (not (empty? acc))) ", ")
 317.355 +             this
 317.356 +             (if (and (not (empty? this)) (pos? (+ pos offset)))
 317.357 +               (str " " (nth english-scale-numbers (+ pos offset)))))
 317.358 +        (recur 
 317.359 +         (if (empty? this)
 317.360 +           acc
 317.361 +           (conj acc (str this " " (nth english-scale-numbers (+ pos offset)))))
 317.362 +         (dec pos)
 317.363 +         (first remainder)
 317.364 +         (next remainder))))))
 317.365 +
 317.366 +(defn- format-cardinal-english [params navigator offsets]
 317.367 +  (let [[arg navigator] (next-arg navigator)]
 317.368 +    (if (= 0 arg)
 317.369 +      (print "zero")
 317.370 +      (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs
 317.371 +            parts (remainders 1000 abs-arg)]
 317.372 +        (if (<= (count parts) (count english-scale-numbers))
 317.373 +          (let [parts-strs (map format-simple-cardinal parts)
 317.374 +                full-str (add-english-scales parts-strs 0)]
 317.375 +            (print (str (if (neg? arg) "minus ") full-str)))
 317.376 +          (format-integer ;; for numbers > 10^63, we fall back on ~D
 317.377 +           10
 317.378 +           { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true}
 317.379 +           (init-navigator [arg])
 317.380 +           { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}))))
 317.381 +    navigator))
 317.382 +
 317.383 +(defn- format-simple-ordinal
 317.384 +  "Convert a number less than 1000 to a ordinal english string
 317.385 +Note this should only be used for the last one in the sequence"
 317.386 +  [num]
 317.387 +  (let [hundreds (quot num 100)
 317.388 +        tens (rem num 100)]
 317.389 +    (str
 317.390 +     (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred"))
 317.391 +     (if (and (pos? hundreds) (pos? tens)) " ")
 317.392 +     (if (pos? tens) 
 317.393 +       (if (< tens 20) 
 317.394 +         (nth english-ordinal-units tens)
 317.395 +         (let [ten-digit (quot tens 10)
 317.396 +               unit-digit (rem tens 10)]
 317.397 +           (if (and (pos? ten-digit) (not (pos? unit-digit)))
 317.398 +             (nth english-ordinal-tens ten-digit)
 317.399 +             (str
 317.400 +              (if (pos? ten-digit) (nth english-cardinal-tens ten-digit))
 317.401 +              (if (and (pos? ten-digit) (pos? unit-digit)) "-")
 317.402 +              (if (pos? unit-digit) (nth english-ordinal-units unit-digit))))))
 317.403 +       (if (pos? hundreds) "th")))))
 317.404 +
 317.405 +(defn- format-ordinal-english [params navigator offsets]
 317.406 +  (let [[arg navigator] (next-arg navigator)]
 317.407 +    (if (= 0 arg)
 317.408 +      (print "zeroth")
 317.409 +      (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs
 317.410 +            parts (remainders 1000 abs-arg)]
 317.411 +        (if (<= (count parts) (count english-scale-numbers))
 317.412 +          (let [parts-strs (map format-simple-cardinal (drop-last parts))
 317.413 +                head-str (add-english-scales parts-strs 1)
 317.414 +                tail-str (format-simple-ordinal (last parts))]
 317.415 +            (print (str (if (neg? arg) "minus ") 
 317.416 +                        (cond 
 317.417 +                         (and (not (empty? head-str)) (not (empty? tail-str))) 
 317.418 +                         (str head-str ", " tail-str)
 317.419 +                         
 317.420 +                         (not (empty? head-str)) (str head-str "th")
 317.421 +                         :else tail-str))))
 317.422 +          (do (format-integer ;; for numbers > 10^63, we fall back on ~D
 317.423 +               10
 317.424 +               { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true}
 317.425 +               (init-navigator [arg])
 317.426 +               { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})
 317.427 +              (let [low-two-digits (rem arg 100)
 317.428 +                    not-teens (or (< 11 low-two-digits) (> 19 low-two-digits))
 317.429 +                    low-digit (rem low-two-digits 10)]
 317.430 +                (print (cond 
 317.431 +                        (and (= low-digit 1) not-teens) "st"
 317.432 +                        (and (= low-digit 2) not-teens) "nd"
 317.433 +                        (and (= low-digit 3) not-teens) "rd"
 317.434 +                        :else "th")))))))
 317.435 +    navigator))
 317.436 +
 317.437 +
 317.438 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.439 +;;; Support for roman numeral formats (~@R and ~@:R)
 317.440 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.441 +
 317.442 +(def ^{:private true}
 317.443 +     old-roman-table
 317.444 +     [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"]
 317.445 +      [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"]
 317.446 +      [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"]
 317.447 +      [ "M" "MM" "MMM"]])
 317.448 +
 317.449 +(def ^{:private true}
 317.450 +     new-roman-table
 317.451 +     [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"]
 317.452 +      [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"]
 317.453 +      [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"]
 317.454 +      [ "M" "MM" "MMM"]])
 317.455 +
 317.456 +(defn- format-roman
 317.457 +  "Format a roman numeral using the specified look-up table"
 317.458 +  [table params navigator offsets]
 317.459 +  (let [[arg navigator] (next-arg navigator)]
 317.460 +    (if (and (number? arg) (> arg 0) (< arg 4000))
 317.461 +      (let [digits (remainders 10 arg)]
 317.462 +        (loop [acc []
 317.463 +               pos (dec (count digits))
 317.464 +               digits digits]
 317.465 +          (if (empty? digits)
 317.466 +            (print (apply str acc))
 317.467 +            (let [digit (first digits)]
 317.468 +              (recur (if (= 0 digit) 
 317.469 +                       acc 
 317.470 +                       (conj acc (nth (nth table pos) (dec digit))))
 317.471 +                     (dec pos)
 317.472 +                     (next digits))))))
 317.473 +      (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D
 317.474 +           10
 317.475 +           { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true}
 317.476 +           (init-navigator [arg])
 317.477 +           { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}))
 317.478 +    navigator))
 317.479 +
 317.480 +(defn- format-old-roman [params navigator offsets]
 317.481 +  (format-roman old-roman-table params navigator offsets))
 317.482 +
 317.483 +(defn- format-new-roman [params navigator offsets]
 317.484 +  (format-roman new-roman-table params navigator offsets))
 317.485 +
 317.486 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.487 +;;; Support for character formats (~C)
 317.488 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.489 +
 317.490 +(def ^{:private true} 
 317.491 +     special-chars { 8 "Backspace", 9 "Tab",  10 "Newline", 13 "Return", 32 "Space"})
 317.492 +
 317.493 +(defn- pretty-character [params navigator offsets]
 317.494 +  (let [[c navigator] (next-arg navigator)
 317.495 +        as-int (int c)
 317.496 +        base-char (bit-and as-int 127)
 317.497 +        meta (bit-and as-int 128)
 317.498 +        special (get special-chars base-char)]
 317.499 +    (if (> meta 0) (print "Meta-"))
 317.500 +    (print (cond
 317.501 +            special special
 317.502 +            (< base-char 32) (str "Control-" (char (+ base-char 64)))
 317.503 +            (= base-char 127) "Control-?"
 317.504 +            :else (char base-char)))
 317.505 +    navigator))
 317.506 +
 317.507 +(defn- readable-character [params navigator offsets]
 317.508 +  (let [[c navigator] (next-arg navigator)]
 317.509 +    (condp = (:char-format params)
 317.510 +      \o (cl-format true "\\o~3,'0o" (int c))
 317.511 +      \u (cl-format true "\\u~4,'0x" (int c))
 317.512 +      nil (pr c))
 317.513 +    navigator))
 317.514 +
 317.515 +(defn- plain-character [params navigator offsets]
 317.516 +  (let [[char navigator] (next-arg navigator)]
 317.517 +    (print char)
 317.518 +    navigator))
 317.519 +
 317.520 +;; Check to see if a result is an abort (~^) construct
 317.521 +;; TODO: move these funcs somewhere more appropriate
 317.522 +(defn- abort? [context]
 317.523 +  (let [token (first context)]
 317.524 +    (or (= :up-arrow token) (= :colon-up-arrow token))))
 317.525 +
 317.526 +;; Handle the execution of "sub-clauses" in bracket constructions
 317.527 +(defn- execute-sub-format [format args base-args]
 317.528 +  (second
 317.529 +   (map-passing-context 
 317.530 +    (fn [element context]
 317.531 +      (if (abort? context)
 317.532 +        [nil context] ; just keep passing it along
 317.533 +        (let [[params args] (realize-parameter-list (:params element) context)
 317.534 +              [params offsets] (unzip-map params)
 317.535 +              params (assoc params :base-args base-args)]
 317.536 +          [nil (apply (:func element) [params args offsets])])))
 317.537 +    args
 317.538 +    format)))
 317.539 +
 317.540 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.541 +;;; Support for real number formats
 317.542 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.543 +
 317.544 +;; TODO - return exponent as int to eliminate double conversion
 317.545 +(defn- float-parts-base
 317.546 +  "Produce string parts for the mantissa (normalized 1-9) and exponent"
 317.547 +  [^Object f]
 317.548 +  (let [^String s (.toLowerCase (.toString f))
 317.549 +        exploc (.indexOf s (int \e))]
 317.550 +    (if (neg? exploc)
 317.551 +      (let [dotloc (.indexOf s (int \.))]
 317.552 +        (if (neg? dotloc)
 317.553 +          [s (str (dec (count s)))]
 317.554 +          [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))]))
 317.555 +      [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))])))
 317.556 +
 317.557 +
 317.558 +(defn- float-parts
 317.559 +  "Take care of leading and trailing zeros in decomposed floats"
 317.560 +  [f]
 317.561 +  (let [[m ^String e] (float-parts-base f)
 317.562 +        m1 (rtrim m \0)
 317.563 +        m2 (ltrim m1 \0)
 317.564 +        delta (- (count m1) (count m2))
 317.565 +        ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)]
 317.566 +    (if (empty? m2)
 317.567 +      ["0" 0]
 317.568 +      [m2 (- (Integer/valueOf e) delta)])))
 317.569 +
 317.570 +(defn- round-str [m e d w]
 317.571 +  (if (or d w)
 317.572 +    (let [len (count m)
 317.573 +          round-pos (if d (+ e d 1))
 317.574 +          round-pos (if (and w (< (inc e) (dec w)) 
 317.575 +                             (or (nil? round-pos) (< (dec w) round-pos)))
 317.576 +                      (dec w)
 317.577 +                      round-pos)
 317.578 +          [m1 e1 round-pos len] (if (= round-pos 0) 
 317.579 +                                  [(str "0" m) (inc e) 1 (inc len)]
 317.580 +                                  [m e round-pos len])]
 317.581 +      (if round-pos
 317.582 +        (if (neg? round-pos)
 317.583 +          ["0" 0 false]
 317.584 +          (if (> len round-pos)
 317.585 +            (let [round-char (nth m1 round-pos)
 317.586 +                  ^String result (subs m1 0 round-pos)]
 317.587 +              (if (>= (int round-char) (int \5))
 317.588 +                (let [result-val (Integer/valueOf result)
 317.589 +                      leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1)))
 317.590 +                      round-up-result (str leading-zeros
 317.591 +                                           (String/valueOf (+ result-val 
 317.592 +                                                              (if (neg? result-val) -1 1))))
 317.593 +                      expanded (> (count round-up-result) (count result))]
 317.594 +                  [round-up-result e1 expanded])
 317.595 +                [result e1 false]))
 317.596 +            [m e false]))
 317.597 +        [m e false]))
 317.598 +    [m e false]))
 317.599 +
 317.600 +(defn- expand-fixed [m e d]
 317.601 +  (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m)
 317.602 +        len (count m1)
 317.603 +        target-len (if d (+ e d 1) (inc e))]
 317.604 +    (if (< len target-len) 
 317.605 +      (str m1 (apply str (repeat (- target-len len) \0))) 
 317.606 +      m1)))
 317.607 +
 317.608 +(defn- insert-decimal
 317.609 +  "Insert the decimal point at the right spot in the number to match an exponent"
 317.610 +  [m e]
 317.611 +  (if (neg? e)
 317.612 +    (str "." m)
 317.613 +    (let [loc (inc e)]
 317.614 +      (str (subs m 0 loc) "." (subs m loc)))))
 317.615 +
 317.616 +(defn- get-fixed [m e d]
 317.617 +  (insert-decimal (expand-fixed m e d) e))
 317.618 +
 317.619 +(defn- insert-scaled-decimal
 317.620 +  "Insert the decimal point at the right spot in the number to match an exponent"
 317.621 +  [m k]
 317.622 +  (if (neg? k)
 317.623 +    (str "." m)
 317.624 +    (str (subs m 0 k) "." (subs m k))))
 317.625 +
 317.626 +;; the function to render ~F directives
 317.627 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 317.628 +(defn- fixed-float [params navigator offsets]
 317.629 +  (let [w (:w params)
 317.630 +        d (:d params)
 317.631 +        [arg navigator] (next-arg navigator)
 317.632 +        [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg])
 317.633 +        [mantissa exp] (float-parts abs)
 317.634 +        scaled-exp (+ exp (:k params))
 317.635 +        add-sign (or (:at params) (neg? arg))
 317.636 +        append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp))
 317.637 +        [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp 
 317.638 +                                                          d (if w (- w (if add-sign 1 0))))
 317.639 +        fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d)
 317.640 +        prepend-zero (= (first fixed-repr) \.)]
 317.641 +    (if w
 317.642 +      (let [len (count fixed-repr)
 317.643 +            signed-len (if add-sign (inc len) len)
 317.644 +            prepend-zero (and prepend-zero (not (>= signed-len w)))
 317.645 +            append-zero (and append-zero (not (>= signed-len w)))
 317.646 +            full-len (if (or prepend-zero append-zero)
 317.647 +                       (inc signed-len) 
 317.648 +                       signed-len)]
 317.649 +        (if (and (> full-len w) (:overflowchar params))
 317.650 +          (print (apply str (repeat w (:overflowchar params))))
 317.651 +          (print (str
 317.652 +                  (apply str (repeat (- w full-len) (:padchar params)))
 317.653 +                  (if add-sign sign) 
 317.654 +                  (if prepend-zero "0")
 317.655 +                  fixed-repr
 317.656 +                  (if append-zero "0")))))
 317.657 +      (print (str
 317.658 +              (if add-sign sign) 
 317.659 +              (if prepend-zero "0")
 317.660 +              fixed-repr
 317.661 +              (if append-zero "0"))))
 317.662 +    navigator))
 317.663 +
 317.664 +
 317.665 +;; the function to render ~E directives
 317.666 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 317.667 +;; TODO: define ~E representation for Infinity
 317.668 +(defn- exponential-float [params navigator offsets]
 317.669 +  (let [[arg navigator] (next-arg navigator)]
 317.670 +    (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))]
 317.671 +      (let [w (:w params)
 317.672 +            d (:d params)
 317.673 +            e (:e params)
 317.674 +            k (:k params)
 317.675 +            expchar (or (:exponentchar params) \E)
 317.676 +            add-sign (or (:at params) (neg? arg))
 317.677 +            prepend-zero (<= k 0)
 317.678 +            ^Integer scaled-exp (- exp (dec k))
 317.679 +            scaled-exp-str (str (Math/abs scaled-exp))
 317.680 +            scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) 
 317.681 +                                (if e (apply str 
 317.682 +                                             (repeat 
 317.683 +                                              (- e 
 317.684 +                                                 (count scaled-exp-str)) 
 317.685 +                                              \0))) 
 317.686 +                                scaled-exp-str)
 317.687 +            exp-width (count scaled-exp-str)
 317.688 +            base-mantissa-width (count mantissa)
 317.689 +            scaled-mantissa (str (apply str (repeat (- k) \0))
 317.690 +                                 mantissa
 317.691 +                                 (if d 
 317.692 +                                   (apply str 
 317.693 +                                          (repeat 
 317.694 +                                           (- d (dec base-mantissa-width)
 317.695 +                                              (if (neg? k) (- k) 0)) \0))))
 317.696 +            w-mantissa (if w (- w exp-width))
 317.697 +            [rounded-mantissa _ incr-exp] (round-str 
 317.698 +                                           scaled-mantissa 0
 317.699 +                                           (cond
 317.700 +                                            (= k 0) (dec d)
 317.701 +                                            (pos? k) d
 317.702 +                                            (neg? k) (dec d))
 317.703 +                                           (if w-mantissa 
 317.704 +                                             (- w-mantissa (if add-sign 1 0))))
 317.705 +            full-mantissa (insert-scaled-decimal rounded-mantissa k)
 317.706 +            append-zero (and (= k (count rounded-mantissa)) (nil? d))]
 317.707 +        (if (not incr-exp)
 317.708 +          (if w
 317.709 +            (let [len (+ (count full-mantissa) exp-width)
 317.710 +                  signed-len (if add-sign (inc len) len)
 317.711 +                  prepend-zero (and prepend-zero (not (= signed-len w)))
 317.712 +                  full-len (if prepend-zero (inc signed-len) signed-len)
 317.713 +                  append-zero (and append-zero (< full-len w))]
 317.714 +              (if (and (or (> full-len w) (and e (> (- exp-width 2) e)))
 317.715 +                       (:overflowchar params))
 317.716 +                (print (apply str (repeat w (:overflowchar params))))
 317.717 +                (print (str
 317.718 +                        (apply str 
 317.719 +                               (repeat 
 317.720 +                                (- w full-len (if append-zero 1 0) )
 317.721 +                                (:padchar params)))
 317.722 +                        (if add-sign (if (neg? arg) \- \+)) 
 317.723 +                        (if prepend-zero "0")
 317.724 +                        full-mantissa
 317.725 +                        (if append-zero "0")
 317.726 +                        scaled-exp-str))))
 317.727 +            (print (str
 317.728 +                    (if add-sign (if (neg? arg) \- \+)) 
 317.729 +                    (if prepend-zero "0")
 317.730 +                    full-mantissa
 317.731 +                    (if append-zero "0")
 317.732 +                    scaled-exp-str)))
 317.733 +          (recur [rounded-mantissa (inc exp)]))))
 317.734 +    navigator))
 317.735 +
 317.736 +;; the function to render ~G directives
 317.737 +;; This just figures out whether to pass the request off to ~F or ~E based 
 317.738 +;; on the algorithm in CLtL.
 317.739 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 317.740 +;; TODO: refactor so that float-parts isn't called twice
 317.741 +(defn- general-float [params navigator offsets]
 317.742 +  (let [[arg _] (next-arg navigator)
 317.743 +        [mantissa exp] (float-parts (if (neg? arg) (- arg) arg))
 317.744 +        w (:w params)
 317.745 +        d (:d params)
 317.746 +        e (:e params)
 317.747 +        n (if (= arg 0.0) 0 (inc exp))
 317.748 +        ee (if e (+ e 2) 4)
 317.749 +        ww (if w (- w ee))
 317.750 +        d (if d d (max (count mantissa) (min n 7)))
 317.751 +        dd (- d n)]
 317.752 +    (if (<= 0 dd d)
 317.753 +      (let [navigator (fixed-float {:w ww, :d dd, :k 0, 
 317.754 +                                    :overflowchar (:overflowchar params),
 317.755 +                                    :padchar (:padchar params), :at (:at params)} 
 317.756 +                                   navigator offsets)]
 317.757 +        (print (apply str (repeat ee \space)))
 317.758 +        navigator)
 317.759 +      (exponential-float params navigator offsets))))
 317.760 +
 317.761 +;; the function to render ~$ directives
 317.762 +;; TODO: support rationals. Back off to ~D/~A is the appropriate cases
 317.763 +(defn- dollar-float [params navigator offsets]
 317.764 +  (let [[^Double arg navigator] (next-arg navigator)
 317.765 +        [mantissa exp] (float-parts (Math/abs arg))
 317.766 +        d (:d params) ; digits after the decimal
 317.767 +        n (:n params) ; minimum digits before the decimal
 317.768 +        w (:w params) ; minimum field width
 317.769 +        add-sign (or (:at params) (neg? arg))
 317.770 +        [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil)
 317.771 +        ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d)
 317.772 +        full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr)
 317.773 +        full-len (+ (count full-repr) (if add-sign 1 0))]
 317.774 +    (print (str
 317.775 +            (if (and (:colon params) add-sign) (if (neg? arg) \- \+))
 317.776 +            (apply str (repeat (- w full-len) (:padchar params)))
 317.777 +            (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+))
 317.778 +            full-repr))
 317.779 +    navigator))
 317.780 +        
 317.781 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.782 +;;; Support for the '~[...~]' conditional construct in its
 317.783 +;;; different flavors
 317.784 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.785 +
 317.786 +;; ~[...~] without any modifiers chooses one of the clauses based on the param or 
 317.787 +;; next argument
 317.788 +;; TODO check arg is positive int
 317.789 +(defn- choice-conditional [params arg-navigator offsets]
 317.790 +  (let [arg (:selector params)
 317.791 +        [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator))
 317.792 +        clauses (:clauses params)
 317.793 +        clause (if (or (neg? arg) (>= arg (count clauses)))
 317.794 +                 (first (:else params))
 317.795 +                 (nth clauses arg))]
 317.796 +    (if clause
 317.797 +      (execute-sub-format clause navigator (:base-args params))
 317.798 +      navigator)))
 317.799 +
 317.800 +;; ~:[...~] with the colon reads the next argument treating it as a truth value
 317.801 +(defn- boolean-conditional [params arg-navigator offsets]
 317.802 +  (let [[arg navigator] (next-arg arg-navigator)
 317.803 +        clauses (:clauses params)
 317.804 +        clause (if arg
 317.805 +                 (second clauses)
 317.806 +                 (first clauses))]
 317.807 +    (if clause
 317.808 +      (execute-sub-format clause navigator (:base-args params))
 317.809 +      navigator)))
 317.810 +
 317.811 +;; ~@[...~] with the at sign executes the conditional if the next arg is not
 317.812 +;; nil/false without consuming the arg
 317.813 +(defn- check-arg-conditional [params arg-navigator offsets]
 317.814 +  (let [[arg navigator] (next-arg arg-navigator)
 317.815 +        clauses (:clauses params)
 317.816 +        clause (if arg (first clauses))]
 317.817 +    (if arg
 317.818 +      (if clause
 317.819 +        (execute-sub-format clause arg-navigator (:base-args params))
 317.820 +        arg-navigator)
 317.821 +      navigator)))
 317.822 +
 317.823 +
 317.824 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.825 +;;; Support for the '~{...~}' iteration construct in its
 317.826 +;;; different flavors
 317.827 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.828 +
 317.829 +
 317.830 +;; ~{...~} without any modifiers uses the next argument as an argument list that 
 317.831 +;; is consumed by all the iterations
 317.832 +(defn- iterate-sublist [params navigator offsets]
 317.833 +  (let [max-count (:max-iterations params)
 317.834 +        param-clause (first (:clauses params))
 317.835 +        [clause navigator] (if (empty? param-clause) 
 317.836 +                             (get-format-arg navigator)
 317.837 +                             [param-clause navigator]) 
 317.838 +        [arg-list navigator] (next-arg navigator)
 317.839 +        args (init-navigator arg-list)]
 317.840 +    (loop [count 0
 317.841 +           args args
 317.842 +           last-pos -1]
 317.843 +      (if (and (not max-count) (= (:pos args) last-pos) (> count 1))
 317.844 +        ;; TODO get the offset in here and call format exception
 317.845 +        (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!")))
 317.846 +      (if (or (and (empty? (:rest args))
 317.847 +                   (or (not (:colon (:right-params params))) (> count 0)))
 317.848 +              (and max-count (>= count max-count)))
 317.849 +        navigator
 317.850 +        (let [iter-result (execute-sub-format clause args (:base-args params))] 
 317.851 +          (if (= :up-arrow (first iter-result))
 317.852 +            navigator
 317.853 +            (recur (inc count) iter-result (:pos args))))))))
 317.854 +
 317.855 +;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the
 317.856 +;; sublists is used as the arglist for a single iteration.
 317.857 +(defn- iterate-list-of-sublists [params navigator offsets]
 317.858 +  (let [max-count (:max-iterations params)
 317.859 +        param-clause (first (:clauses params))
 317.860 +        [clause navigator] (if (empty? param-clause) 
 317.861 +                             (get-format-arg navigator)
 317.862 +                             [param-clause navigator]) 
 317.863 +        [arg-list navigator] (next-arg navigator)]
 317.864 +    (loop [count 0
 317.865 +           arg-list arg-list]
 317.866 +      (if (or (and (empty? arg-list)
 317.867 +                   (or (not (:colon (:right-params params))) (> count 0)))
 317.868 +              (and max-count (>= count max-count)))
 317.869 +        navigator
 317.870 +        (let [iter-result (execute-sub-format 
 317.871 +                           clause 
 317.872 +                           (init-navigator (first arg-list))
 317.873 +                           (init-navigator (next arg-list)))]
 317.874 +          (if (= :colon-up-arrow (first iter-result))
 317.875 +            navigator
 317.876 +            (recur (inc count) (next arg-list))))))))
 317.877 +
 317.878 +;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations
 317.879 +;; is consumed by all the iterations
 317.880 +(defn- iterate-main-list [params navigator offsets]
 317.881 +  (let [max-count (:max-iterations params)
 317.882 +        param-clause (first (:clauses params))
 317.883 +        [clause navigator] (if (empty? param-clause) 
 317.884 +                             (get-format-arg navigator)
 317.885 +                             [param-clause navigator])]
 317.886 +    (loop [count 0
 317.887 +           navigator navigator
 317.888 +           last-pos -1]
 317.889 +      (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1))
 317.890 +        ;; TODO get the offset in here and call format exception
 317.891 +        (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!")))
 317.892 +      (if (or (and (empty? (:rest navigator))
 317.893 +                   (or (not (:colon (:right-params params))) (> count 0)))
 317.894 +              (and max-count (>= count max-count)))
 317.895 +        navigator
 317.896 +        (let [iter-result (execute-sub-format clause navigator (:base-args params))] 
 317.897 +          (if (= :up-arrow (first iter-result))
 317.898 +            (second iter-result)
 317.899 +            (recur 
 317.900 +             (inc count) iter-result (:pos navigator))))))))
 317.901 +
 317.902 +;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one
 317.903 +;; of which is consumed with each iteration
 317.904 +(defn- iterate-main-sublists [params navigator offsets]
 317.905 +  (let [max-count (:max-iterations params)
 317.906 +        param-clause (first (:clauses params))
 317.907 +        [clause navigator] (if (empty? param-clause) 
 317.908 +                             (get-format-arg navigator)
 317.909 +                             [param-clause navigator]) 
 317.910 +        ]
 317.911 +    (loop [count 0
 317.912 +           navigator navigator]
 317.913 +      (if (or (and (empty? (:rest navigator))
 317.914 +                   (or (not (:colon (:right-params params))) (> count 0)))
 317.915 +              (and max-count (>= count max-count)))
 317.916 +        navigator
 317.917 +        (let [[sublist navigator] (next-arg-or-nil navigator)
 317.918 +              iter-result (execute-sub-format clause (init-navigator sublist) navigator)]
 317.919 +          (if (= :colon-up-arrow (first iter-result))
 317.920 +            navigator
 317.921 +            (recur (inc count) navigator)))))))
 317.922 +
 317.923 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.924 +;;; The '~< directive has two completely different meanings
 317.925 +;;; in the '~<...~>' form it does justification, but with
 317.926 +;;; ~<...~:>' it represents the logical block operation of the
 317.927 +;;; pretty printer.
 317.928 +;;; 
 317.929 +;;; Unfortunately, the current architecture decides what function
 317.930 +;;; to call at form parsing time before the sub-clauses have been
 317.931 +;;; folded, so it is left to run-time to make the decision.
 317.932 +;;; 
 317.933 +;;; TODO: make it possible to make these decisions at compile-time.
 317.934 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.935 +
 317.936 +(declare format-logical-block)
 317.937 +(declare justify-clauses)
 317.938 +
 317.939 +(defn- logical-block-or-justify [params navigator offsets]
 317.940 +  (if (:colon (:right-params params))
 317.941 +    (format-logical-block params navigator offsets)
 317.942 +    (justify-clauses params navigator offsets)))
 317.943 +
 317.944 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.945 +;;; Support for the '~<...~>' justification directive
 317.946 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 317.947 +
 317.948 +(defn- render-clauses [clauses navigator base-navigator]
 317.949 +  (loop [clauses clauses
 317.950 +         acc []
 317.951 +         navigator navigator]
 317.952 +    (if (empty? clauses)
 317.953 +      [acc navigator]
 317.954 +      (let [clause (first clauses)
 317.955 +            [iter-result result-str] (binding [*out* (java.io.StringWriter.)]
 317.956 +                                       [(execute-sub-format clause navigator base-navigator) 
 317.957 +                                        (.toString *out*)])]
 317.958 +        (if (= :up-arrow (first iter-result))
 317.959 +          [acc (second iter-result)]
 317.960 +          (recur (next clauses) (conj acc result-str) iter-result))))))
 317.961 +
 317.962 +;; TODO support for ~:; constructions
 317.963 +(defn- justify-clauses [params navigator offsets]
 317.964 +  (let [[[eol-str] new-navigator] (when-let [else (:else params)]
 317.965 +                                    (render-clauses else navigator (:base-args params)))
 317.966 +        navigator (or new-navigator navigator)
 317.967 +        [else-params new-navigator] (when-let [p (:else-params params)]
 317.968 +                                      (realize-parameter-list p navigator))
 317.969 +        navigator (or new-navigator navigator)
 317.970 +        min-remaining (or (first (:min-remaining else-params)) 0)
 317.971 +        max-columns (or (first (:max-columns else-params))
 317.972 +                        (get-max-column *out*))
 317.973 +        clauses (:clauses params)
 317.974 +        [strs navigator] (render-clauses clauses navigator (:base-args params))
 317.975 +        slots (max 1
 317.976 +                   (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0)))
 317.977 +        chars (reduce + (map count strs))
 317.978 +        mincol (:mincol params)
 317.979 +        minpad (:minpad params)
 317.980 +        colinc (:colinc params)
 317.981 +        minout (+ chars (* slots minpad))
 317.982 +        result-columns (if (<= minout mincol) 
 317.983 +                         mincol
 317.984 +                         (+ mincol (* colinc
 317.985 +                                      (+ 1 (quot (- minout mincol 1) colinc)))))
 317.986 +        total-pad (- result-columns chars)
 317.987 +        pad (max minpad (quot total-pad slots))
 317.988 +        extra-pad (- total-pad (* pad slots))
 317.989 +        pad-str (apply str (repeat pad (:padchar params)))]
 317.990 +    (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) 
 317.991 +                        max-columns))
 317.992 +      (print eol-str))
 317.993 +    (loop [slots slots
 317.994 +           extra-pad extra-pad
 317.995 +           strs strs
 317.996 +           pad-only (or (:colon params)
 317.997 +                        (and (= (count strs) 1) (not (:at params))))]
 317.998 +      (if (seq strs)
 317.999 +        (do
317.1000 +          (print (str (if (not pad-only) (first strs))
317.1001 +                      (if (or pad-only (next strs) (:at params)) pad-str)
317.1002 +                      (if (pos? extra-pad) (:padchar params))))
317.1003 +          (recur 
317.1004 +           (dec slots)
317.1005 +           (dec extra-pad)
317.1006 +           (if pad-only strs (next strs))
317.1007 +           false))))
317.1008 +    navigator))
317.1009 +
317.1010 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1011 +;;; Support for case modification with ~(...~).
317.1012 +;;; We do this by wrapping the underlying writer with
317.1013 +;;; a special writer to do the appropriate modification. This
317.1014 +;;; allows us to support arbitrary-sized output and sources
317.1015 +;;; that may block.
317.1016 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1017 +
317.1018 +(defn- downcase-writer 
317.1019 +  "Returns a proxy that wraps writer, converting all characters to lower case"
317.1020 +  [^java.io.Writer writer]
317.1021 +  (proxy [java.io.Writer] []
317.1022 +    (close [] (.close writer))
317.1023 +    (flush [] (.flush writer))
317.1024 +    (write ([^chars cbuf ^Integer off ^Integer len] 
317.1025 +              (.write writer cbuf off len))
317.1026 +           ([x]
317.1027 +              (condp = (class x)
317.1028 +		String 
317.1029 +		(let [s ^String x]
317.1030 +		  (.write writer (.toLowerCase s)))
317.1031 +
317.1032 +		Integer
317.1033 +		(let [c ^Character x]
317.1034 +		  (.write writer (int (Character/toLowerCase (char c))))))))))
317.1035 +
317.1036 +(defn- upcase-writer 
317.1037 +  "Returns a proxy that wraps writer, converting all characters to upper case"
317.1038 +  [^java.io.Writer writer]
317.1039 +  (proxy [java.io.Writer] []
317.1040 +    (close [] (.close writer))
317.1041 +    (flush [] (.flush writer))
317.1042 +    (write ([^chars cbuf ^Integer off ^Integer len] 
317.1043 +              (.write writer cbuf off len))
317.1044 +           ([x]
317.1045 +              (condp = (class x)
317.1046 +		String 
317.1047 +		(let [s ^String x]
317.1048 +		  (.write writer (.toUpperCase s)))
317.1049 +
317.1050 +		Integer
317.1051 +		(let [c ^Character x]
317.1052 +		  (.write writer (int (Character/toUpperCase (char c))))))))))
317.1053 +
317.1054 +(defn- capitalize-string
317.1055 +  "Capitalizes the words in a string. If first? is false, don't capitalize the 
317.1056 +                                      first character of the string even if it's a letter."
317.1057 +  [s first?]
317.1058 +  (let [^Character f (first s) 
317.1059 +        s (if (and first? f (Character/isLetter f))
317.1060 +            (str (Character/toUpperCase f) (subs s 1))
317.1061 +            s)]
317.1062 +    (apply str 
317.1063 +           (first
317.1064 +            (consume
317.1065 +             (fn [s]
317.1066 +               (if (empty? s)
317.1067 +                 [nil nil]
317.1068 +                 (let [m (re-matcher #"\W\w" s)
317.1069 +                       match (re-find m)
317.1070 +                       offset (and match (inc (.start m)))]
317.1071 +                   (if offset
317.1072 +                     [(str (subs s 0 offset) 
317.1073 +                           (Character/toUpperCase ^Character (nth s offset)))
317.1074 +                      (subs s (inc offset))]
317.1075 +                     [s nil]))))
317.1076 +             s)))))
317.1077 +
317.1078 +(defn- capitalize-word-writer
317.1079 +  "Returns a proxy that wraps writer, captializing all words"
317.1080 +  [^java.io.Writer writer]
317.1081 +  (let [last-was-whitespace? (ref true)] 
317.1082 +    (proxy [java.io.Writer] []
317.1083 +      (close [] (.close writer))
317.1084 +      (flush [] (.flush writer))
317.1085 +      (write 
317.1086 +       ([^chars cbuf ^Integer off ^Integer len] 
317.1087 +          (.write writer cbuf off len))
317.1088 +       ([x]
317.1089 +          (condp = (class x)
317.1090 +            String 
317.1091 +            (let [s ^String x]
317.1092 +              (.write writer 
317.1093 +                      ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?))
317.1094 +              (dosync 
317.1095 +               (ref-set last-was-whitespace? 
317.1096 +                        (Character/isWhitespace 
317.1097 +                         ^Character (nth s (dec (count s)))))))
317.1098 +
317.1099 +            Integer
317.1100 +            (let [c (char x)]
317.1101 +              (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] 
317.1102 +                (.write writer (int mod-c))
317.1103 +                (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x))))))))))))
317.1104 +
317.1105 +(defn- init-cap-writer
317.1106 +  "Returns a proxy that wraps writer, capitalizing the first word"
317.1107 +  [^java.io.Writer writer]
317.1108 +  (let [capped (ref false)] 
317.1109 +    (proxy [java.io.Writer] []
317.1110 +      (close [] (.close writer))
317.1111 +      (flush [] (.flush writer))
317.1112 +      (write ([^chars cbuf ^Integer off ^Integer len] 
317.1113 +                (.write writer cbuf off len))
317.1114 +             ([x]
317.1115 +                (condp = (class x)
317.1116 +                 String 
317.1117 +                 (let [s (.toLowerCase ^String x)]
317.1118 +                   (if (not @capped) 
317.1119 +                     (let [m (re-matcher #"\S" s)
317.1120 +                           match (re-find m)
317.1121 +                           offset (and match (.start m))]
317.1122 +                       (if offset
317.1123 +                         (do (.write writer 
317.1124 +                                   (str (subs s 0 offset) 
317.1125 +                                        (Character/toUpperCase ^Character (nth s offset))
317.1126 +                                        (.toLowerCase ^String (subs s (inc offset)))))
317.1127 +                           (dosync (ref-set capped true)))
317.1128 +                         (.write writer s))) 
317.1129 +                     (.write writer (.toLowerCase s))))
317.1130 +
317.1131 +                 Integer
317.1132 +                 (let [c ^Character (char x)]
317.1133 +                   (if (and (not @capped) (Character/isLetter c))
317.1134 +                     (do
317.1135 +                       (dosync (ref-set capped true))
317.1136 +                       (.write writer (int (Character/toUpperCase c))))
317.1137 +                     (.write writer (int (Character/toLowerCase c)))))))))))
317.1138 +
317.1139 +(defn- modify-case [make-writer params navigator offsets]
317.1140 +  (let [clause (first (:clauses params))]
317.1141 +    (binding [*out* (make-writer *out*)] 
317.1142 +      (execute-sub-format clause navigator (:base-args params)))))
317.1143 +
317.1144 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1145 +;;; If necessary, wrap the writer in a PrettyWriter object
317.1146 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1147 +
317.1148 +(defn get-pretty-writer 
317.1149 +  "Returns the java.io.Writer passed in wrapped in a pretty writer proxy, unless it's 
317.1150 +already a pretty writer. Generally, it is unneccesary to call this function, since pprint,
317.1151 +write, and cl-format all call it if they need to. However if you want the state to be 
317.1152 +preserved across calls, you will want to wrap them with this. 
317.1153 +
317.1154 +For example, when you want to generate column-aware output with multiple calls to cl-format, 
317.1155 +do it like in this example:
317.1156 +
317.1157 +    (defn print-table [aseq column-width]
317.1158 +      (binding [*out* (get-pretty-writer *out*)]
317.1159 +        (doseq [row aseq]
317.1160 +          (doseq [col row]
317.1161 +            (cl-format true \"~4D~7,vT\" col column-width))
317.1162 +          (prn))))
317.1163 +
317.1164 +Now when you run:
317.1165 +
317.1166 +    user> (print-table (map #(vector % (* % %) (* % % %)) (range 1 11)) 8)
317.1167 +
317.1168 +It prints a table of squares and cubes for the numbers from 1 to 10:
317.1169 +
317.1170 +       1      1       1    
317.1171 +       2      4       8    
317.1172 +       3      9      27    
317.1173 +       4     16      64    
317.1174 +       5     25     125    
317.1175 +       6     36     216    
317.1176 +       7     49     343    
317.1177 +       8     64     512    
317.1178 +       9     81     729    
317.1179 +      10    100    1000"
317.1180 +  {:added "1.2"}
317.1181 +  [writer]
317.1182 +  (if (pretty-writer? writer) 
317.1183 +    writer
317.1184 +    (pretty-writer writer *print-right-margin* *print-miser-width*)))
317.1185 + 
317.1186 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1187 +;;; Support for column-aware operations ~&, ~T
317.1188 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1189 +
317.1190 +(defn fresh-line
317.1191 +  "Make a newline if *out* is not already at the beginning of the line. If *out* is
317.1192 +not a pretty writer (which keeps track of columns), this function always outputs a newline."
317.1193 +  {:added "1.2"}
317.1194 +  []
317.1195 +  (if (instance? clojure.lang.IDeref *out*)
317.1196 +    (if (not (= 0 (get-column (:base @@*out*))))
317.1197 +      (prn))
317.1198 +    (prn)))
317.1199 +
317.1200 +(defn- absolute-tabulation [params navigator offsets]
317.1201 +  (let [colnum (:colnum params) 
317.1202 +        colinc (:colinc params)
317.1203 +        current (get-column (:base @@*out*))
317.1204 +        space-count (cond
317.1205 +                     (< current colnum) (- colnum current)
317.1206 +                     (= colinc 0) 0
317.1207 +                     :else (- colinc (rem (- current colnum) colinc)))]
317.1208 +    (print (apply str (repeat space-count \space))))
317.1209 +  navigator)
317.1210 +
317.1211 +(defn- relative-tabulation [params navigator offsets]
317.1212 +  (let [colrel (:colnum params) 
317.1213 +        colinc (:colinc params)
317.1214 +        start-col (+ colrel (get-column (:base @@*out*)))
317.1215 +        offset (if (pos? colinc) (rem start-col colinc) 0)
317.1216 +        space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))]
317.1217 +    (print (apply str (repeat space-count \space))))
317.1218 +  navigator)
317.1219 +
317.1220 +
317.1221 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1222 +;;; Support for accessing the pretty printer from a format
317.1223 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1224 +
317.1225 +;; TODO: support ~@; per-line-prefix separator
317.1226 +;; TODO: get the whole format wrapped so we can start the lb at any column
317.1227 +(defn- format-logical-block [params navigator offsets]
317.1228 +  (let [clauses (:clauses params)
317.1229 +        clause-count (count clauses)
317.1230 +        prefix (cond
317.1231 +                (> clause-count 1) (:string (:params (first (first clauses))))
317.1232 +                (:colon params) "(")
317.1233 +        body (nth clauses (if (> clause-count 1) 1 0))
317.1234 +        suffix (cond
317.1235 +                (> clause-count 2) (:string (:params (first (nth clauses 2))))
317.1236 +                (:colon params) ")")
317.1237 +        [arg navigator] (next-arg navigator)]
317.1238 +    (pprint-logical-block :prefix prefix :suffix suffix
317.1239 +      (execute-sub-format 
317.1240 +       body 
317.1241 +       (init-navigator arg)
317.1242 +       (:base-args params)))
317.1243 +    navigator))
317.1244 +
317.1245 +(defn- set-indent [params navigator offsets]
317.1246 +  (let [relative-to (if (:colon params) :current :block)]
317.1247 +    (pprint-indent relative-to (:n params))
317.1248 +    navigator))
317.1249 +
317.1250 +;;; TODO: support ~:T section options for ~T
317.1251 +
317.1252 +(defn- conditional-newline [params navigator offsets]
317.1253 +  (let [kind (if (:colon params) 
317.1254 +               (if (:at params) :mandatory :fill)
317.1255 +               (if (:at params) :miser :linear))]
317.1256 +    (pprint-newline kind)
317.1257 +    navigator))
317.1258 +
317.1259 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1260 +;;; The table of directives we support, each with its params,
317.1261 +;;; properties, and the compilation function
317.1262 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1263 +
317.1264 +;; We start with a couple of helpers
317.1265 +(defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ]
317.1266 +  [char, 
317.1267 +   {:directive char,
317.1268 +    :params `(array-map ~@params),
317.1269 +    :flags flags,
317.1270 +    :bracket-info bracket-info,
317.1271 +    :generator-fn (concat '(fn [ params offset]) generator-fn) }])
317.1272 +
317.1273 +(defmacro ^{:private true}
317.1274 +  defdirectives 
317.1275 +  [ & directives ]
317.1276 +  `(def ^{:private true}
317.1277 +        directive-table (hash-map ~@(mapcat process-directive-table-element directives))))
317.1278 +
317.1279 +(defdirectives 
317.1280 +  (\A 
317.1281 +   [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] 
317.1282 +   #{ :at :colon :both} {}
317.1283 +   #(format-ascii print-str %1 %2 %3))
317.1284 +
317.1285 +  (\S 
317.1286 +   [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] 
317.1287 +   #{ :at :colon :both} {}
317.1288 +   #(format-ascii pr-str %1 %2 %3))
317.1289 +
317.1290 +  (\D
317.1291 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
317.1292 +    :commainterval [ 3 Integer]]
317.1293 +   #{ :at :colon :both } {}
317.1294 +   #(format-integer 10 %1 %2 %3))
317.1295 +
317.1296 +  (\B
317.1297 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
317.1298 +    :commainterval [ 3 Integer]]
317.1299 +   #{ :at :colon :both } {}
317.1300 +   #(format-integer 2 %1 %2 %3))
317.1301 +
317.1302 +  (\O
317.1303 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
317.1304 +    :commainterval [ 3 Integer]]
317.1305 +   #{ :at :colon :both } {}
317.1306 +   #(format-integer 8 %1 %2 %3))
317.1307 +
317.1308 +  (\X
317.1309 +   [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
317.1310 +    :commainterval [ 3 Integer]]
317.1311 +   #{ :at :colon :both } {}
317.1312 +   #(format-integer 16 %1 %2 %3))
317.1313 +
317.1314 +  (\R
317.1315 +   [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] 
317.1316 +    :commainterval [ 3 Integer]]
317.1317 +   #{ :at :colon :both } {}
317.1318 +   (do
317.1319 +     (cond                          ; ~R is overloaded with bizareness
317.1320 +       (first (:base params))     #(format-integer (:base %1) %1 %2 %3)
317.1321 +       (and (:at params) (:colon params))   #(format-old-roman %1 %2 %3)
317.1322 +       (:at params)               #(format-new-roman %1 %2 %3)
317.1323 +       (:colon params)            #(format-ordinal-english %1 %2 %3)
317.1324 +       true                       #(format-cardinal-english %1 %2 %3))))
317.1325 +
317.1326 +  (\P
317.1327 +   [ ]
317.1328 +   #{ :at :colon :both } {}
317.1329 +   (fn [params navigator offsets]
317.1330 +     (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator)
317.1331 +           strs (if (:at params) ["y" "ies"] ["" "s"])
317.1332 +           [arg navigator] (next-arg navigator)]
317.1333 +       (print (if (= arg 1) (first strs) (second strs)))
317.1334 +       navigator)))
317.1335 +
317.1336 +  (\C
317.1337 +   [:char-format [nil Character]]
317.1338 +   #{ :at :colon :both } {}
317.1339 +   (cond
317.1340 +     (:colon params) pretty-character
317.1341 +     (:at params) readable-character
317.1342 +     :else plain-character))
317.1343 +
317.1344 +  (\F
317.1345 +   [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] 
317.1346 +    :padchar [\space Character] ]
317.1347 +   #{ :at } {}
317.1348 +   fixed-float)
317.1349 +
317.1350 +  (\E
317.1351 +   [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] 
317.1352 +    :overflowchar [nil Character] :padchar [\space Character] 
317.1353 +    :exponentchar [nil Character] ]
317.1354 +   #{ :at } {}
317.1355 +   exponential-float)
317.1356 +
317.1357 +  (\G
317.1358 +   [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] 
317.1359 +    :overflowchar [nil Character] :padchar [\space Character] 
317.1360 +    :exponentchar [nil Character] ]
317.1361 +   #{ :at } {}
317.1362 +   general-float)
317.1363 +
317.1364 +  (\$
317.1365 +   [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]]
317.1366 +   #{ :at :colon :both} {}
317.1367 +   dollar-float)
317.1368 +
317.1369 +  (\% 
317.1370 +   [ :count [1 Integer] ] 
317.1371 +   #{ } {}
317.1372 +   (fn [params arg-navigator offsets]
317.1373 +     (dotimes [i (:count params)]
317.1374 +       (prn))
317.1375 +     arg-navigator))
317.1376 +
317.1377 +  (\&
317.1378 +   [ :count [1 Integer] ] 
317.1379 +   #{ :pretty } {}
317.1380 +   (fn [params arg-navigator offsets]
317.1381 +     (let [cnt (:count params)]
317.1382 +       (if (pos? cnt) (fresh-line))
317.1383 +       (dotimes [i (dec cnt)]
317.1384 +         (prn)))
317.1385 +     arg-navigator))
317.1386 +
317.1387 +  (\| 
317.1388 +   [ :count [1 Integer] ] 
317.1389 +   #{ } {}
317.1390 +   (fn [params arg-navigator offsets]
317.1391 +     (dotimes [i (:count params)]
317.1392 +       (print \formfeed))
317.1393 +     arg-navigator))
317.1394 +
317.1395 +  (\~ 
317.1396 +   [ :n [1 Integer] ] 
317.1397 +   #{ } {}
317.1398 +   (fn [params arg-navigator offsets]
317.1399 +     (let [n (:n params)]
317.1400 +       (print (apply str (repeat n \~)))
317.1401 +       arg-navigator)))
317.1402 +
317.1403 +  (\newline ;; Whitespace supression is handled in the compilation loop
317.1404 +   [ ] 
317.1405 +   #{:colon :at} {}
317.1406 +   (fn [params arg-navigator offsets]
317.1407 +     (if (:at params)
317.1408 +       (prn))
317.1409 +     arg-navigator))
317.1410 +
317.1411 +  (\T
317.1412 +   [ :colnum [1 Integer] :colinc [1 Integer] ] 
317.1413 +   #{ :at :pretty } {}
317.1414 +   (if (:at params)
317.1415 +     #(relative-tabulation %1 %2 %3)
317.1416 +     #(absolute-tabulation %1 %2 %3)))
317.1417 +
317.1418 +  (\* 
317.1419 +   [ :n [1 Integer] ] 
317.1420 +   #{ :colon :at } {}
317.1421 +   (fn [params navigator offsets]
317.1422 +     (let [n (:n params)]
317.1423 +       (if (:at params)
317.1424 +         (absolute-reposition navigator n)
317.1425 +         (relative-reposition navigator (if (:colon params) (- n) n)))
317.1426 +       )))
317.1427 +
317.1428 +  (\? 
317.1429 +   [ ] 
317.1430 +   #{ :at } {}
317.1431 +   (if (:at params)
317.1432 +     (fn [params navigator offsets]     ; args from main arg list
317.1433 +       (let [[subformat navigator] (get-format-arg navigator)]
317.1434 +         (execute-sub-format subformat navigator  (:base-args params))))
317.1435 +     (fn [params navigator offsets]     ; args from sub-list
317.1436 +       (let [[subformat navigator] (get-format-arg navigator)
317.1437 +             [subargs navigator] (next-arg navigator)
317.1438 +             sub-navigator (init-navigator subargs)]
317.1439 +         (execute-sub-format subformat sub-navigator (:base-args params))
317.1440 +         navigator))))
317.1441 +       
317.1442 +
317.1443 +  (\(
317.1444 +   [ ]
317.1445 +   #{ :colon :at :both} { :right \), :allows-separator nil, :else nil }
317.1446 +   (let [mod-case-writer (cond
317.1447 +                           (and (:at params) (:colon params))
317.1448 +                           upcase-writer
317.1449 +
317.1450 +                           (:colon params)
317.1451 +                           capitalize-word-writer
317.1452 +
317.1453 +                           (:at params)
317.1454 +                           init-cap-writer
317.1455 +
317.1456 +                           :else
317.1457 +                           downcase-writer)]
317.1458 +     #(modify-case mod-case-writer %1 %2 %3)))
317.1459 +
317.1460 +  (\) [] #{} {} nil) 
317.1461 +
317.1462 +  (\[
317.1463 +   [ :selector [nil Integer] ]
317.1464 +   #{ :colon :at } { :right \], :allows-separator true, :else :last }
317.1465 +   (cond
317.1466 +     (:colon params)
317.1467 +     boolean-conditional
317.1468 +
317.1469 +     (:at params)
317.1470 +     check-arg-conditional
317.1471 +
317.1472 +     true
317.1473 +     choice-conditional))
317.1474 +
317.1475 +  (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] 
317.1476 +   #{ :colon } { :separator true } nil) 
317.1477 +   
317.1478 +  (\] [] #{} {} nil) 
317.1479 +
317.1480 +  (\{
317.1481 +   [ :max-iterations [nil Integer] ]
317.1482 +   #{ :colon :at :both} { :right \}, :allows-separator false }
317.1483 +   (cond
317.1484 +     (and (:at params) (:colon params))
317.1485 +     iterate-main-sublists
317.1486 +
317.1487 +     (:colon params)
317.1488 +     iterate-list-of-sublists
317.1489 +
317.1490 +     (:at params)
317.1491 +     iterate-main-list
317.1492 +
317.1493 +     true
317.1494 +     iterate-sublist))
317.1495 +
317.1496 +   
317.1497 +  (\} [] #{:colon} {} nil) 
317.1498 +
317.1499 +  (\<
317.1500 +   [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]]
317.1501 +   #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first }
317.1502 +   logical-block-or-justify)
317.1503 +
317.1504 +  (\> [] #{:colon} {} nil) 
317.1505 +
317.1506 +  ;; TODO: detect errors in cases where colon not allowed
317.1507 +  (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] 
317.1508 +   #{:colon} {} 
317.1509 +   (fn [params navigator offsets]
317.1510 +     (let [arg1 (:arg1 params)
317.1511 +           arg2 (:arg2 params)
317.1512 +           arg3 (:arg3 params)
317.1513 +           exit (if (:colon params) :colon-up-arrow :up-arrow)]
317.1514 +       (cond
317.1515 +         (and arg1 arg2 arg3)
317.1516 +         (if (<= arg1 arg2 arg3) [exit navigator] navigator)
317.1517 +
317.1518 +         (and arg1 arg2)
317.1519 +         (if (= arg1 arg2) [exit navigator] navigator)
317.1520 +
317.1521 +         arg1
317.1522 +         (if (= arg1 0) [exit navigator] navigator)
317.1523 +
317.1524 +         true     ; TODO: handle looking up the arglist stack for info
317.1525 +         (if (if (:colon params) 
317.1526 +               (empty? (:rest (:base-args params)))
317.1527 +               (empty? (:rest navigator)))
317.1528 +           [exit navigator] navigator))))) 
317.1529 +
317.1530 +  (\W 
317.1531 +   [] 
317.1532 +   #{:at :colon :both} {}
317.1533 +   (if (or (:at params) (:colon params))
317.1534 +     (let [bindings (concat
317.1535 +                     (if (:at params) [:level nil :length nil] [])
317.1536 +                     (if (:colon params) [:pretty true] []))]
317.1537 +       (fn [params navigator offsets]
317.1538 +         (let [[arg navigator] (next-arg navigator)]
317.1539 +           (if (apply write arg bindings)
317.1540 +             [:up-arrow navigator]
317.1541 +             navigator))))
317.1542 +     (fn [params navigator offsets]
317.1543 +       (let [[arg navigator] (next-arg navigator)]
317.1544 +         (if (write-out arg)
317.1545 +           [:up-arrow navigator]
317.1546 +           navigator)))))
317.1547 +
317.1548 +  (\_
317.1549 +   []
317.1550 +   #{:at :colon :both} {}
317.1551 +   conditional-newline)
317.1552 +
317.1553 +  (\I
317.1554 +   [:n [0 Integer]]
317.1555 +   #{:colon} {}
317.1556 +   set-indent)
317.1557 +  )
317.1558 +
317.1559 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1560 +;;; Code to manage the parameters and flags associated with each
317.1561 +;;; directive in the format string.
317.1562 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317.1563 +
317.1564 +(def ^{:private true}
317.1565 +     param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))")
317.1566 +(def ^{:private true}
317.1567 +     special-params #{ :parameter-from-args :remaining-arg-count })
317.1568 +
317.1569 +(defn- extract-param [[s offset saw-comma]]
317.1570 +  (let [m (re-matcher param-pattern s)
317.1571 +        param (re-find m)]
317.1572 +    (if param
317.1573 +      (let [token-str (first (re-groups m))
317.1574 +            remainder (subs s (.end m))
317.1575 +            new-offset (+ offset (.end m))]
317.1576 +        (if (not (= \, (nth remainder 0)))
317.1577 +          [ [token-str offset] [remainder new-offset false]]
317.1578 +          [ [token-str offset] [(subs remainder 1) (inc new-offset) true]]))
317.1579 +      (if saw-comma 
317.1580 +        (format-error "Badly formed parameters in format directive" offset)
317.1581 +        [ nil [s offset]]))))
317.1582 +
317.1583 +
317.1584 +(defn- extract-params [s offset] 
317.1585 +  (consume extract-param [s offset false]))
317.1586 +
317.1587 +(defn- translate-param
317.1588 +  "Translate the string representation of a param to the internalized
317.1589 +                                      representation"
317.1590 +  [[^String p offset]]
317.1591 +  [(cond 
317.1592 +    (= (.length p) 0) nil
317.1593 +    (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args
317.1594 +    (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count
317.1595 +    (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1)
317.1596 +    true (new Integer p))
317.1597 +   offset])
317.1598 + 
317.1599 +(def ^{:private true}
317.1600 +     flag-defs { \: :colon, \@ :at })
317.1601 +
317.1602 +(defn- extract-flags [s offset]
317.1603 +  (consume
317.1604 +   (fn [[s offset flags]]
317.1605 +     (if (empty? s)
317.1606 +       [nil [s offset flags]]
317.1607 +       (let [flag (get flag-defs (first s))]
317.1608 +         (if flag
317.1609 +           (if (contains? flags flag)
317.1610 +             (format-error 
317.1611 +              (str "Flag \"" (first s) "\" appears more than once in a directive")
317.1612 +              offset)
317.1613 +             [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]])
317.1614 +           [nil [s offset flags]]))))
317.1615 +   [s offset {}]))
317.1616 +
317.1617 +(defn- check-flags [def flags]
317.1618 +  (let [allowed (:flags def)]
317.1619 +    (if (and (not (:at allowed)) (:at flags))
317.1620 +      (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"")
317.1621 +                    (nth (:at flags) 1)))
317.1622 +    (if (and (not (:colon allowed)) (:colon flags))
317.1623 +      (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"")
317.1624 +                    (nth (:colon flags) 1)))
317.1625 +    (if (and (not (:both allowed)) (:at flags) (:colon flags))
317.1626 +      (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" 
317.1627 +                         (:directive def) "\"")
317.1628 +                    (min (nth (:colon flags) 1) (nth (:at flags) 1))))))
317.1629 +
317.1630 +(defn- map-params
317.1631 +  "Takes a directive definition and the list of actual parameters and
317.1632 +a map of flags and returns a map of the parameters and flags with defaults
317.1633 +filled in. We check to make sure that there are the right types and number
317.1634 +of parameters as well."
317.1635 +  [def params flags offset]
317.1636 +  (check-flags def flags)
317.1637 +  (if (> (count params) (count (:params def)))
317.1638 +    (format-error 
317.1639 +     (cl-format 
317.1640 +      nil 
317.1641 +      "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed"
317.1642 +      (:directive def) (count params) (count (:params def)))
317.1643 +     (second (first params))))
317.1644 +  (doall
317.1645 +   (map #(let [val (first %1)]
317.1646 +           (if (not (or (nil? val) (contains? special-params val) 
317.1647 +                        (instance? (second (second %2)) val)))
317.1648 +             (format-error (str "Parameter " (name (first %2))
317.1649 +                                " has bad type in directive \"" (:directive def) "\": "
317.1650 +                                (class val))
317.1651 +                           (second %1))) )
317.1652 +        params (:params def)))
317.1653 +     
317.1654 +  (merge                                ; create the result map
317.1655 +   (into (array-map) ; start with the default values, make sure the order is right
317.1656 +         (reverse (for [[name [default]] (:params def)] [name [default offset]])))
317.1657 +   (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils
317.1658 +   flags))                                ; and finally add the flags
317.1659 +
317.1660 +(defn- compile-directive [s offset]
317.1661 +  (let [[raw-params [rest offset]] (extract-params s offset)
317.1662 +        [_ [rest offset flags]] (extract-flags rest offset)
317.1663 +        directive (first rest)
317.1664 +        def (get directive-table (Character/toUpperCase ^Character directive))
317.1665 +        params (if def (map-params def (map translate-param raw-params) flags offset))]
317.1666 +    (if (not directive)
317.1667 +      (format-error "Format string ended in the middle of a directive" offset))
317.1668 +    (if (not def)
317.1669 +      (format-error (str "Directive \"" directive "\" is undefined") offset))
317.1670 +    [(struct compiled-directive ((:generator-fn def) params offset) def params offset)
317.1671 +     (let [remainder (subs rest 1) 
317.1672 +           offset (inc offset)
317.1673 +           trim? (and (= \newline (:directive def))
317.1674 +                      (not (:colon params)))
317.1675 +           trim-count (if trim? (prefix-count remainder [\space \tab]) 0)
317.1676 +           remainder (subs remainder trim-count)
317.1677 +           offset (+ offset trim-count)]
317.1678 +       [remainder offset])]))
317.1679 +    
317.1680 +(defn- compile-raw-string [s offset]
317.1681 +  (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset))
317.1682 +
317.1683 +(defn- right-bracket [this] (:right (:bracket-info (:def this))))
317.1684 +(defn- separator? [this] (:separator (:bracket-info (:def this))))
317.1685 +(defn- else-separator? [this] 
317.1686 +  (and (:separator (:bracket-info (:def this)))
317.1687 +       (:colon (:params this))))
317.1688 +  
317.1689 +
317.1690 +(declare collect-clauses)
317.1691 +
317.1692 +(defn- process-bracket [this remainder]
317.1693 +  (let [[subex remainder] (collect-clauses (:bracket-info (:def this))
317.1694 +                                           (:offset this) remainder)]
317.1695 +    [(struct compiled-directive 
317.1696 +             (:func this) (:def this) 
317.1697 +             (merge (:params this) (tuple-map subex (:offset this)))
317.1698 +             (:offset this))
317.1699 +     remainder]))
317.1700 +
317.1701 +(defn- process-clause [bracket-info offset remainder]
317.1702 +  (consume 
317.1703 +   (fn [remainder]
317.1704 +     (if (empty? remainder)
317.1705 +       (format-error "No closing bracket found." offset)
317.1706 +       (let [this (first remainder)
317.1707 +             remainder (next remainder)]
317.1708 +         (cond
317.1709 +          (right-bracket this)
317.1710 +          (process-bracket this remainder)
317.1711 +
317.1712 +          (= (:right bracket-info) (:directive (:def this)))
317.1713 +          [ nil [:right-bracket (:params this) nil remainder]]
317.1714 +
317.1715 +          (else-separator? this)
317.1716 +          [nil [:else nil (:params this) remainder]]
317.1717 +
317.1718 +          (separator? this)
317.1719 +          [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~;
317.1720 +
317.1721 +          true
317.1722 +          [this remainder]))))
317.1723 +   remainder))
317.1724 +
317.1725 +(defn- collect-clauses [bracket-info offset remainder]
317.1726 +  (second
317.1727 +   (consume
317.1728 +    (fn [[clause-map saw-else remainder]]
317.1729 +      (let [[clause [type right-params else-params remainder]] 
317.1730 +            (process-clause bracket-info offset remainder)]
317.1731 +        (cond
317.1732 +         (= type :right-bracket)
317.1733 +         [nil [(merge-with concat clause-map 
317.1734 +                           {(if saw-else :else :clauses) [clause] 
317.1735 +                            :right-params right-params})
317.1736 +               remainder]]
317.1737 +
317.1738 +         (= type :else)
317.1739 +         (cond
317.1740 +          (:else clause-map)
317.1741 +          (format-error "Two else clauses (\"~:;\") inside bracket construction." offset)
317.1742 +         
317.1743 +          (not (:else bracket-info))
317.1744 +          (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." 
317.1745 +                        offset)
317.1746 +
317.1747 +          (and (= :first (:else bracket-info)) (seq (:clauses clause-map)))
317.1748 +          (format-error
317.1749 +           "The else clause (\"~:;\") is only allowed in the first position for this directive." 
317.1750 +           offset)
317.1751 +         
317.1752 +          true         ; if the ~:; is in the last position, the else clause
317.1753 +                                        ; is next, this was a regular clause
317.1754 +          (if (= :first (:else bracket-info))
317.1755 +            [true [(merge-with concat clause-map { :else [clause] :else-params else-params})
317.1756 +                   false remainder]]
317.1757 +            [true [(merge-with concat clause-map { :clauses [clause] })
317.1758 +                   true remainder]]))
317.1759 +
317.1760 +         (= type :separator)
317.1761 +         (cond
317.1762 +          saw-else
317.1763 +          (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset)
317.1764 +         
317.1765 +          (not (:allows-separator bracket-info))
317.1766 +          (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." 
317.1767 +                        offset)
317.1768 +         
317.1769 +          true
317.1770 +          [true [(merge-with concat clause-map { :clauses [clause] })
317.1771 +                 false remainder]]))))
317.1772 +    [{ :clauses [] } false remainder])))
317.1773 +
317.1774 +(defn- process-nesting
317.1775 +  "Take a linearly compiled format and process the bracket directives to give it 
317.1776 +   the appropriate tree structure"
317.1777 +  [format]
317.1778 +  (first
317.1779 +   (consume 
317.1780 +    (fn [remainder]
317.1781 +      (let [this (first remainder)
317.1782 +            remainder (next remainder)
317.1783 +            bracket (:bracket-info (:def this))]
317.1784 +        (if (:right bracket)
317.1785 +          (process-bracket this remainder)
317.1786 +          [this remainder])))
317.1787 +    format)))
317.1788 +
317.1789 +(defn- compile-format 
317.1790 +  "Compiles format-str into a compiled format which can be used as an argument
317.1791 +to cl-format just like a plain format string. Use this function for improved 
317.1792 +performance when you're using the same format string repeatedly"
317.1793 +  [ format-str ]
317.1794 +;  (prlabel compiling format-str)
317.1795 +  (binding [*format-str* format-str]
317.1796 +    (process-nesting
317.1797 +     (first 
317.1798 +      (consume 
317.1799 +       (fn [[^String s offset]]
317.1800 +         (if (empty? s)
317.1801 +           [nil s]
317.1802 +           (let [tilde (.indexOf s (int \~))]
317.1803 +             (cond
317.1804 +              (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]]
317.1805 +              (zero? tilde)  (compile-directive (subs s 1) (inc offset))
317.1806 +              true 
317.1807 +              [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]]))))
317.1808 +       [format-str 0])))))
317.1809 +
317.1810 +(defn- needs-pretty 
317.1811 +  "determine whether a given compiled format has any directives that depend on the
317.1812 +column number or pretty printing"
317.1813 +  [format]
317.1814 +  (loop [format format]
317.1815 +    (if (empty? format)
317.1816 +      false
317.1817 +      (if (or (:pretty (:flags (:def (first format))))
317.1818 +              (some needs-pretty (first (:clauses (:params (first format)))))
317.1819 +              (some needs-pretty (first (:else (:params (first format))))))
317.1820 +        true
317.1821 +        (recur (next format))))))
317.1822 +
317.1823 +(defn- execute-format 
317.1824 +  "Executes the format with the arguments."
317.1825 +  {:skip-wiki true}
317.1826 +  ([stream format args]
317.1827 +     (let [^java.io.Writer real-stream (cond 
317.1828 +                                         (not stream) (java.io.StringWriter.)
317.1829 +                                         (true? stream) *out*
317.1830 +                                         :else stream)
317.1831 +           ^java.io.Writer wrapped-stream (if (and (needs-pretty format) 
317.1832 +                                                    (not (pretty-writer? real-stream)))
317.1833 +                                             (get-pretty-writer real-stream)
317.1834 +                                             real-stream)]
317.1835 +       (binding [*out* wrapped-stream]
317.1836 +         (try
317.1837 +          (execute-format format args)
317.1838 +          (finally
317.1839 +           (if-not (identical? real-stream wrapped-stream)
317.1840 +             (.flush wrapped-stream))))
317.1841 +         (if (not stream) (.toString real-stream)))))
317.1842 +  ([format args]
317.1843 +     (map-passing-context 
317.1844 +      (fn [element context]
317.1845 +        (if (abort? context)
317.1846 +          [nil context]
317.1847 +          (let [[params args] (realize-parameter-list 
317.1848 +                               (:params element) context)
317.1849 +                [params offsets] (unzip-map params)
317.1850 +                params (assoc params :base-args args)]
317.1851 +            [nil (apply (:func element) [params args offsets])])))
317.1852 +      args
317.1853 +      format)
317.1854 +     nil))
317.1855 +
317.1856 +;;; This is a bad idea, but it prevents us from leaking private symbols
317.1857 +;;; This should all be replaced by really compiled formats anyway.
317.1858 +(def ^{:private true} cached-compile (memoize compile-format))
317.1859 +
317.1860 +(defmacro formatter
317.1861 +  "Makes a function which can directly run format-in. The function is
317.1862 +fn [stream & args] ... and returns nil unless the stream is nil (meaning 
317.1863 +output to a string) in which case it returns the resulting string.
317.1864 +
317.1865 +format-in can be either a control string or a previously compiled format."
317.1866 +  {:added "1.2"}
317.1867 +  [format-in]
317.1868 +  `(let [format-in# ~format-in
317.1869 +         my-c-c# (var-get (get (ns-interns (the-ns 'clojure.pprint))
317.1870 +                               '~'cached-compile))
317.1871 +         my-e-f# (var-get (get (ns-interns (the-ns 'clojure.pprint))
317.1872 +                               '~'execute-format))
317.1873 +         my-i-n# (var-get (get (ns-interns (the-ns 'clojure.pprint))
317.1874 +                               '~'init-navigator))
317.1875 +         cf# (if (string? format-in#) (my-c-c# format-in#) format-in#)]
317.1876 +     (fn [stream# & args#]
317.1877 +       (let [navigator# (my-i-n# args#)]
317.1878 +         (my-e-f# stream# cf# navigator#)))))
317.1879 +
317.1880 +(defmacro formatter-out
317.1881 +  "Makes a function which can directly run format-in. The function is
317.1882 +fn [& args] ... and returns nil. This version of the formatter macro is
317.1883 +designed to be used with *out* set to an appropriate Writer. In particular,
317.1884 +this is meant to be used as part of a pretty printer dispatch method.
317.1885 +
317.1886 +format-in can be either a control string or a previously compiled format."
317.1887 +  {:added "1.2"}
317.1888 +  [format-in]
317.1889 +  `(let [format-in# ~format-in
317.1890 +         cf# (if (string? format-in#) (#'clojure.pprint/cached-compile format-in#) format-in#)]
317.1891 +     (fn [& args#]
317.1892 +       (let [navigator# (#'clojure.pprint/init-navigator args#)]
317.1893 +         (#'clojure.pprint/execute-format cf# navigator#)))))
   318.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   318.2 +++ b/src/clojure/pprint/column_writer.clj	Sat Aug 21 06:25:44 2010 -0400
   318.3 @@ -0,0 +1,79 @@
   318.4 +;;; column_writer.clj -- part of the pretty printer for Clojure
   318.5 +
   318.6 +
   318.7 +;   Copyright (c) Rich Hickey. All rights reserved.
   318.8 +;   The use and distribution terms for this software are covered by the
   318.9 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  318.10 +;   which can be found in the file epl-v10.html at the root of this distribution.
  318.11 +;   By using this software in any fashion, you are agreeing to be bound by
  318.12 +;   the terms of this license.
  318.13 +;   You must not remove this notice, or any other, from this software.
  318.14 +
  318.15 +;; Author: Tom Faulhaber
  318.16 +;; April 3, 2009
  318.17 +;; Revised to use proxy instead of gen-class April 2010
  318.18 +
  318.19 +;; This module implements a column-aware wrapper around an instance of java.io.Writer
  318.20 +
  318.21 +(in-ns 'clojure.pprint)
  318.22 +
  318.23 +(import [clojure.lang IDeref]
  318.24 +        [java.io Writer])
  318.25 +
  318.26 +(def ^{:private true} *default-page-width* 72)
  318.27 +
  318.28 +(defn- get-field [^Writer this sym]
  318.29 +  (sym @@this))
  318.30 +
  318.31 +(defn- set-field [^Writer this sym new-val] 
  318.32 +  (alter @this assoc sym new-val))
  318.33 +
  318.34 +(defn- get-column [this]
  318.35 +  (get-field this :cur))
  318.36 +
  318.37 +(defn- get-line [this]
  318.38 +  (get-field this :line))
  318.39 +
  318.40 +(defn- get-max-column [this]
  318.41 +  (get-field this :max))
  318.42 +
  318.43 +(defn- set-max-column [this new-max]
  318.44 +  (dosync (set-field this :max new-max))
  318.45 +  nil)
  318.46 +
  318.47 +(defn- get-writer [this]
  318.48 +  (get-field this :base))
  318.49 +
  318.50 +(defn- c-write-char [^Writer this ^Integer c]
  318.51 +  (dosync (if (= c (int \newline))
  318.52 +	    (do
  318.53 +              (set-field this :cur 0)
  318.54 +              (set-field this :line (inc (get-field this :line))))
  318.55 +	    (set-field this :cur (inc (get-field this :cur)))))
  318.56 +  (.write ^Writer (get-field this :base) c))
  318.57 +
  318.58 +(defn- column-writer   
  318.59 +  ([writer] (column-writer writer *default-page-width*))
  318.60 +  ([writer max-columns]
  318.61 +     (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})]
  318.62 +       (proxy [Writer IDeref] []
  318.63 +         (deref [] fields)
  318.64 +         (write
  318.65 +          ([^chars cbuf ^Integer off ^Integer len] 
  318.66 +             (let [^Writer writer (get-field this :base)] 
  318.67 +               (.write writer cbuf off len)))
  318.68 +          ([x]
  318.69 +             (condp = (class x)
  318.70 +               String 
  318.71 +               (let [^String s x
  318.72 +                     nl (.lastIndexOf s (int \newline))]
  318.73 +                 (dosync (if (neg? nl)
  318.74 +                           (set-field this :cur (+ (get-field this :cur) (count s)))
  318.75 +                           (do
  318.76 +                             (set-field this :cur (- (count s) nl 1))
  318.77 +                             (set-field this :line (+ (get-field this :line)
  318.78 +                                                      (count (filter #(= % \newline) s)))))))
  318.79 +                 (.write ^Writer (get-field this :base) s))
  318.80 +
  318.81 +               Integer
  318.82 +               (c-write-char this x))))))))
   319.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   319.2 +++ b/src/clojure/pprint/dispatch.clj	Sat Aug 21 06:25:44 2010 -0400
   319.3 @@ -0,0 +1,467 @@
   319.4 +;; dispatch.clj -- part of the pretty printer for Clojure
   319.5 +
   319.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   319.7 +;   The use and distribution terms for this software are covered by the
   319.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   319.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  319.10 +;   By using this software in any fashion, you are agreeing to be bound by
  319.11 +;   the terms of this license.
  319.12 +;   You must not remove this notice, or any other, from this software.
  319.13 +
  319.14 +;; Author: Tom Faulhaber
  319.15 +;; April 3, 2009
  319.16 +
  319.17 +
  319.18 +;; This module implements the default dispatch tables for pretty printing code and
  319.19 +;; data.
  319.20 +
  319.21 +(in-ns 'clojure.pprint)
  319.22 +
  319.23 +(defn- use-method
  319.24 +  "Installs a function as a new method of multimethod associated with dispatch-value. "
  319.25 +  [multifn dispatch-val func]
  319.26 +  (. multifn addMethod dispatch-val func))
  319.27 +
  319.28 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  319.29 +;; Implementations of specific dispatch table entries
  319.30 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  319.31 +
  319.32 +;;; Handle forms that can be "back-translated" to reader macros
  319.33 +;;; Not all reader macros can be dealt with this way or at all. 
  319.34 +;;; Macros that we can't deal with at all are:
  319.35 +;;; ;  - The comment character is aborbed by the reader and never is part of the form
  319.36 +;;; `  - Is fully processed at read time into a lisp expression (which will contain concats
  319.37 +;;;      and regular quotes).
  319.38 +;;; ~@ - Also fully eaten by the processing of ` and can't be used outside.
  319.39 +;;; ,  - is whitespace and is lost (like all other whitespace). Formats can generate commas
  319.40 +;;;      where they deem them useful to help readability.
  319.41 +;;; ^  - Adding metadata completely disappears at read time and the data appears to be
  319.42 +;;;      completely lost.
  319.43 +;;;
  319.44 +;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{})
  319.45 +;;; or directly by printing the objects using Clojure's built-in print functions (like
  319.46 +;;; :keyword, \char, or ""). The notable exception is #() which is special-cased.
  319.47 +
  319.48 +(def ^{:private true} reader-macros
  319.49 +     {'quote "'", 'clojure.core/deref "@", 
  319.50 +      'var "#'", 'clojure.core/unquote "~"})
  319.51 +
  319.52 +(defn- pprint-reader-macro [alis]
  319.53 +  (let [^String macro-char (reader-macros (first alis))]
  319.54 +    (when (and macro-char (= 2 (count alis)))
  319.55 +      (.write ^java.io.Writer *out* macro-char)
  319.56 +      (write-out (second alis))
  319.57 +      true)))
  319.58 +
  319.59 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  319.60 +;; Dispatch for the basic data types when interpreted
  319.61 +;; as data (as opposed to code).
  319.62 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  319.63 +
  319.64 +;;; TODO: inline these formatter statements into funcs so that we
  319.65 +;;; are a little easier on the stack. (Or, do "real" compilation, a
  319.66 +;;; la Common Lisp)
  319.67 +
  319.68 +;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>"))
  319.69 +(defn- pprint-simple-list [alis]
  319.70 +  (pprint-logical-block :prefix "(" :suffix ")"
  319.71 +    (loop [alis (seq alis)]
  319.72 +      (when alis
  319.73 +	(write-out (first alis))
  319.74 +	(when (next alis)
  319.75 +	  (.write ^java.io.Writer *out* " ")
  319.76 +	  (pprint-newline :linear)
  319.77 +	  (recur (next alis)))))))
  319.78 +
  319.79 +(defn- pprint-list [alis]
  319.80 +  (if-not (pprint-reader-macro alis)
  319.81 +    (pprint-simple-list alis)))
  319.82 +
  319.83 +;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>"))
  319.84 +(defn- pprint-vector [avec]
  319.85 +  (pprint-logical-block :prefix "[" :suffix "]"
  319.86 +    (loop [aseq (seq avec)]
  319.87 +      (when aseq
  319.88 +	(write-out (first aseq))
  319.89 +	(when (next aseq)
  319.90 +	  (.write ^java.io.Writer *out* " ")
  319.91 +	  (pprint-newline :linear)
  319.92 +	  (recur (next aseq)))))))
  319.93 +
  319.94 +(def ^{:private true} pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>"))
  319.95 +
  319.96 +;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>"))
  319.97 +(defn- pprint-map [amap]
  319.98 +  (pprint-logical-block :prefix "{" :suffix "}"
  319.99 +    (loop [aseq (seq amap)]
 319.100 +      (when aseq
 319.101 +	(pprint-logical-block 
 319.102 +          (write-out (ffirst aseq))
 319.103 +          (.write ^java.io.Writer *out* " ")
 319.104 +          (pprint-newline :linear)
 319.105 +          (write-out (fnext (first aseq))))
 319.106 +        (when (next aseq)
 319.107 +          (.write ^java.io.Writer *out* ", ")
 319.108 +          (pprint-newline :linear)
 319.109 +          (recur (next aseq)))))))
 319.110 +
 319.111 +(def ^{:private true} pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>"))
 319.112 +
 319.113 +;;; TODO: don't block on promise (currently impossible)
 319.114 +
 319.115 +(def ^{:private true} 
 319.116 +     type-map {"core$future_call" "Future",
 319.117 +               "core$promise" "Promise"})
 319.118 +
 319.119 +(defn- map-ref-type 
 319.120 +  "Map ugly type names to something simpler"
 319.121 +  [name]
 319.122 +  (or (when-let [match (re-find #"^[^$]+\$[^$]+" name)]
 319.123 +        (type-map match))
 319.124 +      name))
 319.125 +
 319.126 +(defn- pprint-ideref [o]
 319.127 +  (let [prefix (format "#<%s@%x%s: "
 319.128 +                       (map-ref-type (.getSimpleName (class o)))
 319.129 +                       (System/identityHashCode o)
 319.130 +                       (if (and (instance? clojure.lang.Agent o)
 319.131 +                                (agent-error o))
 319.132 +                         " FAILED"
 319.133 +                         ""))]
 319.134 +    (pprint-logical-block  :prefix prefix :suffix ">"
 319.135 +                           (pprint-indent :block (-> (count prefix) (- 2) -))
 319.136 +                           (pprint-newline :linear)
 319.137 +                           (write-out (cond 
 319.138 +                                       (and (future? o) (not (future-done? o))) :pending
 319.139 +                                       :else @o)))))
 319.140 +
 319.141 +(def ^{:private true} pprint-pqueue (formatter-out "~<<-(~;~@{~w~^ ~_~}~;)-<~:>"))
 319.142 +
 319.143 +(defn- pprint-simple-default [obj]
 319.144 +  (cond 
 319.145 +    (.isArray (class obj)) (pprint-array obj)
 319.146 +    (and *print-suppress-namespaces* (symbol? obj)) (print (name obj))
 319.147 +    :else (pr obj)))
 319.148 +
 319.149 +
 319.150 +(defmulti 
 319.151 +  simple-dispatch
 319.152 +  "The pretty print dispatch function for simple data structure format."
 319.153 +  {:added "1.2" :arglists '[[object]]} 
 319.154 +  class)
 319.155 +
 319.156 +(use-method simple-dispatch clojure.lang.ISeq pprint-list)
 319.157 +(use-method simple-dispatch clojure.lang.IPersistentVector pprint-vector)
 319.158 +(use-method simple-dispatch clojure.lang.IPersistentMap pprint-map)
 319.159 +(use-method simple-dispatch clojure.lang.IPersistentSet pprint-set)
 319.160 +(use-method simple-dispatch clojure.lang.PersistentQueue pprint-pqueue)
 319.161 +(use-method simple-dispatch clojure.lang.IDeref pprint-ideref)
 319.162 +(use-method simple-dispatch nil pr)
 319.163 +(use-method simple-dispatch :default pprint-simple-default)
 319.164 +
 319.165 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.166 +;;; Dispatch for the code table
 319.167 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.168 +
 319.169 +(declare pprint-simple-code-list)
 319.170 +
 319.171 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.172 +;;; Format something that looks like a simple def (sans metadata, since the reader
 319.173 +;;; won't give it to us now).
 319.174 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.175 +
 319.176 +(def ^{:private true} pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>"))
 319.177 +
 319.178 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.179 +;;; Format something that looks like a defn or defmacro
 319.180 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.181 +
 319.182 +;;; Format the params and body of a defn with a single arity
 319.183 +(defn- single-defn [alis has-doc-str?]
 319.184 +  (if (seq alis)
 319.185 +    (do
 319.186 +      (if has-doc-str?
 319.187 +        ((formatter-out " ~_"))
 319.188 +        ((formatter-out " ~@_")))
 319.189 +      ((formatter-out "~{~w~^ ~_~}") alis))))
 319.190 +
 319.191 +;;; Format the param and body sublists of a defn with multiple arities
 319.192 +(defn- multi-defn [alis has-doc-str?]
 319.193 +  (if (seq alis)
 319.194 +    ((formatter-out " ~_~{~w~^ ~_~}") alis)))
 319.195 +
 319.196 +;;; TODO: figure out how to support capturing metadata in defns (we might need a 
 319.197 +;;; special reader)
 319.198 +(defn- pprint-defn [alis]
 319.199 +  (if (next alis) 
 319.200 +    (let [[defn-sym defn-name & stuff] alis
 319.201 +          [doc-str stuff] (if (string? (first stuff))
 319.202 +                            [(first stuff) (next stuff)]
 319.203 +                            [nil stuff])
 319.204 +          [attr-map stuff] (if (map? (first stuff))
 319.205 +                             [(first stuff) (next stuff)]
 319.206 +                             [nil stuff])]
 319.207 +      (pprint-logical-block :prefix "(" :suffix ")"
 319.208 +        ((formatter-out "~w ~1I~@_~w") defn-sym defn-name)
 319.209 +        (if doc-str
 319.210 +          ((formatter-out " ~_~w") doc-str))
 319.211 +        (if attr-map
 319.212 +          ((formatter-out " ~_~w") attr-map))
 319.213 +        ;; Note: the multi-defn case will work OK for malformed defns too
 319.214 +        (cond
 319.215 +         (vector? (first stuff)) (single-defn stuff (or doc-str attr-map))
 319.216 +         :else (multi-defn stuff (or doc-str attr-map)))))
 319.217 +    (pprint-simple-code-list alis)))
 319.218 +
 319.219 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.220 +;;; Format something with a binding form
 319.221 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.222 +
 319.223 +(defn- pprint-binding-form [binding-vec]
 319.224 +  (pprint-logical-block :prefix "[" :suffix "]"
 319.225 +    (loop [binding binding-vec]
 319.226 +      (when (seq binding)
 319.227 +        (pprint-logical-block binding
 319.228 +          (write-out (first binding))
 319.229 +          (when (next binding)
 319.230 +            (.write ^java.io.Writer *out* " ")
 319.231 +            (pprint-newline :miser)
 319.232 +            (write-out (second binding))))
 319.233 +        (when (next (rest binding))
 319.234 +          (.write ^java.io.Writer *out* " ")
 319.235 +          (pprint-newline :linear)
 319.236 +          (recur (next (rest binding))))))))
 319.237 +
 319.238 +(defn- pprint-let [alis]
 319.239 +  (let [base-sym (first alis)]
 319.240 +    (pprint-logical-block :prefix "(" :suffix ")"
 319.241 +      (if (and (next alis) (vector? (second alis)))
 319.242 +        (do
 319.243 +          ((formatter-out "~w ~1I~@_") base-sym)
 319.244 +          (pprint-binding-form (second alis))
 319.245 +          ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis))))
 319.246 +        (pprint-simple-code-list alis)))))
 319.247 +
 319.248 +
 319.249 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.250 +;;; Format something that looks like "if"
 319.251 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.252 +
 319.253 +(def ^{:private true} pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>"))
 319.254 +
 319.255 +(defn- pprint-cond [alis]
 319.256 +  (pprint-logical-block :prefix "(" :suffix ")"
 319.257 +    (pprint-indent :block 1)
 319.258 +    (write-out (first alis))
 319.259 +    (when (next alis)
 319.260 +      (.write ^java.io.Writer *out* " ")
 319.261 +      (pprint-newline :linear)
 319.262 +     (loop [alis (next alis)]
 319.263 +       (when alis
 319.264 +         (pprint-logical-block alis
 319.265 +          (write-out (first alis))
 319.266 +          (when (next alis)
 319.267 +            (.write ^java.io.Writer *out* " ")
 319.268 +            (pprint-newline :miser)
 319.269 +            (write-out (second alis))))
 319.270 +         (when (next (rest alis))
 319.271 +           (.write ^java.io.Writer *out* " ")
 319.272 +           (pprint-newline :linear)
 319.273 +           (recur (next (rest alis)))))))))
 319.274 +
 319.275 +(defn- pprint-condp [alis]
 319.276 +  (if (> (count alis) 3) 
 319.277 +    (pprint-logical-block :prefix "(" :suffix ")"
 319.278 +      (pprint-indent :block 1)
 319.279 +      (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis)
 319.280 +      (loop [alis (seq (drop 3 alis))]
 319.281 +        (when alis
 319.282 +          (pprint-logical-block alis
 319.283 +            (write-out (first alis))
 319.284 +            (when (next alis)
 319.285 +              (.write ^java.io.Writer *out* " ")
 319.286 +              (pprint-newline :miser)
 319.287 +              (write-out (second alis))))
 319.288 +          (when (next (rest alis))
 319.289 +            (.write ^java.io.Writer *out* " ")
 319.290 +            (pprint-newline :linear)
 319.291 +            (recur (next (rest alis)))))))
 319.292 +    (pprint-simple-code-list alis)))
 319.293 +
 319.294 +;;; The map of symbols that are defined in an enclosing #() anonymous function
 319.295 +(def ^{:private true} *symbol-map* {})
 319.296 +
 319.297 +(defn- pprint-anon-func [alis]
 319.298 +  (let [args (second alis)
 319.299 +        nlis (first (rest (rest alis)))]
 319.300 +    (if (vector? args)
 319.301 +      (binding [*symbol-map* (if (= 1 (count args)) 
 319.302 +                               {(first args) "%"}
 319.303 +                               (into {} 
 319.304 +                                     (map 
 319.305 +                                      #(vector %1 (str \% %2)) 
 319.306 +                                      args 
 319.307 +                                      (range 1 (inc (count args))))))]
 319.308 +        ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis))
 319.309 +      (pprint-simple-code-list alis))))
 319.310 +
 319.311 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.312 +;;; The master definitions for formatting lists in code (that is, (fn args...) or
 319.313 +;;; special forms).
 319.314 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 319.315 +
 319.316 +;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is
 319.317 +;;; easier on the stack.
 319.318 +
 319.319 +(defn- pprint-simple-code-list [alis]
 319.320 +  (pprint-logical-block :prefix "(" :suffix ")"
 319.321 +    (pprint-indent :block 1)
 319.322 +    (loop [alis (seq alis)]
 319.323 +      (when alis
 319.324 +	(write-out (first alis))
 319.325 +	(when (next alis)
 319.326 +	  (.write ^java.io.Writer *out* " ")
 319.327 +	  (pprint-newline :linear)
 319.328 +	  (recur (next alis)))))))
 319.329 +
 319.330 +;;; Take a map with symbols as keys and add versions with no namespace.
 319.331 +;;; That is, if ns/sym->val is in the map, add sym->val to the result.
 319.332 +(defn- two-forms [amap]
 319.333 +  (into {} 
 319.334 +        (mapcat 
 319.335 +         identity 
 319.336 +         (for [x amap] 
 319.337 +           [x [(symbol (name (first x))) (second x)]]))))
 319.338 +
 319.339 +(defn- add-core-ns [amap]
 319.340 +  (let [core "clojure.core"]
 319.341 +    (into {}
 319.342 +          (map #(let [[s f] %] 
 319.343 +                  (if (not (or (namespace s) (special-symbol? s)))
 319.344 +                    [(symbol core (name s)) f]
 319.345 +                    %))
 319.346 +               amap))))
 319.347 +
 319.348 +(def ^{:private true} *code-table*
 319.349 +     (two-forms
 319.350 +      (add-core-ns
 319.351 +       {'def pprint-hold-first, 'defonce pprint-hold-first, 
 319.352 +	'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn,
 319.353 +        'let pprint-let, 'loop pprint-let, 'binding pprint-let,
 319.354 +        'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let,
 319.355 +	'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let,
 319.356 +	'when-first pprint-let,
 319.357 +        'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if,
 319.358 +        'cond pprint-cond, 'condp pprint-condp,
 319.359 +        'fn* pprint-anon-func,
 319.360 +        '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first,
 319.361 +        'locking pprint-hold-first, 'struct pprint-hold-first,
 319.362 +        'struct-map pprint-hold-first, 
 319.363 +        })))
 319.364 +
 319.365 +(defn- pprint-code-list [alis]
 319.366 +  (if-not (pprint-reader-macro alis) 
 319.367 +    (if-let [special-form (*code-table* (first alis))]
 319.368 +      (special-form alis)
 319.369 +      (pprint-simple-code-list alis))))
 319.370 +
 319.371 +(defn- pprint-code-symbol [sym] 
 319.372 +  (if-let [arg-num (sym *symbol-map*)]
 319.373 +    (print arg-num)
 319.374 +    (if *print-suppress-namespaces* 
 319.375 +      (print (name sym))
 319.376 +      (pr sym))))
 319.377 +
 319.378 +(defmulti 
 319.379 +  code-dispatch
 319.380 +  "The pretty print dispatch function for pretty printing Clojure code."
 319.381 +  {:added "1.2" :arglists '[[object]]} 
 319.382 +  class)
 319.383 +
 319.384 +(use-method code-dispatch clojure.lang.ISeq pprint-code-list)
 319.385 +(use-method code-dispatch clojure.lang.Symbol pprint-code-symbol)
 319.386 +
 319.387 +;; The following are all exact copies of simple-dispatch
 319.388 +(use-method code-dispatch clojure.lang.IPersistentVector pprint-vector)
 319.389 +(use-method code-dispatch clojure.lang.IPersistentMap pprint-map)
 319.390 +(use-method code-dispatch clojure.lang.IPersistentSet pprint-set)
 319.391 +(use-method code-dispatch clojure.lang.PersistentQueue pprint-pqueue)
 319.392 +(use-method code-dispatch clojure.lang.IDeref pprint-ideref)
 319.393 +(use-method code-dispatch nil pr)
 319.394 +(use-method code-dispatch :default pprint-simple-default)
 319.395 +
 319.396 +(set-pprint-dispatch simple-dispatch)
 319.397 +
 319.398 +
 319.399 +;;; For testing
 319.400 +(comment
 319.401 +
 319.402 +(with-pprint-dispatch code-dispatch 
 319.403 +  (pprint 
 319.404 +   '(defn cl-format 
 319.405 +      "An implementation of a Common Lisp compatible format function"
 319.406 +      [stream format-in & args]
 319.407 +      (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
 319.408 +            navigator (init-navigator args)]
 319.409 +        (execute-format stream compiled-format navigator)))))
 319.410 +
 319.411 +(with-pprint-dispatch code-dispatch 
 319.412 +  (pprint 
 319.413 +   '(defn cl-format 
 319.414 +      [stream format-in & args]
 319.415 +      (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
 319.416 +            navigator (init-navigator args)]
 319.417 +        (execute-format stream compiled-format navigator)))))
 319.418 +
 319.419 +(with-pprint-dispatch code-dispatch 
 319.420 +  (pprint
 319.421 +   '(defn- -write 
 319.422 +      ([this x]
 319.423 +         (condp = (class x)
 319.424 +           String 
 319.425 +           (let [s0 (write-initial-lines this x)
 319.426 +                 s (.replaceFirst s0 "\\s+$" "")
 319.427 +                 white-space (.substring s0 (count s))
 319.428 +                 mode (getf :mode)]
 319.429 +             (if (= mode :writing)
 319.430 +               (dosync
 319.431 +                (write-white-space this)
 319.432 +                (.col_write this s)
 319.433 +                (setf :trailing-white-space white-space))
 319.434 +               (add-to-buffer this (make-buffer-blob s white-space))))
 319.435 +
 319.436 +           Integer
 319.437 +           (let [c ^Character x]
 319.438 +             (if (= (getf :mode) :writing)
 319.439 +               (do 
 319.440 +                 (write-white-space this)
 319.441 +                 (.col_write this x))
 319.442 +               (if (= c (int \newline))
 319.443 +                 (write-initial-lines this "\n")
 319.444 +                 (add-to-buffer this (make-buffer-blob (str (char c)) nil))))))))))
 319.445 +
 319.446 +(with-pprint-dispatch code-dispatch 
 319.447 +  (pprint 
 319.448 +   '(defn pprint-defn [writer alis]
 319.449 +      (if (next alis) 
 319.450 +        (let [[defn-sym defn-name & stuff] alis
 319.451 +              [doc-str stuff] (if (string? (first stuff))
 319.452 +                                [(first stuff) (next stuff)]
 319.453 +                                [nil stuff])
 319.454 +              [attr-map stuff] (if (map? (first stuff))
 319.455 +                                 [(first stuff) (next stuff)]
 319.456 +                                 [nil stuff])]
 319.457 +          (pprint-logical-block writer :prefix "(" :suffix ")"
 319.458 +                                (cl-format true "~w ~1I~@_~w" defn-sym defn-name)
 319.459 +                                (if doc-str
 319.460 +                                  (cl-format true " ~_~w" doc-str))
 319.461 +                                (if attr-map
 319.462 +                                  (cl-format true " ~_~w" attr-map))
 319.463 +                                ;; Note: the multi-defn case will work OK for malformed defns too
 319.464 +                                (cond
 319.465 +                                  (vector? (first stuff)) (single-defn stuff (or doc-str attr-map))
 319.466 +                                  :else (multi-defn stuff (or doc-str attr-map)))))
 319.467 +        (pprint-simple-code-list writer alis)))))
 319.468 +)
 319.469 +nil
 319.470 +
   320.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   320.2 +++ b/src/clojure/pprint/pprint_base.clj	Sat Aug 21 06:25:44 2010 -0400
   320.3 @@ -0,0 +1,374 @@
   320.4 +;;; pprint_base.clj -- part of the pretty printer for Clojure
   320.5 +
   320.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   320.7 +;   The use and distribution terms for this software are covered by the
   320.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   320.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  320.10 +;   By using this software in any fashion, you are agreeing to be bound by
  320.11 +;   the terms of this license.
  320.12 +;   You must not remove this notice, or any other, from this software.
  320.13 +
  320.14 +;; Author: Tom Faulhaber
  320.15 +;; April 3, 2009
  320.16 +
  320.17 +
  320.18 +;; This module implements the generic pretty print functions and special variables
  320.19 +
  320.20 +(in-ns 'clojure.pprint)
  320.21 +
  320.22 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  320.23 +;; Variables that control the pretty printer
  320.24 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  320.25 +
  320.26 +;;;
  320.27 +;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core
  320.28 +;;; TODO: use *print-dup* here (or is it supplanted by other variables?)
  320.29 +;;; TODO: make dispatch items like "(let..." get counted in *print-length*
  320.30 +;;; constructs
  320.31 +
  320.32 +
  320.33 +(def
  320.34 + ^{:doc "Bind to true if you want write to use pretty printing", :added "1.2"}
  320.35 + *print-pretty* true)
  320.36 +
  320.37 +(defonce ; If folks have added stuff here, don't overwrite
  320.38 + ^{:doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch
  320.39 +to modify.",
  320.40 +   :added "1.2"}
  320.41 + *print-pprint-dispatch* nil)
  320.42 +
  320.43 +(def
  320.44 + ^{:doc "Pretty printing will try to avoid anything going beyond this column.
  320.45 +Set it to nil to have pprint let the line be arbitrarily long. This will ignore all 
  320.46 +non-mandatory newlines.",
  320.47 +   :added "1.2"}
  320.48 + *print-right-margin* 72)
  320.49 +
  320.50 +(def
  320.51 + ^{:doc "The column at which to enter miser style. Depending on the dispatch table, 
  320.52 +miser style add newlines in more places to try to keep lines short allowing for further 
  320.53 +levels of nesting.",
  320.54 +   :added "1.2"}
  320.55 + *print-miser-width* 40)
  320.56 +
  320.57 +;;; TODO implement output limiting
  320.58 +(def
  320.59 + ^{:private true,
  320.60 +   :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"}
  320.61 + *print-lines* nil)
  320.62 +
  320.63 +;;; TODO: implement circle and shared
  320.64 +(def
  320.65 + ^{:private true,
  320.66 +   :doc "Mark circular structures (N.B. This is not yet used)"}
  320.67 + *print-circle* nil)
  320.68 +
  320.69 +;;; TODO: should we just use *print-dup* here?
  320.70 +(def
  320.71 + ^{:private true,
  320.72 +   :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"}
  320.73 + *print-shared* nil)
  320.74 +
  320.75 +(def
  320.76 + ^{:doc "Don't print namespaces with symbols. This is particularly useful when 
  320.77 +pretty printing the results of macro expansions"
  320.78 +   :added "1.2"}
  320.79 + *print-suppress-namespaces* nil)
  320.80 +
  320.81 +;;; TODO: support print-base and print-radix in cl-format
  320.82 +;;; TODO: support print-base and print-radix in rationals
  320.83 +(def
  320.84 + ^{:doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, 
  320.85 +or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the 
  320.86 +radix specifier is in the form #XXr where XX is the decimal value of *print-base* "
  320.87 +   :added "1.2"}
  320.88 + *print-radix* nil)
  320.89 +
  320.90 +(def
  320.91 + ^{:doc "The base to use for printing integers and rationals."
  320.92 +   :added "1.2"}
  320.93 + *print-base* 10)
  320.94 +
  320.95 +
  320.96 +
  320.97 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  320.98 +;; Internal variables that keep track of where we are in the 
  320.99 +;; structure
 320.100 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 320.101 +
 320.102 +(def ^{ :private true } *current-level* 0)
 320.103 +
 320.104 +(def ^{ :private true } *current-length* nil)
 320.105 +
 320.106 +;; TODO: add variables for length, lines.
 320.107 +
 320.108 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 320.109 +;; Support for the write function
 320.110 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 320.111 +
 320.112 +(declare format-simple-number)
 320.113 +
 320.114 +(def ^{:private true} orig-pr pr)
 320.115 +
 320.116 +(defn- pr-with-base [x]
 320.117 +  (if-let [s (format-simple-number x)]
 320.118 +    (print s)
 320.119 +    (orig-pr x)))
 320.120 +
 320.121 +(def ^{:private true} write-option-table
 320.122 +     {;:array            *print-array*
 320.123 +      :base             'clojure.pprint/*print-base*,
 320.124 +      ;;:case             *print-case*,
 320.125 +      :circle           'clojure.pprint/*print-circle*,
 320.126 +      ;;:escape           *print-escape*,
 320.127 +      ;;:gensym           *print-gensym*,
 320.128 +      :length           'clojure.core/*print-length*,
 320.129 +      :level            'clojure.core/*print-level*,
 320.130 +      :lines            'clojure.pprint/*print-lines*,
 320.131 +      :miser-width      'clojure.pprint/*print-miser-width*,
 320.132 +      :dispatch         'clojure.pprint/*print-pprint-dispatch*,
 320.133 +      :pretty           'clojure.pprint/*print-pretty*,
 320.134 +      :radix            'clojure.pprint/*print-radix*,
 320.135 +      :readably         'clojure.core/*print-readably*,
 320.136 +      :right-margin     'clojure.pprint/*print-right-margin*,
 320.137 +      :suppress-namespaces 'clojure.pprint/*print-suppress-namespaces*})
 320.138 +
 320.139 +
 320.140 +(defmacro ^{:private true} binding-map [amap & body]
 320.141 +  (let []
 320.142 +    `(do
 320.143 +       (. clojure.lang.Var (pushThreadBindings ~amap))
 320.144 +       (try
 320.145 +        ~@body
 320.146 +        (finally
 320.147 +         (. clojure.lang.Var (popThreadBindings)))))))
 320.148 +
 320.149 +(defn- table-ize [t m] 
 320.150 +  (apply hash-map (mapcat 
 320.151 +                   #(when-let [v (get t (key %))] [(find-var v) (val %)]) 
 320.152 +                   m)))
 320.153 +
 320.154 +(defn- pretty-writer? 
 320.155 +  "Return true iff x is a PrettyWriter"
 320.156 +  [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x)))
 320.157 +
 320.158 +(defn- make-pretty-writer 
 320.159 +  "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width"
 320.160 +  [base-writer right-margin miser-width]
 320.161 +  (pretty-writer base-writer right-margin miser-width))
 320.162 +
 320.163 +(defmacro ^{:private true} with-pretty-writer [base-writer & body]
 320.164 +  `(let [base-writer# ~base-writer
 320.165 +         new-writer# (not (pretty-writer? base-writer#))]
 320.166 +     (binding [*out* (if new-writer#
 320.167 +                      (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*)
 320.168 +                      base-writer#)]
 320.169 +       ~@body
 320.170 +       (.flush *out*))))
 320.171 +
 320.172 +
 320.173 +;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc.
 320.174 +(defn write-out 
 320.175 +  "Write an object to *out* subject to the current bindings of the printer control 
 320.176 +variables. Use the kw-args argument to override individual variables for this call (and 
 320.177 +any recursive calls).
 320.178 +
 320.179 +*out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility
 320.180 +of the caller.
 320.181 +
 320.182 +This method is primarily intended for use by pretty print dispatch functions that 
 320.183 +already know that the pretty printer will have set up their environment appropriately.
 320.184 +Normal library clients should use the standard \"write\" interface. "
 320.185 +  {:added "1.2"}
 320.186 +  [object]
 320.187 +  (let [length-reached (and 
 320.188 +                        *current-length*
 320.189 +                        *print-length*
 320.190 +                        (>= *current-length* *print-length*))]
 320.191 +    (if-not *print-pretty*
 320.192 +      (pr object)
 320.193 +      (if length-reached
 320.194 +        (print "...")
 320.195 +        (do
 320.196 +          (if *current-length* (set! *current-length* (inc *current-length*)))
 320.197 +          (*print-pprint-dispatch* object))))
 320.198 +    length-reached))
 320.199 +
 320.200 +(defn write 
 320.201 +  "Write an object subject to the current bindings of the printer control variables.
 320.202 +Use the kw-args argument to override individual variables for this call (and any 
 320.203 +recursive calls). Returns the string result if :stream is nil or nil otherwise.
 320.204 +
 320.205 +The following keyword arguments can be passed with values:
 320.206 +  Keyword              Meaning                              Default value
 320.207 +  :stream              Writer for output or nil             true (indicates *out*)
 320.208 +  :base                Base to use for writing rationals    Current value of *print-base*
 320.209 +  :circle*             If true, mark circular structures    Current value of *print-circle*
 320.210 +  :length              Maximum elements to show in sublists Current value of *print-length*
 320.211 +  :level               Maximum depth                        Current value of *print-level*
 320.212 +  :lines*              Maximum lines of output              Current value of *print-lines*
 320.213 +  :miser-width         Width to enter miser mode            Current value of *print-miser-width*
 320.214 +  :dispatch            The pretty print dispatch function   Current value of *print-pprint-dispatch*
 320.215 +  :pretty              If true, do pretty printing          Current value of *print-pretty*
 320.216 +  :radix               If true, prepend a radix specifier   Current value of *print-radix*
 320.217 +  :readably*           If true, print readably              Current value of *print-readably*
 320.218 +  :right-margin        The column for the right margin      Current value of *print-right-margin*
 320.219 +  :suppress-namespaces If true, no namespaces in symbols    Current value of *print-suppress-namespaces*
 320.220 +
 320.221 +  * = not yet supported
 320.222 +"
 320.223 +  {:added "1.2"}
 320.224 +  [object & kw-args]
 320.225 +  (let [options (merge {:stream true} (apply hash-map kw-args))]
 320.226 +    (binding-map (table-ize write-option-table options) 
 320.227 +      (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) 
 320.228 +        (let [optval (if (contains? options :stream) 
 320.229 +                       (:stream options)
 320.230 +                       true) 
 320.231 +              base-writer (condp = optval
 320.232 +                            nil (java.io.StringWriter.)
 320.233 +                            true *out*
 320.234 +                            optval)]
 320.235 +          (if *print-pretty*
 320.236 +            (with-pretty-writer base-writer
 320.237 +              (write-out object))
 320.238 +            (binding [*out* base-writer]
 320.239 +              (pr object)))
 320.240 +          (if (nil? optval) 
 320.241 +            (.toString ^java.io.StringWriter base-writer)))))))
 320.242 +
 320.243 +
 320.244 +(defn pprint 
 320.245 +  "Pretty print object to the optional output writer. If the writer is not provided, 
 320.246 +print the object to the currently bound value of *out*."
 320.247 +  {:added "1.2"}
 320.248 +  ([object] (pprint object *out*)) 
 320.249 +  ([object writer]
 320.250 +     (with-pretty-writer writer
 320.251 +       (binding [*print-pretty* true]
 320.252 +         (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) 
 320.253 +           (write-out object)))
 320.254 +       (if (not (= 0 (get-column *out*)))
 320.255 +         (.write *out* (int \newline))))))
 320.256 +
 320.257 +(defmacro pp 
 320.258 +  "A convenience macro that pretty prints the last thing output. This is
 320.259 +exactly equivalent to (pprint *1)."
 320.260 +  {:added "1.2"}
 320.261 +  [] `(pprint *1))
 320.262 +
 320.263 +(defn set-pprint-dispatch  
 320.264 +  "Set the pretty print dispatch function to a function matching (fn [obj] ...)
 320.265 +where obj is the object to pretty print. That function will be called with *out* set
 320.266 +to a pretty printing writer to which it should do its printing.
 320.267 +
 320.268 +For example functions, see simple-dispatch and code-dispatch in 
 320.269 +clojure.pprint.dispatch.clj."
 320.270 +  {:added "1.2"}
 320.271 +  [function]
 320.272 +  (let [old-meta (meta #'*print-pprint-dispatch*)]
 320.273 +    (alter-var-root #'*print-pprint-dispatch* (constantly function))
 320.274 +    (alter-meta! #'*print-pprint-dispatch* (constantly old-meta)))
 320.275 +  nil)
 320.276 +
 320.277 +(defmacro with-pprint-dispatch 
 320.278 +  "Execute body with the pretty print dispatch function bound to function."
 320.279 +  {:added "1.2"}
 320.280 +  [function & body]
 320.281 +  `(binding [*print-pprint-dispatch* ~function]
 320.282 +     ~@body))
 320.283 +
 320.284 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 320.285 +;; Support for the functional interface to the pretty printer
 320.286 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 320.287 +
 320.288 +(defn- parse-lb-options [opts body]
 320.289 +  (loop [body body
 320.290 +         acc []]
 320.291 +    (if (opts (first body))
 320.292 +      (recur (drop 2 body) (concat acc (take 2 body)))
 320.293 +      [(apply hash-map acc) body])))
 320.294 +
 320.295 +(defn- check-enumerated-arg [arg choices]
 320.296 +  (if-not (choices arg)
 320.297 +          (throw
 320.298 +           (IllegalArgumentException.
 320.299 +            ;; TODO clean up choices string
 320.300 +            (str "Bad argument: " arg ". It must be one of " choices)))))
 320.301 +
 320.302 +(defn- level-exceeded []
 320.303 +  (and *print-level* (>= *current-level* *print-level*)))
 320.304 +
 320.305 +(defmacro pprint-logical-block 
 320.306 +  "Execute the body as a pretty printing logical block with output to *out* which 
 320.307 +must be a pretty printing writer. When used from pprint or cl-format, this can be 
 320.308 +assumed. 
 320.309 +
 320.310 +This function is intended for use when writing custom dispatch functions.
 320.311 +
 320.312 +Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, 
 320.313 +and :suffix."
 320.314 +  {:added "1.2", :arglists '[[options* body]]}
 320.315 +  [& args]
 320.316 +  (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)]
 320.317 +    `(do (if (#'clojure.pprint/level-exceeded) 
 320.318 +           (.write ^java.io.Writer *out* "#")
 320.319 +           (do 
 320.320 +             (push-thread-bindings {#'clojure.pprint/*current-level*
 320.321 +                                    (inc (var-get #'clojure.pprint/*current-level*))
 320.322 +                                    #'clojure.pprint/*current-length* 0})
 320.323 +             (try  
 320.324 +              (#'clojure.pprint/start-block *out*
 320.325 +                           ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options))
 320.326 +              ~@body
 320.327 +              (#'clojure.pprint/end-block *out*)
 320.328 +              (finally 
 320.329 +               (pop-thread-bindings)))))
 320.330 +         nil)))
 320.331 +
 320.332 +(defn pprint-newline
 320.333 +  "Print a conditional newline to a pretty printing stream. kind specifies if the 
 320.334 +newline is :linear, :miser, :fill, or :mandatory. 
 320.335 +
 320.336 +This function is intended for use when writing custom dispatch functions.
 320.337 +
 320.338 +Output is sent to *out* which must be a pretty printing writer."
 320.339 +  {:added "1.2"}
 320.340 +  [kind] 
 320.341 +  (check-enumerated-arg kind #{:linear :miser :fill :mandatory})
 320.342 +  (nl *out* kind))
 320.343 +
 320.344 +(defn pprint-indent 
 320.345 +  "Create an indent at this point in the pretty printing stream. This defines how 
 320.346 +following lines are indented. relative-to can be either :block or :current depending 
 320.347 +whether the indent should be computed relative to the start of the logical block or
 320.348 +the current column position. n is an offset. 
 320.349 +
 320.350 +This function is intended for use when writing custom dispatch functions.
 320.351 +
 320.352 +Output is sent to *out* which must be a pretty printing writer."
 320.353 +  {:added "1.2"}
 320.354 +  [relative-to n] 
 320.355 +  (check-enumerated-arg relative-to #{:block :current})
 320.356 +  (indent *out* relative-to n))
 320.357 +
 320.358 +;; TODO a real implementation for pprint-tab
 320.359 +(defn pprint-tab 
 320.360 +  "Tab at this point in the pretty printing stream. kind specifies whether the tab
 320.361 +is :line, :section, :line-relative, or :section-relative. 
 320.362 +
 320.363 +Colnum and colinc specify the target column and the increment to move the target
 320.364 +forward if the output is already past the original target.
 320.365 +
 320.366 +This function is intended for use when writing custom dispatch functions.
 320.367 +
 320.368 +Output is sent to *out* which must be a pretty printing writer.
 320.369 +
 320.370 +THIS FUNCTION IS NOT YET IMPLEMENTED."
 320.371 +  {:added "1.2"}
 320.372 +  [kind colnum colinc] 
 320.373 +  (check-enumerated-arg kind #{:line :section :line-relative :section-relative})
 320.374 +  (throw (UnsupportedOperationException. "pprint-tab is not yet implemented")))
 320.375 +
 320.376 +
 320.377 +nil
   321.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   321.2 +++ b/src/clojure/pprint/pretty_writer.clj	Sat Aug 21 06:25:44 2010 -0400
   321.3 @@ -0,0 +1,483 @@
   321.4 +;;; pretty_writer.clj -- part of the pretty printer for Clojure
   321.5 +
   321.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   321.7 +;   The use and distribution terms for this software are covered by the
   321.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   321.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  321.10 +;   By using this software in any fashion, you are agreeing to be bound by
  321.11 +;   the terms of this license.
  321.12 +;   You must not remove this notice, or any other, from this software.
  321.13 +
  321.14 +;; Author: Tom Faulhaber
  321.15 +;; April 3, 2009
  321.16 +;; Revised to use proxy instead of gen-class April 2010
  321.17 +
  321.18 +;; This module implements a wrapper around a java.io.Writer which implements the
  321.19 +;; core of the XP algorithm.
  321.20 +
  321.21 +(in-ns 'clojure.pprint)
  321.22 +
  321.23 +(import [clojure.lang IDeref]
  321.24 +        [java.io Writer])
  321.25 +
  321.26 +;; TODO: Support for tab directives
  321.27 +
  321.28 +
  321.29 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.30 +;;; Forward declarations
  321.31 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.32 +
  321.33 +(declare get-miser-width)
  321.34 +
  321.35 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.36 +;;; Macros to simplify dealing with types and classes. These are
  321.37 +;;; really utilities, but I'm experimenting with them here.
  321.38 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.39 +
  321.40 +(defmacro ^{:private true} 
  321.41 +  getf 
  321.42 +  "Get the value of the field a named by the argument (which should be a keyword)."
  321.43 +  [sym]
  321.44 +  `(~sym @@~'this))
  321.45 +
  321.46 +(defmacro ^{:private true} 
  321.47 +  setf [sym new-val] 
  321.48 +  "Set the value of the field SYM to NEW-VAL"
  321.49 +  `(alter @~'this assoc ~sym ~new-val))
  321.50 +
  321.51 +(defmacro ^{:private true} 
  321.52 +  deftype [type-name & fields]
  321.53 +  (let [name-str (name type-name)]
  321.54 +    `(do
  321.55 +       (defstruct ~type-name :type-tag ~@fields)
  321.56 +       (alter-meta! #'~type-name assoc :private true)
  321.57 +       (defn- ~(symbol (str "make-" name-str)) 
  321.58 +         [& vals#] (apply struct ~type-name ~(keyword name-str) vals#))
  321.59 +       (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str))))))
  321.60 +
  321.61 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.62 +;;; The data structures used by pretty-writer
  321.63 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.64 +
  321.65 +(defstruct ^{:private true} logical-block
  321.66 +           :parent :section :start-col :indent
  321.67 +           :done-nl :intra-block-nl
  321.68 +           :prefix :per-line-prefix :suffix
  321.69 +           :logical-block-callback)
  321.70 +
  321.71 +(defn- ancestor? [parent child]
  321.72 +  (loop [child (:parent child)]
  321.73 +    (cond 
  321.74 +     (nil? child) false
  321.75 +     (identical? parent child) true
  321.76 +     :else (recur (:parent child)))))
  321.77 +
  321.78 +(defstruct ^{:private true} section :parent)
  321.79 +
  321.80 +(defn- buffer-length [l] 
  321.81 +  (let [l (seq l)]
  321.82 +    (if l 
  321.83 +      (- (:end-pos (last l)) (:start-pos (first l)))
  321.84 +      0)))
  321.85 +
  321.86 +; A blob of characters (aka a string)
  321.87 +(deftype buffer-blob :data :trailing-white-space :start-pos :end-pos)
  321.88 +
  321.89 +; A newline
  321.90 +(deftype nl-t :type :logical-block :start-pos :end-pos)
  321.91 +
  321.92 +(deftype start-block-t :logical-block :start-pos :end-pos)
  321.93 +
  321.94 +(deftype end-block-t :logical-block :start-pos :end-pos)
  321.95 +
  321.96 +(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos)
  321.97 +
  321.98 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  321.99 +;;; Functions to write tokens in the output buffer
 321.100 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.101 +
 321.102 +(declare emit-nl)
 321.103 +
 321.104 +(defmulti ^{:private true} write-token #(:type-tag %2))
 321.105 +(defmethod write-token :start-block-t [^Writer this token]
 321.106 +   (when-let [cb (getf :logical-block-callback)] (cb :start))
 321.107 +   (let [lb (:logical-block token)]
 321.108 +    (dosync
 321.109 +     (when-let [^String prefix (:prefix lb)] 
 321.110 +       (.write (getf :base) prefix))
 321.111 +     (let [col (get-column (getf :base))]
 321.112 +       (ref-set (:start-col lb) col)
 321.113 +       (ref-set (:indent lb) col)))))
 321.114 +
 321.115 +(defmethod write-token :end-block-t [^Writer this token]
 321.116 +  (when-let [cb (getf :logical-block-callback)] (cb :end))
 321.117 +  (when-let [^String suffix (:suffix (:logical-block token))] 
 321.118 +    (.write (getf :base) suffix)))
 321.119 +
 321.120 +(defmethod write-token :indent-t [^Writer this token]
 321.121 +  (let [lb (:logical-block token)]
 321.122 +    (ref-set (:indent lb) 
 321.123 +             (+ (:offset token)
 321.124 +                (condp = (:relative-to token)
 321.125 +		  :block @(:start-col lb)
 321.126 +		  :current (get-column (getf :base)))))))
 321.127 +
 321.128 +(defmethod write-token :buffer-blob [^Writer this token]
 321.129 +  (.write (getf :base) ^String (:data token)))
 321.130 +
 321.131 +(defmethod write-token :nl-t [^Writer this token]
 321.132 +;  (prlabel wt @(:done-nl (:logical-block token)))
 321.133 +;  (prlabel wt (:type token) (= (:type token) :mandatory))
 321.134 +  (if (or (= (:type token) :mandatory)
 321.135 +           (and (not (= (:type token) :fill))
 321.136 +                @(:done-nl (:logical-block token))))
 321.137 +    (emit-nl this token)
 321.138 +    (if-let [^String tws (getf :trailing-white-space)]
 321.139 +      (.write (getf :base) tws)))
 321.140 +  (dosync (setf :trailing-white-space nil)))
 321.141 +
 321.142 +(defn- write-tokens [^Writer this tokens force-trailing-whitespace]
 321.143 +  (doseq [token tokens]
 321.144 +    (if-not (= (:type-tag token) :nl-t)
 321.145 +      (if-let [^String tws (getf :trailing-white-space)]
 321.146 +	(.write (getf :base) tws)))
 321.147 +    (write-token this token)
 321.148 +    (setf :trailing-white-space (:trailing-white-space token)))
 321.149 +  (let [^String tws (getf :trailing-white-space)] 
 321.150 +    (when (and force-trailing-whitespace tws)
 321.151 +      (.write (getf :base) tws)
 321.152 +      (setf :trailing-white-space nil))))
 321.153 +
 321.154 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.155 +;;; emit-nl? method defs for each type of new line. This makes
 321.156 +;;; the decision about whether to print this type of new line.
 321.157 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.158 +
 321.159 +
 321.160 +(defn- tokens-fit? [^Writer this tokens]
 321.161 +;;;  (prlabel tf? (get-column (getf :base) (buffer-length tokens))
 321.162 +  (let [maxcol (get-max-column (getf :base))]
 321.163 +    (or 
 321.164 +     (nil? maxcol) 
 321.165 +     (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol))))
 321.166 +
 321.167 +(defn- linear-nl? [this lb section]
 321.168 +;  (prlabel lnl? @(:done-nl lb) (tokens-fit? this section))
 321.169 +  (or @(:done-nl lb)
 321.170 +      (not (tokens-fit? this section))))
 321.171 +
 321.172 +(defn- miser-nl? [^Writer this lb section]
 321.173 +  (let [miser-width (get-miser-width this)
 321.174 +        maxcol (get-max-column (getf :base))]
 321.175 +    (and miser-width maxcol
 321.176 +         (>= @(:start-col lb) (- maxcol miser-width))
 321.177 +         (linear-nl? this lb section))))
 321.178 +
 321.179 +(defmulti ^{:private true} emit-nl? (fn [t _ _ _] (:type t)))
 321.180 +
 321.181 +(defmethod emit-nl? :linear [newl this section _]
 321.182 +  (let [lb (:logical-block newl)]
 321.183 +    (linear-nl? this lb section)))
 321.184 +
 321.185 +(defmethod emit-nl? :miser [newl this section _]
 321.186 +  (let [lb (:logical-block newl)]
 321.187 +    (miser-nl? this lb section)))
 321.188 +
 321.189 +(defmethod emit-nl? :fill [newl this section subsection]
 321.190 +  (let [lb (:logical-block newl)]
 321.191 +    (or @(:intra-block-nl lb)
 321.192 +        (not (tokens-fit? this subsection))
 321.193 +        (miser-nl? this lb section))))
 321.194 +
 321.195 +(defmethod emit-nl? :mandatory [_ _ _ _]
 321.196 +  true)
 321.197 +
 321.198 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.199 +;;; Various support functions
 321.200 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.201 +
 321.202 +
 321.203 +(defn- get-section [buffer]
 321.204 +  (let [nl (first buffer) 
 321.205 +        lb (:logical-block nl)
 321.206 +        section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb)))
 321.207 +                                 (next buffer)))]
 321.208 +    [section (seq (drop (inc (count section)) buffer))])) 
 321.209 +
 321.210 +(defn- get-sub-section [buffer]
 321.211 +  (let [nl (first buffer) 
 321.212 +        lb (:logical-block nl)
 321.213 +        section (seq (take-while #(let [nl-lb (:logical-block %)]
 321.214 +                                    (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb)))))
 321.215 +                            (next buffer)))]
 321.216 +    section)) 
 321.217 +
 321.218 +(defn- update-nl-state [lb]
 321.219 +  (dosync
 321.220 +   (ref-set (:intra-block-nl lb) false)
 321.221 +   (ref-set (:done-nl lb) true)
 321.222 +   (loop [lb (:parent lb)]
 321.223 +     (if lb
 321.224 +       (do (ref-set (:done-nl lb) true)
 321.225 +           (ref-set (:intra-block-nl lb) true)
 321.226 +           (recur (:parent lb)))))))
 321.227 +
 321.228 +(defn- emit-nl [^Writer this nl]
 321.229 +  (.write (getf :base) (int \newline))
 321.230 +  (dosync (setf :trailing-white-space nil))
 321.231 +  (let [lb (:logical-block nl)
 321.232 +        ^String prefix (:per-line-prefix lb)] 
 321.233 +    (if prefix 
 321.234 +      (.write (getf :base) prefix))
 321.235 +    (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix))
 321.236 +					  \space))] 
 321.237 +      (.write (getf :base) istr))
 321.238 +    (update-nl-state lb)))
 321.239 +
 321.240 +(defn- split-at-newline [tokens]
 321.241 +  (let [pre (seq (take-while #(not (nl-t? %)) tokens))]
 321.242 +    [pre (seq (drop (count pre) tokens))]))
 321.243 +
 321.244 +;;; Methods for showing token strings for debugging
 321.245 +
 321.246 +(defmulti ^{:private true} tok :type-tag)
 321.247 +(defmethod tok :nl-t [token]
 321.248 +  (:type token))
 321.249 +(defmethod tok :buffer-blob [token]
 321.250 +  (str \" (:data token) (:trailing-white-space token) \"))
 321.251 +(defmethod tok :default [token]
 321.252 +  (:type-tag token))
 321.253 +(defn- toks [toks] (map tok toks))
 321.254 +
 321.255 +;;; write-token-string is called when the set of tokens in the buffer
 321.256 +;;; is longer than the available space on the line
 321.257 +
 321.258 +(defn- write-token-string [this tokens]
 321.259 +  (let [[a b] (split-at-newline tokens)]
 321.260 +;;    (prlabel wts (toks a) (toks b))
 321.261 +    (if a (write-tokens this a false))
 321.262 +    (if b
 321.263 +      (let [[section remainder] (get-section b)
 321.264 +            newl (first b)]
 321.265 +;;         (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) 
 321.266 +        (let [do-nl (emit-nl? newl this section (get-sub-section b))
 321.267 +              result (if do-nl 
 321.268 +                       (do
 321.269 +;;                          (prlabel emit-nl (:type newl))
 321.270 +                         (emit-nl this newl)
 321.271 +                         (next b))
 321.272 +                       b)
 321.273 +              long-section (not (tokens-fit? this result))
 321.274 +              result (if long-section
 321.275 +                       (let [rem2 (write-token-string this section)]
 321.276 +;;;                              (prlabel recurse (toks rem2))
 321.277 +                         (if (= rem2 section)
 321.278 +                           (do ; If that didn't produce any output, it has no nls
 321.279 +                                        ; so we'll force it
 321.280 +                             (write-tokens this section false)
 321.281 +                             remainder)
 321.282 +                           (into [] (concat rem2 remainder))))
 321.283 +                       result)
 321.284 +;;              ff (prlabel wts (toks result))
 321.285 +              ] 
 321.286 +          result)))))
 321.287 +
 321.288 +(defn- write-line [^Writer this]
 321.289 +  (dosync
 321.290 +   (loop [buffer (getf :buffer)]
 321.291 +;;     (prlabel wl1 (toks buffer))
 321.292 +     (setf :buffer (into [] buffer))
 321.293 +     (if (not (tokens-fit? this buffer))
 321.294 +       (let [new-buffer (write-token-string this buffer)]
 321.295 +;;          (prlabel wl new-buffer)
 321.296 +         (if-not (identical? buffer new-buffer)
 321.297 +                 (recur new-buffer)))))))
 321.298 +
 321.299 +;;; Add a buffer token to the buffer and see if it's time to start
 321.300 +;;; writing
 321.301 +(defn- add-to-buffer [^Writer this token]
 321.302 +;  (prlabel a2b token)
 321.303 +  (dosync
 321.304 +   (setf :buffer (conj (getf :buffer) token))
 321.305 +   (if (not (tokens-fit? this (getf :buffer)))
 321.306 +     (write-line this))))
 321.307 +
 321.308 +;;; Write all the tokens that have been buffered
 321.309 +(defn- write-buffered-output [^Writer this]
 321.310 +  (write-line this)
 321.311 +  (if-let [buf (getf :buffer)]
 321.312 +    (do
 321.313 +      (write-tokens this buf true)
 321.314 +      (setf :buffer []))))
 321.315 +
 321.316 +;;; If there are newlines in the string, print the lines up until the last newline, 
 321.317 +;;; making the appropriate adjustments. Return the remainder of the string
 321.318 +(defn- write-initial-lines 
 321.319 +  [^Writer this ^String s] 
 321.320 +  (let [lines (.split s "\n" -1)]
 321.321 +    (if (= (count lines) 1)
 321.322 +      s
 321.323 +      (dosync 
 321.324 +       (let [^String prefix (:per-line-prefix (first (getf :logical-blocks)))
 321.325 +             ^String l (first lines)] 
 321.326 +         (if (= :buffering (getf :mode))
 321.327 +           (let [oldpos (getf :pos)
 321.328 +                 newpos (+ oldpos (count l))]
 321.329 +             (setf :pos newpos)
 321.330 +             (add-to-buffer this (make-buffer-blob l nil oldpos newpos))
 321.331 +             (write-buffered-output this))
 321.332 +           (.write (getf :base) l))
 321.333 +         (.write (getf :base) (int \newline))
 321.334 +         (doseq [^String l (next (butlast lines))]
 321.335 +           (.write (getf :base) l)
 321.336 +           (.write (getf :base) (int \newline))
 321.337 +           (if prefix
 321.338 +             (.write (getf :base) prefix)))
 321.339 +         (setf :buffering :writing)
 321.340 +         (last lines))))))
 321.341 +
 321.342 +
 321.343 +(defn- write-white-space [^Writer this]
 321.344 +  (if-let [^String tws (getf :trailing-white-space)]
 321.345 +    (dosync
 321.346 +     (.write (getf :base) tws)
 321.347 +     (setf :trailing-white-space nil))))
 321.348 +
 321.349 +(defn- p-write-char [^Writer this ^Integer c]
 321.350 +  (if (= (getf :mode) :writing)
 321.351 +    (do 
 321.352 +      (write-white-space this)
 321.353 +      (.write (getf :base) c))
 321.354 +    (if (= c \newline)
 321.355 +      (write-initial-lines this "\n")
 321.356 +      (let [oldpos (getf :pos)
 321.357 +            newpos (inc oldpos)]
 321.358 +        (dosync
 321.359 +         (setf :pos newpos)
 321.360 +         (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos)))))))
 321.361 +
 321.362 +
 321.363 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.364 +;;; Initialize the pretty-writer instance
 321.365 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.366 +
 321.367 +
 321.368 +(defn- pretty-writer [writer max-columns miser-width]
 321.369 +  (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))
 321.370 +        fields (ref {:pretty-writer true
 321.371 +                     :base (column-writer writer max-columns)
 321.372 +                     :logical-blocks lb 
 321.373 +                     :sections nil
 321.374 +                     :mode :writing
 321.375 +                     :buffer []
 321.376 +                     :buffer-block lb
 321.377 +                     :buffer-level 1
 321.378 +                     :miser-width miser-width
 321.379 +                     :trailing-white-space nil
 321.380 +                     :pos 0})]
 321.381 +    (proxy [Writer IDeref] []
 321.382 +      (deref [] fields)
 321.383 +
 321.384 +      (write 
 321.385 +       ([x]
 321.386 +          ;;     (prlabel write x (getf :mode))
 321.387 +          (condp = (class x)
 321.388 +            String 
 321.389 +            (let [^String s0 (write-initial-lines this x)
 321.390 +                  ^String s (.replaceFirst s0 "\\s+$" "")
 321.391 +                  white-space (.substring s0 (count s))
 321.392 +                  mode (getf :mode)]
 321.393 +              (dosync
 321.394 +               (if (= mode :writing)
 321.395 +                 (do
 321.396 +                   (write-white-space this)
 321.397 +                   (.write (getf :base) s)
 321.398 +                   (setf :trailing-white-space white-space))
 321.399 +                 (let [oldpos (getf :pos)
 321.400 +                       newpos (+ oldpos (count s0))]
 321.401 +                   (setf :pos newpos)
 321.402 +                   (add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
 321.403 +
 321.404 +            Integer
 321.405 +            (p-write-char this x))))
 321.406 +
 321.407 +      (flush []
 321.408 +             (if (= (getf :mode) :buffering)
 321.409 +               (dosync 
 321.410 +                (write-tokens this (getf :buffer) true)
 321.411 +                (setf :buffer []))
 321.412 +               (write-white-space this)))
 321.413 +
 321.414 +      (close []
 321.415 +             (.flush this)))))
 321.416 +
 321.417 +
 321.418 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.419 +;;; Methods for pretty-writer
 321.420 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321.421 +
 321.422 +(defn- start-block 
 321.423 +  [^Writer this 
 321.424 +   ^String prefix ^String per-line-prefix ^String suffix]
 321.425 +  (dosync 
 321.426 +   (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0)
 321.427 +                    (ref false) (ref false)
 321.428 +                    prefix per-line-prefix suffix)]
 321.429 +     (setf :logical-blocks lb)
 321.430 +     (if (= (getf :mode) :writing)
 321.431 +       (do
 321.432 +         (write-white-space this)
 321.433 +          (when-let [cb (getf :logical-block-callback)] (cb :start))
 321.434 +          (if prefix 
 321.435 +           (.write (getf :base) prefix))
 321.436 +         (let [col (get-column (getf :base))]
 321.437 +           (ref-set (:start-col lb) col)
 321.438 +           (ref-set (:indent lb) col)))
 321.439 +       (let [oldpos (getf :pos)
 321.440 +             newpos (+ oldpos (if prefix (count prefix) 0))]
 321.441 +         (setf :pos newpos)
 321.442 +         (add-to-buffer this (make-start-block-t lb oldpos newpos)))))))
 321.443 +
 321.444 +(defn- end-block [^Writer this]
 321.445 +  (dosync
 321.446 +   (let [lb (getf :logical-blocks)
 321.447 +         ^String suffix (:suffix lb)]
 321.448 +     (if (= (getf :mode) :writing)
 321.449 +       (do
 321.450 +         (write-white-space this)
 321.451 +         (if suffix
 321.452 +           (.write (getf :base) suffix))
 321.453 +         (when-let [cb (getf :logical-block-callback)] (cb :end)))
 321.454 +       (let [oldpos (getf :pos)
 321.455 +             newpos (+ oldpos (if suffix (count suffix) 0))]
 321.456 +         (setf :pos newpos)
 321.457 +         (add-to-buffer this (make-end-block-t lb oldpos newpos))))
 321.458 +     (setf :logical-blocks (:parent lb)))))
 321.459 +
 321.460 +(defn- nl [^Writer this type]
 321.461 +  (dosync 
 321.462 +   (setf :mode :buffering)
 321.463 +   (let [pos (getf :pos)]
 321.464 +     (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos)))))
 321.465 +
 321.466 +(defn- indent [^Writer this relative-to offset]
 321.467 +  (dosync 
 321.468 +   (let [lb (getf :logical-blocks)]
 321.469 +     (if (= (getf :mode) :writing)
 321.470 +       (do
 321.471 +         (write-white-space this)
 321.472 +         (ref-set (:indent lb) 
 321.473 +                  (+ offset (condp = relative-to
 321.474 +			      :block @(:start-col lb)
 321.475 +			      :current (get-column (getf :base))))))
 321.476 +       (let [pos (getf :pos)]
 321.477 +         (add-to-buffer this (make-indent-t lb relative-to offset pos pos)))))))
 321.478 +
 321.479 +(defn- get-miser-width [^Writer this]
 321.480 +  (getf :miser-width))
 321.481 +
 321.482 +(defn- set-miser-width [^Writer this new-miser-width]
 321.483 +  (dosync (setf :miser-width new-miser-width)))
 321.484 +
 321.485 +(defn- set-logical-block-callback [^Writer this f]
 321.486 +  (dosync (setf :logical-block-callback f)))
   322.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   322.2 +++ b/src/clojure/pprint/utilities.clj	Sat Aug 21 06:25:44 2010 -0400
   322.3 @@ -0,0 +1,104 @@
   322.4 +;;; utilities.clj -- part of the pretty printer for Clojure
   322.5 +
   322.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   322.7 +;   The use and distribution terms for this software are covered by the
   322.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   322.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  322.10 +;   By using this software in any fashion, you are agreeing to be bound by
  322.11 +;   the terms of this license.
  322.12 +;   You must not remove this notice, or any other, from this software.
  322.13 +
  322.14 +;; Author: Tom Faulhaber
  322.15 +;; April 3, 2009
  322.16 +
  322.17 +;; This module implements some utility function used in formatting and pretty
  322.18 +;; printing. The functions here could go in a more general purpose library,
  322.19 +;; perhaps.
  322.20 +
  322.21 +(in-ns 'clojure.pprint)
  322.22 +
  322.23 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  322.24 +;;; Helper functions for digesting formats in the various
  322.25 +;;; phases of their lives.
  322.26 +;;; These functions are actually pretty general.
  322.27 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  322.28 +
  322.29 +(defn- map-passing-context [func initial-context lis]
  322.30 +  (loop [context initial-context
  322.31 +         lis lis
  322.32 +         acc []]
  322.33 +    (if (empty? lis)
  322.34 +      [acc context]
  322.35 +    (let [this (first lis)
  322.36 +          remainder (next lis)
  322.37 +          [result new-context] (apply func [this context])]
  322.38 +      (recur new-context remainder (conj acc result))))))
  322.39 +
  322.40 +(defn- consume [func initial-context]
  322.41 +  (loop [context initial-context
  322.42 +         acc []]
  322.43 +    (let [[result new-context] (apply func [context])]
  322.44 +      (if (not result)
  322.45 +        [acc new-context]
  322.46 +      (recur new-context (conj acc result))))))
  322.47 +
  322.48 +(defn- consume-while [func initial-context]
  322.49 +  (loop [context initial-context
  322.50 +         acc []]
  322.51 +    (let [[result continue new-context] (apply func [context])]
  322.52 +      (if (not continue)
  322.53 +        [acc context]
  322.54 +      (recur new-context (conj acc result))))))
  322.55 +
  322.56 +(defn- unzip-map [m]
  322.57 +  "Take a  map that has pairs in the value slots and produce a pair of maps, 
  322.58 +   the first having all the first elements of the pairs and the second all 
  322.59 +   the second elements of the pairs"
  322.60 +  [(into {} (for [[k [v1 v2]] m] [k v1]))
  322.61 +   (into {} (for [[k [v1 v2]] m] [k v2]))])
  322.62 +
  322.63 +(defn- tuple-map [m v1]
  322.64 +  "For all the values, v, in the map, replace them with [v v1]"
  322.65 +  (into {} (for [[k v] m] [k [v v1]])))
  322.66 +
  322.67 +(defn- rtrim [s c]
  322.68 +  "Trim all instances of c from the end of sequence s"
  322.69 +  (let [len (count s)]
  322.70 +    (if (and (pos? len) (= (nth s (dec (count s))) c))
  322.71 +      (loop [n (dec len)]
  322.72 +        (cond 
  322.73 +         (neg? n) ""
  322.74 +         (not (= (nth s n) c)) (subs s 0 (inc n))
  322.75 +         true (recur (dec n))))
  322.76 +      s)))
  322.77 +
  322.78 +(defn- ltrim [s c]
  322.79 +  "Trim all instances of c from the beginning of sequence s"
  322.80 +  (let [len (count s)]
  322.81 +    (if (and (pos? len) (= (nth s 0) c))
  322.82 +      (loop [n 0]
  322.83 +        (if (or (= n len) (not (= (nth s n) c)))
  322.84 +          (subs s n)
  322.85 +          (recur (inc n))))
  322.86 +      s)))
  322.87 +
  322.88 +(defn- prefix-count [aseq val]
  322.89 +  "Return the number of times that val occurs at the start of sequence aseq, 
  322.90 +if val is a seq itself, count the number of times any element of val occurs at the
  322.91 +beginning of aseq"
  322.92 +  (let [test (if (coll? val) (set val) #{val})]
  322.93 +    (loop [pos 0]
  322.94 +     (if (or (= pos (count aseq)) (not (test (nth aseq pos))))
  322.95 +       pos
  322.96 +       (recur (inc pos))))))
  322.97 +
  322.98 +(defn- prerr [& args]
  322.99 +  "Println to *err*"
 322.100 +  (binding [*out* *err*]
 322.101 +    (apply println args)))
 322.102 +       
 322.103 +(defmacro ^{:private true} prlabel [prefix arg & more-args]
 322.104 +  "Print args to *err* in name = value format"
 322.105 +  `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) 
 322.106 +                                                  (cons arg (seq more-args))))))
 322.107 +
   323.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   323.2 +++ b/src/clojure/repl.clj	Sat Aug 21 06:25:44 2010 -0400
   323.3 @@ -0,0 +1,74 @@
   323.4 +;   Copyright (c) Chris Houser, Dec 2008. All rights reserved.
   323.5 +;   The use and distribution terms for this software are covered by the
   323.6 +;   Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
   323.7 +;   which can be found in the file CPL.TXT at the root of this distribution.
   323.8 +;   By using this software in any fashion, you are agreeing to be bound by
   323.9 +;   the terms of this license.
  323.10 +;   You must not remove this notice, or any other, from this software.
  323.11 +
  323.12 +; Utilities meant to be used interactively at the REPL
  323.13 +
  323.14 +(ns
  323.15 +  #^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim, Christophe Grande"
  323.16 +     :doc "Utilities meant to be used interactively at the REPL"}
  323.17 +  clojure.repl
  323.18 +  (:import (java.io LineNumberReader InputStreamReader PushbackReader)
  323.19 +           (clojure.lang RT Reflector)))
  323.20 +
  323.21 +;; ----------------------------------------------------------------------
  323.22 +;; Examine Clojure functions (Vars, really)
  323.23 +
  323.24 +(defn source-fn
  323.25 +  "Returns a string of the source code for the given symbol, if it can
  323.26 +  find it.  This requires that the symbol resolve to a Var defined in
  323.27 +  a namespace for which the .clj is in the classpath.  Returns nil if
  323.28 +  it can't find the source.  For most REPL usage, 'source' is more
  323.29 +  convenient.
  323.30 +
  323.31 +  Example: (source-fn 'filter)"
  323.32 +  [x]
  323.33 +  (when-let [v (resolve x)]
  323.34 +    (when-let [filepath (:file (meta v))]
  323.35 +      (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)]
  323.36 +        (with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
  323.37 +          (dotimes [_ (dec (:line (meta v)))] (.readLine rdr))
  323.38 +          (let [text (StringBuilder.)
  323.39 +                pbr (proxy [PushbackReader] [rdr]
  323.40 +                      (read [] (let [i (proxy-super read)]
  323.41 +                                 (.append text (char i))
  323.42 +                                 i)))]
  323.43 +            (read (PushbackReader. pbr))
  323.44 +            (str text)))))))
  323.45 +
  323.46 +(defmacro source
  323.47 +  "Prints the source code for the given symbol, if it can find it.
  323.48 +  This requires that the symbol resolve to a Var defined in a
  323.49 +  namespace for which the .clj is in the classpath.
  323.50 +
  323.51 +  Example: (source filter)"
  323.52 +  [n]
  323.53 +  `(println (or (source-fn '~n) (str "Source not found"))))
  323.54 +
  323.55 +(defn apropos
  323.56 +  "Given a regular expression or stringable thing, return a seq of
  323.57 +all definitions in all currently-loaded namespaces that match the
  323.58 +str-or-pattern."
  323.59 +  [str-or-pattern]
  323.60 +  (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern)
  323.61 +                   #(re-find str-or-pattern (str %))
  323.62 +                   #(.contains (str %) (str str-or-pattern)))]
  323.63 +    (mapcat (fn [ns]
  323.64 +              (filter matches? (keys (ns-publics ns))))
  323.65 +            (all-ns))))
  323.66 +
  323.67 +(defn dir-fn
  323.68 +  "Returns a sorted seq of symbols naming public vars in
  323.69 +  a namespace"
  323.70 +  [ns]
  323.71 +  (sort (map first (ns-publics (the-ns ns)))))
  323.72 +
  323.73 +(defmacro dir
  323.74 +  "Prints a sorted directory of public vars in a namespace"
  323.75 +  [nsname]
  323.76 +  `(doseq [v# (dir-fn '~nsname)]
  323.77 +     (println v#)))
   324.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   324.2 +++ b/src/clojure/set.clj	Sat Aug 21 06:25:44 2010 -0400
   324.3 @@ -0,0 +1,177 @@
   324.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   324.5 +;   The use and distribution terms for this software are covered by the
   324.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   324.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   324.8 +;   By using this software in any fashion, you are agreeing to be bound by
   324.9 +;   the terms of this license.
  324.10 +;   You must not remove this notice, or any other, from this software.
  324.11 +
  324.12 +(ns ^{:doc "Set operations such as union/intersection."
  324.13 +       :author "Rich Hickey"}
  324.14 +       clojure.set)
  324.15 +
  324.16 +(defn- bubble-max-key [k coll]
  324.17 +  "Move a maximal element of coll according to fn k (which returns a number) 
  324.18 +   to the front of coll."
  324.19 +  (let [max (apply max-key k coll)]
  324.20 +    (cons max (remove #(identical? max %) coll))))
  324.21 +
  324.22 +(defn union
  324.23 +  "Return a set that is the union of the input sets"
  324.24 +  {:added "1.0"}
  324.25 +  ([] #{})
  324.26 +  ([s1] s1)
  324.27 +  ([s1 s2]
  324.28 +     (if (< (count s1) (count s2))
  324.29 +       (reduce conj s2 s1)
  324.30 +       (reduce conj s1 s2)))
  324.31 +  ([s1 s2 & sets]
  324.32 +     (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))]
  324.33 +       (reduce into (first bubbled-sets) (rest bubbled-sets)))))
  324.34 +
  324.35 +(defn intersection
  324.36 +  "Return a set that is the intersection of the input sets"
  324.37 +  {:added "1.0"}
  324.38 +  ([s1] s1)
  324.39 +  ([s1 s2]
  324.40 +     (if (< (count s2) (count s1))
  324.41 +       (recur s2 s1)
  324.42 +       (reduce (fn [result item]
  324.43 +                   (if (contains? s2 item)
  324.44 +		     result
  324.45 +                     (disj result item)))
  324.46 +	       s1 s1)))
  324.47 +  ([s1 s2 & sets] 
  324.48 +     (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))]
  324.49 +       (reduce intersection (first bubbled-sets) (rest bubbled-sets)))))
  324.50 +
  324.51 +(defn difference
  324.52 +  "Return a set that is the first set without elements of the remaining sets"
  324.53 +  {:added "1.0"}
  324.54 +  ([s1] s1)
  324.55 +  ([s1 s2] 
  324.56 +     (if (< (count s1) (count s2))
  324.57 +       (reduce (fn [result item] 
  324.58 +                   (if (contains? s2 item) 
  324.59 +                     (disj result item) 
  324.60 +                     result))
  324.61 +               s1 s1)
  324.62 +       (reduce disj s1 s2)))
  324.63 +  ([s1 s2 & sets] 
  324.64 +     (reduce difference s1 (conj sets s2))))
  324.65 +
  324.66 +
  324.67 +(defn select
  324.68 +  "Returns a set of the elements for which pred is true"
  324.69 +  {:added "1.0"}
  324.70 +  [pred xset]
  324.71 +    (reduce (fn [s k] (if (pred k) s (disj s k)))
  324.72 +            xset xset))
  324.73 +
  324.74 +(defn project
  324.75 +  "Returns a rel of the elements of xrel with only the keys in ks"
  324.76 +  {:added "1.0"}
  324.77 +  [xrel ks]
  324.78 +    (set (map #(select-keys % ks) xrel)))
  324.79 +
  324.80 +(defn rename-keys
  324.81 +  "Returns the map with the keys in kmap renamed to the vals in kmap"
  324.82 +  {:added "1.0"}
  324.83 +  [map kmap]
  324.84 +    (reduce 
  324.85 +     (fn [m [old new]]
  324.86 +       (if (and (not= old new)
  324.87 +                (contains? m old))
  324.88 +         (-> m (assoc new (get m old)) (dissoc old))
  324.89 +         m)) 
  324.90 +     map kmap))
  324.91 +
  324.92 +(defn rename
  324.93 +  "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap"
  324.94 +  {:added "1.0"}
  324.95 +  [xrel kmap]
  324.96 +    (set (map #(rename-keys % kmap) xrel)))
  324.97 +
  324.98 +(defn index
  324.99 +  "Returns a map of the distinct values of ks in the xrel mapped to a
 324.100 +  set of the maps in xrel with the corresponding values of ks."
 324.101 +  {:added "1.0"}
 324.102 +  [xrel ks]
 324.103 +    (reduce
 324.104 +     (fn [m x]
 324.105 +       (let [ik (select-keys x ks)]
 324.106 +         (assoc m ik (conj (get m ik #{}) x))))
 324.107 +     {} xrel))
 324.108 +   
 324.109 +(defn map-invert
 324.110 +  "Returns the map with the vals mapped to the keys."
 324.111 +  {:added "1.0"}
 324.112 +  [m] (reduce (fn [m [k v]] (assoc m v k)) {} m))
 324.113 +
 324.114 +(defn join
 324.115 +  "When passed 2 rels, returns the rel corresponding to the natural
 324.116 +  join. When passed an additional keymap, joins on the corresponding
 324.117 +  keys."
 324.118 +  {:added "1.0"}
 324.119 +  ([xrel yrel] ;natural join
 324.120 +   (if (and (seq xrel) (seq yrel))
 324.121 +     (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel))))
 324.122 +           [r s] (if (<= (count xrel) (count yrel))
 324.123 +                   [xrel yrel]
 324.124 +                   [yrel xrel])
 324.125 +           idx (index r ks)]
 324.126 +       (reduce (fn [ret x]
 324.127 +                 (let [found (idx (select-keys x ks))]
 324.128 +                   (if found
 324.129 +                     (reduce #(conj %1 (merge %2 x)) ret found)
 324.130 +                     ret)))
 324.131 +               #{} s))
 324.132 +     #{}))
 324.133 +  ([xrel yrel km] ;arbitrary key mapping
 324.134 +   (let [[r s k] (if (<= (count xrel) (count yrel))
 324.135 +                   [xrel yrel (map-invert km)]
 324.136 +                   [yrel xrel km])
 324.137 +         idx (index r (vals k))]
 324.138 +     (reduce (fn [ret x]
 324.139 +               (let [found (idx (rename-keys (select-keys x (keys k)) k))]
 324.140 +                 (if found
 324.141 +                   (reduce #(conj %1 (merge %2 x)) ret found)
 324.142 +                   ret)))
 324.143 +             #{} s))))
 324.144 +
 324.145 +(defn subset? 
 324.146 +  "Is set1 a subset of set2?"
 324.147 +  {:added "1.2",
 324.148 +   :tag Boolean}
 324.149 +  [set1 set2]
 324.150 +  (and (<= (count set1) (count set2))
 324.151 +       (every? set2 set1)))
 324.152 +
 324.153 +(defn superset? 
 324.154 +  "Is set1 a superset of set2?"
 324.155 +  {:added "1.2",
 324.156 +   :tag Boolean}
 324.157 +  [set1 set2]
 324.158 +  (and (>= (count set1) (count set2))
 324.159 +       (every? set1 set2)))
 324.160 +
 324.161 +(comment
 324.162 +(refer 'set)
 324.163 +(def xs #{{:a 11 :b 1 :c 1 :d 4}
 324.164 +         {:a 2 :b 12 :c 2 :d 6}
 324.165 +         {:a 3 :b 3 :c 3 :d 8 :f 42}})
 324.166 +
 324.167 +(def ys #{{:a 11 :b 11 :c 11 :e 5}
 324.168 +         {:a 12 :b 11 :c 12 :e 3}
 324.169 +         {:a 3 :b 3 :c 3 :e 7 }})
 324.170 +
 324.171 +(join xs ys)
 324.172 +(join xs (rename ys {:b :yb :c :yc}) {:a :a})
 324.173 +
 324.174 +(union #{:a :b :c} #{:c :d :e })
 324.175 +(difference #{:a :b :c} #{:c :d :e})
 324.176 +(intersection #{:a :b :c} #{:c :d :e})
 324.177 +
 324.178 +(index ys [:b])
 324.179 +)
 324.180 +
   325.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   325.2 +++ b/src/clojure/stacktrace.clj	Sat Aug 21 06:25:44 2010 -0400
   325.3 @@ -0,0 +1,79 @@
   325.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   325.5 +;   The use and distribution terms for this software are covered by the
   325.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   325.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   325.8 +;   By using this software in any fashion, you are agreeing to be bound by
   325.9 +;   the terms of this license.
  325.10 +;   You must not remove this notice, or any other, from this software.
  325.11 +
  325.12 +;;; stacktrace.clj: print Clojure-centric stack traces
  325.13 +
  325.14 +;; by Stuart Sierra
  325.15 +;; January 6, 2009
  325.16 +
  325.17 +(ns ^{:doc "Print stack traces oriented towards Clojure, not Java."
  325.18 +       :author "Stuart Sierra"}
  325.19 +  clojure.stacktrace)
  325.20 +
  325.21 +(defn root-cause
  325.22 +  "Returns the last 'cause' Throwable in a chain of Throwables."
  325.23 +  {:added "1.1"}
  325.24 +  [tr]
  325.25 +  (if-let [cause (.getCause tr)]
  325.26 +    (recur cause)
  325.27 +    tr))
  325.28 +
  325.29 +(defn print-trace-element
  325.30 +  "Prints a Clojure-oriented view of one element in a stack trace."
  325.31 +  {:added "1.1"}
  325.32 +  [e]
  325.33 +  (let [class (.getClassName e)
  325.34 +	method (.getMethodName e)] 
  325.35 +    (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)]
  325.36 +      (if (and match (= "invoke" method))
  325.37 +	(apply printf "%s/%s" (rest match))
  325.38 +	(printf "%s.%s" class method))))
  325.39 +  (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
  325.40 +
  325.41 +(defn print-throwable
  325.42 +  "Prints the class and message of a Throwable."
  325.43 +  {:added "1.1"}
  325.44 +  [tr]
  325.45 +  (printf "%s: %s" (.getName (class tr)) (.getMessage tr)))
  325.46 +
  325.47 +(defn print-stack-trace
  325.48 +  "Prints a Clojure-oriented stack trace of tr, a Throwable.
  325.49 +  Prints a maximum of n stack frames (default: unlimited).
  325.50 +  Does not print chained exceptions (causes)."
  325.51 +  {:added "1.1"}
  325.52 +  ([tr] (print-stack-trace tr nil))
  325.53 +  ([tr n]
  325.54 +     (let [st (.getStackTrace tr)]
  325.55 +       (print-throwable tr)
  325.56 +       (newline)
  325.57 +       (print " at ") 
  325.58 +       (print-trace-element (first st))
  325.59 +       (newline)
  325.60 +       (doseq [e (if (nil? n)
  325.61 +		   (rest st)
  325.62 +		   (take (dec n) (rest st)))]
  325.63 +	 (print "    ")
  325.64 +	 (print-trace-element e)
  325.65 +	 (newline)))))
  325.66 +
  325.67 +(defn print-cause-trace
  325.68 +  "Like print-stack-trace but prints chained exceptions (causes)."
  325.69 +  {:added "1.1"}
  325.70 +  ([tr] (print-cause-trace tr nil))
  325.71 +  ([tr n]
  325.72 +     (print-stack-trace tr n)
  325.73 +     (when-let [cause (.getCause tr)]
  325.74 +       (print "Caused by: " )
  325.75 +       (recur cause n))))
  325.76 +
  325.77 +(defn e
  325.78 +  "REPL utility.  Prints a brief stack trace for the root cause of the
  325.79 +  most recent exception."
  325.80 +  {:added "1.1"}
  325.81 +  []
  325.82 +  (print-stack-trace (root-cause *e) 8))
   326.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   326.2 +++ b/src/clojure/string.clj	Sat Aug 21 06:25:44 2010 -0400
   326.3 @@ -0,0 +1,254 @@
   326.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   326.5 +;   The use and distribution terms for this software are covered by the
   326.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   326.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   326.8 +;   By using this software in any fashion, you are agreeing to be bound by
   326.9 +;   the terms of this license.
  326.10 +;   You must not remove this notice, or any other, from this software.
  326.11 +
  326.12 +(ns ^{:doc "Clojure String utilities
  326.13 +
  326.14 +It is poor form to (:use clojure.string). Instead, use require
  326.15 +with :as to specify a prefix, e.g.
  326.16 +
  326.17 +(ns your.namespace.here
  326.18 +  (:require '[clojure.string :as str]))
  326.19 +
  326.20 +Design notes for clojure.string:
  326.21 +
  326.22 +1. Strings are objects (as opposed to sequences). As such, the
  326.23 +   string being manipulated is the first argument to a function;
  326.24 +   passing nil will result in a NullPointerException unless
  326.25 +   documented otherwise. If you want sequence-y behavior instead,
  326.26 +   use a sequence.
  326.27 +
  326.28 +2. Functions are generally not lazy, and call straight to host
  326.29 +   methods where those are available and efficient.
  326.30 +
  326.31 +3. Functions take advantage of String implementation details to
  326.32 +   write high-performing loop/recurs instead of using higher-order
  326.33 +   functions. (This is not idiomatic in general-purpose application
  326.34 +   code.)
  326.35 +
  326.36 +4. When a function is documented to accept a string argument, it
  326.37 +   will take any implementation of the correct *interface* on the
  326.38 +   host platform. In Java, this is CharSequence, which is more
  326.39 +   general than String. In ordinary usage you will almost always
  326.40 +   pass concrete strings. If you are doing something unusual,
  326.41 +   e.g. passing a mutable implementation of CharSequence, then
  326.42 +   thead-safety is your responsibility."
  326.43 +      :author "Stuart Sierra, Stuart Halloway, David Liebke"}
  326.44 +  clojure.string
  326.45 +  (:refer-clojure :exclude (replace reverse))
  326.46 +  (:import (java.util.regex Pattern)
  326.47 +           clojure.lang.LazilyPersistentVector))
  326.48 +
  326.49 +(defn ^String reverse
  326.50 +  "Returns s with its characters reversed."
  326.51 +  {:added "1.2"}
  326.52 +  [^CharSequence s]
  326.53 +  (.toString (.reverse (StringBuilder. s))))
  326.54 +
  326.55 +(defn- replace-by
  326.56 +  [^CharSequence s re f]
  326.57 +  (let [m (re-matcher re s)]
  326.58 +    (let [buffer (StringBuffer. (.length s))]
  326.59 +      (loop []
  326.60 +        (if (.find m)
  326.61 +          (do (.appendReplacement m buffer (f (re-groups m)))
  326.62 +              (recur))
  326.63 +          (do (.appendTail m buffer)
  326.64 +              (.toString buffer)))))))
  326.65 +
  326.66 +(defn ^String replace
  326.67 +  "Replaces all instance of match with replacement in s.
  326.68 +
  326.69 +   match/replacement can be:
  326.70 +
  326.71 +   string / string
  326.72 +   char / char
  326.73 +   pattern / (string or function of match).
  326.74 +
  326.75 +   See also replace-first."
  326.76 +  {:added "1.2"}
  326.77 +  [^CharSequence s match replacement]
  326.78 +  (let [s (.toString s)]
  326.79 +    (cond 
  326.80 +     (instance? Character match) (.replace s ^Character match ^Character replacement)
  326.81 +     (instance? CharSequence match) (.replace s ^CharSequence match ^CharSequence replacement)
  326.82 +     (instance? Pattern match) (if (instance? CharSequence replacement)
  326.83 +                                 (.replaceAll (re-matcher ^Pattern match s)
  326.84 +                                              (.toString ^CharSequence replacement))
  326.85 +                                 (replace-by s match replacement))
  326.86 +     :else (throw (IllegalArgumentException. (str "Invalid match arg: " match))))))
  326.87 +
  326.88 +(defn- replace-first-by
  326.89 +  [^CharSequence s ^Pattern re f]
  326.90 +  (let [m (re-matcher re s)]
  326.91 +    (let [buffer (StringBuffer. (.length s))]
  326.92 +      (if (.find m)
  326.93 +        (let [rep (f (re-groups m))]
  326.94 +          (.appendReplacement m buffer rep)
  326.95 +          (.appendTail m buffer)
  326.96 +          (str buffer))))))
  326.97 +
  326.98 +(defn- replace-first-char
  326.99 +  [^CharSequence s ^Character match replace]
 326.100 +  (let [s (.toString s)
 326.101 +        i (.indexOf s (int match))]
 326.102 +    (if (= -1 i)
 326.103 +      s
 326.104 +      (str (subs s 0 i) replace (subs s (inc i))))))
 326.105 +
 326.106 +(defn ^String replace-first
 326.107 +  "Replaces the first instance of match with replacement in s.
 326.108 +
 326.109 +   match/replacement can be:
 326.110 +
 326.111 +   char / char
 326.112 +   string / string
 326.113 +   pattern / (string or function of match).
 326.114 +
 326.115 +   See also replace-all."
 326.116 +  {:added "1.2"}
 326.117 +  [^CharSequence s match replacement]
 326.118 +  (let [s (.toString s)]
 326.119 +    (cond
 326.120 +     (instance? Character match)
 326.121 +     (replace-first-char s match replacement)
 326.122 +     (instance? CharSequence match)
 326.123 +     (.replaceFirst s (Pattern/quote (.toString ^CharSequence match))
 326.124 +                    (.toString ^CharSequence replacement))
 326.125 +     (instance? Pattern match)
 326.126 +     (if (instance? CharSequence replacement)
 326.127 +       (.replaceFirst (re-matcher ^Pattern match s)
 326.128 +                      (.toString ^CharSequence replacement))
 326.129 +       (replace-first-by s match replacement))
 326.130 +     :else (throw (IllegalArgumentException. (str "Invalid match arg: " match))))))
 326.131 +
 326.132 +
 326.133 +(defn ^String join
 326.134 +  "Returns a string of all elements in coll, separated by
 326.135 +   an optional separator.  Like Perl's join."
 326.136 +  {:added "1.2"}
 326.137 +  ([coll]
 326.138 +     (apply str coll))
 326.139 +  ([separator [x & more]]
 326.140 +     (loop [sb (StringBuilder. (str x))
 326.141 +            more more
 326.142 +            sep (str separator)]
 326.143 +       (if more
 326.144 +         (recur (-> sb (.append sep) (.append (str (first more))))
 326.145 +                (next more)
 326.146 +                sep)
 326.147 +         (str sb)))))
 326.148 +
 326.149 +(defn ^String capitalize
 326.150 +  "Converts first character of the string to upper-case, all other
 326.151 +  characters to lower-case."
 326.152 +  {:added "1.2"}
 326.153 +  [^CharSequence s]
 326.154 +  (let [s (.toString s)]
 326.155 +    (if (< (count s) 2)
 326.156 +      (.toUpperCase s)
 326.157 +      (str (.toUpperCase (subs s 0 1))
 326.158 +           (.toLowerCase (subs s 1))))))
 326.159 +
 326.160 +(defn ^String upper-case
 326.161 +  "Converts string to all upper-case."
 326.162 +  {:added "1.2"}
 326.163 +  [^CharSequence s]
 326.164 +  (.. s toString toUpperCase))
 326.165 +
 326.166 +(defn ^String lower-case
 326.167 +  "Converts string to all lower-case."
 326.168 +  {:added "1.2"}
 326.169 +  [^CharSequence s]
 326.170 +  (.. s toString toLowerCase))
 326.171 +
 326.172 +(defn split
 326.173 +  "Splits string on a regular expression.  Optional argument limit is
 326.174 +  the maximum number of splits. Not lazy. Returns vector of the splits."
 326.175 +  {:added "1.2"}
 326.176 +  ([^CharSequence s ^Pattern re]
 326.177 +     (LazilyPersistentVector/createOwning (.split re s)))
 326.178 +  ([ ^CharSequence s ^Pattern re limit]
 326.179 +     (LazilyPersistentVector/createOwning (.split re s limit))))
 326.180 +
 326.181 +(defn split-lines
 326.182 +  "Splits s on \\n or \\r\\n."
 326.183 +  {:added "1.2"}
 326.184 +  [^CharSequence s]
 326.185 +  (split s #"\r?\n"))
 326.186 +
 326.187 +(defn ^String trim
 326.188 +  "Removes whitespace from both ends of string."
 326.189 +  {:added "1.2"}
 326.190 +  [^CharSequence s]
 326.191 +  (.. s toString trim))
 326.192 +
 326.193 +(defn ^String triml
 326.194 +  "Removes whitespace from the left side of string."
 326.195 +  {:added "1.2"}
 326.196 +  [^CharSequence s]
 326.197 +  (loop [index (int 0)]
 326.198 +    (if (= (.length s) index)
 326.199 +      ""
 326.200 +      (if (Character/isWhitespace (.charAt s index))
 326.201 +        (recur (inc index))
 326.202 +        (.. s (subSequence index (.length s)) toString)))))
 326.203 +
 326.204 +(defn ^String trimr
 326.205 +  "Removes whitespace from the right side of string."
 326.206 +  {:added "1.2"}
 326.207 +  [^CharSequence s]
 326.208 +  (loop [index (.length s)]
 326.209 +    (if (zero? index)
 326.210 +      ""
 326.211 +      (if (Character/isWhitespace (.charAt s (dec index)))
 326.212 +        (recur (dec index))
 326.213 +        (.. s (subSequence 0 index) toString)))))
 326.214 +
 326.215 +(defn ^String trim-newline
 326.216 +  "Removes all trailing newline \\n or return \\r characters from
 326.217 +  string.  Similar to Perl's chomp."
 326.218 +  {:added "1.2"}
 326.219 +  [^CharSequence s]
 326.220 +  (loop [index (.length s)]
 326.221 +    (if (zero? index)
 326.222 +      ""
 326.223 +      (let [ch (.charAt s (dec index))]
 326.224 +        (if (or (= ch \newline) (= ch \return))
 326.225 +          (recur (dec index))
 326.226 +          (.. s (subSequence 0 index) toString))))))
 326.227 +
 326.228 +(defn blank?
 326.229 +  "True if s is nil, empty, or contains only whitespace."
 326.230 +  {:added "1.2"}
 326.231 +  [^CharSequence s]
 326.232 +  (if s
 326.233 +    (loop [index (int 0)]
 326.234 +      (if (= (.length s) index)
 326.235 +        true
 326.236 +        (if (Character/isWhitespace (.charAt s index))
 326.237 +          (recur (inc index))
 326.238 +          false)))
 326.239 +    true))
 326.240 +
 326.241 +(defn ^String escape
 326.242 +  "Return a new string, using cmap to escape each character ch
 326.243 +   from s as follows:
 326.244 +   
 326.245 +   If (cmap ch) is nil, append ch to the new string.
 326.246 +   If (cmap ch) is non-nil, append (str (cmap ch)) instead."
 326.247 +  {:added "1.2"}
 326.248 +  [^CharSequence s cmap]
 326.249 +  (loop [index (int 0)
 326.250 +         buffer (StringBuilder. (.length s))]
 326.251 +    (if (= (.length s) index)
 326.252 +      (.toString buffer)
 326.253 +      (let [ch (.charAt s index)]
 326.254 +        (if-let [replacement (cmap ch)]
 326.255 +          (.append buffer replacement)
 326.256 +          (.append buffer ch))
 326.257 +        (recur (inc index) buffer)))))
   327.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   327.2 +++ b/src/clojure/template.clj	Sat Aug 21 06:25:44 2010 -0400
   327.3 @@ -0,0 +1,55 @@
   327.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   327.5 +;   The use and distribution terms for this software are covered by the
   327.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   327.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   327.8 +;   By using this software in any fashion, you are agreeing to be bound by
   327.9 +;   the terms of this license.
  327.10 +;   You must not remove this notice, or any other, from this software.
  327.11 +
  327.12 +;;; template.clj - anonymous functions that pre-evaluate sub-expressions
  327.13 +
  327.14 +;; By Stuart Sierra
  327.15 +;; June 23, 2009
  327.16 +
  327.17 +;; CHANGE LOG
  327.18 +;;
  327.19 +;; June 23, 2009: complete rewrite, eliminated _1,_2,... argument
  327.20 +;; syntax
  327.21 +;;
  327.22 +;; January 20, 2009: added "template?" and checks for valid template
  327.23 +;; expressions.
  327.24 +;;
  327.25 +;; December 15, 2008: first version
  327.26 +
  327.27 +
  327.28 +(ns ^{:doc "Macros that expand to repeated copies of a template expression."
  327.29 +       :author "Stuart Sierra"}
  327.30 +  clojure.template
  327.31 +  (:require [clojure.walk :as walk]))
  327.32 +
  327.33 +(defn apply-template
  327.34 +  "For use in macros.  argv is an argument list, as in defn.  expr is
  327.35 +  a quoted expression using the symbols in argv.  values is a sequence
  327.36 +  of values to be used for the arguments.
  327.37 +
  327.38 +  apply-template will recursively replace argument symbols in expr
  327.39 +  with their corresponding values, returning a modified expr.
  327.40 +
  327.41 +  Example: (apply-template '[x] '(+ x x) '[2])
  327.42 +           ;=> (+ 2 2)"
  327.43 +  [argv expr values]
  327.44 +  (assert (vector? argv))
  327.45 +  (assert (every? symbol? argv))
  327.46 +  (walk/prewalk-replace (zipmap argv values) expr))
  327.47 +
  327.48 +(defmacro do-template
  327.49 +  "Repeatedly copies expr (in a do block) for each group of arguments
  327.50 +  in values.  values are automatically partitioned by the number of
  327.51 +  arguments in argv, an argument vector as in defn.
  327.52 +
  327.53 +  Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5))
  327.54 +           ;=> (do (+ 4 2) (+ 5 3))"
  327.55 +  [argv expr & values]
  327.56 +  (let [c (count argv)]
  327.57 +    `(do ~@(map (fn [a] (apply-template argv expr a)) 
  327.58 +                (partition c values)))))
   328.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   328.2 +++ b/src/clojure/test.clj	Sat Aug 21 06:25:44 2010 -0400
   328.3 @@ -0,0 +1,758 @@
   328.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   328.5 +;   The use and distribution terms for this software are covered by the
   328.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   328.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   328.8 +;   By using this software in any fashion, you are agreeing to be bound by
   328.9 +;   the terms of this license.
  328.10 +;   You must not remove this notice, or any other, from this software.
  328.11 +
  328.12 +;;; test.clj: test framework for Clojure
  328.13 +
  328.14 +;; by Stuart Sierra
  328.15 +;; March 28, 2009
  328.16 +
  328.17 +;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for
  328.18 +;; contributions and suggestions.
  328.19 +
  328.20 +(ns 
  328.21 +  ^{:author "Stuart Sierra, with contributions and suggestions by 
  328.22 +  Chas Emerick, Allen Rohner, and Stuart Halloway",
  328.23 +     :doc "A unit testing framework.
  328.24 +
  328.25 +   ASSERTIONS
  328.26 +
  328.27 +   The core of the library is the \"is\" macro, which lets you make
  328.28 +   assertions of any arbitrary expression:
  328.29 +
  328.30 +   (is (= 4 (+ 2 2)))
  328.31 +   (is (instance? Integer 256))
  328.32 +   (is (.startsWith \"abcde\" \"ab\"))
  328.33 +
  328.34 +   You can type an \"is\" expression directly at the REPL, which will
  328.35 +   print a message if it fails.
  328.36 +
  328.37 +       user> (is (= 5 (+ 2 2)))
  328.38 +
  328.39 +       FAIL in  (:1)
  328.40 +       expected: (= 5 (+ 2 2))
  328.41 +         actual: (not (= 5 4))
  328.42 +       false
  328.43 +
  328.44 +   The \"expected:\" line shows you the original expression, and the
  328.45 +   \"actual:\" shows you what actually happened.  In this case, it
  328.46 +   shows that (+ 2 2) returned 4, which is not = to 5.  Finally, the
  328.47 +   \"false\" on the last line is the value returned from the
  328.48 +   expression.  The \"is\" macro always returns the result of the
  328.49 +   inner expression.
  328.50 +
  328.51 +   There are two special assertions for testing exceptions.  The
  328.52 +   \"(is (thrown? c ...))\" form tests if an exception of class c is
  328.53 +   thrown:
  328.54 +
  328.55 +   (is (thrown? ArithmeticException (/ 1 0))) 
  328.56 +
  328.57 +   \"(is (thrown-with-msg? c re ...))\" does the same thing and also
  328.58 +   tests that the message on the exception matches the regular
  328.59 +   expression re:
  328.60 +
  328.61 +   (is (thrown-with-msg? ArithmeticException #\"Divide by zero\"
  328.62 +                         (/ 1 0)))
  328.63 +
  328.64 +   DOCUMENTING TESTS
  328.65 +
  328.66 +   \"is\" takes an optional second argument, a string describing the
  328.67 +   assertion.  This message will be included in the error report.
  328.68 +
  328.69 +   (is (= 5 (+ 2 2)) \"Crazy arithmetic\")
  328.70 +
  328.71 +   In addition, you can document groups of assertions with the
  328.72 +   \"testing\" macro, which takes a string followed by any number of
  328.73 +   assertions.  The string will be included in failure reports.
  328.74 +   Calls to \"testing\" may be nested, and all of the strings will be
  328.75 +   joined together with spaces in the final report, in a style
  328.76 +   similar to RSpec <http://rspec.info/>
  328.77 +
  328.78 +   (testing \"Arithmetic\"
  328.79 +     (testing \"with positive integers\"
  328.80 +       (is (= 4 (+ 2 2)))
  328.81 +       (is (= 7 (+ 3 4))))
  328.82 +     (testing \"with negative integers\"
  328.83 +       (is (= -4 (+ -2 -2)))
  328.84 +       (is (= -1 (+ 3 -4)))))
  328.85 +
  328.86 +   Note that, unlike RSpec, the \"testing\" macro may only be used
  328.87 +   INSIDE a \"deftest\" or \"with-test\" form (see below).
  328.88 +
  328.89 +
  328.90 +   DEFINING TESTS
  328.91 +
  328.92 +   There are two ways to define tests.  The \"with-test\" macro takes
  328.93 +   a defn or def form as its first argument, followed by any number
  328.94 +   of assertions.  The tests will be stored as metadata on the
  328.95 +   definition.
  328.96 +
  328.97 +   (with-test
  328.98 +       (defn my-function [x y]
  328.99 +         (+ x y))
 328.100 +     (is (= 4 (my-function 2 2)))
 328.101 +     (is (= 7 (my-function 3 4))))
 328.102 +
 328.103 +   As of Clojure SVN rev. 1221, this does not work with defmacro.
 328.104 +   See http://code.google.com/p/clojure/issues/detail?id=51
 328.105 +
 328.106 +   The other way lets you define tests separately from the rest of
 328.107 +   your code, even in a different namespace:
 328.108 +
 328.109 +   (deftest addition
 328.110 +     (is (= 4 (+ 2 2)))
 328.111 +     (is (= 7 (+ 3 4))))
 328.112 +
 328.113 +   (deftest subtraction
 328.114 +     (is (= 1 (- 4 3)))
 328.115 +     (is (= 3 (- 7 4))))
 328.116 +
 328.117 +   This creates functions named \"addition\" and \"subtraction\", which
 328.118 +   can be called like any other function.  Therefore, tests can be
 328.119 +   grouped and composed, in a style similar to the test framework in
 328.120 +   Peter Seibel's \"Practical Common Lisp\"
 328.121 +   <http://www.gigamonkeys.com/book/practical-building-a-unit-test-framework.html>
 328.122 +
 328.123 +   (deftest arithmetic
 328.124 +     (addition)
 328.125 +     (subtraction))
 328.126 +
 328.127 +   The names of the nested tests will be joined in a list, like
 328.128 +   \"(arithmetic addition)\", in failure reports.  You can use nested
 328.129 +   tests to set up a context shared by several tests.
 328.130 +
 328.131 +
 328.132 +   RUNNING TESTS
 328.133 +
 328.134 +   Run tests with the function \"(run-tests namespaces...)\":
 328.135 +
 328.136 +   (run-tests 'your.namespace 'some.other.namespace)
 328.137 +
 328.138 +   If you don't specify any namespaces, the current namespace is
 328.139 +   used.  To run all tests in all namespaces, use \"(run-all-tests)\".
 328.140 +
 328.141 +   By default, these functions will search for all tests defined in
 328.142 +   a namespace and run them in an undefined order.  However, if you
 328.143 +   are composing tests, as in the \"arithmetic\" example above, you
 328.144 +   probably do not want the \"addition\" and \"subtraction\" tests run
 328.145 +   separately.  In that case, you must define a special function
 328.146 +   named \"test-ns-hook\" that runs your tests in the correct order:
 328.147 +
 328.148 +   (defn test-ns-hook []
 328.149 +     (arithmetic))
 328.150 +
 328.151 +
 328.152 +   OMITTING TESTS FROM PRODUCTION CODE
 328.153 +
 328.154 +   You can bind the variable \"*load-tests*\" to false when loading or
 328.155 +   compiling code in production.  This will prevent any tests from
 328.156 +   being created by \"with-test\" or \"deftest\".
 328.157 +
 328.158 +
 328.159 +   FIXTURES (new)
 328.160 +
 328.161 +   Fixtures allow you to run code before and after tests, to set up
 328.162 +   the context in which tests should be run.
 328.163 +
 328.164 +   A fixture is just a function that calls another function passed as
 328.165 +   an argument.  It looks like this:
 328.166 +
 328.167 +   (defn my-fixture [f]
 328.168 +      Perform setup, establish bindings, whatever.
 328.169 +     (f)  Then call the function we were passed.
 328.170 +      Tear-down / clean-up code here.
 328.171 +    )
 328.172 +
 328.173 +   Fixtures are attached to namespaces in one of two ways.  \"each\"
 328.174 +   fixtures are run repeatedly, once for each test function created
 328.175 +   with \"deftest\" or \"with-test\".  \"each\" fixtures are useful for
 328.176 +   establishing a consistent before/after state for each test, like
 328.177 +   clearing out database tables.
 328.178 +
 328.179 +   \"each\" fixtures can be attached to the current namespace like this:
 328.180 +   (use-fixtures :each fixture1 fixture2 ...)
 328.181 +   The fixture1, fixture2 are just functions like the example above.
 328.182 +   They can also be anonymous functions, like this:
 328.183 +   (use-fixtures :each (fn [f] setup... (f) cleanup...))
 328.184 +
 328.185 +   The other kind of fixture, a \"once\" fixture, is only run once,
 328.186 +   around ALL the tests in the namespace.  \"once\" fixtures are useful
 328.187 +   for tasks that only need to be performed once, like establishing
 328.188 +   database connections, or for time-consuming tasks.
 328.189 +
 328.190 +   Attach \"once\" fixtures to the current namespace like this:
 328.191 +   (use-fixtures :once fixture1 fixture2 ...)
 328.192 +
 328.193 +
 328.194 +   SAVING TEST OUTPUT TO A FILE
 328.195 +
 328.196 +   All the test reporting functions write to the var *test-out*.  By
 328.197 +   default, this is the same as *out*, but you can rebind it to any
 328.198 +   PrintWriter.  For example, it could be a file opened with
 328.199 +   clojure.java.io/writer.
 328.200 +
 328.201 +
 328.202 +   EXTENDING TEST-IS (ADVANCED)
 328.203 +
 328.204 +   You can extend the behavior of the \"is\" macro by defining new
 328.205 +   methods for the \"assert-expr\" multimethod.  These methods are
 328.206 +   called during expansion of the \"is\" macro, so they should return
 328.207 +   quoted forms to be evaluated.
 328.208 +
 328.209 +   You can plug in your own test-reporting framework by rebinding
 328.210 +   the \"report\" function: (report event)
 328.211 +
 328.212 +   The 'event' argument is a map.  It will always have a :type key,
 328.213 +   whose value will be a keyword signaling the type of event being
 328.214 +   reported.  Standard events with :type value of :pass, :fail, and
 328.215 +   :error are called when an assertion passes, fails, and throws an
 328.216 +   exception, respectively.  In that case, the event will also have
 328.217 +   the following keys:
 328.218 +
 328.219 +     :expected   The form that was expected to be true
 328.220 +     :actual     A form representing what actually occurred
 328.221 +     :message    The string message given as an argument to 'is'
 328.222 +
 328.223 +   The \"testing\" strings will be a list in \"*testing-contexts*\", and
 328.224 +   the vars being tested will be a list in \"*testing-vars*\".
 328.225 +
 328.226 +   Your \"report\" function should wrap any printing calls in the
 328.227 +   \"with-test-out\" macro, which rebinds *out* to the current value
 328.228 +   of *test-out*.
 328.229 +
 328.230 +   For additional event types, see the examples in the code.
 328.231 +"}
 328.232 +  clojure.test
 328.233 +  (:require [clojure.template :as temp]
 328.234 +            [clojure.stacktrace :as stack]))
 328.235 +
 328.236 +;; Nothing is marked "private" here, so you can rebind things to plug
 328.237 +;; in your own testing or reporting frameworks.
 328.238 +
 328.239 +
 328.240 +;;; USER-MODIFIABLE GLOBALS
 328.241 +
 328.242 +(defonce
 328.243 +  ^{:doc "True by default.  If set to false, no test functions will
 328.244 +   be created by deftest, set-test, or with-test.  Use this to omit
 328.245 +   tests when compiling or loading production code."
 328.246 +    :added "1.1"}
 328.247 +  *load-tests* true)
 328.248 +
 328.249 +(def
 328.250 + ^{:doc "The maximum depth of stack traces to print when an Exception
 328.251 +  is thrown during a test.  Defaults to nil, which means print the 
 328.252 +  complete stack trace."
 328.253 +   :added "1.1"}
 328.254 + *stack-trace-depth* nil)
 328.255 +
 328.256 +
 328.257 +;;; GLOBALS USED BY THE REPORTING FUNCTIONS
 328.258 +
 328.259 +(def *report-counters* nil)	  ; bound to a ref of a map in test-ns
 328.260 +
 328.261 +(def *initial-report-counters*  ; used to initialize *report-counters*
 328.262 +     {:test 0, :pass 0, :fail 0, :error 0})
 328.263 +
 328.264 +(def *testing-vars* (list))  ; bound to hierarchy of vars being tested
 328.265 +
 328.266 +(def *testing-contexts* (list)) ; bound to hierarchy of "testing" strings
 328.267 +
 328.268 +(def *test-out* *out*)         ; PrintWriter for test reporting output
 328.269 +
 328.270 +(defmacro with-test-out
 328.271 +  "Runs body with *out* bound to the value of *test-out*."
 328.272 +  {:added "1.1"}
 328.273 +  [& body]
 328.274 +  `(binding [*out* *test-out*]
 328.275 +     ~@body))
 328.276 +
 328.277 +;;; UTILITIES FOR REPORTING FUNCTIONS
 328.278 +
 328.279 +(defn file-position
 328.280 +  "Returns a vector [filename line-number] for the nth call up the
 328.281 +  stack.
 328.282 +
 328.283 +  Deprecated in 1.2: The information needed for test reporting is
 328.284 +  now on :file and :line keys in the result map."
 328.285 +  {:added "1.1"
 328.286 +   :deprecated "1.2"}
 328.287 +  [n]
 328.288 +  (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)]
 328.289 +    [(.getFileName s) (.getLineNumber s)]))
 328.290 +
 328.291 +(defn testing-vars-str
 328.292 +  "Returns a string representation of the current test.  Renders names
 328.293 +  in *testing-vars* as a list, then the source file and line of
 328.294 +  current assertion."
 328.295 +  {:added "1.1"}
 328.296 +  [m]
 328.297 +  (let [{:keys [file line]} m]
 328.298 +    (str
 328.299 +     ;; Uncomment to include namespace in failure report:
 328.300 +     ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ "
 328.301 +     (reverse (map #(:name (meta %)) *testing-vars*))
 328.302 +     " (" file ":" line ")")))
 328.303 +
 328.304 +(defn testing-contexts-str
 328.305 +  "Returns a string representation of the current test context. Joins
 328.306 +  strings in *testing-contexts* with spaces."
 328.307 +  {:added "1.1"}
 328.308 +  []
 328.309 +  (apply str (interpose " " (reverse *testing-contexts*))))
 328.310 +
 328.311 +(defn inc-report-counter
 328.312 +  "Increments the named counter in *report-counters*, a ref to a map.
 328.313 +  Does nothing if *report-counters* is nil."
 328.314 +  {:added "1.1"}
 328.315 +  [name]
 328.316 +  (when *report-counters*
 328.317 +    (dosync (commute *report-counters* assoc name
 328.318 +                     (inc (or (*report-counters* name) 0))))))
 328.319 +
 328.320 +;;; TEST RESULT REPORTING
 328.321 +
 328.322 +(defmulti
 328.323 +  ^{:doc "Generic reporting function, may be overridden to plug in
 328.324 +   different report formats (e.g., TAP, JUnit).  Assertions such as
 328.325 +   'is' call 'report' to indicate results.  The argument given to
 328.326 +   'report' will be a map with a :type key.  See the documentation at
 328.327 +   the top of test_is.clj for more information on the types of
 328.328 +   arguments for 'report'."
 328.329 +     :dynamic true
 328.330 +     :added "1.1"}
 328.331 +  report :type)
 328.332 +
 328.333 +(defn- file-and-line 
 328.334 +  [exception depth]
 328.335 +  (let [^StackTraceElement s (nth (.getStackTrace exception) depth)]
 328.336 +    {:file (.getFileName s) :line (.getLineNumber s)}))
 328.337 +
 328.338 +(defn do-report
 328.339 +  "Add file and line information to a test result and call report.
 328.340 +   If you are writing a custom assert-expr method, call this function
 328.341 +   to pass test results to report."
 328.342 +  {:added "1.2"}
 328.343 +  [m]
 328.344 +  (report
 328.345 +   (case
 328.346 +    (:type m)
 328.347 +    :fail (merge (file-and-line (new java.lang.Throwable) 1) m)
 328.348 +    :error (merge (file-and-line (:actual m) 0) m) 
 328.349 +    m)))
 328.350 +
 328.351 +(defmethod report :default [m]
 328.352 +  (with-test-out (prn m)))
 328.353 +
 328.354 +(defmethod report :pass [m]
 328.355 +  (with-test-out (inc-report-counter :pass)))
 328.356 +
 328.357 +(defmethod report :fail [m]
 328.358 +  (with-test-out
 328.359 +    (inc-report-counter :fail)
 328.360 +    (println "\nFAIL in" (testing-vars-str m))
 328.361 +    (when (seq *testing-contexts*) (println (testing-contexts-str)))
 328.362 +    (when-let [message (:message m)] (println message))
 328.363 +    (println "expected:" (pr-str (:expected m)))
 328.364 +    (println "  actual:" (pr-str (:actual m)))))
 328.365 +
 328.366 +(defmethod report :error [m]
 328.367 +  (with-test-out
 328.368 +   (inc-report-counter :error)
 328.369 +   (println "\nERROR in" (testing-vars-str m))
 328.370 +   (when (seq *testing-contexts*) (println (testing-contexts-str)))
 328.371 +   (when-let [message (:message m)] (println message))
 328.372 +   (println "expected:" (pr-str (:expected m)))
 328.373 +   (print "  actual: ")
 328.374 +   (let [actual (:actual m)]
 328.375 +     (if (instance? Throwable actual)
 328.376 +       (stack/print-cause-trace actual *stack-trace-depth*)
 328.377 +       (prn actual)))))
 328.378 +
 328.379 +(defmethod report :summary [m]
 328.380 +  (with-test-out
 328.381 +   (println "\nRan" (:test m) "tests containing"
 328.382 +            (+ (:pass m) (:fail m) (:error m)) "assertions.")
 328.383 +   (println (:fail m) "failures," (:error m) "errors.")))
 328.384 +
 328.385 +(defmethod report :begin-test-ns [m]
 328.386 +  (with-test-out
 328.387 +   (println "\nTesting" (ns-name (:ns m)))))
 328.388 +
 328.389 +;; Ignore these message types:
 328.390 +(defmethod report :end-test-ns [m])
 328.391 +(defmethod report :begin-test-var [m])
 328.392 +(defmethod report :end-test-var [m])
 328.393 +
 328.394 +
 328.395 +
 328.396 +;;; UTILITIES FOR ASSERTIONS
 328.397 +
 328.398 +(defn get-possibly-unbound-var
 328.399 +  "Like var-get but returns nil if the var is unbound."
 328.400 +  {:added "1.1"}
 328.401 +  [v]
 328.402 +  (try (var-get v)
 328.403 +       (catch IllegalStateException e
 328.404 +         nil)))
 328.405 +
 328.406 +(defn function?
 328.407 +  "Returns true if argument is a function or a symbol that resolves to
 328.408 +  a function (not a macro)."
 328.409 +  {:added "1.1"}
 328.410 +  [x]
 328.411 +  (if (symbol? x)
 328.412 +    (when-let [v (resolve x)]
 328.413 +      (when-let [value (get-possibly-unbound-var v)]
 328.414 +        (and (fn? value)
 328.415 +             (not (:macro (meta v))))))
 328.416 +    (fn? x)))
 328.417 +
 328.418 +(defn assert-predicate
 328.419 +  "Returns generic assertion code for any functional predicate.  The
 328.420 +  'expected' argument to 'report' will contains the original form, the
 328.421 +  'actual' argument will contain the form with all its sub-forms
 328.422 +  evaluated.  If the predicate returns false, the 'actual' form will
 328.423 +  be wrapped in (not...)."
 328.424 +  {:added "1.1"}
 328.425 +  [msg form]
 328.426 +  (let [args (rest form)
 328.427 +        pred (first form)]
 328.428 +    `(let [values# (list ~@args)
 328.429 +           result# (apply ~pred values#)]
 328.430 +       (if result#
 328.431 +         (do-report {:type :pass, :message ~msg,
 328.432 +                  :expected '~form, :actual (cons ~pred values#)})
 328.433 +         (do-report {:type :fail, :message ~msg,
 328.434 +                  :expected '~form, :actual (list '~'not (cons '~pred values#))}))
 328.435 +       result#)))
 328.436 +
 328.437 +(defn assert-any
 328.438 +  "Returns generic assertion code for any test, including macros, Java
 328.439 +  method calls, or isolated symbols."
 328.440 +  {:added "1.1"}
 328.441 +  [msg form]
 328.442 +  `(let [value# ~form]
 328.443 +     (if value#
 328.444 +       (do-report {:type :pass, :message ~msg,
 328.445 +                :expected '~form, :actual value#})
 328.446 +       (do-report {:type :fail, :message ~msg,
 328.447 +                :expected '~form, :actual value#}))
 328.448 +     value#))
 328.449 +
 328.450 +
 328.451 +
 328.452 +;;; ASSERTION METHODS
 328.453 +
 328.454 +;; You don't call these, but you can add methods to extend the 'is'
 328.455 +;; macro.  These define different kinds of tests, based on the first
 328.456 +;; symbol in the test expression.
 328.457 +
 328.458 +(defmulti assert-expr 
 328.459 +  (fn [msg form]
 328.460 +    (cond
 328.461 +      (nil? form) :always-fail
 328.462 +      (seq? form) (first form)
 328.463 +      :else :default)))
 328.464 +
 328.465 +(defmethod assert-expr :always-fail [msg form]
 328.466 +  ;; nil test: always fail
 328.467 +  `(do-report {:type :fail, :message ~msg}))
 328.468 +
 328.469 +(defmethod assert-expr :default [msg form]
 328.470 +  (if (and (sequential? form) (function? (first form)))
 328.471 +    (assert-predicate msg form)
 328.472 +    (assert-any msg form)))
 328.473 +
 328.474 +(defmethod assert-expr 'instance? [msg form]
 328.475 +  ;; Test if x is an instance of y.
 328.476 +  `(let [klass# ~(nth form 1)
 328.477 +         object# ~(nth form 2)]
 328.478 +     (let [result# (instance? klass# object#)]
 328.479 +       (if result#
 328.480 +         (do-report {:type :pass, :message ~msg,
 328.481 +                  :expected '~form, :actual (class object#)})
 328.482 +         (do-report {:type :fail, :message ~msg,
 328.483 +                  :expected '~form, :actual (class object#)}))
 328.484 +       result#)))
 328.485 +
 328.486 +(defmethod assert-expr 'thrown? [msg form]
 328.487 +  ;; (is (thrown? c expr))
 328.488 +  ;; Asserts that evaluating expr throws an exception of class c.
 328.489 +  ;; Returns the exception thrown.
 328.490 +  (let [klass (second form)
 328.491 +        body (nthnext form 2)]
 328.492 +    `(try ~@body
 328.493 +          (do-report {:type :fail, :message ~msg,
 328.494 +                   :expected '~form, :actual nil})
 328.495 +          (catch ~klass e#
 328.496 +            (do-report {:type :pass, :message ~msg,
 328.497 +                     :expected '~form, :actual e#})
 328.498 +            e#))))
 328.499 +
 328.500 +(defmethod assert-expr 'thrown-with-msg? [msg form]
 328.501 +  ;; (is (thrown-with-msg? c re expr))
 328.502 +  ;; Asserts that evaluating expr throws an exception of class c.
 328.503 +  ;; Also asserts that the message string of the exception matches
 328.504 +  ;; (with re-find) the regular expression re.
 328.505 +  (let [klass (nth form 1)
 328.506 +        re (nth form 2)
 328.507 +        body (nthnext form 3)]
 328.508 +    `(try ~@body
 328.509 +          (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil})
 328.510 +          (catch ~klass e#
 328.511 +            (let [m# (.getMessage e#)]
 328.512 +              (if (re-find ~re m#)
 328.513 +                (do-report {:type :pass, :message ~msg,
 328.514 +                         :expected '~form, :actual e#})
 328.515 +                (do-report {:type :fail, :message ~msg,
 328.516 +                         :expected '~form, :actual e#})))
 328.517 +            e#))))
 328.518 +
 328.519 +
 328.520 +(defmacro try-expr
 328.521 +  "Used by the 'is' macro to catch unexpected exceptions.
 328.522 +  You don't call this."
 328.523 +  {:added "1.1"}
 328.524 +  [msg form]
 328.525 +  `(try ~(assert-expr msg form)
 328.526 +        (catch Throwable t#
 328.527 +          (do-report {:type :error, :message ~msg,
 328.528 +                      :expected '~form, :actual t#}))))
 328.529 +
 328.530 +
 328.531 +
 328.532 +;;; ASSERTION MACROS
 328.533 +
 328.534 +;; You use these in your tests.
 328.535 +
 328.536 +(defmacro is
 328.537 +  "Generic assertion macro.  'form' is any predicate test.
 328.538 +  'msg' is an optional message to attach to the assertion.
 328.539 +  
 328.540 +  Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\")
 328.541 +
 328.542 +  Special forms:
 328.543 +
 328.544 +  (is (thrown? c body)) checks that an instance of c is thrown from
 328.545 +  body, fails if not; then returns the thing thrown.
 328.546 +
 328.547 +  (is (thrown-with-msg? c re body)) checks that an instance of c is
 328.548 +  thrown AND that the message on the exception matches (with
 328.549 +  re-find) the regular expression re."
 328.550 +  {:added "1.1"} 
 328.551 +  ([form] `(is ~form nil))
 328.552 +  ([form msg] `(try-expr ~msg ~form)))
 328.553 +
 328.554 +(defmacro are
 328.555 +  "Checks multiple assertions with a template expression.
 328.556 +  See clojure.template/do-template for an explanation of
 328.557 +  templates.
 328.558 +
 328.559 +  Example: (are [x y] (= x y)  
 328.560 +                2 (+ 1 1)
 328.561 +                4 (* 2 2))
 328.562 +  Expands to: 
 328.563 +           (do (is (= 2 (+ 1 1)))
 328.564 +               (is (= 4 (* 2 2))))
 328.565 +
 328.566 +  Note: This breaks some reporting features, such as line numbers."
 328.567 +  {:added "1.1"}
 328.568 +  [argv expr & args]
 328.569 +  `(temp/do-template ~argv (is ~expr) ~@args))
 328.570 +
 328.571 +(defmacro testing
 328.572 +  "Adds a new string to the list of testing contexts.  May be nested,
 328.573 +  but must occur inside a test function (deftest)."
 328.574 +  {:added "1.1"}
 328.575 +  [string & body]
 328.576 +  `(binding [*testing-contexts* (conj *testing-contexts* ~string)]
 328.577 +     ~@body))
 328.578 +
 328.579 +
 328.580 +
 328.581 +;;; DEFINING TESTS
 328.582 +
 328.583 +(defmacro with-test
 328.584 +  "Takes any definition form (that returns a Var) as the first argument.
 328.585 +  Remaining body goes in the :test metadata function for that Var.
 328.586 +
 328.587 +  When *load-tests* is false, only evaluates the definition, ignoring
 328.588 +  the tests."
 328.589 +  {:added "1.1"}
 328.590 +  [definition & body]
 328.591 +  (if *load-tests*
 328.592 +    `(doto ~definition (alter-meta! assoc :test (fn [] ~@body)))
 328.593 +    definition))
 328.594 +
 328.595 +
 328.596 +(defmacro deftest
 328.597 +  "Defines a test function with no arguments.  Test functions may call
 328.598 +  other tests, so tests may be composed.  If you compose tests, you
 328.599 +  should also define a function named test-ns-hook; run-tests will
 328.600 +  call test-ns-hook instead of testing all vars.
 328.601 +
 328.602 +  Note: Actually, the test body goes in the :test metadata on the var,
 328.603 +  and the real function (the value of the var) calls test-var on
 328.604 +  itself.
 328.605 +
 328.606 +  When *load-tests* is false, deftest is ignored."
 328.607 +  {:added "1.1"}
 328.608 +  [name & body]
 328.609 +  (when *load-tests*
 328.610 +    `(def ~(vary-meta name assoc :test `(fn [] ~@body))
 328.611 +          (fn [] (test-var (var ~name))))))
 328.612 +
 328.613 +(defmacro deftest-
 328.614 +  "Like deftest but creates a private var."
 328.615 +  {:added "1.1"}
 328.616 +  [name & body]
 328.617 +  (when *load-tests*
 328.618 +    `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true)
 328.619 +          (fn [] (test-var (var ~name))))))
 328.620 +
 328.621 +
 328.622 +(defmacro set-test
 328.623 +  "Experimental.
 328.624 +  Sets :test metadata of the named var to a fn with the given body.
 328.625 +  The var must already exist.  Does not modify the value of the var.
 328.626 +
 328.627 +  When *load-tests* is false, set-test is ignored."
 328.628 +  {:added "1.1"}
 328.629 +  [name & body]
 328.630 +  (when *load-tests*
 328.631 +    `(alter-meta! (var ~name) assoc :test (fn [] ~@body))))
 328.632 +
 328.633 +
 328.634 +
 328.635 +;;; DEFINING FIXTURES
 328.636 +
 328.637 +(defn- add-ns-meta
 328.638 +  "Adds elements in coll to the current namespace metadata as the
 328.639 +  value of key."
 328.640 +  {:added "1.1"}
 328.641 +  [key coll]
 328.642 +  (alter-meta! *ns* assoc key coll))
 328.643 +
 328.644 +(defmulti use-fixtures
 328.645 +  "Wrap test runs in a fixture function to perform setup and
 328.646 +  teardown. Using a fixture-type of :each wraps every test
 328.647 +  individually, while:once wraps the whole run in a single function."
 328.648 +  {:added "1.1"}
 328.649 +  (fn [fixture-type & args] fixture-type))
 328.650 +
 328.651 +(defmethod use-fixtures :each [fixture-type & args]
 328.652 +  (add-ns-meta ::each-fixtures args))
 328.653 +
 328.654 +(defmethod use-fixtures :once [fixture-type & args]
 328.655 +  (add-ns-meta ::once-fixtures args))
 328.656 +
 328.657 +(defn- default-fixture
 328.658 +  "The default, empty, fixture function.  Just calls its argument."
 328.659 +  {:added "1.1"}
 328.660 +  [f]
 328.661 +  (f))
 328.662 +
 328.663 +(defn compose-fixtures
 328.664 +  "Composes two fixture functions, creating a new fixture function
 328.665 +  that combines their behavior."
 328.666 +  {:added "1.1"}
 328.667 +  [f1 f2]
 328.668 +  (fn [g] (f1 (fn [] (f2 g)))))
 328.669 +
 328.670 +(defn join-fixtures
 328.671 +  "Composes a collection of fixtures, in order.  Always returns a valid
 328.672 +  fixture function, even if the collection is empty."
 328.673 +  {:added "1.1"}
 328.674 +  [fixtures]
 328.675 +  (reduce compose-fixtures default-fixture fixtures))
 328.676 +
 328.677 +
 328.678 +
 328.679 +
 328.680 +;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS
 328.681 +
 328.682 +(defn test-var
 328.683 +  "If v has a function in its :test metadata, calls that function,
 328.684 +  with *testing-vars* bound to (conj *testing-vars* v)."
 328.685 +  {:dynamic true, :added "1.1"}
 328.686 +  [v]
 328.687 +  (when-let [t (:test (meta v))]
 328.688 +    (binding [*testing-vars* (conj *testing-vars* v)]
 328.689 +      (do-report {:type :begin-test-var, :var v})
 328.690 +      (inc-report-counter :test)
 328.691 +      (try (t)
 328.692 +           (catch Throwable e
 328.693 +             (do-report {:type :error, :message "Uncaught exception, not in assertion."
 328.694 +                      :expected nil, :actual e})))
 328.695 +      (do-report {:type :end-test-var, :var v}))))
 328.696 +
 328.697 +(defn test-all-vars
 328.698 +  "Calls test-var on every var interned in the namespace, with fixtures."
 328.699 +  {:added "1.1"}
 328.700 +  [ns]
 328.701 +  (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns)))
 328.702 +        each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))]
 328.703 +    (once-fixture-fn
 328.704 +     (fn []
 328.705 +       (doseq [v (vals (ns-interns ns))]
 328.706 +         (when (:test (meta v))
 328.707 +           (each-fixture-fn (fn [] (test-var v)))))))))
 328.708 +
 328.709 +(defn test-ns
 328.710 +  "If the namespace defines a function named test-ns-hook, calls that.
 328.711 +  Otherwise, calls test-all-vars on the namespace.  'ns' is a
 328.712 +  namespace object or a symbol.
 328.713 +
 328.714 +  Internally binds *report-counters* to a ref initialized to
 328.715 +  *inital-report-counters*.  Returns the final, dereferenced state of
 328.716 +  *report-counters*."
 328.717 +  {:added "1.1"}
 328.718 +  [ns]
 328.719 +  (binding [*report-counters* (ref *initial-report-counters*)]
 328.720 +    (let [ns-obj (the-ns ns)]
 328.721 +      (do-report {:type :begin-test-ns, :ns ns-obj})
 328.722 +      ;; If the namespace has a test-ns-hook function, call that:
 328.723 +      (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))]
 328.724 +	((var-get v))
 328.725 +        ;; Otherwise, just test every var in the namespace.
 328.726 +        (test-all-vars ns-obj))
 328.727 +      (do-report {:type :end-test-ns, :ns ns-obj}))
 328.728 +    @*report-counters*))
 328.729 +
 328.730 +
 328.731 +
 328.732 +;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS
 328.733 +
 328.734 +(defn run-tests
 328.735 +  "Runs all tests in the given namespaces; prints results.
 328.736 +  Defaults to current namespace if none given.  Returns a map
 328.737 +  summarizing test results."
 328.738 +  {:added "1.1"}
 328.739 +  ([] (run-tests *ns*))
 328.740 +  ([& namespaces]
 328.741 +     (let [summary (assoc (apply merge-with + (map test-ns namespaces))
 328.742 +                     :type :summary)]
 328.743 +       (do-report summary)
 328.744 +       summary)))
 328.745 +
 328.746 +(defn run-all-tests
 328.747 +  "Runs all tests in all namespaces; prints results.
 328.748 +  Optional argument is a regular expression; only namespaces with
 328.749 +  names matching the regular expression (with re-matches) will be
 328.750 +  tested."
 328.751 +  {:added "1.1"}
 328.752 +  ([] (apply run-tests (all-ns)))
 328.753 +  ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns)))))
 328.754 +
 328.755 +(defn successful?
 328.756 +  "Returns true if the given test summary indicates all tests
 328.757 +  were successful, false otherwise."
 328.758 +  {:added "1.1"}
 328.759 +  [summary]
 328.760 +  (and (zero? (:fail summary 0))
 328.761 +       (zero? (:error summary 0))))
   329.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   329.2 +++ b/src/clojure/test/junit.clj	Sat Aug 21 06:25:44 2010 -0400
   329.3 @@ -0,0 +1,194 @@
   329.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   329.5 +;   The use and distribution terms for this software are covered by the
   329.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   329.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   329.8 +;   By using this software in any fashion, you are agreeing to be bound by
   329.9 +;   the terms of this license.
  329.10 +;   You must not remove this notice, or any other, from this software.
  329.11 +
  329.12 +;; test/junit.clj: Extension to clojure.test for JUnit-compatible XML output
  329.13 +
  329.14 +;; by Jason Sankey
  329.15 +;; June 2009
  329.16 +
  329.17 +;; DOCUMENTATION
  329.18 +;;
  329.19 +
  329.20 +(ns ^{:doc "clojure.test extension for JUnit-compatible XML output.
  329.21 +
  329.22 +  JUnit (http://junit.org/) is the most popular unit-testing library
  329.23 +  for Java.  As such, tool support for JUnit output formats is
  329.24 +  common.  By producing compatible output from tests, this tool
  329.25 +  support can be exploited.
  329.26 +
  329.27 +  To use, wrap any calls to clojure.test/run-tests in the
  329.28 +  with-junit-output macro, like this:
  329.29 +
  329.30 +    (use 'clojure.test)
  329.31 +    (use 'clojure.test.junit)
  329.32 +
  329.33 +    (with-junit-output
  329.34 +      (run-tests 'my.cool.library))
  329.35 +
  329.36 +  To write the output to a file, rebind clojure.test/*test-out* to
  329.37 +  your own PrintWriter (perhaps opened using
  329.38 +  clojure.java.io/writer)."
  329.39 +  :author "Jason Sankey"}
  329.40 +  clojure.test.junit
  329.41 +  (:require [clojure.stacktrace :as stack]
  329.42 +            [clojure.test :as t]))
  329.43 +
  329.44 +;; copied from clojure.contrib.lazy-xml
  329.45 +(def ^{:private true}
  329.46 +     escape-xml-map
  329.47 +     (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp])))
  329.48 +(defn- escape-xml [text]
  329.49 +  (apply str (map #(escape-xml-map % %) text)))
  329.50 +
  329.51 +(def *var-context*)
  329.52 +(def *depth*)
  329.53 +
  329.54 +(defn indent
  329.55 +  []
  329.56 +  (dotimes [n (* *depth* 4)] (print " ")))
  329.57 +
  329.58 +(defn start-element
  329.59 +  [tag pretty & [attrs]]
  329.60 +  (if pretty (indent))
  329.61 +  (print (str "<" tag))
  329.62 +  (if (seq attrs)
  329.63 +    (doseq [[key value] attrs]
  329.64 +      (print (str " " (name key) "=\"" (escape-xml value) "\""))))
  329.65 +  (print ">")
  329.66 +  (if pretty (println))
  329.67 +  (set! *depth* (inc *depth*)))
  329.68 +
  329.69 +(defn element-content
  329.70 +  [content]
  329.71 +  (print (escape-xml content)))
  329.72 +
  329.73 +(defn finish-element
  329.74 +  [tag pretty]
  329.75 +  (set! *depth* (dec *depth*))
  329.76 +  (if pretty (indent))
  329.77 +  (print (str "</" tag ">"))
  329.78 +  (if pretty (println)))
  329.79 +
  329.80 +(defn test-name
  329.81 +  [vars]
  329.82 +  (apply str (interpose "."
  329.83 +                        (reverse (map #(:name (meta %)) vars)))))
  329.84 +
  329.85 +(defn package-class
  329.86 +  [name]
  329.87 +  (let [i (.lastIndexOf name ".")]
  329.88 +    (if (< i 0)
  329.89 +      [nil name]
  329.90 +      [(.substring name 0 i) (.substring name (+ i 1))])))
  329.91 +
  329.92 +(defn start-case
  329.93 +  [name classname]
  329.94 +  (start-element 'testcase true {:name name :classname classname}))
  329.95 +
  329.96 +(defn finish-case
  329.97 +  []
  329.98 +  (finish-element 'testcase true))
  329.99 +
 329.100 +(defn suite-attrs
 329.101 +  [package classname]
 329.102 +  (let [attrs {:name classname}]
 329.103 +    (if package
 329.104 +      (assoc attrs :package package)
 329.105 +      attrs)))
 329.106 +
 329.107 +(defn start-suite
 329.108 +  [name]
 329.109 +  (let [[package classname] (package-class name)]
 329.110 +    (start-element 'testsuite true (suite-attrs package classname))))
 329.111 +
 329.112 +(defn finish-suite
 329.113 +  []
 329.114 +  (finish-element 'testsuite true))
 329.115 +
 329.116 +(defn message-el
 329.117 +  [tag message expected-str actual-str]
 329.118 +  (indent)
 329.119 +  (start-element tag false (if message {:message message} {}))
 329.120 +  (element-content
 329.121 +   (let [[file line] (t/file-position 5)
 329.122 +         detail (apply str (interpose
 329.123 +                            "\n"
 329.124 +                            [(str "expected: " expected-str)
 329.125 +                             (str "  actual: " actual-str)
 329.126 +                             (str "      at: " file ":" line)]))]
 329.127 +     (if message (str message "\n" detail) detail)))
 329.128 +  (finish-element tag false)
 329.129 +  (println))
 329.130 +
 329.131 +(defn failure-el
 329.132 +  [message expected actual]
 329.133 +  (message-el 'failure message (pr-str expected) (pr-str actual)))
 329.134 +
 329.135 +(defn error-el
 329.136 +  [message expected actual]
 329.137 +  (message-el 'error
 329.138 +              message
 329.139 +              (pr-str expected)
 329.140 +              (if (instance? Throwable actual)
 329.141 +                (with-out-str (stack/print-cause-trace actual t/*stack-trace-depth*))
 329.142 +                (prn actual))))
 329.143 +
 329.144 +;; This multimethod will override test-is/report
 329.145 +(defmulti junit-report :type)
 329.146 +
 329.147 +(defmethod junit-report :begin-test-ns [m]
 329.148 +  (t/with-test-out
 329.149 +   (start-suite (name (ns-name (:ns m))))))
 329.150 +
 329.151 +(defmethod junit-report :end-test-ns [_]
 329.152 +  (t/with-test-out
 329.153 +   (finish-suite)))
 329.154 +
 329.155 +(defmethod junit-report :begin-test-var [m]
 329.156 +  (t/with-test-out
 329.157 +   (let [var (:var m)]
 329.158 +     (binding [*var-context* (conj *var-context* var)]
 329.159 +       (start-case (test-name *var-context*) (name (ns-name (:ns (meta var)))))))))
 329.160 +
 329.161 +(defmethod junit-report :end-test-var [m]
 329.162 +  (t/with-test-out
 329.163 +   (finish-case)))
 329.164 +
 329.165 +(defmethod junit-report :pass [m]
 329.166 +  (t/with-test-out
 329.167 +   (t/inc-report-counter :pass)))
 329.168 +
 329.169 +(defmethod junit-report :fail [m]
 329.170 +  (t/with-test-out
 329.171 +   (t/inc-report-counter :fail)
 329.172 +   (failure-el (:message m)
 329.173 +               (:expected m)
 329.174 +               (:actual m))))
 329.175 +
 329.176 +(defmethod junit-report :error [m]
 329.177 +  (t/with-test-out
 329.178 +   (t/inc-report-counter :error)
 329.179 +   (error-el (:message m)
 329.180 +             (:expected m)
 329.181 +             (:actual m))))
 329.182 +
 329.183 +(defmethod junit-report :default [_])
 329.184 +
 329.185 +(defmacro with-junit-output
 329.186 +  "Execute body with modified test-is reporting functions that write
 329.187 +  JUnit-compatible XML output."
 329.188 +  {:added "1.1"}
 329.189 +  [& body]
 329.190 +  `(binding [t/report junit-report
 329.191 +             *var-context* (list)
 329.192 +             *depth* 1]
 329.193 +     (println "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")
 329.194 +     (println "<testsuites>")
 329.195 +     (let [result# ~@body]
 329.196 +       (println "</testsuites>")
 329.197 +       result#)))
   330.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   330.2 +++ b/src/clojure/test/tap.clj	Sat Aug 21 06:25:44 2010 -0400
   330.3 @@ -0,0 +1,116 @@
   330.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   330.5 +;   The use and distribution terms for this software are covered by the
   330.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   330.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   330.8 +;   By using this software in any fashion, you are agreeing to be bound by
   330.9 +;   the terms of this license.
  330.10 +;   You must not remove this notice, or any other, from this software.
  330.11 +
  330.12 +;;; test_is/tap.clj: Extension to test for TAP output
  330.13 +
  330.14 +;; by Stuart Sierra
  330.15 +;; March 31, 2009
  330.16 +
  330.17 +;; Inspired by ClojureCheck by Meikel Brandmeyer:
  330.18 +;; http://kotka.de/projects/clojure/clojurecheck.html
  330.19 +
  330.20 +
  330.21 +;; DOCUMENTATION
  330.22 +;;
  330.23 +
  330.24 +
  330.25 +
  330.26 +(ns ^{:doc "clojure.test extensions for the Test Anything Protocol (TAP)
  330.27 +
  330.28 +  TAP is a simple text-based syntax for reporting test results.  TAP
  330.29 +  was originally develped for Perl, and now has implementations in
  330.30 +  several languages.  For more information on TAP, see
  330.31 +  http://testanything.org/ and
  330.32 +  http://search.cpan.org/~petdance/TAP-1.0.0/TAP.pm
  330.33 +
  330.34 +  To use this library, wrap any calls to
  330.35 +  clojure.test/run-tests in the with-tap-output macro,
  330.36 +  like this:
  330.37 +
  330.38 +    (use 'clojure.test)
  330.39 +    (use 'clojure.test.tap)
  330.40 +
  330.41 +    (with-tap-output
  330.42 +     (run-tests 'my.cool.library))"
  330.43 +       :author "Stuart Sierra"}
  330.44 +  clojure.test.tap
  330.45 +  (:require [clojure.test :as t]
  330.46 +            [clojure.stacktrace :as stack]))
  330.47 +
  330.48 +(defn print-tap-plan
  330.49 +  "Prints a TAP plan line like '1..n'.  n is the number of tests"
  330.50 +  {:added "1.1"}
  330.51 +  [n]
  330.52 +  (println (str "1.." n)))
  330.53 +
  330.54 +(defn print-tap-diagnostic
  330.55 +  "Prints a TAP diagnostic line.  data is a (possibly multi-line)
  330.56 +  string."
  330.57 +  {:added "1.1"}
  330.58 +  [data]
  330.59 +  (doseq [line (.split ^String data "\n")]
  330.60 +    (println "#" line)))
  330.61 +
  330.62 +(defn print-tap-pass
  330.63 +  "Prints a TAP 'ok' line.  msg is a string, with no line breaks"
  330.64 +  {:added "1.1"}
  330.65 +  [msg]
  330.66 +  (println "ok" msg))
  330.67 +
  330.68 +(defn print-tap-fail 
  330.69 +  "Prints a TAP 'not ok' line.  msg is a string, with no line breaks"
  330.70 +  {:added "1.1"}
  330.71 +  [msg]
  330.72 +  (println "not ok" msg))
  330.73 +
  330.74 +;; This multimethod will override test/report
  330.75 +(defmulti tap-report (fn [data] (:type data)))
  330.76 +
  330.77 +(defmethod tap-report :default [data]
  330.78 +  (t/with-test-out
  330.79 +   (print-tap-diagnostic (pr-str data))))
  330.80 +
  330.81 +(defmethod tap-report :pass [data]
  330.82 +  (t/with-test-out
  330.83 +   (t/inc-report-counter :pass)
  330.84 +   (print-tap-pass (t/testing-vars-str))
  330.85 +   (when (seq t/*testing-contexts*)
  330.86 +     (print-tap-diagnostic (t/testing-contexts-str)))
  330.87 +   (when (:message data)
  330.88 +     (print-tap-diagnostic (:message data)))
  330.89 +   (print-tap-diagnostic (str "expected:" (pr-str (:expected data))))
  330.90 +   (print-tap-diagnostic (str "  actual:" (pr-str (:actual data))))))
  330.91 +
  330.92 +(defmethod tap-report :error [data]
  330.93 +  (t/with-test-out
  330.94 +   (t/inc-report-counter :error)
  330.95 +   (print-tap-fail (t/testing-vars-str))
  330.96 +   (when (seq t/*testing-contexts*)
  330.97 +     (print-tap-diagnostic (t/testing-contexts-str)))
  330.98 +   (when (:message data)
  330.99 +     (print-tap-diagnostic (:message data)))
 330.100 +   (print-tap-diagnostic "expected:" (pr-str (:expected data)))
 330.101 +   (print-tap-diagnostic "  actual: ")
 330.102 +   (print-tap-diagnostic
 330.103 +    (with-out-str
 330.104 +      (if (instance? Throwable (:actual data))
 330.105 +        (stack/print-cause-trace (:actual data) t/*stack-trace-depth*)
 330.106 +        (prn (:actual data)))))))
 330.107 +
 330.108 +(defmethod tap-report :summary [data]
 330.109 +  (t/with-test-out
 330.110 +   (print-tap-plan (+ (:pass data) (:fail data) (:error data)))))
 330.111 +
 330.112 +
 330.113 +(defmacro with-tap-output
 330.114 +  "Execute body with modified test reporting functions that produce
 330.115 +  TAP output"
 330.116 +  {:added "1.1"}
 330.117 +  [& body]
 330.118 +  `(binding [t/report tap-report]
 330.119 +     ~@body))
   331.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   331.2 +++ b/src/clojure/test_clojure.clj	Sat Aug 21 06:25:44 2010 -0400
   331.3 @@ -0,0 +1,99 @@
   331.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   331.5 +;   The use and distribution terms for this software are covered by the
   331.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   331.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   331.8 +;   By using this software in any fashion, you are agreeing to be bound by
   331.9 +;   the terms of this license.
  331.10 +;   You must not remove this notice, or any other, from this software.
  331.11 +;
  331.12 +
  331.13 +;;  clojure.test-clojure
  331.14 +;;
  331.15 +;;  Tests for the facilities provided by Clojure
  331.16 +;;
  331.17 +;;  scgilardi (gmail)
  331.18 +;;  Created 22 October 2008
  331.19 +
  331.20 +(ns clojure.test-clojure
  331.21 +  (:require [clojure.test :as t])
  331.22 +  (:gen-class))
  331.23 +
  331.24 +(def test-names
  331.25 +     [:reader
  331.26 +      :printer
  331.27 +      :compilation
  331.28 +      :evaluation
  331.29 +      :special
  331.30 +      :macros
  331.31 +      :metadata
  331.32 +      :ns-libs
  331.33 +      :logic
  331.34 +      :predicates
  331.35 +      :control
  331.36 +      :data-structures
  331.37 +      :numbers
  331.38 +      :sequences
  331.39 +      :for
  331.40 +      :multimethods
  331.41 +      :other-functions
  331.42 +      :vars
  331.43 +      :refs
  331.44 +      :agents
  331.45 +      :atoms
  331.46 +      :parallel
  331.47 +      :java-interop
  331.48 +      :test
  331.49 +      :test-fixtures
  331.50 +      ;; libraries
  331.51 +      :clojure-set
  331.52 +      :clojure-xml
  331.53 +      :clojure-zip
  331.54 +      :protocols
  331.55 +      :genclass
  331.56 +      :main
  331.57 +      :vectors
  331.58 +      :annotations
  331.59 +      :pprint
  331.60 +      :serialization
  331.61 +      :rt
  331.62 +      :repl
  331.63 +      :java.io
  331.64 +      :string
  331.65 +      :java.javadoc
  331.66 +      :java.shell
  331.67 +      :transients
  331.68 +      :def
  331.69 +      ])
  331.70 +
  331.71 +(def test-namespaces
  331.72 +     (map #(symbol (str "clojure.test-clojure." (name %)))
  331.73 +          test-names))
  331.74 +
  331.75 +(defn run
  331.76 +  "Runs all defined tests"
  331.77 +  []
  331.78 +  (println "Loading tests...")
  331.79 +  (apply require :reload-all test-namespaces)
  331.80 +  (apply t/run-tests test-namespaces))
  331.81 +
  331.82 +(defn run-ant
  331.83 +  "Runs all defined tests, prints report to *err*, throw if failures. This works well for running in an ant java task."
  331.84 +  []
  331.85 +  (let [rpt t/report]
  331.86 +    (binding [;; binding to *err* because, in ant, when the test target
  331.87 +              ;; runs after compile-clojure, *out* doesn't print anything
  331.88 +              *out* *err*
  331.89 +              t/*test-out* *err*
  331.90 +              t/report (fn report [m]
  331.91 +                         (if (= :summary (:type m))
  331.92 +                           (do (rpt m)
  331.93 +                               (if (or (pos? (:fail m)) (pos? (:error m)))
  331.94 +                                 (throw (new Exception (str (:fail m) " failures, " (:error m) " errors.")))))
  331.95 +                           (rpt m)))]
  331.96 +      (run))))
  331.97 +
  331.98 +(defn -main
  331.99 +  "Run all defined tests from the command line"
 331.100 +  [& args]
 331.101 +  (run)
 331.102 +  (System/exit 0))
   332.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   332.2 +++ b/src/clojure/test_clojure/agents.clj	Sat Aug 21 06:25:44 2010 -0400
   332.3 @@ -0,0 +1,120 @@
   332.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   332.5 +;   The use and distribution terms for this software are covered by the
   332.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   332.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   332.8 +;   By using this software in any fashion, you are agreeing to be bound by
   332.9 +;   the terms of this license.
  332.10 +;   You must not remove this notice, or any other, from this software.
  332.11 +
  332.12 +;; Author: Shawn Hoover
  332.13 +
  332.14 +(ns clojure.test-clojure.agents
  332.15 +  (:use clojure.test))
  332.16 +
  332.17 +(deftest handle-all-throwables-during-agent-actions
  332.18 +  ;; Bug fixed in r1198; previously hung Clojure or didn't report agent errors
  332.19 +  ;; after OutOfMemoryError, yet wouldn't execute new actions.
  332.20 +  (let [agt (agent nil)]
  332.21 +    (send agt (fn [state] (throw (Throwable. "just testing Throwables"))))
  332.22 +    (try
  332.23 +     ;; Let the action finish; eat the "agent has errors" error that bubbles up
  332.24 +     (await-for 100 agt)
  332.25 +     (catch RuntimeException _))
  332.26 +    (is (instance? Throwable (first (agent-errors agt))))
  332.27 +    (is (= 1 (count (agent-errors agt))))
  332.28 +
  332.29 +    ;; And now send an action that should work
  332.30 +    (clear-agent-errors agt)
  332.31 +    (is (= nil @agt))
  332.32 +    (send agt nil?)
  332.33 +    (is (true? (await-for 100 agt)))
  332.34 +    (is (true? @agt))))
  332.35 +
  332.36 +(deftest default-modes
  332.37 +  (is (= :fail (error-mode (agent nil))))
  332.38 +  (is (= :continue (error-mode (agent nil :error-handler println)))))
  332.39 +
  332.40 +(deftest continue-handler
  332.41 +  (let [err (atom nil)
  332.42 +        agt (agent 0 :error-mode :continue :error-handler #(reset! err %&))]
  332.43 +    (send agt /)
  332.44 +    (is (true? (await-for 100 agt)))
  332.45 +    (is (= 0 @agt))
  332.46 +    (is (nil? (agent-error agt)))
  332.47 +    (is (= agt (first @err)))
  332.48 +  (is (true? (instance? ArithmeticException (second @err))))))
  332.49 +
  332.50 +(deftest fail-handler
  332.51 +  (let [err (atom nil)
  332.52 +        agt (agent 0 :error-mode :fail :error-handler #(reset! err %&))]
  332.53 +    (send agt /)
  332.54 +    (Thread/sleep 100)
  332.55 +    (is (true? (instance? ArithmeticException (agent-error agt))))
  332.56 +    (is (= 0 @agt))
  332.57 +    (is (= agt (first @err)))
  332.58 +    (is (true? (instance? ArithmeticException (second @err))))
  332.59 +    (is (thrown? RuntimeException (send agt inc)))))
  332.60 +
  332.61 +(deftest restart-no-clear
  332.62 +  (let [p (promise)
  332.63 +        agt (agent 1 :error-mode :fail)]
  332.64 +    (send agt (fn [v] @p))
  332.65 +    (send agt /)
  332.66 +    (send agt inc)
  332.67 +    (send agt inc)
  332.68 +    (deliver p 0)
  332.69 +    (Thread/sleep 100)
  332.70 +    (is (= 0 @agt))
  332.71 +    (is (= ArithmeticException (class (agent-error agt))))
  332.72 +    (restart-agent agt 10)
  332.73 +    (is (true? (await-for 100 agt)))
  332.74 +    (is (= 12 @agt))
  332.75 +    (is (nil? (agent-error agt)))))
  332.76 +
  332.77 +(deftest restart-clear
  332.78 +  (let [p (promise)
  332.79 +        agt (agent 1 :error-mode :fail)]
  332.80 +    (send agt (fn [v] @p))
  332.81 +    (send agt /)
  332.82 +    (send agt inc)
  332.83 +    (send agt inc)
  332.84 +    (deliver p 0)
  332.85 +    (Thread/sleep 100)
  332.86 +    (is (= 0 @agt))
  332.87 +    (is (= ArithmeticException (class (agent-error agt))))
  332.88 +    (restart-agent agt 10 :clear-actions true)
  332.89 +    (is (true? (await-for 100 agt)))
  332.90 +    (is (= 10 @agt))
  332.91 +    (is (nil? (agent-error agt)))
  332.92 +    (send agt inc)
  332.93 +    (is (true? (await-for 100 agt)))
  332.94 +    (is (= 11 @agt))
  332.95 +    (is (nil? (agent-error agt)))))
  332.96 +
  332.97 +(deftest invalid-restart
  332.98 +  (let [p (promise)
  332.99 +        agt (agent 2 :error-mode :fail :validator even?)]
 332.100 +    (is (thrown? RuntimeException (restart-agent agt 4)))
 332.101 +    (send agt (fn [v] @p))
 332.102 +    (send agt (partial + 2))
 332.103 +    (send agt (partial + 2))
 332.104 +    (deliver p 3)
 332.105 +    (Thread/sleep 100)
 332.106 +    (is (= 2 @agt))
 332.107 +    (is (= IllegalStateException (class (agent-error agt))))
 332.108 +    (is (thrown? RuntimeException (restart-agent agt 5)))
 332.109 +    (restart-agent agt 6)
 332.110 +    (is (true? (await-for 100 agt)))
 332.111 +    (is (= 10 @agt))
 332.112 +    (is (nil? (agent-error agt)))))
 332.113 +
 332.114 +; http://clojure.org/agents
 332.115 +
 332.116 +; agent
 332.117 +; deref, @-reader-macro, agent-errors
 332.118 +; send send-off clear-agent-errors
 332.119 +; await await-for
 332.120 +; set-validator get-validator
 332.121 +; add-watch remove-watch
 332.122 +; shutdown-agents
 332.123 +
   333.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   333.2 +++ b/src/clojure/test_clojure/annotations.clj	Sat Aug 21 06:25:44 2010 -0400
   333.3 @@ -0,0 +1,29 @@
   333.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   333.5 +;   The use and distribution terms for this software are covered by the
   333.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   333.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   333.8 +;   By using this software in any fashion, you are agreeing to be bound by
   333.9 +;   the terms of this license.
  333.10 +;   You must not remove this notice, or any other, from this software.
  333.11 +
  333.12 +;; Authors: Stuart Halloway, Rich Hickey
  333.13 +
  333.14 +(ns clojure.test-clojure.annotations
  333.15 +  (:use clojure.test))
  333.16 +
  333.17 +(defn vm-has-ws-annotations?
  333.18 +  "Does the vm have the ws annotations we use to test some
  333.19 +   annotation features. If not, fall back to Java 5 tests."
  333.20 +  []
  333.21 +  (try
  333.22 +   (doseq [n ["javax.xml.ws.soap.Addressing"
  333.23 +              "javax.xml.ws.WebServiceRef"
  333.24 +              "javax.xml.ws.WebServiceRefs"]]
  333.25 +     (Class/forName n))
  333.26 +   true
  333.27 +   (catch ClassNotFoundException e
  333.28 +     false)))
  333.29 +
  333.30 +(if (vm-has-ws-annotations?)
  333.31 +  (load "annotations/java_6_and_later")
  333.32 +  (load "annotations/java_5"))
   334.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   334.2 +++ b/src/clojure/test_clojure/annotations/java_5.clj	Sat Aug 21 06:25:44 2010 -0400
   334.3 @@ -0,0 +1,54 @@
   334.4 +;; java 5 annotation tests
   334.5 +(in-ns 'clojure.test-clojure.annotations)
   334.6 +
   334.7 +(import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType])
   334.8 +(definterface Foo (foo []))
   334.9 +
  334.10 +(deftype #^{Deprecated true
  334.11 +            Retention RetentionPolicy/RUNTIME}
  334.12 +  Bar [#^int a
  334.13 +       #^{:tag int
  334.14 +          Deprecated true
  334.15 +          Retention RetentionPolicy/RUNTIME} b]
  334.16 +  Foo (#^{Deprecated true
  334.17 +          Retention RetentionPolicy/RUNTIME}
  334.18 +       foo [this] 42))
  334.19 +
  334.20 +(defn annotation->map
  334.21 +  "Converts a Java annotation (which conceals data)
  334.22 +   into a map (which makes is usable). Not lazy.
  334.23 +   Works recursively. Returns non-annotations unscathed."
  334.24 +  [#^java.lang.annotation.Annotation o]
  334.25 +  (cond
  334.26 +   (instance? Annotation o)
  334.27 +   (let [type (.annotationType o)
  334.28 +         itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation))
  334.29 +         data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))]
  334.30 +     (into
  334.31 +      {:annotationType (.annotationType o)}
  334.32 +      (map
  334.33 +       (fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))])
  334.34 +       data-methods)))
  334.35 +   (or (sequential? o) (.isArray (class o)))
  334.36 +   (map annotation->map o)
  334.37 +     :else o))
  334.38 +
  334.39 +(def expected-annotations
  334.40 +  #{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME}
  334.41 +    {:annotationType java.lang.Deprecated}})
  334.42 +
  334.43 +(deftest test-annotations-on-type
  334.44 +  (is (=
  334.45 +       expected-annotations
  334.46 +       (into #{} (map annotation->map (.getAnnotations Bar))))))
  334.47 +
  334.48 +(deftest test-annotations-on-field
  334.49 +  (is (=
  334.50 +       expected-annotations
  334.51 +       (into #{} (map annotation->map (.getAnnotations (.getField Bar "b")))))))
  334.52 +
  334.53 +(deftest test-annotations-on-method
  334.54 +  (is (=
  334.55 +       expected-annotations
  334.56 +       (into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil)))))))
  334.57 +
   335.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   335.2 +++ b/src/clojure/test_clojure/annotations/java_6_and_later.clj	Sat Aug 21 06:25:44 2010 -0400
   335.3 @@ -0,0 +1,73 @@
   335.4 +;; java 6 annotation tests
   335.5 +(in-ns 'clojure.test-clojure.annotations)
   335.6 +
   335.7 +(import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType]
   335.8 +        [javax.xml.ws WebServiceRef WebServiceRefs])
   335.9 +(definterface Foo (foo []))
  335.10 +
  335.11 +(deftype #^{Deprecated true
  335.12 +            Retention RetentionPolicy/RUNTIME
  335.13 +            javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"]
  335.14 +            javax.xml.ws.soap.Addressing {:enabled false :required true}
  335.15 +            WebServiceRefs [(WebServiceRef {:name "fred" :type String})
  335.16 +                            (WebServiceRef {:name "ethel" :mappedName "lucy"})]}
  335.17 +  Bar [#^int a
  335.18 +       #^{:tag int
  335.19 +          Deprecated true
  335.20 +          Retention RetentionPolicy/RUNTIME
  335.21 +          javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"]
  335.22 +            javax.xml.ws.soap.Addressing {:enabled false :required true}
  335.23 +          WebServiceRefs [(WebServiceRef {:name "fred" :type String})
  335.24 +                            (WebServiceRef {:name "ethel" :mappedName "lucy"})]}
  335.25 +       b]
  335.26 +  Foo (#^{Deprecated true
  335.27 +          Retention RetentionPolicy/RUNTIME
  335.28 +          javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"]
  335.29 +          javax.xml.ws.soap.Addressing {:enabled false :required true}
  335.30 +          WebServiceRefs [(WebServiceRef {:name "fred" :type String})
  335.31 +                          (WebServiceRef {:name "ethel" :mappedName "lucy"})]}
  335.32 +       foo [this] 42))
  335.33 +
  335.34 +(defn annotation->map
  335.35 +  "Converts a Java annotation (which conceals data)
  335.36 +   into a map (which makes is usable). Not lazy.
  335.37 +   Works recursively. Returns non-annotations unscathed."
  335.38 +  [#^java.lang.annotation.Annotation o]
  335.39 +  (cond
  335.40 +   (instance? Annotation o)
  335.41 +   (let [type (.annotationType o)
  335.42 +         itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation))
  335.43 +         data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))]
  335.44 +     (into
  335.45 +      {:annotationType (.annotationType o)}
  335.46 +      (map
  335.47 +       (fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))])
  335.48 +       data-methods)))
  335.49 +   (or (sequential? o) (.isArray (class o)))
  335.50 +   (map annotation->map o)
  335.51 +     :else o))
  335.52 +
  335.53 +(def expected-annotations
  335.54 +  #{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME}
  335.55 +    {:annotationType javax.xml.ws.WebServiceRefs,
  335.56 +     :value [{:annotationType javax.xml.ws.WebServiceRef, :name "fred", :mappedName "", :type java.lang.String, :wsdlLocation "", :value java.lang.Object}
  335.57 +             {:annotationType javax.xml.ws.WebServiceRef, :name "ethel", :mappedName "lucy", :type java.lang.Object, :wsdlLocation "", :value java.lang.Object}]}
  335.58 +    {:annotationType javax.xml.ws.soap.Addressing, :enabled false, :required true}
  335.59 +    {:annotationType javax.annotation.processing.SupportedOptions, :value ["foo" "bar" "baz"]}
  335.60 +    {:annotationType java.lang.Deprecated}})
  335.61 +
  335.62 +(deftest test-annotations-on-type
  335.63 +  (is (=
  335.64 +       expected-annotations
  335.65 +       (into #{} (map annotation->map (.getAnnotations Bar))))))
  335.66 +
  335.67 +(deftest test-annotations-on-field
  335.68 +  (is (=
  335.69 +       expected-annotations
  335.70 +       (into #{} (map annotation->map (.getAnnotations (.getField Bar "b")))))))
  335.71 +
  335.72 +(deftest test-annotations-on-method
  335.73 +  (is (=
  335.74 +       expected-annotations
  335.75 +       (into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil)))))))
  335.76 +
   336.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   336.2 +++ b/src/clojure/test_clojure/atoms.clj	Sat Aug 21 06:25:44 2010 -0400
   336.3 @@ -0,0 +1,20 @@
   336.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   336.5 +;   The use and distribution terms for this software are covered by the
   336.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   336.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   336.8 +;   By using this software in any fashion, you are agreeing to be bound by
   336.9 +;   the terms of this license.
  336.10 +;   You must not remove this notice, or any other, from this software.
  336.11 +
  336.12 +;;Author: Frantisek Sodomka
  336.13 +
  336.14 +(ns clojure.test-clojure.atoms
  336.15 +  (:use clojure.test))
  336.16 +
  336.17 +; http://clojure.org/atoms
  336.18 +
  336.19 +; atom
  336.20 +; deref, @-reader-macro
  336.21 +; swap! reset!
  336.22 +; compare-and-set!
  336.23 +
   337.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   337.2 +++ b/src/clojure/test_clojure/clojure_set.clj	Sat Aug 21 06:25:44 2010 -0400
   337.3 @@ -0,0 +1,206 @@
   337.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   337.5 +;   The use and distribution terms for this software are covered by the
   337.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   337.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   337.8 +;   By using this software in any fashion, you are agreeing to be bound by
   337.9 +;   the terms of this license.
  337.10 +;   You must not remove this notice, or any other, from this software.
  337.11 +
  337.12 +;; Author: Frantisek Sodomka
  337.13 +
  337.14 +
  337.15 +(ns clojure.test-clojure.clojure-set
  337.16 +  (:use clojure.test)
  337.17 +  (:require [clojure.set :as set]))
  337.18 +
  337.19 +(deftest test-union
  337.20 +  (are [x y] (= x y)
  337.21 +      (set/union) #{}
  337.22 +
  337.23 +      ; identity
  337.24 +      (set/union #{}) #{}
  337.25 +      (set/union #{1}) #{1}
  337.26 +      (set/union #{1 2 3}) #{1 2 3}
  337.27 +
  337.28 +      ; 2 sets, at least one is empty
  337.29 +      (set/union #{} #{}) #{}
  337.30 +      (set/union #{} #{1}) #{1}
  337.31 +      (set/union #{} #{1 2 3}) #{1 2 3}
  337.32 +      (set/union #{1} #{}) #{1}
  337.33 +      (set/union #{1 2 3} #{}) #{1 2 3}
  337.34 +
  337.35 +      ; 2 sets
  337.36 +      (set/union #{1} #{2}) #{1 2}
  337.37 +      (set/union #{1} #{1 2}) #{1 2}
  337.38 +      (set/union #{2} #{1 2}) #{1 2}
  337.39 +      (set/union #{1 2} #{3}) #{1 2 3}
  337.40 +      (set/union #{1 2} #{2 3}) #{1 2 3}
  337.41 +
  337.42 +      ; 3 sets, some are empty
  337.43 +      (set/union #{} #{} #{}) #{}
  337.44 +      (set/union #{1} #{} #{}) #{1}
  337.45 +      (set/union #{} #{1} #{}) #{1}
  337.46 +      (set/union #{} #{} #{1}) #{1}
  337.47 +      (set/union #{1 2} #{2 3} #{}) #{1 2 3}
  337.48 +
  337.49 +      ; 3 sets
  337.50 +      (set/union #{1 2} #{3 4} #{5 6}) #{1 2 3 4 5 6}
  337.51 +      (set/union #{1 2} #{2 3} #{1 3 4}) #{1 2 3 4}
  337.52 +
  337.53 +      ; different data types
  337.54 +      (set/union #{1 2} #{:a :b} #{nil} #{false true} #{\c "abc"} #{[] [1 2]}
  337.55 +        #{{} {:a 1}} #{#{} #{1 2}})
  337.56 +          #{1 2 :a :b nil false true \c "abc" [] [1 2] {} {:a 1} #{} #{1 2}}
  337.57 +
  337.58 +      ; different types of sets
  337.59 +      (set/union (hash-set) (hash-set 1 2) (hash-set 2 3))
  337.60 +          (hash-set 1 2 3)
  337.61 +      (set/union (sorted-set) (sorted-set 1 2) (sorted-set 2 3))
  337.62 +          (sorted-set 1 2 3)
  337.63 +      (set/union (hash-set) (hash-set 1 2) (hash-set 2 3)
  337.64 +        (sorted-set) (sorted-set 4 5) (sorted-set 5 6))
  337.65 +          (hash-set 1 2 3 4 5 6)  ; also equals (sorted-set 1 2 3 4 5 6)
  337.66 +))
  337.67 +
  337.68 +(deftest test-intersection
  337.69 +  ; at least one argument is needed
  337.70 +  (is (thrown? IllegalArgumentException (set/intersection)))
  337.71 +  
  337.72 +  (are [x y] (= x y)
  337.73 +      ; identity
  337.74 +      (set/intersection #{}) #{}
  337.75 +      (set/intersection #{1}) #{1}
  337.76 +      (set/intersection #{1 2 3}) #{1 2 3}
  337.77 +      
  337.78 +      ; 2 sets, at least one is empty
  337.79 +      (set/intersection #{} #{}) #{}
  337.80 +      (set/intersection #{} #{1}) #{}
  337.81 +      (set/intersection #{} #{1 2 3}) #{}
  337.82 +      (set/intersection #{1} #{}) #{}
  337.83 +      (set/intersection #{1 2 3} #{}) #{}
  337.84 +
  337.85 +      ; 2 sets
  337.86 +      (set/intersection #{1 2} #{1 2}) #{1 2}
  337.87 +      (set/intersection #{1 2} #{3 4}) #{}
  337.88 +      (set/intersection #{1 2} #{1}) #{1}
  337.89 +      (set/intersection #{1 2} #{2}) #{2}
  337.90 +      (set/intersection #{1 2 4} #{2 3 4 5}) #{2 4}
  337.91 +
  337.92 +      ; 3 sets, some are empty
  337.93 +      (set/intersection #{} #{} #{}) #{}
  337.94 +      (set/intersection #{1} #{} #{}) #{}
  337.95 +      (set/intersection #{1} #{1} #{}) #{}
  337.96 +      (set/intersection #{1} #{} #{1}) #{}
  337.97 +      (set/intersection #{1 2} #{2 3} #{}) #{}
  337.98 +
  337.99 +      ; 3 sets
 337.100 +      (set/intersection #{1 2} #{2 3} #{5 2}) #{2}
 337.101 +      (set/intersection #{1 2 3} #{1 3 4} #{1 3}) #{1 3}
 337.102 +      (set/intersection #{1 2 3} #{3 4 5} #{8 2 3}) #{3}
 337.103 +
 337.104 +      ; different types of sets
 337.105 +      (set/intersection (hash-set 1 2) (hash-set 2 3)) #{2}
 337.106 +      (set/intersection (sorted-set 1 2) (sorted-set 2 3)) #{2}
 337.107 +      (set/intersection
 337.108 +        (hash-set 1 2) (hash-set 2 3)
 337.109 +        (sorted-set 1 2) (sorted-set 2 3)) #{2} ))
 337.110 +
 337.111 +(deftest test-difference
 337.112 +  (are [x y] (= x y)
 337.113 +      ; identity
 337.114 +      (set/difference #{}) #{}
 337.115 +      (set/difference #{1}) #{1}
 337.116 +      (set/difference #{1 2 3}) #{1 2 3}
 337.117 +
 337.118 +      ; 2 sets
 337.119 +      (set/difference #{1 2} #{1 2}) #{}
 337.120 +      (set/difference #{1 2} #{3 4}) #{1 2}
 337.121 +      (set/difference #{1 2} #{1}) #{2}
 337.122 +      (set/difference #{1 2} #{2}) #{1}
 337.123 +      (set/difference #{1 2 4} #{2 3 4 5}) #{1}
 337.124 +
 337.125 +       ; 3 sets
 337.126 +      (set/difference #{1 2} #{2 3} #{5 2}) #{1}
 337.127 +      (set/difference #{1 2 3} #{1 3 4} #{1 3}) #{2}
 337.128 +      (set/difference #{1 2 3} #{3 4 5} #{8 2 3}) #{1} ))
 337.129 +
 337.130 +(deftest test-select
 337.131 +  (are [x y] (= x y)
 337.132 +    (set/select integer? #{}) #{}
 337.133 +    (set/select integer? #{1 2}) #{1 2}
 337.134 +    (set/select integer? #{1 2 :a :b :c}) #{1 2}
 337.135 +    (set/select integer? #{:a :b :c}) #{}) )
 337.136 +
 337.137 +(def compositions
 337.138 +  #{{:name "Art of the Fugue" :composer "J. S. Bach"}
 337.139 +    {:name "Musical Offering" :composer "J. S. Bach"}
 337.140 +    {:name "Requiem" :composer "Giuseppe Verdi"}
 337.141 +    {:name "Requiem" :composer "W. A. Mozart"}})
 337.142 +
 337.143 +(deftest test-project
 337.144 +  (are [x y] (= x y)
 337.145 +    (set/project compositions [:name]) #{{:name "Art of the Fugue"}
 337.146 +                                         {:name "Requiem"}
 337.147 +                                         {:name "Musical Offering"}}
 337.148 +    (set/project compositions [:composer]) #{{:composer "W. A. Mozart"}
 337.149 +                                             {:composer "Giuseppe Verdi"}
 337.150 +                                             {:composer "J. S. Bach"}}
 337.151 +    (set/project compositions [:year]) #{{}}
 337.152 +    (set/project #{{}} [:name]) #{{}} ))
 337.153 +
 337.154 +(deftest test-rename
 337.155 +  (are [x y] (= x y)
 337.156 +    (set/rename compositions {:name :title}) #{{:title "Art of the Fugue" :composer "J. S. Bach"}
 337.157 +                                               {:title "Musical Offering" :composer "J. S. Bach"}
 337.158 +                                               {:title "Requiem" :composer "Giuseppe Verdi"}
 337.159 +                                               {:title "Requiem" :composer "W. A. Mozart"}}
 337.160 +    (set/rename compositions {:year :decade}) #{{:name "Art of the Fugue" :composer "J. S. Bach"}
 337.161 +                                                {:name "Musical Offering" :composer "J. S. Bach"}
 337.162 +                                                {:name "Requiem" :composer "Giuseppe Verdi"}
 337.163 +                                                {:name "Requiem" :composer "W. A. Mozart"}}
 337.164 +    (set/rename #{{}} {:year :decade}) #{{}}))
 337.165 +
 337.166 +(deftest test-rename-keys
 337.167 +  (are [x y] (= x y)
 337.168 +    (set/rename-keys {:a "one" :b "two"} {:a :z}) {:z "one" :b "two"}
 337.169 +    ))
 337.170 +
 337.171 +(deftest test-index
 337.172 +  (are [x y] (= x y)
 337.173 +    (set/index  #{{:c 2} {:b 1} {:a 1 :b 2}} [:b]) {{:b 2} #{{:a 1 :b 2}}, {:b 1} #{{:b 1}} {} #{{:c 2}}}
 337.174 +  ))
 337.175 +
 337.176 +(deftest test-join
 337.177 +  (are [x y] (= x y)
 337.178 +    (set/join compositions compositions) compositions
 337.179 +    (set/join compositions #{{:name "Art of the Fugue" :genre "Classical"}})
 337.180 +                           #{{:name "Art of the Fugue" :composer "J. S. Bach" :genre "Classical"}}
 337.181 +    ))
 337.182 +
 337.183 +(deftest test-map-invert
 337.184 +  (are [x y] (= x y)
 337.185 +       (set/map-invert {:a "one" :b "two"}) {"one" :a "two" :b}))
 337.186 +
 337.187 +(deftest test-subset?
 337.188 +  (are [sub super] (set/subset? sub super)
 337.189 +       #{} #{}
 337.190 +       #{} #{1}
 337.191 +       #{1} #{1}
 337.192 +       #{1 2} #{1 2}
 337.193 +       #{1 2} #{1 2 42})
 337.194 +  (are [notsub super] (not (set/subset? notsub super))
 337.195 +       #{1} #{}
 337.196 +       #{2} #{1}
 337.197 +       #{1 3} #{1}))
 337.198 +
 337.199 +(deftest test-superset?
 337.200 +  (are [super sub] (set/superset? super sub)
 337.201 +       #{} #{}
 337.202 +       #{1} #{}
 337.203 +       #{1} #{1}
 337.204 +       #{1 2} #{1 2}
 337.205 +       #{1 2 42} #{1 2})
 337.206 +  (are [notsuper sub] (not (set/superset? notsuper sub))
 337.207 +       #{} #{1}
 337.208 +       #{2} #{1}
 337.209 +       #{1} #{1 3}))
   338.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   338.2 +++ b/src/clojure/test_clojure/clojure_xml.clj	Sat Aug 21 06:25:44 2010 -0400
   338.3 @@ -0,0 +1,21 @@
   338.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   338.5 +;   The use and distribution terms for this software are covered by the
   338.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   338.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   338.8 +;   By using this software in any fashion, you are agreeing to be bound by
   338.9 +;   the terms of this license.
  338.10 +;   You must not remove this notice, or any other, from this software.
  338.11 +
  338.12 +;;Author: Frantisek Sodomka
  338.13 +
  338.14 +
  338.15 +(ns clojure.test-clojure.clojure-xml
  338.16 +  (:use clojure.test)
  338.17 +  (:require [clojure.xml :as xml]))
  338.18 +
  338.19 +
  338.20 +; parse
  338.21 +
  338.22 +; emit-element
  338.23 +; emit
  338.24 +
   339.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   339.2 +++ b/src/clojure/test_clojure/clojure_zip.clj	Sat Aug 21 06:25:44 2010 -0400
   339.3 @@ -0,0 +1,48 @@
   339.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   339.5 +;   The use and distribution terms for this software are covered by the
   339.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   339.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   339.8 +;   By using this software in any fashion, you are agreeing to be bound by
   339.9 +;   the terms of this license.
  339.10 +;   You must not remove this notice, or any other, from this software.
  339.11 +
  339.12 +; Author: Frantisek Sodomka
  339.13 +
  339.14 +
  339.15 +(ns clojure.test-clojure.clojure-zip
  339.16 +  (:use clojure.test)
  339.17 +  (:require [clojure.zip :as zip]))
  339.18 +
  339.19 +
  339.20 +; zipper
  339.21 +;
  339.22 +; seq-zip
  339.23 +; vector-zip
  339.24 +; xml-zip
  339.25 +;
  339.26 +; node
  339.27 +; branch?
  339.28 +; children
  339.29 +; make-node
  339.30 +; path
  339.31 +; lefts
  339.32 +; rights
  339.33 +; down
  339.34 +; up
  339.35 +; root
  339.36 +; right
  339.37 +; rightmost
  339.38 +; left
  339.39 +; leftmost
  339.40 +;
  339.41 +; insert-left
  339.42 +; insert-right
  339.43 +; replace
  339.44 +; edit
  339.45 +; insert-child
  339.46 +; append-child
  339.47 +; next
  339.48 +; prev
  339.49 +; end?
  339.50 +; remove
  339.51 +
   340.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   340.2 +++ b/src/clojure/test_clojure/compilation.clj	Sat Aug 21 06:25:44 2010 -0400
   340.3 @@ -0,0 +1,52 @@
   340.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   340.5 +;   The use and distribution terms for this software are covered by the
   340.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   340.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   340.8 +;   By using this software in any fashion, you are agreeing to be bound by
   340.9 +;   the terms of this license.
  340.10 +;   You must not remove this notice, or any other, from this software.
  340.11 +
  340.12 +; Author: Frantisek Sodomka
  340.13 +
  340.14 +
  340.15 +(ns clojure.test-clojure.compilation
  340.16 +  (:use clojure.test))
  340.17 +
  340.18 +; http://clojure.org/compilation
  340.19 +
  340.20 +; compile
  340.21 +; gen-class, gen-interface
  340.22 +
  340.23 +
  340.24 +(deftest test-compiler-metadata
  340.25 +  (let [m (meta #'when)]
  340.26 +    (are [x y]  (= x y)
  340.27 +        (list? (:arglists m)) true
  340.28 +        (> (count (:arglists m)) 0) true
  340.29 +
  340.30 +        (string? (:doc m)) true
  340.31 +        (> (.length (:doc m)) 0) true
  340.32 +        
  340.33 +        (string? (:file m)) true
  340.34 +        (> (.length (:file m)) 0) true
  340.35 +
  340.36 +        (integer? (:line m)) true
  340.37 +        (> (:line m) 0) true
  340.38 +
  340.39 +        (:macro m) true
  340.40 +        (:name m) 'when )))
  340.41 +
  340.42 +(deftest test-embedded-constants
  340.43 +  (testing "Embedded constants"
  340.44 +    (is (eval `(= Boolean/TYPE ~Boolean/TYPE)))
  340.45 +    (is (eval `(= Byte/TYPE ~Byte/TYPE)))
  340.46 +    (is (eval `(= Character/TYPE ~Character/TYPE)))
  340.47 +    (is (eval `(= Double/TYPE ~Double/TYPE)))
  340.48 +    (is (eval `(= Float/TYPE ~Float/TYPE)))
  340.49 +    (is (eval `(= Integer/TYPE ~Integer/TYPE)))
  340.50 +    (is (eval `(= Long/TYPE ~Long/TYPE)))
  340.51 +    (is (eval `(= Short/TYPE ~Short/TYPE)))))
  340.52 + 
  340.53 +(deftest test-compiler-resolution
  340.54 +  (testing "resolve nonexistent class create should return nil (assembla #262)"
  340.55 +    (is (nil? (resolve 'NonExistentClass.)))))
   341.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   341.2 +++ b/src/clojure/test_clojure/control.clj	Sat Aug 21 06:25:44 2010 -0400
   341.3 @@ -0,0 +1,333 @@
   341.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   341.5 +;   The use and distribution terms for this software are covered by the
   341.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   341.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   341.8 +;   By using this software in any fashion, you are agreeing to be bound by
   341.9 +;   the terms of this license.
  341.10 +;   You must not remove this notice, or any other, from this software.
  341.11 +
  341.12 +; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway
  341.13 +
  341.14 +;;
  341.15 +;;  Test "flow control" constructs.
  341.16 +;;
  341.17 +
  341.18 +(ns clojure.test-clojure.control
  341.19 +  (:use clojure.test
  341.20 +        [clojure.test-clojure.helpers :only (exception)]))
  341.21 +
  341.22 +;; *** Helper functions ***
  341.23 +
  341.24 +(defn maintains-identity [f]
  341.25 +  (are [x] (= (f x) x)
  341.26 +      nil
  341.27 +      false true
  341.28 +      0 42
  341.29 +      0.0 3.14
  341.30 +      2/3
  341.31 +      0M 1M
  341.32 +      \c
  341.33 +      "" "abc"
  341.34 +      'sym
  341.35 +      :kw
  341.36 +      () '(1 2)
  341.37 +      [] [1 2]
  341.38 +      {} {:a 1 :b 2}
  341.39 +      #{} #{1 2} ))
  341.40 +
  341.41 +
  341.42 +; http://clojure.org/special_forms
  341.43 +; http://clojure.org/macros
  341.44 +
  341.45 +(deftest test-do
  341.46 +  (are [x y] (= x y)
  341.47 +      ; no params => nil
  341.48 +      (do) nil
  341.49 +      
  341.50 +      ; return last
  341.51 +      (do 1) 1
  341.52 +      (do 1 2) 2
  341.53 +      (do 1 2 3 4 5) 5
  341.54 +      
  341.55 +      ; evaluate and return last
  341.56 +      (let [a (atom 0)]
  341.57 +        (do (reset! a (+ @a 1))   ; 1
  341.58 +            (reset! a (+ @a 1))   ; 2
  341.59 +            (reset! a (+ @a 1))   ; 3
  341.60 +            @a))  3 )
  341.61 +
  341.62 +  ; identity (= (do x) x)
  341.63 +  (maintains-identity (fn [_] (do _))) )
  341.64 +
  341.65 +
  341.66 +;; loop/recur
  341.67 +(deftest test-loop
  341.68 +  (are [x y] (= x y)
  341.69 +       1 (loop []
  341.70 +           1)
  341.71 +       3 (loop [a 1]
  341.72 +           (if (< a 3)
  341.73 +             (recur (inc a))
  341.74 +             a))
  341.75 +       [2 4 6] (loop [a []
  341.76 +                      b [1 2 3]]
  341.77 +                 (if (seq b)
  341.78 +                   (recur (conj a (* 2 (first b)))
  341.79 +                          (next b))
  341.80 +                   a))
  341.81 +       [6 4 2] (loop [a ()
  341.82 +                      b [1 2 3]]
  341.83 +                 (if (seq b)
  341.84 +                   (recur (conj a (* 2 (first b)))
  341.85 +                          (next b))
  341.86 +                   a))
  341.87 +       )
  341.88 +  )
  341.89 +
  341.90 +
  341.91 +;; throw, try
  341.92 +
  341.93 +; if: see logic.clj
  341.94 +
  341.95 +(deftest test-when
  341.96 +  (are [x y] (= x y)
  341.97 +       1 (when true 1)
  341.98 +       nil (when true)
  341.99 +       nil (when false)
 341.100 +       nil (when false (exception))
 341.101 +       ))
 341.102 +
 341.103 +(deftest test-when-not
 341.104 +  (are [x y] (= x y)
 341.105 +       1 (when-not false 1)
 341.106 +       nil (when-not true)
 341.107 +       nil (when-not false)
 341.108 +       nil (when-not true (exception))
 341.109 +       ))
 341.110 +
 341.111 +(deftest test-if-not
 341.112 +  (are [x y] (= x y)
 341.113 +       1 (if-not false 1)
 341.114 +       1 (if-not false 1 (exception))
 341.115 +       nil (if-not true 1)
 341.116 +       2 (if-not true 1 2)
 341.117 +       nil (if-not true (exception))
 341.118 +       1 (if-not true (exception) 1)
 341.119 +       ))
 341.120 +
 341.121 +(deftest test-when-let
 341.122 +  (are [x y] (= x y)
 341.123 +       1 (when-let [a 1]
 341.124 +           a)
 341.125 +       2 (when-let [[a b] '(1 2)]
 341.126 +           b)
 341.127 +       nil (when-let [a false]
 341.128 +             (exception))
 341.129 +       ))
 341.130 +
 341.131 +(deftest test-if-let
 341.132 +  (are [x y] (= x y)
 341.133 +       1 (if-let [a 1]
 341.134 +           a)
 341.135 +       2 (if-let [[a b] '(1 2)]
 341.136 +           b)
 341.137 +       nil (if-let [a false]
 341.138 +             (exception))
 341.139 +       1 (if-let [a false]
 341.140 +           a 1)
 341.141 +       1 (if-let [[a b] nil]
 341.142 +             b 1)
 341.143 +       1 (if-let [a false]
 341.144 +           (exception)
 341.145 +           1)
 341.146 +       ))
 341.147 +
 341.148 +(deftest test-when-first
 341.149 +  (are [x y] (= x y)
 341.150 +       1 (when-first [a [1 2]]
 341.151 +           a)
 341.152 +       2 (when-first [[a b] '((1 2) 3)]
 341.153 +           b)
 341.154 +       nil (when-first [a nil]
 341.155 +             (exception))
 341.156 +       ))
 341.157 +
 341.158 +
 341.159 +(deftest test-cond
 341.160 +  (are [x y] (= x y)
 341.161 +      (cond) nil
 341.162 +
 341.163 +      (cond nil true) nil
 341.164 +      (cond false true) nil
 341.165 +      
 341.166 +      (cond true 1 true (exception)) 1
 341.167 +      (cond nil 1 false 2 true 3 true 4) 3
 341.168 +      (cond nil 1 false 2 true 3 true (exception)) 3 )
 341.169 +
 341.170 +  ; false
 341.171 +  (are [x]  (= (cond x :a true :b) :b)
 341.172 +      nil false )
 341.173 +
 341.174 +  ; true
 341.175 +  (are [x]  (= (cond x :a true :b) :a)
 341.176 +      true
 341.177 +      0 42
 341.178 +      0.0 3.14
 341.179 +      2/3
 341.180 +      0M 1M
 341.181 +      \c
 341.182 +      "" "abc"
 341.183 +      'sym
 341.184 +      :kw
 341.185 +      () '(1 2)
 341.186 +      [] [1 2]
 341.187 +      {} {:a 1 :b 2}
 341.188 +      #{} #{1 2} )
 341.189 +
 341.190 +  ; evaluation
 341.191 +  (are [x y] (= x y)
 341.192 +      (cond (> 3 2) (+ 1 2) true :result true (exception)) 3
 341.193 +      (cond (< 3 2) (+ 1 2) true :result true (exception)) :result )
 341.194 +
 341.195 +  ; identity (= (cond true x) x)
 341.196 +  (maintains-identity (fn [_] (cond true _))) )
 341.197 +
 341.198 +
 341.199 +(deftest test-condp
 341.200 +  (are [x] (= :pass x)
 341.201 +       (condp = 1
 341.202 +         1 :pass
 341.203 +         2 :fail)
 341.204 +       (condp = 1
 341.205 +         2 :fail
 341.206 +         1 :pass)
 341.207 +       (condp = 1
 341.208 +         2 :fail
 341.209 +         :pass)
 341.210 +       (condp = 1
 341.211 +         :pass)
 341.212 +       (condp = 1
 341.213 +         2 :fail
 341.214 +         ;; doc of condp says result-expr is returned
 341.215 +         ;; shouldn't it say similar to cond: "evaluates and returns
 341.216 +         ;; the value of the corresponding expr and doesn't evaluate any of the
 341.217 +         ;; other tests or exprs."
 341.218 +         (identity :pass))
 341.219 +       (condp + 1
 341.220 +         1 :>> #(if (= % 2) :pass :fail))
 341.221 +       (condp + 1
 341.222 +         1 :>> #(if (= % 3) :fail :pass))
 341.223 +       )
 341.224 +  (is (thrown? IllegalArgumentException
 341.225 +               (condp = 1)
 341.226 +               ))
 341.227 +  (is (thrown? IllegalArgumentException
 341.228 +               (condp = 1
 341.229 +                 2 :fail)
 341.230 +               ))
 341.231 +  )
 341.232 +
 341.233 +
 341.234 +; [for, doseq (for.clj)]
 341.235 +
 341.236 +(deftest test-dotimes
 341.237 +  ;; dotimes always returns nil
 341.238 +  (is (= nil (dotimes [n 1] n)))
 341.239 +  ;; test using an atom since dotimes is for modifying
 341.240 +  ;; test executes n times
 341.241 +  (is (= 3
 341.242 +         (let [a (atom 0)]
 341.243 +           (dotimes [n 3]
 341.244 +             (swap! a inc))
 341.245 +           @a)
 341.246 +         ))
 341.247 +  ;; test all values of n
 341.248 +  (is (= [0 1 2]
 341.249 +         (let [a (atom [])]
 341.250 +           (dotimes [n 3]
 341.251 +             (swap! a conj n))
 341.252 +           @a)))
 341.253 +  (is (= []
 341.254 +         (let [a (atom [])]
 341.255 +           (dotimes [n 0]
 341.256 +             (swap! a conj n))
 341.257 +           @a)))
 341.258 +  )
 341.259 +
 341.260 +(deftest test-while
 341.261 +  (is (= nil (while nil (throw (Exception. "never")))))
 341.262 +  (is (= [0 nil]
 341.263 +         ;; a will dec to 0
 341.264 +         ;; while always returns nil
 341.265 +         (let [a (atom 3)
 341.266 +               w (while (pos? @a)
 341.267 +                   (swap! a dec))]
 341.268 +           [@a w])))
 341.269 +  (is (thrown? Exception (while true (throw (Exception. "expected to throw")))))
 341.270 +  )
 341.271 +
 341.272 +; locking, monitor-enter, monitor-exit
 341.273 +
 341.274 +; case 
 341.275 +(deftest test-case
 341.276 +  (testing "can match many kinds of things"
 341.277 +    (let [two 2
 341.278 +          test-fn
 341.279 +          #(case %
 341.280 +                 1 :number
 341.281 +                 "foo" :string
 341.282 +                 \a :char
 341.283 +                 pow :symbol
 341.284 +                 :zap :keyword
 341.285 +                 (2 \b "bar") :one-of-many
 341.286 +                 [1 2] :sequential-thing
 341.287 +                 {:a 2} :map
 341.288 +                 {:r 2 :d 2} :droid
 341.289 +                 #{2 3 4 5} :set
 341.290 +                 [1 [[[2]]]] :deeply-nested
 341.291 +                 :default)]
 341.292 +      (are [result input] (= result (test-fn input))
 341.293 +           :number 1
 341.294 +           :string "foo"
 341.295 +           :char \a
 341.296 +           :keyword :zap
 341.297 +           :symbol 'pow
 341.298 +           :one-of-many 2
 341.299 +           :one-of-many \b
 341.300 +           :one-of-many "bar"
 341.301 +           :sequential-thing [1 2]
 341.302 +           :sequential-thing (list 1 2)
 341.303 +           :sequential-thing [1 two]
 341.304 +           :map {:a 2}
 341.305 +           :map {:a two}
 341.306 +           :set #{2 3 4 5}
 341.307 +           :set #{two 3 4 5}
 341.308 +           :default #{2 3 4 5 6}
 341.309 +           :droid {:r 2 :d 2}
 341.310 +           :deeply-nested [1 [[[two]]]]
 341.311 +           :default :anything-not-appearing-above)))
 341.312 +  (testing "throws IllegalArgumentException if no match"
 341.313 +    (is (thrown-with-msg?
 341.314 +          IllegalArgumentException #"No matching clause: 2"
 341.315 +          (case 2 1 :ok))))
 341.316 +  (testing "sorting doesn't matter"
 341.317 +    (let [test-fn
 341.318 +          #(case %
 341.319 +                {:b 2 :a 1} :map
 341.320 +                #{3 2 1} :set
 341.321 +                :default)]
 341.322 +      (are [result input] (= result (test-fn input))
 341.323 +           :map {:a 1 :b 2}
 341.324 +           :map (sorted-map :a 1 :b 2)
 341.325 +           :set #{3 2 1}
 341.326 +           :set (sorted-set 2 1 3))))
 341.327 +  (testing "test constants are *not* evaluated"
 341.328 +    (let [test-fn
 341.329 +          ;; never write code like this...
 341.330 +          #(case %
 341.331 +                 (throw (RuntimeException. "boom")) :piece-of-throw-expr
 341.332 +                 :no-match)]
 341.333 +      (are [result input] (= result (test-fn input))
 341.334 +           :piece-of-throw-expr 'throw
 341.335 +           :piece-of-throw-expr '[RuntimeException. "boom"]
 341.336 +           :no-match nil))))
   342.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   342.2 +++ b/src/clojure/test_clojure/data_structures.clj	Sat Aug 21 06:25:44 2010 -0400
   342.3 @@ -0,0 +1,830 @@
   342.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   342.5 +;   The use and distribution terms for this software are covered by the
   342.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   342.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   342.8 +;   By using this software in any fashion, you are agreeing to be bound by
   342.9 +;   the terms of this license.
  342.10 +;   You must not remove this notice, or any other, from this software.
  342.11 +
  342.12 +; Author: Frantisek Sodomka
  342.13 +
  342.14 +
  342.15 +(ns clojure.test-clojure.data-structures
  342.16 +  (:use clojure.test))
  342.17 +
  342.18 +
  342.19 +;; *** Helper functions ***
  342.20 +
  342.21 +(defn diff [s1 s2]
  342.22 +  (seq (reduce disj (set s1) (set s2))))
  342.23 +
  342.24 +
  342.25 +;; *** General ***
  342.26 +
  342.27 +(defstruct equality-struct :a :b)
  342.28 +
  342.29 +(deftest test-equality
  342.30 +  ; nil is not equal to any other value
  342.31 +  (are [x] (not (= nil x))
  342.32 +      true false
  342.33 +      0 0.0
  342.34 +      \space
  342.35 +      "" #""
  342.36 +      () [] #{} {}
  342.37 +      (lazy-seq nil)  ; SVN 1292: fixed (= (lazy-seq nil) nil)
  342.38 +      (lazy-seq ())
  342.39 +      (lazy-seq [])
  342.40 +      (lazy-seq {})
  342.41 +      (lazy-seq #{})
  342.42 +      (lazy-seq "")
  342.43 +      (lazy-seq (into-array []))
  342.44 +      (new Object) )
  342.45 +
  342.46 +  ; numbers equality across types (see tests below - NOT IMPLEMENTED YET)
  342.47 +
  342.48 +  ; ratios
  342.49 +  (is (= 1/2 0.5))
  342.50 +  (is (= 1/1000 0.001))
  342.51 +  (is (not= 2/3 0.6666666666666666))
  342.52 +
  342.53 +  ; vectors equal other seqs by items equality
  342.54 +  (are [x y] (= x y)
  342.55 +      '() []        ; regression fixed in r1208; was not equal
  342.56 +      '(1) [1]
  342.57 +      '(1 2) [1 2]
  342.58 +
  342.59 +      [] '()        ; same again, but vectors first
  342.60 +      [1] '(1)
  342.61 +      [1 2] '(1 2) )
  342.62 +  (is (not= [1 2] '(2 1)))  ; order of items matters
  342.63 +
  342.64 +  ; list and vector vs. set and map
  342.65 +  (are [x y] (not= x y)
  342.66 +      ; only () equals []
  342.67 +      () #{}
  342.68 +      () {}
  342.69 +      [] #{}
  342.70 +      [] {}
  342.71 +      #{} {}
  342.72 +      ; only '(1) equals [1]
  342.73 +      '(1) #{1}
  342.74 +      [1] #{1} )
  342.75 +
  342.76 +  ; sorted-map, hash-map and array-map - classes differ, but content is equal
  342.77 +  
  342.78 +;; TODO: reimplement all-are with new do-template?  
  342.79 +;;   (all-are (not= (class _1) (class _2))
  342.80 +;;       (sorted-map :a 1)
  342.81 +;;       (hash-map   :a 1)
  342.82 +;;       (array-map  :a 1))
  342.83 +;;   (all-are (= _1 _2)
  342.84 +;;       (sorted-map)
  342.85 +;;       (hash-map)
  342.86 +;;       (array-map))
  342.87 +;;   (all-are (= _1 _2)
  342.88 +;;       (sorted-map :a 1)
  342.89 +;;       (hash-map   :a 1)
  342.90 +;;       (array-map  :a 1))
  342.91 +;;   (all-are (= _1 _2)
  342.92 +;;       (sorted-map :a 1 :z 3 :c 2)
  342.93 +;;       (hash-map   :a 1 :z 3 :c 2)
  342.94 +;;       (array-map  :a 1 :z 3 :c 2))
  342.95 +
  342.96 +  ; struct-map vs. sorted-map, hash-map and array-map
  342.97 +  (are [x] (and (not= (class (struct equality-struct 1 2)) (class x))
  342.98 +                (= (struct equality-struct 1 2) x))
  342.99 +      (sorted-map-by compare :a 1 :b 2)
 342.100 +      (sorted-map :a 1 :b 2)
 342.101 +      (hash-map   :a 1 :b 2)
 342.102 +      (array-map  :a 1 :b 2))
 342.103 +
 342.104 +  ; sorted-set vs. hash-set
 342.105 +  (is (not= (class (sorted-set 1)) (class (hash-set 1))))
 342.106 +  (are [x y] (= x y)
 342.107 +      (sorted-set-by <) (hash-set)
 342.108 +      (sorted-set-by < 1) (hash-set 1)
 342.109 +      (sorted-set-by < 3 2 1) (hash-set 3 2 1)
 342.110 +      (sorted-set) (hash-set)
 342.111 +      (sorted-set 1) (hash-set 1)
 342.112 +      (sorted-set 3 2 1) (hash-set 3 2 1) ))
 342.113 +
 342.114 +
 342.115 +;; *** Collections ***
 342.116 +
 342.117 +(deftest test-count
 342.118 +  (are [x y] (= x y)
 342.119 +      (count nil) 0
 342.120 +
 342.121 +      (count ()) 0
 342.122 +      (count '(1)) 1
 342.123 +      (count '(1 2 3)) 3
 342.124 +
 342.125 +      (count []) 0
 342.126 +      (count [1]) 1
 342.127 +      (count [1 2 3]) 3
 342.128 +
 342.129 +      (count #{}) 0
 342.130 +      (count #{1}) 1
 342.131 +      (count #{1 2 3}) 3
 342.132 +
 342.133 +      (count {}) 0
 342.134 +      (count {:a 1}) 1
 342.135 +      (count {:a 1 :b 2 :c 3}) 3
 342.136 +
 342.137 +      (count "") 0
 342.138 +      (count "a") 1
 342.139 +      (count "abc") 3
 342.140 +
 342.141 +      (count (into-array [])) 0
 342.142 +      (count (into-array [1])) 1
 342.143 +      (count (into-array [1 2 3])) 3
 342.144 +
 342.145 +      (count (java.util.ArrayList. [])) 0
 342.146 +      (count (java.util.ArrayList. [1])) 1
 342.147 +      (count (java.util.ArrayList. [1 2 3])) 3
 342.148 +
 342.149 +      (count (java.util.HashMap. {})) 0
 342.150 +      (count (java.util.HashMap. {:a 1})) 1
 342.151 +      (count (java.util.HashMap. {:a 1 :b 2 :c 3})) 3 )
 342.152 +
 342.153 +  ; different types
 342.154 +  (are [x]  (= (count [x]) 1)
 342.155 +      nil true false
 342.156 +      0 0.0 "" \space
 342.157 +      () [] #{} {}  ))
 342.158 +
 342.159 +
 342.160 +(deftest test-conj
 342.161 +  ; doesn't work on strings or arrays
 342.162 +  (is (thrown? ClassCastException (conj "" \a)))
 342.163 +  (is (thrown? ClassCastException (conj (into-array []) 1)))
 342.164 +
 342.165 +  (are [x y] (= x y)
 342.166 +      (conj nil 1) '(1)
 342.167 +      (conj nil 3 2 1) '(1 2 3)
 342.168 +
 342.169 +      (conj nil nil) '(nil)
 342.170 +      (conj nil nil nil) '(nil nil)
 342.171 +      (conj nil nil nil 1) '(1 nil nil)
 342.172 +
 342.173 +      ; list -> conj puts the item at the front of the list
 342.174 +      (conj () 1) '(1)
 342.175 +      (conj () 1 2) '(2 1)
 342.176 +
 342.177 +      (conj '(2 3) 1) '(1 2 3)
 342.178 +      (conj '(2 3) 1 4 3) '(3 4 1 2 3)
 342.179 +
 342.180 +      (conj () nil) '(nil)
 342.181 +      (conj () ()) '(())
 342.182 +
 342.183 +      ; vector -> conj puts the item at the end of the vector
 342.184 +      (conj [] 1) [1]
 342.185 +      (conj [] 1 2) [1 2]
 342.186 +
 342.187 +      (conj [2 3] 1) [2 3 1]
 342.188 +      (conj [2 3] 1 4 3) [2 3 1 4 3]
 342.189 +
 342.190 +      (conj [] nil) [nil]
 342.191 +      (conj [] []) [[]]
 342.192 +
 342.193 +      ; map -> conj expects another (possibly single entry) map as the item,
 342.194 +      ;   and returns a new map which is the old map plus the entries
 342.195 +      ;   from the new, which may overwrite entries of the old.
 342.196 +      ;   conj also accepts a MapEntry or a vector of two items (key and value).
 342.197 +      (conj {} {}) {}
 342.198 +      (conj {} {:a 1}) {:a 1}
 342.199 +      (conj {} {:a 1 :b 2}) {:a 1 :b 2}
 342.200 +      (conj {} {:a 1 :b 2} {:c 3}) {:a 1 :b 2 :c 3}
 342.201 +      (conj {} {:a 1 :b 2} {:a 3 :c 4}) {:a 3 :b 2 :c 4}
 342.202 +
 342.203 +      (conj {:a 1} {:a 7}) {:a 7}
 342.204 +      (conj {:a 1} {:b 2}) {:a 1 :b 2}
 342.205 +      (conj {:a 1} {:a 7 :b 2}) {:a 7 :b 2}
 342.206 +      (conj {:a 1} {:a 7 :b 2} {:c 3}) {:a 7 :b 2 :c 3}
 342.207 +      (conj {:a 1} {:a 7 :b 2} {:b 4 :c 5}) {:a 7 :b 4 :c 5}
 342.208 +
 342.209 +      (conj {} (first {:a 1})) {:a 1}           ; MapEntry
 342.210 +      (conj {:a 1} (first {:b 2})) {:a 1 :b 2}
 342.211 +      (conj {:a 1} (first {:a 7})) {:a 7}
 342.212 +      (conj {:a 1} (first {:b 2}) (first {:a 5})) {:a 5 :b 2}
 342.213 +
 342.214 +      (conj {} [:a 1]) {:a 1}                   ; vector
 342.215 +      (conj {:a 1} [:b 2]) {:a 1 :b 2}
 342.216 +      (conj {:a 1} [:a 7]) {:a 7}
 342.217 +      (conj {:a 1} [:b 2] [:a 5]) {:a 5 :b 2}
 342.218 +
 342.219 +      (conj {} {nil {}}) {nil {}}
 342.220 +      (conj {} {{} nil}) {{} nil}
 342.221 +      (conj {} {{} {}}) {{} {}}
 342.222 +
 342.223 +      ; set
 342.224 +      (conj #{} 1) #{1}
 342.225 +      (conj #{} 1 2 3) #{1 2 3}
 342.226 +
 342.227 +      (conj #{2 3} 1) #{3 1 2}
 342.228 +      (conj #{3 2} 1) #{1 2 3}
 342.229 +
 342.230 +      (conj #{2 3} 2) #{2 3}
 342.231 +      (conj #{2 3} 2 3) #{2 3}
 342.232 +      (conj #{2 3} 4 1 2 3) #{1 2 3 4}
 342.233 +
 342.234 +      (conj #{} nil) #{nil}
 342.235 +      (conj #{} #{}) #{#{}} ))
 342.236 +
 342.237 +
 342.238 +;; *** Lists and Vectors ***
 342.239 +
 342.240 +(deftest test-peek
 342.241 +  ; doesn't work for sets and maps
 342.242 +  (is (thrown? ClassCastException (peek #{1})))
 342.243 +  (is (thrown? ClassCastException (peek {:a 1})))
 342.244 +
 342.245 +  (are [x y] (= x y)
 342.246 +      (peek nil) nil
 342.247 +
 342.248 +      ; list = first
 342.249 +      (peek ()) nil
 342.250 +      (peek '(1)) 1
 342.251 +      (peek '(1 2 3)) 1
 342.252 +
 342.253 +      (peek '(nil)) nil     ; special cases
 342.254 +      (peek '(1 nil)) 1
 342.255 +      (peek '(nil 2)) nil
 342.256 +      (peek '(())) ()
 342.257 +      (peek '(() nil)) ()
 342.258 +      (peek '(() 2 nil)) ()
 342.259 +
 342.260 +      ; vector = last
 342.261 +      (peek []) nil
 342.262 +      (peek [1]) 1
 342.263 +      (peek [1 2 3]) 3
 342.264 +
 342.265 +      (peek [nil]) nil      ; special cases
 342.266 +      (peek [1 nil]) nil
 342.267 +      (peek [nil 2]) 2
 342.268 +      (peek [[]]) []
 342.269 +      (peek [[] nil]) nil
 342.270 +      (peek [[] 2 nil]) nil ))
 342.271 +
 342.272 +
 342.273 +(deftest test-pop
 342.274 +  ; doesn't work for sets and maps
 342.275 +  (is (thrown? ClassCastException (pop #{1})))
 342.276 +  (is (thrown? ClassCastException (pop #{:a 1})))
 342.277 +
 342.278 +  ; collection cannot be empty
 342.279 +  (is (thrown? IllegalStateException (pop ())))
 342.280 +  (is (thrown? IllegalStateException (pop [])))
 342.281 +
 342.282 +  (are [x y] (= x y)
 342.283 +      (pop nil) nil
 342.284 +
 342.285 +      ; list - pop first
 342.286 +      (pop '(1)) ()
 342.287 +      (pop '(1 2 3)) '(2 3)
 342.288 +
 342.289 +      (pop '(nil)) ()
 342.290 +      (pop '(1 nil)) '(nil)
 342.291 +      (pop '(nil 2)) '(2)
 342.292 +      (pop '(())) ()
 342.293 +      (pop '(() nil)) '(nil)
 342.294 +      (pop '(() 2 nil)) '(2 nil)
 342.295 +
 342.296 +      ; vector - pop last
 342.297 +      (pop [1]) []
 342.298 +      (pop [1 2 3]) [1 2]
 342.299 +
 342.300 +      (pop [nil]) []
 342.301 +      (pop [1 nil]) [1]
 342.302 +      (pop [nil 2]) [nil]
 342.303 +      (pop [[]]) []
 342.304 +      (pop [[] nil]) [[]]
 342.305 +      (pop [[] 2 nil]) [[] 2] ))
 342.306 +
 342.307 +
 342.308 +;; *** Lists (IPersistentList) ***
 342.309 +
 342.310 +(deftest test-list
 342.311 +  (are [x]  (list? x)
 342.312 +      ()
 342.313 +      '()
 342.314 +      (list)
 342.315 +      (list 1 2 3) )
 342.316 +
 342.317 +  ; order is important
 342.318 +  (are [x y] (not (= x y))
 342.319 +      (list 1 2) (list 2 1)
 342.320 +      (list 3 1 2) (list 1 2 3) )
 342.321 +
 342.322 +  (are [x y] (= x y)
 342.323 +      '() ()
 342.324 +      (list) '()
 342.325 +      (list 1) '(1)
 342.326 +      (list 1 2) '(1 2)
 342.327 +
 342.328 +      ; nesting
 342.329 +      (list 1 (list 2 3) (list 3 (list 4 5 (list 6 (list 7)))))
 342.330 +        '(1 (2 3) (3 (4 5 (6 (7)))))
 342.331 +
 342.332 +      ; different data structures
 342.333 +      (list true false nil)
 342.334 +        '(true false nil)
 342.335 +      (list 1 2.5 2/3 "ab" \x 'cd :kw)
 342.336 +        '(1 2.5 2/3 "ab" \x cd :kw)
 342.337 +      (list (list 1 2) [3 4] {:a 1 :b 2} #{:c :d})
 342.338 +        '((1 2) [3 4] {:a 1 :b 2} #{:c :d})
 342.339 +
 342.340 +      ; evaluation
 342.341 +      (list (+ 1 2) [(+ 2 3) 'a] (list (* 2 3) 8))
 342.342 +        '(3 [5 a] (6 8))
 342.343 +
 342.344 +      ; special cases
 342.345 +      (list nil) '(nil)
 342.346 +      (list 1 nil) '(1 nil)
 342.347 +      (list nil 2) '(nil 2)
 342.348 +      (list ()) '(())
 342.349 +      (list 1 ()) '(1 ())
 342.350 +      (list () 2) '(() 2) ))
 342.351 +
 342.352 +
 342.353 +;; *** Maps (IPersistentMap) ***
 342.354 +
 342.355 +(deftest test-find
 342.356 +  (are [x y] (= x y)
 342.357 +      (find {} :a) nil
 342.358 +
 342.359 +      (find {:a 1} :a) [:a 1]
 342.360 +      (find {:a 1} :b) nil
 342.361 +
 342.362 +      (find {:a 1 :b 2} :a) [:a 1]
 342.363 +      (find {:a 1 :b 2} :b) [:b 2]
 342.364 +      (find {:a 1 :b 2} :c) nil
 342.365 +
 342.366 +      (find {} nil) nil
 342.367 +      (find {:a 1} nil) nil
 342.368 +      (find {:a 1 :b 2} nil) nil ))
 342.369 +
 342.370 +
 342.371 +(deftest test-contains?
 342.372 +  ; contains? is designed to work preferably on maps and sets
 342.373 +  (are [x y] (= x y)
 342.374 +      (contains? {} :a) false
 342.375 +      (contains? {} nil) false
 342.376 +
 342.377 +      (contains? {:a 1} :a) true
 342.378 +      (contains? {:a 1} :b) false
 342.379 +      (contains? {:a 1} nil) false
 342.380 +
 342.381 +      (contains? {:a 1 :b 2} :a) true
 342.382 +      (contains? {:a 1 :b 2} :b) true
 342.383 +      (contains? {:a 1 :b 2} :c) false
 342.384 +      (contains? {:a 1 :b 2} nil) false
 342.385 +
 342.386 +      ; sets
 342.387 +      (contains? #{} 1) false
 342.388 +      (contains? #{} nil) false
 342.389 +
 342.390 +      (contains? #{1} 1) true
 342.391 +      (contains? #{1} 2) false
 342.392 +      (contains? #{1} nil) false
 342.393 +
 342.394 +      (contains? #{1 2 3} 1) true
 342.395 +      (contains? #{1 2 3} 3) true
 342.396 +      (contains? #{1 2 3} 10) false
 342.397 +      (contains? #{1 2 3} nil) false)
 342.398 +
 342.399 +  ; numerically indexed collections (e.g. vectors and Java arrays)
 342.400 +  ; => test if the numeric key is WITHIN THE RANGE OF INDEXES
 342.401 +  (are [x y] (= x y)
 342.402 +      (contains? [] 0) false
 342.403 +      (contains? [] -1) false
 342.404 +      (contains? [] 1) false
 342.405 +
 342.406 +      (contains? [1] 0) true
 342.407 +      (contains? [1] -1) false
 342.408 +      (contains? [1] 1) false
 342.409 +
 342.410 +      (contains? [1 2 3] 0) true
 342.411 +      (contains? [1 2 3] 2) true
 342.412 +      (contains? [1 2 3] 3) false
 342.413 +      (contains? [1 2 3] -1) false
 342.414 +
 342.415 +      ; arrays
 342.416 +      (contains? (into-array []) 0) false
 342.417 +      (contains? (into-array []) -1) false
 342.418 +      (contains? (into-array []) 1) false
 342.419 +
 342.420 +      (contains? (into-array [1]) 0) true
 342.421 +      (contains? (into-array [1]) -1) false
 342.422 +      (contains? (into-array [1]) 1) false
 342.423 +
 342.424 +      (contains? (into-array [1 2 3]) 0) true
 342.425 +      (contains? (into-array [1 2 3]) 2) true
 342.426 +      (contains? (into-array [1 2 3]) 3) false
 342.427 +      (contains? (into-array [1 2 3]) -1) false)
 342.428 +
 342.429 +  ; 'contains?' operates constant or logarithmic time,
 342.430 +  ; it WILL NOT perform a linear search for a value.
 342.431 +  (are [x]  (= x false)
 342.432 +      (contains? '(1 2 3) 0)
 342.433 +      (contains? '(1 2 3) 1)
 342.434 +      (contains? '(1 2 3) 3)
 342.435 +      (contains? '(1 2 3) 10)
 342.436 +      (contains? '(1 2 3) nil)
 342.437 +      (contains? '(1 2 3) ()) ))
 342.438 +
 342.439 +
 342.440 +(deftest test-keys
 342.441 +  (are [x y] (= x y)      ; other than map data structures
 342.442 +      (keys ()) nil
 342.443 +      (keys []) nil
 342.444 +      (keys #{}) nil
 342.445 +      (keys "") nil )
 342.446 +
 342.447 +  (are [x y] (= x y)
 342.448 +      ; (class {:a 1}) => clojure.lang.PersistentArrayMap
 342.449 +      (keys {}) nil
 342.450 +      (keys {:a 1}) '(:a)
 342.451 +      (diff (keys {:a 1 :b 2}) '(:a :b)) nil              ; (keys {:a 1 :b 2}) '(:a :b)
 342.452 +
 342.453 +      ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap
 342.454 +      (keys (sorted-map)) nil
 342.455 +      (keys (sorted-map :a 1)) '(:a)
 342.456 +      (diff (keys (sorted-map :a 1 :b 2)) '(:a :b)) nil   ; (keys (sorted-map :a 1 :b 2)) '(:a :b)
 342.457 +
 342.458 +      ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap
 342.459 +      (keys (hash-map)) nil
 342.460 +      (keys (hash-map :a 1)) '(:a)
 342.461 +      (diff (keys (hash-map :a 1 :b 2)) '(:a :b)) nil ))  ; (keys (hash-map :a 1 :b 2)) '(:a :b)
 342.462 +
 342.463 +
 342.464 +(deftest test-vals
 342.465 +  (are [x y] (= x y)      ; other than map data structures
 342.466 +      (vals ()) nil
 342.467 +      (vals []) nil
 342.468 +      (vals #{}) nil
 342.469 +      (vals "") nil )
 342.470 +
 342.471 +  (are [x y] (= x y)
 342.472 +      ; (class {:a 1}) => clojure.lang.PersistentArrayMap
 342.473 +      (vals {}) nil
 342.474 +      (vals {:a 1}) '(1)
 342.475 +      (diff (vals {:a 1 :b 2}) '(1 2)) nil              ; (vals {:a 1 :b 2}) '(1 2)
 342.476 +
 342.477 +      ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap
 342.478 +      (vals (sorted-map)) nil
 342.479 +      (vals (sorted-map :a 1)) '(1)
 342.480 +      (diff (vals (sorted-map :a 1 :b 2)) '(1 2)) nil   ; (vals (sorted-map :a 1 :b 2)) '(1 2)
 342.481 +
 342.482 +      ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap
 342.483 +      (vals (hash-map)) nil
 342.484 +      (vals (hash-map :a 1)) '(1)
 342.485 +      (diff (vals (hash-map :a 1 :b 2)) '(1 2)) nil ))  ; (vals (hash-map :a 1 :b 2)) '(1 2)
 342.486 +
 342.487 +
 342.488 +(deftest test-key
 342.489 +  (are [x]  (= (key (first (hash-map x :value))) x)
 342.490 +      nil
 342.491 +      false true
 342.492 +      0 42
 342.493 +      0.0 3.14
 342.494 +      2/3
 342.495 +      0M 1M
 342.496 +      \c
 342.497 +      "" "abc"
 342.498 +      'sym
 342.499 +      :kw
 342.500 +      () '(1 2)
 342.501 +      [] [1 2]
 342.502 +      {} {:a 1 :b 2}
 342.503 +      #{} #{1 2} ))
 342.504 +
 342.505 +
 342.506 +(deftest test-val
 342.507 +  (are [x]  (= (val (first (hash-map :key x))) x)
 342.508 +      nil
 342.509 +      false true
 342.510 +      0 42
 342.511 +      0.0 3.14
 342.512 +      2/3
 342.513 +      0M 1M
 342.514 +      \c
 342.515 +      "" "abc"
 342.516 +      'sym
 342.517 +      :kw
 342.518 +      () '(1 2)
 342.519 +      [] [1 2]
 342.520 +      {} {:a 1 :b 2}
 342.521 +      #{} #{1 2} ))
 342.522 +
 342.523 +(deftest test-get
 342.524 +  (let [m {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}}]
 342.525 +    (is (thrown? IllegalArgumentException (get-in {:a 1} 5)))
 342.526 +    (are [x y] (= x y)
 342.527 +         (get m :a) 1
 342.528 +         (get m :e) nil
 342.529 +         (get m :e 0) 0
 342.530 +         (get m :b 0) 2
 342.531 +         (get m :f 0) nil
 342.532 +
 342.533 +         (get-in m [:c :e]) 4
 342.534 +         (get-in m '(:c :e)) 4
 342.535 +         (get-in m [:c :x]) nil
 342.536 +         (get-in m [:f]) nil
 342.537 +         (get-in m [:g]) false
 342.538 +         (get-in m [:h]) nil
 342.539 +         (get-in m []) m
 342.540 +         (get-in m nil) m
 342.541 +
 342.542 +         (get-in m [:c :e] 0) 4
 342.543 +         (get-in m '(:c :e) 0) 4
 342.544 +         (get-in m [:c :x] 0) 0
 342.545 +         (get-in m [:b] 0) 2
 342.546 +         (get-in m [:f] 0) nil
 342.547 +         (get-in m [:g] 0) false
 342.548 +         (get-in m [:h] 0) 0
 342.549 +         (get-in m [:x :y] {:y 1}) {:y 1}
 342.550 +         (get-in m [] 0) m
 342.551 +         (get-in m nil 0) m)))
 342.552 +
 342.553 +;; *** Sets ***
 342.554 +
 342.555 +(deftest test-hash-set
 342.556 +  (are [x] (set? x)
 342.557 +      #{}
 342.558 +      #{1 2}
 342.559 +      (hash-set)
 342.560 +      (hash-set 1 2) )
 342.561 +
 342.562 +  ; order isn't important
 342.563 +  (are [x y] (= x y)
 342.564 +      #{1 2} #{2 1}
 342.565 +      #{3 1 2} #{1 2 3}
 342.566 +      (hash-set 1 2) (hash-set 2 1)
 342.567 +      (hash-set 3 1 2) (hash-set 1 2 3) )
 342.568 +
 342.569 +
 342.570 +  (are [x y] (= x y)
 342.571 +      ; equal classes
 342.572 +      (class #{}) (class (hash-set))
 342.573 +      (class #{1 2}) (class (hash-set 1 2))
 342.574 +
 342.575 +      ; creating
 342.576 +      (hash-set) #{}
 342.577 +      (hash-set 1) #{1}
 342.578 +      (hash-set 1 2) #{1 2}
 342.579 +
 342.580 +      ; nesting
 342.581 +      (hash-set 1 (hash-set 2 3) (hash-set 3 (hash-set 4 5 (hash-set 6 (hash-set 7)))))
 342.582 +        #{1 #{2 3} #{3 #{4 5 #{6 #{7}}}}}
 342.583 +
 342.584 +      ; different data structures
 342.585 +      (hash-set true false nil)
 342.586 +        #{true false nil}
 342.587 +      (hash-set 1 2.5 2/3 "ab" \x 'cd :kw)
 342.588 +        #{1 2.5 2/3 "ab" \x 'cd :kw}
 342.589 +      (hash-set (list 1 2) [3 4] {:a 1 :b 2} #{:c :d})
 342.590 +        #{'(1 2) [3 4] {:a 1 :b 2} #{:c :d}}
 342.591 +
 342.592 +      ; evaluation
 342.593 +      (hash-set (+ 1 2) [(+ 2 3) :a] (hash-set (* 2 3) 8))
 342.594 +        #{3 [5 :a] #{6 8}}
 342.595 +
 342.596 +      ; special cases
 342.597 +      (hash-set nil) #{nil}
 342.598 +      (hash-set 1 nil) #{1 nil}
 342.599 +      (hash-set nil 2) #{nil 2}
 342.600 +      (hash-set #{}) #{#{}}
 342.601 +      (hash-set 1 #{}) #{1 #{}}
 342.602 +      (hash-set #{} 2) #{#{} 2} ))
 342.603 +
 342.604 +
 342.605 +(deftest test-sorted-set
 342.606 +  ; only compatible types can be used
 342.607 +  (is (thrown? ClassCastException (sorted-set 1 "a")))
 342.608 +  (is (thrown? ClassCastException (sorted-set '(1 2) [3 4])))
 342.609 +
 342.610 +  ; creates set?
 342.611 +  (are [x] (set? x)
 342.612 +       (sorted-set)
 342.613 +       (sorted-set 1 2) )
 342.614 +
 342.615 +  ; equal and unique
 342.616 +  (are [x] (and (= (sorted-set x) #{x})
 342.617 +                (= (sorted-set x x) (sorted-set x)))
 342.618 +      nil
 342.619 +      false true
 342.620 +      0 42
 342.621 +      0.0 3.14
 342.622 +      2/3
 342.623 +      0M 1M
 342.624 +      \c
 342.625 +      "" "abc"
 342.626 +      'sym
 342.627 +      :kw
 342.628 +      ()  ; '(1 2)
 342.629 +      [] [1 2]
 342.630 +      {}  ; {:a 1 :b 2}
 342.631 +      #{} ; #{1 2}
 342.632 +  )
 342.633 +  ; cannot be cast to java.lang.Comparable
 342.634 +  (is (thrown? ClassCastException (sorted-set '(1 2) '(1 2))))
 342.635 +  (is (thrown? ClassCastException (sorted-set {:a 1 :b 2} {:a 1 :b 2})))
 342.636 +  (is (thrown? ClassCastException (sorted-set #{1 2} #{1 2})))
 342.637 +
 342.638 +  (are [x y] (= x y)
 342.639 +      ; generating
 342.640 +      (sorted-set) #{}
 342.641 +      (sorted-set 1) #{1}
 342.642 +      (sorted-set 1 2) #{1 2}
 342.643 +
 342.644 +      ; sorting
 342.645 +      (seq (sorted-set 5 4 3 2 1)) '(1 2 3 4 5)
 342.646 +
 342.647 +      ; special cases
 342.648 +      (sorted-set nil) #{nil}
 342.649 +      (sorted-set 1 nil) #{nil 1}
 342.650 +      (sorted-set nil 2) #{nil 2}
 342.651 +      (sorted-set #{}) #{#{}} ))
 342.652 +
 342.653 +
 342.654 +(deftest test-sorted-set-by
 342.655 +  ; only compatible types can be used
 342.656 +  ; NB: not a ClassCastException, but a RuntimeException is thrown,
 342.657 +  ; requires discussion on whether this should be symmetric with test-sorted-set
 342.658 +  (is (thrown? Exception (sorted-set-by < 1 "a")))
 342.659 +  (is (thrown? Exception (sorted-set-by < '(1 2) [3 4])))
 342.660 +
 342.661 +  ; creates set?
 342.662 +  (are [x] (set? x)
 342.663 +       (sorted-set-by <)
 342.664 +       (sorted-set-by < 1 2) )
 342.665 +
 342.666 +  ; equal and unique
 342.667 +  (are [x] (and (= (sorted-set-by compare x) #{x})
 342.668 +                (= (sorted-set-by compare x x) (sorted-set-by compare x)))
 342.669 +      nil
 342.670 +      false true
 342.671 +      0 42
 342.672 +      0.0 3.14
 342.673 +      2/3
 342.674 +      0M 1M
 342.675 +      \c
 342.676 +      "" "abc"
 342.677 +      'sym
 342.678 +      :kw
 342.679 +      ()  ; '(1 2)
 342.680 +      [] [1 2]
 342.681 +      {}  ; {:a 1 :b 2}
 342.682 +      #{} ; #{1 2}
 342.683 +  )
 342.684 +  ; cannot be cast to java.lang.Comparable
 342.685 +  ; NB: not a ClassCastException, but a RuntimeException is thrown,
 342.686 +  ; requires discussion on whether this should be symmetric with test-sorted-set
 342.687 +  (is (thrown? Exception (sorted-set-by compare '(1 2) '(1 2))))
 342.688 +  (is (thrown? Exception (sorted-set-by compare {:a 1 :b 2} {:a 1 :b 2})))
 342.689 +  (is (thrown? Exception (sorted-set-by compare #{1 2} #{1 2})))
 342.690 +
 342.691 +  (are [x y] (= x y)
 342.692 +      ; generating
 342.693 +      (sorted-set-by >) #{}
 342.694 +      (sorted-set-by > 1) #{1}
 342.695 +      (sorted-set-by > 1 2) #{1 2}
 342.696 +
 342.697 +      ; sorting
 342.698 +      (seq (sorted-set-by < 5 4 3 2 1)) '(1 2 3 4 5)
 342.699 +
 342.700 +      ; special cases
 342.701 +      (sorted-set-by compare nil) #{nil}
 342.702 +      (sorted-set-by compare 1 nil) #{nil 1}
 342.703 +      (sorted-set-by compare nil 2) #{nil 2}
 342.704 +      (sorted-set-by compare #{}) #{#{}} ))
 342.705 +
 342.706 +
 342.707 +(deftest test-set
 342.708 +  ; set?
 342.709 +  (are [x] (set? (set x))
 342.710 +      () '(1 2)
 342.711 +      [] [1 2]
 342.712 +      #{} #{1 2}
 342.713 +      {} {:a 1 :b 2}
 342.714 +      (into-array []) (into-array [1 2])
 342.715 +      "" "abc" )
 342.716 +
 342.717 +  ; unique
 342.718 +  (are [x] (= (set [x x]) #{x})
 342.719 +      nil
 342.720 +      false true
 342.721 +      0 42
 342.722 +      0.0 3.14
 342.723 +      2/3
 342.724 +      0M 1M
 342.725 +      \c
 342.726 +      "" "abc"
 342.727 +      'sym
 342.728 +      :kw
 342.729 +      () '(1 2)
 342.730 +      [] [1 2]
 342.731 +      {} {:a 1 :b 2}
 342.732 +      #{} #{1 2} )
 342.733 +
 342.734 +  ; conversion
 342.735 +  (are [x y] (= (set x) y)
 342.736 +      () #{}
 342.737 +      '(1 2) #{1 2}
 342.738 +
 342.739 +      [] #{}
 342.740 +      [1 2] #{1 2}
 342.741 +
 342.742 +      #{} #{}         ; identity
 342.743 +      #{1 2} #{1 2}   ; identity
 342.744 +
 342.745 +      {} #{}
 342.746 +      {:a 1 :b 2} #{[:a 1] [:b 2]}
 342.747 +
 342.748 +      (into-array []) #{}
 342.749 +      (into-array [1 2]) #{1 2}
 342.750 +
 342.751 +      "" #{}
 342.752 +      "abc" #{\a \b \c} ))
 342.753 +
 342.754 +
 342.755 +(deftest test-disj
 342.756 +  ; doesn't work on lists, vectors or maps
 342.757 +  (is (thrown? ClassCastException (disj '(1 2) 1)))
 342.758 +  (is (thrown? ClassCastException (disj [1 2] 1)))
 342.759 +  (is (thrown? ClassCastException (disj {:a 1} :a)))
 342.760 +
 342.761 +  ; identity
 342.762 +  (are [x] (= (disj x) x)
 342.763 +      nil
 342.764 +      #{}
 342.765 +      #{1 2 3}
 342.766 +      ; different data types
 342.767 +      #{nil
 342.768 +        false true
 342.769 +        0 42
 342.770 +        0.0 3.14
 342.771 +        2/3
 342.772 +        0M 1M
 342.773 +        \c
 342.774 +        "" "abc"
 342.775 +        'sym
 342.776 +        :kw
 342.777 +        [] [1 2]
 342.778 +        {} {:a 1 :b 2}
 342.779 +        #{} #{1 2}} )
 342.780 +
 342.781 +  ; type identity
 342.782 +  (are [x] (= (class (disj x)) (class x))
 342.783 +      (hash-set)
 342.784 +      (hash-set 1 2)
 342.785 +      (sorted-set)
 342.786 +      (sorted-set 1 2) )
 342.787 +
 342.788 +  (are [x y] (= x y)
 342.789 +      (disj nil :a) nil
 342.790 +      (disj nil :a :b) nil
 342.791 +
 342.792 +      (disj #{} :a) #{}
 342.793 +      (disj #{} :a :b) #{}
 342.794 +
 342.795 +      (disj #{:a} :a) #{}
 342.796 +      (disj #{:a} :a :b) #{}
 342.797 +      (disj #{:a} :c) #{:a}
 342.798 +
 342.799 +      (disj #{:a :b :c :d} :a) #{:b :c :d}
 342.800 +      (disj #{:a :b :c :d} :a :d) #{:b :c}
 342.801 +      (disj #{:a :b :c :d} :a :b :c) #{:d}
 342.802 +      (disj #{:a :b :c :d} :d :a :c :b) #{}
 342.803 +
 342.804 +      (disj #{nil} :a) #{nil}
 342.805 +      (disj #{nil} #{}) #{nil}
 342.806 +      (disj #{nil} nil) #{}
 342.807 +
 342.808 +      (disj #{#{}} nil) #{#{}}
 342.809 +      (disj #{#{}} #{}) #{}
 342.810 +      (disj #{#{nil}} #{nil}) #{} ))
 342.811 +
 342.812 +
 342.813 +;; *** Queues ***
 342.814 +
 342.815 +(deftest test-queues
 342.816 +  (let [EMPTY clojure.lang.PersistentQueue/EMPTY]
 342.817 +    (are [x y] (= x y)
 342.818 +      EMPTY EMPTY
 342.819 +      (into EMPTY (range 50)) (into EMPTY (range 50))
 342.820 +      (range 5) (into EMPTY (range 5))
 342.821 +      (range 1 6) (-> EMPTY
 342.822 +                    (into (range 6))
 342.823 +                    pop))
 342.824 +    (are [x y] (not= x y)
 342.825 +      (range 5) (into EMPTY (range 6))
 342.826 +      (range 6) (into EMPTY (range 5))
 342.827 +      (range 0 6) (-> EMPTY
 342.828 +                    (into (range 6))
 342.829 +                    pop)
 342.830 +      (range 1 6) (-> EMPTY
 342.831 +                    (into (range 7))
 342.832 +                    pop))))
 342.833 +
   343.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   343.2 +++ b/src/clojure/test_clojure/def.clj	Sat Aug 21 06:25:44 2010 -0400
   343.3 @@ -0,0 +1,16 @@
   343.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   343.5 +;   The use and distribution terms for this software are covered by the
   343.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   343.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   343.8 +;   By using this software in any fashion, you are agreeing to be bound by
   343.9 +;   the terms of this license.
  343.10 +;   You must not remove this notice, or any other, from this software.
  343.11 +
  343.12 +(ns clojure.test-clojure.def
  343.13 +  (:use clojure.test clojure.test-clojure.helpers
  343.14 +        clojure.test-clojure.protocols))
  343.15 +
  343.16 +(deftest defn-error-messages
  343.17 +  (testing "bad arglist forms"
  343.18 +    (is (fails-with-cause? IllegalArgumentException '#"Parameter declaration arg1 should be a vector"
  343.19 +          (eval-in-temp-ns (defn foo (arg1 arg2)))))))
   344.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   344.2 +++ b/src/clojure/test_clojure/evaluation.clj	Sat Aug 21 06:25:44 2010 -0400
   344.3 @@ -0,0 +1,225 @@
   344.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   344.5 +;   The use and distribution terms for this software are covered by the
   344.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   344.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   344.8 +;   By using this software in any fashion, you are agreeing to be bound by
   344.9 +;   the terms of this license.
  344.10 +;   You must not remove this notice, or any other, from this software.
  344.11 +
  344.12 +
  344.13 +;;  Tests for the Clojure functions documented at the URL:
  344.14 +;;
  344.15 +;;    http://clojure.org/Evaluation
  344.16 +;;
  344.17 +;;  by J. McConnell
  344.18 +;;  Created 22 October 2008
  344.19 +
  344.20 +(ns clojure.test-clojure.evaluation
  344.21 +  (:use clojure.test))
  344.22 +
  344.23 +(import '(java.lang Boolean)
  344.24 +        '(clojure.lang Compiler Compiler$CompilerException))
  344.25 +
  344.26 +(defmacro test-that
  344.27 +  "Provides a useful way for specifying the purpose of tests. If the first-level
  344.28 +  forms are lists that make a call to a clojure.test function, it supplies the
  344.29 +  purpose as the msg argument to those functions. Otherwise, the purpose just
  344.30 +  acts like a comment and the forms are run unchanged."
  344.31 +  [purpose & test-forms]
  344.32 +  (let [tests (map
  344.33 +                #(if (= (:ns (meta (resolve (first %))))
  344.34 +                        (the-ns 'clojure.test))
  344.35 +                   (concat % (list purpose))
  344.36 +                   %)
  344.37 +                test-forms)]
  344.38 +    `(do ~@tests)))
  344.39 +
  344.40 +(deftest Eval
  344.41 +  (is (= (eval '(+ 1 2 3)) (Compiler/eval '(+ 1 2 3))))
  344.42 +  (is (= (eval '(list 1 2 3)) '(1 2 3)))
  344.43 +  (is (= (eval '(list + 1 2 3)) (list clojure.core/+ 1 2 3)))
  344.44 +  (test-that "Non-closure fns are supported as code"
  344.45 +             (is (= (eval (eval '(list + 1 2 3))) 6)))
  344.46 +  (is (= (eval (list '+ 1 2 3)) 6)))
  344.47 +
  344.48 +; not using Clojure's RT/classForName since a bug in it could hide a bug in
  344.49 +; eval's resolution
  344.50 +(defn class-for-name [name]
  344.51 +  (java.lang.Class/forName name))
  344.52 +
  344.53 +(defmacro in-test-ns [& body]
  344.54 +  `(binding [*ns* *ns*]
  344.55 +     (in-ns 'clojure.test-clojure.evaluation)
  344.56 +     ~@body))
  344.57 +
  344.58 +;;; Literals tests ;;;
  344.59 +
  344.60 +(defmacro #^{:private true} evaluates-to-itself? [expr]
  344.61 +  `(let [v# ~expr
  344.62 +         q# (quote ~expr)]
  344.63 +     (is (= (eval q#) q#) (str q# " does not evaluate to itself"))))
  344.64 +
  344.65 +(deftest Literals
  344.66 +  ; Strings, numbers, characters, nil and keywords should evaluate to themselves
  344.67 +  (evaluates-to-itself? "test")
  344.68 +  (evaluates-to-itself? "test
  344.69 +                        multi-line
  344.70 +                        string")
  344.71 +  (evaluates-to-itself? 1)
  344.72 +  (evaluates-to-itself? 1.0)
  344.73 +  (evaluates-to-itself? 1.123456789)
  344.74 +  (evaluates-to-itself? 1/2)
  344.75 +  (evaluates-to-itself? 1M)
  344.76 +  (evaluates-to-itself? 999999999999999999)
  344.77 +  (evaluates-to-itself? \a)
  344.78 +  (evaluates-to-itself? \newline)
  344.79 +  (evaluates-to-itself? nil)
  344.80 +  (evaluates-to-itself? :test)
  344.81 +  ; Boolean literals should evaluate to Boolean.{TRUE|FALSE}
  344.82 +  (is (identical? (eval true) Boolean/TRUE))
  344.83 +  (is (identical? (eval false) Boolean/FALSE)))
  344.84 +
  344.85 +;;; Symbol resolution tests ;;;
  344.86 +
  344.87 +(def foo "abc")
  344.88 +(in-ns 'resolution-test)
  344.89 +(def bar 123)
  344.90 +(def #^{:private true} baz 456)
  344.91 +(in-ns 'clojure.test-clojure.evaluation)
  344.92 +
  344.93 +(defn a-match? [re s] (not (nil? (re-matches re s))))
  344.94 +
  344.95 +(defmacro throws-with-msg
  344.96 +  ([re form] `(throws-with-msg ~re ~form Exception))
  344.97 +  ([re form x] `(throws-with-msg
  344.98 +                  ~re
  344.99 +                  ~form
 344.100 +                  ~(if (instance? Exception x) x Exception)
 344.101 +                  ~(if (instance? String x) x nil)))
 344.102 +  ([re form class msg]
 344.103 +       `(let [ex# (try
 344.104 +                    ~form
 344.105 +                    (catch ~class e# e#)
 344.106 +                    (catch Exception e#
 344.107 +                      (let [cause# (.getCause e#)]
 344.108 +                        (if (= ~class (class cause#)) cause# (throw e#)))))]
 344.109 +          (is (a-match? ~re (.toString ex#))
 344.110 +              (or ~msg
 344.111 +                  (str "Expected exception that matched " (pr-str ~re)
 344.112 +                       ", but got exception with message: \"" ex#))))))
 344.113 +
 344.114 +(deftest SymbolResolution
 344.115 +  (test-that
 344.116 +    "If a symbol is namespace-qualified, the evaluated value is the value
 344.117 +     of the binding of the global var named by the symbol"
 344.118 +    (is (= (eval 'resolution-test/bar) 123)))
 344.119 +
 344.120 +  (test-that
 344.121 +    "It is an error if there is no global var named by the symbol"
 344.122 +    (throws-with-msg
 344.123 +      #".*Unable to resolve symbol: bar.*" (eval 'bar)))
 344.124 +
 344.125 +  (test-that
 344.126 +    "It is an error if the symbol reference is to a non-public var in a
 344.127 +    different namespace"
 344.128 +    (throws-with-msg
 344.129 +      #".*resolution-test/baz is not public.*"
 344.130 +      (eval 'resolution-test/baz)
 344.131 +      Compiler$CompilerException))
 344.132 +
 344.133 +  (test-that
 344.134 +    "If a symbol is package-qualified, its value is the Java class named by the
 344.135 +    symbol"
 344.136 +    (is (= (eval 'java.lang.Math) (class-for-name "java.lang.Math"))))
 344.137 +
 344.138 +  (test-that
 344.139 +    "If a symbol is package-qualified, it is an error if there is no Class named
 344.140 +    by the symbol"
 344.141 +    (is (thrown? Compiler$CompilerException (eval 'java.lang.FooBar))))
 344.142 +
 344.143 +  (test-that
 344.144 +    "If a symbol is not qualified, the following applies, in this order:
 344.145 +
 344.146 +      1. If it names a special form it is considered a special form, and must
 344.147 +         be utilized accordingly.
 344.148 +
 344.149 +      2. A lookup is done in the current namespace to see if there is a mapping
 344.150 +         from the symbol to a class. If so, the symbol is considered to name a
 344.151 +         Java class object.
 344.152 +
 344.153 +      3. If in a local scope (i.e. in a function definition), a lookup is done
 344.154 +         to see if it names a local binding (e.g. a function argument or
 344.155 +         let-bound name). If so, the value is the value of the local binding.
 344.156 +
 344.157 +      4. A lookup is done in the current namespace to see if there is a mapping
 344.158 +         from the symbol to a var. If so, the value is the value of the binding
 344.159 +         of the var referred-to by the symbol.
 344.160 +
 344.161 +      5. It is an error."
 344.162 +
 344.163 +    ; First
 344.164 +    (doall (for [form '(def if do let quote var fn loop recur throw try
 344.165 +                         monitor-enter monitor-exit)]
 344.166 +             (is (thrown? Compiler$CompilerException (eval form)))))
 344.167 +    (let [if "foo"]
 344.168 +      (is (thrown? Compiler$CompilerException (eval 'if)))
 344.169 +
 344.170 +    ; Second
 344.171 +      (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean"))))
 344.172 +    (let [Boolean "foo"]
 344.173 +      (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean"))))
 344.174 +
 344.175 +    ; Third
 344.176 +    (is (= (eval '(let [foo "bar"] foo)) "bar"))
 344.177 +
 344.178 +    ; Fourth
 344.179 +    (in-test-ns (is (= (eval 'foo) "abc")))
 344.180 +    (is (thrown? Compiler$CompilerException (eval 'bar))) ; not in this namespace
 344.181 +
 344.182 +    ; Fifth
 344.183 +    (is (thrown? Compiler$CompilerException (eval 'foobar)))))
 344.184 +
 344.185 +;;; Metadata tests ;;;
 344.186 +
 344.187 +(defstruct struct-with-symbols (with-meta 'k {:a "A"}))
 344.188 +
 344.189 +(deftest Metadata
 344.190 +
 344.191 +  (test-that
 344.192 +    "find returns key symbols and their metadata"
 344.193 +    (let [s (struct struct-with-symbols 1)]
 344.194 +      (is (= {:a "A"} (meta (first (find s 'k))))))))
 344.195 +
 344.196 +;;; Collections tests ;;;
 344.197 +(def x 1)
 344.198 +(def y 2)
 344.199 +
 344.200 +(deftest Collections
 344.201 +  (in-test-ns
 344.202 +    (test-that
 344.203 +      "Vectors and Maps yield vectors and (hash) maps whose contents are the
 344.204 +      evaluated values of the objects they contain."
 344.205 +      (is (= (eval '[x y 3]) [1 2 3]))
 344.206 +      (is (= (eval '{:x x :y y :z 3}) {:x 1 :y 2 :z 3}))
 344.207 +      (is (instance? clojure.lang.IPersistentMap (eval '{:x x :y y})))))
 344.208 +
 344.209 +  (in-test-ns
 344.210 +    (test-that
 344.211 +      "Metadata maps yield maps whose contents are the evaluated values of
 344.212 +      the objects they contain. If a vector or map has metadata, the evaluated
 344.213 +      metadata map will become the metadata of the resulting value."
 344.214 +      (is (= (eval #^{:x x} '[x y]) #^{:x 1} [1 2]))))
 344.215 +
 344.216 +  (test-that
 344.217 +    "An empty list () evaluates to an empty list."
 344.218 +    (is (= (eval '()) ()))
 344.219 +    (is (empty? (eval ())))
 344.220 +    (is (= (eval (list)) ())))
 344.221 +
 344.222 +  (test-that
 344.223 +    "Non-empty lists are considered calls"
 344.224 +    (is (thrown? Compiler$CompilerException (eval '(1 2 3))))))
 344.225 +
 344.226 +(deftest Macros)
 344.227 +
 344.228 +(deftest Loading)
   345.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   345.2 +++ b/src/clojure/test_clojure/for.clj	Sat Aug 21 06:25:44 2010 -0400
   345.3 @@ -0,0 +1,128 @@
   345.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   345.5 +;   The use and distribution terms for this software are covered by the
   345.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   345.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   345.8 +;   By using this software in any fashion, you are agreeing to be bound by
   345.9 +;   the terms of this license.
  345.10 +;   You must not remove this notice, or any other, from this software.
  345.11 +
  345.12 +;;  Tests for the Clojure 'for' macro
  345.13 +;;
  345.14 +;;  by Chouser
  345.15 +;;  Created Dec 2008
  345.16 +
  345.17 +(ns clojure.test-clojure.for
  345.18 +  (:use clojure.test))
  345.19 +
  345.20 +(deftest Docstring-Example
  345.21 +  (is (= (take 100 (for [x (range 100000000)
  345.22 +                         y (range 1000000) :while (< y x)]
  345.23 +                     [x y]))
  345.24 +         '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2] [4 0] [4 1] [4 2] [4 3]
  345.25 +           [5 0] [5 1] [5 2] [5 3] [5 4]
  345.26 +           [6 0] [6 1] [6 2] [6 3] [6 4] [6 5]
  345.27 +           [7 0] [7 1] [7 2] [7 3] [7 4] [7 5] [7 6]
  345.28 +           [8 0] [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7]
  345.29 +           [9 0] [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8]
  345.30 +           [10 0] [10 1] [10 2] [10 3] [10 4] [10 5] [10 6] [10 7] [10 8] [10 9]
  345.31 +           [11 0] [11 1] [11 2] [11 3] [11 4] [11 5] [11 6] [11 7] [11 8] [11 9]
  345.32 +             [11 10]
  345.33 +           [12 0] [12 1] [12 2] [12 3] [12 4] [12 5] [12 6] [12 7] [12 8] [12 9]
  345.34 +             [12 10] [12 11]
  345.35 +           [13 0] [13 1] [13 2] [13 3] [13 4] [13 5] [13 6] [13 7] [13 8] [13 9]
  345.36 +             [13 10] [13 11] [13 12]
  345.37 +           [14 0] [14 1] [14 2] [14 3] [14 4] [14 5] [14 6] [14 7] [14 8]))))
  345.38 +
  345.39 +(defmacro deftest-both [txt & ises]
  345.40 +  `(do
  345.41 +     (deftest ~(symbol (str "For-" txt)) ~@ises)
  345.42 +     (deftest ~(symbol (str "Doseq-" txt))
  345.43 +              ~@(map (fn [[x-is [x-= [x-for binds body] value]]]
  345.44 +                       (when (and (= x-is 'is) (= x-= '=) (= x-for 'for))
  345.45 +                         `(is (= (let [acc# (atom [])]
  345.46 +                                   (doseq ~binds (swap! acc# conj ~body))
  345.47 +                                   @acc#)
  345.48 +                                 ~value))))
  345.49 +                     ises))))
  345.50 +
  345.51 +(deftest-both When
  345.52 +  (is (= (for [x (range 10) :when (odd? x)] x) '(1 3 5 7 9)))
  345.53 +  (is (= (for [x (range 4) y (range 4) :when (odd? y)] [x y])
  345.54 +         '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3])))
  345.55 +  (is (= (for [x (range 4) y (range 4) :when (odd? x)] [x y])
  345.56 +         '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3])))
  345.57 +  (is (= (for [x (range 4) :when (odd? x) y (range 4)] [x y])
  345.58 +         '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3])))
  345.59 +  (is (= (for [x (range 5) y (range 5) :when (< x y)] [x y])
  345.60 +         '([0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4]))))
  345.61 +
  345.62 +(defn only
  345.63 +  "Returns a lazy seq of increasing ints starting at 0.  Trying to get
  345.64 +  the nth+1 value of the seq throws an exception.  This is meant to
  345.65 +  help detecting over-eagerness in lazy seq consumers."
  345.66 +  [n]
  345.67 +  (lazy-cat (range n)
  345.68 +            (throw (Exception. "consumer went too far in lazy seq"))))
  345.69 +
  345.70 +(deftest-both While
  345.71 +  (is (= (for [x (only 6) :while (< x 5)] x) '(0 1 2 3 4)))
  345.72 +  (is (= (for [x (range 4) y (only 4) :while (< y 3)] [x y])
  345.73 +         '([0 0] [0 1] [0 2] [1 0] [1 1] [1 2]
  345.74 +           [2 0] [2 1] [2 2] [3 0] [3 1] [3 2])))
  345.75 +  (is (= (for [x (range 4) y (range 4) :while (< x 3)] [x y])
  345.76 +         '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3]
  345.77 +           [2 0] [2 1] [2 2] [2 3])))
  345.78 +  (is (= (for [x (only 4) :while (< x 3) y (range 4)] [x y])
  345.79 +         '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3]
  345.80 +           [2 0] [2 1] [2 2] [2 3])))
  345.81 +  (is (= (for [x (range 4) y (range 4) :while (even? x)] [x y])
  345.82 +         '([0 0] [0 1] [0 2] [0 3] [2 0] [2 1] [2 2] [2 3])))
  345.83 +  (is (= (for [x (only 2) :while (even? x) y (range 4)] [x y])
  345.84 +         '([0 0] [0 1] [0 2] [0 3])))
  345.85 +  (is (= (for [x (range 4) y (only 4) :while (< y x)] [x y])
  345.86 +         '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2]))))
  345.87 +
  345.88 +(deftest-both While-and-When
  345.89 +  (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? y)] [x y])
  345.90 +         '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3] [4 1] [4 3])))
  345.91 +  (is (= (for [x (range 4) :when (odd? x) y (only 6) :while (< y 5)] [x y])
  345.92 +         '([1 0] [1 1] [1 2] [1 3] [1 4] [3 0] [3 1] [3 2] [3 3] [3 4])))
  345.93 +  (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? (+ x y))]
  345.94 +           [x y])
  345.95 +         '([0 1] [0 3] [1 0] [1 2] [2 1] [2 3] [3 0] [3 2] [4 1] [4 3])))
  345.96 +  (is (= (for [x (range 4) :when (odd? x) y (only 2) :while (odd? (+ x y))]
  345.97 +           [x y])
  345.98 +         '([1 0] [3 0]))))
  345.99 +
 345.100 +(deftest-both While-and-When-Same-Binding
 345.101 +  (is (= (for [x (only 6) :while (< x 5) :when (odd? x)] x) '(1 3)))
 345.102 +  (is (= (for [x (only 6)
 345.103 +               :while (< x 5) ; if :while is false, :when should not be evaled
 345.104 +               :when (do (if (< x 5) (odd? x)))] x) '(1 3)))
 345.105 +  (is (= (for [a (range -2 5)
 345.106 +               :when (not= a 0) ; :when may guard :while
 345.107 +               :while (> (Math/abs (/ 1.0 a)) 1/3)] a) '(-2 -1 1 2))))
 345.108 +
 345.109 +(deftest-both Nesting
 345.110 +  (is (= (for [x '(a b) y (interpose x '(1 2)) z (list x y)] [x y z])
 345.111 +         '([a 1 a] [a 1 1] [a a a] [a a a] [a 2 a] [a 2 2]
 345.112 +           [b 1 b] [b 1 1] [b b b] [b b b] [b 2 b] [b 2 2])))
 345.113 +  (is (= (for [x ['a nil] y [x 'b]] [x y])
 345.114 +         '([a a] [a b] [nil nil] [nil b]))))
 345.115 +
 345.116 +(deftest-both Destructuring
 345.117 +  (is (= (for [{:syms [a b c]} (map #(zipmap '(a b c) (range % 5)) (range 3))
 345.118 +               x [a b c]]
 345.119 +           (Integer. (str a b c x)))
 345.120 +         '(120 121 122 1231 1232 1233 2342 2343 2344))))
 345.121 +
 345.122 +(deftest-both Let
 345.123 +  (is (= (for [x (range 3) y (range 3) :let [z (+ x y)] :when (odd? z)] [x y z])
 345.124 +         '([0 1 1] [1 0 1] [1 2 3] [2 1 3])))
 345.125 +  (is (= (for [x (range 6) :let [y (rem x 2)] :when (even? y) z [8 9]] [x z])
 345.126 +         '([0 8] [0 9] [2 8] [2 9] [4 8] [4 9]))))
 345.127 +
 345.128 +; :while must skip all subsequent chunks as well as the remainder of
 345.129 +; the current chunk:
 345.130 +(deftest-both Chunked-While
 345.131 +  (is (= (for [x (range 100) :while (even? x)] x) '(0))))
   346.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   346.2 +++ b/src/clojure/test_clojure/genclass.clj	Sat Aug 21 06:25:44 2010 -0400
   346.3 @@ -0,0 +1,65 @@
   346.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   346.5 +;   The use and distribution terms for this software are covered by the
   346.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   346.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   346.8 +;   By using this software in any fashion, you are agreeing to be bound by
   346.9 +;   the terms of this license.
  346.10 +;   You must not remove this notice, or any other, from this software.
  346.11 +
  346.12 +(ns ^{:doc "Tests for clojure.core/gen-class"
  346.13 +      :author "Stuart Halloway, Daniel Solano Gómez"}
  346.14 +  clojure.test-clojure.genclass
  346.15 +  (:use clojure.test clojure.test-clojure.helpers)
  346.16 +  (:import [clojure.test_clojure.genclass.examples ExampleClass
  346.17 +                                                   ExampleAnnotationClass]
  346.18 +           [java.lang.annotation ElementType
  346.19 +                                 Retention
  346.20 +                                 RetentionPolicy
  346.21 +                                 Target]))
  346.22 +
  346.23 +(deftest arg-support
  346.24 +  (let [example (ExampleClass.)
  346.25 +        o (Object.)]
  346.26 +    (is (= "foo with o, o" (.foo example o o)))
  346.27 +    (is (= "foo with o, i" (.foo example o (int 1))))
  346.28 +    (is (thrown? java.lang.UnsupportedOperationException (.foo example o)))))
  346.29 +
  346.30 +(deftest name-munging
  346.31 +  (testing "mapping from Java fields to Clojure vars"
  346.32 +    (is (= #'clojure.test-clojure.genclass.examples/-foo-Object-int
  346.33 +           (get-field ExampleClass 'foo_Object_int__var)))
  346.34 +    (is (= #'clojure.test-clojure.genclass.examples/-toString
  346.35 +           (get-field ExampleClass 'toString__var)))))
  346.36 +
  346.37 +(deftest test-annotations
  346.38 +  (let [annot-class ExampleAnnotationClass
  346.39 +        foo-method          (.getDeclaredMethod annot-class "foo" (into-array [String]))]
  346.40 +    (testing "Class annotations:"
  346.41 +      (is (= 2 (count (.getDeclaredAnnotations annot-class))))
  346.42 +      (testing "@Deprecated"
  346.43 +        (let [deprecated (.getAnnotation annot-class Deprecated)]
  346.44 +          (is deprecated)))
  346.45 +      (testing "@Target([])"
  346.46 +        (let [resource (.getAnnotation annot-class Target)]
  346.47 +          (is (= 0 (count (.value resource)))))))
  346.48 +    (testing "Method annotations:"
  346.49 +      (testing "@Deprecated void foo(String):"
  346.50 +        (is (= 1 (count (.getDeclaredAnnotations foo-method))))
  346.51 +        (is (.getAnnotation foo-method Deprecated))))
  346.52 +    (testing "Parameter annotations:"
  346.53 +      (let [param-annots (.getParameterAnnotations foo-method)]
  346.54 +        (is (= 1 (alength param-annots)))
  346.55 +        (let [first-param-annots (aget param-annots 0)]
  346.56 +          (is (= 2 (alength first-param-annots)))
  346.57 +          (testing "void foo(@Retention(…) String)"
  346.58 +            (let [retention (aget first-param-annots 0)]
  346.59 +              (is (instance? Retention retention))
  346.60 +              (= RetentionPolicy/SOURCE (.value retention))))
  346.61 +          (testing "void foo(@Target(…) String)"
  346.62 +            (let [target (aget first-param-annots 1)]
  346.63 +              (is (instance? Target target))
  346.64 +              (is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target)))))))))))
  346.65 +
  346.66 +(deftest genclass-option-validation
  346.67 +  (is (fails-with-cause? IllegalArgumentException #"Not a valid method name: has-hyphen"
  346.68 +        (@#'clojure.core/validate-generate-class-options {:methods '[[fine [] void] [has-hyphen [] void]]}))))
   347.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   347.2 +++ b/src/clojure/test_clojure/genclass/examples.clj	Sat Aug 21 06:25:44 2010 -0400
   347.3 @@ -0,0 +1,42 @@
   347.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   347.5 +;   The use and distribution terms for this software are covered by the
   347.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   347.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   347.8 +;   By using this software in any fashion, you are agreeing to be bound by
   347.9 +;   the terms of this license.
  347.10 +;   You must not remove this notice, or any other, from this software.
  347.11 +
  347.12 +(ns ^{:doc "Test classes that are AOT-compile for the tests in
  347.13 +           clojure.test-clojure.genclass."
  347.14 +      :author "Stuart Halloway, Daniel Solano Gómez"}
  347.15 +  clojure.test-clojure.genclass.examples)
  347.16 +
  347.17 +(definterface ExampleInterface
  347.18 +  (foo [a])
  347.19 +  (foo [a b])
  347.20 +  (foo [a #^int b]))
  347.21 +
  347.22 +(gen-class :name clojure.test_clojure.genclass.examples.ExampleClass
  347.23 +           :implements [clojure.test_clojure.genclass.examples.ExampleInterface])
  347.24 +
  347.25 +;; -foo-Object unimplemented to test missing fn case
  347.26 +
  347.27 +(defn -foo-Object-Object
  347.28 +  [_ o1 o2]
  347.29 +  "foo with o, o")
  347.30 +
  347.31 +(defn -foo-Object-int
  347.32 +  [_ o i]
  347.33 +  "foo with o, i")
  347.34 +
  347.35 +(gen-class :name ^{Deprecated {}
  347.36 +                   SuppressWarnings ["Warning1"] ; discarded
  347.37 +                   java.lang.annotation.Target []}
  347.38 +                 clojure.test_clojure.genclass.examples.ExampleAnnotationClass
  347.39 +           :prefix "annot-"
  347.40 +           :methods [[^{Deprecated {}
  347.41 +                        Override {}} ;discarded
  347.42 +                      foo [^{java.lang.annotation.Retention java.lang.annotation.RetentionPolicy/SOURCE
  347.43 +                             java.lang.annotation.Target    [java.lang.annotation.ElementType/TYPE
  347.44 +                                                             java.lang.annotation.ElementType/PARAMETER]}
  347.45 +                           String] void]])
   348.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   348.2 +++ b/src/clojure/test_clojure/helpers.clj	Sat Aug 21 06:25:44 2010 -0400
   348.3 @@ -0,0 +1,86 @@
   348.4 +;   The use and distribution terms for this software are covered by the
   348.5 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   348.6 +;   which can be found in the file epl-v10.html at the root of this distribution.
   348.7 +;   By using this software in any fashion, you are agreeing to be bound by
   348.8 +;   the terms of this license.
   348.9 +;   You must not remove this notice, or any other, from this software.
  348.10 +
  348.11 +; Author: Stuart Halloway
  348.12 +
  348.13 +(ns clojure.test-clojure.helpers
  348.14 +  (:use clojure.test))
  348.15 +
  348.16 +(defn temp-ns
  348.17 +  "Create and return a temporary ns, using clojure.core + uses"
  348.18 +  [& uses]
  348.19 +  (binding [*ns* *ns*]
  348.20 +    (in-ns (gensym))
  348.21 +    (apply clojure.core/use 'clojure.core uses)
  348.22 +    *ns*))
  348.23 +
  348.24 +(defmacro eval-in-temp-ns [& forms]
  348.25 +  `(binding [*ns* *ns*]
  348.26 +     (in-ns (gensym))
  348.27 +     (clojure.core/use 'clojure.core)
  348.28 +     (eval
  348.29 +      '(do ~@forms))))
  348.30 +
  348.31 +(defn causes
  348.32 +  [^Throwable throwable]
  348.33 +  (loop [causes []
  348.34 +         t throwable]
  348.35 +    (if t (recur (conj causes t) (.getCause t)) causes)))
  348.36 +
  348.37 +;; this is how I wish clojure.test/thrown? worked...
  348.38 +;; Does body throw expected exception, anywhere in the .getCause chain?
  348.39 +(defmethod assert-expr 'fails-with-cause?
  348.40 +  [msg [_ exception-class msg-re & body :as form]]
  348.41 +  `(try
  348.42 +   ~@body
  348.43 +   (report {:type :fail, :message ~msg, :expected '~form, :actual nil})
  348.44 +   (catch Throwable t#
  348.45 +     (if (some (fn [cause#]
  348.46 +                 (and
  348.47 +                  (= ~exception-class (class cause#))
  348.48 +                  (re-find ~msg-re (.getMessage cause#))))
  348.49 +               (causes t#))
  348.50 +       (report {:type :pass, :message ~msg,
  348.51 +                :expected '~form, :actual t#})
  348.52 +       (report {:type :fail, :message ~msg,
  348.53 +                :expected '~form, :actual t#})))))
  348.54 +
  348.55 +
  348.56 +(defn get-field
  348.57 +  "Access to private or protected field.  field-name is a symbol or
  348.58 +  keyword."
  348.59 +  ([klass field-name]
  348.60 +     (get-field klass field-name nil))
  348.61 +  ([klass field-name inst]
  348.62 +     (-> klass (.getDeclaredField (name field-name))
  348.63 +         (doto (.setAccessible true))
  348.64 +         (.get inst))))
  348.65 +
  348.66 +(defn set-var-roots
  348.67 +  [maplike]
  348.68 +  (doseq [[var val] maplike]
  348.69 +    (alter-var-root var (fn [_] val))))
  348.70 +
  348.71 +(defn with-var-roots*
  348.72 +  "Temporarily set var roots, run block, then put original roots back."
  348.73 +  [root-map f & args]
  348.74 +  (let [originals (doall (map (fn [[var _]] [var @var]) root-map))]
  348.75 +    (set-var-roots root-map)
  348.76 +    (try
  348.77 +     (apply f args)
  348.78 +     (finally
  348.79 +      (set-var-roots originals)))))
  348.80 +
  348.81 +(defmacro with-var-roots
  348.82 +  [root-map & body]
  348.83 +  `(with-var-roots* ~root-map (fn [] ~@body)))
  348.84 +
  348.85 +(defn exception
  348.86 +  "Use this function to ensure that execution of a program doesn't
  348.87 +  reach certain point."
  348.88 +  []
  348.89 +  (throw (new Exception "Exception which should never occur")))
   349.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   349.2 +++ b/src/clojure/test_clojure/java/io.clj	Sat Aug 21 06:25:44 2010 -0400
   349.3 @@ -0,0 +1,206 @@
   349.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   349.5 +;   The use and distribution terms for this software are covered by the
   349.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   349.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   349.8 +;   By using this software in any fashion, you are agreeing to be bound by
   349.9 +;   the terms of this license.
  349.10 +;   You must not remove this notice, or any other, from this software.
  349.11 +
  349.12 +(ns clojure.test-clojure.java.io
  349.13 +  (:use clojure.test clojure.java.io)
  349.14 +  (:import (java.io File BufferedInputStream
  349.15 +                    FileInputStream InputStreamReader InputStream
  349.16 +                    FileOutputStream OutputStreamWriter OutputStream
  349.17 +                    ByteArrayInputStream ByteArrayOutputStream)
  349.18 +           (java.net URL URI Socket ServerSocket)))
  349.19 +
  349.20 +(defn temp-file
  349.21 +  [prefix suffix]
  349.22 +  (doto (File/createTempFile prefix suffix)
  349.23 +    (.deleteOnExit)))
  349.24 +
  349.25 +(deftest test-spit-and-slurp
  349.26 +  (let [f (temp-file "clojure.java.io" "test")]
  349.27 +    (spit f "foobar")
  349.28 +    (is (= "foobar" (slurp f)))
  349.29 +    (spit f "foobar" :encoding "UTF-16")
  349.30 +    (is (= "foobar" (slurp f :encoding "UTF-16")))
  349.31 +    (testing "deprecated arity"
  349.32 +      (is (=
  349.33 +           "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).\n"
  349.34 +           (with-out-str
  349.35 +             (is (= "foobar" (slurp f "UTF-16")))))))))
  349.36 +  
  349.37 +(deftest test-streams-defaults
  349.38 +  (let [f (temp-file "clojure.java.io" "test-reader-writer")
  349.39 +        content "testing"]
  349.40 +    (try
  349.41 +      (is (thrown? Exception (reader (Object.))))
  349.42 +      (is (thrown? Exception (writer (Object.))))
  349.43 +
  349.44 +      (are [write-to read-from] (= content (do
  349.45 +                                             (spit write-to content :encoding "UTF-8")
  349.46 +                                             (slurp read-from :encoding "UTF-8")))
  349.47 +           f f
  349.48 +           (.getAbsolutePath f) (.getAbsolutePath f)
  349.49 +           (.toURL f) (.toURL f)
  349.50 +           (.toURI f) (.toURI f)
  349.51 +           (FileOutputStream. f) (FileInputStream. f)
  349.52 +           (OutputStreamWriter. (FileOutputStream. f) "UTF-8") (reader f :encoding "UTF-8")
  349.53 +           f (FileInputStream. f)
  349.54 +           (writer f :encoding "UTF-8") (InputStreamReader. (FileInputStream. f) "UTF-8"))
  349.55 +
  349.56 +      (is (= content (slurp (.getBytes content "UTF-8"))))
  349.57 +      (is (= content (slurp (.toCharArray content))))
  349.58 +      (finally
  349.59 +       (.delete f)))))
  349.60 +
  349.61 +(defn bytes-should-equal [byte-array-1 byte-array-2 msg]
  349.62 +  (is (= @#'clojure.java.io/byte-array-type (class byte-array-1) (class byte-array-2)) msg)
  349.63 +  (is (= (into []  byte-array-1) (into []  byte-array-2)) msg))
  349.64 +
  349.65 +(defn data-fixture
  349.66 +  "in memory fixture data for tests"
  349.67 +  [encoding]
  349.68 +  (let [bs (.getBytes "hello" encoding)
  349.69 +        cs (.toCharArray "hello")
  349.70 +        i (ByteArrayInputStream. bs)
  349.71 +        r (InputStreamReader. i)
  349.72 +        o (ByteArrayOutputStream.)
  349.73 +        w (OutputStreamWriter. o)]
  349.74 +    {:bs bs
  349.75 +     :i i
  349.76 +     :r r
  349.77 +     :o o
  349.78 +     :s "hello"
  349.79 +     :cs cs
  349.80 +     :w w}))
  349.81 +
  349.82 +(deftest test-copy
  349.83 +  (dorun
  349.84 +   (for [{:keys [in out flush] :as test}
  349.85 +         [{:in :i :out :o}
  349.86 +          {:in :i :out :w}
  349.87 +          {:in :r :out :o}
  349.88 +          {:in :r :out :w}
  349.89 +          {:in :cs :out :o}
  349.90 +          {:in :cs :out :w}
  349.91 +          {:in :bs :out :o}
  349.92 +          {:in :bs :out :w}]
  349.93 +         
  349.94 +         opts
  349.95 +         [{} {:buffer-size 256}]]
  349.96 +     (let [{:keys [s o] :as d} (data-fixture "UTF-8")]
  349.97 +       (apply copy (in d) (out d) (flatten (vec opts)))
  349.98 +       #_(when (= out :w) (.flush (:w d)))
  349.99 +       (.flush (out d))
 349.100 +       (bytes-should-equal (.getBytes s "UTF-8")
 349.101 +                           (.toByteArray o)
 349.102 +                           (str "combination " test opts))))))
 349.103 +
 349.104 +(deftest test-copy-encodings
 349.105 +  (testing "from inputstream UTF-16 to writer UTF-8"
 349.106 +    (let [{:keys [i s o w bs]} (data-fixture "UTF-16")]
 349.107 +      (copy i w :encoding "UTF-16")
 349.108 +      (.flush w)
 349.109 +      (bytes-should-equal (.getBytes s "UTF-8") (.toByteArray o) "")))
 349.110 +  (testing "from reader UTF-8 to output-stream UTF-16"
 349.111 +    (let [{:keys [r o s]} (data-fixture "UTF-8")]
 349.112 +      (copy r o :encoding "UTF-16")
 349.113 +      (bytes-should-equal (.getBytes s "UTF-16") (.toByteArray o) ""))))
 349.114 +
 349.115 +(deftest test-as-file
 349.116 +  (are [result input] (= result (as-file input))
 349.117 +       (File. "foo") "foo"
 349.118 +       (File. "bar") (File. "bar")
 349.119 +       (File. "baz") (URL. "file:baz")
 349.120 +       (File. "quux") (URI. "file:quux")
 349.121 +       nil nil))
 349.122 +
 349.123 +(deftest test-file
 349.124 +  (are [result args] (= (File. result) (apply file args))
 349.125 +       "foo" ["foo"]
 349.126 +       "foo/bar" ["foo" "bar"]
 349.127 +       "foo/bar/baz" ["foo" "bar" "baz"]))
 349.128 +(deftest test-as-url
 349.129 +  (are [file-part input] (= (URL. (str "file:" file-part)) (as-url input))
 349.130 +       "foo" "file:foo"
 349.131 +       "baz" (URL. "file:baz")
 349.132 +       "quux" (URI. "file:quux"))
 349.133 +  (is (nil? (as-url nil))))
 349.134 +
 349.135 +(deftest test-delete-file
 349.136 +  (let [file (temp-file "test" "deletion")
 349.137 +        not-file (File. (str (java.util.UUID/randomUUID)))]
 349.138 +    (delete-file (.getAbsolutePath file))
 349.139 +    (is (not (.exists file)))
 349.140 +    (is (thrown? java.io.IOException (delete-file not-file)))
 349.141 +    (is (= :silently (delete-file not-file :silently)))))
 349.142 +
 349.143 +(deftest test-as-relative-path
 349.144 +  (testing "strings"
 349.145 +    (is (= "foo" (as-relative-path "foo"))))
 349.146 +  (testing "absolute path strings are forbidden"
 349.147 +    (is (thrown? IllegalArgumentException (as-relative-path (.getAbsolutePath (File. "baz"))))))
 349.148 +  (testing "relative File paths"
 349.149 +    (is (= "bar" (as-relative-path (File. "bar")))))
 349.150 +  (testing "absolute File paths are forbidden"
 349.151 +    (is (thrown? IllegalArgumentException (as-relative-path (File. (.getAbsolutePath (File. "quux"))))))))
 349.152 +
 349.153 +(defn stream-should-have [stream expected-bytes msg]
 349.154 +  (let [actual-bytes (byte-array (alength expected-bytes))]
 349.155 +    (.read stream actual-bytes)
 349.156 +    (is (= -1 (.read stream)) (str msg " : should be end of stream"))
 349.157 +    (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match"))))
 349.158 +
 349.159 +(deftest test-input-stream
 349.160 +  (let [file (temp-file "test-input-stream" "txt")
 349.161 +        bytes (.getBytes "foobar")]
 349.162 +    (spit file "foobar")
 349.163 +    (doseq [[expr msg]
 349.164 +            [[file File]
 349.165 +             [(FileInputStream. file) FileInputStream]
 349.166 +             [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream]
 349.167 +             [(.. file toURI) URI]
 349.168 +             [(.. file toURI toURL) URL]
 349.169 +             [(.. file toURI toURL toString) "URL as String"]
 349.170 +             [(.. file toString) "File as String"]]]
 349.171 +      (with-open [s (input-stream expr)]
 349.172 +        (stream-should-have s bytes msg)))))
 349.173 +
 349.174 +(deftest test-streams-buffering
 349.175 +  (let [data (.getBytes "")]
 349.176 +    (is (instance? java.io.BufferedReader (reader data)))
 349.177 +    (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.))))
 349.178 +    (is (instance? java.io.BufferedInputStream (input-stream data)))
 349.179 +    (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.))))))
 349.180 +
 349.181 +(deftest test-resource
 349.182 +  (is (nil? (resource "non/existent/resource")))
 349.183 +  (is (instance? URL (resource "clojure/core.clj")))
 349.184 +  (let [file (temp-file "test-resource" "txt")
 349.185 +        url (as-url (.getParentFile file))
 349.186 +        loader (java.net.URLClassLoader. (into-array [url]))]
 349.187 +    (is (nil? (resource "non/existent/resource" loader)))
 349.188 +    (is (instance? URL (resource (.getName file) loader)))))
 349.189 +
 349.190 +(deftest test-make-parents
 349.191 +  (let [tmp (System/getProperty "java.io.tmpdir")]
 349.192 +    (delete-file (file tmp "test-make-parents" "child" "grandchild") :silently)
 349.193 +    (delete-file (file tmp "test-make-parents" "child") :silently)
 349.194 +    (delete-file (file tmp "test-make-parents") :silently)
 349.195 +    (make-parents tmp "test-make-parents" "child" "grandchild")
 349.196 +    (is (.isDirectory (file tmp "test-make-parents" "child")))
 349.197 +    (is (not (.isDirectory (file tmp "test-make-parents" "child" "grandchild"))))
 349.198 +    (delete-file (file tmp "test-make-parents" "child"))
 349.199 +    (delete-file (file tmp "test-make-parents"))))
 349.200 +
 349.201 +(deftest test-socket-iofactory
 349.202 +  (let [port 65321
 349.203 +        server-socket (ServerSocket. port)
 349.204 +        client-socket (Socket. "localhost" port)]
 349.205 +    (try
 349.206 +      (is (instance? InputStream (input-stream client-socket)))
 349.207 +      (is (instance? OutputStream (output-stream client-socket)))
 349.208 +      (finally (.close server-socket)
 349.209 +               (.close client-socket)))))
   350.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   350.2 +++ b/src/clojure/test_clojure/java/javadoc.clj	Sat Aug 21 06:25:44 2010 -0400
   350.3 @@ -0,0 +1,22 @@
   350.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   350.5 +;   The use and distribution terms for this software are covered by the
   350.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   350.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   350.8 +;   By using this software in any fashion, you are agreeing to be bound by
   350.9 +;   the terms of this license.
  350.10 +;   You must not remove this notice, or any other, from this software.
  350.11 +
  350.12 +(ns clojure.test-clojure.java.javadoc
  350.13 +  (:use clojure.test
  350.14 +	[clojure.java.javadoc :as j])
  350.15 +  (:import (java.io File)))
  350.16 +
  350.17 +(deftest javadoc-url-test
  350.18 +  (testing "for a core api"
  350.19 +    (binding [*feeling-lucky* false]
  350.20 +      (are [x y] (= x (#'j/javadoc-url y))
  350.21 +           nil "foo.Bar"
  350.22 +           (str *core-java-api* "java/lang/String.html") "java.lang.String")))
  350.23 +  (testing "for a remote javadoc"
  350.24 +    (binding [*remote-javadocs* (ref (sorted-map "java." "http://example.com/"))]
  350.25 +      (is (= "http://example.com/java/lang/Number.html" (#'j/javadoc-url "java.lang.Number"))))))
   351.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   351.2 +++ b/src/clojure/test_clojure/java/shell.clj	Sat Aug 21 06:25:44 2010 -0400
   351.3 @@ -0,0 +1,41 @@
   351.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   351.5 +;   The use and distribution terms for this software are covered by the
   351.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   351.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   351.8 +;   By using this software in any fashion, you are agreeing to be bound by
   351.9 +;   the terms of this license.
  351.10 +;   You must not remove this notice, or any other, from this software.
  351.11 +
  351.12 +(ns clojure.test-clojure.java.shell
  351.13 +  (:use clojure.test
  351.14 +	[clojure.java.shell :as sh])
  351.15 +  (:import (java.io File)))
  351.16 +
  351.17 +(def platform-enc (.name (java.nio.charset.Charset/defaultCharset)))
  351.18 +(def default-enc "UTF-8")
  351.19 +
  351.20 +(deftest test-parse-args
  351.21 +  (are [x y] (= x y)
  351.22 +       [[] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args [])
  351.23 +       [["ls"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls"])
  351.24 +       [["ls" "-l"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"])
  351.25 +       [["ls"] {:in-enc default-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "ISO-8859-1"])
  351.26 +       [[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args [:in-enc platform-enc :out-enc platform-enc])))
  351.27 +  
  351.28 +(deftest test-with-sh-dir
  351.29 +  (are [x y] (= x y)
  351.30 +    nil *sh-dir*
  351.31 +    "foo" (with-sh-dir "foo" *sh-dir*)))
  351.32 +
  351.33 +(deftest test-with-sh-env
  351.34 +  (are [x y] (= x y)
  351.35 +    nil *sh-env*
  351.36 +    {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*)))
  351.37 +
  351.38 +(deftest test-as-env-strings
  351.39 +  (are [x y] (= x y)
  351.40 +    nil (#'sh/as-env-strings nil)
  351.41 +    ["FOO=BAR"] (seq (#'sh/as-env-strings {"FOO" "BAR"}))
  351.42 +    ["FOO_SYMBOL=BAR"] (seq (#'sh/as-env-strings {'FOO_SYMBOL "BAR"}))
  351.43 +    ["FOO_KEYWORD=BAR"] (seq (#'sh/as-env-strings {:FOO_KEYWORD "BAR"}))))
  351.44 +
   352.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   352.2 +++ b/src/clojure/test_clojure/java_interop.clj	Sat Aug 21 06:25:44 2010 -0400
   352.3 @@ -0,0 +1,427 @@
   352.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   352.5 +;   The use and distribution terms for this software are covered by the
   352.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   352.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   352.8 +;   By using this software in any fashion, you are agreeing to be bound by
   352.9 +;   the terms of this license.
  352.10 +;   You must not remove this notice, or any other, from this software.
  352.11 +
  352.12 +; Author: Frantisek Sodomka
  352.13 +
  352.14 +
  352.15 +(ns clojure.test-clojure.java-interop
  352.16 +  (:use clojure.test))
  352.17 +
  352.18 +; http://clojure.org/java_interop
  352.19 +; http://clojure.org/compilation
  352.20 +
  352.21 +
  352.22 +(deftest test-dot
  352.23 +  ; (.instanceMember instance args*)
  352.24 +  (are [x] (= x "FRED")
  352.25 +      (.toUpperCase "fred") 
  352.26 +      (. "fred" toUpperCase)
  352.27 +      (. "fred" (toUpperCase)) )
  352.28 +
  352.29 +  (are [x] (= x true)
  352.30 +      (.startsWith "abcde" "ab")
  352.31 +      (. "abcde" startsWith "ab")
  352.32 +      (. "abcde" (startsWith "ab")) )
  352.33 +
  352.34 +  ; (.instanceMember Classname args*)
  352.35 +  (are [x] (= x "java.lang.String")
  352.36 +      (.getName String)
  352.37 +      (. (identity String) getName)
  352.38 +      (. (identity String) (getName)) )
  352.39 +
  352.40 +  ; (Classname/staticMethod args*)
  352.41 +  (are [x] (= x 7)
  352.42 +      (Math/abs -7)
  352.43 +      (. Math abs -7)
  352.44 +      (. Math (abs -7)) )
  352.45 +
  352.46 +  ; Classname/staticField
  352.47 +  (are [x] (= x 2147483647)
  352.48 +      Integer/MAX_VALUE
  352.49 +      (. Integer MAX_VALUE) ))
  352.50 +
  352.51 +
  352.52 +(deftest test-double-dot
  352.53 +  (is (= (.. System (getProperties) (get "os.name"))
  352.54 +         (. (. System (getProperties)) (get "os.name")))))
  352.55 +
  352.56 +
  352.57 +(deftest test-doto
  352.58 +  (let [m (doto (new java.util.HashMap)
  352.59 +            (.put "a" 1)
  352.60 +            (.put "b" 2))]
  352.61 +    (are [x y] (= x y)
  352.62 +        (class m) java.util.HashMap
  352.63 +        m {"a" 1 "b" 2} )))
  352.64 +
  352.65 +
  352.66 +(deftest test-new
  352.67 +  ; Integer
  352.68 +  (are [expr cls value] (and (= (class expr) cls)
  352.69 +                            (= expr value))
  352.70 +      (new java.lang.Integer 42) java.lang.Integer 42
  352.71 +      (java.lang.Integer. 123) java.lang.Integer 123 )
  352.72 +
  352.73 +  ; Date
  352.74 +  (are [x] (= (class x) java.util.Date)
  352.75 +      (new java.util.Date)
  352.76 +      (java.util.Date.) ))
  352.77 +
  352.78 +
  352.79 +(deftest test-instance?
  352.80 +  ; evaluation
  352.81 +  (are [x y] (= x y)
  352.82 +      (instance? java.lang.Integer (+ 1 2)) true
  352.83 +      (instance? java.lang.Long (+ 1 2)) false )
  352.84 +
  352.85 +  ; different types
  352.86 +  (are [type literal] (instance? literal type)
  352.87 +      1   java.lang.Integer
  352.88 +      1.0 java.lang.Double
  352.89 +      1M  java.math.BigDecimal
  352.90 +      \a  java.lang.Character
  352.91 +      "a" java.lang.String )
  352.92 +
  352.93 +  ; it is an int, nothing else
  352.94 +  (are [x y] (= (instance? x 42) y)
  352.95 +      java.lang.Integer true
  352.96 +      java.lang.Long false
  352.97 +      java.lang.Character false
  352.98 +      java.lang.String false ))
  352.99 +
 352.100 +
 352.101 +; set!
 352.102 +
 352.103 +; memfn
 352.104 +
 352.105 +
 352.106 +(deftest test-bean
 352.107 +  (let [b (bean java.awt.Color/black)]
 352.108 +    (are [x y] (= x y)
 352.109 +        (map? b) true
 352.110 +
 352.111 +        (:red b) 0
 352.112 +        (:green b) 0
 352.113 +        (:blue b) 0
 352.114 +        (:RGB b) -16777216
 352.115 +
 352.116 +        (:alpha b) 255
 352.117 +        (:transparency b) 1
 352.118 +
 352.119 +        (:class b) java.awt.Color )))
 352.120 +
 352.121 +
 352.122 +; proxy, proxy-super
 352.123 +
 352.124 +
 352.125 +(deftest test-bases
 352.126 +  (are [x y] (= x y)
 352.127 +      (bases java.lang.Math)
 352.128 +        (list java.lang.Object)
 352.129 +      (bases java.lang.Integer)
 352.130 +        (list java.lang.Number java.lang.Comparable) ))
 352.131 +
 352.132 +(deftest test-supers
 352.133 +  (are [x y] (= x y)
 352.134 +      (supers java.lang.Math)
 352.135 +        #{java.lang.Object}
 352.136 +      (supers java.lang.Integer)
 352.137 +        #{java.lang.Number java.lang.Object
 352.138 +          java.lang.Comparable java.io.Serializable} ))
 352.139 +
 352.140 +
 352.141 +; Arrays: [alength] aget aset [make-array to-array into-array to-array-2d aclone]
 352.142 +;   [float-array, int-array, etc]
 352.143 +;   amap, areduce
 352.144 +
 352.145 +(defmacro deftest-type-array [type-array type]
 352.146 +  `(deftest ~(symbol (str "test-" type-array))
 352.147 +      ; correct type
 352.148 +      (is (= (class (first (~type-array [1 2]))) (class (~type 1))))
 352.149 +
 352.150 +      ; given size (and empty)
 352.151 +      (are [x] (and (= (alength (~type-array x)) x)
 352.152 +                    (= (vec (~type-array x)) (repeat x 0)))
 352.153 +          0 1 5 )
 352.154 +
 352.155 +      ; copy of a sequence
 352.156 +      (are [x] (and (= (alength (~type-array x)) (count x))
 352.157 +                    (= (vec (~type-array x)) x))
 352.158 +          []
 352.159 +          [1]
 352.160 +          [1 -2 3 0 5] )
 352.161 +
 352.162 +      ; given size and init-value
 352.163 +      (are [x] (and (= (alength (~type-array x 42)) x)
 352.164 +                    (= (vec (~type-array x 42)) (repeat x 42)))
 352.165 +          0 1 5 )
 352.166 +
 352.167 +      ; given size and init-seq
 352.168 +      (are [x y z] (and (= (alength (~type-array x y)) x)
 352.169 +                        (= (vec (~type-array x y)) z))
 352.170 +          0 [] []
 352.171 +          0 [1] []
 352.172 +          0 [1 2 3] []
 352.173 +          1 [] [0]
 352.174 +          1 [1] [1]
 352.175 +          1 [1 2 3] [1]
 352.176 +          5 [] [0 0 0 0 0]
 352.177 +          5 [1] [1 0 0 0 0]
 352.178 +          5 [1 2 3] [1 2 3 0 0]
 352.179 +          5 [1 2 3 4 5] [1 2 3 4 5]
 352.180 +          5 [1 2 3 4 5 6 7] [1 2 3 4 5] )))
 352.181 +
 352.182 +(deftest-type-array int-array int)
 352.183 +(deftest-type-array long-array long)
 352.184 +(deftest-type-array float-array float)
 352.185 +(deftest-type-array double-array double)
 352.186 +
 352.187 +; separate test for exceptions (doesn't work with above macro...)
 352.188 +(deftest test-type-array-exceptions
 352.189 +  (are [x] (thrown? NegativeArraySizeException x)
 352.190 +       (int-array -1)
 352.191 +       (long-array -1)
 352.192 +       (float-array -1)
 352.193 +       (double-array -1) ))
 352.194 +
 352.195 +
 352.196 +(deftest test-make-array
 352.197 +  ; negative size
 352.198 +  (is (thrown? NegativeArraySizeException (make-array Integer -1)))
 352.199 +
 352.200 +  ; one-dimensional
 352.201 +  (are [x] (= (alength (make-array Integer x)) x)
 352.202 +      0 1 5 )
 352.203 +
 352.204 +  (let [a (make-array Integer 5)]
 352.205 +    (aset a 3 42)
 352.206 +    (are [x y] (= x y)
 352.207 +        (aget a 3) 42
 352.208 +        (class (aget a 3)) Integer ))
 352.209 +      
 352.210 +  ; multi-dimensional
 352.211 +  (let [a (make-array Integer 3 2 4)]
 352.212 +    (aset a 0 1 2 987)
 352.213 +    (are [x y] (= x y)
 352.214 +        (alength a) 3
 352.215 +        (alength (first a)) 2
 352.216 +        (alength (first (first a))) 4
 352.217 +
 352.218 +        (aget a 0 1 2) 987
 352.219 +        (class (aget a 0 1 2)) Integer )))
 352.220 +
 352.221 +
 352.222 +(deftest test-to-array
 352.223 +  (let [v [1 "abc" :kw \c []]
 352.224 +        a (to-array v)]
 352.225 +    (are [x y] (= x y)
 352.226 +        ; length
 352.227 +        (alength a) (count v)
 352.228 +
 352.229 +        ; content
 352.230 +        (vec a) v
 352.231 +        (class (aget a 0)) (class (nth v 0))
 352.232 +        (class (aget a 1)) (class (nth v 1))
 352.233 +        (class (aget a 2)) (class (nth v 2))
 352.234 +        (class (aget a 3)) (class (nth v 3))
 352.235 +        (class (aget a 4)) (class (nth v 4)) ))
 352.236 +
 352.237 +  ; different kinds of collections
 352.238 +  (are [x] (and (= (alength (to-array x)) (count x))
 352.239 +                (= (vec (to-array x)) (vec x)))
 352.240 +      ()
 352.241 +      '(1 2)
 352.242 +      []
 352.243 +      [1 2]
 352.244 +      (sorted-set)
 352.245 +      (sorted-set 1 2)
 352.246 +      
 352.247 +      (int-array 0)
 352.248 +      (int-array [1 2 3])
 352.249 +
 352.250 +      (to-array [])
 352.251 +      (to-array [1 2 3]) ))
 352.252 +
 352.253 +
 352.254 +(deftest test-into-array
 352.255 +  ; compatible types only
 352.256 +  (is (thrown? IllegalArgumentException (into-array [1 "abc" :kw])))
 352.257 +  (is (thrown? IllegalArgumentException (into-array [1.2 4])))
 352.258 +  (is (thrown? IllegalArgumentException (into-array [(byte 2) (short 3)])))
 352.259 +
 352.260 +  ; simple case
 352.261 +  (let [v [1 2 3 4 5]
 352.262 +        a (into-array v)]
 352.263 +    (are [x y] (= x y)
 352.264 +        (alength a) (count v)
 352.265 +        (vec a) v
 352.266 +        (class (first a)) (class (first v)) ))
 352.267 +
 352.268 +  ; given type
 352.269 +  (let [a (into-array Integer/TYPE [(byte 2) (short 3) (int 4)])]
 352.270 +    (are [x] (= x Integer)
 352.271 +        (class (aget a 0))
 352.272 +        (class (aget a 1))
 352.273 +        (class (aget a 2)) ))
 352.274 +
 352.275 +  ; different kinds of collections
 352.276 +  (are [x] (and (= (alength (into-array x)) (count x))
 352.277 +                (= (vec (into-array x)) (vec x))
 352.278 +                (= (alength (into-array Integer/TYPE x)) (count x))
 352.279 +                (= (vec (into-array Integer/TYPE x)) (vec x)))
 352.280 +      ()
 352.281 +      '(1 2)
 352.282 +      []
 352.283 +      [1 2]
 352.284 +      (sorted-set)
 352.285 +      (sorted-set 1 2)
 352.286 +
 352.287 +      (int-array 0)
 352.288 +      (int-array [1 2 3])
 352.289 +
 352.290 +      (to-array [])
 352.291 +      (to-array [1 2 3]) ))
 352.292 +
 352.293 +
 352.294 +(deftest test-to-array-2d
 352.295 +  ; needs to be a collection of collection(s)
 352.296 +  (is (thrown? Exception (to-array-2d [1 2 3])))
 352.297 +
 352.298 +  ; ragged array
 352.299 +  (let [v [[1] [2 3] [4 5 6]]
 352.300 +        a (to-array-2d v)]
 352.301 +    (are [x y] (= x y)
 352.302 +        (alength a) (count v)
 352.303 +        (alength (aget a 0)) (count (nth v 0))
 352.304 +        (alength (aget a 1)) (count (nth v 1))
 352.305 +        (alength (aget a 2)) (count (nth v 2))
 352.306 +
 352.307 +        (vec (aget a 0)) (nth v 0)
 352.308 +        (vec (aget a 1)) (nth v 1)
 352.309 +        (vec (aget a 2)) (nth v 2) ))
 352.310 +
 352.311 +  ; empty array
 352.312 +  (let [a (to-array-2d [])]
 352.313 +    (are [x y] (= x y)
 352.314 +        (alength a) 0
 352.315 +        (vec a) [] )))
 352.316 +
 352.317 +
 352.318 +(deftest test-alength
 352.319 +  (are [x] (= (alength x) 0)
 352.320 +      (int-array 0)
 352.321 +      (long-array 0)
 352.322 +      (float-array 0)
 352.323 +      (double-array 0)
 352.324 +      (boolean-array 0)
 352.325 +      (byte-array 0)
 352.326 +      (char-array 0)
 352.327 +      (short-array 0)
 352.328 +      (make-array Integer/TYPE 0)
 352.329 +      (to-array [])
 352.330 +      (into-array [])
 352.331 +      (to-array-2d []) )
 352.332 +
 352.333 +  (are [x] (= (alength x) 1)
 352.334 +      (int-array 1)
 352.335 +      (long-array 1)
 352.336 +      (float-array 1)
 352.337 +      (double-array 1)
 352.338 +      (boolean-array 1)
 352.339 +      (byte-array 1)
 352.340 +      (char-array 1)
 352.341 +      (short-array 1)
 352.342 +      (make-array Integer/TYPE 1)
 352.343 +      (to-array [1])
 352.344 +      (into-array [1])
 352.345 +      (to-array-2d [[1]]) )
 352.346 +
 352.347 +  (are [x] (= (alength x) 3)
 352.348 +      (int-array 3)
 352.349 +      (long-array 3)
 352.350 +      (float-array 3)
 352.351 +      (double-array 3)
 352.352 +      (boolean-array 3)
 352.353 +      (byte-array 3)
 352.354 +      (char-array 3)
 352.355 +      (short-array 3)
 352.356 +      (make-array Integer/TYPE 3)
 352.357 +      (to-array [1 "a" :k])
 352.358 +      (into-array [1 2 3])
 352.359 +      (to-array-2d [[1] [2 3] [4 5 6]]) ))
 352.360 +
 352.361 +
 352.362 +(deftest test-aclone
 352.363 +  ; clone all arrays except 2D
 352.364 +  (are [x] (and (= (alength (aclone x)) (alength x))
 352.365 +                (= (vec (aclone x)) (vec x)))
 352.366 +      (int-array 0)
 352.367 +      (long-array 0)
 352.368 +      (float-array 0)
 352.369 +      (double-array 0)
 352.370 +      (boolean-array 0)
 352.371 +      (byte-array 0)
 352.372 +      (char-array 0)
 352.373 +      (short-array 0)
 352.374 +      (make-array Integer/TYPE 0)
 352.375 +      (to-array [])
 352.376 +      (into-array [])
 352.377 +
 352.378 +      (int-array [1 2 3])
 352.379 +      (long-array [1 2 3])
 352.380 +      (float-array [1 2 3])
 352.381 +      (double-array [1 2 3])
 352.382 +      (boolean-array [true false])
 352.383 +      (byte-array [(byte 1) (byte 2)])
 352.384 +      (char-array [\a \b \c])
 352.385 +      (short-array [(short 1) (short 2)])
 352.386 +      (make-array Integer/TYPE 3)
 352.387 +      (to-array [1 "a" :k])
 352.388 +      (into-array [1 2 3]) )
 352.389 +
 352.390 +  ; clone 2D
 352.391 +  (are [x] (and (= (alength (aclone x)) (alength x))
 352.392 +                (= (map alength (aclone x)) (map alength x))
 352.393 +                (= (map vec (aclone x)) (map vec x)))
 352.394 +      (to-array-2d [])
 352.395 +      (to-array-2d [[1] [2 3] [4 5 6]]) ))
 352.396 +
 352.397 +
 352.398 +; Type Hints, *warn-on-reflection*
 352.399 +;   #^ints, #^floats, #^longs, #^doubles
 352.400 +
 352.401 +; Coercions: [int, long, float, double, char, boolean, short, byte]
 352.402 +;   num
 352.403 +;   ints/longs/floats/doubles
 352.404 +
 352.405 +(deftest test-boolean
 352.406 +  (are [x y] (and (instance? java.lang.Boolean (boolean x))
 352.407 +                  (= (boolean x) y))
 352.408 +      nil false
 352.409 +      false false
 352.410 +      true true
 352.411 +
 352.412 +      0 true
 352.413 +      1 true
 352.414 +      () true
 352.415 +      [1] true
 352.416 +
 352.417 +      "" true
 352.418 +      \space true
 352.419 +      :kw true ))
 352.420 +
 352.421 +
 352.422 +(deftest test-char
 352.423 +  ; int -> char
 352.424 +  (is (instance? java.lang.Character (char 65)))
 352.425 +
 352.426 +  ; char -> char
 352.427 +  (is (instance? java.lang.Character (char \a)))
 352.428 +  (is (= (char \a) \a)))
 352.429 +
 352.430 +;; Note: More coercions in numbers.clj
   353.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   353.2 +++ b/src/clojure/test_clojure/logic.clj	Sat Aug 21 06:25:44 2010 -0400
   353.3 @@ -0,0 +1,205 @@
   353.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   353.5 +;   The use and distribution terms for this software are covered by the
   353.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   353.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   353.8 +;   By using this software in any fashion, you are agreeing to be bound by
   353.9 +;   the terms of this license.
  353.10 +;   You must not remove this notice, or any other, from this software.
  353.11 +
  353.12 +; Author: Frantisek Sodomka
  353.13 +
  353.14 +;;
  353.15 +;;  Created 1/29/2009
  353.16 +
  353.17 +(ns clojure.test-clojure.logic
  353.18 +  (:use clojure.test
  353.19 +        [clojure.test-clojure.helpers :only (exception)]))
  353.20 +
  353.21 +
  353.22 +;; *** Tests ***
  353.23 +
  353.24 +(deftest test-if
  353.25 +  ; true/false/nil
  353.26 +  (are [x y] (= x y)
  353.27 +      (if true :t) :t
  353.28 +      (if true :t :f) :t
  353.29 +      (if true :t (exception)) :t
  353.30 +
  353.31 +      (if false :t) nil
  353.32 +      (if false :t :f) :f
  353.33 +      (if false (exception) :f) :f
  353.34 +
  353.35 +      (if nil :t) nil
  353.36 +      (if nil :t :f) :f
  353.37 +      (if nil (exception) :f) :f )
  353.38 +
  353.39 +  ; zero/empty is true
  353.40 +  (are [x] (= (if x :t :f) :t)
  353.41 +      (byte 0)
  353.42 +      (short 0)
  353.43 +      (int 0)
  353.44 +      (long 0)
  353.45 +      (bigint 0)
  353.46 +      (float 0)
  353.47 +      (double 0)
  353.48 +      (bigdec 0)
  353.49 +
  353.50 +      0/2
  353.51 +      ""
  353.52 +      #""
  353.53 +      (symbol "")
  353.54 +
  353.55 +      ()
  353.56 +      []
  353.57 +      {}
  353.58 +      #{}
  353.59 +      (into-array []) )
  353.60 +
  353.61 +  ; anything except nil/false is true
  353.62 +  (are [x]  (= (if x :t :f) :t)
  353.63 +      (byte 2)
  353.64 +      (short 2)
  353.65 +      (int 2)
  353.66 +      (long 2)
  353.67 +      (bigint 2)
  353.68 +      (float 2)
  353.69 +      (double 2)
  353.70 +      (bigdec 2)
  353.71 +
  353.72 +      2/3
  353.73 +      \a
  353.74 +      "abc"
  353.75 +      #"a*b"
  353.76 +      'abc
  353.77 +      :kw
  353.78 +
  353.79 +      '(1 2)
  353.80 +      [1 2]
  353.81 +      {:a 1 :b 2}
  353.82 +      #{1 2}
  353.83 +      (into-array [1 2])
  353.84 +
  353.85 +      (new java.util.Date) ))
  353.86 +
  353.87 +
  353.88 +(deftest test-nil-punning
  353.89 +  (are [x y]  (= (if x :no :yes) y)
  353.90 +    (first []) :yes
  353.91 +    (next [1]) :yes
  353.92 +    (rest [1]) :no
  353.93 +
  353.94 +    (butlast [1]) :yes
  353.95 +
  353.96 +    (seq nil) :yes
  353.97 +    (seq []) :yes
  353.98 +
  353.99 +    (sequence nil) :no
 353.100 +    (sequence []) :no
 353.101 +
 353.102 +    (lazy-seq nil) :no
 353.103 +    (lazy-seq []) :no
 353.104 +
 353.105 +    (filter #(> % 10) [1 2 3]) :no
 353.106 +    (map identity []) :no
 353.107 +    (apply concat []) :no
 353.108 +
 353.109 +    (concat) :no
 353.110 +    (concat []) :no
 353.111 +
 353.112 +    (reverse nil) :no
 353.113 +    (reverse []) :no
 353.114 +
 353.115 +    (sort nil) :no
 353.116 +    (sort []) :no ))
 353.117 +
 353.118 +
 353.119 +(deftest test-and
 353.120 +  (are [x y] (= x y)
 353.121 +      (and) true
 353.122 +      (and true) true
 353.123 +      (and nil) nil
 353.124 +      (and false) false
 353.125 +
 353.126 +      (and true nil) nil
 353.127 +      (and true false) false
 353.128 +
 353.129 +      (and 1 true :kw 'abc "abc") "abc"
 353.130 +
 353.131 +      (and 1 true :kw nil 'abc "abc") nil
 353.132 +      (and 1 true :kw nil (exception) 'abc "abc") nil
 353.133 +
 353.134 +      (and 1 true :kw 'abc "abc" false) false
 353.135 +      (and 1 true :kw 'abc "abc" false (exception)) false ))
 353.136 +
 353.137 +
 353.138 +(deftest test-or
 353.139 +  (are [x y] (= x y)
 353.140 +      (or) nil
 353.141 +      (or true) true
 353.142 +      (or nil) nil
 353.143 +      (or false) false
 353.144 +
 353.145 +      (or nil false true) true
 353.146 +      (or nil false 1 2) 1
 353.147 +      (or nil false "abc" :kw) "abc"
 353.148 +
 353.149 +      (or false nil) nil
 353.150 +      (or nil false) false
 353.151 +      (or nil nil nil false) false
 353.152 +
 353.153 +      (or nil true false) true
 353.154 +      (or nil true (exception) false) true
 353.155 +      (or nil false "abc" (exception)) "abc" ))
 353.156 +
 353.157 +
 353.158 +(deftest test-not
 353.159 +  (is (thrown? IllegalArgumentException (not)))
 353.160 +  (are [x] (= (not x) true)
 353.161 +      nil
 353.162 +      false )
 353.163 +  (are [x]  (= (not x) false)
 353.164 +      true
 353.165 +
 353.166 +      ; numbers
 353.167 +      0
 353.168 +      0.0
 353.169 +      42
 353.170 +      1.2
 353.171 +      0/2
 353.172 +      2/3
 353.173 +
 353.174 +      ; characters
 353.175 +      \space
 353.176 +      \tab
 353.177 +      \a
 353.178 +
 353.179 +      ; strings
 353.180 +      ""
 353.181 +      "abc"
 353.182 +
 353.183 +      ; regexes
 353.184 +      #""
 353.185 +      #"a*b"
 353.186 +
 353.187 +      ; symbols
 353.188 +      (symbol "")
 353.189 +      'abc
 353.190 +
 353.191 +      ; keywords
 353.192 +      :kw
 353.193 +
 353.194 +      ; collections/arrays
 353.195 +      ()
 353.196 +      '(1 2)
 353.197 +      []
 353.198 +      [1 2]
 353.199 +      {}
 353.200 +      {:a 1 :b 2}
 353.201 +      #{}
 353.202 +      #{1 2}
 353.203 +      (into-array [])
 353.204 +      (into-array [1 2])
 353.205 +
 353.206 +      ; Java objects
 353.207 +      (new java.util.Date) ))
 353.208 +
   354.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   354.2 +++ b/src/clojure/test_clojure/macros.clj	Sat Aug 21 06:25:44 2010 -0400
   354.3 @@ -0,0 +1,18 @@
   354.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   354.5 +;   The use and distribution terms for this software are covered by the
   354.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   354.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   354.8 +;   By using this software in any fashion, you are agreeing to be bound by
   354.9 +;   the terms of this license.
  354.10 +;   You must not remove this notice, or any other, from this software.
  354.11 +
  354.12 +; Author: Frantisek Sodomka
  354.13 +
  354.14 +(ns clojure.test-clojure.macros
  354.15 +  (:use clojure.test))
  354.16 +
  354.17 +; http://clojure.org/macros
  354.18 +
  354.19 +; ->
  354.20 +; defmacro definline macroexpand-1 macroexpand
  354.21 +
   355.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   355.2 +++ b/src/clojure/test_clojure/main.clj	Sat Aug 21 06:25:44 2010 -0400
   355.3 @@ -0,0 +1,50 @@
   355.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   355.5 +;   The use and distribution terms for this software are covered by the
   355.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   355.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   355.8 +;   By using this software in any fashion, you are agreeing to be bound by
   355.9 +;   the terms of this license.
  355.10 +;   You must not remove this notice, or any other, from this software.
  355.11 +
  355.12 +; Author: Stuart Halloway
  355.13 +
  355.14 +
  355.15 +(ns clojure.test-clojure.main
  355.16 +  (:use clojure.test)
  355.17 +  (:require [clojure.main :as main]))
  355.18 +
  355.19 +(deftest eval-opt
  355.20 +  (testing "evals and prints forms"
  355.21 +    (is (= "2\n4\n" (with-out-str (#'clojure.main/eval-opt "(+ 1 1) (+ 2 2)")))))
  355.22 +
  355.23 +  (testing "skips printing nils"
  355.24 +    (is (= ":a\n:c\n" (with-out-str (#'clojure.main/eval-opt ":a nil :c")))))
  355.25 +
  355.26 +  (testing "does not block access to *in* (#299)"
  355.27 +    (with-in-str "(+ 1 1)"
  355.28 +      (is (= "(+ 1 1)\n" (with-out-str (#'clojure.main/eval-opt "(read)")))))))
  355.29 +
  355.30 +(defmacro with-err-str
  355.31 +  "Evaluates exprs in a context in which *err* is bound to a fresh
  355.32 +  StringWriter.  Returns the string created by any nested printing
  355.33 +  calls."
  355.34 +  [& body]
  355.35 +  `(let [s# (new java.io.StringWriter)
  355.36 +         p# (new java.io.PrintWriter s#)]
  355.37 +     (binding [*err* p#]
  355.38 +       ~@body
  355.39 +       (str s#))))
  355.40 +
  355.41 +(defn run-repl-and-return-err
  355.42 +  "Run repl, swallowing stdout and returing stderr."
  355.43 +  [in-str]
  355.44 +  (with-err-str
  355.45 +    (with-out-str
  355.46 +      (with-in-str in-str
  355.47 +        (main/repl)))))
  355.48 +
  355.49 +(deftest repl-exception-safety
  355.50 +  (testing "catches and prints exception on bad equals"
  355.51 +    (is (re-matches #"java\.lang\.NullPointerException\r?\n"
  355.52 +           (run-repl-and-return-err
  355.53 +            "(proxy [Object] [] (equals [o] (.toString nil)))")))))
   356.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   356.2 +++ b/src/clojure/test_clojure/metadata.clj	Sat Aug 21 06:25:44 2010 -0400
   356.3 @@ -0,0 +1,76 @@
   356.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   356.5 +;   The use and distribution terms for this software are covered by the
   356.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   356.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   356.8 +;   By using this software in any fashion, you are agreeing to be bound by
   356.9 +;   the terms of this license.
  356.10 +;   You must not remove this notice, or any other, from this software.
  356.11 +
  356.12 +; Authors: Stuart Halloway, Frantisek Sodomka
  356.13 +
  356.14 +(ns clojure.test-clojure.metadata
  356.15 +  (:use clojure.test
  356.16 +        [clojure.test-clojure.helpers :only (eval-in-temp-ns)]))
  356.17 +
  356.18 +(def public-namespaces
  356.19 +  '[clojure.core
  356.20 +    clojure.pprint
  356.21 +    clojure.inspector
  356.22 +    clojure.set
  356.23 +    clojure.stacktrace
  356.24 +    clojure.test
  356.25 +    clojure.walk
  356.26 +    clojure.xml
  356.27 +    clojure.zip
  356.28 +    clojure.java.io
  356.29 +    clojure.java.browse
  356.30 +    clojure.java.javadoc
  356.31 +    clojure.java.shell
  356.32 +    clojure.string])
  356.33 +
  356.34 +(doseq [ns public-namespaces]
  356.35 +  (require ns))
  356.36 +
  356.37 +(def public-vars
  356.38 +  (mapcat #(vals (ns-publics %)) public-namespaces))
  356.39 +
  356.40 +(def public-vars-with-docstrings
  356.41 +  (filter (comp :doc meta) public-vars))
  356.42 +
  356.43 +(deftest public-vars-with-docstrings-have-added
  356.44 +  (is (= [] (remove (comp :added meta) public-vars-with-docstrings))))
  356.45 +
  356.46 +(deftest interaction-of-def-with-metadata
  356.47 +  (testing "initial def sets metadata"
  356.48 +    (let [v (eval-in-temp-ns
  356.49 +             (def ^{:a 1} foo 0)
  356.50 +             #'foo)]
  356.51 +      (is (= 1 (-> v meta :a)))))
  356.52 +  (testing "subsequent declare doesn't overwrite metadata"
  356.53 +    (let [v (eval-in-temp-ns
  356.54 +             (def ^{:b 2} bar 0)
  356.55 +             (declare bar)
  356.56 +             #'bar)]
  356.57 +      (is (= 2 (-> v meta :b))))
  356.58 +    (testing "when compiled"
  356.59 +      (let [v (eval-in-temp-ns
  356.60 +               (def ^{:c 3} bar 0)
  356.61 +               (defn declare-bar []
  356.62 +                 (declare bar))
  356.63 +               (declare-bar)
  356.64 +               #'bar)]
  356.65 +        (is (= 3 (-> v meta :c))))))
  356.66 +  (testing "subsequent def with init-expr *does* overwrite metadata"
  356.67 +    (let [v (eval-in-temp-ns
  356.68 +             (def ^{:d 4} quux 0)
  356.69 +             (def quux 1)
  356.70 +             #'quux)]
  356.71 +      (is (nil? (-> v meta :d))))
  356.72 +    (testing "when compiled"
  356.73 +      (let [v (eval-in-temp-ns
  356.74 +               (def ^{:e 5} quux 0)
  356.75 +               (defn def-quux []
  356.76 +                 (def quux 1))
  356.77 +               (def-quux)
  356.78 +               #'quux)]
  356.79 +        (is (nil? (-> v meta :e)))))))
   357.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   357.2 +++ b/src/clojure/test_clojure/multimethods.clj	Sat Aug 21 06:25:44 2010 -0400
   357.3 @@ -0,0 +1,160 @@
   357.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   357.5 +;   The use and distribution terms for this software are covered by the
   357.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   357.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   357.8 +;   By using this software in any fashion, you are agreeing to be bound by
   357.9 +;   the terms of this license.
  357.10 +;   You must not remove this notice, or any other, from this software.
  357.11 +
  357.12 +; Author: Frantisek Sodomka, Robert Lachlan
  357.13 +
  357.14 +(ns clojure.test-clojure.multimethods
  357.15 +  (:use clojure.test [clojure.test-clojure.helpers :only (with-var-roots)])
  357.16 +  (:require [clojure.set :as set]))
  357.17 +
  357.18 +; http://clojure.org/multimethods
  357.19 +
  357.20 +; defmulti
  357.21 +; defmethod
  357.22 +; remove-method
  357.23 +; prefer-method
  357.24 +; methods
  357.25 +; prefers
  357.26 +
  357.27 +(defmacro for-all
  357.28 +  [& args]
  357.29 +  `(dorun (for ~@args)))
  357.30 +
  357.31 +(defn hierarchy-tags
  357.32 +  "Return all tags in a derivation hierarchy"
  357.33 +  [h]
  357.34 +  (set/select
  357.35 +   #(instance? clojure.lang.Named %)
  357.36 +   (reduce into #{} (map keys (vals h)))))
  357.37 +
  357.38 +(defn transitive-closure
  357.39 +  "Return all objects reachable by calling f starting with o,
  357.40 +   not including o itself. f should return a collection."
  357.41 +  [o f]
  357.42 +  (loop [results #{}
  357.43 +         more #{o}]
  357.44 +    (let [new-objects (set/difference more results)]
  357.45 +      (if (seq new-objects)
  357.46 +        (recur (set/union results more) (reduce into #{} (map f new-objects)))
  357.47 +        (disj results o)))))
  357.48 +
  357.49 +(defn tag-descendants
  357.50 +  "Set of descedants which are tags (i.e. Named)."
  357.51 +  [& args]
  357.52 +  (set/select
  357.53 +   #(instance? clojure.lang.Named %)
  357.54 +   (or (apply descendants args) #{})))
  357.55 +
  357.56 +(defn assert-valid-hierarchy
  357.57 +  [h]
  357.58 +  (let [tags (hierarchy-tags h)]
  357.59 +    (testing "ancestors are the transitive closure of parents"
  357.60 +      (for-all [tag tags]
  357.61 +        (is (= (transitive-closure tag #(parents h %))
  357.62 +               (or (ancestors h tag) #{})))))
  357.63 +    (testing "ancestors are transitive"
  357.64 +      (for-all [tag tags]
  357.65 +        (is (= (transitive-closure tag #(ancestors h %))
  357.66 +               (or (ancestors h tag) #{})))))
  357.67 +    (testing "tag descendants are transitive"
  357.68 +      (for-all [tag tags]
  357.69 +        (is (= (transitive-closure tag #(tag-descendants h %))
  357.70 +               (or (tag-descendants h tag) #{})))))
  357.71 +    (testing "a tag isa? all of its parents"
  357.72 +      (for-all [tag tags
  357.73 +               :let [parents (parents h tag)]
  357.74 +               parent parents]
  357.75 +        (is (isa? h tag parent))))
  357.76 +    (testing "a tag isa? all of its ancestors"
  357.77 +      (for-all [tag tags
  357.78 +               :let [ancestors (ancestors h tag)]
  357.79 +               ancestor ancestors]
  357.80 +        (is (isa? h tag ancestor))))
  357.81 +    (testing "all my descendants have me as an ancestor"
  357.82 +      (for-all [tag tags
  357.83 +               :let [descendants (descendants h tag)]
  357.84 +                descendant descendants]
  357.85 +        (is (isa? h descendant tag))))
  357.86 +    (testing "there are no cycles in parents"
  357.87 +      (for-all [tag tags]
  357.88 +        (is (not (contains? (transitive-closure tag #(parents h %)) tag)))))
  357.89 +    (testing "there are no cycles in descendants"
  357.90 +      (for-all [tag tags]
  357.91 +        (is (not (contains? (descendants h tag) tag)))))))
  357.92 +
  357.93 +(def family
  357.94 +  (reduce #(apply derive (cons %1 %2)) (make-hierarchy)
  357.95 +          [[::parent-1 ::ancestor-1]
  357.96 +           [::parent-1 ::ancestor-2]
  357.97 +           [::parent-2 ::ancestor-2]
  357.98 +           [::child ::parent-2]
  357.99 +           [::child ::parent-1]]))
 357.100 +
 357.101 +(deftest cycles-are-forbidden
 357.102 +  (testing "a tag cannot be its own parent"
 357.103 +    (is (thrown-with-msg? Throwable #"\(not= tag parent\)"
 357.104 +          (derive family ::child ::child))))
 357.105 +  (testing "a tag cannot be its own ancestor"
 357.106 +    (is (thrown-with-msg? Throwable #"Cyclic derivation: :clojure.test-clojure.multimethods/child has :clojure.test-clojure.multimethods/ancestor-1 as ancestor"
 357.107 +          (derive family ::ancestor-1 ::child)))))
 357.108 +
 357.109 +(deftest using-diamond-inheritance
 357.110 +  (let [diamond (reduce #(apply derive (cons %1 %2)) (make-hierarchy)
 357.111 +                        [[::mammal ::animal]
 357.112 +                         [::bird ::animal]
 357.113 +                         [::griffin ::mammal]
 357.114 +                         [::griffin ::bird]])
 357.115 +        bird-no-more (underive diamond ::griffin ::bird)]
 357.116 +    (assert-valid-hierarchy diamond)
 357.117 +    (assert-valid-hierarchy bird-no-more)
 357.118 +    (testing "a griffin is a mammal, indirectly through mammal and bird"
 357.119 +      (is (isa? diamond ::griffin ::animal)))
 357.120 +    (testing "a griffin is a bird"
 357.121 +      (is (isa? diamond ::griffin ::bird)))
 357.122 +    (testing "after underive, griffin is no longer a bird"
 357.123 +      (is (not (isa? bird-no-more ::griffin ::bird))))
 357.124 +    (testing "but it is still an animal, via mammal"
 357.125 +      (is (isa? bird-no-more ::griffin ::animal)))))
 357.126 +
 357.127 +(deftest derivation-world-bridges-to-java-inheritance
 357.128 +  (let [h (derive (make-hierarchy) java.util.Map ::map)]
 357.129 +    (testing "a Java class can be isa? a tag"
 357.130 +      (is (isa? h java.util.Map ::map)))
 357.131 +    (testing "if a Java class isa? a tag, so are its subclasses..."
 357.132 +      (is (isa? h java.util.HashMap ::map)))
 357.133 +    (testing "...but not its superclasses!"
 357.134 +      (is (not (isa? h java.util.Collection ::map))))))
 357.135 +
 357.136 +(deftest global-hierarchy-test
 357.137 +  (with-var-roots {#'clojure.core/global-hierarchy (make-hierarchy)}
 357.138 +    (assert-valid-hierarchy @#'clojure.core/global-hierarchy)
 357.139 +    (testing "when you add some derivations..."
 357.140 +      (derive ::lion ::cat)
 357.141 +      (derive ::manx ::cat)
 357.142 +      (assert-valid-hierarchy @#'clojure.core/global-hierarchy))
 357.143 +    (testing "...isa? sees the derivations"
 357.144 +      (is (isa? ::lion ::cat))
 357.145 +      (is (not (isa? ::cat ::lion))))
 357.146 +    (testing "... you can traverse the derivations"
 357.147 +      (is (= #{::manx ::lion} (descendants ::cat)))
 357.148 +      (is (= #{::cat} (parents ::manx)))
 357.149 +      (is (= #{::cat} (ancestors ::manx))))
 357.150 +    (testing "then, remove a derivation..."
 357.151 +      (underive ::manx ::cat))
 357.152 +    (testing "... traversals update accordingly"
 357.153 +      (is (= #{::lion} (descendants ::cat)))
 357.154 +      (is (nil? (parents ::manx)))
 357.155 +      (is (nil? (ancestors ::manx))))))
 357.156 +
 357.157 +#_(defmacro for-all
 357.158 +  "Better than the actual for-all, if only it worked."
 357.159 +  [& args]
 357.160 +  `(reduce
 357.161 +    #(and %1 %2)
 357.162 +    (map true? (for ~@args))))
 357.163 +
   358.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   358.2 +++ b/src/clojure/test_clojure/ns_libs.clj	Sat Aug 21 06:25:44 2010 -0400
   358.3 @@ -0,0 +1,85 @@
   358.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   358.5 +;   The use and distribution terms for this software are covered by the
   358.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   358.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   358.8 +;   By using this software in any fashion, you are agreeing to be bound by
   358.9 +;   the terms of this license.
  358.10 +;   You must not remove this notice, or any other, from this software.
  358.11 +
  358.12 +; Authors: Frantisek Sodomka, Stuart Halloway
  358.13 +
  358.14 +(ns clojure.test-clojure.ns-libs
  358.15 +  (:use clojure.test))
  358.16 +
  358.17 +; http://clojure.org/namespaces
  358.18 +
  358.19 +; in-ns ns create-ns
  358.20 +; alias import intern refer
  358.21 +; all-ns find-ns
  358.22 +; ns-name ns-aliases ns-imports ns-interns ns-map ns-publics ns-refers
  358.23 +; resolve ns-resolve namespace
  358.24 +; ns-unalias ns-unmap remove-ns
  358.25 +
  358.26 +
  358.27 +; http://clojure.org/libs
  358.28 +
  358.29 +; require use
  358.30 +; loaded-libs
  358.31 +
  358.32 +(deftest test-require
  358.33 +         (is (thrown? Exception (require :foo)))
  358.34 +         (is (thrown? Exception (require))))
  358.35 +
  358.36 +(deftest test-use
  358.37 +         (is (thrown? Exception (use :foo)))
  358.38 +         (is (thrown? Exception (use))))
  358.39 +
  358.40 +(deftest reimporting-deftypes
  358.41 +  (let [inst1 (binding [*ns* *ns*]
  358.42 +                (eval '(do (ns exporter)
  358.43 +                           (defrecord ReimportMe [a])
  358.44 +                           (ns importer)
  358.45 +                           (import exporter.ReimportMe)
  358.46 +                           (ReimportMe. 1))))
  358.47 +        inst2 (binding [*ns* *ns*]
  358.48 +                (eval '(do (ns exporter)
  358.49 +                           (defrecord ReimportMe [a b])
  358.50 +                           (ns importer)
  358.51 +                           (import exporter.ReimportMe)
  358.52 +                           (ReimportMe. 1 2))))]
  358.53 +    (testing "you can reimport a changed class and see the changes"
  358.54 +      (is (= [:a] (keys inst1)))
  358.55 +      (is (= [:a :b] (keys inst2))))
  358.56 +    (testing "you cannot import same local name from a different namespace"
  358.57 +      (is (thrown? clojure.lang.Compiler$CompilerException
  358.58 +                  #"ReimportMe already refers to: class exporter.ReimportMe in namespace: importer"
  358.59 +                  (binding [*ns* *ns*]
  358.60 +                    (eval '(do (ns exporter-2)
  358.61 +                               (defrecord ReimportMe [a b])
  358.62 +                               (ns importer)
  358.63 +                               (import exporter-2.ReimportMe)
  358.64 +                               (ReimportMe. 1 2)))))))))
  358.65 +
  358.66 +(deftest naming-types
  358.67 +  (testing "you cannot use a name already referred from another namespace"
  358.68 +    (is (thrown? IllegalStateException
  358.69 +                 #"String already refers to: class java.lang.String"
  358.70 +                 (definterface String)))
  358.71 +    (is (thrown? IllegalStateException
  358.72 +                 #"StringBuffer already refers to: class java.lang.StringBuffer"
  358.73 +                 (deftype StringBuffer [])))
  358.74 +    (is (thrown? IllegalStateException
  358.75 +                 #"Integer already refers to: class java.lang.Integer"
  358.76 +                 (defrecord Integer [])))))
  358.77 +
  358.78 +(deftest refer-error-messages
  358.79 +  (let [temp-ns (gensym)]
  358.80 +    (binding [*ns* *ns*]
  358.81 +      (in-ns temp-ns)
  358.82 +      (eval '(def ^{:private true} hidden-var)))
  358.83 +    (testing "referring to something that does not exist"
  358.84 +      (is (thrown-with-msg? IllegalAccessError #"nonexistent-var does not exist"
  358.85 +            (refer temp-ns :only '(nonexistent-var)))))
  358.86 +    (testing "referring to something non-public"
  358.87 +      (is (thrown-with-msg? IllegalAccessError #"hidden-var is not public"
  358.88 +            (refer temp-ns :only '(hidden-var)))))))
   359.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   359.2 +++ b/src/clojure/test_clojure/numbers.clj	Sat Aug 21 06:25:44 2010 -0400
   359.3 @@ -0,0 +1,444 @@
   359.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   359.5 +;   The use and distribution terms for this software are covered by the
   359.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   359.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   359.8 +;   By using this software in any fashion, you are agreeing to be bound by
   359.9 +;   the terms of this license.
  359.10 +;   You must not remove this notice, or any other, from this software.
  359.11 +
  359.12 +; Author: Stephen C. Gilardi
  359.13 +;;  scgilardi (gmail)
  359.14 +;;  Created 30 October 2008
  359.15 +;;
  359.16 +
  359.17 +(ns clojure.test-clojure.numbers
  359.18 +  (:use clojure.test))
  359.19 +
  359.20 +
  359.21 +; TODO:
  359.22 +; ==
  359.23 +; and more...
  359.24 +
  359.25 +
  359.26 +;; *** Types ***
  359.27 +
  359.28 +(deftest Coerced-Byte
  359.29 +  (let [v (byte 3)]
  359.30 +    (are [x] (true? x)
  359.31 +     (instance? Byte v)
  359.32 +     (number? v)
  359.33 +     (integer? v)
  359.34 +     (rational? v))))
  359.35 +
  359.36 +(deftest Coerced-Short
  359.37 +  (let [v (short 3)]
  359.38 +    (are [x] (true? x)
  359.39 +     (instance? Short v)
  359.40 +     (number? v)
  359.41 +     (integer? v)
  359.42 +     (rational? v))))
  359.43 +
  359.44 +(deftest Coerced-Integer
  359.45 +  (let [v (int 3)]
  359.46 +    (are [x] (true? x)
  359.47 +     (instance? Integer v)
  359.48 +     (number? v)
  359.49 +     (integer? v)
  359.50 +     (rational? v))))
  359.51 +
  359.52 +(deftest Coerced-Long
  359.53 +  (let [v (long 3)]
  359.54 +    (are [x] (true? x)
  359.55 +     (instance? Long v)
  359.56 +     (number? v)
  359.57 +     (integer? v)
  359.58 +     (rational? v))))
  359.59 +
  359.60 +(deftest Coerced-BigInteger
  359.61 +  (let [v (bigint 3)]
  359.62 +    (are [x] (true? x)
  359.63 +     (instance? BigInteger v)
  359.64 +     (number? v)
  359.65 +     (integer? v)
  359.66 +     (rational? v))))
  359.67 +
  359.68 +(deftest Coerced-Float
  359.69 +  (let [v (float 3)]
  359.70 +    (are [x] (true? x)
  359.71 +     (instance? Float v)
  359.72 +     (number? v)
  359.73 +     (float? v))))
  359.74 +
  359.75 +(deftest Coerced-Double
  359.76 +  (let [v (double 3)]
  359.77 +    (are [x] (true? x)
  359.78 +     (instance? Double v)
  359.79 +     (number? v)
  359.80 +     (float? v))))
  359.81 +
  359.82 +(deftest Coerced-BigDecimal
  359.83 +  (let [v (bigdec 3)]
  359.84 +    (are [x] (true? x)
  359.85 +     (instance? BigDecimal v)
  359.86 +     (number? v)
  359.87 +     (decimal? v)
  359.88 +     (not (float? v)))))
  359.89 +
  359.90 +
  359.91 +;; *** Functions ***
  359.92 +
  359.93 +(defonce DELTA 1e-12)
  359.94 +
  359.95 +(deftest test-add
  359.96 +  (are [x y] (= x y)
  359.97 +      (+) 0
  359.98 +      (+ 1) 1
  359.99 +      (+ 1 2) 3
 359.100 +      (+ 1 2 3) 6
 359.101 +
 359.102 +      (+ -1) -1
 359.103 +      (+ -1 -2) -3
 359.104 +      (+ -1 +2 -3) -2
 359.105 +
 359.106 +      (+ 1 -1) 0
 359.107 +      (+ -1 1) 0
 359.108 +
 359.109 +      (+ 2/3) 2/3
 359.110 +      (+ 2/3 1) 5/3
 359.111 +      (+ 2/3 1/3) 1 )
 359.112 +
 359.113 +  (are [x y] (< (- x y) DELTA)
 359.114 +      (+ 1.2) 1.2
 359.115 +      (+ 1.1 2.4) 3.5
 359.116 +      (+ 1.1 2.2 3.3) 6.6 )
 359.117 +
 359.118 +  (is (> (+ Integer/MAX_VALUE 10) Integer/MAX_VALUE))  ; no overflow
 359.119 +  (is (thrown? ClassCastException (+ "ab" "cd"))) )    ; no string concatenation
 359.120 +
 359.121 +
 359.122 +(deftest test-subtract
 359.123 +  (is (thrown? IllegalArgumentException (-)))
 359.124 +  (are [x y] (= x y)
 359.125 +      (- 1) -1
 359.126 +      (- 1 2) -1
 359.127 +      (- 1 2 3) -4
 359.128 +
 359.129 +      (- -2) 2
 359.130 +      (- 1 -2) 3
 359.131 +      (- 1 -2 -3) 6
 359.132 +
 359.133 +      (- 1 1) 0
 359.134 +      (- -1 -1) 0
 359.135 +
 359.136 +      (- 2/3) -2/3
 359.137 +      (- 2/3 1) -1/3
 359.138 +      (- 2/3 1/3) 1/3 )
 359.139 +
 359.140 +  (are [x y] (< (- x y) DELTA)
 359.141 +      (- 1.2) -1.2
 359.142 +      (- 2.2 1.1) 1.1
 359.143 +      (- 6.6 2.2 1.1) 3.3 )
 359.144 +
 359.145 +  (is (< (- Integer/MIN_VALUE 10) Integer/MIN_VALUE)) )  ; no underflow
 359.146 +
 359.147 +
 359.148 +(deftest test-multiply
 359.149 +  (are [x y] (= x y)
 359.150 +      (*) 1
 359.151 +      (* 2) 2
 359.152 +      (* 2 3) 6
 359.153 +      (* 2 3 4) 24
 359.154 +
 359.155 +      (* -2) -2
 359.156 +      (* 2 -3) -6
 359.157 +      (* 2 -3 -1) 6
 359.158 +
 359.159 +      (* 1/2) 1/2
 359.160 +      (* 1/2 1/3) 1/6
 359.161 +      (* 1/2 1/3 -1/4) -1/24 )
 359.162 +
 359.163 +  (are [x y] (< (- x y) DELTA)
 359.164 +      (* 1.2) 1.2
 359.165 +      (* 2.0 1.2) 2.4
 359.166 +      (* 3.5 2.0 1.2) 8.4 )
 359.167 +
 359.168 +  (is (> (* 3 (int (/ Integer/MAX_VALUE 2.0))) Integer/MAX_VALUE)) )  ; no overflow
 359.169 +
 359.170 +(deftest test-ratios-simplify-to-ints-where-appropriate
 359.171 +  (testing "negative denominator (assembla #275)"
 359.172 +    (is (integer? (/ 1 -1/2)))
 359.173 +    (is (integer? (/ 0 -1/2)))))
 359.174 +
 359.175 +(deftest test-divide
 359.176 +  (are [x y] (= x y)
 359.177 +      (/ 1) 1
 359.178 +      (/ 2) 1/2
 359.179 +      (/ 3 2) 3/2
 359.180 +      (/ 4 2) 2
 359.181 +      (/ 24 3 2) 4
 359.182 +      (/ 24 3 2 -1) -4
 359.183 +
 359.184 +      (/ -1) -1
 359.185 +      (/ -2) -1/2
 359.186 +      (/ -3 -2) 3/2
 359.187 +      (/ -4 -2) 2
 359.188 +      (/ -4 2) -2 )
 359.189 +
 359.190 +  (are [x y] (< (- x y) DELTA)
 359.191 +      (/ 4.5 3) 1.5
 359.192 +      (/ 4.5 3.0 3.0) 0.5 )
 359.193 +
 359.194 +  (is (thrown? ArithmeticException (/ 0)))
 359.195 +  (is (thrown? ArithmeticException (/ 2 0)))
 359.196 +  (is (thrown? IllegalArgumentException (/))) )
 359.197 +
 359.198 +
 359.199 +;; mod
 359.200 +;; http://en.wikipedia.org/wiki/Modulo_operation
 359.201 +;; http://mathforum.org/library/drmath/view/52343.html
 359.202 +;;
 359.203 +;; is mod correct?
 359.204 +;; http://groups.google.com/group/clojure/browse_frm/thread/2a0ee4d248f3d131#
 359.205 +;;
 359.206 +;; Issue 23: mod (modulo) operator
 359.207 +;; http://code.google.com/p/clojure/issues/detail?id=23
 359.208 +
 359.209 +(deftest test-mod
 359.210 +  ; wrong number of args
 359.211 +  (is (thrown? IllegalArgumentException (mod)))
 359.212 +  (is (thrown? IllegalArgumentException (mod 1)))
 359.213 +  (is (thrown? IllegalArgumentException (mod 3 2 1)))
 359.214 +
 359.215 +  ; divide by zero
 359.216 +  (is (thrown? ArithmeticException (mod 9 0)))
 359.217 +  (is (thrown? ArithmeticException (mod 0 0)))
 359.218 +
 359.219 +  (are [x y] (= x y)
 359.220 +    (mod 4 2) 0
 359.221 +    (mod 3 2) 1
 359.222 +    (mod 6 4) 2
 359.223 +    (mod 0 5) 0
 359.224 +
 359.225 +    (mod 2 1/2) 0
 359.226 +    (mod 2/3 1/2) 1/6
 359.227 +    (mod 1 2/3) 1/3
 359.228 +
 359.229 +    (mod 4.0 2.0) 0.0
 359.230 +    (mod 4.5 2.0) 0.5
 359.231 +
 359.232 +    ; |num| > |div|, num != k * div
 359.233 +    (mod 42 5) 2      ; (42 / 5) * 5 + (42 mod 5)        = 8 * 5 + 2        = 42
 359.234 +    (mod 42 -5) -3    ; (42 / -5) * (-5) + (42 mod -5)   = -9 * (-5) + (-3) = 42
 359.235 +    (mod -42 5) 3     ; (-42 / 5) * 5 + (-42 mod 5)      = -9 * 5 + 3       = -42
 359.236 +    (mod -42 -5) -2   ; (-42 / -5) * (-5) + (-42 mod -5) = 8 * (-5) + (-2)  = -42
 359.237 +
 359.238 +    ; |num| > |div|, num = k * div
 359.239 +    (mod 9 3) 0       ; (9 / 3) * 3 + (9 mod 3) = 3 * 3 + 0 = 9
 359.240 +    (mod 9 -3) 0
 359.241 +    (mod -9 3) 0
 359.242 +    (mod -9 -3) 0
 359.243 +
 359.244 +    ; |num| < |div|
 359.245 +    (mod 2 5) 2       ; (2 / 5) * 5 + (2 mod 5)        = 0 * 5 + 2          = 2
 359.246 +    (mod 2 -5) -3     ; (2 / -5) * (-5) + (2 mod -5)   = (-1) * (-5) + (-3) = 2
 359.247 +    (mod -2 5) 3      ; (-2 / 5) * 5 + (-2 mod 5)      = (-1) * 5 + 3       = -2
 359.248 +    (mod -2 -5) -2    ; (-2 / -5) * (-5) + (-2 mod -5) = 0 * (-5) + (-2)    = -2
 359.249 +
 359.250 +    ; num = 0, div != 0
 359.251 +    (mod 0 3) 0       ; (0 / 3) * 3 + (0 mod 3) = 0 * 3 + 0 = 0
 359.252 +    (mod 0 -3) 0
 359.253 +  )
 359.254 +)
 359.255 +
 359.256 +;; rem & quot
 359.257 +;; http://en.wikipedia.org/wiki/Remainder
 359.258 +
 359.259 +(deftest test-rem
 359.260 +  ; wrong number of args
 359.261 +  (is (thrown? IllegalArgumentException (rem)))
 359.262 +  (is (thrown? IllegalArgumentException (rem 1)))
 359.263 +  (is (thrown? IllegalArgumentException (rem 3 2 1)))
 359.264 +
 359.265 +  ; divide by zero
 359.266 +  (is (thrown? ArithmeticException (rem 9 0)))
 359.267 +  (is (thrown? ArithmeticException (rem 0 0)))
 359.268 +  
 359.269 +  (are [x y] (= x y)
 359.270 +    (rem 4 2) 0
 359.271 +    (rem 3 2) 1
 359.272 +    (rem 6 4) 2
 359.273 +    (rem 0 5) 0
 359.274 +
 359.275 +    (rem 2 1/2) 0
 359.276 +    (rem 2/3 1/2) 1/6
 359.277 +    (rem 1 2/3) 1/3
 359.278 +
 359.279 +    (rem 4.0 2.0) 0.0
 359.280 +    (rem 4.5 2.0) 0.5
 359.281 +
 359.282 +    ; |num| > |div|, num != k * div
 359.283 +    (rem 42 5) 2      ; (8 * 5) + 2 == 42
 359.284 +    (rem 42 -5) 2     ; (-8 * -5) + 2 == 42
 359.285 +    (rem -42 5) -2    ; (-8 * 5) + -2 == -42
 359.286 +    (rem -42 -5) -2   ; (8 * -5) + -2 == -42
 359.287 +
 359.288 +    ; |num| > |div|, num = k * div
 359.289 +    (rem 9 3) 0
 359.290 +    (rem 9 -3) 0
 359.291 +    (rem -9 3) 0
 359.292 +    (rem -9 -3) 0
 359.293 +
 359.294 +    ; |num| < |div|
 359.295 +    (rem 2 5) 2
 359.296 +    (rem 2 -5) 2
 359.297 +    (rem -2 5) -2
 359.298 +    (rem -2 -5) -2
 359.299 +    
 359.300 +    ; num = 0, div != 0
 359.301 +    (rem 0 3) 0
 359.302 +    (rem 0 -3) 0
 359.303 +  )
 359.304 +)
 359.305 +
 359.306 +(deftest test-quot
 359.307 +  ; wrong number of args
 359.308 +  (is (thrown? IllegalArgumentException (quot)))
 359.309 +  (is (thrown? IllegalArgumentException (quot 1)))
 359.310 +  (is (thrown? IllegalArgumentException (quot 3 2 1)))
 359.311 +
 359.312 +  ; divide by zero
 359.313 +  (is (thrown? ArithmeticException (quot 9 0)))
 359.314 +  (is (thrown? ArithmeticException (quot 0 0)))
 359.315 +  
 359.316 +  (are [x y] (= x y)
 359.317 +    (quot 4 2) 2
 359.318 +    (quot 3 2) 1
 359.319 +    (quot 6 4) 1
 359.320 +    (quot 0 5) 0
 359.321 +
 359.322 +    (quot 2 1/2) 4
 359.323 +    (quot 2/3 1/2) 1
 359.324 +    (quot 1 2/3) 1
 359.325 +
 359.326 +    (quot 4.0 2.0) 2.0
 359.327 +    (quot 4.5 2.0) 2.0
 359.328 +
 359.329 +    ; |num| > |div|, num != k * div
 359.330 +    (quot 42 5) 8     ; (8 * 5) + 2 == 42
 359.331 +    (quot 42 -5) -8   ; (-8 * -5) + 2 == 42
 359.332 +    (quot -42 5) -8   ; (-8 * 5) + -2 == -42
 359.333 +    (quot -42 -5) 8   ; (8 * -5) + -2 == -42
 359.334 +
 359.335 +    ; |num| > |div|, num = k * div
 359.336 +    (quot 9 3) 3
 359.337 +    (quot 9 -3) -3
 359.338 +    (quot -9 3) -3
 359.339 +    (quot -9 -3) 3
 359.340 +
 359.341 +    ; |num| < |div|
 359.342 +    (quot 2 5) 0
 359.343 +    (quot 2 -5) 0
 359.344 +    (quot -2 5) 0
 359.345 +    (quot -2 -5) 0
 359.346 +
 359.347 +    ; num = 0, div != 0
 359.348 +    (quot 0 3) 0
 359.349 +    (quot 0 -3) 0
 359.350 +  )
 359.351 +)
 359.352 +
 359.353 +
 359.354 +;; *** Predicates ***
 359.355 +
 359.356 +;; pos? zero? neg?
 359.357 +
 359.358 +(deftest test-pos?-zero?-neg?
 359.359 +  (let [nums [[(byte 2) (byte 0) (byte -2)]
 359.360 +              [(short 3) (short 0) (short -3)]
 359.361 +              [(int 4) (int 0) (int -4)]
 359.362 +              [(long 5) (long 0) (long -5)]
 359.363 +              [(bigint 6) (bigint 0) (bigint -6)]
 359.364 +              [(float 7) (float 0) (float -7)]
 359.365 +              [(double 8) (double 0) (double -8)]
 359.366 +              [(bigdec 9) (bigdec 0) (bigdec -9)]
 359.367 +              [2/3 0 -2/3]]
 359.368 +        pred-result [[pos?  [true false false]]
 359.369 +                     [zero? [false true false]]
 359.370 +                     [neg?  [false false true]]] ]
 359.371 +    (doseq [pr pred-result]
 359.372 +      (doseq [n nums]
 359.373 +        (is (= (map (first pr) n) (second pr))
 359.374 +          (pr-str (first pr) n))))))
 359.375 +
 359.376 +
 359.377 +;; even? odd?
 359.378 +
 359.379 +(deftest test-even?
 359.380 +  (are [x] (true? x)
 359.381 +    (even? -4)
 359.382 +    (not (even? -3))
 359.383 +    (even? 0)
 359.384 +    (not (even? 5))
 359.385 +    (even? 8))
 359.386 +  (is (thrown? ArithmeticException (even? 1/2)))
 359.387 +  (is (thrown? ArithmeticException (even? (double 10)))))
 359.388 +
 359.389 +(deftest test-odd?
 359.390 +  (are [x] (true? x)
 359.391 +    (not (odd? -4))
 359.392 +    (odd? -3)
 359.393 +    (not (odd? 0))
 359.394 +    (odd? 5)
 359.395 +    (not (odd? 8)))
 359.396 +  (is (thrown? ArithmeticException (odd? 1/2)))
 359.397 +  (is (thrown? ArithmeticException (odd? (double 10)))))
 359.398 +
 359.399 +(defn- expt
 359.400 +  "clojure.contrib.math/expt is a better and much faster impl, but this works.
 359.401 +Math/pow overflows to Infinity."
 359.402 +  [x n] (apply * (replicate n x)))
 359.403 +
 359.404 +(deftest test-bit-shift-left
 359.405 +  (are [x y] (= x y)
 359.406 +       2r10 (bit-shift-left 2r1 1)
 359.407 +       2r100 (bit-shift-left 2r1 2)
 359.408 +       2r1000 (bit-shift-left 2r1 3)
 359.409 +       2r00101110 (bit-shift-left 2r00010111 1)
 359.410 +       2r00101110 (apply bit-shift-left [2r00010111 1])
 359.411 +       2r01 (bit-shift-left 2r10 -1)
 359.412 +       (expt 2 32) (bit-shift-left 1 32)
 359.413 +       (expt 2 10000) (bit-shift-left 1 10000)
 359.414 +       ))
 359.415 +
 359.416 +(deftest test-bit-shift-right
 359.417 +  (are [x y] (= x y)
 359.418 +       2r0 (bit-shift-right 2r1 1)
 359.419 +       2r010 (bit-shift-right 2r100 1)
 359.420 +       2r001 (bit-shift-right 2r100 2)
 359.421 +       2r000 (bit-shift-right 2r100 3)
 359.422 +       2r0001011 (bit-shift-right 2r00010111 1)
 359.423 +       2r0001011 (apply bit-shift-right [2r00010111 1])
 359.424 +       2r100 (bit-shift-right 2r10 -1)
 359.425 +       1 (bit-shift-right (expt 2 32) 32)
 359.426 +       1 (bit-shift-right (expt 2 10000) 10000)
 359.427 +       ))
 359.428 +
 359.429 +
 359.430 +;; arrays
 359.431 +(deftest test-array-types
 359.432 +  (are [x y z] (= (Class/forName x) (class y) (class z))
 359.433 +       "[Z" (boolean-array 1) (booleans (boolean-array 1 true))
 359.434 +       "[B" (byte-array 1) (bytes (byte-array 1 (byte 1)))
 359.435 +       "[C" (char-array 1) (chars (char-array 1 \a))
 359.436 +       "[S" (short-array 1) (shorts (short-array 1 (short 1)))
 359.437 +       "[F" (float-array 1) (floats (float-array 1 1))
 359.438 +       "[D" (double-array 1) (doubles (double-array 1 1))
 359.439 +       "[I" (int-array 1) (ints (int-array 1 1))
 359.440 +       "[J" (long-array 1) (longs (long-array 1 1))))
 359.441 +
 359.442 +
 359.443 +(deftest test-ratios
 359.444 +  (is (= (denominator 1/2) 2))
 359.445 +  (is (= (numerator 1/2) 1))
 359.446 +  (is (= (bigint (/ 100000000000000000000 3)) 33333333333333333333))
 359.447 +  (is (= (long 10000000000000000000/3) 3333333333333333333)))
   360.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   360.2 +++ b/src/clojure/test_clojure/other_functions.clj	Sat Aug 21 06:25:44 2010 -0400
   360.3 @@ -0,0 +1,86 @@
   360.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   360.5 +;   The use and distribution terms for this software are covered by the
   360.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   360.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   360.8 +;   By using this software in any fashion, you are agreeing to be bound by
   360.9 +;   the terms of this license.
  360.10 +;   You must not remove this notice, or any other, from this software.
  360.11 +
  360.12 +; Author: Frantisek Sodomka
  360.13 +
  360.14 +
  360.15 +(ns clojure.test-clojure.other-functions
  360.16 +  (:use clojure.test))
  360.17 +
  360.18 +; http://clojure.org/other_functions
  360.19 +
  360.20 +; [= not= (tests in data_structures.clj and elsewhere)]
  360.21 +
  360.22 +
  360.23 +(deftest test-identity
  360.24 +  ; exactly 1 argument needed
  360.25 +  (is (thrown? IllegalArgumentException (identity)))
  360.26 +  (is (thrown? IllegalArgumentException (identity 1 2)))
  360.27 +
  360.28 +  (are [x] (= (identity x) x)
  360.29 +      nil
  360.30 +      false true
  360.31 +      0 42
  360.32 +      0.0 3.14
  360.33 +      2/3
  360.34 +      0M 1M
  360.35 +      \c
  360.36 +      "" "abc"
  360.37 +      'sym
  360.38 +      :kw
  360.39 +      () '(1 2)
  360.40 +      [] [1 2]
  360.41 +      {} {:a 1 :b 2}
  360.42 +      #{} #{1 2} )
  360.43 +
  360.44 +  ; evaluation
  360.45 +  (are [x y] (= (identity x) y)
  360.46 +      (+ 1 2) 3
  360.47 +      (> 5 0) true ))
  360.48 +
  360.49 +
  360.50 +(deftest test-name
  360.51 +  (are [x y] (= x (name y))
  360.52 +       "foo" :foo
  360.53 +       "bar" 'bar
  360.54 +       "quux" "quux"))
  360.55 +
  360.56 +(deftest test-fnil
  360.57 +  (let [f1 (fnil vector :a)
  360.58 +        f2 (fnil vector :a :b)
  360.59 +        f3 (fnil vector :a :b :c)]
  360.60 +    (are [result input] (= result [(apply f1 input) (apply f2 input) (apply f3 input)])
  360.61 +         [[1 2 3 4] [1 2 3 4] [1 2 3 4]]  [1 2 3 4]
  360.62 +         [[:a 2 3 4] [:a 2 3 4] [:a 2 3 4]] [nil 2 3 4]
  360.63 +         [[:a nil 3 4] [:a :b 3 4] [:a :b 3 4]] [nil nil 3 4]
  360.64 +         [[:a nil nil 4] [:a :b nil 4] [:a :b :c 4]] [nil nil nil 4]
  360.65 +         [[:a nil nil nil] [:a :b nil nil] [:a :b :c nil]] [nil nil nil nil]))
  360.66 +  (are [x y] (= x y)
  360.67 +       ((fnil + 0) nil 42) 42
  360.68 +       ((fnil conj []) nil 42) [42]
  360.69 +       (reduce #(update-in %1 [%2] (fnil inc 0)) {} 
  360.70 +               ["fun" "counting" "words" "fun"])
  360.71 +       {"words" 1, "counting" 1, "fun" 2}
  360.72 +       (reduce #(update-in %1 [(first %2)] (fnil conj []) (second %2)) {} 
  360.73 +               [[:a 1] [:a 2] [:b 3]])
  360.74 +       {:b [3], :a [1 2]}))
  360.75 +
  360.76 +; time assert comment doc
  360.77 +
  360.78 +; partial
  360.79 +; comp
  360.80 +; complement
  360.81 +; constantly
  360.82 +
  360.83 +; Printing
  360.84 +; pr prn print println newline
  360.85 +; pr-str prn-str print-str println-str [with-out-str (vars.clj)]
  360.86 +
  360.87 +; Regex Support
  360.88 +; re-matcher re-find re-matches re-groups re-seq
  360.89 +
   361.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   361.2 +++ b/src/clojure/test_clojure/parallel.clj	Sat Aug 21 06:25:44 2010 -0400
   361.3 @@ -0,0 +1,29 @@
   361.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   361.5 +;   The use and distribution terms for this software are covered by the
   361.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   361.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   361.8 +;   By using this software in any fashion, you are agreeing to be bound by
   361.9 +;   the terms of this license.
  361.10 +;   You must not remove this notice, or any other, from this software.
  361.11 +
  361.12 +; Author: Frantisek Sodomka
  361.13 +
  361.14 +
  361.15 +(ns clojure.test-clojure.parallel
  361.16 +  (:use clojure.test))
  361.17 +
  361.18 +;; !! Tests for the parallel library will be in a separate file clojure_parallel.clj !!
  361.19 +
  361.20 +; future-call
  361.21 +; future
  361.22 +; pmap
  361.23 +; pcalls
  361.24 +; pvalues
  361.25 +
  361.26 +
  361.27 +;; pmap
  361.28 +;;
  361.29 +(deftest pmap-does-its-thing
  361.30 +  ;; regression fixed in r1218; was OutOfMemoryError
  361.31 +  (is (= '(1) (pmap inc [0]))))
  361.32 +
   362.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   362.2 +++ b/src/clojure/test_clojure/pprint.clj	Sat Aug 21 06:25:44 2010 -0400
   362.3 @@ -0,0 +1,18 @@
   362.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   362.5 +;   The use and distribution terms for this software are covered by the
   362.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   362.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   362.8 +;   By using this software in any fashion, you are agreeing to be bound by
   362.9 +;   the terms of this license.
  362.10 +;   You must not remove this notice, or any other, from this software.
  362.11 +
  362.12 +;; Author: Tom Faulhaber
  362.13 +
  362.14 +(ns clojure.test-clojure.pprint
  362.15 +  (:refer-clojure :exclude [format])
  362.16 +  (:use [clojure.test :only (deftest are run-tests)]
  362.17 +        clojure.test-clojure.pprint.test-helper
  362.18 +        clojure.pprint))
  362.19 +
  362.20 +(load "pprint/test_cl_format")
  362.21 +(load "pprint/test_pretty")
   363.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   363.2 +++ b/src/clojure/test_clojure/pprint/test_cl_format.clj	Sat Aug 21 06:25:44 2010 -0400
   363.3 @@ -0,0 +1,688 @@
   363.4 +;;; test_cl_format.clj -- part of the pretty printer for Clojure
   363.5 +
   363.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   363.7 +;   The use and distribution terms for this software are covered by the
   363.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   363.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  363.10 +;   By using this software in any fashion, you are agreeing to be bound by
  363.11 +;   the terms of this license.
  363.12 +;   You must not remove this notice, or any other, from this software.
  363.13 +
  363.14 +;; Author: Tom Faulhaber
  363.15 +;; April 3, 2009
  363.16 +
  363.17 +;; This test set tests the basic cl-format functionality
  363.18 +
  363.19 +
  363.20 +(in-ns 'clojure.test-clojure.pprint)
  363.21 +
  363.22 +(def format cl-format)
  363.23 +
  363.24 +;; TODO tests for ~A, ~D, etc.
  363.25 +;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding
  363.26 +
  363.27 +(simple-tests d-tests
  363.28 +  (cl-format nil "~D" 0) "0"
  363.29 +  (cl-format nil "~D" 2e6) "2000000"
  363.30 +  (cl-format nil "~D" 2000000) "2000000"
  363.31 +  (cl-format nil "~:D" 2000000) "2,000,000"
  363.32 +  (cl-format nil "~D" 1/2) "1/2"
  363.33 +  (cl-format nil "~D" 'fred) "fred"
  363.34 +)
  363.35 +
  363.36 +(simple-tests base-tests
  363.37 +  (cl-format nil "~{~2r~^ ~}~%" (range 10))
  363.38 +  "0 1 10 11 100 101 110 111 1000 1001\n"
  363.39 +  (with-out-str
  363.40 +    (dotimes [i 35]
  363.41 +      (binding [*print-base* (+ i 2)]       ;print the decimal number 40 
  363.42 +        (write 40)                          ;in each base from 2 to 36
  363.43 +        (if (zero? (mod i 10)) (prn) (cl-format true " ")))))
  363.44 +  "101000
  363.45 +1111 220 130 104 55 50 44 40 37 34
  363.46 +31 2c 2a 28 26 24 22 20 1j 1i
  363.47 +1h 1g 1f 1e 1d 1c 1b 1a 19 18
  363.48 +17 16 15 14 "
  363.49 +  (with-out-str
  363.50 +    (doseq [pb [2 3 8 10 16]]               
  363.51 +      (binding [*print-radix* true      ;print the integer 10 and 
  363.52 +            *print-base* pb]            ;the ratio 1/10 in bases 2, 
  363.53 +        (cl-format true "~&~S  ~S~%" 10 1/10))))        ;3, 8, 10, 16
  363.54 +  "#b1010  #b1/1010
  363.55 +#3r101  #3r1/101
  363.56 +#o12  #o1/12
  363.57 +10.  #10r1/10
  363.58 +#xa  #x1/a
  363.59 +")
  363.60 +
  363.61 +
  363.62 +
  363.63 +(simple-tests cardinal-tests
  363.64 +  (cl-format nil "~R" 0) "zero"
  363.65 +  (cl-format nil "~R" 4) "four"
  363.66 +  (cl-format nil "~R" 15) "fifteen"
  363.67 +  (cl-format nil "~R" -15) "minus fifteen"
  363.68 +  (cl-format nil "~R" 25) "twenty-five"
  363.69 +  (cl-format nil "~R" 20) "twenty"
  363.70 +  (cl-format nil "~R" 200) "two hundred"
  363.71 +  (cl-format nil "~R" 203) "two hundred three"
  363.72 +
  363.73 +  (cl-format nil "~R" 44879032)
  363.74 +  "forty-four million, eight hundred seventy-nine thousand, thirty-two"
  363.75 +
  363.76 +  (cl-format nil "~R" -44879032)
  363.77 +  "minus forty-four million, eight hundred seventy-nine thousand, thirty-two"
  363.78 +  
  363.79 +  (cl-format nil "~R = ~:*~:D" 44000032)
  363.80 +  "forty-four million, thirty-two = 44,000,032"
  363.81 +
  363.82 +  (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
  363.83 +  "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"
  363.84 +
  363.85 +  (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
  363.86 +  "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"
  363.87 +
  363.88 +  (cl-format nil "~R = ~:*~:D" 2e6)
  363.89 +  "two million = 2,000,000"
  363.90 +
  363.91 +  (cl-format nil "~R = ~:*~:D" 200000200000)
  363.92 +  "two hundred billion, two hundred thousand = 200,000,200,000")
  363.93 +
  363.94 +(simple-tests ordinal-tests
  363.95 +  (cl-format nil "~:R" 0) "zeroth"
  363.96 +  (cl-format nil "~:R" 4) "fourth"
  363.97 +  (cl-format nil "~:R" 15) "fifteenth"
  363.98 +  (cl-format nil "~:R" -15) "minus fifteenth"
  363.99 +  (cl-format nil "~:R" 25) "twenty-fifth"
 363.100 +  (cl-format nil "~:R" 20) "twentieth"
 363.101 +  (cl-format nil "~:R" 200) "two hundredth"
 363.102 +  (cl-format nil "~:R" 203) "two hundred third"
 363.103 +
 363.104 +  (cl-format nil "~:R" 44879032)
 363.105 +  "forty-four million, eight hundred seventy-nine thousand, thirty-second"
 363.106 +
 363.107 +  (cl-format nil "~:R" -44879032)
 363.108 +  "minus forty-four million, eight hundred seventy-nine thousand, thirty-second"
 363.109 +  
 363.110 +  (cl-format nil "~:R = ~:*~:D" 44000032)
 363.111 +  "forty-four million, thirty-second = 44,000,032"
 363.112 +
 363.113 +  (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
 363.114 +  "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"
 363.115 +  (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
 363.116 +  "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"
 363.117 +  (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471)
 363.118 +  "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"
 363.119 +  (cl-format nil "~:R = ~:*~:D" 2e6)
 363.120 +  "two millionth = 2,000,000")
 363.121 +
 363.122 +(simple-tests ordinal1-tests
 363.123 +  (cl-format nil "~:R" 1) "first"
 363.124 +  (cl-format nil "~:R" 11) "eleventh"
 363.125 +  (cl-format nil "~:R" 21) "twenty-first"
 363.126 +  (cl-format nil "~:R" 20) "twentieth"
 363.127 +  (cl-format nil "~:R" 220) "two hundred twentieth"
 363.128 +  (cl-format nil "~:R" 200) "two hundredth"
 363.129 +  (cl-format nil "~:R" 999) "nine hundred ninety-ninth"
 363.130 +  )
 363.131 +
 363.132 +(simple-tests roman-tests
 363.133 +  (cl-format nil "~@R" 3) "III"
 363.134 +  (cl-format nil "~@R" 4) "IV"
 363.135 +  (cl-format nil "~@R" 9) "IX"
 363.136 +  (cl-format nil "~@R" 29) "XXIX"
 363.137 +  (cl-format nil "~@R" 429) "CDXXIX"
 363.138 +  (cl-format nil "~@:R" 429) "CCCCXXVIIII"
 363.139 +  (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII"
 363.140 +  (cl-format nil "~@R" 3429) "MMMCDXXIX"
 363.141 +  (cl-format nil "~@R" 3479) "MMMCDLXXIX"
 363.142 +  (cl-format nil "~@R" 3409) "MMMCDIX"
 363.143 +  (cl-format nil "~@R" 300) "CCC"
 363.144 +  (cl-format nil "~@R ~D" 300 20) "CCC 20"
 363.145 +  (cl-format nil "~@R" 5000) "5,000"
 363.146 +  (cl-format nil "~@R ~D" 5000 20) "5,000 20"
 363.147 +  (cl-format nil "~@R" "the quick") "the quick")
 363.148 +
 363.149 +(simple-tests c-tests
 363.150 +  (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n"
 363.151 +  (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n"
 363.152 +  (cl-format nil "~@C~%" \m) "\\m\n"
 363.153 +  (cl-format nil "~@C~%" (char 222)) "\\Þ\n"
 363.154 +  (cl-format nil "~@C~%" (char 8)) "\\backspace\n"
 363.155 +  (cl-format nil "~@C~%" (char 3)) "\\\n")
 363.156 +
 363.157 +(simple-tests e-tests
 363.158 +  (cl-format nil "*~E*" 0.0) "*0.0E+0*"
 363.159 +  (cl-format nil "*~6E*" 0.0) "*0.0E+0*"
 363.160 +  (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*"
 363.161 +  (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*"
 363.162 +  (cl-format nil "*~5E*" 0.0) "*0.E+0*"
 363.163 +  (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*"
 363.164 +  (cl-format nil "*~10,2E*" 9.99999) "*   1.00E+1*"
 363.165 +  (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*"
 363.166 +  (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*"
 363.167 +  (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*"
 363.168 +  )
 363.169 +  
 363.170 +(simple-tests $-tests
 363.171 +  (cl-format nil "~$" 22.3) "22.30"
 363.172 +  (cl-format nil "~$" 22.375) "22.38"
 363.173 +  (cl-format nil "~3,5$" 22.375) "00022.375"
 363.174 +  (cl-format nil "~3,5,8$" 22.375) "00022.375"
 363.175 +  (cl-format nil "~3,5,10$" 22.375) " 00022.375"
 363.176 +  (cl-format nil "~3,5,14@$" 22.375) "    +00022.375"
 363.177 +  (cl-format nil "~3,5,14@$" 22.375) "    +00022.375"
 363.178 +  (cl-format nil "~3,5,14@:$" 22.375) "+    00022.375"
 363.179 +  (cl-format nil "~3,,14@:$" 0.375) "+        0.375"
 363.180 +  (cl-format nil "~1,1$" -12.0) "-12.0"
 363.181 +  (cl-format nil "~1,1$" 12.0) "12.0"
 363.182 +  (cl-format nil "~1,1$" 12.0) "12.0"
 363.183 +  (cl-format nil "~1,1@$" 12.0) "+12.0"
 363.184 +  (cl-format nil "~1,1,8,' @:$" 12.0) "+   12.0"
 363.185 +  (cl-format nil "~1,1,8,' @$" 12.0) "   +12.0"
 363.186 +  (cl-format nil "~1,1,8,' :$" 12.0) "    12.0"
 363.187 +  (cl-format nil "~1,1,8,' $" 12.0) "    12.0"
 363.188 +  (cl-format nil "~1,1,8,' @:$" -12.0) "-   12.0"
 363.189 +  (cl-format nil "~1,1,8,' @$" -12.0) "   -12.0"
 363.190 +  (cl-format nil "~1,1,8,' :$" -12.0) "-   12.0"
 363.191 +  (cl-format nil "~1,1,8,' $" -12.0) "   -12.0"
 363.192 +  (cl-format nil "~1,1$" 0.001) "0.0"
 363.193 +  (cl-format nil "~2,1$" 0.001) "0.00"
 363.194 +  (cl-format nil "~1,1,6$" 0.001) "   0.0"
 363.195 +  (cl-format nil "~1,1,6$" 0.0015) "   0.0"
 363.196 +  (cl-format nil "~2,1,6$" 0.005) "  0.01"
 363.197 +  (cl-format nil "~2,1,6$" 0.01) "  0.01"
 363.198 +  (cl-format nil "~$" 0.099) "0.10"
 363.199 +  (cl-format nil "~1$" 0.099) "0.1"
 363.200 +  (cl-format nil "~1$" 0.1) "0.1"
 363.201 +  (cl-format nil "~1$" 0.99) "1.0"
 363.202 +  (cl-format nil "~1$" -0.99) "-1.0")
 363.203 +
 363.204 +(simple-tests f-tests
 363.205 +  (cl-format nil "~,1f" -12.0) "-12.0"
 363.206 +  (cl-format nil "~,0f" 9.4) "9."
 363.207 +  (cl-format nil "~,0f" 9.5) "10."
 363.208 +  (cl-format nil "~,0f" -0.99) "-1."
 363.209 +  (cl-format nil "~,1f" -0.99) "-1.0"
 363.210 +  (cl-format nil "~,2f" -0.99) "-0.99"
 363.211 +  (cl-format nil "~,3f" -0.99) "-0.990"
 363.212 +  (cl-format nil "~,0f" 0.99) "1."
 363.213 +  (cl-format nil "~,1f" 0.99) "1.0"
 363.214 +  (cl-format nil "~,2f" 0.99) "0.99"
 363.215 +  (cl-format nil "~,3f" 0.99) "0.990"
 363.216 +  (cl-format nil "~f" -1) "-1.0"
 363.217 +  (cl-format nil "~2f" -1) "-1."
 363.218 +  (cl-format nil "~3f" -1) "-1."
 363.219 +  (cl-format nil "~4f" -1) "-1.0"
 363.220 +  (cl-format nil "~8f" -1) "    -1.0"
 363.221 +  (cl-format nil "~1,1f" 0.1) ".1")
 363.222 +
 363.223 +(simple-tests ampersand-tests
 363.224 +  (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5)
 363.225 +  "The quick brown elephant jumped over 5 lazy dogs"
 363.226 +  (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5)
 363.227 +  "The quick brown \nelephant jumped over 5 lazy dogs"
 363.228 +  (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
 363.229 +  "The quick brown \nelephant jumped\n over 5 lazy dogs"
 363.230 +  (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
 363.231 +  "The quick brown \nelephant jumped\n over 5 lazy dogs"
 363.232 +  (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5)
 363.233 +  "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs"
 363.234 +  (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10)
 363.235 +  "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs"
 363.236 +  (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n"
 363.237 +  (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n")
 363.238 +
 363.239 +(simple-tests t-tests
 363.240 +  (cl-format nil "~@{~&~A~8,4T~:*~A~}" 
 363.241 +             'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
 363.242 +  "a       a\naa      aa\naaa     aaa\naaaa    aaaa\naaaaa   aaaaa\naaaaaa  aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa    aaaaaaaa\naaaaaaaaa   aaaaaaaaa\naaaaaaaaaa  aaaaaaaaaa"
 363.243 +  (cl-format nil "~@{~&~A~,4T~:*~A~}" 
 363.244 +             'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
 363.245 +  "a    a\naa   aa\naaa  aaa\naaaa aaaa\naaaaa    aaaaa\naaaaaa   aaaaaa\naaaaaaa  aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa    aaaaaaaaa\naaaaaaaaaa   aaaaaaaaaa"
 363.246 +  (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
 363.247 +  "a     a\naa    aa\naaa   aaa\naaaa  aaaa\naaaaa       aaaaa\naaaaaa      aaaaaa\naaaaaaa     aaaaaaa\naaaaaaaa    aaaaaaaa\naaaaaaaaa   aaaaaaaaa\naaaaaaaaaa  aaaaaaaaaa"
 363.248 +)
 363.249 +
 363.250 +(simple-tests paren-tests
 363.251 +  (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here"
 363.252 +  (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here"
 363.253 +  (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT"
 363.254 +  (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!"
 363.255 +  ;; Test cases from CLtL 18.3 - string-upcase, et al.
 363.256 +  (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" 
 363.257 +  (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" 
 363.258 +  (cl-format nil "~:(~A~)" " hello ") " Hello " 
 363.259 +  (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") 
 363.260 +  "Occluded Casements Forestall Inadvertent Defenestration" 
 363.261 +  (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" 
 363.262 +  (cl-format nil "~:(~A~)" "DON'T!") "Don'T!"     ;not "Don't!" 
 363.263 +  (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c"
 363.264 +)
 363.265 +
 363.266 +(simple-tests square-bracket-tests
 363.267 +  ;; Tests for format without modifiers
 363.268 +  (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n"
 363.269 +  (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n"
 363.270 +  (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n"
 363.271 +  (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n"
 363.272 +  (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n"
 363.273 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n"
 363.274 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n"
 363.275 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n"
 363.276 +  (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n"
 363.277 +
 363.278 +  ;; Tests for format with a colon 
 363.279 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n"
 363.280 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n"
 363.281 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n"
 363.282 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n"
 363.283 +  (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n"
 363.284 +
 363.285 +  ;; Tests for format with an at sign
 363.286 +  (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n"
 363.287 +  (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17)
 363.288 +  "We had 15 wins (out of 17 tries).\n"
 363.289 +
 363.290 +  ;; Format tests with directives
 363.291 +  (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7)
 363.292 +  "Max 15: Blue team 7.\n"
 363.293 +  (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12)
 363.294 +  "Max 15: Red team 12.\n"
 363.295 +  (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 
 363.296 +             15, -1, "(system failure)")
 363.297 +  "Max 15: No team (system failure).\n"
 363.298 +
 363.299 +  ;; Nested format tests
 363.300 +  (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" 
 363.301 +             15, 0, 7, true)
 363.302 +  "Max 15: Blue team 7 (complete success).\n"
 363.303 +  (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" 
 363.304 +             15, 0, 7, false)
 363.305 +  "Max 15: Blue team 7.\n"
 363.306 +
 363.307 +  ;; Test the selector as part of the argument
 363.308 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].")
 363.309 +  "The answer is nothing."
 363.310 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4)
 363.311 +  "The answer is 4."
 363.312 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22)
 363.313 +  "The answer is 7 out of 22."
 363.314 +  (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4)
 363.315 +  "The answer is something crazy."
 363.316 +)
 363.317 +
 363.318 +(simple-tests curly-brace-plain-tests
 363.319 +  ;; Iteration from sublist
 363.320 +  (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
 363.321 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 363.322 +
 363.323 +  (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
 363.324 +  "Coordinates are [0,1] [1,0]\n"
 363.325 +
 363.326 +  (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
 363.327 +  "Coordinates are\n"
 363.328 +
 363.329 +  (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
 363.330 +  "Coordinates are none\n"
 363.331 +
 363.332 +  (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1])
 363.333 +  "Coordinates are [2,3] <1>\n"
 363.334 +
 363.335 +  (cl-format nil "Coordinates are~{~:}~%" "" [])
 363.336 +  "Coordinates are\n"
 363.337 +
 363.338 +  (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1])
 363.339 +  "Coordinates are [2,3] <1>\n"
 363.340 +
 363.341 +  (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
 363.342 +  "Coordinates are none\n"
 363.343 +)
 363.344 +
 363.345 +
 363.346 +(simple-tests curly-brace-colon-tests
 363.347 +  ;; Iteration from list of sublists
 363.348 +  (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
 363.349 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 363.350 +
 363.351 +  (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ])
 363.352 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 363.353 +
 363.354 +  (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
 363.355 +  "Coordinates are [0,1] [1,0]\n"
 363.356 +
 363.357 +  (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
 363.358 +  "Coordinates are\n"
 363.359 +
 363.360 +  (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
 363.361 +  "Coordinates are none\n"
 363.362 +
 363.363 +  (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]])
 363.364 +  "Coordinates are [2,3] <1>\n"
 363.365 +
 363.366 +  (cl-format nil "Coordinates are~:{~:}~%" "" [])
 363.367 +  "Coordinates are\n"
 363.368 +
 363.369 +  (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]])
 363.370 +  "Coordinates are [2,3] <1>\n"
 363.371 +
 363.372 +  (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
 363.373 +  "Coordinates are none\n"
 363.374 +)
 363.375 +
 363.376 +(simple-tests curly-brace-at-tests
 363.377 +  ;; Iteration from main list
 363.378 +  (cl-format nil "Coordinates are~@{ [~D,~D]~}~%"  0, 1, 1, 0, 3, 5, 2, 1)
 363.379 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 363.380 +
 363.381 +  (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1)
 363.382 +  "Coordinates are [0,1] [1,0]\n"
 363.383 +
 363.384 +  (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
 363.385 +  "Coordinates are\n"
 363.386 +
 363.387 +  (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
 363.388 +  "Coordinates are none\n"
 363.389 +
 363.390 +  (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1)
 363.391 +  "Coordinates are [2,3] <1>\n"
 363.392 +
 363.393 +  (cl-format nil "Coordinates are~@{~:}~%" "")
 363.394 +  "Coordinates are\n"
 363.395 +
 363.396 +  (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1)
 363.397 +  "Coordinates are [2,3] <1>\n"
 363.398 +
 363.399 +  (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
 363.400 +  "Coordinates are none\n"
 363.401 +)
 363.402 +
 363.403 +(simple-tests curly-brace-colon-at-tests
 363.404 +  ;; Iteration from sublists on the main arg list
 363.405 +  (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%"  [0, 1], [1, 0], [3, 5], [2, 1] )
 363.406 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 363.407 +
 363.408 +  (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] )
 363.409 +  "Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
 363.410 +
 363.411 +  (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1])
 363.412 +  "Coordinates are [0,1] [1,0]\n"
 363.413 +
 363.414 +  (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
 363.415 +  "Coordinates are\n"
 363.416 +
 363.417 +  (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
 363.418 +  "Coordinates are none\n"
 363.419 +
 363.420 +  (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1])
 363.421 +  "Coordinates are [2,3] <1>\n"
 363.422 +
 363.423 +  (cl-format nil "Coordinates are~@:{~:}~%" "")
 363.424 +  "Coordinates are\n"
 363.425 +
 363.426 +  (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1])
 363.427 +  "Coordinates are [2,3] <1>\n"
 363.428 +
 363.429 +  (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
 363.430 +  "Coordinates are none\n"
 363.431 +)
 363.432 +
 363.433 +;; TODO tests for ~^ in ~[ constructs and other brackets
 363.434 +;; TODO test ~:^ generates an error when used improperly
 363.435 +;; TODO test ~:^ works in ~@:{...~}
 363.436 +(let [aseq '(a quick brown fox jumped over the lazy dog)
 363.437 +      lseq (mapcat identity (for [x aseq] [x (.length (name x))]))]
 363.438 +  (simple-tests up-tests
 363.439 +    (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog"
 363.440 +    (cl-format nil "~{~a~0^, ~}" aseq) "a"
 363.441 +    (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over"
 363.442 +    (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox"
 363.443 +    (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox"
 363.444 +))
 363.445 +
 363.446 +(simple-tests angle-bracket-tests
 363.447 +  (cl-format nil "~<foo~;bar~;baz~>") "foobarbaz"
 363.448 +  (cl-format nil "~20<foo~;bar~;baz~>") "foo      bar     baz"
 363.449 +  (cl-format nil "~,,2<foo~;bar~;baz~>") "foo  bar  baz"
 363.450 +  (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo      bar     baz"
 363.451 +  (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") "    foo    bar   baz"
 363.452 +  (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo    bar    baz   "
 363.453 +  (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") "   foo   bar   baz  "
 363.454 +  (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo  bar  baz"
 363.455 +  (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo      bar     baz"
 363.456 +  (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz"
 363.457 +  (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo      bar     baz"
 363.458 +  (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo              bar"
 363.459 +  (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo                 "
 363.460 +  (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") "                 foo"
 363.461 +)
 363.462 +
 363.463 +(simple-tests angle-bracket-max-column-tests
 363.464 +  (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")))
 363.465 +  "\n;;  This function computes the circular\n;;  thermodynamic coefficient of the thrombulator\n;;  angle for use in determining the reaction\n;;  distance.\n"
 363.466 +(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"))))
 363.467 +
 363.468 +(defn list-to-table [aseq column-width]
 363.469 +  (let [stream (get-pretty-writer (java.io.StringWriter.))]
 363.470 +    (binding [*out* stream]
 363.471 +     (doseq [row aseq]
 363.472 +       (doseq [col row]
 363.473 +         (cl-format true "~4D~7,vT" col column-width))
 363.474 +       (prn)))
 363.475 +    (.flush stream)
 363.476 +    (.toString (:base @@(:base @@stream)))))
 363.477 +
 363.478 +(simple-tests column-writer-test
 363.479 +  (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8)
 363.480 +  "   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")
 363.481 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 363.482 +;; The following tests are the various examples from the format
 363.483 +;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3
 363.484 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 363.485 +
 363.486 +(defn expt [base pow] (reduce * (repeat pow base)))
 363.487 +
 363.488 +(let [x 5, y "elephant", n 3]
 363.489 +  (simple-tests cltl-intro-tests
 363.490 +   (format nil "foo")  "foo" 
 363.491 +   (format nil "The answer is ~D." x)  "The answer is 5." 
 363.492 +   (format nil "The answer is ~3D." x)  "The answer is   5." 
 363.493 +   (format nil "The answer is ~3,'0D." x)  "The answer is 005." 
 363.494 +   (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007."
 363.495 +   (format nil "Look at the ~A!" y)  "Look at the elephant!" 
 363.496 +   (format nil "Type ~:C to ~A." (char 4) "delete all your files") 
 363.497 +   "Type Control-D to delete all your files."
 363.498 +   (format nil "~D item~:P found." n)  "3 items found."
 363.499 +   (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here."
 363.500 +   (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here."
 363.501 +   (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies."))
 363.502 + 
 363.503 +(simple-tests cltl-B-tests
 363.504 +  ;; CLtL didn't have the colons here, but the spec requires them
 363.505 +  (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" 
 363.506 +  (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" 
 363.507 +  (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" 
 363.508 +  ;; This one was a nice idea, but nothing in the spec supports it working this way
 363.509 +  ;; (and SBCL doesn't work this way either)
 363.510 +  ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110")
 363.511 +  )
 363.512 +
 363.513 +(simple-tests cltl-P-tests
 363.514 +  (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" 
 363.515 +  (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" 
 363.516 +  (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins")
 363.517 +
 363.518 +(defn foo [x] 
 363.519 +  (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" 
 363.520 +          x x x x x x))
 363.521 +
 363.522 +(simple-tests cltl-F-tests
 363.523 +  (foo 3.14159)  "  3.14| 31.42|  3.14|3.1416|3.14|3.14159" 
 363.524 +  (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" 
 363.525 +  (foo 100.0)    "100.00|******|100.00| 100.0|100.00|100.0" 
 363.526 +  (foo 1234.0)   "1234.00|******|??????|1234.0|1234.00|1234.0" 
 363.527 +  (foo 0.006)    "  0.01|  0.06|  0.01| 0.006|0.01|0.006")
 363.528 +
 363.529 +(defn foo-e [x] 
 363.530 +  (format nil 
 363.531 +          "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" 
 363.532 +          x x x x)) 
 363.533 +
 363.534 +;; Clojure doesn't support float/double differences in representation
 363.535 +(simple-tests cltl-E-tests
 363.536 +  (foo-e 0.0314159) "  3.14E-2| 31.42$-03|+.003E+01|  3.14E-2"  ; Added this one 
 363.537 +  (foo-e 3.14159)  "  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0" 
 363.538 +  (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
 363.539 +  (foo-e 1100.0)   "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3" 
 363.540 +; In Clojure, this is identical to the above
 363.541 +;  (foo-e 1100.0L0) "  1.10L+3| 11.00$+02|+.001L+06|  1.10L+3" 
 363.542 +  (foo-e 1.1E13)   "*********| 11.00$+12|+.001E+16| 1.10E+13" 
 363.543 +  (foo-e 1.1E120)  "*********|??????????|%%%%%%%%%|1.10E+120" 
 363.544 +; Clojure doesn't support real numbers this large
 363.545 +;  (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200"
 363.546 +)
 363.547 +
 363.548 +(simple-tests cltl-E-scale-tests
 363.549 +  (map
 363.550 +    (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" 
 363.551 +                    (- k 5) 3.14159))              ;Prints 13 lines 
 363.552 +    (range 13))
 363.553 +  '("Scale factor -5: | 0.000003E+06|"
 363.554 +    "Scale factor -4: | 0.000031E+05|"
 363.555 +    "Scale factor -3: | 0.000314E+04|"
 363.556 +    "Scale factor -2: | 0.003142E+03|"
 363.557 +    "Scale factor -1: | 0.031416E+02|"
 363.558 +    "Scale factor  0: | 0.314159E+01|"
 363.559 +    "Scale factor  1: | 3.141590E+00|"
 363.560 +    "Scale factor  2: | 31.41590E-01|"
 363.561 +    "Scale factor  3: | 314.1590E-02|"
 363.562 +    "Scale factor  4: | 3141.590E-03|"
 363.563 +    "Scale factor  5: | 31415.90E-04|"
 363.564 +    "Scale factor  6: | 314159.0E-05|"
 363.565 +    "Scale factor  7: | 3141590.E-06|"))
 363.566 +
 363.567 +(defn foo-g [x] 
 363.568 +  (format nil 
 363.569 +          "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" 
 363.570 +          x x x x)) 
 363.571 +
 363.572 +;; Clojure doesn't support float/double differences in representation
 363.573 +(simple-tests cltl-G-tests
 363.574 +  (foo-g 0.0314159) "  3.14E-2|314.2$-04|0.314E-01|  3.14E-2" 
 363.575 +  (foo-g 0.314159)  "  0.31   |0.314    |0.314    | 0.31    " 
 363.576 +  (foo-g 3.14159)   "   3.1   | 3.14    | 3.14    |  3.1    " 
 363.577 +  (foo-g 31.4159)   "   31.   | 31.4    | 31.4    |  31.    " 
 363.578 +  (foo-g 314.159)   "  3.14E+2| 314.    | 314.    |  3.14E+2" 
 363.579 +  (foo-g 3141.59)   "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3" 
 363.580 +; In Clojure, this is identical to the above
 363.581 +;  (foo-g 3141.59L0) "  3.14L+3|314.2$+01|0.314L+04|  3.14L+3" 
 363.582 +  (foo-g 3.14E12)   "*********|314.0$+10|0.314E+13| 3.14E+12" 
 363.583 +  (foo-g 3.14E120)  "*********|?????????|%%%%%%%%%|3.14E+120" 
 363.584 +; Clojure doesn't support real numbers this large
 363.585 +;  (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200"
 363.586 +)
 363.587 +
 363.588 +(defn type-clash-error [fun nargs argnum right-type wrong-type]
 363.589 +  (format nil ;; CLtL has this format string slightly wrong
 363.590 +          "~&Function ~S requires its ~:[~:R ~;~*~]~
 363.591 +           argument to be of type ~S,~%but it was called ~
 363.592 +           with an argument of type ~S.~%" 
 363.593 +          fun (= nargs 1) argnum right-type wrong-type)) 
 363.594 +
 363.595 +(simple-tests cltl-Newline-tests
 363.596 +  (type-clash-error 'aref nil 2 'integer 'vector)
 363.597 +"Function aref requires its second argument to be of type integer,
 363.598 +but it was called with an argument of type vector.\n"
 363.599 +  (type-clash-error 'car 1 1 'list 'short-float)
 363.600 +"Function car requires its argument to be of type list,
 363.601 +but it was called with an argument of type short-float.\n")
 363.602 +
 363.603 +(simple-tests cltl-?-tests
 363.604 +  (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) "<Foo 5> 7" 
 363.605 +  (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) "<Foo 5> 7"
 363.606 +  (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) "<Foo 5> 7" 
 363.607 +  (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) "<Foo 5> 14")
 363.608 +
 363.609 +(defn f [n] (format nil "~@(~R~) error~:P detected." n)) 
 363.610 +
 363.611 +(simple-tests cltl-paren-tests
 363.612 +  (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" 
 363.613 +  (f 0) "Zero errors detected." 
 363.614 +  (f 1) "One error detected." 
 363.615 +  (f 23) "Twenty-three errors detected.")
 363.616 +
 363.617 +(let [*print-level* nil *print-length* 5] 
 363.618 +  (simple-tests cltl-bracket-tests
 363.619 +    (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" 
 363.620 +            *print-level* *print-length*) 
 363.621 +    " print length = 5"))
 363.622 +
 363.623 +(let [foo "Items:~#[ none~; ~S~; ~S and ~S~
 363.624 +           ~:;~@{~#[~; and~] ~
 363.625 +           ~S~^,~}~]."]
 363.626 +  (simple-tests cltl-bracket1-tests
 363.627 +    (format nil foo) "Items: none." 
 363.628 +    (format nil foo 'foo) "Items: foo." 
 363.629 +    (format nil foo 'foo 'bar) "Items: foo and bar." 
 363.630 +    (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." 
 363.631 +    (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux."))
 363.632 +
 363.633 +(simple-tests cltl-curly-bracket-tests
 363.634 +  (format nil 
 363.635 +        "The winners are:~{ ~S~}." 
 363.636 +        '(fred harry jill)) 
 363.637 +  "The winners are: fred harry jill." 
 363.638 +
 363.639 +  (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) 
 363.640 +  "Pairs: <a,1> <b,2> <c,3>."
 363.641 +
 363.642 +  (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) 
 363.643 +  "Pairs: <a,1> <b,2> <c,3>."
 363.644 +
 363.645 +  (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) 
 363.646 +  "Pairs: <a,1> <b,2> <c,3>."
 363.647 +
 363.648 +  (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) 
 363.649 +  "Pairs: <a,1> <b,2> <c,3>.")
 363.650 +
 363.651 +(simple-tests cltl-angle-bracket-tests
 363.652 +  (format nil "~10<foo~;bar~>")           "foo    bar" 
 363.653 +  (format nil "~10:<foo~;bar~>")          "  foo  bar" 
 363.654 +  (format nil "~10:@<foo~;bar~>")         "  foo bar " 
 363.655 +  (format nil "~10<foobar~>")             "    foobar" 
 363.656 +  (format nil "~10:<foobar~>")            "    foobar" 
 363.657 +  (format nil "~10@<foobar~>")            "foobar    " 
 363.658 +  (format nil "~10:@<foobar~>")           "  foobar  ")
 363.659 +
 363.660 +(let [donestr "Done.~^  ~D warning~:P.~^  ~D error~:P."
 363.661 +      tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here
 363.662 +
 363.663 +  (simple-tests cltl-up-tests
 363.664 +    (format nil donestr) "Done." 
 363.665 +    (format nil donestr 3) "Done.  3 warnings." 
 363.666 +    (format nil donestr 1 5) "Done.  1 warning.  5 errors."
 363.667 +    (format nil tellstr 23) "Twenty-three." 
 363.668 +    (format nil tellstr nil "losers") "Losers." 
 363.669 +    (format nil tellstr 23 "losers") "Twenty-three losers."
 363.670 +    (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) 
 363.671 +    "            foo" 
 363.672 +    (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) 
 363.673 +    "foo         bar" 
 363.674 +    (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) 
 363.675 +    "foo   bar   baz"))
 363.676 +
 363.677 +(simple-tests cltl-up-x3j13-tests
 363.678 +  (format nil 
 363.679 +          "~:{/~S~^ ...~}" 
 363.680 +          '((hot dog) (hamburger) (ice cream) (french fries))) 
 363.681 +  "/hot .../hamburger/ice .../french ..."
 363.682 +  (format nil 
 363.683 +          "~:{/~S~:^ ...~}" 
 363.684 +          '((hot dog) (hamburger) (ice cream) (french fries))) 
 363.685 +  "/hot .../hamburger .../ice .../french"
 363.686 +
 363.687 +  (format nil 
 363.688 +          "~:{/~S~#:^ ...~}"  ;; This is wrong in CLtL
 363.689 +          '((hot dog) (hamburger) (ice cream) (french fries))) 
 363.690 +  "/hot .../hamburger")
 363.691 +
   364.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   364.2 +++ b/src/clojure/test_clojure/pprint/test_helper.clj	Sat Aug 21 06:25:44 2010 -0400
   364.3 @@ -0,0 +1,27 @@
   364.4 +;;; test_helper.clj -- part of the pretty printer for Clojure
   364.5 +
   364.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   364.7 +;   The use and distribution terms for this software are covered by the
   364.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   364.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  364.10 +;   By using this software in any fashion, you are agreeing to be bound by
  364.11 +;   the terms of this license.
  364.12 +;   You must not remove this notice, or any other, from this software.
  364.13 +
  364.14 +;; Author: Tom Faulhaber
  364.15 +;; April 3, 2009
  364.16 +
  364.17 +
  364.18 +;; This is just a macro to make my tests a little cleaner
  364.19 +
  364.20 +(ns clojure.test-clojure.pprint.test-helper
  364.21 +  (:use [clojure.test :only (deftest is)]))
  364.22 +
  364.23 +(defn- back-match [x y] (re-matches y x))
  364.24 +(defmacro simple-tests [name & test-pairs]
  364.25 +  `(deftest ~name
  364.26 +     ~@(for [[x y] (partition 2 test-pairs)]
  364.27 +         (if (instance? java.util.regex.Pattern y)
  364.28 +           `(is (#'clojure.test-clojure.pprint.test-helper/back-match ~x ~y))
  364.29 +           `(is (= ~x ~y))))))
  364.30 +
   365.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   365.2 +++ b/src/clojure/test_clojure/pprint/test_pretty.clj	Sat Aug 21 06:25:44 2010 -0400
   365.3 @@ -0,0 +1,275 @@
   365.4 +;;; test_pretty.clj -- part of the pretty printer for Clojure
   365.5 +
   365.6 +;   Copyright (c) Rich Hickey. All rights reserved.
   365.7 +;   The use and distribution terms for this software are covered by the
   365.8 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   365.9 +;   which can be found in the file epl-v10.html at the root of this distribution.
  365.10 +;   By using this software in any fashion, you are agreeing to be bound by
  365.11 +;   the terms of this license.
  365.12 +;   You must not remove this notice, or any other, from this software.
  365.13 +
  365.14 +;; Author: Tom Faulhaber
  365.15 +;; April 3, 2009
  365.16 +
  365.17 +
  365.18 +(in-ns 'clojure.test-clojure.pprint)
  365.19 +
  365.20 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  365.21 +;;;
  365.22 +;;; Unit tests for the pretty printer
  365.23 +;;;
  365.24 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  365.25 +
  365.26 +(simple-tests xp-fill-test
  365.27 +  (binding [*print-pprint-dispatch* simple-dispatch
  365.28 +            *print-right-margin* 38
  365.29 +            *print-miser-width* nil]
  365.30 +    (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
  365.31 +               '((x 4) (*print-length* nil) (z 2) (list nil))))
  365.32 +  "(let ((x 4) (*print-length* nil)\n      (z 2) (list nil))\n ...)\n"
  365.33 +
  365.34 +  (binding [*print-pprint-dispatch* simple-dispatch
  365.35 +            *print-right-margin* 22]
  365.36 +    (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
  365.37 +               '((x 4) (*print-length* nil) (z 2) (list nil))))
  365.38 +  "(let ((x 4)\n      (*print-length*\n       nil)\n      (z 2)\n      (list nil))\n ...)\n")
  365.39 +
  365.40 +(simple-tests xp-miser-test
  365.41 +  (binding [*print-pprint-dispatch* simple-dispatch
  365.42 +            *print-right-margin* 10, *print-miser-width* 9]
  365.43 +    (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
  365.44 +  "(LIST\n first\n second\n third)"
  365.45 +
  365.46 +  (binding [*print-pprint-dispatch* simple-dispatch
  365.47 +            *print-right-margin* 10, *print-miser-width* 8]
  365.48 +    (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
  365.49 +  "(LIST first second third)")
  365.50 +
  365.51 +(simple-tests mandatory-fill-test
  365.52 +  (cl-format nil
  365.53 +             "<pre>~%~<Usage: ~:I~@{*~a*~^~:@_~}~:>~%</pre>~%"
  365.54 +             [ "hello" "gooodbye" ])
  365.55 +  "<pre>
  365.56 +Usage: *hello*
  365.57 +       *gooodbye*
  365.58 +</pre>
  365.59 +")
  365.60 +
  365.61 +(simple-tests prefix-suffix-test
  365.62 +  (binding [*print-pprint-dispatch* simple-dispatch
  365.63 +            *print-right-margin* 10, *print-miser-width* 10]
  365.64 +    (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third)))
  365.65 +  "{LIST\n first\n second\n third}")
  365.66 +
  365.67 +(simple-tests pprint-test
  365.68 +  (binding [*print-pprint-dispatch* simple-dispatch]
  365.69 +    (write '(defn foo [x y] 
  365.70 +              (let [result (* x y)] 
  365.71 +                (if (> result 400) 
  365.72 +                  (cl-format true "That number is too big")
  365.73 +                  (cl-format true "The  result of ~d x ~d is ~d" x y result))))
  365.74 +           :stream nil))
  365.75 +  "(defn
  365.76 + foo
  365.77 + [x y]
  365.78 + (let
  365.79 +  [result (* x y)]
  365.80 +  (if
  365.81 +   (> result 400)
  365.82 +   (cl-format true \"That number is too big\")
  365.83 +   (cl-format true \"The  result of ~d x ~d is ~d\" x y result))))"
  365.84 +
  365.85 +  (with-pprint-dispatch code-dispatch
  365.86 +    (write '(defn foo [x y] 
  365.87 +              (let [result (* x y)] 
  365.88 +                (if (> result 400) 
  365.89 +                  (cl-format true "That number is too big")
  365.90 +                  (cl-format true "The  result of ~d x ~d is ~d" x y result))))
  365.91 +           :stream nil))
  365.92 +  "(defn foo [x y]
  365.93 +  (let [result (* x y)]
  365.94 +    (if (> result 400)
  365.95 +      (cl-format true \"That number is too big\")
  365.96 +      (cl-format true \"The  result of ~d x ~d is ~d\" x y result))))"
  365.97 +
  365.98 +  (binding [*print-pprint-dispatch* simple-dispatch
  365.99 +            *print-right-margin* 15] 
 365.100 +    (write '(fn (cons (car x) (cdr y))) :stream nil))
 365.101 +  "(fn\n (cons\n  (car x)\n  (cdr y)))"
 365.102 +
 365.103 +  (with-pprint-dispatch code-dispatch
 365.104 +    (binding [*print-right-margin* 52] 
 365.105 +      (write 
 365.106 +       '(add-to-buffer this (make-buffer-blob (str (char c)) nil))
 365.107 +       :stream nil)))
 365.108 +  "(add-to-buffer\n  this\n  (make-buffer-blob (str (char c)) nil))"
 365.109 +  )
 365.110 +
 365.111 +
 365.112 +
 365.113 +(simple-tests pprint-reader-macro-test
 365.114 +  (with-pprint-dispatch code-dispatch
 365.115 +    (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])")
 365.116 +	   :stream nil))
 365.117 +  "(map #(first %) [[1 2 3] [4 5 6] [7]])"
 365.118 +
 365.119 +  (with-pprint-dispatch code-dispatch
 365.120 +    (write (read-string "@@(ref (ref 1))")
 365.121 +	   :stream nil))
 365.122 +  "@@(ref (ref 1))"
 365.123 +
 365.124 +  (with-pprint-dispatch code-dispatch
 365.125 +    (write (read-string "'foo")
 365.126 +	   :stream nil))
 365.127 +  "'foo"
 365.128 +)
 365.129 +
 365.130 +(simple-tests code-block-tests 
 365.131 + (with-out-str
 365.132 +   (with-pprint-dispatch code-dispatch 
 365.133 +     (pprint 
 365.134 +      '(defn cl-format 
 365.135 +         "An implementation of a Common Lisp compatible format function"
 365.136 +         [stream format-in & args]
 365.137 +         (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
 365.138 +               navigator (init-navigator args)]
 365.139 +           (execute-format stream compiled-format navigator))))))
 365.140 + "(defn cl-format
 365.141 +  \"An implementation of a Common Lisp compatible format function\"
 365.142 +  [stream format-in & args]
 365.143 +  (let [compiled-format (if (string? format-in)
 365.144 +                          (compile-format format-in)
 365.145 +                          format-in)
 365.146 +        navigator (init-navigator args)]
 365.147 +    (execute-format stream compiled-format navigator)))
 365.148 +"
 365.149 +
 365.150 + (with-out-str
 365.151 +   (with-pprint-dispatch code-dispatch 
 365.152 +     (pprint 
 365.153 +      '(defn pprint-defn [writer alis]
 365.154 +         (if (next alis) 
 365.155 +           (let [[defn-sym defn-name & stuff] alis
 365.156 +                 [doc-str stuff] (if (string? (first stuff))
 365.157 +                                   [(first stuff) (next stuff)]
 365.158 +                                   [nil stuff])
 365.159 +                 [attr-map stuff] (if (map? (first stuff))
 365.160 +                                    [(first stuff) (next stuff)]
 365.161 +                                    [nil stuff])]
 365.162 +             (pprint-logical-block writer :prefix "(" :suffix ")"
 365.163 +                                   (cl-format true "~w ~1I~@_~w" defn-sym defn-name)
 365.164 +                                   (if doc-str
 365.165 +                                     (cl-format true " ~_~w" doc-str))
 365.166 +                                   (if attr-map
 365.167 +                                     (cl-format true " ~_~w" attr-map))
 365.168 +                                   ;; Note: the multi-defn case will work OK for malformed defns too
 365.169 +                                   (cond
 365.170 +                                    (vector? (first stuff)) (single-defn stuff (or doc-str attr-map))
 365.171 +                                    :else (multi-defn stuff (or doc-str attr-map)))))
 365.172 +           (pprint-simple-code-list writer alis))))))
 365.173 + "(defn pprint-defn [writer alis]
 365.174 +  (if (next alis)
 365.175 +    (let [[defn-sym defn-name & stuff] alis
 365.176 +          [doc-str stuff] (if (string? (first stuff))
 365.177 +                            [(first stuff) (next stuff)]
 365.178 +                            [nil stuff])
 365.179 +          [attr-map stuff] (if (map? (first stuff))
 365.180 +                             [(first stuff) (next stuff)]
 365.181 +                             [nil stuff])]
 365.182 +      (pprint-logical-block
 365.183 +        writer
 365.184 +        :prefix
 365.185 +        \"(\"
 365.186 +        :suffix
 365.187 +        \")\"
 365.188 +        (cl-format true \"~w ~1I~@_~w\" defn-sym defn-name)
 365.189 +        (if doc-str (cl-format true \" ~_~w\" doc-str))
 365.190 +        (if attr-map (cl-format true \" ~_~w\" attr-map))
 365.191 +        (cond
 365.192 +          (vector? (first stuff)) (single-defn
 365.193 +                                    stuff
 365.194 +                                    (or doc-str attr-map))
 365.195 +          :else (multi-defn stuff (or doc-str attr-map)))))
 365.196 +    (pprint-simple-code-list writer alis)))
 365.197 +")
 365.198 +
 365.199 +
 365.200 +(defn tst-pprint
 365.201 +  "A helper function to pprint to a string with a restricted right margin"
 365.202 +  [right-margin obj]
 365.203 +  (binding [*print-right-margin* right-margin
 365.204 +            *print-pretty* true]
 365.205 +    (write obj :stream nil)))
 365.206 +
 365.207 +;;; A bunch of predefined data to print
 365.208 +(def future-filled (future-call (fn [] 100)))
 365.209 +@future-filled
 365.210 +(def future-unfilled (future-call (fn [] (.acquire (java.util.concurrent.Semaphore. 0)))))
 365.211 +(def promise-filled (promise))
 365.212 +(deliver promise-filled '(first second third))
 365.213 +(def promise-unfilled (promise))
 365.214 +(def basic-agent (agent '(first second third)))
 365.215 +(defn failed-agent
 365.216 +  "must be a fn because you cannot await agents during load"
 365.217 +  []
 365.218 +  (let [a (agent "foo")]
 365.219 +    (send a +)
 365.220 +    (try (await-for 100 failed-agent) (catch RuntimeException re))
 365.221 +    a))
 365.222 +(def basic-atom (atom '(first second third)))
 365.223 +(def basic-ref (ref '(first second third)))
 365.224 +(def delay-forced (delay '(first second third)))
 365.225 +(force delay-forced)
 365.226 +(def delay-unforced (delay '(first second third)))
 365.227 +(defrecord pprint-test-rec [a b c])
 365.228 +
 365.229 +(simple-tests pprint-datastructures-tests
 365.230 + (tst-pprint 20 future-filled) #"#<Future@[0-9a-f]+: \n  100>"
 365.231 + (tst-pprint 20 future-unfilled) #"#<Future@[0-9a-f]+: \n  :pending>"
 365.232 + (tst-pprint 20 promise-filled) #"#<Promise@[0-9a-f]+: \n  \(first\n   second\n   third\)>"
 365.233 + ;; This hangs currently, cause we can't figure out whether a promise is filled
 365.234 + ;;(tst-pprint 20 promise-unfilled) #"#<Promise@[0-9a-f]+: \n  :pending>"
 365.235 + (tst-pprint 20 basic-agent) #"#<Agent@[0-9a-f]+: \n  \(first\n   second\n   third\)>"
 365.236 + (tst-pprint 20 (failed-agent)) #"#<Agent@[0-9a-f]+ FAILED: \n  \"foo\">"
 365.237 + (tst-pprint 20 basic-atom) #"#<Atom@[0-9a-f]+: \n  \(first\n   second\n   third\)>"
 365.238 + (tst-pprint 20 basic-ref) #"#<Ref@[0-9a-f]+: \n  \(first\n   second\n   third\)>"
 365.239 + (tst-pprint 20 delay-forced) #"#<Delay@[0-9a-f]+: \n  \(first\n   second\n   third\)>"
 365.240 + ;; Currently no way not to force the delay
 365.241 + ;;(tst-pprint 20 delay-unforced) #"#<Delay@[0-9a-f]+: \n  :pending>"
 365.242 + (tst-pprint 20 (pprint-test-rec. 'first 'second 'third)) "{:a first,\n :b second,\n :c third}"
 365.243 +
 365.244 + ;; basic java arrays: fails owing to assembla ticket #346
 365.245 + ;;(tst-pprint 10 (int-array (range 7))) "[0,\n 1,\n 2,\n 3,\n 4,\n 5,\n 6]"
 365.246 + (tst-pprint 15 (reduce conj clojure.lang.PersistentQueue/EMPTY (range 10)))
 365.247 + "<-(0\n   1\n   2\n   3\n   4\n   5\n   6\n   7\n   8\n   9)-<"
 365.248 + )
 365.249 +
 365.250 +
 365.251 +;;; Some simple tests of dispatch
 365.252 +
 365.253 +(defmulti 
 365.254 +  test-dispatch
 365.255 +  "A test dispatch method"
 365.256 +  {:added "1.2" :arglists '[[object]]} 
 365.257 +  #(and (seq %) (not (string? %))))
 365.258 +
 365.259 +(defmethod test-dispatch true [avec]
 365.260 +  (pprint-logical-block :prefix "[" :suffix "]"
 365.261 +    (loop [aseq (seq avec)]
 365.262 +      (when aseq
 365.263 +	(write-out (first aseq))
 365.264 +	(when (next aseq)
 365.265 +	  (.write ^java.io.Writer *out* " ")
 365.266 +	  (pprint-newline :linear)
 365.267 +	  (recur (next aseq)))))))
 365.268 +
 365.269 +(defmethod test-dispatch false [aval] (pr aval))
 365.270 +
 365.271 +(simple-tests dispatch-tests
 365.272 +  (with-pprint-dispatch test-dispatch
 365.273 +    (with-out-str 
 365.274 +      (pprint '("hello" "there"))))
 365.275 +  "[\"hello\" \"there\"]\n"
 365.276 +)
 365.277 +
 365.278 +
   366.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   366.2 +++ b/src/clojure/test_clojure/predicates.clj	Sat Aug 21 06:25:44 2010 -0400
   366.3 @@ -0,0 +1,142 @@
   366.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   366.5 +;   The use and distribution terms for this software are covered by the
   366.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   366.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   366.8 +;   By using this software in any fashion, you are agreeing to be bound by
   366.9 +;   the terms of this license.
  366.10 +;   You must not remove this notice, or any other, from this software.
  366.11 +
  366.12 +; Author: Frantisek Sodomka
  366.13 +
  366.14 +;;
  366.15 +;;  Created 1/28/2009
  366.16 +
  366.17 +(ns clojure.test-clojure.predicates
  366.18 +  (:use clojure.test))
  366.19 +
  366.20 +
  366.21 +;; *** Type predicates ***
  366.22 +
  366.23 +(def myvar 42)
  366.24 +
  366.25 +(def sample-data {
  366.26 +  :nil nil
  366.27 +
  366.28 +  :bool-true true
  366.29 +  :bool-false false
  366.30 +
  366.31 +  :byte   (byte 7)
  366.32 +  :short  (short 7)
  366.33 +  :int    (int 7)
  366.34 +  :long   (long 7)
  366.35 +  :bigint (bigint 7)
  366.36 +  :float  (float 7)
  366.37 +  :double (double 7)
  366.38 +  :bigdec (bigdec 7)
  366.39 +
  366.40 +  :ratio 2/3
  366.41 +
  366.42 +  :character \a
  366.43 +  :symbol 'abc
  366.44 +  :keyword :kw
  366.45 +
  366.46 +  :empty-string ""
  366.47 +  :empty-regex #""
  366.48 +  :empty-list ()
  366.49 +  :empty-lazy-seq (lazy-seq nil)
  366.50 +  :empty-vector []
  366.51 +  :empty-map {}
  366.52 +  :empty-set #{}
  366.53 +  :empty-array (into-array [])
  366.54 +
  366.55 +  :string "abc"
  366.56 +  :regex #"a*b"
  366.57 +  :list '(1 2 3)
  366.58 +  :lazy-seq (lazy-seq [1 2 3])
  366.59 +  :vector [1 2 3]
  366.60 +  :map {:a 1 :b 2 :c 3}
  366.61 +  :set #{1 2 3}
  366.62 +  :array (into-array [1 2 3])
  366.63 +
  366.64 +  :fn (fn [x] (* 2 x))
  366.65 +
  366.66 +  :class java.util.Date
  366.67 +  :object (new java.util.Date)
  366.68 +
  366.69 +  :var (var myvar)
  366.70 +  :delay (delay (+ 1 2))
  366.71 +})
  366.72 +
  366.73 +
  366.74 +(def type-preds {
  366.75 +  nil? [:nil]
  366.76 +
  366.77 +  true?  [:bool-true]
  366.78 +  false? [:bool-false]
  366.79 +  ; boolean?
  366.80 +
  366.81 +  integer?  [:byte :short :int :long :bigint]
  366.82 +  float?    [:float :double]
  366.83 +  decimal?  [:bigdec]
  366.84 +  ratio?    [:ratio]
  366.85 +  rational? [:byte :short :int :long :bigint :ratio :bigdec]
  366.86 +  number?   [:byte :short :int :long :bigint :ratio :bigdec :float :double]
  366.87 +
  366.88 +  ; character?
  366.89 +  symbol?  [:symbol]
  366.90 +  keyword? [:keyword]
  366.91 +
  366.92 +  string? [:empty-string :string]
  366.93 +  ; regex?
  366.94 +
  366.95 +  list?   [:empty-list   :list]
  366.96 +  vector? [:empty-vector :vector]
  366.97 +  map?    [:empty-map    :map]
  366.98 +  set?    [:empty-set    :set]
  366.99 +
 366.100 +  coll? [:empty-list     :list
 366.101 +         :empty-lazy-seq :lazy-seq
 366.102 +         :empty-vector   :vector
 366.103 +         :empty-map      :map
 366.104 +         :empty-set      :set]
 366.105 +
 366.106 +  seq?  [:empty-list     :list
 366.107 +         :empty-lazy-seq :lazy-seq]
 366.108 +  ; array?
 366.109 +
 366.110 +  fn?  [:fn]
 366.111 +  ifn? [:fn
 366.112 +        :empty-vector :vector :empty-map :map :empty-set :set
 366.113 +        :keyword :symbol :var]
 366.114 +
 366.115 +  class? [:class]
 366.116 +  var?   [:var]
 366.117 +  delay? [:delay]
 366.118 +})
 366.119 +
 366.120 +
 366.121 +;; Test all type predicates against all data types
 366.122 +;;
 366.123 +(defn- get-fn-name [f]
 366.124 +  (str
 366.125 +    (apply str (nthnext (first (.split (str f) "_"))
 366.126 +                        (count "clojure.core$")))
 366.127 +    "?"))
 366.128 +
 366.129 +(deftest test-type-preds
 366.130 +  (doseq [tp type-preds]
 366.131 +    (doseq [dt sample-data]
 366.132 +      (if (some #(= % (first dt)) (second tp))
 366.133 +        (is ((first tp) (second dt))
 366.134 +          (pr-str (list (get-fn-name (first tp)) (second dt))))
 366.135 +        (is (not ((first tp) (second dt)))
 366.136 +          (pr-str (list 'not (list (get-fn-name (first tp)) (second dt)))))))))
 366.137 +
 366.138 +
 366.139 +;; Additional tests:
 366.140 +;; http://groups.google.com/group/clojure/browse_thread/thread/537761a06edb4b06/bfd4f0705b746a38
 366.141 +;;
 366.142 +(deftest test-string?-more
 366.143 +  (are [x] (not (string? x))
 366.144 +    (new java.lang.StringBuilder "abc")
 366.145 +    (new java.lang.StringBuffer "xyz")))
   367.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   367.2 +++ b/src/clojure/test_clojure/printer.clj	Sat Aug 21 06:25:44 2010 -0400
   367.3 @@ -0,0 +1,83 @@
   367.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   367.5 +;   The use and distribution terms for this software are covered by the
   367.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   367.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   367.8 +;   By using this software in any fashion, you are agreeing to be bound by
   367.9 +;   the terms of this license.
  367.10 +;   You must not remove this notice, or any other, from this software.
  367.11 +
  367.12 +; Author: Stephen C. Gilardi
  367.13 +
  367.14 +;;  clojure.test-clojure.printer
  367.15 +;;
  367.16 +;;  scgilardi (gmail)
  367.17 +;;  Created 29 October 2008
  367.18 +
  367.19 +(ns clojure.test-clojure.printer
  367.20 +  (:use clojure.test))
  367.21 +
  367.22 +(deftest print-length-empty-seq
  367.23 +  (let [coll () val "()"]
  367.24 +    (is (= val (binding [*print-length* 0] (print-str coll))))
  367.25 +    (is (= val (binding [*print-length* 1] (print-str coll))))))
  367.26 +
  367.27 +(deftest print-length-seq
  367.28 +  (let [coll (range 5)
  367.29 +        length-val '((0 "(...)")
  367.30 +                     (1 "(0 ...)")
  367.31 +                     (2 "(0 1 ...)")
  367.32 +                     (3 "(0 1 2 ...)")
  367.33 +                     (4 "(0 1 2 3 ...)")
  367.34 +                     (5 "(0 1 2 3 4)"))]
  367.35 +    (doseq [[length val] length-val]
  367.36 +      (binding [*print-length* length]
  367.37 +        (is (= val (print-str coll)))))))
  367.38 +
  367.39 +(deftest print-length-empty-vec
  367.40 +  (let [coll [] val "[]"]
  367.41 +    (is (= val (binding [*print-length* 0] (print-str coll))))
  367.42 +    (is (= val (binding [*print-length* 1] (print-str coll))))))
  367.43 +
  367.44 +(deftest print-length-vec
  367.45 +  (let [coll [0 1 2 3 4]
  367.46 +        length-val '((0 "[...]")
  367.47 +                     (1 "[0 ...]")
  367.48 +                     (2 "[0 1 ...]")
  367.49 +                     (3 "[0 1 2 ...]")
  367.50 +                     (4 "[0 1 2 3 ...]")
  367.51 +                     (5 "[0 1 2 3 4]"))]
  367.52 +    (doseq [[length val] length-val]
  367.53 +      (binding [*print-length* length]
  367.54 +        (is (= val (print-str coll)))))))
  367.55 +
  367.56 +(deftest print-level-seq
  367.57 +  (let [coll '(0 (1 (2 (3 (4)))))
  367.58 +        level-val '((0 "#")
  367.59 +                    (1 "(0 #)")
  367.60 +                    (2 "(0 (1 #))")
  367.61 +                    (3 "(0 (1 (2 #)))")
  367.62 +                    (4 "(0 (1 (2 (3 #))))")
  367.63 +                    (5 "(0 (1 (2 (3 (4)))))"))]
  367.64 +    (doseq [[level val] level-val]
  367.65 +      (binding [*print-level* level]
  367.66 +        (is (= val (print-str coll)))))))
  367.67 +
  367.68 +(deftest print-level-length-coll
  367.69 +  (let [coll '(if (member x y) (+ (first x) 3) (foo (a b c d "Baz")))
  367.70 +        level-length-val
  367.71 +        '((0 1 "#")
  367.72 +          (1 1 "(if ...)")
  367.73 +          (1 2 "(if # ...)")
  367.74 +          (1 3 "(if # # ...)")
  367.75 +          (1 4 "(if # # #)")
  367.76 +          (2 1 "(if ...)")
  367.77 +          (2 2 "(if (member x ...) ...)")
  367.78 +          (2 3 "(if (member x y) (+ # 3) ...)")
  367.79 +          (3 2 "(if (member x ...) ...)")
  367.80 +          (3 3 "(if (member x y) (+ (first x) 3) ...)")
  367.81 +          (3 4 "(if (member x y) (+ (first x) 3) (foo (a b c d ...)))")
  367.82 +          (3 5 "(if (member x y) (+ (first x) 3) (foo (a b c d Baz)))"))]
  367.83 +    (doseq [[level length val] level-length-val]
  367.84 +      (binding [*print-level* level
  367.85 +                *print-length* length]
  367.86 +        (is (= val (print-str coll)))))))
   368.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   368.2 +++ b/src/clojure/test_clojure/protocols.clj	Sat Aug 21 06:25:44 2010 -0400
   368.3 @@ -0,0 +1,300 @@
   368.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   368.5 +;   The use and distribution terms for this software are covered by the
   368.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   368.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   368.8 +;   By using this software in any fashion, you are agreeing to be bound by
   368.9 +;   the terms of this license.
  368.10 +;   You must not remove this notice, or any other, from this software.
  368.11 +
  368.12 +; Author: Stuart Halloway
  368.13 +
  368.14 +(ns clojure.test-clojure.protocols
  368.15 +  (:use clojure.test clojure.test-clojure.protocols.examples)
  368.16 +  (:require [clojure.test-clojure.protocols.more-examples :as other]
  368.17 +            [clojure.set :as set]
  368.18 +            clojure.test-clojure.helpers)
  368.19 +  (:import [clojure.test_clojure.protocols.examples ExampleInterface]))
  368.20 +
  368.21 +;; temporary hack until I decide how to cleanly reload protocol
  368.22 +(defn reload-example-protocols
  368.23 +  []
  368.24 +  (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
  368.25 +                  assoc :impls {})
  368.26 +  (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
  368.27 +                  assoc :impls {})
  368.28 +  (require :reload
  368.29 +           'clojure.test-clojure.protocols.examples
  368.30 +           'clojure.test-clojure.protocols.more-examples))
  368.31 +
  368.32 +(defn method-names
  368.33 +  "return sorted list of method names on a class"
  368.34 +  [c]
  368.35 +  (->> (.getMethods c)
  368.36 +     (map #(.getName %))
  368.37 +     (sort)))
  368.38 +
  368.39 +(defrecord EmptyRecord [])
  368.40 +(defrecord TestRecord [a b])
  368.41 +(defn r
  368.42 +  ([a b] (TestRecord. a b))
  368.43 +  ([a b meta ext] (TestRecord. a b meta ext)))
  368.44 +(defrecord MapEntry [k v]
  368.45 +  java.util.Map$Entry
  368.46 +  (getKey [_] k)
  368.47 +  (getValue [_] v))
  368.48 +
  368.49 +(deftest protocols-test
  368.50 +  (testing "protocol fns have useful metadata"
  368.51 +    (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples)
  368.52 +                       :protocol #'ExampleProtocol}]
  368.53 +      (are [m f] (= (merge (quote m) common-meta)
  368.54 +                    (meta (var f)))
  368.55 +           {:name foo :arglists ([a]) :doc "method with one arg"} foo
  368.56 +           {:name bar :arglists ([a b]) :doc "method with two args"} bar
  368.57 +           {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz
  368.58 +           {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux)))
  368.59 +  (testing "protocol fns throw IllegalArgumentException if no impl matches"
  368.60 +    (is (thrown-with-msg?
  368.61 +          IllegalArgumentException
  368.62 +          #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer"
  368.63 +          (foo 10))))
  368.64 +  (testing "protocols generate a corresponding interface using _ instead of - for method names"
  368.65 +    (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))
  368.66 +  (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"
  368.67 +    (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []
  368.68 +                (foo [] "foo!"))]
  368.69 +      (is (= "foo!" (.foo obj)) "call through interface")
  368.70 +      (is (= "foo!" (foo obj)) "call through protocol")))
  368.71 +  (testing "you can implement just part of a protocol if you want"
  368.72 +    (let [obj (reify ExampleProtocol
  368.73 +                     (baz [a b] "two-arg baz!"))]
  368.74 +      (is (= "two-arg baz!" (baz obj nil)))
  368.75 +      (is (thrown? AbstractMethodError (baz obj)))))
  368.76 +  (testing "you can redefine a protocol with different methods"
  368.77 +    (eval '(defprotocol Elusive (old-method [x])))
  368.78 +    (eval '(defprotocol Elusive (new-method [x])))
  368.79 +    (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))
  368.80 +    (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\.\)"
  368.81 +          (eval '(old-method (reify Elusive (new-method [x] :new-method))))))))
  368.82 +
  368.83 +(deftype ExtendTestWidget [name])
  368.84 +(deftype HasProtocolInline []
  368.85 +  ExampleProtocol
  368.86 +  (foo [this] :inline))
  368.87 +(deftest extend-test
  368.88 +  (testing "you can extend a protocol to a class"
  368.89 +    (extend String ExampleProtocol
  368.90 +            {:foo identity})
  368.91 +    (is (= "pow" (foo "pow"))))
  368.92 +  (testing "you can have two methods with the same name. Just use namespaces!"
  368.93 +    (extend String other/SimpleProtocol
  368.94 +     {:foo (fn [s] (.toUpperCase s))})
  368.95 +    (is (= "POW" (other/foo "pow"))))
  368.96 +  (testing "you can extend deftype types"
  368.97 +    (extend
  368.98 +     ExtendTestWidget
  368.99 +     ExampleProtocol
 368.100 +     {:foo (fn [this] (str "widget " (.name this)))})
 368.101 +    (is (= "widget z" (foo (ExtendTestWidget. "z"))))))
 368.102 +
 368.103 +(deftest illegal-extending
 368.104 +  (testing "you cannot extend a protocol to a type that implements the protocol inline"
 368.105 +    (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"
 368.106 +          (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
 368.107 +                         clojure.test-clojure.protocols.examples/ExampleProtocol
 368.108 +                         {:foo (fn [_] :extended)})))))
 368.109 +  (testing "you cannot extend to an interface"
 368.110 +    (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"
 368.111 +          (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
 368.112 +                         clojure.test_clojure.protocols.examples.ExampleProtocol
 368.113 +                         {:foo (fn [_] :extended)}))))))
 368.114 +
 368.115 +(deftype ExtendsTestWidget []
 368.116 +  ExampleProtocol)
 368.117 +(deftest extends?-test
 368.118 +  (reload-example-protocols)
 368.119 +  (testing "returns false if a type does not implement the protocol at all"
 368.120 +    (is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
 368.121 +  (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
 368.122 +    (is (true? (extends? ExampleProtocol ExtendsTestWidget))))
 368.123 +  (testing "returns true if a type explicitly extends protocol"
 368.124 +    (extend
 368.125 +     ExtendsTestWidget
 368.126 +     other/SimpleProtocol
 368.127 +     {:foo identity})
 368.128 +    (is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))
 368.129 +
 368.130 +(deftype ExtendersTestWidget [])
 368.131 +(deftest extenders-test
 368.132 +  (reload-example-protocols)
 368.133 +  (testing "a fresh protocol has no extenders"
 368.134 +    (is (nil? (extenders ExampleProtocol))))
 368.135 +  (testing "extending with no methods doesn't count!"
 368.136 +    (deftype Something [])
 368.137 +    (extend ::Something ExampleProtocol)
 368.138 +    (is (nil? (extenders ExampleProtocol))))
 368.139 +  (testing "extending a protocol (and including an impl) adds an entry to extenders"
 368.140 +    (extend ExtendersTestWidget ExampleProtocol {:foo identity})
 368.141 +    (is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))
 368.142 +
 368.143 +(deftype SatisfiesTestWidget []
 368.144 +  ExampleProtocol)
 368.145 +(deftest satisifies?-test
 368.146 +  (reload-example-protocols)
 368.147 +  (let [whatzit (SatisfiesTestWidget.)]
 368.148 +    (testing "returns false if a type does not implement the protocol at all"
 368.149 +      (is (false? (satisfies? other/SimpleProtocol whatzit))))
 368.150 +    (testing "returns true if a type implements the protocol directly"
 368.151 +      (is (true? (satisfies? ExampleProtocol whatzit))))
 368.152 +    (testing "returns true if a type explicitly extends protocol"
 368.153 +      (extend
 368.154 +       SatisfiesTestWidget
 368.155 +       other/SimpleProtocol
 368.156 +       {:foo identity})
 368.157 +      (is (true? (satisfies? other/SimpleProtocol whatzit)))))  )
 368.158 +
 368.159 +(deftype ReExtendingTestWidget [])
 368.160 +(deftest re-extending-test
 368.161 +  (reload-example-protocols)
 368.162 +  (extend
 368.163 +   ReExtendingTestWidget
 368.164 +   ExampleProtocol
 368.165 +   {:foo (fn [_] "first foo")
 368.166 +    :baz (fn [_] "first baz")})
 368.167 +  (testing "if you re-extend, the old implementation is replaced (not merged!)"
 368.168 +    (extend
 368.169 +     ReExtendingTestWidget
 368.170 +     ExampleProtocol
 368.171 +     {:baz (fn [_] "second baz")
 368.172 +      :bar (fn [_ _] "second bar")})
 368.173 +    (let [whatzit (ReExtendingTestWidget.)]
 368.174 +      (is (thrown? IllegalArgumentException (foo whatzit)))
 368.175 +      (is (= "second bar" (bar whatzit nil)))
 368.176 +      (is (= "second baz" (baz whatzit))))))
 368.177 +
 368.178 +(defrecord DefrecordObjectMethodsWidgetA [a])
 368.179 +(defrecord DefrecordObjectMethodsWidgetB [a])
 368.180 +(deftest defrecord-object-methods-test
 368.181 +  (testing "= depends on fields and type"
 368.182 +    (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
 368.183 +    (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
 368.184 +    (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))
 368.185 +
 368.186 +(deftest defrecord-acts-like-a-map
 368.187 +  (let [rec (r 1 2)]
 368.188 +    (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
 368.189 +    (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))
 368.190 +    (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
 368.191 +
 368.192 +(deftest degenerate-defrecord-test
 368.193 +  (let [empty (EmptyRecord.)]
 368.194 +    (is (nil? (seq empty)))
 368.195 +    (is (not (.containsValue empty :a)))))
 368.196 +
 368.197 +(deftest defrecord-interfaces-test
 368.198 +  (testing "java.util.Map"
 368.199 +    (let [rec (r 1 2)]
 368.200 +      (is (= 2 (.size rec)))
 368.201 +      (is (= 3 (.size (assoc rec :c 3))))
 368.202 +      (is (not (.isEmpty rec)))
 368.203 +      (is (.isEmpty (EmptyRecord.)))
 368.204 +      (is (.containsKey rec :a))
 368.205 +      (is (not (.containsKey rec :c)))
 368.206 +      (is (.containsValue rec 1))
 368.207 +      (is (not (.containsValue rec 3)))
 368.208 +      (is (= 1 (.get rec :a)))
 368.209 +      (is (thrown? UnsupportedOperationException (.put rec :a 1)))
 368.210 +      (is (thrown? UnsupportedOperationException (.remove rec :a)))
 368.211 +      (is (thrown? UnsupportedOperationException (.putAll rec {})))
 368.212 +      (is (thrown? UnsupportedOperationException (.clear rec)))
 368.213 +      (is (= #{:a :b} (.keySet rec)))
 368.214 +      (is (= #{1 2} (set (.values rec))))
 368.215 +      (is (= #{[:a 1] [:b 2]} (.entrySet rec)))
 368.216 +      
 368.217 +      ))
 368.218 +  (testing "IPersistentCollection"
 368.219 +    (testing ".cons"
 368.220 +      (let [rec (r 1 2)]
 368.221 +        (are [x] (= rec (.cons rec x))
 368.222 +             nil {})
 368.223 +        (is (= (r 1 3) (.cons rec {:b 3})))
 368.224 +        (is (= (r 1 4) (.cons rec [:b 4])))
 368.225 +        (is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
 368.226 +
 368.227 +(defrecord RecordWithSpecificFieldNames [this that k m o])
 368.228 +(deftest defrecord-with-specific-field-names
 368.229 +  (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)]
 368.230 +    (is (= rec rec))
 368.231 +    (is (= 1 (:this (with-meta rec {:foo :bar}))))
 368.232 +    (is (= 3 (get rec :k)))
 368.233 +    (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))
 368.234 +    (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))
 368.235 +
 368.236 +(deftest reify-test
 368.237 +  (testing "of an interface"
 368.238 +    (let [s :foo
 368.239 +          r (reify
 368.240 +             java.util.List
 368.241 +             (contains [_ o] (= s o)))]
 368.242 +      (testing "implemented methods"
 368.243 +        (is (true? (.contains r :foo)))
 368.244 +        (is (false? (.contains r :bar))))
 368.245 +      (testing "unimplemented methods"
 368.246 +        (is (thrown? AbstractMethodError (.add r :baz))))))
 368.247 +  (testing "of two interfaces"
 368.248 +    (let [r (reify
 368.249 +             java.util.List
 368.250 +             (contains [_ o] (= :foo o))
 368.251 +             java.util.Collection
 368.252 +             (isEmpty [_] false))]
 368.253 +      (is (true? (.contains r :foo)))
 368.254 +      (is (false? (.contains r :bar)))
 368.255 +      (is (false? (.isEmpty r)))))
 368.256 +  (testing "you can't define a method twice"
 368.257 +    (is (fails-with-cause?
 368.258 +         java.lang.ClassFormatError #"^(Repetitive|Duplicate) method name"
 368.259 +         (eval '(reify
 368.260 +                 java.util.List
 368.261 +                 (size [_] 10)
 368.262 +                 java.util.Collection
 368.263 +                 (size [_] 20))))))
 368.264 +  (testing "you can't define a method not on an interface/protocol/j.l.Object"
 368.265 +    (is (fails-with-cause? 
 368.266 +         IllegalArgumentException #"^Can't define method not in interfaces: foo"
 368.267 +         (eval '(reify java.util.List (foo [_]))))))
 368.268 +  (testing "of a protocol"
 368.269 +    (let [r (reify
 368.270 +             ExampleProtocol
 368.271 +             (bar [this o] o)
 368.272 +             (baz [this] 1)
 368.273 +             (baz [this o] 2))]
 368.274 +      (= :foo (.bar r :foo))
 368.275 +      (= 1 (.baz r))
 368.276 +      (= 2 (.baz r nil))))
 368.277 +  (testing "destructuring in method def"
 368.278 +    (let [r (reify
 368.279 +             ExampleProtocol
 368.280 +             (bar [this [_ _ item]] item))]
 368.281 +      (= :c (.bar r [:a :b :c]))))
 368.282 +  (testing "methods can recur"
 368.283 +    (let [r (reify
 368.284 +             java.util.List
 368.285 +             (get [_ index]
 368.286 +                  (if (zero? index)
 368.287 +                    :done
 368.288 +                    (recur (dec index)))))]
 368.289 +      (is (= :done (.get r 0)))
 368.290 +      (is (= :done (.get r 1)))))
 368.291 +  (testing "disambiguating with type hints"
 368.292 +    (testing "you must hint an overloaded method"
 368.293 +      (is (fails-with-cause?
 368.294 +            IllegalArgumentException #"Must hint overloaded method: hinted"
 368.295 +            (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))
 368.296 +    (testing "hinting"
 368.297 +      (let [r (reify
 368.298 +               ExampleInterface
 368.299 +               (hinted [_ ^int i] (inc i))
 368.300 +               (hinted [_ ^String s] (str s s)))]
 368.301 +        (is (= 2 (.hinted r 1)))
 368.302 +        (is (= "xoxo" (.hinted r "xo")))))))
 368.303 +
   369.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   369.2 +++ b/src/clojure/test_clojure/protocols/examples.clj	Sat Aug 21 06:25:44 2010 -0400
   369.3 @@ -0,0 +1,14 @@
   369.4 +(ns clojure.test-clojure.protocols.examples)
   369.5 +
   369.6 +(defprotocol ExampleProtocol
   369.7 +  "example protocol used by clojure tests"
   369.8 +
   369.9 +  (foo [a] "method with one arg")
  369.10 +  (bar [a b] "method with two args")
  369.11 +  (^String baz [a] [a b] "method with multiple arities")
  369.12 +  (with-quux [a] "method name with a hyphen"))
  369.13 +
  369.14 +(definterface ExampleInterface
  369.15 +  (hinted [^int i])
  369.16 +  (hinted [^String s]))
  369.17 +
   370.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   370.2 +++ b/src/clojure/test_clojure/protocols/more_examples.clj	Sat Aug 21 06:25:44 2010 -0400
   370.3 @@ -0,0 +1,7 @@
   370.4 +(ns clojure.test-clojure.protocols.more-examples)
   370.5 +
   370.6 +(defprotocol SimpleProtocol
   370.7 +  "example protocol used by clojure tests. Note that
   370.8 +   foo collides with examples/ExampleProtocol."
   370.9 +
  370.10 +  (foo [a] ""))
   371.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   371.2 +++ b/src/clojure/test_clojure/reader.clj	Sat Aug 21 06:25:44 2010 -0400
   371.3 @@ -0,0 +1,319 @@
   371.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   371.5 +;   The use and distribution terms for this software are covered by the
   371.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   371.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   371.8 +;   By using this software in any fashion, you are agreeing to be bound by
   371.9 +;   the terms of this license.
  371.10 +;   You must not remove this notice, or any other, from this software.
  371.11 +
  371.12 +; Author: Stephen C. Gilardi
  371.13 +
  371.14 +;;
  371.15 +;;  Tests for the Clojure functions documented at the URL:
  371.16 +;;
  371.17 +;;    http://clojure.org/Reader
  371.18 +;;
  371.19 +;;  scgilardi (gmail)
  371.20 +;;  Created 22 October 2008
  371.21 +
  371.22 +(ns clojure.test-clojure.reader
  371.23 +  (:use clojure.test))
  371.24 +
  371.25 +;; Symbols
  371.26 +
  371.27 +(deftest Symbols
  371.28 +  (is (= 'abc (symbol "abc")))
  371.29 +  (is (= '*+!-_? (symbol "*+!-_?")))
  371.30 +  (is (= 'abc:def:ghi (symbol "abc:def:ghi")))
  371.31 +  (is (= 'abc/def (symbol "abc" "def")))
  371.32 +  (is (= 'abc.def/ghi (symbol "abc.def" "ghi")))
  371.33 +  (is (= 'abc/def.ghi (symbol "abc" "def.ghi")))
  371.34 +  (is (= 'abc:def/ghi:jkl.mno (symbol "abc:def" "ghi:jkl.mno")))
  371.35 +  (is (instance? clojure.lang.Symbol 'alphabet))
  371.36 +  )
  371.37 +
  371.38 +;; Literals
  371.39 +
  371.40 +(deftest Literals
  371.41 +  ; 'nil 'false 'true are reserved by Clojure and are not symbols
  371.42 +  (is (= 'nil nil))
  371.43 +  (is (= 'false false))
  371.44 +  (is (= 'true true)) )
  371.45 +
  371.46 +;; Strings
  371.47 +
  371.48 +(deftest Strings
  371.49 +  (is (= "abcde" (str \a \b \c \d \e)))
  371.50 +  (is (= "abc
  371.51 +  def" (str \a \b \c \newline \space \space \d \e \f)))
  371.52 +  )
  371.53 +
  371.54 +;; Numbers
  371.55 +
  371.56 +(deftest Numbers
  371.57 +
  371.58 +  ; Read Integer
  371.59 +  (is (instance? Integer 2147483647))
  371.60 +  (is (instance? Integer +1))
  371.61 +  (is (instance? Integer 1))
  371.62 +  (is (instance? Integer +0))
  371.63 +  (is (instance? Integer 0))
  371.64 +  (is (instance? Integer -0))
  371.65 +  (is (instance? Integer -1))
  371.66 +  (is (instance? Integer -2147483648))
  371.67 +
  371.68 +  ; Read Long
  371.69 +  (is (instance? Long 2147483648))
  371.70 +  (is (instance? Long -2147483649))
  371.71 +  (is (instance? Long 9223372036854775807))
  371.72 +  (is (instance? Long -9223372036854775808))
  371.73 +
  371.74 +  ;; Numeric constants of different types don't wash out. Regression fixed in
  371.75 +  ;; r1157. Previously the compiler saw 0 and 0.0 as the same constant and
  371.76 +  ;; caused the sequence to be built of Doubles.
  371.77 +  (let [x 0.0]
  371.78 +    (let [sequence (loop [i 0 l '()]
  371.79 +                     (if (< i 5)
  371.80 +                       (recur (inc i) (conj l i))
  371.81 +                       l))]
  371.82 +      (is (= [4 3 2 1 0] sequence))
  371.83 +      (is (every? #(instance? Integer %)
  371.84 +                  sequence))))
  371.85 +
  371.86 +  ; Read BigInteger
  371.87 +  (is (instance? BigInteger 9223372036854775808))
  371.88 +  (is (instance? BigInteger -9223372036854775809))
  371.89 +  (is (instance? BigInteger 10000000000000000000000000000000000000000000000000))
  371.90 +  (is (instance? BigInteger -10000000000000000000000000000000000000000000000000))
  371.91 +
  371.92 +  ; Read Double
  371.93 +  (is (instance? Double +1.0e+1))
  371.94 +  (is (instance? Double +1.e+1))
  371.95 +  (is (instance? Double +1e+1))
  371.96 +
  371.97 +  (is (instance? Double +1.0e1))
  371.98 +  (is (instance? Double +1.e1))
  371.99 +  (is (instance? Double +1e1))
 371.100 +
 371.101 +  (is (instance? Double +1.0e-1))
 371.102 +  (is (instance? Double +1.e-1))
 371.103 +  (is (instance? Double +1e-1))
 371.104 +
 371.105 +  (is (instance? Double 1.0e+1))
 371.106 +  (is (instance? Double 1.e+1))
 371.107 +  (is (instance? Double 1e+1))
 371.108 +
 371.109 +  (is (instance? Double 1.0e1))
 371.110 +  (is (instance? Double 1.e1))
 371.111 +  (is (instance? Double 1e1))
 371.112 +
 371.113 +  (is (instance? Double 1.0e-1))
 371.114 +  (is (instance? Double 1.e-1))
 371.115 +  (is (instance? Double 1e-1))
 371.116 +
 371.117 +  (is (instance? Double -1.0e+1))
 371.118 +  (is (instance? Double -1.e+1))
 371.119 +  (is (instance? Double -1e+1))
 371.120 +
 371.121 +  (is (instance? Double -1.0e1))
 371.122 +  (is (instance? Double -1.e1))
 371.123 +  (is (instance? Double -1e1))
 371.124 +
 371.125 +  (is (instance? Double -1.0e-1))
 371.126 +  (is (instance? Double -1.e-1))
 371.127 +  (is (instance? Double -1e-1))
 371.128 +
 371.129 +  (is (instance? Double +1.0))
 371.130 +  (is (instance? Double +1.))
 371.131 +
 371.132 +  (is (instance? Double 1.0))
 371.133 +  (is (instance? Double 1.))
 371.134 +
 371.135 +  (is (instance? Double +0.0))
 371.136 +  (is (instance? Double +0.))
 371.137 +
 371.138 +  (is (instance? Double 0.0))
 371.139 +  (is (instance? Double 0.))
 371.140 +
 371.141 +  (is (instance? Double -0.0))
 371.142 +  (is (instance? Double -0.))
 371.143 +
 371.144 +  (is (instance? Double -1.0))
 371.145 +  (is (instance? Double -1.))
 371.146 +
 371.147 +  ; Read BigDecimal
 371.148 +  (is (instance? BigDecimal 9223372036854775808M))
 371.149 +  (is (instance? BigDecimal -9223372036854775809M))
 371.150 +  (is (instance? BigDecimal 2147483647M))
 371.151 +  (is (instance? BigDecimal +1M))
 371.152 +  (is (instance? BigDecimal 1M))
 371.153 +  (is (instance? BigDecimal +0M))
 371.154 +  (is (instance? BigDecimal 0M))
 371.155 +  (is (instance? BigDecimal -0M))
 371.156 +  (is (instance? BigDecimal -1M))
 371.157 +  (is (instance? BigDecimal -2147483648M))
 371.158 +
 371.159 +  (is (instance? BigDecimal +1.0e+1M))
 371.160 +  (is (instance? BigDecimal +1.e+1M))
 371.161 +  (is (instance? BigDecimal +1e+1M))
 371.162 +
 371.163 +  (is (instance? BigDecimal +1.0e1M))
 371.164 +  (is (instance? BigDecimal +1.e1M))
 371.165 +  (is (instance? BigDecimal +1e1M))
 371.166 +
 371.167 +  (is (instance? BigDecimal +1.0e-1M))
 371.168 +  (is (instance? BigDecimal +1.e-1M))
 371.169 +  (is (instance? BigDecimal +1e-1M))
 371.170 +
 371.171 +  (is (instance? BigDecimal 1.0e+1M))
 371.172 +  (is (instance? BigDecimal 1.e+1M))
 371.173 +  (is (instance? BigDecimal 1e+1M))
 371.174 +
 371.175 +  (is (instance? BigDecimal 1.0e1M))
 371.176 +  (is (instance? BigDecimal 1.e1M))
 371.177 +  (is (instance? BigDecimal 1e1M))
 371.178 +
 371.179 +  (is (instance? BigDecimal 1.0e-1M))
 371.180 +  (is (instance? BigDecimal 1.e-1M))
 371.181 +  (is (instance? BigDecimal 1e-1M))
 371.182 +
 371.183 +  (is (instance? BigDecimal -1.0e+1M))
 371.184 +  (is (instance? BigDecimal -1.e+1M))
 371.185 +  (is (instance? BigDecimal -1e+1M))
 371.186 +
 371.187 +  (is (instance? BigDecimal -1.0e1M))
 371.188 +  (is (instance? BigDecimal -1.e1M))
 371.189 +  (is (instance? BigDecimal -1e1M))
 371.190 +
 371.191 +  (is (instance? BigDecimal -1.0e-1M))
 371.192 +  (is (instance? BigDecimal -1.e-1M))
 371.193 +  (is (instance? BigDecimal -1e-1M))
 371.194 +
 371.195 +  (is (instance? BigDecimal +1.0M))
 371.196 +  (is (instance? BigDecimal +1.M))
 371.197 +
 371.198 +  (is (instance? BigDecimal 1.0M))
 371.199 +  (is (instance? BigDecimal 1.M))
 371.200 +
 371.201 +  (is (instance? BigDecimal +0.0M))
 371.202 +  (is (instance? BigDecimal +0.M))
 371.203 +
 371.204 +  (is (instance? BigDecimal 0.0M))
 371.205 +  (is (instance? BigDecimal 0.M))
 371.206 +
 371.207 +  (is (instance? BigDecimal -0.0M))
 371.208 +  (is (instance? BigDecimal -0.M))
 371.209 +
 371.210 +  (is (instance? BigDecimal -1.0M))
 371.211 +  (is (instance? BigDecimal -1.M))
 371.212 +)
 371.213 +
 371.214 +;; Characters
 371.215 +
 371.216 +(deftest t-Characters)
 371.217 +
 371.218 +;; nil
 371.219 +
 371.220 +(deftest t-nil)
 371.221 +
 371.222 +;; Booleans
 371.223 +
 371.224 +(deftest t-Booleans)
 371.225 +
 371.226 +;; Keywords
 371.227 +
 371.228 +(deftest t-Keywords
 371.229 +  (is (= :abc (keyword "abc")))
 371.230 +  (is (= :abc (keyword 'abc)))
 371.231 +  (is (= :*+!-_? (keyword "*+!-_?")))
 371.232 +  (is (= :abc:def:ghi (keyword "abc:def:ghi")))
 371.233 +  (is (= :abc/def (keyword "abc" "def")))
 371.234 +  (is (= :abc/def (keyword 'abc/def)))
 371.235 +  (is (= :abc.def/ghi (keyword "abc.def" "ghi")))
 371.236 +  (is (= :abc/def.ghi (keyword "abc" "def.ghi")))
 371.237 +  (is (= :abc:def/ghi:jkl.mno (keyword "abc:def" "ghi:jkl.mno")))
 371.238 +  (is (instance? clojure.lang.Keyword :alphabet))
 371.239 +  )
 371.240 +
 371.241 +(deftest reading-keywords
 371.242 +  (are [x y] (= x (read-string y))
 371.243 +       :foo ":foo"
 371.244 +       :foo/bar ":foo/bar"
 371.245 +       :user/foo "::foo")
 371.246 +  (are [err msg form] (thrown-with-msg? err msg (read-string form))
 371.247 +       Exception #"Invalid token: foo:" "foo:"
 371.248 +       Exception #"Invalid token: :bar/" ":bar/"
 371.249 +       Exception #"Invalid token: ::does.not/exist" "::does.not/exist"))
 371.250 +;; Lists
 371.251 +
 371.252 +(deftest t-Lists)
 371.253 +
 371.254 +;; Vectors
 371.255 +
 371.256 +(deftest t-Vectors)
 371.257 +
 371.258 +;; Maps
 371.259 +
 371.260 +(deftest t-Maps)
 371.261 +
 371.262 +;; Sets
 371.263 +
 371.264 +(deftest t-Sets)
 371.265 +
 371.266 +;; Macro characters
 371.267 +
 371.268 +;; Quote (')
 371.269 +
 371.270 +(deftest t-Quote)
 371.271 +
 371.272 +;; Character (\)
 371.273 +
 371.274 +(deftest t-Character)
 371.275 +
 371.276 +;; Comment (;)
 371.277 +
 371.278 +(deftest t-Comment)
 371.279 +
 371.280 +;; Meta (^)
 371.281 +
 371.282 +(deftest t-Meta)
 371.283 +
 371.284 +;; Deref (@)
 371.285 +
 371.286 +(deftest t-Deref)
 371.287 +
 371.288 +;; Dispatch (#)
 371.289 +
 371.290 +;; #{} - see Sets above
 371.291 +
 371.292 +;; Regex patterns (#"pattern")
 371.293 +
 371.294 +(deftest t-Regex)
 371.295 +
 371.296 +;; Metadata (#^)
 371.297 +
 371.298 +(deftest t-Metadata)
 371.299 +
 371.300 +;; Var-quote (#')
 371.301 +
 371.302 +(deftest t-Var-quote)
 371.303 +
 371.304 +;; Anonymous function literal (#())
 371.305 +
 371.306 +(deftest t-Anonymouns-function-literal)
 371.307 +
 371.308 +;; Syntax-quote (`, note, the "backquote" character), Unquote (~) and
 371.309 +;; Unquote-splicing (~@)
 371.310 +
 371.311 +(deftest t-Syntax-quote
 371.312 +  (are [x y] (= x y)
 371.313 +      `() ()    ; was NPE before SVN r1337
 371.314 +  ))
 371.315 +
 371.316 +;; (read)
 371.317 +;; (read stream)
 371.318 +;; (read stream eof-is-error)
 371.319 +;; (read stream eof-is-error eof-value)
 371.320 +;; (read stream eof-is-error eof-value is-recursive)
 371.321 +
 371.322 +(deftest t-read)
   372.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   372.2 +++ b/src/clojure/test_clojure/refs.clj	Sat Aug 21 06:25:44 2010 -0400
   372.3 @@ -0,0 +1,22 @@
   372.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   372.5 +;   The use and distribution terms for this software are covered by the
   372.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   372.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   372.8 +;   By using this software in any fashion, you are agreeing to be bound by
   372.9 +;   the terms of this license.
  372.10 +;   You must not remove this notice, or any other, from this software.
  372.11 +
  372.12 +; Author: Frantisek Sodomka
  372.13 +
  372.14 +
  372.15 +(ns clojure.test-clojure.refs
  372.16 +  (:use clojure.test))
  372.17 +
  372.18 +; http://clojure.org/refs
  372.19 +
  372.20 +; ref
  372.21 +; deref, @-reader-macro
  372.22 +; dosync io!
  372.23 +; ensure ref-set alter commute
  372.24 +; set-validator get-validator
  372.25 +
   373.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   373.2 +++ b/src/clojure/test_clojure/repl.clj	Sat Aug 21 06:25:44 2010 -0400
   373.3 @@ -0,0 +1,30 @@
   373.4 +(ns clojure.test-clojure.repl
   373.5 +  (:use clojure.test
   373.6 +        clojure.repl
   373.7 +        clojure.test-clojure.repl.example))
   373.8 +
   373.9 +(deftest test-source
  373.10 +  (is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo)))
  373.11 +  (is (= "(defn foo [])\n" (with-out-str (source clojure.test-clojure.repl.example/foo))))
  373.12 +  (is (nil? (source-fn 'non-existent-fn))))
  373.13 +
  373.14 +(deftest test-dir
  373.15 +  (is (thrown? Exception (dir-fn 'non-existent-ns)))
  373.16 +  (is (= '[bar foo] (dir-fn 'clojure.test-clojure.repl.example)))
  373.17 +  (is (= "bar\nfoo\n" (with-out-str (dir clojure.test-clojure.repl.example)))))
  373.18 +
  373.19 +(deftest test-apropos
  373.20 +  (testing "with a regular expression"
  373.21 +    (is (= '[defmacro] (apropos #"^defmacro$")))
  373.22 +    (is (some #{'defmacro} (apropos #"def.acr.")))
  373.23 +    (is (= [] (apropos #"nothing-has-this-name"))))
  373.24 +
  373.25 +  (testing "with a string"
  373.26 +    (is (some #{'defmacro} (apropos "defmacro")))
  373.27 +    (is (some #{'defmacro} (apropos "efmac")))
  373.28 +    (is (= [] (apropos "nothing-has-this-name"))))
  373.29 +
  373.30 +  (testing "with a symbol"
  373.31 +    (is (some #{'defmacro} (apropos 'defmacro)))
  373.32 +    (is (some #{'defmacro} (apropos 'efmac)))
  373.33 +    (is (= [] (apropos 'nothing-has-this-name)))))
   374.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   374.2 +++ b/src/clojure/test_clojure/repl/example.clj	Sat Aug 21 06:25:44 2010 -0400
   374.3 @@ -0,0 +1,5 @@
   374.4 +(ns clojure.test-clojure.repl.example)
   374.5 +
   374.6 +;; sample namespace for repl tests, don't add anything here
   374.7 +(defn foo [])
   374.8 +(defn bar [])
   375.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   375.2 +++ b/src/clojure/test_clojure/rt.clj	Sat Aug 21 06:25:44 2010 -0400
   375.3 @@ -0,0 +1,111 @@
   375.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   375.5 +;   The use and distribution terms for this software are covered by the
   375.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   375.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   375.8 +;   By using this software in any fashion, you are agreeing to be bound by
   375.9 +;   the terms of this license.
  375.10 +;   You must not remove this notice, or any other, from this software.
  375.11 +
  375.12 +; Author: Stuart Halloway
  375.13 +
  375.14 +(ns clojure.test-clojure.rt
  375.15 +  (:use clojure.test clojure.test-clojure.helpers))
  375.16 +
  375.17 +(defmacro with-err-print-writer
  375.18 +  "Evaluate with err pointing to a temporary PrintWriter, and
  375.19 +   return err contents as a string."
  375.20 +  [& body]
  375.21 +  `(let [s# (java.io.StringWriter.)
  375.22 +         p# (java.io.PrintWriter. s#)]
  375.23 +     (binding [*err* p#]
  375.24 +       ~@body
  375.25 +       (str s#))))
  375.26 +
  375.27 +(defmacro with-err-string-writer
  375.28 +  "Evaluate with err pointing to a temporary StringWriter, and
  375.29 +   return err contents as a string."
  375.30 +  [& body]
  375.31 +  `(let [s# (java.io.StringWriter.)]
  375.32 +     (binding [*err* s#]
  375.33 +       ~@body
  375.34 +       (str s#))))
  375.35 +
  375.36 +(defmacro should-print-err-message
  375.37 +  "Turn on all warning flags, and test that error message prints
  375.38 +   correctly for all semi-reasonable bindings of *err*."
  375.39 +  [msg-re form]
  375.40 +  `(binding [*warn-on-reflection* true]
  375.41 +    (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form))))
  375.42 +    (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form))))))
  375.43 +
  375.44 +(defn bare-rt-print
  375.45 +  "Return string RT would print prior to print-initialize"
  375.46 +  [x]
  375.47 +  (with-out-str
  375.48 +    (try
  375.49 +     (push-thread-bindings {#'clojure.core/print-initialized false})
  375.50 +     (clojure.lang.RT/print x *out*)
  375.51 +     (finally
  375.52 +      (pop-thread-bindings)))))
  375.53 +
  375.54 +(deftest rt-print-prior-to-print-initialize
  375.55 +  (testing "pattern literals"
  375.56 +    (is (= "#\"foo\"" (bare-rt-print #"foo")))))
  375.57 +
  375.58 +(deftest error-messages
  375.59 +  (testing "binding a core var that already refers to something"
  375.60 +    (should-print-err-message
  375.61 +     #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
  375.62 +     (defn prefers [] (throw (RuntimeException. "rebound!")))))
  375.63 +  (testing "reflection cannot resolve field"
  375.64 +    (should-print-err-message
  375.65 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n"
  375.66 +     (defn foo [x] (.blah x))))
  375.67 +  (testing "reflection cannot resolve instance method"
  375.68 +    (should-print-err-message
  375.69 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n"
  375.70 +     (defn foo [x] (.zap x 1))))
  375.71 +  (testing "reflection cannot resolve static method"
  375.72 +    (should-print-err-message
  375.73 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n"
  375.74 +     (defn foo [] (Integer/valueOf #"boom"))))
  375.75 +  (testing "reflection cannot resolve constructor"
  375.76 +    (should-print-err-message
  375.77 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n"
  375.78 +     (defn foo [] (String. 1 2 3)))))
  375.79 +
  375.80 +(def example-var)
  375.81 +(deftest binding-root-clears-macro-metadata
  375.82 +  (alter-meta! #'example-var assoc :macro true)
  375.83 +  (is (contains? (meta #'example-var) :macro))
  375.84 +  (.bindRoot #'example-var 0)
  375.85 +  (is (not (contains? (meta #'example-var) :macro))))
  375.86 +
  375.87 +(deftest last-var-wins-for-core
  375.88 +  (testing "you can replace a core name, with warning"
  375.89 +    (let [ns (temp-ns)
  375.90 +        replacement (gensym)]
  375.91 +      (with-err-string-writer (intern ns 'prefers replacement))
  375.92 +      (is (= replacement @('prefers (ns-publics ns))))))
  375.93 +  (testing "you can replace a name you defined before"
  375.94 +    (let [ns (temp-ns)
  375.95 +          s (gensym)
  375.96 +          v1 (intern ns 'foo s)
  375.97 +          v2 (intern ns 'bar s)]
  375.98 +      (with-err-string-writer (.refer ns 'flatten v1))
  375.99 +      (.refer ns 'flatten v2)
 375.100 +      (is (= v2 (ns-resolve ns 'flatten)))))
 375.101 +  (testing "you cannot intern over an existing non-core name"
 375.102 +    (let [ns (temp-ns 'clojure.set)
 375.103 +          replacement (gensym)]
 375.104 +      (is (thrown? IllegalStateException
 375.105 +                   (intern ns 'subset? replacement)))
 375.106 +      (is (nil? ('subset? (ns-publics ns))))
 375.107 +      (is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))
 375.108 +  (testing "you cannot refer over an existing non-core name"
 375.109 +    (let [ns (temp-ns 'clojure.set)
 375.110 +          replacement (gensym)]
 375.111 +      (is (thrown? IllegalStateException
 375.112 +                   (.refer ns 'subset? #'clojure.set/intersection)))
 375.113 +      (is (nil? ('subset? (ns-publics ns))))
 375.114 +      (is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))))
   376.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   376.2 +++ b/src/clojure/test_clojure/sequences.clj	Sat Aug 21 06:25:44 2010 -0400
   376.3 @@ -0,0 +1,1162 @@
   376.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   376.5 +;   The use and distribution terms for this software are covered by the
   376.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   376.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   376.8 +;   By using this software in any fashion, you are agreeing to be bound by
   376.9 +;   the terms of this license.
  376.10 +;   You must not remove this notice, or any other, from this software.
  376.11 +
  376.12 +; Author: Frantisek Sodomka
  376.13 +; Contributors: Stuart Halloway
  376.14 +
  376.15 +(ns clojure.test-clojure.sequences
  376.16 +  (:use clojure.test))
  376.17 +
  376.18 +;; *** Tests ***
  376.19 +
  376.20 +; TODO:
  376.21 +; apply, map, filter, remove
  376.22 +; and more...
  376.23 +
  376.24 +(deftest test-reduce-from-chunked-into-unchunked
  376.25 +  (= [1 2 \a \b] (into [] (concat [1 2] "ab"))))
  376.26 + 
  376.27 +(deftest test-reduce
  376.28 +  (let [int+ (fn [a b] (+ (int a) (int b)))
  376.29 +        arange (range 100) ;; enough to cross nodes
  376.30 +        avec (into [] arange)
  376.31 +        alist (into () arange)
  376.32 +        obj-array (into-array arange)
  376.33 +        int-array (into-array Integer/TYPE arange)
  376.34 +        long-array (into-array Long/TYPE arange)
  376.35 +        float-array (into-array Float/TYPE arange)
  376.36 +        char-array (into-array Character/TYPE (map char arange))
  376.37 +        double-array (into-array Double/TYPE arange)
  376.38 +        byte-array (into-array Byte/TYPE (map byte arange))
  376.39 +        int-vec (into (vector-of :int) arange)
  376.40 +        long-vec (into (vector-of :long) arange)
  376.41 +        float-vec (into (vector-of :float) arange)
  376.42 +        char-vec (into (vector-of :char) (map char arange))
  376.43 +        double-vec (into (vector-of :double) arange)
  376.44 +        byte-vec (into (vector-of :byte) (map byte arange))
  376.45 +        all-true (into-array Boolean/TYPE (repeat 10 true))]
  376.46 +    (is (= 4950
  376.47 +           (reduce + arange)
  376.48 +           (reduce + avec)
  376.49 +           (reduce + alist)
  376.50 +           (reduce + obj-array)
  376.51 +           (reduce + int-array)
  376.52 +           (reduce + long-array)
  376.53 +           (reduce + float-array)
  376.54 +           (reduce int+ char-array)
  376.55 +           (reduce + double-array)
  376.56 +           (reduce int+ byte-array)
  376.57 +           (reduce + int-vec)
  376.58 +           (reduce + long-vec)
  376.59 +           (reduce + float-vec)
  376.60 +           (reduce int+ char-vec)
  376.61 +           (reduce + double-vec)
  376.62 +           (reduce int+ byte-vec)))
  376.63 +    (is (= 4951
  376.64 +           (reduce + 1 arange)
  376.65 +           (reduce + 1 avec)
  376.66 +           (reduce + 1 alist)
  376.67 +           (reduce + 1 obj-array)
  376.68 +           (reduce + 1 int-array)
  376.69 +           (reduce + 1 long-array)
  376.70 +           (reduce + 1 float-array)
  376.71 +           (reduce int+ 1 char-array)
  376.72 +           (reduce + 1 double-array)
  376.73 +           (reduce int+ 1 byte-array)
  376.74 +           (reduce + 1 int-vec)
  376.75 +           (reduce + 1 long-vec)
  376.76 +           (reduce + 1 float-vec)
  376.77 +           (reduce int+ 1 char-vec)
  376.78 +           (reduce + 1 double-vec)
  376.79 +           (reduce int+ 1 byte-vec)))
  376.80 +    (is (= true
  376.81 +           (reduce #(and %1 %2) all-true)
  376.82 +           (reduce #(and %1 %2) true all-true)))))
  376.83 +
  376.84 +(deftest test-equality
  376.85 +  ; lazy sequences
  376.86 +  (are [x y] (= x y)
  376.87 +      ; fixed SVN 1288 - LazySeq and EmptyList equals/equiv
  376.88 +      ; http://groups.google.com/group/clojure/browse_frm/thread/286d807be9cae2a5#
  376.89 +      (map inc nil) ()
  376.90 +      (map inc ()) ()
  376.91 +      (map inc []) ()
  376.92 +      (map inc #{}) ()
  376.93 +      (map inc {}) () ))
  376.94 +
  376.95 +
  376.96 +(deftest test-lazy-seq
  376.97 +  (are [x] (seq? x)
  376.98 +      (lazy-seq nil)
  376.99 +      (lazy-seq [])
 376.100 +      (lazy-seq [1 2]))
 376.101 +
 376.102 +  (are [x y] (= x y)
 376.103 +      (lazy-seq nil) ()
 376.104 +      (lazy-seq [nil]) '(nil)
 376.105 +
 376.106 +      (lazy-seq ()) ()
 376.107 +      (lazy-seq []) ()
 376.108 +      (lazy-seq #{}) ()
 376.109 +      (lazy-seq {}) ()
 376.110 +      (lazy-seq "") ()
 376.111 +      (lazy-seq (into-array [])) ()
 376.112 +
 376.113 +      (lazy-seq (list 1 2)) '(1 2)
 376.114 +      (lazy-seq [1 2]) '(1 2)
 376.115 +      (lazy-seq (sorted-set 1 2)) '(1 2)
 376.116 +      (lazy-seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2])
 376.117 +      (lazy-seq "abc") '(\a \b \c)
 376.118 +      (lazy-seq (into-array [1 2])) '(1 2) ))
 376.119 +
 376.120 +
 376.121 +(deftest test-seq
 376.122 +  (is (not (seq? (seq []))))
 376.123 +  (is (seq? (seq [1 2])))
 376.124 +  
 376.125 +  (are [x y] (= x y)
 376.126 +    (seq nil) nil
 376.127 +    (seq [nil]) '(nil)
 376.128 +
 376.129 +    (seq ()) nil
 376.130 +    (seq []) nil
 376.131 +    (seq #{}) nil
 376.132 +    (seq {}) nil
 376.133 +    (seq "") nil
 376.134 +    (seq (into-array [])) nil
 376.135 +
 376.136 +    (seq (list 1 2)) '(1 2)
 376.137 +    (seq [1 2]) '(1 2)
 376.138 +    (seq (sorted-set 1 2)) '(1 2)
 376.139 +    (seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2])
 376.140 +    (seq "abc") '(\a \b \c)
 376.141 +    (seq (into-array [1 2])) '(1 2) ))
 376.142 +
 376.143 +
 376.144 +(deftest test-cons
 376.145 +  (is (thrown? IllegalArgumentException (cons 1 2)))
 376.146 +  (are [x y] (= x y)
 376.147 +    (cons 1 nil) '(1)
 376.148 +    (cons nil nil) '(nil)
 376.149 +
 376.150 +    (cons \a nil) '(\a)
 376.151 +    (cons \a "") '(\a)
 376.152 +    (cons \a "bc") '(\a \b \c)
 376.153 +
 376.154 +    (cons 1 ()) '(1)
 376.155 +    (cons 1 '(2 3)) '(1 2 3)
 376.156 +
 376.157 +    (cons 1 []) [1]
 376.158 +    (cons 1 [2 3]) [1 2 3]
 376.159 +
 376.160 +    (cons 1 #{}) '(1)
 376.161 +    (cons 1 (sorted-set 2 3)) '(1 2 3)
 376.162 +
 376.163 +    (cons 1 (into-array [])) '(1)
 376.164 +    (cons 1 (into-array [2 3])) '(1 2 3) ))
 376.165 +
 376.166 +
 376.167 +(deftest test-empty
 376.168 +  (are [x y] (and (= (empty x) y)
 376.169 +                  (= (class (empty x)) (class y)))
 376.170 +      nil nil
 376.171 +
 376.172 +      () ()
 376.173 +      '(1 2) ()
 376.174 +
 376.175 +      [] []
 376.176 +      [1 2] []
 376.177 +
 376.178 +      {} {}
 376.179 +      {:a 1 :b 2} {}
 376.180 +
 376.181 +      (sorted-map) (sorted-map)
 376.182 +      (sorted-map :a 1 :b 2) (sorted-map)
 376.183 +
 376.184 +      #{} #{}
 376.185 +      #{1 2} #{}
 376.186 +
 376.187 +      (sorted-set) (sorted-set)
 376.188 +      (sorted-set 1 2) (sorted-set)
 376.189 +
 376.190 +      (seq ()) nil      ; (seq ()) => nil
 376.191 +      (seq '(1 2)) ()
 376.192 +
 376.193 +      (seq []) nil      ; (seq []) => nil
 376.194 +      (seq [1 2]) ()
 376.195 +
 376.196 +      (seq "") nil      ; (seq "") => nil
 376.197 +      (seq "ab") ()
 376.198 +
 376.199 +      (lazy-seq ()) ()
 376.200 +      (lazy-seq '(1 2)) ()
 376.201 +
 376.202 +      (lazy-seq []) ()
 376.203 +      (lazy-seq [1 2]) ()
 376.204 +
 376.205 +      ; non-coll, non-seq => nil
 376.206 +      42 nil
 376.207 +      1.2 nil
 376.208 +      "abc" nil ))
 376.209 +
 376.210 +;Tests that the comparator is preservered
 376.211 +;The first element should be the same in each set if preserved.
 376.212 +(deftest test-empty-sorted
 376.213 +  (let [inv-compare (comp - compare)]
 376.214 +    (are [x y] (= (first (into (empty x) x)) 
 376.215 +		  (first y))
 376.216 +	 (sorted-set 1 2 3) (sorted-set 1 2 3)
 376.217 +	 (sorted-set-by inv-compare 1 2 3) (sorted-set-by inv-compare 1 2 3)
 376.218 +
 376.219 +	 (sorted-map 1 :a 2 :b 3 :c) (sorted-map 1 :a 2 :b 3 :c)
 376.220 +	 (sorted-map-by inv-compare 1 :a 2 :b 3 :c) (sorted-map-by inv-compare 1 :a 2 :b 3 :c))))
 376.221 +
 376.222 +
 376.223 +(deftest test-not-empty
 376.224 +  ; empty coll/seq => nil
 376.225 +  (are [x] (= (not-empty x) nil)
 376.226 +      ()
 376.227 +      []
 376.228 +      {}
 376.229 +      #{}
 376.230 +      (seq ())
 376.231 +      (seq [])
 376.232 +      (lazy-seq ())
 376.233 +      (lazy-seq []) )
 376.234 +
 376.235 +  ; non-empty coll/seq => identity
 376.236 +  (are [x] (and (= (not-empty x) x)
 376.237 +                (= (class (not-empty x)) (class x)))
 376.238 +      '(1 2)
 376.239 +      [1 2]
 376.240 +      {:a 1}
 376.241 +      #{1 2}
 376.242 +      (seq '(1 2))
 376.243 +      (seq [1 2])
 376.244 +      (lazy-seq '(1 2))
 376.245 +      (lazy-seq [1 2]) ))
 376.246 +
 376.247 +
 376.248 +(deftest test-first
 376.249 +  (is (thrown? IllegalArgumentException (first)))
 376.250 +  (is (thrown? IllegalArgumentException (first true)))
 376.251 +  (is (thrown? IllegalArgumentException (first false)))
 376.252 +  (is (thrown? IllegalArgumentException (first 1)))
 376.253 +  (is (thrown? IllegalArgumentException (first 1 2)))
 376.254 +  (is (thrown? IllegalArgumentException (first \a)))
 376.255 +  (is (thrown? IllegalArgumentException (first 's)))
 376.256 +  (is (thrown? IllegalArgumentException (first :k)))
 376.257 +  (are [x y] (= x y)
 376.258 +    (first nil) nil
 376.259 +
 376.260 +    ; string
 376.261 +    (first "") nil
 376.262 +    (first "a") \a
 376.263 +    (first "abc") \a
 376.264 +
 376.265 +    ; list
 376.266 +    (first ()) nil
 376.267 +    (first '(1)) 1
 376.268 +    (first '(1 2 3)) 1
 376.269 +
 376.270 +    (first '(nil)) nil
 376.271 +    (first '(1 nil)) 1
 376.272 +    (first '(nil 2)) nil
 376.273 +    (first '(())) ()
 376.274 +    (first '(() nil)) ()
 376.275 +    (first '(() 2 nil)) ()
 376.276 +
 376.277 +    ; vector
 376.278 +    (first []) nil
 376.279 +    (first [1]) 1
 376.280 +    (first [1 2 3]) 1
 376.281 +
 376.282 +    (first [nil]) nil
 376.283 +    (first [1 nil]) 1
 376.284 +    (first [nil 2]) nil
 376.285 +    (first [[]]) []
 376.286 +    (first [[] nil]) []
 376.287 +    (first [[] 2 nil]) []
 376.288 +
 376.289 +    ; set
 376.290 +    (first #{}) nil
 376.291 +    (first #{1}) 1
 376.292 +    (first (sorted-set 1 2 3)) 1
 376.293 +
 376.294 +    (first #{nil}) nil
 376.295 +    (first (sorted-set 1 nil)) nil
 376.296 +    (first (sorted-set nil 2)) nil
 376.297 +    (first #{#{}}) #{}
 376.298 +    (first (sorted-set #{} nil)) nil
 376.299 +    ;(first (sorted-set #{} 2 nil)) nil
 376.300 +
 376.301 +    ; map
 376.302 +    (first {}) nil
 376.303 +    (first (sorted-map :a 1)) '(:a 1)
 376.304 +    (first (sorted-map :a 1 :b 2 :c 3)) '(:a 1)
 376.305 +
 376.306 +    ; array
 376.307 +    (first (into-array [])) nil
 376.308 +    (first (into-array [1])) 1
 376.309 +    (first (into-array [1 2 3])) 1
 376.310 +    (first (to-array [nil])) nil
 376.311 +    (first (to-array [1 nil])) 1
 376.312 +    (first (to-array [nil 2])) nil ))
 376.313 +
 376.314 +
 376.315 +(deftest test-next
 376.316 +  (is (thrown? IllegalArgumentException (next)))
 376.317 +  (is (thrown? IllegalArgumentException (next true)))
 376.318 +  (is (thrown? IllegalArgumentException (next false)))
 376.319 +  (is (thrown? IllegalArgumentException (next 1)))
 376.320 +  (is (thrown? IllegalArgumentException (next 1 2)))
 376.321 +  (is (thrown? IllegalArgumentException (next \a)))
 376.322 +  (is (thrown? IllegalArgumentException (next 's)))
 376.323 +  (is (thrown? IllegalArgumentException (next :k)))
 376.324 +  (are [x y] (= x y)
 376.325 +    (next nil) nil
 376.326 +
 376.327 +    ; string
 376.328 +    (next "") nil
 376.329 +    (next "a") nil
 376.330 +    (next "abc") '(\b \c)
 376.331 +
 376.332 +    ; list
 376.333 +    (next ()) nil
 376.334 +    (next '(1)) nil
 376.335 +    (next '(1 2 3)) '(2 3)
 376.336 +
 376.337 +    (next '(nil)) nil
 376.338 +    (next '(1 nil)) '(nil)
 376.339 +    (next '(1 ())) '(())
 376.340 +    (next '(nil 2)) '(2)
 376.341 +    (next '(())) nil
 376.342 +    (next '(() nil)) '(nil)
 376.343 +    (next '(() 2 nil)) '(2 nil)
 376.344 +
 376.345 +    ; vector
 376.346 +    (next []) nil
 376.347 +    (next [1]) nil
 376.348 +    (next [1 2 3]) [2 3]
 376.349 +
 376.350 +    (next [nil]) nil
 376.351 +    (next [1 nil]) [nil]
 376.352 +    (next [1 []]) [[]]
 376.353 +    (next [nil 2]) [2]
 376.354 +    (next [[]]) nil
 376.355 +    (next [[] nil]) [nil]
 376.356 +    (next [[] 2 nil]) [2 nil]
 376.357 +
 376.358 +    ; set
 376.359 +    (next #{}) nil
 376.360 +    (next #{1}) nil
 376.361 +    (next (sorted-set 1 2 3)) '(2 3)
 376.362 +
 376.363 +    (next #{nil}) nil
 376.364 +    (next (sorted-set 1 nil)) '(1)
 376.365 +    (next (sorted-set nil 2)) '(2)
 376.366 +    (next #{#{}}) nil
 376.367 +    (next (sorted-set #{} nil)) '(#{})
 376.368 +    ;(next (sorted-set #{} 2 nil)) #{}
 376.369 +
 376.370 +    ; map
 376.371 +    (next {}) nil
 376.372 +    (next (sorted-map :a 1)) nil
 376.373 +    (next (sorted-map :a 1 :b 2 :c 3)) '((:b 2) (:c 3))
 376.374 +
 376.375 +    ; array
 376.376 +    (next (into-array [])) nil
 376.377 +    (next (into-array [1])) nil
 376.378 +    (next (into-array [1 2 3])) '(2 3)
 376.379 +
 376.380 +    (next (to-array [nil])) nil
 376.381 +    (next (to-array [1 nil])) '(nil)
 376.382 +    ;(next (to-array [1 (into-array [])])) (list (into-array []))
 376.383 +    (next (to-array [nil 2])) '(2)
 376.384 +    (next (to-array [(into-array [])])) nil
 376.385 +    (next (to-array [(into-array []) nil])) '(nil)
 376.386 +    (next (to-array [(into-array []) 2 nil])) '(2 nil) ))
 376.387 +
 376.388 +
 376.389 +(deftest test-last
 376.390 +  (are [x y] (= x y)
 376.391 +      (last nil) nil
 376.392 +
 376.393 +      ; list
 376.394 +      (last ()) nil
 376.395 +      (last '(1)) 1
 376.396 +      (last '(1 2 3)) 3
 376.397 +
 376.398 +      (last '(nil)) nil
 376.399 +      (last '(1 nil)) nil
 376.400 +      (last '(nil 2)) 2
 376.401 +      (last '(())) ()
 376.402 +      (last '(() nil)) nil
 376.403 +      (last '(() 2 nil)) nil
 376.404 +
 376.405 +      ; vector
 376.406 +      (last []) nil
 376.407 +      (last [1]) 1
 376.408 +      (last [1 2 3]) 3
 376.409 +
 376.410 +      (last [nil]) nil
 376.411 +      (last [1 nil]) nil
 376.412 +      (last [nil 2]) 2
 376.413 +      (last [[]]) []
 376.414 +      (last [[] nil]) nil
 376.415 +      (last [[] 2 nil]) nil
 376.416 +
 376.417 +      ; set
 376.418 +      (last #{}) nil
 376.419 +      (last #{1}) 1
 376.420 +      (last (sorted-set 1 2 3)) 3
 376.421 +
 376.422 +      (last #{nil}) nil
 376.423 +      (last (sorted-set 1 nil)) 1
 376.424 +      (last (sorted-set nil 2)) 2
 376.425 +      (last #{#{}}) #{}
 376.426 +      (last (sorted-set #{} nil)) #{}
 376.427 +      ;(last (sorted-set #{} 2 nil)) nil
 376.428 +
 376.429 +      ; map
 376.430 +      (last {}) nil
 376.431 +      (last (sorted-map :a 1)) [:a 1]
 376.432 +      (last (sorted-map :a 1 :b 2 :c 3)) [:c 3]
 376.433 +
 376.434 +      ; string
 376.435 +      (last "") nil
 376.436 +      (last "a") \a
 376.437 +      (last "abc") \c
 376.438 +
 376.439 +      ; array
 376.440 +      (last (into-array [])) nil
 376.441 +      (last (into-array [1])) 1
 376.442 +      (last (into-array [1 2 3])) 3
 376.443 +      (last (to-array [nil])) nil
 376.444 +      (last (to-array [1 nil])) nil
 376.445 +      (last (to-array [nil 2])) 2 ))
 376.446 +
 376.447 +
 376.448 +;; (ffirst coll) = (first (first coll))
 376.449 +;;
 376.450 +(deftest test-ffirst
 376.451 +  (is (thrown? IllegalArgumentException (ffirst)))
 376.452 +  (are [x y] (= x y)
 376.453 +    (ffirst nil) nil
 376.454 +
 376.455 +    (ffirst ()) nil
 376.456 +    (ffirst '((1 2) (3 4))) 1
 376.457 +
 376.458 +    (ffirst []) nil
 376.459 +    (ffirst [[1 2] [3 4]]) 1
 376.460 +
 376.461 +    (ffirst {}) nil
 376.462 +    (ffirst {:a 1}) :a
 376.463 +
 376.464 +    (ffirst #{}) nil
 376.465 +    (ffirst #{[1 2]}) 1 ))
 376.466 +
 376.467 +
 376.468 +;; (fnext coll) = (first (next coll)) = (second coll)
 376.469 +;;
 376.470 +(deftest test-fnext
 376.471 +  (is (thrown? IllegalArgumentException (fnext)))
 376.472 +  (are [x y] (= x y)
 376.473 +    (fnext nil) nil
 376.474 +
 376.475 +    (fnext ()) nil
 376.476 +    (fnext '(1)) nil
 376.477 +    (fnext '(1 2 3 4)) 2
 376.478 +
 376.479 +    (fnext []) nil
 376.480 +    (fnext [1]) nil
 376.481 +    (fnext [1 2 3 4]) 2
 376.482 +
 376.483 +    (fnext {}) nil
 376.484 +    (fnext (sorted-map :a 1)) nil
 376.485 +    (fnext (sorted-map :a 1 :b 2)) [:b 2]
 376.486 +
 376.487 +    (fnext #{}) nil
 376.488 +    (fnext #{1}) nil
 376.489 +    (fnext (sorted-set 1 2 3 4)) 2 ))
 376.490 +
 376.491 +
 376.492 +;; (nfirst coll) = (next (first coll))
 376.493 +;;
 376.494 +(deftest test-nfirst
 376.495 +  (is (thrown? IllegalArgumentException (nfirst)))
 376.496 +  (are [x y] (= x y)
 376.497 +    (nfirst nil) nil
 376.498 +
 376.499 +    (nfirst ()) nil
 376.500 +    (nfirst '((1 2 3) (4 5 6))) '(2 3)
 376.501 +
 376.502 +    (nfirst []) nil
 376.503 +    (nfirst [[1 2 3] [4 5 6]]) '(2 3)
 376.504 +
 376.505 +    (nfirst {}) nil
 376.506 +    (nfirst {:a 1}) '(1)
 376.507 +
 376.508 +    (nfirst #{}) nil
 376.509 +    (nfirst #{[1 2]}) '(2) ))
 376.510 +
 376.511 +
 376.512 +;; (nnext coll) = (next (next coll))
 376.513 +;;
 376.514 +(deftest test-nnext
 376.515 +  (is (thrown? IllegalArgumentException (nnext)))
 376.516 +  (are [x y] (= x y)
 376.517 +    (nnext nil) nil
 376.518 +
 376.519 +    (nnext ()) nil
 376.520 +    (nnext '(1)) nil
 376.521 +    (nnext '(1 2)) nil
 376.522 +    (nnext '(1 2 3 4)) '(3 4)
 376.523 +
 376.524 +    (nnext []) nil
 376.525 +    (nnext [1]) nil
 376.526 +    (nnext [1 2]) nil
 376.527 +    (nnext [1 2 3 4]) '(3 4)
 376.528 +
 376.529 +    (nnext {}) nil
 376.530 +    (nnext (sorted-map :a 1)) nil
 376.531 +    (nnext (sorted-map :a 1 :b 2)) nil
 376.532 +    (nnext (sorted-map :a 1 :b 2 :c 3 :d 4)) '([:c 3] [:d 4])
 376.533 +
 376.534 +    (nnext #{}) nil
 376.535 +    (nnext #{1}) nil
 376.536 +    (nnext (sorted-set 1 2)) nil
 376.537 +    (nnext (sorted-set 1 2 3 4)) '(3 4) ))
 376.538 +
 376.539 +
 376.540 +(deftest test-nth
 376.541 +  ; maps, sets are not supported
 376.542 +  (is (thrown? UnsupportedOperationException (nth {} 0)))
 376.543 +  (is (thrown? UnsupportedOperationException (nth {:a 1 :b 2} 0)))
 376.544 +  (is (thrown? UnsupportedOperationException (nth #{} 0)))
 376.545 +  (is (thrown? UnsupportedOperationException (nth #{1 2 3} 0)))
 376.546 +
 376.547 +  ; out of bounds
 376.548 +  (is (thrown? IndexOutOfBoundsException (nth '() 0)))
 376.549 +  (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) 5)))
 376.550 +  (is (thrown? IndexOutOfBoundsException (nth '() -1)))
 376.551 +  (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) -1)))
 376.552 +
 376.553 +  (is (thrown? IndexOutOfBoundsException (nth [] 0)))
 376.554 +  (is (thrown? IndexOutOfBoundsException (nth [1 2 3] 5)))
 376.555 +  (is (thrown? IndexOutOfBoundsException (nth [] -1)))
 376.556 +  (is (thrown? IndexOutOfBoundsException (nth [1 2 3] -1)))  ; ???
 376.557 +
 376.558 +  (is (thrown? IndexOutOfBoundsException (nth (into-array []) 0)))
 376.559 +  (is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) 5)))
 376.560 +  (is (thrown? IndexOutOfBoundsException (nth (into-array []) -1)))
 376.561 +  (is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) -1)))
 376.562 +
 376.563 +  (is (thrown? StringIndexOutOfBoundsException (nth "" 0)))
 376.564 +  (is (thrown? StringIndexOutOfBoundsException (nth "abc" 5)))
 376.565 +  (is (thrown? StringIndexOutOfBoundsException (nth "" -1)))
 376.566 +  (is (thrown? StringIndexOutOfBoundsException (nth "abc" -1)))
 376.567 +
 376.568 +  (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) 0)))
 376.569 +  (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) 5)))
 376.570 +  (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) -1)))       ; ???
 376.571 +  (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) -1)))  ; ???
 376.572 +
 376.573 +  (are [x y] (= x y)
 376.574 +      (nth '(1) 0) 1
 376.575 +      (nth '(1 2 3) 0) 1
 376.576 +      (nth '(1 2 3 4 5) 1) 2
 376.577 +      (nth '(1 2 3 4 5) 4) 5
 376.578 +      (nth '(1 2 3) 5 :not-found) :not-found
 376.579 +
 376.580 +      (nth [1] 0) 1
 376.581 +      (nth [1 2 3] 0) 1
 376.582 +      (nth [1 2 3 4 5] 1) 2
 376.583 +      (nth [1 2 3 4 5] 4) 5
 376.584 +      (nth [1 2 3] 5 :not-found) :not-found
 376.585 +
 376.586 +      (nth (into-array [1]) 0) 1
 376.587 +      (nth (into-array [1 2 3]) 0) 1
 376.588 +      (nth (into-array [1 2 3 4 5]) 1) 2
 376.589 +      (nth (into-array [1 2 3 4 5]) 4) 5
 376.590 +      (nth (into-array [1 2 3]) 5 :not-found) :not-found
 376.591 +
 376.592 +      (nth "a" 0) \a
 376.593 +      (nth "abc" 0) \a
 376.594 +      (nth "abcde" 1) \b
 376.595 +      (nth "abcde" 4) \e
 376.596 +      (nth "abc" 5 :not-found) :not-found
 376.597 +
 376.598 +      (nth (java.util.ArrayList. [1]) 0) 1
 376.599 +      (nth (java.util.ArrayList. [1 2 3]) 0) 1
 376.600 +      (nth (java.util.ArrayList. [1 2 3 4 5]) 1) 2
 376.601 +      (nth (java.util.ArrayList. [1 2 3 4 5]) 4) 5
 376.602 +      (nth (java.util.ArrayList. [1 2 3]) 5 :not-found) :not-found )
 376.603 +
 376.604 +  ; regex Matchers
 376.605 +  (let [m (re-matcher #"(a)(b)" "ababaa")]
 376.606 +    (re-find m) ; => ["ab" "a" "b"]
 376.607 +    (are [x y] (= x y)
 376.608 +        (nth m 0) "ab"
 376.609 +        (nth m 1) "a"
 376.610 +        (nth m 2) "b"
 376.611 +        (nth m 3 :not-found) :not-found
 376.612 +        (nth m -1 :not-found) :not-found )
 376.613 +    (is (thrown? IndexOutOfBoundsException (nth m 3)))
 376.614 +    (is (thrown? IndexOutOfBoundsException (nth m -1))))
 376.615 +
 376.616 +  (let [m (re-matcher #"c" "ababaa")]
 376.617 +    (re-find m) ; => nil
 376.618 +    (are [x y] (= x y)
 376.619 +        (nth m 0 :not-found) :not-found
 376.620 +        (nth m 2 :not-found) :not-found
 376.621 +        (nth m -1 :not-found) :not-found )
 376.622 +    (is (thrown? IllegalStateException (nth m 0)))
 376.623 +    (is (thrown? IllegalStateException (nth m 2)))
 376.624 +    (is (thrown? IllegalStateException (nth m -1)))))
 376.625 +
 376.626 +
 376.627 +; distinct was broken for nil & false:
 376.628 +;   fixed in rev 1278:
 376.629 +;   http://code.google.com/p/clojure/source/detail?r=1278
 376.630 +;
 376.631 +(deftest test-distinct
 376.632 +  (are [x y] (= x y)
 376.633 +      (distinct ()) ()
 376.634 +      (distinct '(1)) '(1)
 376.635 +      (distinct '(1 2 3)) '(1 2 3)
 376.636 +      (distinct '(1 2 3 1 1 1)) '(1 2 3)
 376.637 +      (distinct '(1 1 1 2)) '(1 2)
 376.638 +      (distinct '(1 2 1 2)) '(1 2)
 376.639 +
 376.640 +      (distinct []) ()
 376.641 +      (distinct [1]) '(1)
 376.642 +      (distinct [1 2 3]) '(1 2 3)
 376.643 +      (distinct [1 2 3 1 2 2 1 1]) '(1 2 3)
 376.644 +      (distinct [1 1 1 2]) '(1 2)
 376.645 +      (distinct [1 2 1 2]) '(1 2)
 376.646 +
 376.647 +      (distinct "") ()
 376.648 +      (distinct "a") '(\a)
 376.649 +      (distinct "abc") '(\a \b \c)
 376.650 +      (distinct "abcabab") '(\a \b \c)
 376.651 +      (distinct "aaab") '(\a \b)
 376.652 +      (distinct "abab") '(\a \b) )
 376.653 +
 376.654 +  (are [x] (= (distinct [x x]) [x])   
 376.655 +      nil
 376.656 +      false true
 376.657 +      0 42
 376.658 +      0.0 3.14
 376.659 +      2/3
 376.660 +      0M 1M
 376.661 +      \c
 376.662 +      "" "abc"
 376.663 +      'sym
 376.664 +      :kw
 376.665 +      () '(1 2)
 376.666 +      [] [1 2]
 376.667 +      {} {:a 1 :b 2}
 376.668 +      #{} #{1 2} ))
 376.669 +
 376.670 +
 376.671 +(deftest test-interpose
 376.672 +  (are [x y] (= x y)
 376.673 +    (interpose 0 []) ()
 376.674 +    (interpose 0 [1]) '(1)
 376.675 +    (interpose 0 [1 2]) '(1 0 2)
 376.676 +    (interpose 0 [1 2 3]) '(1 0 2 0 3) ))
 376.677 +
 376.678 +
 376.679 +(deftest test-interleave
 376.680 +  (are [x y] (= x y)
 376.681 +    (interleave [1 2] [3 4]) '(1 3 2 4)
 376.682 +
 376.683 +    (interleave [1] [3 4]) '(1 3)
 376.684 +    (interleave [1 2] [3]) '(1 3)
 376.685 +
 376.686 +    (interleave [] [3 4]) ()
 376.687 +    (interleave [1 2] []) ()
 376.688 +    (interleave [] []) () ))
 376.689 +
 376.690 +
 376.691 +(deftest test-zipmap
 376.692 +  (are [x y] (= x y)
 376.693 +    (zipmap [:a :b] [1 2]) {:a 1 :b 2}
 376.694 +
 376.695 +    (zipmap [:a] [1 2]) {:a 1}
 376.696 +    (zipmap [:a :b] [1]) {:a 1}
 376.697 +
 376.698 +    (zipmap [] [1 2]) {}
 376.699 +    (zipmap [:a :b] []) {}
 376.700 +    (zipmap [] []) {} ))
 376.701 +
 376.702 +
 376.703 +(deftest test-concat
 376.704 +  (are [x y] (= x y)
 376.705 +    (concat) ()
 376.706 +
 376.707 +    (concat []) ()
 376.708 +    (concat [1 2]) '(1 2)
 376.709 +
 376.710 +    (concat [1 2] [3 4]) '(1 2 3 4)
 376.711 +    (concat [] [3 4]) '(3 4)
 376.712 +    (concat [1 2] []) '(1 2)
 376.713 +    (concat [] []) ()
 376.714 +
 376.715 +    (concat [1 2] [3 4] [5 6]) '(1 2 3 4 5 6) ))
 376.716 +
 376.717 +
 376.718 +(deftest test-cycle
 376.719 +  (are [x y] (= x y)
 376.720 +    (cycle []) ()
 376.721 +
 376.722 +    (take 3 (cycle [1])) '(1 1 1)
 376.723 +    (take 5 (cycle [1 2 3])) '(1 2 3 1 2)
 376.724 +
 376.725 +    (take 3 (cycle [nil])) '(nil nil nil) ))
 376.726 +
 376.727 +
 376.728 +(deftest test-partition
 376.729 +  (are [x y] (= x y)
 376.730 +    (partition 2 [1 2 3]) '((1 2))
 376.731 +    (partition 2 [1 2 3 4]) '((1 2) (3 4))
 376.732 +    (partition 2 []) ()
 376.733 +
 376.734 +    (partition 2 3 [1 2 3 4 5 6 7]) '((1 2) (4 5))
 376.735 +    (partition 2 3 [1 2 3 4 5 6 7 8]) '((1 2) (4 5) (7 8))
 376.736 +    (partition 2 3 []) ()
 376.737 +
 376.738 +    (partition 1 []) ()
 376.739 +    (partition 1 [1 2 3]) '((1) (2) (3))
 376.740 +
 376.741 +    (partition 5 [1 2 3]) ()
 376.742 +
 376.743 +;    (partition 0 [1 2 3]) (repeat nil)   ; infinite sequence of nil
 376.744 +    (partition -1 [1 2 3]) ()
 376.745 +    (partition -2 [1 2 3]) () ))
 376.746 +
 376.747 +
 376.748 +(deftest test-reverse
 376.749 +  (are [x y] (= x y)
 376.750 +    (reverse nil) ()    ; since SVN 1294
 376.751 +    (reverse []) ()
 376.752 +    (reverse [1]) '(1)
 376.753 +    (reverse [1 2 3]) '(3 2 1) ))
 376.754 +
 376.755 +
 376.756 +(deftest test-take
 376.757 +  (are [x y] (= x y)
 376.758 +    (take 1 [1 2 3 4 5]) '(1)
 376.759 +    (take 3 [1 2 3 4 5]) '(1 2 3)
 376.760 +    (take 5 [1 2 3 4 5]) '(1 2 3 4 5)
 376.761 +    (take 9 [1 2 3 4 5]) '(1 2 3 4 5)
 376.762 +
 376.763 +    (take 0 [1 2 3 4 5]) ()
 376.764 +    (take -1 [1 2 3 4 5]) ()
 376.765 +    (take -2 [1 2 3 4 5]) () ))
 376.766 +
 376.767 +
 376.768 +(deftest test-drop
 376.769 +  (are [x y] (= x y)
 376.770 +    (drop 1 [1 2 3 4 5]) '(2 3 4 5)
 376.771 +    (drop 3 [1 2 3 4 5]) '(4 5)
 376.772 +    (drop 5 [1 2 3 4 5]) ()
 376.773 +    (drop 9 [1 2 3 4 5]) ()
 376.774 +
 376.775 +    (drop 0 [1 2 3 4 5]) '(1 2 3 4 5)
 376.776 +    (drop -1 [1 2 3 4 5]) '(1 2 3 4 5)
 376.777 +    (drop -2 [1 2 3 4 5]) '(1 2 3 4 5) ))
 376.778 +
 376.779 +
 376.780 +(deftest test-take-nth
 376.781 +  (are [x y] (= x y)
 376.782 +     (take-nth 1 [1 2 3 4 5]) '(1 2 3 4 5)
 376.783 +     (take-nth 2 [1 2 3 4 5]) '(1 3 5)
 376.784 +     (take-nth 3 [1 2 3 4 5]) '(1 4)
 376.785 +     (take-nth 4 [1 2 3 4 5]) '(1 5)
 376.786 +     (take-nth 5 [1 2 3 4 5]) '(1)
 376.787 +     (take-nth 9 [1 2 3 4 5]) '(1)
 376.788 +
 376.789 +     ; infinite seq of 1s = (repeat 1)
 376.790 +     ;(take-nth 0 [1 2 3 4 5])
 376.791 +     ;(take-nth -1 [1 2 3 4 5])
 376.792 +     ;(take-nth -2 [1 2 3 4 5])
 376.793 +  ))
 376.794 +
 376.795 +
 376.796 +(deftest test-take-while
 376.797 +  (are [x y] (= x y)
 376.798 +    (take-while pos? []) ()
 376.799 +    (take-while pos? [1 2 3 4]) '(1 2 3 4)
 376.800 +    (take-while pos? [1 2 3 -1]) '(1 2 3)
 376.801 +    (take-while pos? [1 -1 2 3]) '(1)
 376.802 +    (take-while pos? [-1 1 2 3]) ()
 376.803 +    (take-while pos? [-1 -2 -3]) () ))
 376.804 +
 376.805 +
 376.806 +(deftest test-drop-while
 376.807 +  (are [x y] (= x y)
 376.808 +    (drop-while pos? []) ()
 376.809 +    (drop-while pos? [1 2 3 4]) ()
 376.810 +    (drop-while pos? [1 2 3 -1]) '(-1)
 376.811 +    (drop-while pos? [1 -1 2 3]) '(-1 2 3)
 376.812 +    (drop-while pos? [-1 1 2 3]) '(-1 1 2 3)
 376.813 +    (drop-while pos? [-1 -2 -3]) '(-1 -2 -3) ))
 376.814 +
 376.815 +
 376.816 +(deftest test-butlast
 376.817 +  (are [x y] (= x y)
 376.818 +    (butlast []) nil
 376.819 +    (butlast [1]) nil
 376.820 +    (butlast [1 2 3]) '(1 2) ))
 376.821 +
 376.822 +
 376.823 +(deftest test-drop-last
 376.824 +  (are [x y] (= x y)
 376.825 +    ; as butlast
 376.826 +    (drop-last []) ()
 376.827 +    (drop-last [1]) ()
 376.828 +    (drop-last [1 2 3]) '(1 2)
 376.829 +
 376.830 +    ; as butlast, but lazy
 376.831 +    (drop-last 1 []) ()
 376.832 +    (drop-last 1 [1]) ()
 376.833 +    (drop-last 1 [1 2 3]) '(1 2)
 376.834 +
 376.835 +    (drop-last 2 []) ()
 376.836 +    (drop-last 2 [1]) ()
 376.837 +    (drop-last 2 [1 2 3]) '(1)
 376.838 +
 376.839 +    (drop-last 5 []) ()
 376.840 +    (drop-last 5 [1]) ()
 376.841 +    (drop-last 5 [1 2 3]) ()
 376.842 +
 376.843 +    (drop-last 0 []) ()
 376.844 +    (drop-last 0 [1]) '(1)
 376.845 +    (drop-last 0 [1 2 3]) '(1 2 3)
 376.846 +
 376.847 +    (drop-last -1 []) ()
 376.848 +    (drop-last -1 [1]) '(1)
 376.849 +    (drop-last -1 [1 2 3]) '(1 2 3)
 376.850 +
 376.851 +    (drop-last -2 []) ()
 376.852 +    (drop-last -2 [1]) '(1)
 376.853 +    (drop-last -2 [1 2 3]) '(1 2 3) ))
 376.854 +
 376.855 +
 376.856 +(deftest test-split-at
 376.857 +  (is (vector? (split-at 2 [])))
 376.858 +  (is (vector? (split-at 2 [1 2 3])))
 376.859 +
 376.860 +  (are [x y] (= x y)
 376.861 +    (split-at 2 []) [() ()]
 376.862 +    (split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)]
 376.863 +
 376.864 +    (split-at 5 [1 2 3]) [(list 1 2 3) ()]
 376.865 +    (split-at 0 [1 2 3]) [() (list 1 2 3)]
 376.866 +    (split-at -1 [1 2 3]) [() (list 1 2 3)]
 376.867 +    (split-at -5 [1 2 3]) [() (list 1 2 3)] ))
 376.868 +
 376.869 +
 376.870 +(deftest test-split-with
 376.871 +  (is (vector? (split-with pos? [])))
 376.872 +  (is (vector? (split-with pos? [1 2 -1 0 3 4])))
 376.873 +
 376.874 +  (are [x y] (= x y)
 376.875 +    (split-with pos? []) [() ()]
 376.876 +    (split-with pos? [1 2 -1 0 3 4]) [(list 1 2) (list -1 0 3 4)]
 376.877 +
 376.878 +    (split-with pos? [-1 2 3 4 5]) [() (list -1 2 3 4 5)]
 376.879 +    (split-with number? [1 -2 "abc" \x]) [(list 1 -2) (list "abc" \x)] ))
 376.880 +
 376.881 +
 376.882 +(deftest test-repeat
 376.883 +  (is (thrown? IllegalArgumentException (repeat)))
 376.884 +
 376.885 +  ; infinite sequence => use take
 376.886 +  (are [x y] (= x y)
 376.887 +      (take 0 (repeat 7)) ()
 376.888 +      (take 1 (repeat 7)) '(7)
 376.889 +      (take 2 (repeat 7)) '(7 7)
 376.890 +      (take 5 (repeat 7)) '(7 7 7 7 7) )
 376.891 +
 376.892 +  ; limited sequence
 376.893 +  (are [x y] (= x y)
 376.894 +      (repeat 0 7) ()
 376.895 +      (repeat 1 7) '(7)
 376.896 +      (repeat 2 7) '(7 7)
 376.897 +      (repeat 5 7) '(7 7 7 7 7)
 376.898 +
 376.899 +      (repeat -1 7) ()
 376.900 +      (repeat -3 7) () )
 376.901 +
 376.902 +  ; test different data types
 376.903 +  (are [x] (= (repeat 3 x) (list x x x))
 376.904 +      nil
 376.905 +      false true
 376.906 +      0 42
 376.907 +      0.0 3.14
 376.908 +      2/3
 376.909 +      0M 1M
 376.910 +      \c
 376.911 +      "" "abc"
 376.912 +      'sym
 376.913 +      :kw
 376.914 +      () '(1 2)
 376.915 +      [] [1 2]
 376.916 +      {} {:a 1 :b 2}
 376.917 +      #{} #{1 2} ))
 376.918 +
 376.919 +
 376.920 +(deftest test-range
 376.921 +  (are [x y] (= x y)
 376.922 +      (range 0) ()   ; exclusive end!
 376.923 +      (range 1) '(0)
 376.924 +      (range 5) '(0 1 2 3 4)
 376.925 +
 376.926 +      (range -1) ()
 376.927 +      (range -3) ()
 376.928 +
 376.929 +      (range 2.5) '(0 1 2)
 376.930 +      (range 7/3) '(0 1 2)
 376.931 +
 376.932 +      (range 0 3) '(0 1 2)
 376.933 +      (range 0 1) '(0)
 376.934 +      (range 0 0) ()
 376.935 +      (range 0 -3) ()
 376.936 +
 376.937 +      (range 3 6) '(3 4 5)
 376.938 +      (range 3 4) '(3)
 376.939 +      (range 3 3) ()
 376.940 +      (range 3 1) ()
 376.941 +      (range 3 0) ()
 376.942 +      (range 3 -2) ()
 376.943 +
 376.944 +      (range -2 5) '(-2 -1 0 1 2 3 4)
 376.945 +      (range -2 0) '(-2 -1)
 376.946 +      (range -2 -1) '(-2)
 376.947 +      (range -2 -2) ()
 376.948 +      (range -2 -5) ()
 376.949 +
 376.950 +      (range 3 9 0) ()
 376.951 +      (range 3 9 1) '(3 4 5 6 7 8)
 376.952 +      (range 3 9 2) '(3 5 7)
 376.953 +      (range 3 9 3) '(3 6)
 376.954 +      (range 3 9 10) '(3)
 376.955 +      (range 3 9 -1) () ))
 376.956 +
 376.957 +
 376.958 +(deftest test-empty?
 376.959 +  (are [x] (empty? x)
 376.960 +    nil
 376.961 +    ()
 376.962 +    (lazy-seq nil)    ; => ()
 376.963 +    []
 376.964 +    {}
 376.965 +    #{}
 376.966 +    ""
 376.967 +    (into-array []) )
 376.968 +
 376.969 +  (are [x] (not (empty? x))
 376.970 +    '(1 2)
 376.971 +    (lazy-seq [1 2])
 376.972 +    [1 2]
 376.973 +    {:a 1 :b 2}
 376.974 +    #{1 2}
 376.975 +    "abc"
 376.976 +    (into-array [1 2]) ))
 376.977 +
 376.978 +
 376.979 +(deftest test-every?
 376.980 +  ; always true for nil or empty coll/seq
 376.981 +  (are [x] (= (every? pos? x) true)
 376.982 +      nil
 376.983 +      () [] {} #{}
 376.984 +      (lazy-seq [])
 376.985 +      (into-array []) )
 376.986 +
 376.987 +  (are [x y] (= x y)
 376.988 +      true (every? pos? [1])
 376.989 +      true (every? pos? [1 2])
 376.990 +      true (every? pos? [1 2 3 4 5])
 376.991 +
 376.992 +      false (every? pos? [-1])
 376.993 +      false (every? pos? [-1 -2])
 376.994 +      false (every? pos? [-1 -2 3])
 376.995 +      false (every? pos? [-1 2])
 376.996 +      false (every? pos? [1 -2])
 376.997 +      false (every? pos? [1 2 -3])
 376.998 +      false (every? pos? [1 2 -3 4]) )
 376.999 +
376.1000 +  (are [x y] (= x y)
376.1001 +      true (every? #{:a} [:a :a])
376.1002 +;!      false (every? #{:a} [:a :b])   ; Issue 68: every? returns nil instead of false
376.1003 +;!      false (every? #{:a} [:b :b])   ; http://code.google.com/p/clojure/issues/detail?id=68
376.1004 +  ))
376.1005 +
376.1006 +
376.1007 +(deftest test-not-every?
376.1008 +  ; always false for nil or empty coll/seq
376.1009 +  (are [x] (= (not-every? pos? x) false)
376.1010 +      nil
376.1011 +      () [] {} #{}
376.1012 +      (lazy-seq [])
376.1013 +      (into-array []) )
376.1014 +
376.1015 +  (are [x y] (= x y)
376.1016 +      false (not-every? pos? [1])
376.1017 +      false (not-every? pos? [1 2])
376.1018 +      false (not-every? pos? [1 2 3 4 5])
376.1019 +
376.1020 +      true (not-every? pos? [-1])
376.1021 +      true (not-every? pos? [-1 -2])
376.1022 +      true (not-every? pos? [-1 -2 3])
376.1023 +      true (not-every? pos? [-1 2])
376.1024 +      true (not-every? pos? [1 -2])
376.1025 +      true (not-every? pos? [1 2 -3])
376.1026 +      true (not-every? pos? [1 2 -3 4]) )
376.1027 +
376.1028 +  (are [x y] (= x y)
376.1029 +      false (not-every? #{:a} [:a :a])
376.1030 +      true (not-every? #{:a} [:a :b])
376.1031 +      true (not-every? #{:a} [:b :b]) ))
376.1032 +
376.1033 +
376.1034 +(deftest test-not-any?
376.1035 +  ; always true for nil or empty coll/seq
376.1036 +  (are [x] (= (not-any? pos? x) true)
376.1037 +      nil
376.1038 +      () [] {} #{}
376.1039 +      (lazy-seq [])
376.1040 +      (into-array []) )
376.1041 +
376.1042 +  (are [x y] (= x y)
376.1043 +      false (not-any? pos? [1])
376.1044 +      false (not-any? pos? [1 2])
376.1045 +      false (not-any? pos? [1 2 3 4 5])
376.1046 +
376.1047 +      true (not-any? pos? [-1])
376.1048 +      true (not-any? pos? [-1 -2])
376.1049 +
376.1050 +      false (not-any? pos? [-1 -2 3])
376.1051 +      false (not-any? pos? [-1 2])
376.1052 +      false (not-any? pos? [1 -2])
376.1053 +      false (not-any? pos? [1 2 -3])
376.1054 +      false (not-any? pos? [1 2 -3 4]) )
376.1055 +
376.1056 +  (are [x y] (= x y)
376.1057 +      false (not-any? #{:a} [:a :a])
376.1058 +      false (not-any? #{:a} [:a :b])
376.1059 +      true (not-any? #{:a} [:b :b]) ))
376.1060 +
376.1061 +
376.1062 +(deftest test-some
376.1063 +  ;; always nil for nil or empty coll/seq
376.1064 +  (are [x] (= (some pos? x) nil)
376.1065 +       nil
376.1066 +       () [] {} #{}
376.1067 +       (lazy-seq [])
376.1068 +       (into-array []))
376.1069 +  
376.1070 +  (are [x y] (= x y)
376.1071 +       nil (some nil nil)
376.1072 +       
376.1073 +       true (some pos? [1])
376.1074 +       true (some pos? [1 2])
376.1075 +       
376.1076 +       nil (some pos? [-1])
376.1077 +       nil (some pos? [-1 -2])
376.1078 +       true (some pos? [-1 2])
376.1079 +       true (some pos? [1 -2])
376.1080 +       
376.1081 +       :a (some #{:a} [:a :a])
376.1082 +       :a (some #{:a} [:b :a])
376.1083 +       nil (some #{:a} [:b :b])
376.1084 +       
376.1085 +       :a (some #{:a} '(:a :b))
376.1086 +       :a (some #{:a} #{:a :b})
376.1087 +       ))
376.1088 +
376.1089 +(deftest test-flatten-present
376.1090 +  (are [expected nested-val] (= (flatten nested-val) expected)
376.1091 +       ;simple literals
376.1092 +       [] nil
376.1093 +       [] 1
376.1094 +       [] 'test
376.1095 +       [] :keyword
376.1096 +       [] 1/2
376.1097 +       [] #"[\r\n]"
376.1098 +       [] true
376.1099 +       [] false
376.1100 +       ;vectors
376.1101 +       [1 2 3 4 5] [[1 2] [3 4 [5]]]
376.1102 +       [1 2 3 4 5] [1 2 3 4 5]
376.1103 +       [#{1 2} 3 4 5] [#{1 2} 3 4 5]
376.1104 +       ;sets
376.1105 +       [] #{}
376.1106 +       [] #{#{1 2} 3 4 5}
376.1107 +       [] #{1 2 3 4 5}
376.1108 +       [] #{#{1 2} 3 4 5}
376.1109 +       ;lists
376.1110 +       [] '()
376.1111 +       [1 2 3 4 5] `(1 2 3 4 5)
376.1112 +       ;maps
376.1113 +       [] {:a 1 :b 2}
376.1114 +       [:a 1 :b 2] (seq {:a 1 :b 2})
376.1115 +       [] {[:a :b] 1 :c 2}
376.1116 +       [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2})
376.1117 +       [:a 1 2 :b 3] (seq {:a [1 2] :b 3})
376.1118 +       ;Strings
376.1119 +       [] "12345"
376.1120 +       [\1 \2 \3 \4 \5] (seq "12345")
376.1121 +       ;fns
376.1122 +       [] count
376.1123 +       [count even? odd?] [count even? odd?]))
376.1124 +
376.1125 +(deftest test-group-by
376.1126 +  (is (= (group-by even? [1 2 3 4 5]) 
376.1127 +	 {false [1 3 5], true [2 4]})))
376.1128 +
376.1129 +(deftest test-partition-by
376.1130 +  (are [test-seq] (= (partition-by (comp even? count) test-seq)
376.1131 +		     [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]])
376.1132 +       ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"]
376.1133 +       '("a" "bb" "cccc" "dd" "eee" "f" "" "hh"))
376.1134 +  (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm")
376.1135 +       [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]])))
376.1136 +
376.1137 +(deftest test-frequencies
376.1138 +  (are [expected test-seq] (= (frequencies test-seq) expected)
376.1139 +       {\p 2, \s 4, \i 4, \m 1} "mississippi"
376.1140 +       {1 4 2 2 3 1} [1 1 1 1 2 2 3]
376.1141 +       {1 4 2 2 3 1} '(1 1 1 1 2 2 3)))
376.1142 +
376.1143 +(deftest test-reductions
376.1144 +  (is (= (reductions + nil)
376.1145 +         [0]))
376.1146 +  (is (= (reductions + [1 2 3 4 5])
376.1147 +	 [1 3 6 10 15]))
376.1148 +  (is (= (reductions + 10 [1 2 3 4 5])
376.1149 +	 [10 11 13 16 20 25])))
376.1150 +
376.1151 +(deftest test-rand-nth-invariants
376.1152 +  (let [elt (rand-nth [:a :b :c :d])]
376.1153 +    (is (#{:a :b :c :d} elt))))
376.1154 +
376.1155 +(deftest test-partition-all
376.1156 +  (is (= (partition-all 4 [1 2 3 4 5 6 7 8 9])
376.1157 +	 [[1 2 3 4] [5 6 7 8] [9]]))
376.1158 +  (is (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9])
376.1159 +	 [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]])))
376.1160 +
376.1161 +(deftest test-shuffle-invariants
376.1162 +  (is (= (count (shuffle [1 2 3 4])) 4))
376.1163 +  (let [shuffled-seq (shuffle [1 2 3 4])]
376.1164 +    (is (every? #{1 2 3 4} shuffled-seq))))
376.1165 +
   377.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   377.2 +++ b/src/clojure/test_clojure/serialization.clj	Sat Aug 21 06:25:44 2010 -0400
   377.3 @@ -0,0 +1,158 @@
   377.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   377.5 +;   The use and distribution terms for this software are covered by the
   377.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   377.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   377.8 +;   By using this software in any fashion, you are agreeing to be bound by
   377.9 +;   the terms of this license.
  377.10 +;   You must not remove this notice, or any other, from this software.
  377.11 +
  377.12 +;; Author: Chas Emerick
  377.13 +;;         cemerick@snowtide.com
  377.14 +
  377.15 +(ns clojure.test-clojure.serialization
  377.16 +  (:use clojure.test)
  377.17 +  (:import (java.io ObjectOutputStream ObjectInputStream
  377.18 +             ByteArrayOutputStream ByteArrayInputStream)))
  377.19 +
  377.20 +(defn- serialize
  377.21 +  "Serializes a single object, returning a byte array."
  377.22 +  [v]
  377.23 +  (with-open [bout (ByteArrayOutputStream.)
  377.24 +              oos (ObjectOutputStream. bout)]
  377.25 +    (.writeObject oos v)
  377.26 +    (.flush oos)
  377.27 +    (.toByteArray bout)))
  377.28 +
  377.29 +(defn- deserialize
  377.30 +  "Deserializes and returns a single object from the given byte array."
  377.31 +  [bytes]
  377.32 +  (with-open [ois (-> bytes ByteArrayInputStream. ObjectInputStream.)]
  377.33 +    (.readObject ois)))
  377.34 +
  377.35 +(defrecord SerializationRecord [a b c])
  377.36 +(defstruct SerializationStruct :a :b :c)
  377.37 +
  377.38 +(defn- build-via-transient
  377.39 +  [coll]
  377.40 +  (persistent!
  377.41 +    (reduce conj! (transient coll) (map vec (partition 2 (range 1000))))))
  377.42 +
  377.43 +(defn- roundtrip
  377.44 +  [v]
  377.45 +  (let [rt (-> v serialize deserialize)
  377.46 +        rt-seq (-> v seq serialize deserialize)]
  377.47 +    (and (= v rt)
  377.48 +      (= (seq v) (seq rt))
  377.49 +      (= (seq v) rt-seq))))
  377.50 +
  377.51 +(deftest sequable-serialization
  377.52 +  (are [val] (roundtrip val)
  377.53 +    ; lists and related
  377.54 +    (list)
  377.55 +    (apply list (range 10))
  377.56 +    (cons 0 nil)
  377.57 +    (clojure.lang.Cons. 0 nil)
  377.58 +
  377.59 +    ; vectors
  377.60 +    []
  377.61 +    (into [] (range 10))
  377.62 +    (into [] (range 25))
  377.63 +    (into [] (range 100))
  377.64 +    (into [] (range 500))
  377.65 +    (into [] (range 1000))
  377.66 +
  377.67 +    ; maps
  377.68 +    {}
  377.69 +    {:a 5 :b 0}
  377.70 +    (apply array-map (range 100))
  377.71 +    (apply hash-map (range 100))
  377.72 +
  377.73 +    ; sets
  377.74 +    #{}
  377.75 +    #{'a 'b 'c}
  377.76 +    (set (range 10))
  377.77 +    (set (range 25))
  377.78 +    (set (range 100))
  377.79 +    (set (range 500))
  377.80 +    (set (range 1000))
  377.81 +    (sorted-set)
  377.82 +    (sorted-set 'a 'b 'c)
  377.83 +    (apply sorted-set (reverse (range 10)))
  377.84 +    (apply sorted-set (reverse (range 25)))
  377.85 +    (apply sorted-set (reverse (range 100)))
  377.86 +    (apply sorted-set (reverse (range 500)))
  377.87 +    (apply sorted-set (reverse (range 1000)))
  377.88 +
  377.89 +    ; queues
  377.90 +    clojure.lang.PersistentQueue/EMPTY
  377.91 +    (into clojure.lang.PersistentQueue/EMPTY (range 50))
  377.92 +
  377.93 +    ; lazy seqs
  377.94 +    (lazy-seq nil)
  377.95 +    (lazy-seq (range 50))
  377.96 +
  377.97 +    ; transient / persistent! round-trip
  377.98 +    (build-via-transient [])
  377.99 +    (build-via-transient {})
 377.100 +    (build-via-transient #{})
 377.101 +    
 377.102 +    ; array-seqs
 377.103 +    (seq (make-array Object 10))
 377.104 +    (seq (make-array Boolean/TYPE 10))
 377.105 +    (seq (make-array Byte/TYPE 10))
 377.106 +    (seq (make-array Character/TYPE 10))
 377.107 +    (seq (make-array Double/TYPE 10))
 377.108 +    (seq (make-array Float/TYPE 10))
 377.109 +    (seq (make-array Integer/TYPE 10))
 377.110 +    (seq (make-array Long/TYPE 10))
 377.111 +
 377.112 +    ; "records"
 377.113 +    (SerializationRecord. 0 :foo (range 20))
 377.114 +    (struct SerializationStruct 0 :foo (range 20))
 377.115 +
 377.116 +    ; misc seqs
 377.117 +    (seq "s11n")
 377.118 +    (range 50)
 377.119 +    (rseq (apply sorted-set (reverse (range 100))))))
 377.120 +
 377.121 +(deftest misc-serialization
 377.122 +  (are [v] (= v (-> v serialize deserialize))
 377.123 +    25/3
 377.124 +    :keyword
 377.125 +    ::namespaced-keyword
 377.126 +    'symbol))
 377.127 +
 377.128 +(deftest interned-serializations
 377.129 +  (are [v] (identical? v (-> v serialize deserialize))
 377.130 +    clojure.lang.RT/DEFAULT_COMPARATOR
 377.131 +    
 377.132 +    ; namespaces just get deserialized back into the same-named ns in the present runtime
 377.133 +    ; (they're referred to by defrecord instances)
 377.134 +    *ns*))
 377.135 +
 377.136 +(deftest function-serialization
 377.137 +  (let [capture 5]
 377.138 +    (are [f] (= capture ((-> f serialize deserialize)))
 377.139 +      (constantly 5)
 377.140 +      (fn [] 5)
 377.141 +      #(do 5)
 377.142 +      (constantly capture)
 377.143 +      (fn [] capture)
 377.144 +      #(do capture))))
 377.145 +
 377.146 +(deftest check-unserializable-objects
 377.147 +  (are [t] (thrown? java.io.NotSerializableException (serialize t))
 377.148 +    ;; transients
 377.149 +    (transient [])
 377.150 +    (transient {})
 377.151 +    (transient #{})
 377.152 +
 377.153 +    ;; reference types
 377.154 +    (atom nil)
 377.155 +    (ref nil)
 377.156 +    (agent nil)
 377.157 +    #'+
 377.158 +
 377.159 +    ;; stateful seqs
 377.160 +    (enumeration-seq (java.util.Collections/enumeration (range 50)))
 377.161 +    (iterator-seq (.iterator (range 50)))))
 377.162 \ No newline at end of file
   378.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   378.2 +++ b/src/clojure/test_clojure/special.clj	Sat Aug 21 06:25:44 2010 -0400
   378.3 @@ -0,0 +1,24 @@
   378.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   378.5 +;   The use and distribution terms for this software are covered by the
   378.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   378.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   378.8 +;   By using this software in any fashion, you are agreeing to be bound by
   378.9 +;   the terms of this license.
  378.10 +;   You must not remove this notice, or any other, from this software.
  378.11 +
  378.12 +; Author: Frantisek Sodomka
  378.13 +
  378.14 +;;
  378.15 +;;  Test special forms, macros and metadata
  378.16 +;;
  378.17 +
  378.18 +(ns clojure.test-clojure.special
  378.19 +  (:use clojure.test))
  378.20 +
  378.21 +; http://clojure.org/special_forms
  378.22 +
  378.23 +; let, letfn
  378.24 +; quote
  378.25 +; var
  378.26 +; fn
  378.27 +
   379.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   379.2 +++ b/src/clojure/test_clojure/string.clj	Sat Aug 21 06:25:44 2010 -0400
   379.3 @@ -0,0 +1,120 @@
   379.4 +(ns clojure.test-clojure.string
   379.5 +  (:require [clojure.string :as s])
   379.6 +  (:use clojure.test))
   379.7 +
   379.8 +(deftest t-split
   379.9 +  (is (= ["a" "b"] (s/split "a-b" #"-")))
  379.10 +  (is (= ["a" "b-c"] (s/split "a-b-c" #"-" 2)))
  379.11 +  (is (vector? (s/split "abc" #"-"))))
  379.12 +
  379.13 +(deftest t-reverse
  379.14 +  (is (= "tab" (s/reverse "bat"))))
  379.15 +
  379.16 +(deftest t-replace
  379.17 +  (is (= "faabar" (s/replace "foobar" \o \a)))
  379.18 +  (is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar")))
  379.19 +  (is (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case))))
  379.20 +
  379.21 +(deftest t-replace-first
  379.22 +  (is (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar")))
  379.23 +  (is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar")))
  379.24 +  (is (= "z.ology" (s/replace-first "zoology" \o \.)))
  379.25 +  (is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case))))
  379.26 +
  379.27 +(deftest t-join
  379.28 +  (are [x coll] (= x (s/join coll))
  379.29 +       "" nil
  379.30 +       "" []
  379.31 +       "1" [1]
  379.32 +       "12" [1 2])
  379.33 +  (are [x sep coll] (= x (s/join sep coll))
  379.34 +       "1,2,3" \, [1 2 3]
  379.35 +       "" \, []
  379.36 +       "1" \, [1]
  379.37 +       "1 and-a 2 and-a 3" " and-a " [1 2 3]))
  379.38 +
  379.39 +(deftest t-trim-newline
  379.40 +  (is (= "foo" (s/trim-newline "foo\n")))
  379.41 +  (is (= "foo" (s/trim-newline "foo\r\n")))
  379.42 +  (is (= "foo" (s/trim-newline "foo")))
  379.43 +  (is (= "" (s/trim-newline ""))))
  379.44 +
  379.45 +(deftest t-capitalize
  379.46 +  (is (= "Foobar" (s/capitalize "foobar")))
  379.47 +  (is (= "Foobar" (s/capitalize "FOOBAR"))))
  379.48 +
  379.49 +(deftest t-triml
  379.50 +  (is (= "foo " (s/triml " foo ")))
  379.51 +  (is (= "" (s/triml "   "))))
  379.52 +
  379.53 +(deftest t-trimr
  379.54 +  (is (= " foo" (s/trimr " foo ")))
  379.55 +  (is (= "" (s/trimr "   "))))
  379.56 +
  379.57 +(deftest t-trim
  379.58 +  (is (= "foo" (s/trim "  foo  \r\n"))))
  379.59 +
  379.60 +(deftest t-upper-case
  379.61 +  (is (= "FOOBAR" (s/upper-case "Foobar"))))
  379.62 +
  379.63 +(deftest t-lower-case
  379.64 +  (is (= "foobar" (s/lower-case "FooBar"))))
  379.65 +
  379.66 +(deftest nil-handling
  379.67 +  (are [f args] (thrown? NullPointerException (apply f args))
  379.68 +       s/reverse [nil]
  379.69 +       s/replace [nil #"foo" "bar"]
  379.70 +       s/replace-first [nil #"foo" "bar"]
  379.71 +       s/capitalize [nil]
  379.72 +       s/upper-case [nil]
  379.73 +       s/lower-case [nil]
  379.74 +       s/split [nil #"-"]
  379.75 +       s/split [nil #"-" 1]
  379.76 +       s/trim [nil]
  379.77 +       s/triml [nil]
  379.78 +       s/trimr [nil]
  379.79 +       s/trim-newline [nil]))
  379.80 +
  379.81 +(deftest char-sequence-handling
  379.82 +  (are [result f args] (let [[^CharSequence s & more] args]
  379.83 +                         (= result (apply f (StringBuffer. s) more)))
  379.84 +       "paz" s/reverse ["zap"]
  379.85 +       "foo:bar" s/replace ["foo-bar" \- \:]
  379.86 +       "ABC" s/replace ["abc" #"\w" s/upper-case]
  379.87 +       "faa" s/replace ["foo" #"o" (StringBuffer. "a")]
  379.88 +       "baz::quux" s/replace-first ["baz--quux" #"--" "::"]
  379.89 +       "baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")]
  379.90 +       "zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")]
  379.91 +       "Pow" s/capitalize ["POW"]
  379.92 +       "BOOM" s/upper-case ["boom"]
  379.93 +       "whimper" s/lower-case ["whimPER"]
  379.94 +       ["foo" "bar"] s/split ["foo-bar" #"-"]
  379.95 +       "calvino" s/trim ["  calvino  "]
  379.96 +       "calvino  " s/triml ["  calvino  "]
  379.97 +       "  calvino" s/trimr ["  calvino  "]
  379.98 +       "the end" s/trim-newline ["the end\r\n\r\r\n"]
  379.99 +       true s/blank? [" "]
 379.100 +       ["a" "b"] s/split-lines ["a\nb"]
 379.101 +       "fa la la" s/escape ["fo lo lo" {\o \a}]))
 379.102 +
 379.103 +(deftest t-escape
 379.104 +  (is (= "&lt;foo&amp;bar&gt;"
 379.105 +         (s/escape "<foo&bar>" {\& "&amp;" \< "&lt;" \> "&gt;"})))
 379.106 +  (is (= " \\\"foo\\\" "
 379.107 +         (s/escape " \"foo\" " {\" "\\\""})))
 379.108 +  (is (= "faabor"
 379.109 +         (s/escape "foobar" {\a \o, \o \a}))))
 379.110 +
 379.111 +(deftest t-blank
 379.112 +  (is (s/blank? nil))
 379.113 +  (is (s/blank? ""))
 379.114 +  (is (s/blank? " "))
 379.115 +  (is (s/blank? " \t \n  \r "))
 379.116 +  (is (not (s/blank? "  foo  "))))
 379.117 +
 379.118 +(deftest t-split-lines
 379.119 +  (let [result (s/split-lines "one\ntwo\r\nthree")]
 379.120 +    (is (= ["one" "two" "three"] result))
 379.121 +    (is (vector? result)))
 379.122 +  (is (= (list "foo") (s/split-lines "foo"))))
 379.123 +
   380.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   380.2 +++ b/src/clojure/test_clojure/test.clj	Sat Aug 21 06:25:44 2010 -0400
   380.3 @@ -0,0 +1,115 @@
   380.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   380.5 +;   The use and distribution terms for this software are covered by the
   380.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   380.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   380.8 +;   By using this software in any fashion, you are agreeing to be bound by
   380.9 +;   the terms of this license.
  380.10 +;   You must not remove this notice, or any other, from this software.
  380.11 +
  380.12 +;;; test_clojure/test.clj: unit tests for test.clj
  380.13 +
  380.14 +;; by Stuart Sierra
  380.15 +;; January 16, 2009
  380.16 +
  380.17 +;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for
  380.18 +;; contributions and suggestions.
  380.19 +
  380.20 +
  380.21 +(ns clojure.test-clojure.test
  380.22 +  (:use clojure.test))
  380.23 +
  380.24 +(deftest can-test-symbol
  380.25 +  (let [x true]
  380.26 +    (is x "Should pass"))
  380.27 +  (let [x false]
  380.28 +    (is x "Should fail")))
  380.29 +
  380.30 +(deftest can-test-boolean
  380.31 +  (is true "Should pass")
  380.32 +  (is false "Should fail"))
  380.33 +
  380.34 +(deftest can-test-nil
  380.35 +  (is nil "Should fail"))
  380.36 +
  380.37 +(deftest can-test-=
  380.38 +  (is (= 2 (+ 1 1)) "Should pass")
  380.39 +  (is (= 3 (+ 2 2)) "Should fail"))
  380.40 +
  380.41 +(deftest can-test-instance
  380.42 +  (is (instance? Integer (+ 2 2)) "Should pass")
  380.43 +  (is (instance? Float (+ 1 1)) "Should fail"))
  380.44 +
  380.45 +(deftest can-test-thrown
  380.46 +  (is (thrown? ArithmeticException (/ 1 0)) "Should pass")
  380.47 +  ;; No exception is thrown:
  380.48 +  (is (thrown? Exception (+ 1 1)) "Should fail")
  380.49 +  ;; Wrong class of exception is thrown:
  380.50 +  (is (thrown? ArithmeticException (throw (RuntimeException.))) "Should error"))
  380.51 +
  380.52 +(deftest can-test-thrown-with-msg
  380.53 +  (is (thrown-with-msg? ArithmeticException #"Divide by zero" (/ 1 0)) "Should pass")
  380.54 +  ;; Wrong message string:
  380.55 +  (is (thrown-with-msg? ArithmeticException #"Something else" (/ 1 0)) "Should fail")
  380.56 +  ;; No exception is thrown:
  380.57 +  (is (thrown? Exception (+ 1 1)) "Should fail")
  380.58 +  ;; Wrong class of exception is thrown:
  380.59 +  (is (thrown-with-msg? IllegalArgumentException #"Divide by zero" (/ 1 0)) "Should error"))
  380.60 +
  380.61 +(deftest can-catch-unexpected-exceptions
  380.62 +  (is (= 1 (throw (Exception.))) "Should error"))
  380.63 +
  380.64 +(deftest can-test-method-call
  380.65 +  (is (.startsWith "abc" "a") "Should pass")
  380.66 +  (is (.startsWith "abc" "d") "Should fail"))
  380.67 +
  380.68 +(deftest can-test-anonymous-fn
  380.69 +  (is (#(.startsWith % "a") "abc") "Should pass")
  380.70 +  (is (#(.startsWith % "d") "abc") "Should fail"))
  380.71 +
  380.72 +(deftest can-test-regexps
  380.73 +  (is (re-matches #"^ab.*$" "abbabba") "Should pass")
  380.74 +  (is (re-matches #"^cd.*$" "abbabba") "Should fail")
  380.75 +  (is (re-find #"ab" "abbabba") "Should pass")
  380.76 +  (is (re-find #"cd" "abbabba") "Should fail"))
  380.77 +
  380.78 +(deftest #^{:has-meta true} can-add-metadata-to-tests
  380.79 +  (is (:has-meta (meta #'can-add-metadata-to-tests)) "Should pass"))
  380.80 +
  380.81 +;; still have to declare the symbol before testing unbound symbols
  380.82 +(declare does-not-exist)
  380.83 +
  380.84 +(deftest can-test-unbound-symbol
  380.85 +  (is (= nil does-not-exist) "Should error"))
  380.86 +
  380.87 +(deftest can-test-unbound-function
  380.88 +  (is (does-not-exist) "Should error"))
  380.89 +
  380.90 +
  380.91 +;; Here, we create an alternate version of test/report, that
  380.92 +;; compares the event with the message, then calls the original
  380.93 +;; 'report' with modified arguments.
  380.94 +
  380.95 +(declare original-report)
  380.96 +
  380.97 +(defn custom-report [data]
  380.98 +  (let [event (:type data)
  380.99 +        msg (:message data)
 380.100 +        expected (:expected data)
 380.101 +        actual (:actual data)
 380.102 +        passed (cond
 380.103 +                 (= event :fail) (= msg "Should fail")
 380.104 +                 (= event :pass) (= msg "Should pass")
 380.105 +                 (= event :error) (= msg "Should error")
 380.106 +                 :else true)]
 380.107 +    (if passed
 380.108 +      (original-report {:type :pass, :message msg,
 380.109 +                        :expected expected, :actual actual})
 380.110 +      (original-report {:type :fail, :message (str msg " but got " event)
 380.111 +                        :expected expected, :actual actual}))))
 380.112 +
 380.113 +;; test-ns-hook will be used by test/test-ns to run tests in this
 380.114 +;; namespace.
 380.115 +(defn test-ns-hook []
 380.116 +  (binding [original-report report
 380.117 +            report custom-report]
 380.118 +    (test-all-vars (find-ns 'clojure.test-clojure.test))))
   381.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   381.2 +++ b/src/clojure/test_clojure/test_fixtures.clj	Sat Aug 21 06:25:44 2010 -0400
   381.3 @@ -0,0 +1,50 @@
   381.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   381.5 +;   The use and distribution terms for this software are covered by the
   381.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   381.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   381.8 +;   By using this software in any fashion, you are agreeing to be bound by
   381.9 +;   the terms of this license.
  381.10 +;   You must not remove this notice, or any other, from this software.
  381.11 +;
  381.12 +;;; test_fixtures.clj: unit tests for fixtures in test.clj
  381.13 +
  381.14 +;; by Stuart Sierra
  381.15 +;; March 28, 2009
  381.16 +
  381.17 +(ns clojure.test-clojure.test-fixtures
  381.18 +  (:use clojure.test))
  381.19 +
  381.20 +(declare *a* *b* *c* *d*)
  381.21 +
  381.22 +(def *n* 0)
  381.23 +
  381.24 +(defn fixture-a [f]
  381.25 +  (binding [*a* 3] (f)))
  381.26 +
  381.27 +(defn fixture-b [f]
  381.28 +  (binding [*b* 5] (f)))
  381.29 +
  381.30 +(defn fixture-c [f]
  381.31 +  (binding [*c* 7] (f)))
  381.32 +
  381.33 +(defn fixture-d [f]
  381.34 +  (binding [*d* 11] (f)))
  381.35 +
  381.36 +(defn inc-n-fixture [f]
  381.37 +  (binding [*n* (inc *n*)] (f)))
  381.38 +
  381.39 +(use-fixtures :once fixture-a fixture-b)
  381.40 +
  381.41 +(use-fixtures :each fixture-c fixture-d inc-n-fixture)
  381.42 +(use-fixtures :each fixture-c fixture-d inc-n-fixture)
  381.43 +
  381.44 +(deftest can-use-once-fixtures
  381.45 +  (is (= 3 *a*))
  381.46 +  (is (= 5 *b*)))
  381.47 +
  381.48 +(deftest can-use-each-fixtures
  381.49 +  (is (= 7 *c*))
  381.50 +  (is (= 11 *d*)))
  381.51 +
  381.52 +(deftest use-fixtures-replaces
  381.53 +  (is (= *n* 1)))
  381.54 \ No newline at end of file
   382.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   382.2 +++ b/src/clojure/test_clojure/transients.clj	Sat Aug 21 06:25:44 2010 -0400
   382.3 @@ -0,0 +1,12 @@
   382.4 +(ns clojure.test-clojure.transients
   382.5 +  (:use clojure.test))
   382.6 +
   382.7 +(deftest popping-off
   382.8 +  (testing "across a node boundary"
   382.9 +    (are [n] 
  382.10 +      (let [v (-> (range n) vec)]
  382.11 +        (= (subvec v 0 (- n 2)) (-> v transient pop! pop! persistent!)))
  382.12 +      33 (+ 32 (inc (* 32 32))) (+ 32 (inc (* 32 32 32)))))
  382.13 +  (testing "off the end"
  382.14 +    (is (thrown-with-msg? IllegalStateException #"Can't pop empty vector"
  382.15 +          (-> [] transient pop!)))))
   383.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   383.2 +++ b/src/clojure/test_clojure/vars.clj	Sat Aug 21 06:25:44 2010 -0400
   383.3 @@ -0,0 +1,56 @@
   383.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   383.5 +;   The use and distribution terms for this software are covered by the
   383.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   383.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   383.8 +;   By using this software in any fashion, you are agreeing to be bound by
   383.9 +;   the terms of this license.
  383.10 +;   You must not remove this notice, or any other, from this software.
  383.11 +
  383.12 +; Author: Frantisek Sodomka, Stephen C. Gilardi
  383.13 +
  383.14 +
  383.15 +(ns clojure.test-clojure.vars
  383.16 +  (:use clojure.test))
  383.17 +
  383.18 +; http://clojure.org/vars
  383.19 +
  383.20 +; def
  383.21 +; defn defn- defonce
  383.22 +
  383.23 +; declare intern binding find-var var
  383.24 +
  383.25 +(def a)
  383.26 +(deftest test-binding
  383.27 +  (are [x y] (= x y)
  383.28 +      (eval `(binding [a 4] a)) 4     ; regression in Clojure SVN r1370
  383.29 +  ))
  383.30 +
  383.31 +; with-local-vars var-get var-set alter-var-root [var? (predicates.clj)]
  383.32 +; with-in-str with-out-str
  383.33 +; with-open
  383.34 +; with-precision
  383.35 +
  383.36 +(deftest test-with-precision
  383.37 +  (are [x y] (= x y)
  383.38 +       (with-precision 4 (+ 3.5555555M 1)) 4.556M
  383.39 +       (with-precision 6 (+ 3.5555555M 1)) 4.55556M
  383.40 +       (with-precision 6 :rounding CEILING     (+ 3.5555555M 1)) 4.55556M
  383.41 +       (with-precision 6 :rounding FLOOR       (+ 3.5555555M 1)) 4.55555M
  383.42 +       (with-precision 6 :rounding HALF_UP     (+ 3.5555555M 1)) 4.55556M
  383.43 +       (with-precision 6 :rounding HALF_DOWN   (+ 3.5555555M 1)) 4.55556M
  383.44 +       (with-precision 6 :rounding HALF_EVEN   (+ 3.5555555M 1)) 4.55556M
  383.45 +       (with-precision 6 :rounding UP          (+ 3.5555555M 1)) 4.55556M
  383.46 +       (with-precision 6 :rounding DOWN        (+ 3.5555555M 1)) 4.55555M
  383.47 +       (with-precision 6 :rounding UNNECESSARY (+ 3.5555M 1))    4.5555M))
  383.48 +
  383.49 +(deftest test-settable-math-context
  383.50 +  (is (=
  383.51 +       (clojure.main/with-bindings
  383.52 +         (set! *math-context* (java.math.MathContext. 8))
  383.53 +         (+ 3.55555555555555M 1))
  383.54 +       4.5555556M)))
  383.55 +
  383.56 +; set-validator get-validator
  383.57 +
  383.58 +; doc find-doc test
  383.59 +
   384.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   384.2 +++ b/src/clojure/test_clojure/vectors.clj	Sat Aug 21 06:25:44 2010 -0400
   384.3 @@ -0,0 +1,304 @@
   384.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   384.5 +;   The use and distribution terms for this software are covered by the
   384.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   384.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   384.8 +;   By using this software in any fashion, you are agreeing to be bound by
   384.9 +;   the terms of this license.
  384.10 +;   You must not remove this notice, or any other, from this software.
  384.11 +
  384.12 +; Author: Stuart Halloway, Daniel Solano Gómez
  384.13 +
  384.14 +(ns clojure.test-clojure.vectors
  384.15 +  (:use clojure.test))
  384.16 +
  384.17 +(deftest test-reversed-vec
  384.18 +  (let [r (range 6)
  384.19 +        v (into (vector-of :int) r)
  384.20 +        reversed (.rseq v)]
  384.21 +    (testing "returns the right impl"
  384.22 +      (is (= clojure.lang.APersistentVector$RSeq (class reversed))))
  384.23 +    (testing "RSeq methods"
  384.24 +      (is (= [5 4 3 2 1 0] reversed))
  384.25 +      (is (= 5 (.index reversed)))
  384.26 +      (is (= 5 (.first reversed)))
  384.27 +      (is (= [4 3 2 1 0] (.next reversed)))
  384.28 +      (is (= [3 2 1 0] (.. reversed next next)))
  384.29 +      (is (= 6 (.count reversed))))
  384.30 +    (testing "clojure calling through"
  384.31 +      (is (= 5 (first reversed)))
  384.32 +      (is (= 5 (nth reversed 0))))
  384.33 +    (testing "empty reverses to nil"
  384.34 +      (is (nil? (.. v empty rseq))))))
  384.35 +
  384.36 +(deftest test-vecseq
  384.37 +  (let [r (range 100)
  384.38 +        vs (into (vector-of :int) r)
  384.39 +        vs-1 (next vs)
  384.40 +        vs-32 (.chunkedNext (seq vs))]
  384.41 +    (testing "="
  384.42 +      (are [a b] (= a b)
  384.43 +           vs vs
  384.44 +           vs-1 vs-1
  384.45 +           vs-32 vs-32)
  384.46 +      (are [a b] (not= a b)
  384.47 +           vs vs-1
  384.48 +           vs-1 vs
  384.49 +           vs vs-32
  384.50 +           vs-32 vs))
  384.51 +    (testing "IPersistentCollection.empty"
  384.52 +      (are [a] (identical? clojure.lang.PersistentList/EMPTY (.empty (seq a)))
  384.53 +           vs vs-1 vs-32))
  384.54 +    (testing "IPersistentCollection.cons"
  384.55 +      (are [result input] (= result (.cons input :foo))
  384.56 +           [:foo 1] (seq (into (vector-of :int) [1]))))
  384.57 +    (testing "IPersistentCollection.count"
  384.58 +      (are [ct s] (= ct (.count (seq s)))
  384.59 +           100 vs
  384.60 +           99 vs-1
  384.61 +           68 vs-32)
  384.62 +      ;; can't manufacture this scenario: ASeq defers to Counted, but
  384.63 +      ;; LazySeq doesn't, so Counted never gets checked on reified seq below
  384.64 +      #_(testing "hops to counted when available"
  384.65 +        (is (= 200
  384.66 +               (.count (concat
  384.67 +                        (seq vs)
  384.68 +                        (reify clojure.lang.ISeq
  384.69 +                               (seq [this] this)
  384.70 +                               clojure.lang.Counted
  384.71 +                               (count [_] 100))))))))
  384.72 +    (testing "IPersistentCollection.equiv"
  384.73 +      (are [a b] (true? (.equiv a b))
  384.74 +           vs vs
  384.75 +           vs-1 vs-1
  384.76 +           vs-32 vs-32
  384.77 +           vs r)
  384.78 +      (are [a b] (false? (.equiv a b))
  384.79 +           vs vs-1
  384.80 +           vs-1 vs
  384.81 +           vs vs-32
  384.82 +           vs-32 vs
  384.83 +           vs nil))))
  384.84 +
  384.85 +(deftest test-vec-compare
  384.86 +  (let [nums      (range 1 100)
  384.87 +        ; randomly replaces a single item with the given value
  384.88 +        rand-replace  (fn[val]
  384.89 +                        (let [r (rand-int 99)]
  384.90 +                          (concat (take r nums) [val] (drop (inc r) nums))))
  384.91 +        ; all num sequences in map
  384.92 +        num-seqs      {:standard       nums
  384.93 +                       :empty          '()
  384.94 +                       ; different lengths
  384.95 +                       :longer         (concat nums [100])
  384.96 +                       :shorter        (drop-last nums)
  384.97 +                       ; greater by value
  384.98 +                       :first-greater  (concat [100] (next nums))
  384.99 +                       :last-greater   (concat (drop-last nums) [100])
 384.100 +                       :rand-greater-1 (rand-replace 100)
 384.101 +                       :rand-greater-2 (rand-replace 100)
 384.102 +                       :rand-greater-3 (rand-replace 100)
 384.103 +                       ; lesser by value
 384.104 +                       :first-lesser   (concat [0] (next nums))
 384.105 +                       :last-lesser    (concat (drop-last nums) [0])
 384.106 +                       :rand-lesser-1  (rand-replace 0)
 384.107 +                       :rand-lesser-2  (rand-replace 0)
 384.108 +                       :rand-lesser-3  (rand-replace 0)}
 384.109 +        ; a way to create compare values based on num-seqs
 384.110 +        create-vals   (fn[base-val]
 384.111 +                        (zipmap (keys num-seqs)
 384.112 +                                (map #(into base-val %1) (vals num-seqs))))
 384.113 +        ; Vecs made of int primitives
 384.114 +        int-vecs      (create-vals (vector-of :int))
 384.115 +        ; Vecs made of long primitives
 384.116 +        long-vecs     (create-vals (vector-of :long))
 384.117 +        ; standard boxing vectors
 384.118 +        regular-vecs  (create-vals [])
 384.119 +        ; the standard int Vec for comparisons
 384.120 +        int-vec       (:standard int-vecs)]
 384.121 +    (testing "compare"
 384.122 +      (testing "identical"
 384.123 +        (is (= 0 (compare int-vec int-vec))))
 384.124 +      (testing "equivalent"
 384.125 +        (are [x y] (= 0 (compare x y))
 384.126 +             ; standard
 384.127 +             int-vec (:standard long-vecs)
 384.128 +             (:standard long-vecs) int-vec
 384.129 +             int-vec (:standard regular-vecs)
 384.130 +             (:standard regular-vecs) int-vec
 384.131 +             ; empty
 384.132 +             (:empty int-vecs) (:empty long-vecs)
 384.133 +             (:empty long-vecs) (:empty int-vecs)))
 384.134 +      (testing "lesser"
 384.135 +        (are [x] (= -1 (compare int-vec x))
 384.136 +             (:longer int-vecs)
 384.137 +             (:longer long-vecs)
 384.138 +             (:longer regular-vecs)
 384.139 +             (:first-greater int-vecs)
 384.140 +             (:first-greater long-vecs)
 384.141 +             (:first-greater regular-vecs)
 384.142 +             (:last-greater int-vecs)
 384.143 +             (:last-greater long-vecs)
 384.144 +             (:last-greater regular-vecs)
 384.145 +             (:rand-greater-1 int-vecs)
 384.146 +             (:rand-greater-1 long-vecs)
 384.147 +             (:rand-greater-1 regular-vecs)
 384.148 +             (:rand-greater-2 int-vecs)
 384.149 +             (:rand-greater-2 long-vecs)
 384.150 +             (:rand-greater-2 regular-vecs)
 384.151 +             (:rand-greater-3 int-vecs)
 384.152 +             (:rand-greater-3 long-vecs)
 384.153 +             (:rand-greater-3 regular-vecs))
 384.154 +        (are [x] (= -1 (compare x int-vec))
 384.155 +             nil
 384.156 +             (:empty int-vecs)
 384.157 +             (:empty long-vecs)
 384.158 +             (:empty regular-vecs)
 384.159 +             (:shorter int-vecs)
 384.160 +             (:shorter long-vecs)
 384.161 +             (:shorter regular-vecs)
 384.162 +             (:first-lesser int-vecs)
 384.163 +             (:first-lesser long-vecs)
 384.164 +             (:first-lesser regular-vecs)
 384.165 +             (:last-lesser int-vecs)
 384.166 +             (:last-lesser long-vecs)
 384.167 +             (:last-lesser regular-vecs)
 384.168 +             (:rand-lesser-1 int-vecs)
 384.169 +             (:rand-lesser-1 long-vecs)
 384.170 +             (:rand-lesser-1 regular-vecs)
 384.171 +             (:rand-lesser-2 int-vecs)
 384.172 +             (:rand-lesser-2 long-vecs)
 384.173 +             (:rand-lesser-2 regular-vecs)
 384.174 +             (:rand-lesser-3 int-vecs)
 384.175 +             (:rand-lesser-3 long-vecs)
 384.176 +             (:rand-lesser-3 regular-vecs)))
 384.177 +      (testing "greater"
 384.178 +        (are [x] (= 1 (compare int-vec x))
 384.179 +             nil
 384.180 +             (:empty int-vecs)
 384.181 +             (:empty long-vecs)
 384.182 +             (:empty regular-vecs)
 384.183 +             (:shorter int-vecs)
 384.184 +             (:shorter long-vecs)
 384.185 +             (:shorter regular-vecs)
 384.186 +             (:first-lesser int-vecs)
 384.187 +             (:first-lesser long-vecs)
 384.188 +             (:first-lesser regular-vecs)
 384.189 +             (:last-lesser int-vecs)
 384.190 +             (:last-lesser long-vecs)
 384.191 +             (:last-lesser regular-vecs)
 384.192 +             (:rand-lesser-1 int-vecs)
 384.193 +             (:rand-lesser-1 long-vecs)
 384.194 +             (:rand-lesser-1 regular-vecs)
 384.195 +             (:rand-lesser-2 int-vecs)
 384.196 +             (:rand-lesser-2 long-vecs)
 384.197 +             (:rand-lesser-2 regular-vecs)
 384.198 +             (:rand-lesser-3 int-vecs)
 384.199 +             (:rand-lesser-3 long-vecs)
 384.200 +             (:rand-lesser-3 regular-vecs))
 384.201 +        (are [x] (= 1 (compare x int-vec))
 384.202 +             (:longer int-vecs)
 384.203 +             (:longer long-vecs)
 384.204 +             (:longer regular-vecs)
 384.205 +             (:first-greater int-vecs)
 384.206 +             (:first-greater long-vecs)
 384.207 +             (:first-greater regular-vecs)
 384.208 +             (:last-greater int-vecs)
 384.209 +             (:last-greater long-vecs)
 384.210 +             (:last-greater regular-vecs)
 384.211 +             (:rand-greater-1 int-vecs)
 384.212 +             (:rand-greater-1 long-vecs)
 384.213 +             (:rand-greater-1 regular-vecs)
 384.214 +             (:rand-greater-2 int-vecs)
 384.215 +             (:rand-greater-2 long-vecs)
 384.216 +             (:rand-greater-2 regular-vecs)
 384.217 +             (:rand-greater-3 int-vecs)
 384.218 +             (:rand-greater-3 long-vecs)
 384.219 +             (:rand-greater-3 regular-vecs))))
 384.220 +    (testing "Comparable.compareTo"
 384.221 +      (testing "incompatible"
 384.222 +        (is (thrown? NullPointerException (.compareTo int-vec nil)))
 384.223 +        (are [x] (thrown? ClassCastException (.compareTo int-vec x))
 384.224 +             '()
 384.225 +             {}
 384.226 +             #{}
 384.227 +             (sorted-set)
 384.228 +             (sorted-map)
 384.229 +             nums
 384.230 +             1))
 384.231 +      (testing "identical"
 384.232 +        (is (= 0 (.compareTo int-vec int-vec))))
 384.233 +      (testing "equivalent"
 384.234 +        (are [x] (= 0 (.compareTo int-vec x))
 384.235 +             (:standard long-vecs)
 384.236 +             (:standard regular-vecs)))
 384.237 +      (testing "lesser"
 384.238 +        (are [x] (= -1 (.compareTo int-vec x))
 384.239 +             (:longer int-vecs)
 384.240 +             (:longer long-vecs)
 384.241 +             (:longer regular-vecs)
 384.242 +             (:first-greater int-vecs)
 384.243 +             (:first-greater long-vecs)
 384.244 +             (:first-greater regular-vecs)
 384.245 +             (:last-greater int-vecs)
 384.246 +             (:last-greater long-vecs)
 384.247 +             (:last-greater regular-vecs)
 384.248 +             (:rand-greater-1 int-vecs)
 384.249 +             (:rand-greater-1 long-vecs)
 384.250 +             (:rand-greater-1 regular-vecs)
 384.251 +             (:rand-greater-2 int-vecs)
 384.252 +             (:rand-greater-2 long-vecs)
 384.253 +             (:rand-greater-2 regular-vecs)
 384.254 +             (:rand-greater-3 int-vecs)
 384.255 +             (:rand-greater-3 long-vecs)
 384.256 +             (:rand-greater-3 regular-vecs)))
 384.257 +      (testing "greater"
 384.258 +        (are [x] (= 1 (.compareTo int-vec x))
 384.259 +             (:empty int-vecs)
 384.260 +             (:empty long-vecs)
 384.261 +             (:empty regular-vecs)
 384.262 +             (:shorter int-vecs)
 384.263 +             (:shorter long-vecs)
 384.264 +             (:shorter regular-vecs)
 384.265 +             (:first-lesser int-vecs)
 384.266 +             (:first-lesser long-vecs)
 384.267 +             (:first-lesser regular-vecs)
 384.268 +             (:last-lesser int-vecs)
 384.269 +             (:last-lesser long-vecs)
 384.270 +             (:last-lesser regular-vecs)
 384.271 +             (:rand-lesser-1 int-vecs)
 384.272 +             (:rand-lesser-1 long-vecs)
 384.273 +             (:rand-lesser-1 regular-vecs)
 384.274 +             (:rand-lesser-2 int-vecs)
 384.275 +             (:rand-lesser-2 long-vecs)
 384.276 +             (:rand-lesser-2 regular-vecs)
 384.277 +             (:rand-lesser-3 int-vecs)
 384.278 +             (:rand-lesser-3 long-vecs)
 384.279 +             (:rand-lesser-3 regular-vecs))))))
 384.280 +
 384.281 +(deftest test-vec-associative
 384.282 +  (let [empty-v (vector-of :long)
 384.283 +        v       (into empty-v (range 1 6))]
 384.284 +    (testing "Associative.containsKey"
 384.285 +      (are [x] (.containsKey v x)
 384.286 +           0 1 2 3 4)
 384.287 +      (are [x] (not (.containsKey v x))
 384.288 +           -1 -100 nil [] "" #"" #{} 5 100)
 384.289 +      (are [x] (not (.containsKey empty-v x))
 384.290 +           0 1))
 384.291 +    (testing "contains?"
 384.292 +      (are [x] (contains? v x)
 384.293 +           0 2 4)
 384.294 +      (are [x] (not (contains? v x))
 384.295 +           -1 -100 nil "" 5 100)
 384.296 +      (are [x] (not (contains? empty-v x))
 384.297 +           0 1))
 384.298 +    (testing "Associative.entryAt"
 384.299 +      (are [idx val] (= (clojure.lang.MapEntry. idx val)
 384.300 +                        (.entryAt v idx))
 384.301 +           0 1
 384.302 +           2 3
 384.303 +           4 5)
 384.304 +      (are [idx] (nil? (.entryAt v idx))
 384.305 +           -5 -1 5 10 nil "")
 384.306 +      (are [idx] (nil? (.entryAt empty-v idx))
 384.307 +           0 1))))
   385.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   385.2 +++ b/src/clojure/walk.clj	Sat Aug 21 06:25:44 2010 -0400
   385.3 @@ -0,0 +1,132 @@
   385.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   385.5 +;   The use and distribution terms for this software are covered by the
   385.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   385.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   385.8 +;   By using this software in any fashion, you are agreeing to be bound by
   385.9 +;   the terms of this license.
  385.10 +;   You must not remove this notice, or any other, from this software.
  385.11 +
  385.12 +;;; walk.clj - generic tree walker with replacement
  385.13 +
  385.14 +;; by Stuart Sierra
  385.15 +;; December 15, 2008
  385.16 +
  385.17 +;; CHANGE LOG:
  385.18 +;;
  385.19 +;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk'
  385.20 +;;
  385.21 +;; * December 9, 2008: first version
  385.22 +
  385.23 +
  385.24 +(ns 
  385.25 +  ^{:author "Stuart Sierra",
  385.26 +     :doc "This file defines a generic tree walker for Clojure data
  385.27 +structures.  It takes any data structure (list, vector, map, set,
  385.28 +seq), calls a function on every element, and uses the return value
  385.29 +of the function in place of the original.  This makes it fairly
  385.30 +easy to write recursive search-and-replace functions, as shown in
  385.31 +the examples.
  385.32 +
  385.33 +Note: \"walk\" supports all Clojure data structures EXCEPT maps
  385.34 +created with sorted-map-by.  There is no (obvious) way to retrieve
  385.35 +the sorting function."}
  385.36 +  clojure.walk)
  385.37 +
  385.38 +(defn walk
  385.39 +  "Traverses form, an arbitrary data structure.  inner and outer are
  385.40 +  functions.  Applies inner to each element of form, building up a
  385.41 +  data structure of the same type, then applies outer to the result.
  385.42 +  Recognizes all Clojure data structures except sorted-map-by.
  385.43 +  Consumes seqs as with doall."
  385.44 +  {:added "1.1"}
  385.45 +  [inner outer form]
  385.46 +  (cond
  385.47 +   (list? form) (outer (apply list (map inner form)))
  385.48 +   (seq? form) (outer (doall (map inner form)))
  385.49 +   (vector? form) (outer (vec (map inner form)))
  385.50 +   (map? form) (outer (into (if (sorted? form) (sorted-map) {})
  385.51 +                            (map inner form)))
  385.52 +   (set? form) (outer (into (if (sorted? form) (sorted-set) #{})
  385.53 +                            (map inner form)))
  385.54 +   :else (outer form)))
  385.55 +
  385.56 +(defn postwalk
  385.57 +  "Performs a depth-first, post-order traversal of form.  Calls f on
  385.58 +  each sub-form, uses f's return value in place of the original.
  385.59 +  Recognizes all Clojure data structures except sorted-map-by.
  385.60 +  Consumes seqs as with doall."
  385.61 +  {:added "1.1"}
  385.62 +  [f form]
  385.63 +  (walk (partial postwalk f) f form))
  385.64 +
  385.65 +(defn prewalk
  385.66 +  "Like postwalk, but does pre-order traversal."
  385.67 +  {:added "1.1"}
  385.68 +  [f form]
  385.69 +  (walk (partial prewalk f) identity (f form)))
  385.70 +
  385.71 +
  385.72 +;; Note: I wanted to write:
  385.73 +;;
  385.74 +;; (defn walk
  385.75 +;;   [f form]
  385.76 +;;   (let [pf (partial walk f)]
  385.77 +;;     (if (coll? form)
  385.78 +;;       (f (into (empty form) (map pf form)))
  385.79 +;;       (f form))))
  385.80 +;;
  385.81 +;; but this throws a ClassCastException when applied to a map.
  385.82 +
  385.83 +
  385.84 +(defn postwalk-demo
  385.85 +  "Demonstrates the behavior of postwalk by printing each form as it is
  385.86 +  walked.  Returns form."
  385.87 +  {:added "1.1"}
  385.88 +  [form]
  385.89 +  (postwalk (fn [x] (print "Walked: ") (prn x) x) form))
  385.90 +
  385.91 +(defn prewalk-demo
  385.92 +  "Demonstrates the behavior of prewalk by printing each form as it is
  385.93 +  walked.  Returns form."
  385.94 +  {:added "1.1"}
  385.95 +  [form]
  385.96 +  (prewalk (fn [x] (print "Walked: ") (prn x) x) form))
  385.97 +
  385.98 +(defn keywordize-keys
  385.99 +  "Recursively transforms all map keys from strings to keywords."
 385.100 +  {:added "1.1"}
 385.101 +  [m]
 385.102 +  (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))]
 385.103 +    ;; only apply to maps
 385.104 +    (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))
 385.105 +
 385.106 +(defn stringify-keys
 385.107 +  "Recursively transforms all map keys from keywords to strings."
 385.108 +  {:added "1.1"}
 385.109 +  [m]
 385.110 +  (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))]
 385.111 +    ;; only apply to maps
 385.112 +    (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))
 385.113 +
 385.114 +(defn prewalk-replace
 385.115 +  "Recursively transforms form by replacing keys in smap with their
 385.116 +  values.  Like clojure/replace but works on any data structure.  Does
 385.117 +  replacement at the root of the tree first."
 385.118 +  {:added "1.1"}
 385.119 +  [smap form]
 385.120 +  (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form))
 385.121 +
 385.122 +(defn postwalk-replace
 385.123 +  "Recursively transforms form by replacing keys in smap with their
 385.124 +  values.  Like clojure/replace but works on any data structure.  Does
 385.125 +  replacement at the leaves of the tree first."
 385.126 +  {:added "1.1"}
 385.127 +  [smap form]
 385.128 +  (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form))
 385.129 +
 385.130 +(defn macroexpand-all
 385.131 +  "Recursively performs all possible macroexpansions in form."
 385.132 +  {:added "1.1"}
 385.133 +  [form]
 385.134 +  (prewalk (fn [x] (if (seq? x) (macroexpand x) x)) form))
 385.135 +
   386.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   386.2 +++ b/src/clojure/xml.clj	Sat Aug 21 06:25:44 2010 -0400
   386.3 @@ -0,0 +1,118 @@
   386.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   386.5 +;   The use and distribution terms for this software are covered by the
   386.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   386.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   386.8 +;   By using this software in any fashion, you are agreeing to be bound by
   386.9 +;   the terms of this license.
  386.10 +;   You must not remove this notice, or any other, from this software.
  386.11 +
  386.12 +(ns ^{:doc "XML reading/writing."
  386.13 +       :author "Rich Hickey"}
  386.14 +  clojure.xml
  386.15 +  (:import (org.xml.sax ContentHandler Attributes SAXException)
  386.16 +           (javax.xml.parsers SAXParser SAXParserFactory)))
  386.17 +
  386.18 +(def *stack*)
  386.19 +(def *current*)
  386.20 +(def *state*) ; :element :chars :between
  386.21 +(def *sb*)
  386.22 +
  386.23 +(defstruct element :tag :attrs :content)
  386.24 +
  386.25 +(def tag (accessor element :tag))
  386.26 +(def attrs (accessor element :attrs))
  386.27 +(def content (accessor element :content))
  386.28 +
  386.29 +(def content-handler
  386.30 +  (let [push-content (fn [e c]
  386.31 +                       (assoc e :content (conj (or (:content e) []) c)))
  386.32 +        push-chars (fn []
  386.33 +                     (when (and (= *state* :chars)
  386.34 +                                (some (complement #(Character/isWhitespace (char %))) (str *sb*)))
  386.35 +                       (set! *current* (push-content *current* (str *sb*)))))]
  386.36 +    (new clojure.lang.XMLHandler
  386.37 +         (proxy [ContentHandler] []
  386.38 +           (startElement [uri local-name q-name ^Attributes atts]
  386.39 +             (let [attrs (fn [ret i]
  386.40 +                           (if (neg? i)
  386.41 +                             ret
  386.42 +                             (recur (assoc ret
  386.43 +                                           (clojure.lang.Keyword/intern (symbol (.getQName atts i)))
  386.44 +                                           (.getValue atts (int i)))
  386.45 +                                    (dec i))))
  386.46 +                   e (struct element
  386.47 +                             (. clojure.lang.Keyword (intern (symbol q-name)))
  386.48 +                             (when (pos? (.getLength atts))
  386.49 +                               (attrs {} (dec (.getLength atts)))))]
  386.50 +               (push-chars)
  386.51 +               (set! *stack* (conj *stack* *current*))
  386.52 +               (set! *current* e)
  386.53 +               (set! *state* :element))
  386.54 +             nil)
  386.55 +           (endElement [uri local-name q-name]
  386.56 +             (push-chars)
  386.57 +             (set! *current* (push-content (peek *stack*) *current*))
  386.58 +             (set! *stack* (pop *stack*))
  386.59 +             (set! *state* :between)
  386.60 +             nil)
  386.61 +           (characters [^chars ch start length]
  386.62 +             (when-not (= *state* :chars)
  386.63 +               (set! *sb* (new StringBuilder)))
  386.64 +             (let [^StringBuilder sb *sb*]
  386.65 +               (.append sb ch (int start) (int length))
  386.66 +               (set! *state* :chars))
  386.67 +             nil)
  386.68 +           (setDocumentLocator [locator])
  386.69 +           (startDocument [])
  386.70 +           (endDocument [])
  386.71 +           (startPrefixMapping [prefix uri])
  386.72 +           (endPrefixMapping [prefix])
  386.73 +           (ignorableWhitespace [ch start length])
  386.74 +           (processingInstruction [target data])
  386.75 +           (skippedEntity [name])
  386.76 +           ))))
  386.77 +
  386.78 +(defn startparse-sax [s ch]
  386.79 +  (.. SAXParserFactory (newInstance) (newSAXParser) (parse s ch)))
  386.80 +
  386.81 +(defn parse
  386.82 +  "Parses and loads the source s, which can be a File, InputStream or
  386.83 +  String naming a URI. Returns a tree of the xml/element struct-map,
  386.84 +  which has the keys :tag, :attrs, and :content. and accessor fns tag,
  386.85 +  attrs, and content. Other parsers can be supplied by passing
  386.86 +  startparse, a fn taking a source and a ContentHandler and returning
  386.87 +  a parser"
  386.88 +  {:added "1.0"}
  386.89 +  ([s] (parse s startparse-sax))
  386.90 +  ([s startparse]
  386.91 +    (binding [*stack* nil
  386.92 +              *current* (struct element)
  386.93 +              *state* :between
  386.94 +              *sb* nil]
  386.95 +      (startparse s content-handler)
  386.96 +      ((:content *current*) 0)))) 
  386.97 +
  386.98 +(defn emit-element [e]
  386.99 +  (if (instance? String e)
 386.100 +    (println e)
 386.101 +    (do
 386.102 +      (print (str "<" (name (:tag e))))
 386.103 +      (when (:attrs e)
 386.104 +	(doseq [attr (:attrs e)]
 386.105 +	  (print (str " " (name (key attr)) "='" (val attr)"'"))))
 386.106 +      (if (:content e)
 386.107 +	(do
 386.108 +	  (println ">")
 386.109 +	  (doseq [c (:content e)]
 386.110 +	    (emit-element c))
 386.111 +	  (println (str "</" (name (:tag e)) ">")))
 386.112 +	(println "/>")))))
 386.113 +
 386.114 +(defn emit [x]
 386.115 +  (println "<?xml version='1.0' encoding='UTF-8'?>")
 386.116 +  (emit-element x))
 386.117 +
 386.118 +;(export '(tag attrs content parse element emit emit-element))
 386.119 +
 386.120 +;(load-file "/Users/rich/dev/clojure/src/xml.clj")
 386.121 +;(def x (xml/parse "http://arstechnica.com/journals.rssx"))
   387.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   387.2 +++ b/src/clojure/zip.clj	Sat Aug 21 06:25:44 2010 -0400
   387.3 @@ -0,0 +1,318 @@
   387.4 +;   Copyright (c) Rich Hickey. All rights reserved.
   387.5 +;   The use and distribution terms for this software are covered by the
   387.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   387.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
   387.8 +;   By using this software in any fashion, you are agreeing to be bound by
   387.9 +;   the terms of this license.
  387.10 +;   You must not remove this notice, or any other, from this software.
  387.11 +
  387.12 +;functional hierarchical zipper, with navigation, editing and enumeration
  387.13 +;see Huet
  387.14 +
  387.15 +(ns ^{:doc "Functional hierarchical zipper, with navigation, editing,
  387.16 +  and enumeration.  See Huet"
  387.17 +       :author "Rich Hickey"}
  387.18 +  clojure.zip
  387.19 +  (:refer-clojure :exclude (replace remove next)))
  387.20 +
  387.21 +(defn zipper
  387.22 +  "Creates a new zipper structure. 
  387.23 +
  387.24 +  branch? is a fn that, given a node, returns true if can have
  387.25 +  children, even if it currently doesn't.
  387.26 +
  387.27 +  children is a fn that, given a branch node, returns a seq of its
  387.28 +  children.
  387.29 +
  387.30 +  make-node is a fn that, given an existing node and a seq of
  387.31 +  children, returns a new branch node with the supplied children.
  387.32 +  root is the root node."
  387.33 +  {:added "1.0"}
  387.34 +  [branch? children make-node root]
  387.35 +    ^{:zip/branch? branch? :zip/children children :zip/make-node make-node}
  387.36 +    [root nil])
  387.37 +
  387.38 +(defn seq-zip
  387.39 +  "Returns a zipper for nested sequences, given a root sequence"
  387.40 +  {:added "1.0"}
  387.41 +  [root]
  387.42 +    (zipper seq?
  387.43 +            identity
  387.44 +            (fn [node children] (with-meta children (meta node)))
  387.45 +            root))
  387.46 +
  387.47 +(defn vector-zip
  387.48 +  "Returns a zipper for nested vectors, given a root vector"
  387.49 +  {:added "1.0"}
  387.50 +  [root]
  387.51 +    (zipper vector?
  387.52 +            seq
  387.53 +            (fn [node children] (with-meta (vec children) (meta node)))
  387.54 +            root))
  387.55 +
  387.56 +(defn xml-zip
  387.57 +  "Returns a zipper for xml elements (as from xml/parse),
  387.58 +  given a root element"
  387.59 +  {:added "1.0"}
  387.60 +  [root]
  387.61 +    (zipper (complement string?) 
  387.62 +            (comp seq :content)
  387.63 +            (fn [node children]
  387.64 +              (assoc node :content (and children (apply vector children))))
  387.65 +            root))
  387.66 +
  387.67 +(defn node
  387.68 +  "Returns the node at loc"
  387.69 +  {:added "1.0"}
  387.70 +  [loc] (loc 0))
  387.71 +
  387.72 +(defn branch?
  387.73 +  "Returns true if the node at loc is a branch"
  387.74 +  {:added "1.0"}
  387.75 +  [loc]
  387.76 +    ((:zip/branch? (meta loc)) (node loc)))
  387.77 +
  387.78 +(defn children
  387.79 +  "Returns a seq of the children of node at loc, which must be a branch"
  387.80 +  {:added "1.0"}
  387.81 +  [loc]
  387.82 +    (if (branch? loc)
  387.83 +      ((:zip/children (meta loc)) (node loc))
  387.84 +      (throw (Exception. "called children on a leaf node"))))
  387.85 +
  387.86 +(defn make-node
  387.87 +  "Returns a new branch node, given an existing node and new
  387.88 +  children. The loc is only used to supply the constructor."
  387.89 +  {:added "1.0"}
  387.90 +  [loc node children]
  387.91 +    ((:zip/make-node (meta loc)) node children))
  387.92 +
  387.93 +(defn path
  387.94 +  "Returns a seq of nodes leading to this loc"
  387.95 +  {:added "1.0"}
  387.96 +  [loc]
  387.97 +    (:pnodes (loc 1)))
  387.98 +
  387.99 +(defn lefts
 387.100 +  "Returns a seq of the left siblings of this loc"
 387.101 +  {:added "1.0"}
 387.102 +  [loc]
 387.103 +    (seq (:l (loc 1))))
 387.104 +
 387.105 +(defn rights
 387.106 +  "Returns a seq of the right siblings of this loc"
 387.107 +  {:added "1.0"}
 387.108 +  [loc]
 387.109 +    (:r (loc 1)))
 387.110 +
 387.111 +
 387.112 +(defn down
 387.113 +  "Returns the loc of the leftmost child of the node at this loc, or
 387.114 +  nil if no children"
 387.115 +  {:added "1.0"}
 387.116 +  [loc]
 387.117 +    (when (branch? loc)
 387.118 +      (let [[node path] loc
 387.119 +            [c & cnext :as cs] (children loc)]
 387.120 +        (when cs
 387.121 +          (with-meta [c {:l [] 
 387.122 +                         :pnodes (if path (conj (:pnodes path) node) [node]) 
 387.123 +                         :ppath path 
 387.124 +                         :r cnext}] (meta loc))))))
 387.125 +
 387.126 +(defn up
 387.127 +  "Returns the loc of the parent of the node at this loc, or nil if at
 387.128 +  the top"
 387.129 +  {:added "1.0"}
 387.130 +  [loc]
 387.131 +    (let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc]
 387.132 +      (when pnodes
 387.133 +        (let [pnode (peek pnodes)]
 387.134 +          (with-meta (if changed?
 387.135 +                       [(make-node loc pnode (concat l (cons node r))) 
 387.136 +                        (and ppath (assoc ppath :changed? true))]
 387.137 +                       [pnode ppath])
 387.138 +                     (meta loc))))))
 387.139 +
 387.140 +(defn root
 387.141 +  "zips all the way up and returns the root node, reflecting any
 387.142 + changes."
 387.143 +  {:added "1.0"}
 387.144 +  [loc]
 387.145 +    (if (= :end (loc 1))
 387.146 +      (node loc)
 387.147 +      (let [p (up loc)]
 387.148 +        (if p
 387.149 +          (recur p)
 387.150 +          (node loc)))))
 387.151 +
 387.152 +(defn right
 387.153 +  "Returns the loc of the right sibling of the node at this loc, or nil"
 387.154 +  {:added "1.0"}
 387.155 +  [loc]
 387.156 +    (let [[node {l :l  [r & rnext :as rs] :r :as path}] loc]
 387.157 +      (when (and path rs)
 387.158 +        (with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc)))))
 387.159 +
 387.160 +(defn rightmost
 387.161 +  "Returns the loc of the rightmost sibling of the node at this loc, or self"
 387.162 +  {:added "1.0"}
 387.163 +  [loc]
 387.164 +    (let [[node {l :l r :r :as path}] loc]
 387.165 +      (if (and path r)
 387.166 +        (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc))
 387.167 +        loc)))
 387.168 +
 387.169 +(defn left
 387.170 +  "Returns the loc of the left sibling of the node at this loc, or nil"
 387.171 +  {:added "1.0"}
 387.172 +  [loc]
 387.173 +    (let [[node {l :l r :r :as path}] loc]
 387.174 +      (when (and path (seq l))
 387.175 +        (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc)))))
 387.176 +
 387.177 +(defn leftmost
 387.178 +  "Returns the loc of the leftmost sibling of the node at this loc, or self"
 387.179 +  {:added "1.0"}
 387.180 +  [loc]
 387.181 +    (let [[node {l :l r :r :as path}] loc]
 387.182 +      (if (and path (seq l))
 387.183 +        (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc))
 387.184 +        loc)))
 387.185 +
 387.186 +(defn insert-left
 387.187 +  "Inserts the item as the left sibling of the node at this loc,
 387.188 + without moving"
 387.189 +  {:added "1.0"}
 387.190 +  [loc item]
 387.191 +    (let [[node {l :l :as path}] loc]
 387.192 +      (if (nil? path)
 387.193 +        (throw (new Exception "Insert at top"))
 387.194 +        (with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc)))))
 387.195 +
 387.196 +(defn insert-right
 387.197 +  "Inserts the item as the right sibling of the node at this loc,
 387.198 +  without moving"
 387.199 +  {:added "1.0"}
 387.200 +  [loc item]
 387.201 +    (let [[node {r :r :as path}] loc]
 387.202 +      (if (nil? path)
 387.203 +        (throw (new Exception "Insert at top"))
 387.204 +        (with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc)))))
 387.205 +
 387.206 +(defn replace
 387.207 +  "Replaces the node at this loc, without moving"
 387.208 +  {:added "1.0"}
 387.209 +  [loc node]
 387.210 +    (let [[_ path] loc]
 387.211 +      (with-meta [node (assoc path :changed? true)] (meta loc))))
 387.212 +
 387.213 +(defn edit
 387.214 +  "Replaces the node at this loc with the value of (f node args)"
 387.215 +  {:added "1.0"}
 387.216 +  [loc f & args]
 387.217 +    (replace loc (apply f (node loc) args)))
 387.218 +
 387.219 +(defn insert-child
 387.220 +  "Inserts the item as the leftmost child of the node at this loc,
 387.221 +  without moving"
 387.222 +  {:added "1.0"}
 387.223 +  [loc item]
 387.224 +    (replace loc (make-node loc (node loc) (cons item (children loc)))))
 387.225 +
 387.226 +(defn append-child
 387.227 +  "Inserts the item as the rightmost child of the node at this loc,
 387.228 +  without moving"
 387.229 +  {:added "1.0"}
 387.230 +  [loc item]
 387.231 +    (replace loc (make-node loc (node loc) (concat (children loc) [item]))))
 387.232 +
 387.233 +(defn next
 387.234 +  "Moves to the next loc in the hierarchy, depth-first. When reaching
 387.235 +  the end, returns a distinguished loc detectable via end?. If already
 387.236 +  at the end, stays there."
 387.237 +  {:added "1.0"}
 387.238 +  [loc]
 387.239 +    (if (= :end (loc 1))
 387.240 +      loc
 387.241 +      (or 
 387.242 +       (and (branch? loc) (down loc))
 387.243 +       (right loc)
 387.244 +       (loop [p loc]
 387.245 +         (if (up p)
 387.246 +           (or (right (up p)) (recur (up p)))
 387.247 +           [(node p) :end])))))
 387.248 +
 387.249 +(defn prev
 387.250 +  "Moves to the previous loc in the hierarchy, depth-first. If already
 387.251 +  at the root, returns nil."
 387.252 +  {:added "1.0"}
 387.253 +  [loc]
 387.254 +    (if-let [lloc (left loc)]
 387.255 +      (loop [loc lloc]
 387.256 +        (if-let [child (and (branch? loc) (down loc))]
 387.257 +          (recur (rightmost child))
 387.258 +          loc))
 387.259 +      (up loc)))
 387.260 +
 387.261 +(defn end?
 387.262 +  "Returns true if loc represents the end of a depth-first walk"
 387.263 +  {:added "1.0"}
 387.264 +  [loc]
 387.265 +    (= :end (loc 1)))
 387.266 +
 387.267 +(defn remove
 387.268 +  "Removes the node at loc, returning the loc that would have preceded
 387.269 +  it in a depth-first walk."
 387.270 +  {:added "1.0"}
 387.271 +  [loc]
 387.272 +    (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc]
 387.273 +      (if (nil? path)
 387.274 +        (throw (new Exception "Remove at top"))
 387.275 +        (if (pos? (count l))
 387.276 +          (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))]
 387.277 +            (if-let [child (and (branch? loc) (down loc))]
 387.278 +              (recur (rightmost child))
 387.279 +              loc))
 387.280 +          (with-meta [(make-node loc (peek pnodes) rs) 
 387.281 +                      (and ppath (assoc ppath :changed? true))]
 387.282 +                     (meta loc))))))
 387.283 +  
 387.284 +(comment
 387.285 +
 387.286 +(load-file "/Users/rich/dev/clojure/src/zip.clj")
 387.287 +(refer 'zip)
 387.288 +(def data '[[a * b] + [c * d]])
 387.289 +(def dz (vector-zip data))
 387.290 +
 387.291 +(right (down (right (right (down dz)))))
 387.292 +(lefts (right (down (right (right (down dz))))))
 387.293 +(rights (right (down (right (right (down dz))))))
 387.294 +(up (up (right (down (right (right (down dz)))))))
 387.295 +(path (right (down (right (right (down dz))))))
 387.296 +
 387.297 +(-> dz down right right down right)
 387.298 +(-> dz down right right down right (replace '/) root)
 387.299 +(-> dz next next (edit str) next next next (replace '/) root)
 387.300 +(-> dz next next next next next next next next next remove root)
 387.301 +(-> dz next next next next next next next next next remove (insert-right 'e) root)
 387.302 +(-> dz next next next next next next next next next remove up (append-child 'e) root)
 387.303 +
 387.304 +(end? (-> dz next next next next next next next next next remove next))
 387.305 +
 387.306 +(-> dz next remove next remove root)
 387.307 +
 387.308 +(loop [loc dz]
 387.309 +  (if (end? loc)
 387.310 +    (root loc)
 387.311 +    (recur (next (if (= '* (node loc)) 
 387.312 +                   (replace loc '/)
 387.313 +                   loc)))))
 387.314 +
 387.315 +(loop [loc dz]
 387.316 +  (if (end? loc)
 387.317 +    (root loc)
 387.318 +    (recur (next (if (= '* (node loc)) 
 387.319 +                   (remove loc)
 387.320 +                   loc)))))
 387.321 +)
   388.1 --- a/swank-laser	Sat Aug 21 06:10:24 2010 -0400
   388.2 +++ b/swank-laser	Sat Aug 21 06:25:44 2010 -0400
   388.3 @@ -1,4 +1,4 @@
   388.4 -":";exec java -verbose:gc -Xmn100M -Xms1500M -Xmx1500M -cp $HOME/roBin/src:$HOME/lasercutter/src:$HOME/lasercutter/lib/* clojure.main $0 $*;
   388.5 +":";exec java -verbose:gc -Xmn100M -Xms1500M -Xmx1500M -cp $HOME/lasercutter/lib/*:$HOME/roBin/src:$HOME/lasercutter/src clojure.main $0 $*;
   388.6  
   388.7  (do 
   388.8    (require 'swank.swank)