Mercurial > lasercutter
changeset 10:ef7dbbd6452c
added clojure source goodness
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("Hello world!"); 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, "Example", null, "java/lang/Object", null); 25.62 + * <p/> 25.63 + * Method m = Method.getMethod("void <init> ()"); 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("void main (String[])"); 25.71 + * mg = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC, m, null, null, cw); 25.72 + * mg.getStatic(Type.getType(System.class), "out", Type.getType(PrintStream.class)); 25.73 + * mg.push("Hello world!"); 25.74 + * mg.invokeVirtual(Type.getType(PrintStream.class), Method.getMethod("void println (String)")); 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, <clinit>, 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, <init>, 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] >>> 24) & 0xFF) | 28.105 + * ((sha[0] >>> 16) & 0xFF) << 8 | 28.106 + * ((sha[0] >>> 8) & 0xFF) << 16 | 28.107 + * ((sha[0] >>> 0) & 0xFF) << 24 | 28.108 + * ((sha[1] >>> 24) & 0xFF) << 32 | 28.109 + * ((sha[1] >>> 16) & 0xFF) << 40 | 28.110 + * ((sha[1] >>> 8) & 0xFF) << 48 | 28.111 + * ((sha[1] >>> 0) & 0xFF) << 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 {\< "<" 114.50 + \> ">" 114.51 + \& "&" 114.52 + \' "'" 114.53 + \" """} 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 & 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 {\< "<" 152.88 + \> ">" 152.89 + \& "&" 152.90 + \' "'" 152.91 + \" """} 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 & 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\": \"" \\u0022 %22 0x22 034 "\", 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&bar\">foo<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 (= "<foo&bar>" 183.15 + (s/escape {\& "&" \< "<" \> ">"} "<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 (= "<foo&bar>" 379.105 + (s/escape "<foo&bar>" {\& "&" \< "<" \> ">"}))) 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)