Repository: galdolber/clojure-objc Branch: master Commit: a56dca4ea382 Files: 349 Total size: 3.3 MB Directory structure: gitextract_r576sy1c/ ├── .gitignore ├── CONTRIBUTING.md ├── KNOWN_ISSUES ├── antsetup.sh ├── build.clj ├── build.xml ├── changes.md ├── clojure.iml ├── doc/ │ └── clojure/ │ └── pprint/ │ ├── CommonLispFormat.markdown │ └── PrettyPrinting.markdown ├── epl-v10.html ├── pom.xml ├── readme.md ├── release.sh ├── src/ │ ├── assembly/ │ │ ├── distribution.xml │ │ └── slim.xml │ ├── clj/ │ │ └── clojure/ │ │ ├── core/ │ │ │ ├── protocols.clj │ │ │ └── reducers.clj │ │ ├── core.clj │ │ ├── core_deftype.clj │ │ ├── core_objc.clj │ │ ├── core_print.clj │ │ ├── core_proxy.clj │ │ ├── data.clj │ │ ├── edn.clj │ │ ├── genclass.clj │ │ ├── gvec.clj │ │ ├── inspector.clj │ │ ├── instant.clj │ │ ├── java/ │ │ │ ├── browse.clj │ │ │ ├── browse_ui.clj │ │ │ ├── io.clj │ │ │ ├── javadoc.clj │ │ │ └── shell.clj │ │ ├── main.clj │ │ ├── parallel.clj │ │ ├── pprint/ │ │ │ ├── cl_format.clj │ │ │ ├── column_writer.clj │ │ │ ├── dispatch.clj │ │ │ ├── pprint_base.clj │ │ │ ├── pretty_writer.clj │ │ │ ├── print_table.clj │ │ │ └── utilities.clj │ │ ├── pprint.clj │ │ ├── reflect/ │ │ │ └── java.clj │ │ ├── reflect.clj │ │ ├── remoterepl.clj │ │ ├── repl.clj │ │ ├── set.clj │ │ ├── stacktrace.clj │ │ ├── string.clj │ │ ├── template.clj │ │ ├── test/ │ │ │ ├── junit.clj │ │ │ └── tap.clj │ │ ├── test.clj │ │ ├── uuid.clj │ │ ├── walk.clj │ │ ├── xml.clj │ │ └── zip.clj │ ├── ffi/ │ │ ├── ffi.h │ │ ├── ffi_arm64.h │ │ ├── ffi_armv7.h │ │ ├── ffi_common.h │ │ ├── ffi_i386.h │ │ ├── ffi_x86_64.h │ │ ├── fficonfig.h │ │ ├── fficonfig_arm64.h │ │ ├── fficonfig_armv7.h │ │ ├── fficonfig_i386.h │ │ ├── fficonfig_x86_64.h │ │ ├── ffitarget.h │ │ ├── ffitarget_arm64.h │ │ ├── ffitarget_armv7.h │ │ ├── ffitarget_i386.h │ │ ├── ffitarget_x86_64.h │ │ └── libffi.a │ ├── jvm/ │ │ ├── clojure/ │ │ │ ├── asm/ │ │ │ │ ├── AnnotationVisitor.java │ │ │ │ ├── AnnotationWriter.java │ │ │ │ ├── Attribute.java │ │ │ │ ├── ByteVector.java │ │ │ │ ├── ClassReader.java │ │ │ │ ├── ClassVisitor.java │ │ │ │ ├── ClassWriter.java │ │ │ │ ├── Context.java │ │ │ │ ├── Edge.java │ │ │ │ ├── FieldVisitor.java │ │ │ │ ├── FieldWriter.java │ │ │ │ ├── Frame.java │ │ │ │ ├── Handle.java │ │ │ │ ├── Handler.java │ │ │ │ ├── Item.java │ │ │ │ ├── Label.java │ │ │ │ ├── MethodVisitor.java │ │ │ │ ├── MethodWriter.java │ │ │ │ ├── Opcodes.java │ │ │ │ ├── Type.java │ │ │ │ ├── commons/ │ │ │ │ │ ├── AdviceAdapter.java │ │ │ │ │ ├── AnalyzerAdapter.java │ │ │ │ │ ├── CodeSizeEvaluator.java │ │ │ │ │ ├── GeneratorAdapter.java │ │ │ │ │ ├── InstructionAdapter.java │ │ │ │ │ ├── LocalVariablesSorter.java │ │ │ │ │ ├── Method.java │ │ │ │ │ ├── SerialVersionUIDAdder.java │ │ │ │ │ ├── StaticInitMerger.java │ │ │ │ │ ├── TableSwitchGenerator.java │ │ │ │ │ └── package.html │ │ │ │ └── package.html │ │ │ ├── java/ │ │ │ │ └── api/ │ │ │ │ ├── Clojure.java │ │ │ │ └── package.html │ │ │ ├── lang/ │ │ │ │ ├── AFn.java │ │ │ │ ├── AFunction.java │ │ │ │ ├── AMapEntry.java │ │ │ │ ├── APersistentMap.java │ │ │ │ ├── APersistentSet.java │ │ │ │ ├── APersistentVector.java │ │ │ │ ├── ARef.java │ │ │ │ ├── AReference.java │ │ │ │ ├── ASeq.java │ │ │ │ ├── ATransientMap.java │ │ │ │ ├── ATransientSet.java │ │ │ │ ├── Agent.java │ │ │ │ ├── ArityException.java │ │ │ │ ├── ArrayChunk.java │ │ │ │ ├── ArrayIter.java │ │ │ │ ├── ArraySeq.java │ │ │ │ ├── Associative.java │ │ │ │ ├── Atom.java │ │ │ │ ├── BigInt.java │ │ │ │ ├── Binding.java │ │ │ │ ├── Box.java │ │ │ │ ├── ChunkBuffer.java │ │ │ │ ├── ChunkedCons.java │ │ │ │ ├── Compile.java │ │ │ │ ├── Compiler.java │ │ │ │ ├── Cons.java │ │ │ │ ├── Counted.java │ │ │ │ ├── Cycle.java │ │ │ │ ├── Delay.java │ │ │ │ ├── DynamicClassLoader.java │ │ │ │ ├── EdnReader.java │ │ │ │ ├── EnumerationSeq.java │ │ │ │ ├── ExceptionInfo.java │ │ │ │ ├── Fn.java │ │ │ │ ├── FnLoaderThunk.java │ │ │ │ ├── IAtom.java │ │ │ │ ├── IBlockingDeref.java │ │ │ │ ├── IChunk.java │ │ │ │ ├── IChunkedSeq.java │ │ │ │ ├── IDeref.java │ │ │ │ ├── IEditableCollection.java │ │ │ │ ├── IExceptionInfo.java │ │ │ │ ├── IFn.java │ │ │ │ ├── IHashEq.java │ │ │ │ ├── IKeywordLookup.java │ │ │ │ ├── ILookup.java │ │ │ │ ├── ILookupSite.java │ │ │ │ ├── ILookupThunk.java │ │ │ │ ├── IMapEntry.java │ │ │ │ ├── IMapIterable.java │ │ │ │ ├── IMeta.java │ │ │ │ ├── IObj.java │ │ │ │ ├── IPending.java │ │ │ │ ├── IPersistentCollection.java │ │ │ │ ├── IPersistentList.java │ │ │ │ ├── IPersistentMap.java │ │ │ │ ├── IPersistentSet.java │ │ │ │ ├── IPersistentStack.java │ │ │ │ ├── IPersistentVector.java │ │ │ │ ├── IProxy.java │ │ │ │ ├── IRecord.java │ │ │ │ ├── IReduce.java │ │ │ │ ├── IReduceInit.java │ │ │ │ ├── IRef.java │ │ │ │ ├── IReference.java │ │ │ │ ├── ISeq.java │ │ │ │ ├── ITransientAssociative.java │ │ │ │ ├── ITransientCollection.java │ │ │ │ ├── ITransientMap.java │ │ │ │ ├── ITransientSet.java │ │ │ │ ├── ITransientVector.java │ │ │ │ ├── IType.java │ │ │ │ ├── IllegalAccessError.java │ │ │ │ ├── Indexed.java │ │ │ │ ├── IndexedSeq.java │ │ │ │ ├── Intrinsics.java │ │ │ │ ├── Iterate.java │ │ │ │ ├── IteratorSeq.java │ │ │ │ ├── Keyword.java │ │ │ │ ├── KeywordLookupSite.java │ │ │ │ ├── LazilyPersistentVector.java │ │ │ │ ├── LazySeq.java │ │ │ │ ├── LineNumberingPushbackReader.java │ │ │ │ ├── LispReader.java │ │ │ │ ├── LockingTransaction.java │ │ │ │ ├── LongRange.java │ │ │ │ ├── MapEntry.java │ │ │ │ ├── MapEquivalence.java │ │ │ │ ├── MethodImplCache.java │ │ │ │ ├── MultiFn.java │ │ │ │ ├── Murmur3.java │ │ │ │ ├── Named.java │ │ │ │ ├── Namespace.java │ │ │ │ ├── Numbers.java │ │ │ │ ├── Obj.java │ │ │ │ ├── ObjC.java │ │ │ │ ├── ObjCClass.java │ │ │ │ ├── PersistentArrayMap.java │ │ │ │ ├── PersistentHashMap.java │ │ │ │ ├── PersistentHashSet.java │ │ │ │ ├── PersistentList.java │ │ │ │ ├── PersistentQueue.java │ │ │ │ ├── PersistentStructMap.java │ │ │ │ ├── PersistentTreeMap.java │ │ │ │ ├── PersistentTreeSet.java │ │ │ │ ├── PersistentVector.java │ │ │ │ ├── ProxyHandler.java │ │ │ │ ├── RT.java │ │ │ │ ├── Range.java │ │ │ │ ├── Ratio.java │ │ │ │ ├── ReaderConditional.java │ │ │ │ ├── RecordIterator.java │ │ │ │ ├── Reduced.java │ │ │ │ ├── Ref.java │ │ │ │ ├── Reflector.java │ │ │ │ ├── RemoteRef.java │ │ │ │ ├── RemoteRepl.java │ │ │ │ ├── Repeat.java │ │ │ │ ├── RestFn.java │ │ │ │ ├── RestFnWithMeta.java │ │ │ │ ├── Reversible.java │ │ │ │ ├── Selector.java │ │ │ │ ├── SeqEnumeration.java │ │ │ │ ├── SeqIterator.java │ │ │ │ ├── Seqable.java │ │ │ │ ├── Sequential.java │ │ │ │ ├── Settable.java │ │ │ │ ├── Sorted.java │ │ │ │ ├── SourceGenIntrinsics.java │ │ │ │ ├── SourceWriter.java │ │ │ │ ├── StringEscapeUtils.java │ │ │ │ ├── StringSeq.java │ │ │ │ ├── Symbol.java │ │ │ │ ├── TaggedLiteral.java │ │ │ │ ├── ThreadFactory.java │ │ │ │ ├── TransactionalHashMap.java │ │ │ │ ├── TransformerIterator.java │ │ │ │ ├── URLClassLoader.java │ │ │ │ ├── Util.java │ │ │ │ ├── Var.java │ │ │ │ ├── Volatile.java │ │ │ │ ├── WarnBoxedMath.java │ │ │ │ ├── XMLHandler.java │ │ │ │ └── package.html │ │ │ └── main.java │ │ └── com/ │ │ └── google/ │ │ └── j2objc/ │ │ └── annotations/ │ │ └── ReflectionSupport.java │ ├── objc/ │ │ ├── Cst502Socket.h │ │ ├── Cst502Socket.m │ │ ├── NSCommon.h │ │ ├── NSCommon.m │ │ ├── NSProxyImpl.h │ │ ├── NSProxyImpl.m │ │ ├── NSSocketImpl.h │ │ ├── NSSocketImpl.m │ │ ├── NSTypeImpl.h │ │ ├── NSTypeImpl.m │ │ ├── ReplClient.h │ │ ├── ReplClient.m │ │ ├── WeakRef.h │ │ └── WeakRef.m │ ├── resources/ │ │ └── clojure/ │ │ └── version.properties │ └── script/ │ ├── run_test.clj │ └── run_test_generative.clj └── test/ ├── clojure/ │ ├── test_clojure/ │ │ ├── agents.clj │ │ ├── annotations/ │ │ │ ├── java_5.clj │ │ │ └── java_6.clj │ │ ├── annotations.clj │ │ ├── api.clj │ │ ├── atoms.clj │ │ ├── clojure_set.clj │ │ ├── clojure_walk.clj │ │ ├── clojure_xml.clj │ │ ├── clojure_zip.clj │ │ ├── compilation/ │ │ │ ├── examples.clj │ │ │ └── line_number_examples.clj │ │ ├── compilation.clj │ │ ├── control.clj │ │ ├── data.clj │ │ ├── data_structures.clj │ │ ├── def.clj │ │ ├── delays.clj │ │ ├── edn.clj │ │ ├── errors.clj │ │ ├── evaluation.clj │ │ ├── fn.clj │ │ ├── for.clj │ │ ├── genclass/ │ │ │ └── examples.clj │ │ ├── genclass.clj │ │ ├── generators.clj │ │ ├── java/ │ │ │ ├── io.clj │ │ │ ├── javadoc.clj │ │ │ └── shell.clj │ │ ├── java_interop.clj │ │ ├── keywords.clj │ │ ├── logic.clj │ │ ├── macros.clj │ │ ├── main.clj │ │ ├── metadata.clj │ │ ├── multimethods.clj │ │ ├── ns_libs.clj │ │ ├── numbers.clj │ │ ├── other_functions.clj │ │ ├── parallel.clj │ │ ├── pprint/ │ │ │ ├── test_cl_format.clj │ │ │ ├── test_helper.clj │ │ │ └── test_pretty.clj │ │ ├── pprint.clj │ │ ├── predicates.clj │ │ ├── printer.clj │ │ ├── protocols/ │ │ │ ├── examples.clj │ │ │ ├── hash_collisions.clj │ │ │ └── more_examples.clj │ │ ├── protocols.clj │ │ ├── reader.cljc │ │ ├── reducers.clj │ │ ├── reflect.clj │ │ ├── refs.clj │ │ ├── repl/ │ │ │ └── example.clj │ │ ├── repl.clj │ │ ├── rt.clj │ │ ├── sequences.clj │ │ ├── serialization.clj │ │ ├── special.clj │ │ ├── string.clj │ │ ├── test.clj │ │ ├── test_fixtures.clj │ │ ├── transducers.clj │ │ ├── transients.clj │ │ ├── try_catch.clj │ │ ├── vars.clj │ │ ├── vectors.clj │ │ └── volatiles.clj │ └── test_helper.clj ├── java/ │ ├── clojure/ │ │ └── test/ │ │ └── ReflectorTryCatchFixture.java │ ├── compilation/ │ │ └── TestDispatch.java │ └── java/ │ └── util/ │ └── jar/ │ ├── JarEntry.java │ └── JarFile.java └── objc/ ├── NSCommonTest.h └── NSCommonTest.m ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitignore ================================================ *.jar target clojure.iws clojure.ipr nbproject/private/ maven-classpath maven-classpath.properties coclojure/* .settings/* .classpath .project xcode .idea/ settings.xml upload-github.sh ================================================ FILE: CONTRIBUTING.md ================================================ If you'd like to submit a patch, please follow the [contributing guidelines](http://clojure.org/contributing). ================================================ FILE: KNOWN_ISSUES ================================================ - Dividing by zero doesn't throw an exception in objc, it fails with EXC_ARITHMETIC - NullPointerException and ClassCastException are not reliable, as they are emulated by j2objc - Empty regular expressions throw an exception - pr-str a date have a bad Timezone format: https://code.google.com/p/j2objc/issues/detail?id=321 ================================================ FILE: antsetup.sh ================================================ #!/bin/bash mvn -q dependency:build-classpath -Dmdep.outputFile=maven-classpath cat <maven-classpath.properties maven.compile.classpath=`cat maven-classpath` maven.test.classpath=`cat maven-classpath` EOF echo "Wrote maven-classpath.properties for standalone ant use" ================================================ FILE: build.clj ================================================ (use '[clojure.java.shell :only [sh with-sh-dir]]) (use '[clojure.java.io :only [delete-file file]]) (require '[clojure.string :as st]) (import '[java.io File]) (def j2objc-home (System/getenv "J2OBJC_HOME")) (def iphone-os-sdk "/Applications/Xcode.app/Contents/Developer/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS.sdk") (def iphone-simulator-sdk "/Applications/Xcode.app/Contents/Developer/Platforms/iPhoneSimulator.platform/Developer/SDKs/iPhoneSimulator.sdk") (def frameworks "-framework UIKit -framework Foundation") (def opts "-g -miphoneos-version-min=6.1 -fmessage-length=0 -fmacro-backtrace-limit=0 -std=gnu99 -fpascal-strings -O3 -DDEBUG=1 -Wno-unsequenced") (let [a (agent nil)] (defn println+ [& other] (send a (fn [_] (apply println other))))) (defn walk [^File dir] (let [children (.listFiles dir) subdirs (filter #(.isDirectory %) children) files (filter #(.isFile %) children)] (concat files (mapcat walk subdirs)))) (defn find-files [folder extension] (filter #(.endsWith (.getName %) (str "." extension)) (walk (file folder)))) (defn sh+ [& args] (let [silent (= :silent (first args)) _ (when-not silent (println+ "Running: " (reduce str (interpose " " args)))) args (map #(clojure.string/split % #" ") (if silent (next args) args)) r (apply sh (flatten args))] (when-not (zero? (:exit r)) (println+ "FAILED" (:err r))))) (defn makeoname [f] (str (st/replace f #"/" ".") ".o")) (defn clang [id params sdk target f] (println+ id (.getName f)) (sh+ :silent "clang" "-x" "objective-c" params opts "-isysroot" sdk (str "-I" target "/../src/ffi") (str "-I" target "/objc") (str "-I" j2objc-home "/include") "-c" (.getCanonicalPath f) "-o" (makeoname (.getPath f)))) (defn build [id params sdk] (let [target (File. "target") tcn (.getCanonicalPath target)] (with-sh-dir target (println+ "Compiling" id) (sh+ "rm" "-Rf" id) (sh+ "mkdir" id) (with-sh-dir (File. (str "target/" id)) (doall (pmap (partial clang id params sdk tcn) (find-files "target/objc" "m"))) (spit (str tcn "/" id "/files.LinkFileList") (reduce str (interpose "\n" (find-files (str tcn "/" id) "o")))) (sh+ "libtool" "-static" "-syslibroot" sdk "-filelist" "files.LinkFileList" frameworks "-o" "libclojure-objc.a"))))) (sh+ "mvn" "compile" "test-compile") (sh+ "rm" "-Rf" "target/objc") (sh+ "mkdir" "target/objc") (sh+ "cp" "-R" "src/objc/." "target/objc") (sh+ "cp" "-R" "src/ffi/." "target/objc") (sh+ "zip" "-r" "target/objc.jar" "target/gen" "src/jvm" "test/java") (sh+ (str j2objc-home "/j2objc") "-d" "target/objc" "--final-methods-as-functions" "--batch-translate-max=500" "-J-Xmx2G" "-classpath" "target/classes:target/test-classes" "target/objc.jar") (let [i (File. "target/include")] (when-not (.exists i) (.mkdirs i))) (with-sh-dir (File. "target/objc") (sh "rsync" "-avm" "--delete" "--include" "*.h" "-f" "hide,! */" "." "../include")) (build "iphoneos" "-arch armv7 -arch armv7s -arch arm64" iphone-os-sdk) (build "iphonesimulator" "-arch i386 -arch x86_64" iphone-simulator-sdk) (let [a (File. "target/libclojure-objc.a")] (when (.exists a) (.delete a)) (sh+ "lipo" "-create" "-output" "target/libclojure-objc.a" "target/iphoneos/libclojure-objc.a" "target/iphonesimulator/libclojure-objc.a")) ================================================ FILE: build.xml ================================================ Build with "ant" and then start the REPL with: "java -cp clojure.jar clojure.main". version=${clojure.version.label} ================================================ FILE: changes.md ================================================ # Changes to Clojure in Version 1.7 ## 1 Compatibility Notes Please be aware of the following issues when upgrading to Clojure 1.7. ### Seqs on Java iterators that return the same mutating object Seqs are fundamentally incompatible with Java iterators that return the same mutating object on every call to next(). Some Clojure libraries incorrectly rely on calling seq on such iterators. In 1.7, iterator-seqs are chunked, which will cause many of these incorrect usages to return incorrect results immediately. The `seq` and `iterator-seq` docstrings have been updated to include an explicit warning. Libraries that incorrectly use `seq` and `iterator-seq` will need to be fixed before running against 1.7. * [CLJ-1669](http://dev.clojure.org/jira/browse/CLJ-1669) * [CLJ-1738](http://dev.clojure.org/jira/browse/CLJ-1738) ### Thread owner check removed on transients Prior to Clojure 1.7, transients would allow modification only from the thread that created the transient. This check has been removed. It is still a requirement that transients should be updated by only a single thread at a time. This constraint was relaxed to allow transients to be used in cases where code is multiplexed across multiple threads in a pool (such as go blocks in core.async). ### keys/vals require custom map type to implement Iterable Invoking `keys` or `vals` on a custom map type that implements IPersistentMap will now use the Iterable iterator() method instead of accessing entries via the seq of the map. There have been no changes in the type hierarchy (IPersistentMap has always extended Iterable) but former map-like instances may have skipped implementing this method in the past. * [CLJ-1602](http://dev.clojure.org/jira/browse/CLJ-1602) ## 2 New and Improved Features ### 2.1 Transducers Transducers is a new way to decouple algorithmic transformations from their application in different contexts. Transducers are functions that transform reducing functions to build up a "recipe" for transformation. Also see: http://clojure.org/transducers Many existing sequence functions now have a new arity (one fewer argument than before). This arity will return a transducer that represents the same logic but is independent of lazy sequence processing. Functions included are: * map * mapcat * filter * remove * take * take-while * drop * drop-while * take-nth * replace * partition-by * partition-all * keep * keep-indexed * map-indexed * distinct * interpose Additionally some new transducer functions have been added: * cat - concatenates the contents of each input * dedupe - removes consecutive duplicated values * random-sample - returns items from coll with random probability And this function can be used to make completing transforms: * completing There are also several new or modified functions that can be used to apply transducers in different ways: * sequence - takes a transformation and a coll and produces a lazy seq * transduce - reduce with a transformation (eager) * eduction - returns a reducible/iterable of applications of the transducer to items in coll. Applications are re-performed with every reduce/iterator. There have been a number of internal changes to support transducers: * volatiles - there are a new set of functions (volatile!, vswap!, vreset!, volatile?) to create and use volatile "boxes" to hold state in stateful transducers. Volatiles are faster than atoms but give up atomicity guarantees so should only be used with thread isolation. * array iterators - added support for iterators over arrays * conj can be used as a reducing function and will conj to [] Some related issues addressed during development: * [CLJ-1511](http://dev.clojure.org/jira/browse/CLJ-1511) * [CLJ-1497](http://dev.clojure.org/jira/browse/CLJ-1497) * [CLJ-1549](http://dev.clojure.org/jira/browse/CLJ-1549) * [CLJ-1537](http://dev.clojure.org/jira/browse/CLJ-1537) * [CLJ-1554](http://dev.clojure.org/jira/browse/CLJ-1554) * [CLJ-1601](http://dev.clojure.org/jira/browse/CLJ-1601) * [CLJ-1606](http://dev.clojure.org/jira/browse/CLJ-1606) * [CLJ-1621](http://dev.clojure.org/jira/browse/CLJ-1621) * [CLJ-1600](http://dev.clojure.org/jira/browse/CLJ-1600) * [CLJ-1635](http://dev.clojure.org/jira/browse/CLJ-1635) * [CLJ-1683](http://dev.clojure.org/jira/browse/CLJ-1683) * [CLJ-1669](http://dev.clojure.org/jira/browse/CLJ-1669) * [CLJ-1723](http://dev.clojure.org/jira/browse/CLJ-1723) ### 2.2 Reader Conditionals Reader Conditionals are a new capability to support portable code that can run on multiple Clojure platforms with only small changes. In particular, this feature aims to support the increasingly common case of libraries targeting both Clojure and ClojureScript. Code intended to be common across multiple platforms should use a new supported file extension: ".cljc". When requested to load a namespace, the platform-specific file extension (.clj, .cljs) will be checked prior to .cljc. A new reader form can be used to specify "reader conditional" code in cljc files (and *only* cljc files). Each platform defines a feature identifying the platform (:clj, :cljs, :cljr). The reader conditional specifies code that is read conditionally based on the feature. The REPL also allows reader conditionals. Form #? takes a list of alternating feature and expression. These are checked like cond and the selected expression is read and returned. Other branches are read but skipped. If no branch is selected, the reader reads nothing (not nil, but literally as if reading no form). An optional `:default` branch can be used as a fallthrough. Reader conditional with 2 features and a default: #?(:clj Double/NaN :cljs js/NaN :default nil) There is also a reader conditional splicing form. The evaluated expression should be sequential and will be spliced into the surrounded code, similar to unquote-splicing. For example: [1 2 #?@(:clj [3 4] :cljs [5 6])] This form would read as [1 2 3 4] on Clojure, [1 2 5 6] on ClojureScript, and [1 2] on any other platform. Splicing is not allowed at the top level. Additionally, the reader can now be invoked with options for the features to use and how to interpret reader conditionals. By default, reader conditionals are not allowed, but that can be turned on, or a "preserve" mode can be used to preserve all branches (most likely useful for tooling or source transforms). In the preserve mode, the reader conditional itself and any tagged literals within the unselected branches are returned as tagged literal data. For more information, see: http://dev.clojure.org/display/design/Reader+Conditionals * [CLJ-1424](http://dev.clojure.org/jira/browse/CLJ-1424) * [CLJ-1685](http://dev.clojure.org/jira/browse/CLJ-1685) * [CLJ-1698](http://dev.clojure.org/jira/browse/CLJ-1698) * [CLJ-1699](http://dev.clojure.org/jira/browse/CLJ-1699) * [CLJ-1700](http://dev.clojure.org/jira/browse/CLJ-1700) * [CLJ-1728](http://dev.clojure.org/jira/browse/CLJ-1728) * [CLJ-1706](http://dev.clojure.org/jira/browse/CLJ-1706) ### 2.3 Keyword and Symbol Construction In response to issues raised in [CLJ-1439](http://dev.clojure.org/jira/browse/CLJ-1439), several changes have been made in symbol and keyword construction: 1) The main bottleneck in construction of symbols (which also occurs inside keywords) was interning of the name and namespace strings. This interning has been removed, resulting in a performance increase. 2) Keywords are cached and keyword construction includes a cache check. A change was made to only clear the cache reference queue when there is a cache miss. ### 2.4 Warn on Boxed Math One source of performance issues is the (unintended) use of arithmetic operations on boxed numbers. To make detecting the presence of boxed math easier, a warning will now be emitted about boxed math if \*unchecked-math* is set to :warn-on-boxed (any truthy value will enable unchecked-math, only this specific value enables the warning). Example use: user> (defn plus-2 [x] (+ x 2)) ;; no warning, but boxed #'user/plus-2 user> (set! *unchecked-math* :warn-on-boxed) true user> (defn plus-2 [x] (+ x 2)) ;; now we see a warning Boxed math warning, NO_SOURCE_PATH:10:18 - call: public static java.lang.Number clojure.lang.Numbers.unchecked_add(java.lang.Object,long). #'user/plus-2 user> (defn plus-2 [^long x] (+ x 2)) ;; use a hint to avoid boxing #'user/plus-2 * [CLJ-1325](http://dev.clojure.org/jira/browse/CLJ-1325) * [CLJ-1535](http://dev.clojure.org/jira/browse/CLJ-1535) * [CLJ-1642](http://dev.clojure.org/jira/browse/CLJ-1642) ### 2.5 update - like update-in for first level `update` is a new function that is like update-in specifically for first-level keys: (update m k f args...) Example use: user> (update {:a 1} :a inc) {:a 2} user> (update {:a 1} :a + 2) {:a 3} user> (update {} :a identity) ;; missing returns nil {:a nil} * [CLJ-1251](http://dev.clojure.org/jira/browse/CLJ-1251) ### 2.6 Faster reduce and iterator paths Several important Clojure functions now return sequences that also contain fast reduce() (or in some cases iterator()) paths. In many cases, the new implementations are also faster for lazy sequences * repeat - now implements IReduce * cycle - implements IReduceInit * iterate - implements IReduceInit * range - implements IReduce, specialized case handles common case of all longs * keys - iterates directly over the keys of a map, without seq or MapEntry allocation * vals - iterates directly over the vals of a map, without seq or MapEntry allocation * iterator-seq - creates a chunked sequence when previously it was unchunked Additionally, hash-maps and hash-sets now provide iterators that walk the data structure directly rather than via a sequence. A new interface (IMapIterable) for direct key and val iterators on maps was added. External data structures can use this interface to provide direct key and val iterators via keys and vals. These enhancements are particularly effective when used in tandem with transducers via transduce, sequence, into, and eduction. * [CLJ-1603](http://dev.clojure.org/jira/browse/CLJ-1603) * [CLJ-1515](http://dev.clojure.org/jira/browse/CLJ-1515) * [CLJ-1602](http://dev.clojure.org/jira/browse/CLJ-1602) * [CLJ-1669](http://dev.clojure.org/jira/browse/CLJ-1669) * [CLJ-1692](http://dev.clojure.org/jira/browse/CLJ-1692) * [CLJ-1694](http://dev.clojure.org/jira/browse/CLJ-1694) * [CLJ-1711](http://dev.clojure.org/jira/browse/CLJ-1711) * [CLJ-1709](http://dev.clojure.org/jira/browse/CLJ-1709) * [CLJ-1713](http://dev.clojure.org/jira/browse/CLJ-1713) * [CLJ-1726](http://dev.clojure.org/jira/browse/CLJ-1726) * [CLJ-1727](http://dev.clojure.org/jira/browse/CLJ-1727) ### 2.7 Printing as data There have been enhancements in how the REPL prints values without a print-method, specifically Throwable and the fallthrough Object case. Both cases now print in a tagged literal data form that can be read by the reader. Unhandled objects print with the class, hash code, and toString: user=> *ns* #object[clojure.lang.Namespace 0x55aa628 "user"] Thrown exceptions will still be printed in the normal way by the default REPL but printing them to a stream will show a different form: user=> (/ 1 0) ArithmeticException Divide by zero clojure.lang.Numbers.divide (Numbers.java:158) user=> (println *e) #error { :cause Divide by zero :via [{:type java.lang.ArithmeticException :message Divide by zero :at [clojure.lang.Numbers divide Numbers.java 158]}] :trace [[clojure.lang.Numbers divide Numbers.java 158] [clojure.lang.Numbers divide Numbers.java 3808] ;; ... elided frames ]} Additionally, there is a new function available to obtain a Throwable as map data: `Throwable->map`. * [CLJ-1703](http://dev.clojure.org/jira/browse/CLJ-1703) * [CLJ-1716](http://dev.clojure.org/jira/browse/CLJ-1716) * [CLJ-1735](http://dev.clojure.org/jira/browse/CLJ-1735) ### 2.8 run! run! is a new function that takes a side effect reducing function and runs it for all items in a collection via reduce. The accumulator is ignored and nil is returned. (run! println (range 10)) ## 3 Enhancements ### 3.1 Error messages * [CLJ-1261](http://dev.clojure.org/jira/browse/CLJ-1261) Invalid defrecord results in exception attributed to consuming ns instead of defrecord ns * [CLJ-1297](http://dev.clojure.org/jira/browse/CLJ-1297) Give more specific hint if namespace with "-" not found to check file uses "_" ### 3.2 Documentation strings * [CLJ-1417](http://dev.clojure.org/jira/browse/CLJ-1417) clojure.java.io/input-stream has incorrect docstring * [CLJ-1357](http://dev.clojure.org/jira/browse/CLJ-1357) Fix typo in gen-class doc-string * [CLJ-1479](http://dev.clojure.org/jira/browse/CLJ-1479) Fix typo in filterv example * [CLJ-1480](http://dev.clojure.org/jira/browse/CLJ-1480) Fix typo in defmulti docstring * [CLJ-1477](http://dev.clojure.org/jira/browse/CLJ-1477) Fix typo in deftype docstring * [CLJ-1478](http://dev.clojure.org/jira/browse/CLJ-1378) Fix typo in clojure.main usage * [CLJ-1738](http://dev.clojure.org/jira/browse/CLJ-1738) Clarify usage on Java iterators in seq and iterator-seq ### 3.3 Performance * [CLJ-1430](http://dev.clojure.org/jira/browse/CLJ-1430) Improve performance of partial with more unrolling * [CLJ-1384](http://dev.clojure.org/jira/browse/CLJ-1384) clojure.core/set should use transients for better performance * [CLJ-1429](http://dev.clojure.org/jira/browse/CLJ-1429) Cache unknown multimethod value default dispatch * [CLJ-1529](http://dev.clojure.org/jira/browse/CLJ-1529) Reduce compile times by avoiding unnecessary calls to Class.forName() * [CLJ-1546](http://dev.clojure.org/jira/browse/CLJ-1546) vec is now faster on almost all inputs * [CLJ-1618](http://dev.clojure.org/jira/browse/CLJ-1618) set is now faster on almost all inputs * [CLJ-1695](http://dev.clojure.org/jira/browse/CLJ-1695) Fixed reflection call in variadic vector-of constructor ### 3.4 Other enhancements * [CLJ-1191](http://dev.clojure.org/jira/browse/CLJ-1191) Improve apropos to show some indication of namespace of symbols found * [CLJ-1378](http://dev.clojure.org/jira/browse/CLJ-1378) Hints don't work with #() form of function * [CLJ-1498](http://dev.clojure.org/jira/browse/CLJ-1498) Removes owner-thread check from transients - this check was preventing some valid usage of transients in core.async where a transient is created on one thread and then used again in another pooled thread (while still maintaining thread isolation). * [CLJ-803](http://dev.clojure.org/jira/browse/CLJ-803) Extracted IAtom interface implemented by Atom. * [CLJ-1315](http://dev.clojure.org/jira/browse/CLJ-1315) Don't initialize classes when importing them * [CLJ-1330](http://dev.clojure.org/jira/browse/CLJ-1330) Class name clash between top-level functions and defn'ed ones * [CLJ-1349](http://dev.clojure.org/jira/browse/CLJ-1349) Update to latest test.generative and add dependency on test.check * [CLJ-1546](http://dev.clojure.org/jira/browse/CLJ-1546) vec now works with things that only implement Iterable or IReduceInit * [CLJ-1618](http://dev.clojure.org/jira/browse/CLJ-1618) set now works with things that only implement Iterable or IReduceInit * [CLJ-1633](http://dev.clojure.org/jira/browse/CLJ-1633) PersistentList/creator doesn't handle ArraySeqs correctly * [CLJ-1589](http://dev.clojure.org/jira/browse/CLJ-1589) Clean up unused paths in InternalReduce * [CLJ-1677](http://dev.clojure.org/jira/browse/CLJ-1677) Add setLineNumber() to LineNumberingPushbackReader * [CLJ-1667](http://dev.clojure.org/jira/browse/CLJ-1667) Change test to avoid using hard-coded socket port * [CLJ-1683](http://dev.clojure.org/jira/browse/CLJ-1683) Change reduce tests to better catch reduce without init bugs ## 4 Bug Fixes * [CLJ-1362](http://dev.clojure.org/jira/browse/CLJ-1362) Reduce broken on some primitive vectors * [CLJ-1388](http://dev.clojure.org/jira/browse/CLJ-1388) Equality bug on records created with nested calls to map->record * [CLJ-1274](http://dev.clojure.org/jira/browse/CLJ-1274) Unable to set compiler options via system properties except for AOT compilation * [CLJ-1241](http://dev.clojure.org/jira/browse/CLJ-1241) NPE when AOTing overrided clojure.core functions * [CLJ-1185](http://dev.clojure.org/jira/browse/CLJ-1185) reductions does not check for reduced value * [CLJ-1039](http://dev.clojure.org/jira/browse/CLJ-1039) Using def with metadata {:type :anything} throws ClassCastException during printing * [CLJ-887](http://dev.clojure.org/jira/browse/CLJ-887) Error when calling primitive functions with destructuring in the arg vector * [CLJ-823](http://dev.clojure.org/jira/browse/CLJ-823) Piping seque into seque can deadlock * [CLJ-738](http://dev.clojure.org/jira/browse/CLJ-738) <= is incorrect when args include Double/NaN * [CLJ-1408](http://dev.clojure.org/jira/browse/CLJ-1408) Make cached string value of Keyword and Symbol transient * [CLJ-1466](http://dev.clojure.org/jira/browse/CLJ-1466) clojure.core/bean should implement Iterable * [CLJ-1578](http://dev.clojure.org/jira/browse/CLJ-1578) Make refer of Clojure core function not throw exception on reload * [CLJ-1501](http://dev.clojure.org/jira/browse/CLJ-1501) LazySeq equals() should not use equiv() logic * [CLJ-1572](http://dev.clojure.org/jira/browse/CLJ-1572) into (and other fns that rely on reduce) require only IReduceInit * [CLJ-1619](http://dev.clojure.org/jira/browse/CLJ-1619) PersistentVector now directly implements reduce without init * [CLJ-1580](http://dev.clojure.org/jira/browse/CLJ-1580) Transient collections should guarantee thread visibility * [CLJ-1590](http://dev.clojure.org/jira/browse/CLJ-1590) Some IReduce/IReduceInit implementors don't respect reduced * [CLJ-979](http://dev.clojure.org/jira/browse/CLJ-979) Clojure resolves to wrong deftype classes when AOT compiling or reloading * [CLJ-1636](http://dev.clojure.org/jira/browse/CLJ-1636) Fix intermittent SeqIterator problem by removing use of this as a sentinel * [CLJ-1637](http://dev.clojure.org/jira/browse/CLJ-1636) Fix regression from CLJ-1546 that broke vec on MapEntry * [CLJ-1663](http://dev.clojure.org/jira/browse/CLJ-1663) Fix regression from CLJ-979 for DynamicClassLoader classloader delegation * [CLJ-1604](http://dev.clojure.org/jira/browse/CLJ-1604) Fix error from AOT'ed code defining a var with a clojure.core symbol name * [CLJ-1561](http://dev.clojure.org/jira/browse/CLJ-1561) Fix incorrect line number reporting for error locations * [CLJ-1568](http://dev.clojure.org/jira/browse/CLJ-1568) Fix incorrect line number reporting for error locations * [CLJ-1638](http://dev.clojure.org/jira/browse/CLJ-1638) Fix regression from CLJ-1546 removed PersistentVector.create(List) method * [CLJ-1681](http://dev.clojure.org/jira/browse/CLJ-1681) Fix regression from CLJ-1248 (1.6) in reflection warning with literal nil argument * [CLJ-1648](http://dev.clojure.org/jira/browse/CLJ-1648) Use equals() instead of == when resolving Symbol * [CLJ-1195](http://dev.clojure.org/jira/browse/CLJ-1195) emit-hinted-impl expands to ns-qualified invocation of fn * [CLJ-1237](http://dev.clojure.org/jira/browse/CLJ-1237) reduce of sequence that switches between chunked and unchunked many times throws StackOverflow # Changes to Clojure in Version 1.6 ## CONTENTS ## 1 Compatibility and Dependencies ## 1.1 JDK Version Update Clojure now builds with Java SE 1.6 and emits bytecode requiring Java SE 1.6 instead of Java SE 1.5. [CLJ-1268] ## 1.2 ASM Library Update The embedded version of the ASM bytecode library has been upgraded to ASM 4.1. [CLJ-713] ## 1.3 Promoted "Alpha" Features The following features are no longer marked Alpha in Clojure: * Watches - add-watch, remove-watch * Transients - transient, persistent!, conj!, assoc!, dissoc!, pop!, disj! * Exception data - ex-info, ex-data * Promises - promise, deliver * Records - defrecord * Types - deftype * Pretty-print tables - print-table ## 2 New and Improved Features ### 2.1 Java API The clojure.java.api package provides a minimal interface to bootstrap Clojure access from other JVM languages. It does this by providing: 1. The ability to use Clojure's namespaces to locate an arbitrary var, returning the var's clojure.lang.IFn interface. 2. A convenience method read for reading data using Clojure's edn reader. IFns provide complete access to Clojure's APIs. You can also access any other library written in Clojure, after adding either its source or compiled form to the classpath. The public Java API for Clojure consists of the following classes and interfaces: * clojure.java.api.Clojure * clojure.lang.IFn All other Java classes should be treated as implementation details, and applications should avoid relying on them. To look up and call a Clojure function: IFn plus = Clojure.var("clojure.core", "+"); plus.invoke(1, 2); Functions in clojure.core are automatically loaded. Other namespaces can be loaded via require: IFn require = Clojure.var("clojure.core", "require"); require.invoke(Clojure.read("clojure.set")); IFns can be passed to higher order functions, e.g. the example below passes plus to read: IFn map = Clojure.var("clojure.core", "map"); IFn inc = Clojure.var("clojure.core", "inc"); map.invoke(inc, Clojure.read("[1 2 3]")); Most IFns in Clojure refer to functions. A few, however, refer to non-function data values. To access these, use deref instead of fn: IFn printLength = Clojure.var("clojure.core", "*print-length*"); Clojure.var("clojure.core", "deref").invoke(printLength); ### 2.2 Map destructuring extended to support namespaced keys * [CLJ-1318](http://dev.clojure.org/jira/browse/CLJ-1318) In the past, map destructuring with :keys and :syms would not work with maps containing namespaced keys or symbols. The :keys and :syms forms have been updated to allow them to match namespaced keys and bind to a local variable based on the name. Examples: (let [m {:x/a 1, :y/b 2} {:keys [x/a y/b]} m] (+ a b)) (let [m {'x/a 1, 'y/b 2} {:syms [x/a y/b]} m] (+ a b)) Additionally, the :keys form can now take keywords instead of symbols. This provides support specifically for auto-resolved keywords: (let [m {:x/a 1, :y/b 2} {:keys [:x/a :y/b]} m] (+ a b)) (let [m {::x 1} {:keys [::x]} m] x) ### 2.3 New "some" operations Many conditional functions rely on logical truth (where "falsey" values are nil or false). Sometimes it is useful to have functions that rely on "not nilness" instead. These functions have been added to support these cases [CLJ-1343]: * some? - same as (not (nil? x)) * if-some - like if-let, but checks (some? test) instead of test * when-some - like when-let, but checks (some? test) instead of test ### 2.4 Hashing Clojure 1.6 provides new hashing algorithms for primitives and collections, accessible via IHashEq/hasheq (in Java) or the clojure.core/hash function (in Clojure). In general, these changes should be transparent to users, except hash codes used inside hashed collections like maps and sets will have better properties. Hash codes returned by the Java .hashCode() method are unchanged and continue to match Java behavior or conform to the Java specification as appropriate. Any collections implementing IHashEq or wishing to interoperate with Clojure collections should conform to the hashing algorithms specified in http://clojure.org/data_structures#hash and use the new function `mix-collection-hash` for the final mixing operation. Alternatively, you may call the helper functions `hash-ordered-coll` and `hash-unordered-coll`. Any details of the current hashing algorithm not specified on that page should be considered subject to future change. Related tickets for dev and regressions: * [CLJ-1328](http://dev.clojure.org/jira/browse/CLJ-1328) Make several Clojure tests independent of ordering * [CLJ-1331](http://dev.clojure.org/jira/browse/CLJ-1331) Update primitive vectors to use Murmur3 hash * [CLJ-1335](http://dev.clojure.org/jira/browse/CLJ-1335) Update hash for empty PersistentList and LazySeq * [CLJ-1336](http://dev.clojure.org/jira/browse/CLJ-1336) Make hashing mixing functions available in Clojure * [CLJ-1338](http://dev.clojure.org/jira/browse/CLJ-1338) Make Murmur3 class public * [CLJ-1344](http://dev.clojure.org/jira/browse/CLJ-1344) Update mapHasheq to call Murmur3 algorithm * [CLJ-1348](http://dev.clojure.org/jira/browse/CLJ-1348) Add hash-ordered-coll and hash-unordered-coll * [CLJ-1355](http://dev.clojure.org/jira/browse/CLJ-1355) Restore cached hashCode for Symbol and (uncached) hashCode for Keyword * [CLJ-1365](http://dev.clojure.org/jira/browse/CLJ-1365) Add type hints for new collection hash functions ### 2.5 bitops * [CLJ-827](http://dev.clojure.org/jira/browse/CLJ-827) - unsigned-bit-shift-right A new unsigned-bit-shift-right (Java's >>>) has been added to the core library. The shift distance is truncated to the least 6 bits (per the Java specification for long >>>). Examples: (unsigned-bit-shift-right 2r100 1) ;; 2r010 (unsigned-bit-shift-right 2r100 2) ;; 2r001 (unsigned-bit-shift-right 2r100 3) ;; 2r000 ### 2.6 clojure.test * [CLJ-866](http://dev.clojure.org/jira/browse/CLJ-866) - test-vars * [CLJ-1352](http://dev.clojure.org/jira/browse/CLJ-1352) - fix regression in CLJ-866 Added a new clojure.test/test-vars function that takes a list of vars, groups them by namespace, and runs them *with their fixtures*. ## 3 Enhancements ### 3.1 Printing * [CLJ-908](http://dev.clojure.org/jira/browse/CLJ-908) Print metadata for functions when *print-meta* is true and remove errant space at beginning. * [CLJ-937](http://dev.clojure.org/jira/browse/CLJ-937) pprint cl-format now supports E, F, and G formats for ratios. ### 3.2 Error messages * [CLJ-1248](http://dev.clojure.org/jira/browse/CLJ-1248) Include type information in reflection warning messages * [CLJ-1099](http://dev.clojure.org/jira/browse/CLJ-1099) If non-seq passed where seq is needed, error message now is an ExceptionInfo with the instance value, retrievable via ex-data. * [CLJ-1083](http://dev.clojure.org/jira/browse/CLJ-1083) Fix error message reporting for "munged" function names (like a->b). * [CLJ-1056](http://dev.clojure.org/jira/browse/CLJ-1056) Handle more cases and improve error message for errors in defprotocol definitions. * [CLJ-1102](http://dev.clojure.org/jira/browse/CLJ-1102) Better handling of exceptions with empty stack traces. * [CLJ-939](http://dev.clojure.org/jira/browse/CLJ-939) Exceptions thrown in the top level ns form are reported without file or line number. ### 3.3 Documentation strings * [CLJ-1164](http://dev.clojure.org/jira/browse/CLJ-1164) Fix typos in clojure.instant/validated and other internal instant functions. * [CLJ-1143](http://dev.clojure.org/jira/browse/CLJ-1143) Correct doc string for ns macro. * [CLJ-196](http://dev.clojure.org/jira/browse/CLJ-196) Clarify value of *file* is undefined in the REPL. * [CLJ-1228](http://dev.clojure.org/jira/browse/CLJ-1228) Fix a number of spelling errors in namespace and doc strings. * [CLJ-835](http://dev.clojure.org/jira/browse/CLJ-835) Update defmulti doc to clarify expectations for hierarchy argument. * [CLJ-1304](http://dev.clojure.org/jira/browse/CLJ-1304) Fix minor typos in documentation and comments * [CLJ-1302](http://dev.clojure.org/jira/browse/CLJ-1302) Mention that keys and vals order are consistent with seq order ### 3.4 Performance * [CLJ-858](http://dev.clojure.org/jira/browse/CLJ-858) Improve speed of STM by removing System.currentTimeMillis. * [CLJ-669](http://dev.clojure.org/jira/browse/CLJ-669) clojure.java.io/do-copy: use java.nio for Files * [commit](https://github.com/clojure/clojure/commit/0b73494c3c855e54b1da591eeb687f24f608f346) Reduce overhead of protocol callsites by removing unneeded generated cache fields. ### 3.5 Other enhancements * [CLJ-908](http://dev.clojure.org/jira/browse/CLJ-908) Make *default-data-reader-fn* set!-able in REPL, similar to *data-readers*. * [CLJ-783](http://dev.clojure.org/jira/browse/CLJ-783) Make clojure.inspector/inspect-tree work on sets. * [CLJ-896](http://dev.clojure.org/jira/browse/CLJ-896) Make browse-url aware of xdg-open. * [CLJ-1160](http://dev.clojure.org/jira/browse/CLJ-1160) Fix clojure.core.reducers/mapcat does not stop on reduced? values. * [CLJ-1121](http://dev.clojure.org/jira/browse/CLJ-1121) -> and ->> have been rewritten to work with a broader set of macros. * [CLJ-1105](http://dev.clojure.org/jira/browse/CLJ-1105) clojure.walk now supports records. * [CLJ-949](http://dev.clojure.org/jira/browse/CLJ-949) Removed all unnecessary cases of sneakyThrow. * [CLJ-1238](http://dev.clojure.org/jira/browse/CLJ-1238) Allow EdnReader to read foo// (matches LispReader behavior). * [CLJ-1264](http://dev.clojure.org/jira/browse/CLJ-1264) Remove uses of _ as a var in the Java code (causes warning in Java 8). * [CLJ-394](http://dev.clojure.org/jira/browse/CLJ-394) Add record? predicate. * [CLJ-1200](http://dev.clojure.org/jira/browse/CLJ-1200) ArraySeq dead code cleanup, ArraySeq_short support added. * [CLJ-1331](http://dev.clojure.org/jira/browse/CLJ-1331) Primitive vectors should implement hasheq and use new hash algorithm * [CLJ-1354](http://dev.clojure.org/jira/browse/CLJ-1354) Make APersistentVector.SubVector public so other collections can access * [CLJ-1353](http://dev.clojure.org/jira/browse/CLJ-1353) Make awt run headless during the build process ## 4 Bug Fixes * [CLJ-1018](http://dev.clojure.org/jira/browse/CLJ-1018) Make range consistently return infinite sequence of start with a step of 0. * [CLJ-863](http://dev.clojure.org/jira/browse/CLJ-863) Make interleave return () on 0 args and identity on 1 args. * [CLJ-1072](http://dev.clojure.org/jira/browse/CLJ-1072) Update internal usages of the old metadata reader syntax to new syntax. * [CLJ-1193](http://dev.clojure.org/jira/browse/CLJ-1193) Make bigint and biginteger functions work on double values outside long range. * [CLJ-1154](http://dev.clojure.org/jira/browse/CLJ-1154) Make Compile.java flush but not close stdout so errors can be reported. * [CLJ-1161](http://dev.clojure.org/jira/browse/CLJ-1161) Remove bad version.properties from sources jar. * [CLJ-1175](http://dev.clojure.org/jira/browse/CLJ-1175) Fix invalid behavior of Delay/deref if an exception is thrown - exception will now be rethrown on subsequent calls and not enter a corrupted state. * [CLJ-1171](http://dev.clojure.org/jira/browse/CLJ-1171) Fix several issues with instance? to make it consistent when used with apply. * [CLJ-1202](http://dev.clojure.org/jira/browse/CLJ-1202) Protocol fns with dashes may get incorrectly compiled into field accesses. * [CLJ-850](http://dev.clojure.org/jira/browse/CLJ-850) Add check to emit invokePrim with return type of double or long if type-hinted. * [CLJ-1177](http://dev.clojure.org/jira/browse/CLJ-1177) clojure.java.io URL to File coercion corrupts path containing UTF-8 characters. * [CLJ-1234](http://dev.clojure.org/jira/browse/CLJ-1234) Accept whitespace in Record and Type reader forms (similar to data literals). * [CLJ-1233](http://dev.clojure.org/jira/browse/CLJ-1233) Allow ** as a valid symbol name without triggering dynamic warnings. * [CLJ-1246](http://dev.clojure.org/jira/browse/CLJ-1246) Add support to clojure.reflect for classes with annotations. * [CLJ-1184](http://dev.clojure.org/jira/browse/CLJ-1184) Evaling #{do ...} or [do ...] is treated as do special form. * [CLJ-1090](http://dev.clojure.org/jira/browse/CLJ-1090) Indirect function calls through Var instances fail to clear locals. * [CLJ-1076](http://dev.clojure.org/jira/browse/CLJ-1076) pprint tests fail on Windows, expecting \n. * [CLJ-766](http://dev.clojure.org/jira/browse/CLJ-766) Make into-array work consistently with short-array and byte-array on bigger types. * [CLJ-1285](http://dev.clojure.org/jira/browse/CLJ-1285) Data structure invariants are violated after persistent operations when collision node created by transients. * [CLJ-1222](http://dev.clojure.org/jira/browse/CLJ-1222) Multiplication overflow issues around Long/MIN_VALUE * [CLJ-1118](http://dev.clojure.org/jira/browse/CLJ-1118) Inconsistent numeric comparison semantics between BigDecimals and other numerics * [CLJ-1125](http://dev.clojure.org/jira/browse/CLJ-1125) Clojure can leak memory in a servlet container when using dynamic bindings or STM transactions. * [CLJ-1082](http://dev.clojure.org/jira/browse/CLJ-1082) Subvecs of primitve vectors cannot be reduced * [CLJ-1301](http://dev.clojure.org/jira/browse/CLJ-1301) Case expressions use a mixture of hashCode and hasheq, potentially leading to missed case matches when these differ. * [CLJ-983](http://dev.clojure.org/jira/browse/CLJ-983) proxy-super does not restore original binding if call throws exception * [CLJ-1176](http://dev.clojure.org/jira/browse/CLJ-1176) clojure.repl/source errors when *read-eval* bound to :unknown * [CLJ-935](http://dev.clojure.org/jira/browse/CLJ-935) clojure.string/trim uses different definition of whitespace than triml and trimr * [CLJ-1058](http://dev.clojure.org/jira/browse/CLJ-1058) StackOverflowError on exception in reducef for PersistentHashMap fold * [CLJ-1328](http://dev.clojure.org/jira/browse/CLJ-1328) Fix some tests in the Clojure test suite to make their names unique and independent of hashing order * [CLJ-1339](http://dev.clojure.org/jira/browse/CLJ-1339) Empty primitive vectors throw NPE on .equals with non-vector sequential types * [CLJ-1363](http://dev.clojure.org/jira/browse/CLJ-1363) Field access via .- in reflective case does not work * [CLJ-944](http://dev.clojure.org/jira/browse/CLJ-944) Compiler gives constant collections types which mismatch their runtime values * [CLJ-1387](http://dev.clojure.org/jira/browse/CLJ-1387) reduce-kv on large hash maps ignores reduced result # Changes to Clojure in Version 1.5.1 * fix for leak caused by ddc65a96fdb1163b # Changes to Clojure in Version 1.5 ## CONTENTS 
 1 Deprecated and Removed Features
    1.1 Clojure 1.5 reducers library requires Java 6 or later
 2 New and Improved Features
    2.1 Reducers
    2.2 Reader Literals improved
    2.3 clojure.core/set-agent-send-executor!, set-agent-send-off-executor!, and send-via
    2.4 New threading macros
    2.5 Column metadata captured by reader
    2.6 gen-class improvements
    2.7 Support added for marker protocols
    2.8 clojure.pprint/print-table output compatible with Emacs Org mode
    2.9 clojure.string/replace and replace-first handle special characters more predictably
    2.10 Set and map constructor functions allow duplicates
    2.11 More functions preserve metadata
    2.12 New edn reader, improvements to *read-eval*
 3 Performance Enhancements
 4 Improved error messages
 5 Improved documentation strings
 6 Bug Fixes
 7 Binary Compatibility Notes
## 1 Deprecated and Removed Features ### 1.1 Clojure 1.5 reducers library requires Java 6 or later The new reducers library (see below) requires Java 6 plus a ForkJoin library, or Java 7 or later. Clojure 1.5 can still be compiled and run with Java 5. The only limitations with Java 5 are that the new reducers library will not work, and building Clojure requires skipping the test suite (e.g. by using the command "ant jar"). ## 2 New and Improved Features ### 2.1 Reducers Reducers provide a set of high performance functions for working with collections. The actual fold/reduce algorithms are specified via the collection being reduced. This allows each collection to define the most efficient way to reduce its contents. The implementation details of reducers are available at the [Clojure blog](http://clojure.com/blog/2012/05/08/reducers-a-library-and-model-for-collection-processing.html) and therefore won't be repeated in these change notes. However, as a summary: * There is a new namespace: clojure.core.reducers * It contains new versions of map, filter etc based upon transforming reducing functions - reducers * It contains a new function, fold, which is a parallel reduce+combine fold uses fork/join when working with (the existing!) Clojure vectors and maps * Your new parallel code has exactly the same shape as your existing seq-based code * The reducers are composable * Reducer implementations are primarily functional - no iterators * The model uses regular data structures, not 'parallel collections' or other OO malarkey * It's fast, and can become faster still * This is work-in-progress Examples: user=> (require '[clojure.core.reducers :as r]) user=> (reduce + (r/filter even? (r/map inc [1 1 1 2]))) ;=> 6 ;;red is a reducer awaiting a collection user=> (def red (comp (r/filter even?) (r/map inc))) user=> (reduce + (red [1 1 1 2])) ;=> 6 user=> (into #{} (r/filter even? (r/map inc [1 1 1 2]))) ;=> #{2} ### 2.2 Reader Literals improved * [CLJ-1034](http://dev.clojure.org/jira/browse/CLJ-1034) "Conflicting data-reader mapping" should no longer be thrown where there really isn't a conflict. Until this patch, having data_readers.clj on the classpath twice would cause the above exception. * [CLJ-927](http://dev.clojure.org/jira/browse/CLJ-927) Added `*default-data-reader-fn*` to clojure.core. When no data reader is found for a tag and `*default-data-reader-fn*`is non-nil, it will be called with two arguments, the tag and the value. If `*default-data-reader-fn*` is nil (the default), an exception will be thrown for the unknown tag. ### 2.3 clojure.core/set-agent-send-executor!, set-agent-send-off-executor!, and send-via Added two new functions: * clojure.core/set-agent-send-executor! Allows the user to set the `java.util.concurrent.Executor` used when calling `clojure.core/send`. Defaults to a fixed thread pool of size: (numCores + 2) * clojure.core/set-agent-send-off-executor! Allows the user to set the `java.util.concurrent.Executor` used when calling `clojure.core/send-off`. Defaults to a cached thread pool. * clojure.core/send-via Like `send`, and `send-off`, except the first argument to this function is an executor to use when sending. ### 2.4 New threading macros * clojure.core/cond-> [expr & clauses] Takes an expression and a set of test/form pairs. Threads the expression (via ->) through each form for which the corresponding test expression (not threaded) is true. Example: user=> (cond-> 1 true inc false (* 42) (= 2 2) (* 3)) 6 * clojure.core/cond->> [expr & clauses] Takes an expression and a set of test/form pairs. Threads expr (via ->>) through each form for which the corresponding test expression (not threaded) is true. Example: user=> (def d [0 1 2 3]) #'user/d user=> (cond->> d true (map inc) (seq? d) (map dec) (= (count d) 4) (reduce +)) ;; no threading in the test expr ;; so d must be passed in explicitly 10 * clojure.core/as-> [expr name & forms] Binds name to expr, evaluates the first form in the lexical context of that binding, then binds name to that result, repeating for each successive form Note: this form does not actually perform any threading. Instead it allows the user to assign a name and lexical context to a value created by a parent threading form. Example: user=> (-> 84 (/ 4) (as-> twenty-one ;; uses the value from -> (* 2 twenty-one))) ;; no threading here 42 * clojure.core/some-> [expr & forms] When expr is not nil, threads it into the first form (via ->), and when that result is not nil, through the next etc. Example: user=> (defn die [x] (assert false)) #'user/die user=> (-> 1 inc range next next next die) AssertionError Assert failed: false user/die (NO_SOURCE_FILE:65) user=> (some-> 1 inc range next next next die) nil * clojure.core/some->> [expr & forms] When expr is not nil, threads it into the first form (via ->>), and when that result is not nil, through the next etc. Same as some-> except the value is threaded as the last argument in each form. ### 2.5 Column metadata captured by reader * [CLJ-960](http://dev.clojure.org/jira/browse/CLJ-960) Data read by the clojure reader is now tagged with :column in addition to :line. ### 2.6 gen-class improvements * [CLJ-745](http://dev.clojure.org/jira/browse/CLJ-745) It is now possible to expose protected final methods via `:exposes-methods` in `gen-class`. This allows Clojure classes created via gen-class to access protected methods of its parent class. Example: (gen-class :name clojure.test_clojure.genclass.examples.ProtectedFinalTester :extends java.lang.ClassLoader :main false :prefix "pf-" :exposes-methods {findSystemClass superFindSystemClass}) * [CLJ-948](http://dev.clojure.org/jira/browse/CLJ-948) It is now possible to annotate constructors via `gen-class`. Example: (gen-class :name foo.Bar :extends clojure.lang.Box :constructors {^{Deprecated true} [Object] [Object]} :init init :prefix "foo") ### 2.7 Support added for marker protocols * [CLJ-966](http://dev.clojure.org/jira/browse/CLJ-966) `defprotocol` no longer requires that at least one method be given in the definition of the protocol. This allows for marker protocols, whose sole reason of existence is to allow `satisfies?` to be true for a given type. Example: user=> (defprotocol P (hi [_])) P user=> (defprotocol M) ; marker protocol M user=> (deftype T [a] M P (hi [_] "hi there")) user.T user=> (satisfies? P (T. 1)) true user=> (satisfies? M (T. 1)) true user=> (hi (T. 1)) "hi there" user=> (defprotocol M2 "marker for 2") ; marker protocol again M2 user=> (extend-type T M2) nil user=> (satisfies? M2 (T. 1)) true ### 2.8 clojure.pprint/print-table output compatible with Emacs Org mode For the convenience of those that use Emacs Org mode, `clojure.pprint/print-table` now prints tables in the form used by that mode. Emacs Org mode has features to make it easy to edit such tables, and even to do spreadsheet-like calculations on their contents. See the [Org mode documentation on tables](http://orgmode.org/manual/Tables.html) for details. user=> (clojure.pprint/print-table [:name :initial-impression] [{:name "Rich" :initial-impression "rock star"} {:name "Andy" :initial-impression "engineer"}]) | :name | :initial-impression | |-------+---------------------| | Rich | rock star | | Andy | engineer | ### 2.9 clojure.string/replace and replace-first handle special characters more predictably `clojure.string/replace` and `clojure.string/replace-first` are now consistent in the way that they handle the replacement strings: all characters in the replacement strings are treated literally, including backslash and dollar sign characters. user=> (require '[clojure.string :as s]) user=> (s/replace-first "munge.this" "." "$") ;=> "munge$this" user=> (s/replace "/my/home/dir" #"/" (fn [s] "\\")) ;=> "\\my\\home\\dir" There is one exception, which is described in the doc strings. If you call these functions with a regex to search for and a string as the replacement, then dollar sign and backslash characters in the replacement string are treated specially. Occurrences of `$1` in the replacement string are replaced with the string that matched the first parenthesized subexpression of the regex, occurrences of `$2` are replaced with the match of the second parenthesized subexpression, etc. user=> (s/replace "x12, b4" #"([a-z]+)([0-9]+)" "$1 <- $2") ;=> "x <- 12, b <- 4" Individual occurrences of `$` or `\` in the replacement string that you wish to be treated literally can be escaped by prefixing them with a `\`. If you wish your replacement string to be treated literally and its contents are unknown to you at compile time (or you don't wish to tarnish your constant string with lots of backslashes), you can use the new function `clojure.string/re-quote-replacement` to do the necessary escaping of special characters for you. user=> (s/replace "x12, b4" #"([a-z]+)([0-9]+)" (s/re-quote-replacement "$1 <- $2")) ;=> "$1 <- $2, $1 <- $2" ### 2.10 Set and map constructor functions allow duplicates All of the functions that construct sets such as `set` and `sorted-set` allow duplicate elements to appear in their arguments, and they are documented to treat this case as if by repeated uses of `conj`. Similarly, all map constructor functions such as `hash-map`, `array-map`, and `sorted-map` allow duplicate keys, and are documented to treat this case as if by repeated uses of `assoc`. As before, literal sets, e.g. `#{1 2 3}`, do not allow duplicate elements, and while elements can be expressions evaluated at run time such as `#{(inc x) (dec y)}`, this leads to a check for duplicates at run time whenever the set needs to be constructed, throwing an exception if any duplicates are found. Similarly, literal maps do not allow duplicate keys. New to Clojure 1.5 is a performance optimization: if all keys are compile time constants but one or more values are expressions requiring evaluation at run time, duplicate keys are checked for once at compile time only, not each time a map is constructed at run time. * [CLJ-1065](http://dev.clojure.org/jira/browse/CLJ-1065) Allow duplicate set elements and map keys for all set and map constructors ### 2.11 More functions preserve metadata Most functions that take a collection and return a "modified" version of that collection preserve the metadata that was on the input collection, e.g. `conj`, `assoc`, `dissoc`, etc. One notable exception was `into`, which would return a collection with metadata `nil` for several common types of input collections. Now the functions `into`, `select-keys`, `clojure.set/project`, and `clojure.set/rename` return collections with the same metadata as their input collections. ### 2.12 New edn reader, improvements to `*read-eval*` The new `clojure.edn` namespace reads edn (http://edn-format.org) data, and should be used for reading data from untrusted sources. Clojure's core read* functions can evaluate code, and should not be used to read data from untrusted sources. As of 1.5, `*read-eval*` supports a documented set of thread-local bindings, see the doc string for details. `*read-eval*`'s default can be set to false by setting a system property: -Dclojure.read.eval=false ## 3 Performance and Memory Enhancements * [CLJ-988](http://dev.clojure.org/jira/browse/CLJ-988) Multimethod tables are now protected by a read/write lock instead of a synchronized method. This should result in a performance boost for multithreaded code using multimethods. * [CLJ-1061](http://dev.clojure.org/jira/browse/CLJ-1061) `when-first` now evaluates its expression only once. * [CLJ-1084](http://dev.clojure.org/jira/browse/CLJ-1084) `PersistentVector$ChunkedSeq` now implements `Counted` interface, to avoid some cases where vector elements were being counted by iterating over their elements. * [CLJ-867](http://dev.clojure.org/jira/browse/CLJ-867) Records with same fields and field values, but different types, now usually hash to different values. * [CLJ-1000](http://dev.clojure.org/jira/browse/CLJ-1000) Cache hasheq() for seqs, sets, vectors, maps and queues * (no ticket) array-map perf tweaks * [CLJ-1111](http://dev.clojure.org/jira/browse/CLJ-1111) Allows loop to evaluate to primitive values * (no ticket) Move loop locals into same clearing context as loop body ## 4 Improved error messages * [CLJ-103](http://dev.clojure.org/jira/browse/CLJ-103) Improved if-let error message when form has a improperly defined body. * [CLJ-897](http://dev.clojure.org/jira/browse/CLJ-897) Don't use destructuring in defrecord/deftype arglists to get a slightly better error message when forgetting to specify the fields vector * [CLJ-788](http://dev.clojure.org/jira/browse/CLJ-788) Add source and line members and getters to CompilerException * [CLJ-157](http://dev.clojure.org/jira/browse/CLJ-157) Better error messages for syntax errors w/ defn and fn * [CLJ-940](http://dev.clojure.org/jira/browse/CLJ-940) Passing a non-sequence to refer :only results in uninformative exception * [CLJ-1052](http://dev.clojure.org/jira/browse/CLJ-1052) `assoc` now throws an exception if the last key argument is missing a value. ## 5 Improved documentation strings * [CLJ-893](http://dev.clojure.org/jira/browse/CLJ-893) Document that vec will alias Java arrays * [CLJ-892](http://dev.clojure.org/jira/browse/CLJ-892) Clarify doc strings of sort and sort-by: they will modify Java array arguments * [CLJ-1019](http://dev.clojure.org/jira/browse/CLJ-1019) ns-resolve doc has a typo * [CLJ-1038](http://dev.clojure.org/jira/browse/CLJ-1038) Docstring for deliver doesn't match behavior * [CLJ-1055](http://dev.clojure.org/jira/browse/CLJ-1055) "be come" should be "become" * [CLJ-917](http://dev.clojure.org/jira/browse/CLJ-917) clojure.core/definterface is not included in the API docs * (no ticket) clojure.core/read, read-string, and *read-eval* all have more extensive documentation. ## 6 Bug Fixes * [CLJ-962](http://dev.clojure.org/jira/browse/CLJ-962) Vectors returned by subvec allow access at negative indices * [CLJ-952](http://dev.clojure.org/jira/browse/CLJ-952) bigdec does not properly convert a clojure.lang.BigInt * [CLJ-975](http://dev.clojure.org/jira/browse/CLJ-975) inconsistent destructuring behaviour when using nested maps * [CLJ-954](http://dev.clojure.org/jira/browse/CLJ-954) TAP support in clojure.test.tap Needs Updating * [CLJ-881](http://dev.clojure.org/jira/browse/CLJ-881) exception when cl-format is given some ~f directive/value combinations * [CLJ-763](http://dev.clojure.org/jira/browse/CLJ-763) Do not check for duplicates in destructuring map creation * [CLJ-667](http://dev.clojure.org/jira/browse/CLJ-667) Allow loops fully nested in catch/finally * [CLJ-768](http://dev.clojure.org/jira/browse/CLJ-768) cl-format bug in ~f formatting * [CLJ-844](http://dev.clojure.org/jira/browse/CLJ-844) NPE calling keyword on map from bean * [CLJ-934](http://dev.clojure.org/jira/browse/CLJ-934) disj! Throws exception when attempting to remove multiple items in one call * [CLJ-943](http://dev.clojure.org/jira/browse/CLJ-943) When load-lib fails, a namespace is still created * [CLJ-981](http://dev.clojure.org/jira/browse/CLJ-981) clojure.set/rename-keys deletes keys when there's a collision * [CLJ-961](http://dev.clojure.org/jira/browse/CLJ-961) with-redefs loses a Var's root binding if the Var is thread-bound * [CLJ-1032](http://dev.clojure.org/jira/browse/CLJ-1032) seque leaks threads from the send-off pool * [CLJ-1041](http://dev.clojure.org/jira/browse/CLJ-1041) reduce-kv on sorted maps should stop on seeing a Reduced value * [CLJ-1011](http://dev.clojure.org/jira/browse/CLJ-1011) clojure.data/diff should cope with null and false values in maps * [CLJ-977](http://dev.clojure.org/jira/browse/CLJ-977) (int \a) returns a value, (long \a) throws an exception * [CLJ-964](http://dev.clojure.org/jira/browse/CLJ-964) test-clojure/rt.clj has undeclared dependency on clojure.set * [CLJ-923](http://dev.clojure.org/jira/browse/CLJ-923) Reading ratios prefixed by + is not working * [CLJ-1012](http://dev.clojure.org/jira/browse/CLJ-1012) partial function should also accept 1 arg (just f) * [CLJ-932](http://dev.clojure.org/jira/browse/CLJ-932) contains? Should throw exception on non-keyed collections * [CLJ-730](http://dev.clojure.org/jira/browse/CLJ-730) Create test suite for functional fns (e.g. juxt, comp, partial, etc.) * [CLJ-757](http://dev.clojure.org/jira/browse/CLJ-757) Empty transient maps/sets return wrong value for .contains * [CLJ-828](http://dev.clojure.org/jira/browse/CLJ-828) clojure.core/bases returns a cons when passed a class and a Java array when passed an interface * [CLJ-1062](http://dev.clojure.org/jira/browse/CLJ-1062) CLJ-940 breaks compilation of namespaces that don't have any public functions * [CLJ-1070](http://dev.clojure.org/jira/browse/CLJ-1070) PersistentQueue's hash function does not match its equality * [CLJ-987](http://dev.clojure.org/jira/browse/CLJ-987) pprint doesn't flush the underlying stream * [CLJ-963](http://dev.clojure.org/jira/browse/CLJ-963) Support pretty printing namespace declarations under code-dispatch * [CLJ-902](http://dev.clojure.org/jira/browse/CLJ-902) doc macro broken for namespaces * [CLJ-909](http://dev.clojure.org/jira/browse/CLJ-909) Make LineNumberingPushbackReader's buffer size configurable * [CLJ-910](http://dev.clojure.org/jira/browse/CLJ-910) Allow for type-hinting the method receiver in memfn * [CLJ-1048](http://dev.clojure.org/jira/browse/CLJ-1048) add test.generative to Clojure's tests * [CLJ-1071](http://dev.clojure.org/jira/browse/CLJ-1071) ExceptionInfo does no abstraction * [CLJ-1085](http://dev.clojure.org/jira/browse/CLJ-1085) clojure.main/repl unconditionally refers REPL utilities into `*ns*` * (no ticket) Rich Hickey fix: syntax-quote was walking records, returning maps * [CLJ-1116](http://dev.clojure.org/jira/browse/CLJ-1116) More REPL-friendly 'ns macro * (no ticket) Rich Hickey fix: deref any j.u.c.Future * [CLJ-1092](http://dev.clojure.org/jira/browse/CLJ-1092) New function re-quote-replacement has incorrect :added metadata * [CLJ-1098](http://dev.clojure.org/jira/browse/CLJ-1098) Implement IKVReduce and CollFold for nil * (no ticket) Rich Hickey fix: impose once semantics on fabricated closures for e.g. loops * [CLJ-1140](http://dev.clojure.org/jira/browse/CLJ-1140) Restore {:as x} destructuring for empty lists * [CLJ-1150](http://dev.clojure.org/jira/browse/CLJ-1150) Make some PersistentVector's and APersistentVector.SubVector's internals public * (no ticket) Rich Hickey fix: use non-loading classForName * [CLJ-1106](http://dev.clojure.org/jira/browse/CLJ-1106) Fixing set equality ## 7 Binary Compatibility Notes * `public static inner class LispReader.ReaderException(int line, Throwable cause)` Constructor changed to `ReaderException(int line, int column, Throwable cause)` * `public Object clojure.lang.Agent.dispatch(IFn fn, ISeq args, boolean solo)` Replaced with `dispatch(IFn fn, ISeq args, Executor exec)` # Changes to Clojure in Version 1.4 ## CONTENTS 
 1 Deprecated and Removed Features
    1.1 Fields that Start With a Dash Can No Longer Be Accessed Using Dot Syntax
 2 New/Improved Features
    2.1 Reader Literals
    2.2 clojure.core/mapv
    2.3 clojure.core/filterv
    2.4 clojure.core/ex-info and clojure.core/ex-data
    2.5 clojure.core/reduce-kv
    2.6 clojure.core/contains? Improved
    2.7 clojure.core/min and clojure.core/max prefer NaN
    2.8 clojure.java.io/as-file and clojure.java.io/as-url Handle URL-Escaping Better
    2.9 New Dot Syntax for Record and Type Field Access
    2.10 Record Factory Methods Available Inside defrecord
    2.11 assert-args Displays Namespace and Line Number on Errors
    2.12 File and Line Number Added to Earmuff Dynamic Warning
    2.13 require Can Take a :refer Option
    2.14 *compiler-options* Var
    2.15 Improved Reporting of Invalid Characters in Unicode String Literals
    2.16 clojure.core/hash No Longer Relies on .hashCode
    2.17 Java 7 Documentation
    2.18 loadLibrary Loads Library Using System ClassLoader
    2.19 Java int is boxed as java.lang.Integer
 3 Performance Enhancements
 4 Bug Fixes
## 1 Deprecated and Removed Features ### 1.1 Record and Type Fields that Start With a Dash Can No Longer Be Accessed Using Dot Syntax Clojure 1.4 introduces a field accessor syntax for the dot special form that aligns Clojure field lookup syntax with ClojureScript's. For example, in Clojure 1.3, one can declare a record with a field starting with dash and access it like this: (defrecord Bar [-a]) ;=> user.Bar (.-a (Bar. 10)) ;=> 10 In 1.4, the above code results in `IllegalArgumentException No matching field found: a for class user.Bar` However, the field may still be accessed as a keyword: (:-a (Bar. 10)) ;=> 10 ## 2 New and Improved Features ### 2.1 Reader Literals Clojure 1.4 supports reader literals, which are data structures tagged by a symbol to denote how they will be read. When Clojure starts, it searches for files named `data_readers.clj` at the root of the classpath. Each such file must contain a Clojure map of symbols, like this: {foo/bar my.project.foo/bar foo/baz my.project/baz} The key in each pair is a tag that will be recognized by the Clojure reader. The value in the pair is the fully-qualified name of a Var which will be invoked by the reader to parse the form following the tag. For example, given the data_readers.clj file above, the Clojure reader would parse this form: #foo/bar [1 2 3] by invoking the Var `#'my.project.foo/bar` on the vector `[1 2 3]`. The data reader function is invoked on the form AFTER it has been read as a normal Clojure data structure by the reader. Reader tags without namespace qualifiers are reserved for Clojure. Default reader tags are defined in `clojure.core/default-data-readers` but may be overridden in `data_readers.clj` or by rebinding `*data-readers*`. #### 2.1.1 Instant Literals Clojure supports literals for instants in the form `#inst "yyyy-mm-ddThh:mm:ss.fff+hh:mm"`. These literals are parsed as `java.util.Date`s by default. They can be parsed as `java.util.Calendar`s or `java.util.Timestamp`s by binding `*data-readers*` to use `clojure.instant/read-instant-calendar` or `clojure.instant/read-instant-timestamp`. (def instant "#inst \"@2010-11-12T13:14:15.666\"") ; Instants are read as java.util.Date by default (= java.util.Date (class (read-string instant))) ;=> true ; Instants can be read as java.util.Calendar or java.util.Timestamp (binding [*data-readers* {'inst read-instant-calendar}] (= java.util.Calendar (class (read-string instant)))) ;=> true (binding [*data-readers* {'inst read-instant-timestamp}] (= java.util.Timestamp (class (read-string instant)))) ;=> true #### 2.1.2 UUID Literals Clojure supports literals for UUIDs in the form `#uuid "uuid-string"`. These literals are parsed as `java.util.UUID`s. ### 2.2 clojure.core/mapv `mapv` takes a function `f` and one or more collections and returns a vector consisting of the result of applying `f` to the set of first items of each collection, followed by applying `f` to the set of second items in each collection, until any one of the collections is exhausted. Any remaining items in other collections are ignored. `f` should accept a number of arguments equal to the number of collections. (= [1 2 3] (mapv + [1 2 3])) ;=> true (= [2 3 4] (mapv + [1 2 3] (repeat 1))) ;=> true ### 2.3 clojure.core/filterv `filterv` takes a predicate `pred` and a collection and returns a vector of the items in the collection for which `(pred item)` returns true. `pred` must be free of side-effects. (= [] (filterv even? [1 3 5])) ;=> true (= [2 4] (filterv even? [1 2 3 4 5])) ;=> true ### 2.4 clojure.core/ex-info and clojure.core/ex-data `ex-info` creates an instance of `ExceptionInfo`. `ExceptionInfo` is a `RuntimeException` subclass that takes a string `msg` and a map of data. (ex-info "Invalid use of robots" {:robots false}) ;=> # `ex-data` is called with an exception and will retrieve that map of data if the exception is an instance of `ExceptionInfo`. (ex-data (ex-info "Invalid use of robots" {:robots false})) ;=> {:robots false} ### 2.5 clojure.core/reduce-kv `reduce-kv` reduces an associative collection. It takes a function `f`, an initial value `init` and an associative collection `coll`. `f` should be a function of 3 arguments. Returns the result of applying `f` to `init`, the first key and the first value in `coll`, then applying `f` to that result and the 2nd key and value, etc. If `coll` contains no entries, returns `init` and f is not called. Note that `reduce-kv` is supported on vectors, where the keys will be the ordinals. (reduce-kv str "Hello " {:w \o :r \l :d \!}) ;=> "Hello :rl:d!:wo" (reduce-kv str "Hello " [\w \o \r \l \d \!]) ;=> "Hello 0w1o2r3l4d5!" ### 2.6 clojure.core/contains? Improved `contains?` now works with `java.util.Set`. ### 2.7 clojure.core/min and clojure.core/max prefer NaN `min` and `max` now give preference to returning NaN if either of their arguments is NaN. ### 2.8 clojure.java.io/as-file and clojure.java.io/as-url Handle URL-Escaping Better `as-file` and `as-url` now handle URL-escaping in both directions. ### 2.9 New Dot Syntax for Record and Type Field Access Clojure 1.4 introduces a field accessor syntax for the dot special form that aligns Clojure field lookup syntax with ClojureScript's. In 1.4, to declare a record type and access its property `x`, one can write: (defrecord Foo [x]) ;=> user.Foo (.-x (Foo. 10)) ;=> 10 This addition makes it easier to write code that will run as expected in both Clojure and ClojureScript. ### 2.10 Record Factory Methods Available Inside defrecord Prior to 1.4, you could not use the factory functions (`->RecordClass` and `map->RecordClass`) to construct a new record from inside a `defrecord` definition. The following example did not work prior to 1.4, but is now valid. This example makes use of `->Mean` which would have not yet been available. (defrecord Mean [last-winner] Player (choose [_] (if last-winner last-winner (random-choice))) (update-strategy [_ me you] (->Mean (when (iwon? me you) me)))) ### 2.11 assert-args Displays Namespace and Line Number on Errors `assert-args` now uses &form to report the namespace and line number where macro syntax errors occur. ### 2.12 File and Line Number Added to Earmuff Dynamic Warning When a variable is defined using earmuffs but is not declared dynamic, Clojure emits a warning. That warning now includes the file and line number. ### 2.13 require Can Take a :refer Option `require` can now take a `:refer` option. `:refer` takes a list of symbols to refer from the namespace or `:all` to bring in all public vars. ### 2.14 \*compiler-options\* Var The dynamic var `*compiler-options*` contains a map of options to send to the Clojure compiler. Supported options: * `:elide-meta`: Have certain metadata elided during compilation. This should be set to a collection of keywords. * `:disable-locals-clearing`: Set to true to disable clearing. Useful for using a debugger. The main function of the Clojure compiler sets the `*compiler-options*` from properties prefixed by `clojure.compiler`, e.g. java -Dclojure.compiler.elide-meta='[:doc :file :line]' ### 2.15 Improved Reporting of Invalid Characters in Unicode String Literals When the reader finds an invalid character in a Unicode string literal, it now reports the character instead of its numerical representation. ### 2.16 clojure.core/hash No Longer Relies on .hashCode `hash` no longer directly uses .hashCode() to return the hash of a Clojure data structure. It calls `clojure.lang.Util.hasheq`, which has its own implementation for Integer, Short, Byte, and Clojure collections. This ensures that the hash code returned is consistent with `=`. ### 2.17 Java 7 Documentation `*core-java-api*` will now return the URL for the Java 7 Javadoc when you are running Java 7. ### 2.18 loadLibrary Loads Library Using System ClassLoader A static method, `loadLibrary`, was added to `clojure.lang.RT` to load a library using the system ClassLoader instead of Clojure's class loader. ### 2.19 Java int is Boxed As java.lang.Integer Java `int`s are now boxed as `java.lang.Integer`s. See [the discussion on clojure-dev](https://groups.google.com/forum/#!msg/clojure/7-hARL5c1lI/ntnnOweEGfUJ) for more information. ## 3 Performance Enhancements * `(= char char)` is now optimized * `equiv` is inlined in variadic = * `toString` cached on keywords and symbols ## 4 Bug Fixes * [CLJ-829](http://dev.clojure.org/jira/browse/CLJ-829) Transient hashmaps mishandle hash collisions * [CLJ-773](http://dev.clojure.org/jira/browse/CLJ-773) Macros that are expanded away still have their vars referenced in the emitted byte code * [CLJ-837](http://dev.clojure.org/jira/browse/CLJ-837) java.lang.VerifyError when compiling deftype or defrecord with argument name starting with double underscore characters * [CLJ-369](http://dev.clojure.org/jira/browse/CLJ-369) Check for invalid interface method names * [CLJ-845](http://dev.clojure.org/jira/browse/CLJ-845) Unexpected interaction between protocol extension and namespaced method keyword/symbols * Ignoring namespace portion of symbols used to name methods in extend-type and extend-protocol * [CLJ-852](http://dev.clojure.org/jira/browse/CLJ-852) IllegalArgumentException thrown when defining a var whose value is calculated with a primitive fn * [CLJ-855](http://dev.clojure.org/jira/browse/CLJ-855) catch receives a RuntimeException rather than the expected checked exception * [CLJ-876](http://dev.clojure.org/jira/browse/CLJ-876) #^:dynamic vars declared in a nested form are not immediately dynamic * [CLJ-886](http://dev.clojure.org/jira/browse/CLJ-886) java.io/do-copy can garble multibyte characters * [CLJ-895](http://dev.clojure.org/jira/browse/CLJ-895) Collection.toArray implementations do not conform to Java API docs * obey contract for toArray return type * [CLJ-898](http://dev.clojure.org/jira/browse/CLJ-898) Agent sends consume heap * Only capture a shallow copy of the current Frame in binding-conveyor-fn, so that sends in agent actions don't build infinite Frame stacks * [CLJ-928](http://dev.clojure.org/jira/browse/CLJ-928) Instant literal for Date and Timestamp should print in UTC * [CLJ-931](http://dev.clojure.org/jira/browse/CLJ-933) Syntactically broken clojure.test/are tests succeed * [CLJ-933](http://dev.clojure.org/jira/browse/CLJ-933) Compiler warning on clojure.test-clojure.require-scratch # Changes to Clojure in Version 1.3 ## CONTENTS 
 1 Deprecated and Removed Features
    1.1 Earmuffed Vars are No Longer Automatically Considered Dynamic
    1.2 ISeq No Longer Inherits from Sequential
    1.3 Removed Bit Operation Support for Boxed Numbers
    1.4 Ancillary Namespaces No Longer Auto-Load on Startup
    1.5 Replicate Deprecated
 2 New/Improved Features
    2.1 Enhanced Primitive Support
    2.2 defrecord and deftype Improvements
    2.3 Better Exception Reporting
    2.4 clojure.reflect/reflect
    2.5 clojure.data/diff
    2.6 clojure.core/every-pred and clojure.core/some-fn Combinators
    2.7 clojure.core/realized?
    2.8 clojure.core/with-redefs-fn & with-redefs
    2.9 clojure.core/find-keyword
    2.10 clojure.repl/pst
    2.11 clojure.pprint/print-table
    2.12 pprint respects *print-length*
    2.13 compilation and deployment via Maven
    2.14 internal keyword map uses weak refs
    2.15 ^:const defs
    2.16 Message Bearing Assert
    2.17 Error Checking for defmulti Options
    2.18 Removed Checked Exceptions
    2.19 vector-of Takes Multiple Arguments
    2.20 deref with timeout
    2.21 Walk Support for sorted-by Collections
    2.22 string.join Enhanced to Work with Sets
    2.23 clojure.test-helper
    2.24 Newline outputs platform-specific newline sequence
    2.25 init-proxy and update-proxy return proxy
    2.26 doc & find-doc moved to REPL
    2.27 clojure.java.shell/sh accepts as input anything that clojure.java.io/copy does
    2.28 InterruptedHandler Promoted to clojure.repl
    2.29 Add support for running -main namespaces from clojure.main
    2.30 Set thread names on agent thread pools
    2.31 Add docstring support to def
    2.32 Comp function returns identity when called with zero arity
    2.33 Type hints can be applied to arg vectors
    2.34 Binding Conveyance
 3 Performance Enhancements
 4 Bug Fixes
 5 Modular Contrib
## 1 Deprecated and Removed Features ### 1.1 Earmuffed Vars Are No Longer Automatically Considered Dynamic. (def *fred*) => Warning: *fred* not declared dynamic and thus is not dynamically rebindable, but its name suggests otherwise. Please either indicate ^:dynamic ** or change the name. ### 1.2 ISeq No Longer Inherits From Sequential This allows ISeq implementers to be in the map or set equality partition. ### 1.3 Removed Bit Operation Support for Boxed Numbers Bit Operations map directly to primitive operations ### 1.4 Ancillary Namespaces No Longer Auto-Load on Startup The following namespaces are no longer loaded on startup: clojure.set, clojure.xml, clojure.zip ### 1.5 Replicate Deprecated Use repeat instead. ## 2 New/Improved Features ### 2.1 Enhanced Primitive Support Full details here: - [Enhanced Primitive Support][EPS] - [Documentation for 1.3 Numerics][NUM] [EPS]: http://dev.clojure.org/display/doc/Enhanced+Primitive+Support [NUM]: http://dev.clojure.org/display/doc/Documentation+for+1.3+Numerics ### 2.2 defrecord and deftype Improvements Details here: [Defrecord Improvements](http://dev.clojure.org/display/design/defrecord+improvements) ### 2.3 Better Exception Reporting Details here: [Error Handling](http://dev.clojure.org/display/design/Error+Handling) Additionally: Better error messages: * When calling macros with arity * For Invalid Map Literals * For alias function if using unknown namespace * In the REPL * Add "starting at " to EOF while reading exceptions * Better compilation error reporting ### 2.4 clojure.reflect/reflect Full details here: [Reflection API](http://dev.clojure.org/display/design/Reflection+API) ### 2.5 clojure.data/diff Recursively compares a and b, returning a tuple of [things-only-in-a things-only-in-b things-in-both] (diff {:a 1 :b 2} {:a 1 :b 22 :c 3}) => ({:b 2} {:c 3, :b 22} {:a 1}) ### 2.6 clojure.core/every-pred and clojure.core/some-fn Combinators every-pred takes a set of predicates and returns a function f that returns true if all of its composing predicates return a logical true value against all of its arguments, else it returns false. ((every-pred even?) 2 4 6) => true ((every-pred even?) 2 4 5) =>false some-fn takes a set of predicates and returns a function f that returns the first logical true value returned by one of its composing predicates against any of its arguments, else it returns logical false. ((some-fn even?) 2 4 5) => true ((some-fn odd?) 2 4 6) => false ### 2.7 clojure.core/realized? Returns true if a value has been produced for a promise, delay, future or lazy sequence. (let [x (range 5)] (println (realized? x)) (first x) (println (realized? x))) => false => true ### 2.8 clojure.core/with-redefs-fn & clojure.core/with-redefs with-redefs-fn temporarily redefines Vars during a call to func. with-redefs temporarily redefines Vars while executing the body. (with-redefs [nil? :temp] (println nil?)) => :temp ### 2.9 clojure.core/find-keyword Returns a Keyword with the given namespace and name if one already exists. (find-keyword "def") => :def (find-keyword "fred") => nil ### 2.10 clojure.repl/pst Prints a stack trace of the exception (pst (IllegalArgumentException.)) IllegalArgumentException user/eval27 (NO_SOURCE_FILE:18) clojure.lang.Compiler.eval (Compiler.java:6355) clojure.lang.Compiler.eval (Compiler.java:6322) clojure.core/eval (core.clj:2699) clojure.main/repl/read-eval-print--5906 (main.clj:244) clojure.main/repl/fn--5911 (main.clj:265) clojure.main/repl (main.clj:265) clojure.main/repl-opt (main.clj:331) clojure.main/main (main.clj:427) clojure.lang.Var.invoke (Var.java:397) clojure.lang.Var.applyTo (Var.java:518) clojure.main.main (main.java:37) ### 2.11 clojure.pprint/print-table Prints a collection of maps in a textual table. (print-table [:fred :barney] [{:fred "ethel"} {:fred "wilma" :barney "betty"}]) =============== :fred | :barney =============== ethel | wilma | betty =============== ### 2.12 pprint respects \*print-length\* Assigning \*print-length\* now affects output of pprint ### 2.13 compilation and deployment via Maven See the following pages for more information: - [Maven Settings and Repositories][MSR] - [Why Maven?][WM] - [Common Contrib Build][CCB] - [How to Make Releases][HMR] [MSR]: http://dev.clojure.org/display/doc/Maven+Settings+and+Repositories [WM]: http://dev.clojure.org/pages/viewpage.action?pageId=950842 [CCB]: http://dev.clojure.org/display/design/Common+Contrib+Build [HMR]:http://dev.clojure.org/display/design/How+to+Make+Releases ### 2.14 internal keyword map uses weak refs ### 2.15 ^:const defs ^:const lets you name primitive values with speedier reference. (def constants {:pi 3.14 :e 2.71}) (def ^:const pi (:pi constants)) (def ^:const e (:e constants)) The overhead of looking up :e and :pi in the map happens at compile time, as (:pi constants) and (:e constants) are evaluated when their parent def forms are evaluated. ### 2.16 Message Bearing Assert Assert can take a second argument which will be printed when the assert fails (assert (= 1 2) "1 is not equal to 2") => AssertionError Assert failed: 1 is not equal to 2 ### 2.17 Error Checking for defmulti Options defmulti will check to verify that its options are valid. For example, the following code will throw an exception: (defmulti fred :ethel :lucy :ricky) => IllegalArgumentException ### 2.18 Removed Checked Exceptions Clojure does not throw checked exceptions ### 2.19 vector-of Takes Multiple Args vector-of takes multiple args used to populate the array (vector-of :int 1 2 3) => [1 2 3] ### 2.20 deref with timeout deref now takes a timeout option - when given with a blocking reference, will return the timeout-val if the timeout (in milliseconds) is reached before value is available. (deref (promise) 10 :ethel) => :ethel ### 2.21 Walk Support for sorted-by Collections Walk modified to work on sorted-by collections let [x (sorted-set-by > 1 2 3)] (walk inc reverse x)) => (2 3 4) ### 2.22 string.join Enhanced to Work with Sets Just like join works on other collections (join " and " #{:fred :ethel :lucy}) => ":lucy and :fred and :ethel" ### 2.23 clojure.test-helper All test helpers moved into clojure.test-helper ### 2.24 Newline outputs platform-specific newline sequence Newline sequence is output as \r\n on Windows now. ### 2.25 init-proxy and update-proxy return proxy Now you can chain calls on the proxy ### 2.26 doc & find-doc moved to REPL Adds special form docs to the REPL ### 2.27 clojure.java.shell/sh accepts as input anything that clojure.java.io/copy does This adds InputStream, Reader, File, byte[] to the list of inputs for clojure.java.shell/sh ### 2.28 Interrupt Handler Promoted to clojure.repl Promoting this library eliminates the need for a dependency on old contrib. ### 2.29 Add support for running -main namespaces from clojure.main This patch allows clojure.main to accept an argument pointing to a namespace to look for a -main function in. This allows users to write -main functions that will work the same whether the code is AOT-compiled for use in an executable jar or just run from source. ### 2.30 Set thread names on agent thread pools It's a best practice to name the threads in an executor thread pool with a custom ThreadFactory so that the purpose of these threads is clear in thread dumps and other runtime operational tools. Patch causes thread names like: clojure-agent-send-pool-%d (should be fixed # of threads) clojure-agent-send-off-pool-%d (will be added and removed over time) ### 2.31 Add docstring support to def A def can now have a docstring between name and value. (def foo "a foo" :foo) ### 2.32 Comp function returns identity when called with zero arity (= (comp) identity) => true ### 2.33 Type hints can be applied to arg vectors You can hint different arities separately: (defn hinted (^String []) (^Integer [a]) (^java.util.List [a & args])) This is preferred over hinting the function name. Hinting the function name is still allowed for backward compatibility, but will likely be deprecated in a future release. ### 2.34 Binding Conveyance Clojure APIs that pass work off to other threads (e.g. send, send-off, pmap, future) now convey the dynamic bindings of the calling thread: (def ^:dynamic *num* 1) (binding [*num* 2] (future (println *num*))) ;; prints "2", not "1" ## 3 Performance Enhancements * Code path for using vars is now much faster for the common case * Improved startup time * Fix performance on some numeric overloads See [CLJ-380](http://dev.clojure.org/jira/browse/CLJ-5) for more information * Promises are lock free * Functions only get metadata support code when metadata explicitly supplied * definterface/gen-interface accepts array type hints * inline nil? * inline bit-functions & math ops * inline n-ary min & max * PersistentQueue count is now O(1) * Intrinsics: unchecked math operators now emit bytecodes directly where possible ## 4 Bug Fixes [Complete list of Tickets for 1.3 Release][ISSUES]. [ISSUES]: http://dev.clojure.org/jira/secure/IssueNavigator.jspa?mode=hide&requestId=10052 * [CLJ-8](http://dev.clojure.org/jira/browse/CLJ-8) detect and report cyclic load dependencies * Patch restore detection of cyclic load dependencies * [CLJ-31](http://dev.clojure.org/jira/browse/CLJ-31) compiler now correctly rejects attempts to recur across try (fn [x] (try (recur 1))) => CompilerException * [CLJ-286](http://dev.clojure.org/jira/browse/CLJ-286) \*out\* being used as java.io.PrintWriter * Patch fixes using Writer instead of PrintWriter * fix clojure.main to not assume that *err* is a PrintWriter * [CLJ-292](http://dev.clojure.org/jira/browse/CLJ-292) LazySeq.sval() nests RuntimeExceptions * Patch causes only the original RuntimeException to be thrown * [CLJ-390](http://dev.clojure.org/jira/browse/CLJ-390) sends from agent error-handlers should be allowed * Patch allows agent error-handler to send successfully * [CLJ-426](http://dev.clojure.org/jira/browse/CLJ-426) case should handle hash collision * There were situations where a hash collision would occur with case and an exception would be thrown. See [discussion](https://groups.google.com/d/topic/clojure/m4ZDWKSfmfo/discussion) for more details * [CLJ-430](http://dev.clojure.org/jira/browse/CLJ-430) clojure.java.io URL Coercion throws java.lang.ClassCastException * Patch correct exception to be thrown * [CLJ-432](http://dev.clojure.org/jira/browse/CLJ-432) deftype does not work if containing ns contains dashes * Patch munges namespaces with dashes properly * [CLJ-433](http://dev.clojure.org/jira/browse/CLJ-433) munge should not munge $ (which isJavaIdentifierPart), should munge ' (which is not) * [CLJ-435](http://dev.clojure.org/jira/browse/CLJ-435) stackoverflow exception in printing meta with :type * Patch fixes exception being thrown on certain type metadata (with-meta {:value 2} {:type Object}) => No message. [Thrown class java.lang.StackOverflowError] * [CLJ-437](http://dev.clojure.org/jira/browse/CLJ-437) Bugs in clojure.set/subset? and superset? for sets with false/nil elements * Patch fixes failing on subset? and superset? for sets with false/nil elements * [CLJ-439](http://dev.clojure.org/jira/browse/CLJ-439) Automatic type translation from Integer to Long * Patch fixes increase coercion from Integer to Long * [CLJ-444](http://dev.clojure.org/jira/browse/CLJ-444) Infinite recursion in Keyword.intern leads to stack overflow * No more infinite recursion with patch * [CLJ-673](http://dev.clojure.org/jira/browse/CLJ-673) use system class loader when base loader is null * facilitates placing Clojure on bootclasspath * [CLJ-678](http://dev.clojure.org/jira/browse/CLJ-678) into-array should work with all primitive types * [CLJ-680](http://dev.clojure.org/jira/browse/CLJ-680) printing promises should not block * Patch allows printing of promises without blocking * [CLJ-682](http://dev.clojure.org/jira/browse/CLJ-682) cl-format: ~w throws an exception when not wrapped in a pretty-writer * Patch fixes the following bug in cl-format with ~w: * [CLJ-693](http://dev.clojure.org/jira/browse/CLJ-693) VerifyError with symbol metadata, macros, and defrecord * [CLJ-702](http://dev.clojure.org/jira/browse/CLJ-702) case gives NPE when used with nil * Patch allows nil to be used with case * [CLJ-734](http://dev.clojure.org/jira/browse/CLJ-734) starting scope of let bindings seems incorrect from jdi perspective * Patch fixes local variables table to have the correct code index for let bindings. * [CLJ-739](http://dev.clojure.org/jira/browse/CLJ-739) version.properties file is not closed * Patch properly closes version.properties file * [CLJ-751](http://dev.clojure.org/jira/browse/CLJ-751) cl-format: ~( throws an exception with an empty string * Patch fixes the following bug in cl-format when format is nil (cl-format nil "~:(~a~)" "") => NullPointerException * [CLJ-780](http://dev.clojure.org/jira/browse/CLJ-780) race condition in reference cache on Java 5 * Map.Entry instances can have null values prior to Java 6. This patch provides a workaround. * floats were being boxed as Doubles, now they are boxed as Floats * several "holding onto head" fixes * Stop top-level defs from hanging onto the head of an expression that uses a lazy seq * Stop multimethods from holding onto heads of their arguments ## 5 Modular Contrib In 1.3, the monolithic clojure-contrib.jar has been replaced by a modular system of contrib libraries, so that production systems can include only the code they actually need. This also allows individual contribs to have their own release cycles. Many contribs have moved forward by several point versions already. Documentation for updating applications to use the new contrib libraries is at http://dev.clojure.org/display/design/Where+Did+Clojure.Contrib+Go Important Note: Many of the new modular contribs are compatible with both 1.2 and 1.3. This offers an incremental migration path: First, upgrade your contrib libraries while holding Clojure at 1.2, Then, in a separate step, upgrade to Clojure 1.3. ================================================ FILE: clojure.iml ================================================ ================================================ FILE: doc/clojure/pprint/CommonLispFormat.markdown ================================================ # A Common Lisp-compatible Format Function cl-format is an implementation of the incredibly baroque Common Lisp format function as specified in [Common Lisp, the Language, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000). Format gives you an easy and powerful way to format text and data for output. It supports rich formatting of strings and numbers, loops, conditionals, embedded formats, etc. It is really a domain-specific language for formatting. This implementation for clojure has the following goals: * Support the full feature set of the Common Lisp format function (including the X3J13 extensions) with the only exception being concepts that make no sense or are differently interpreted in Clojure. * Make porting code from Common Lisp easier. * Provide a more native feeling solution for Clojure programmers than the Java format method and its relatives. * Be fast. This includes the ability to precompile formats that are going to be used repetitively. * Include useful error handling and comprehensive documentation. ## Why would I use cl-format? For some people the answer to this question is that they are used to Common Lisp and, therefore, they already know the syntax of format strings and all the directives. A more interesting answer is that cl-format provides a way of rendering strings that is much more suited to Lisp and its data structures. Because iteration and conditionals are built into the directive structure of cl-format, it is possible to render sequences and other complex data structures directly without having to loop over the data structure. For example, to print the elements of a sequence separated by commas, you simply say: (cl-format true "~{~a~^, ~}" aseq) (This example is taken from [Practical Common Lisp](http://www.gigamonkeys.com/book/) by Peter Seibel.) The corresponding output using Clojure's Java-based _format_ function would involve a nasty loop/recur with some code to figure out about the commas. Yuck! ## Current Status of cl-format cl-format is 100% compatible with the Common Lisp standard as specified in CLtLv2. This includes all of the functionality of Common Lisp's format function including iteration, conditionals, text justification and rich options for displaying real and integer values. It also includes the directives to support pretty printing structured output. If you find a bug in a directive, drop me a line with a chunk of code that exhibits the bug and the version of cl-format you found it in and I'll try to get it fixed. I also intend to have good built-in documentation for the directives, but I haven't built that yet. The following directives are not yet supported: ~:T and ~@:T (but all other forms of ~T work) and extensions with ~/. The pretty printer interface is similar, but not identical to the interface in Common Lisp. Next up: * Support for ~/ * True compiled formats * Restructure unit tests into modular chunks. * Import tests from CLISP and SBCL. * Unit tests for exception conditions. * Interactive documentation ## How to use cl-format ### Loading cl-format in your program Once cl-format is in your path, adding it to your code is easy: (ns your-namespace-here (:use [clojure.pprint :only (cl-format)])) If you want to refer to the cl-format function as "format" (rather than using the clojure function of that name), you can use this idiom: (ns your-namespace-here (:refer-clojure :exclude [format]) (:use clojure.pprint)) (def format cl-format) You might want to do this in code that you've ported from Common Lisp, for instance, or maybe just because old habits die hard. From the REPL, you can grab it using (use): (use 'clojure.pprint) ### Calling cl-format cl-format is a standard clojure function that takes a variable number of arguments. You call it like this: (cl-format stream format args...) _stream_ can be any Java Writer (that is java.io.Writer) or the values _true_, _false_, or _nil_. The argument _true_ is identical to using `*`out`*` while _false_ or _nil_ indicate that cl-format should return its result as a string rather than writing it to a stream. _format_ is either a format string or a compiled format (see below). The format string controls the output that's written in a way that's similar to (but much more powerful than) the standard Clojure API format function (which is based on Java's java.lang.String.Format). Format strings consist of characters that are to be written to the output stream plus directives (which are marked by ~) as in "The answer is ~,2f". Format strings are documented in detail in [*Common Lisp the Language*, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000). _args_ is a set of arguments whose use is defined by the format. ## Using column aware streams across format invocations Writers in Java have no real idea of current column or device page width, so the format directives that want to work relative to the current position on the page have nothing to work with. To deal with this, cl-format contains an extension to writer called pretty-writer. A pretty-writer watches the output and keeps track of what column the current output is going to. When you call format and your format includes a directive that cares about what column it's in (~T, ~&, ~<...~>), cl-format will automatically wrap the Writer you passed in with a pretty-writer. This means that by default all cl-format statements act like they begin on a fresh line and have a page width of 72. For many applications, these assumptions are fine and you need to do nothing more. But sometimes you want to use multiple cl-format calls that output partial lines. You may also want to mix cl-format calls with the native clojure calls like print. If you want stay column-aware while doing this you need to create a pretty-writer of your own (and possibly bind it to `*`out`*`). As an example of this, this function takes a nested list and prints it as a table (returning the result as a string): (defn list-to-table [aseq column-width] (let [string-writer (java.io.StringWriter.) stream (get-pretty-writer string-writer)] (binding [*out* stream] (doseq [row aseq] (doseq [col row] (cl-format true "~4D~7,vT" col column-width)) (prn))) (.flush stream) (.toString string-writer))) (In reality, you'd probably do this as a single call to cl-format.) The get-pretty-writer function takes the Writer to wrap and (optionally) the page width (in columns) for use with ~<...~>. ## Examples The following function uses cl-format to dump a columnized table of the Java system properties: (defn show-props [stream] (let [p (mapcat #(vector (key %) (val %)) (sort-by key (System/getProperties)))] (cl-format stream "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}" "Property" "Value" ["" "" "" ""] p))) There are some more examples in the pretty print examples gallery at http://github.com/tomfaulhaber/pprint-examples: * hexdump - a program that uses cl-format to create a standard formatted hexdump of the requested stream. * multiply - a function to show a formatted multiplication table in a very "first-order" way. * props - the show-props example shown above. * show_doc - some utilities for showing documentation from various name spaces. ## Differences from the Common Lisp format function The floating point directives that show exponents (~E, ~G) show E for the exponent character in all cases (unless overridden with an _exponentchar_). Clojure does not distinguish between floats and doubles in its printed representation and neither does cl-format. The ~A and ~S directives accept the colon prefix, but ignore it since () and nil are not equivalent in Clojure. Clojure has 3 different reader syntaxes for characters. The ~@c directive to cl-format has an argument extension to let you choose: * ~@c (with no argument) prints "\c" (backslash followed by the printed representation of the character or \newline, \space, \tab, \backspace, \return) * ~'o@c prints "\oDDD" where DDD are the octal digits representing the character. * ~'u@c prints "\uXXXX" prints the hex Unicode representation of the character. ================================================ FILE: doc/clojure/pprint/PrettyPrinting.markdown ================================================ # A Pretty Printer for Clojure ## Overview This namespace adds a new feature to Clojure: a generalized pretty printer. The pretty printer is easy to use: user=> (println (for [x (range 10)] (range x))) (() (0) (0 1) (0 1 2) (0 1 2 3) (0 1 2 3 4) (0 1 2 3 4 5) (0 1 2 3 4 5 6) (0 1 2 3 4 5 6 7) (0 1 2 3 4 5 6 7 8)) nil user=> (use 'clojure.pprint) nil user=> (pprint (for [x (range 10)] (range x))) (() (0) (0 1) (0 1 2) (0 1 2 3) (0 1 2 3 4) (0 1 2 3 4 5) (0 1 2 3 4 5 6) (0 1 2 3 4 5 6 7) (0 1 2 3 4 5 6 7 8)) nil user=> The pretty printer supports two modes: _code_ which has special formatting for special forms and core macros and _simple_ (the default) which formats the various Clojure data structures as appropriate for raw data. In fact, the pretty printer is highly customizable, but basic use is pretty simple. All the functions and variables described here are in the clojure.pprint namespace. Using them is as simple as adding a `(:use clojure.pprint)` to your namespace declarations. Or, better practice would be `(:use [clojure.pprint :only ()])`. pprint is being developed by Tom Faulhaber (to mail me you can use my first name at my domain which is infolace.com). As with the rest of Clojure, the pretty printer is licensed under the [http://opensource.org/licenses/eclipse-1.0.php Eclipse Public License 1.0]. Future development is guided by those using it, so send feedback about what's working and not working for you and what you'd like to see in the pretty printer. ## Pretty Printing Basics Pretty printing is primarily implemented with the function pprint. pprint takes a single argument and formats it according to the settings of several special variables. Generally, the defaults are fine for pretty printing and you can simply use: (pprint obj) to print your object. If you wish to write to another stream besides `*`out`*`, you can use: (write obj :pretty true :stream foo) where foo is the stream to which you wish to write. (The write function has a lot more options which are not yet documented. Stay tuned.) When at the REPL, the pp macro pretty prints the last output value. This is useful when you get something too complex to read comfortably. Just type: user=> (pp) and you'll get a pretty printed version of the last thing output (the magic variable `*`1). ## Dispatch tables and code formatting The behavior of the pretty printer can be finely controlled through the use of _dispatch tables_ that contain descriptions for how different structures should be formatted. Using custom dispatch tables, the pretty printer can create formatted output for data structures that is customized for the application. This allows pretty printing to be baked into any structured output. For information and examples, see below in [#Custom_Dispatch_Functions Custom Dispatch Functions]. The pretty printer comes with two pre-defined dispatch tables to cover the most common situations: `*`simple-dispatch`*` - supports basic representation of data in various Clojure structures: seqs, maps, vectors, etc. in a fairly standard way. When structures need to be broken across lines, following lines are indented to line up with the first element. `*`simple-dispatch`*` is the default and is good for showing the output of most operations. `*`code-dispatch`*` - has special representation for various structures found in code: defn, condp, binding vectors, anonymous functions, etc. This dispatch indents following lines of a list one more space as appropriate for a function/argument type of list. An example formatted with code dispatch: user=> (def code '(defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator)))) #'user/code user=> (with-pprint-dispatch *code-dispatch* (pprint code)) (defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))) nil user=> There are three ways to set the current dispatch: set it to a specific table permanently with set-pprint-dispatch, bind it with with-pprint-dispatch (as shown in the example above), or use the :dispatch keyword argument to write. ## Control variables The operation of pretty printing is also controlled by a set of variables that control general parameters of how the pretty printer makes decisions. The current list is as follows: *`*`print-pretty`*`*: Default: *true* Bind to true if you want write to use pretty printing. (pprint and pp automatically bind this to true.) *`*`print-right-margin`*`*: Default: *72* Pretty printing will try to avoid anything going beyond this column. *`*`print-miser-width`*`*: Default: *40* The column at which to enter miser style. Depending on the dispatch table, miser style add newlines in more places to try to keep lines short allowing for further levels of nesting. For example, in the code dispatch table, the pretty printer will insert a newline between the "if" and its condition when in miser style. *`*`print-suppress-namespaces`*`*: Default: *false* Don't print namespaces with symbols. This is particularly useful when pretty printing the results of macro expansions *`*`print-level`*`*: Default: *nil* As with the regular Clojure print function, this variable controls the depth of structure that is printed. The argument itself is level 0, the first level of a collection is level 1, etc. When the structure gets deeper than the specified `*`print-level`*`, a hash sign (#) is printed. For example: user=> (binding [*print-level* 2] (pprint '(a b (c d) ((e) ((f d) g))))) (a b (c d) (# #)) nil user=> *`*`print-length`*`*: Default: *nil* As with the regular Clojure print function, this variable controls the number of items that are printed at each layer of structure. When a layer has too many items, ellipses (...) are displayed. For example: user=> (defn foo [x] (for [i (range x) ] (range 1 (- x (dec i))))) #'user/foo user=> (binding [*print-length* 6] (pprint (foo 10))) ((1 2 3 4 5 6 ...) (1 2 3 4 5 6 ...) (1 2 3 4 5 6 ...) (1 2 3 4 5 6 ...) (1 2 3 4 5 6) (1 2 3 4 5) ...) nil user=> ## Custom Dispatch Functions Using custom dispatch, you can easily create your own formatted output for structured data. Examples included with the pretty printer show how to use custom dispatch to translate simple Clojure structures into nicely formatted JSON and XML. ### Basic Concepts of Pretty Printing In order to create custom dispatch functions, you need to understand the fundamentals of pretty printing. The clojure pretty printer is based on the XP pretty printer algorithm (used in many Lisps including Common Lisp) which supports sophisticated decision-making about line breaking and indentation with reasonable performance even for very large structures. The XP algorithm is documented in the paper, [http://dspace.mit.edu/handle/1721.1/6504 XP. A Common Lisp Pretty Printing System]. The Clojure implementation of XP is similar in spirit to the Common Lisp implementation, but the details of the interface are somewhat different. The result is that writing custom dispatch in Clojure is more "Clojure-y." There are three key concepts to understand when creating custom pretty printing functions: _logical blocks_, _conditional newlines_, and _indentation_. A _logical block_ marks a set of output that should be thought about as a single unit by the pretty printer. Logical blocks can contain other logical blocks (that is, they nest). As a simple example, when printing list structure, every sublist will typically be a logical block. _Conditional newlines_ tell the pretty printer where it can insert line breaks and how to make the decisions about when to do it. There are four types of conditional newline: * Linear newlines tell the pretty printer to insert a newline in a place whenever the enclosing logical block won't fit on a single line. Linear newlines are an all-or-nothing proposition; if the logical block doesn't fit on a single line, *all* the linear newlines are emitted as actual newlines. * Fill newlines tell the pretty printer that it should fit as many chunks of the logical block as possible on this line and then emit a newline. * Mandatory newlines tell the pretty printer to emit a newline regardless of where it is in the output line. * Miser newlines tell the pretty printer to emit a newline if the output column is in the miser region (as defined by the pretty printer variable `*`pprint-miser-width`*`). This allows you to define special behavior as the output gets heavily nested near the right margin. _Indentation_ commands allow you to specify how wrapped lines should be indented. Indentation can be relative to either the start column of the current logical block or the current column position of the output. (This section is still incomplete...) ## Current limitations and future plans This is an early version release of the pretty printer and there is plenty that is yet to come. Here are some examples: * Support all the types and forms in Clojure (most of the way there now). * Support for limiting pretty printing based on line counts. * Support for circular and shared substructure detection. * Finishing the integration with the format function (support for ~/ and tabular pretty printing). * Performance! (Not much thought has been made to making this go fast, but there are a bunch of pretty obvious speedups to be had.) * Handle Java objects intelligently Please let me know about anything that's not working right, anything that should work differently, or the feature you think should be at the top of my list. ================================================ FILE: epl-v10.html ================================================ Eclipse Public License - Version 1.0

Eclipse Public License - v 1.0

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

1. DEFINITIONS

"Contribution" means:

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

b) in the case of each subsequent Contributor:

i) changes to the Program, and

ii) additions to the Program;

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

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

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

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

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

2. GRANT OF RIGHTS

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

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

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

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

3. REQUIREMENTS

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

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

b) its license agreement:

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

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

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

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

When the Program is made available in source code form:

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

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

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

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

4. COMMERCIAL DISTRIBUTION

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

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

5. NO WARRANTY

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

6. DISCLAIMER OF LIABILITY

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

7. GENERAL

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

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

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

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

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

================================================ FILE: pom.xml ================================================ 4.0.0 galdolber clojure-objc clojure-objc jar 1.7.0-RC2 clojars Clojars repository https://clojars.org/repo http://clojure.org/ Clojure core environment and runtime library. Rich Hickey richhickey@gmail.com -5 Eclipse Public License 1.0 http://opensource.org/licenses/eclipse-1.0.php repo scm:git:git@github.com:galdolber/clojure-objc.git scm:git:git@github.com:galdolber/clojure-objc.git git@github.com:galdolber/clojure-objc.git org.codehaus.jsr166-mirror jsr166y 1.7.0 provided org.clojure test.generative 0.5.2 test org.clojure clojure org.clojure test.check 0.5.9 test org.clojure clojure src/resources true src/clj test/java org.apache.maven.plugins maven-compiler-plugin 2.3.2 1.6 1.6 ${project.build.sourceEncoding} maven-antrun-plugin 1.6 clojure-compile compile run clojure-test test run org.codehaus.mojo build-helper-maven-plugin 1.5 add-clojure-source-dirs generate-sources add-source src/jvm maven-assembly-plugin 2.2 clojure-slim-jar package single src/assembly/slim.xml clojure.main maven-jar-plugin 2.3.1 clojure.main maven-source-plugin 2.1.2 sources-jar package jar clojure/version.properties org.apache.maven.plugins maven-release-plugin 2.1 false true org.apache.maven.plugins maven-surefire-plugin 2.6 true ================================================ FILE: readme.md ================================================ # clojure-objc A Clojure compiler that targets objc runtimes. * Write native apps in Clojure * Strong iOS support * Future proof: shares 99.99% of the code base with clojure for the jvm * Distribute clojure-objc libs using maven * Most existing Clojure libs should just work * ObjC interop * C interop * ObjC subclassing * REPL! ![alt usage guide](https://github.com/galdolber/clojure-objc-sample/raw/master/ios.gif) ## Leiningen plugin https://github.com/galdolber/lein-objcbuild ## Dependency [![Clojars Project](http://clojars.org/galdolber/clojure-objc/latest-version.svg)](http://clojars.org/galdolber/clojure-objc) ## Memory management All generated code manage memory automagically, but if you alloc with interop you need to release! ## ObjC interop ;; calling objc methods (defn say-hi [name] (-> ($ UIAlertView) ($ :alloc) ($ :initWithTitle (str "Hello " name) :message "Hi! from clojure" :delegate nil :cancelButtonTitle "Cancelar" :otherButtonTitles nil) ($ :autorelease) ($ :show))) ;; extend objc class (defnstype UIKitController UIViewController ([^:id self :initWith ^:id [view s]] (doto ($$ self :init) ($ :setView ($ view :retain)) (objc-set! :scope s) (#(post-notification ($ % :view) :init))))) ;; c interop (defc NSLog :void [:id &]) ; & for variadic (NSLog "%@ %@ %d" "Hello" "World" 13) ;; proxy objc class (nsproxy ([^:bool self :textFieldShouldReturn ^:id field] ($ field :resignFirstResponder) true)) ## Presentations http://www.slideshare.net/GalDolber/clojureobjc-47500127 ## Discuss https://groups.google.com/d/forum/clojure-objc-discuss ## How to build dist lein exec build.clj ## License Portions of this project derived from Clojure: Copyright © 2006-2015 Rich Hickey Original code and Clojure modifications: Copyright © 2014-2015 Gal Dolber Both are distributed under the Eclipse Public License either version 1.0 or (at your option) any later version. ================================================ FILE: release.sh ================================================ export KEEP_META=false rm -Rf target/release mkdir target/release cp target/libclojure-objc.a target/release/ cp $J2OBJC_HOME/lib/libjre_emul.a target/release/ cp src/ffi/libffi.a target/release/ mkdir target/release/include rsync -a $J2OBJC_HOME/include target/release rsync -a target/include target/release cp $J2OBJC_HOME/j2objc target/release/ mkdir target/release/lib cp $J2OBJC_HOME/lib/j2objc_annotations.jar target/release/lib cp $J2OBJC_HOME/lib/j2objc.jar target/release/lib cp $J2OBJC_HOME/lib/jre_emul.jar target/release/lib cd ./target/release zip -r ../release.zip . ================================================ FILE: src/assembly/distribution.xml ================================================ distribution zip src src doc doc test test target / false *.jar pom.xml build.xml readme.txt true changes.md clojure.iml epl-v10.html ================================================ FILE: src/assembly/slim.xml ================================================ slim jar false src/clj / src/resources / true target/classes/clojure/asm clojure/asm target/classes/clojure/lang clojure/lang target/classes/clojure/main.class clojure ================================================ FILE: src/clj/clojure/core/protocols.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.core.protocols) (set! *warn-on-reflection* true) (defprotocol CollReduce "Protocol for collection types that can implement reduce faster than first/next recursion. Called by clojure.core/reduce. Baseline implementation defined in terms of Iterable." (coll-reduce [coll f] [coll f val])) (defprotocol InternalReduce "Protocol for concrete seq types that can reduce themselves faster than first/next recursion. Called by clojure.core/reduce." (internal-reduce [seq f start])) (defn- seq-reduce ([coll f] (if-let [s (seq coll)] (internal-reduce (next s) f (first s)) (f))) ([coll f val] (let [s (seq coll)] (internal-reduce s f val)))) (defn- iter-reduce ([^java.lang.Iterable coll f] (let [iter (.iterator coll)] (if (.hasNext iter) (loop [ret (.next iter)] (if (.hasNext iter) (let [ret (f ret (.next iter))] (if (reduced? ret) @ret (recur ret))) ret)) (f)))) ([^java.lang.Iterable coll f val] (let [iter (.iterator coll)] (loop [ret val] (if (.hasNext iter) (let [ret (f ret (.next iter))] (if (reduced? ret) @ret (recur ret))) ret))))) (defn- naive-seq-reduce "Reduces a seq, ignoring any opportunities to switch to a more specialized implementation." [s f val] (loop [s (seq s) val val] (if s (let [ret (f val (first s))] (if (reduced? ret) @ret (recur (next s) ret))) val))) (defn- interface-or-naive-reduce "Reduces via IReduceInit if possible, else naively." [coll f val] (if (instance? clojure.lang.IReduceInit coll) (.reduce ^clojure.lang.IReduceInit coll f val) (naive-seq-reduce coll f val))) (extend-protocol CollReduce nil (coll-reduce ([coll f] (f)) ([coll f val] val)) Object (coll-reduce ([coll f] (seq-reduce coll f)) ([coll f val] (seq-reduce coll f val))) clojure.lang.IReduceInit (coll-reduce ([coll f] (.reduce ^clojure.lang.IReduce coll f)) ([coll f val] (.reduce coll f val))) ;;aseqs are iterable, masking internal-reducers clojure.lang.ASeq (coll-reduce ([coll f] (seq-reduce coll f)) ([coll f val] (seq-reduce coll f val))) ;;for range clojure.lang.LazySeq (coll-reduce ([coll f] (seq-reduce coll f)) ([coll f val] (seq-reduce coll f val))) ;;vector's chunked seq is faster than its iter clojure.lang.PersistentVector (coll-reduce ([coll f] (seq-reduce coll f)) ([coll f val] (seq-reduce coll f val))) Iterable (coll-reduce ([coll f] (iter-reduce coll f)) ([coll f val] (iter-reduce coll f val))) clojure.lang.APersistentMap$KeySeq (coll-reduce ([coll f] (iter-reduce coll f)) ([coll f val] (iter-reduce coll f val))) clojure.lang.APersistentMap$ValSeq (coll-reduce ([coll f] (iter-reduce coll f)) ([coll f val] (iter-reduce coll f val)))) (extend-protocol InternalReduce nil (internal-reduce [s f val] val) ;; handles vectors and ranges clojure.lang.IChunkedSeq (internal-reduce [s f val] (if-let [s (seq s)] (if (chunked-seq? s) (let [ret (.reduce (chunk-first s) f val)] (if (reduced? ret) @ret (recur (chunk-next s) f ret))) (interface-or-naive-reduce s f val)) val)) clojure.lang.StringSeq (internal-reduce [str-seq f val] (let [s (.s str-seq)] (loop [i (.i str-seq) val val] (if (< i (.length s)) (let [ret (f val (.charAt s i))] (if (reduced? ret) @ret (recur (inc i) ret))) val)))) java.lang.Object (internal-reduce [s f val] (loop [cls (class s) s s f f val val] (if-let [s (seq s)] (if (identical? (class s) cls) (let [ret (f val (first s))] (if (reduced? ret) @ret (recur cls (next s) f ret))) (interface-or-naive-reduce s f val)) val)))) (defprotocol IKVReduce "Protocol for concrete associative types that can reduce themselves via a function of key and val faster than first/next recursion over map entries. Called by clojure.core/reduce-kv, and has same semantics (just different arg order)." (kv-reduce [amap f init])) ================================================ FILE: src/clj/clojure/core/reducers.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "A library for reduction and parallel folding. Alpha and subject to change. Note that fold and its derivatives require Java 7+ or Java 6 + jsr166y.jar for fork/join support. See Clojure's pom.xml for the dependency info." :author "Rich Hickey"} clojure.core.reducers (:refer-clojure :exclude [reduce map mapcat filter remove take take-while drop flatten cat]) (:require [clojure.walk :as walk])) (alias 'core 'clojure.core) (set! *warn-on-reflection* true) ;;;;;;;;;;;;;; some fj stuff ;;;;;;;;;; (defmacro ^:private compile-if "Evaluate `exp` and if it returns logical true and doesn't error, expand to `then`. Else expand to `else`. (compile-if (Class/forName \"java.util.concurrent.ForkJoinTask\") (do-cool-stuff-with-fork-join) (fall-back-to-executor-services))" [exp then else] (if (try (eval exp) (catch Throwable _ false)) `(do ~then) `(do ~else))) (compile-if (Class/forName "java.util.concurrent.ForkJoinTask") ;; We're running a JDK 7+ (do (def pool (delay (java.util.concurrent.ForkJoinPool.))) (defn fjtask [^Callable f] (java.util.concurrent.ForkJoinTask/adapt f)) (defn- fjinvoke [f] (if (java.util.concurrent.ForkJoinTask/inForkJoinPool) (f) (.invoke ^java.util.concurrent.ForkJoinPool @pool ^java.util.concurrent.ForkJoinTask (fjtask f)))) (defn- fjfork [task] (.fork ^java.util.concurrent.ForkJoinTask task)) (defn- fjjoin [task] (.join ^java.util.concurrent.ForkJoinTask task))) ;; We're running a JDK <7 (do (def pool (delay (jsr166y.ForkJoinPool.))) (defn fjtask [^Callable f] (jsr166y.ForkJoinTask/adapt f)) (defn- fjinvoke [f] (if (jsr166y.ForkJoinTask/inForkJoinPool) (f) (.invoke ^jsr166y.ForkJoinPool @pool ^jsr166y.ForkJoinTask (fjtask f)))) (defn- fjfork [task] (.fork ^jsr166y.ForkJoinTask task)) (defn- fjjoin [task] (.join ^jsr166y.ForkJoinTask task)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn reduce "Like core/reduce except: When init is not provided, (f) is used. Maps are reduced with reduce-kv" ([f coll] (reduce f (f) coll)) ([f init coll] (if (instance? java.util.Map coll) (clojure.core.protocols/kv-reduce coll f init) (clojure.core.protocols/coll-reduce coll f init)))) (defprotocol CollFold (coll-fold [coll n combinef reducef])) (defn fold "Reduces a collection using a (potentially parallel) reduce-combine strategy. The collection is partitioned into groups of approximately n (default 512), each of which is reduced with reducef (with a seed value obtained by calling (combinef) with no arguments). The results of these reductions are then reduced with combinef (default reducef). combinef must be associative, and, when called with no arguments, (combinef) must produce its identity element. These operations may be performed in parallel, but the results will preserve order." {:added "1.5"} ([reducef coll] (fold reducef reducef coll)) ([combinef reducef coll] (fold 512 combinef reducef coll)) ([n combinef reducef coll] (coll-fold coll n combinef reducef))) (defn reducer "Given a reducible collection, and a transformation function xf, returns a reducible collection, where any supplied reducing fn will be transformed by xf. xf is a function of reducing fn to reducing fn." {:added "1.5"} ([coll xf] (reify clojure.core.protocols/CollReduce (coll-reduce [this f1] (clojure.core.protocols/coll-reduce this f1 (f1))) (coll-reduce [_ f1 init] (clojure.core.protocols/coll-reduce coll (xf f1) init))))) (defn folder "Given a foldable collection, and a transformation function xf, returns a foldable collection, where any supplied reducing fn will be transformed by xf. xf is a function of reducing fn to reducing fn." {:added "1.5"} ([coll xf] (reify clojure.core.protocols/CollReduce (coll-reduce [_ f1] (clojure.core.protocols/coll-reduce coll (xf f1) (f1))) (coll-reduce [_ f1 init] (clojure.core.protocols/coll-reduce coll (xf f1) init)) CollFold (coll-fold [_ n combinef reducef] (coll-fold coll n combinef (xf reducef)))))) (defn- do-curried [name doc meta args body] (let [cargs (vec (butlast args))] `(defn ~name ~doc ~meta (~cargs (fn [x#] (~name ~@cargs x#))) (~args ~@body)))) (defmacro ^:private defcurried "Builds another arity of the fn that returns a fn awaiting the last param" [name doc meta args & body] (do-curried name doc meta args body)) (defn- do-rfn [f1 k fkv] `(fn ([] (~f1)) ~(clojure.walk/postwalk #(if (sequential? %) ((if (vector? %) vec identity) (core/remove #{k} %)) %) fkv) ~fkv)) (defmacro ^:private rfn "Builds 3-arity reducing fn given names of wrapped fn and key, and k/v impl." [[f1 k] fkv] (do-rfn f1 k fkv)) (defcurried map "Applies f to every value in the reduction of coll. Foldable." {:added "1.5"} [f coll] (folder coll (fn [f1] (rfn [f1 k] ([ret k v] (f1 ret (f k v))))))) (defcurried mapcat "Applies f to every value in the reduction of coll, concatenating the result colls of (f val). Foldable." {:added "1.5"} [f coll] (folder coll (fn [f1] (let [f1 (fn ([ret v] (let [x (f1 ret v)] (if (reduced? x) (reduced x) x))) ([ret k v] (let [x (f1 ret k v)] (if (reduced? x) (reduced x) x))))] (rfn [f1 k] ([ret k v] (reduce f1 ret (f k v)))))))) (defcurried filter "Retains values in the reduction of coll for which (pred val) returns logical true. Foldable." {:added "1.5"} [pred coll] (folder coll (fn [f1] (rfn [f1 k] ([ret k v] (if (pred k v) (f1 ret k v) ret)))))) (defcurried remove "Removes values in the reduction of coll for which (pred val) returns logical true. Foldable." {:added "1.5"} [pred coll] (filter (complement pred) coll)) (defcurried flatten "Takes any nested combination of sequential things (lists, vectors, etc.) and returns their contents as a single, flat foldable collection." {:added "1.5"} [coll] (folder coll (fn [f1] (fn ([] (f1)) ([ret v] (if (sequential? v) (clojure.core.protocols/coll-reduce (flatten v) f1 ret) (f1 ret v))))))) (defcurried take-while "Ends the reduction of coll when (pred val) returns logical false." {:added "1.5"} [pred coll] (reducer coll (fn [f1] (rfn [f1 k] ([ret k v] (if (pred k v) (f1 ret k v) (reduced ret))))))) (defcurried take "Ends the reduction of coll after consuming n values." {:added "1.5"} [n coll] (reducer coll (fn [f1] (let [cnt (atom n)] (rfn [f1 k] ([ret k v] (swap! cnt dec) (if (neg? @cnt) (reduced ret) (f1 ret k v)))))))) (defcurried drop "Elides the first n values from the reduction of coll." {:added "1.5"} [n coll] (reducer coll (fn [f1] (let [cnt (atom n)] (rfn [f1 k] ([ret k v] (swap! cnt dec) (if (neg? @cnt) (f1 ret k v) ret))))))) ;;do not construct this directly, use cat (deftype Cat [cnt left right] clojure.lang.Counted (count [_] cnt) clojure.lang.Seqable (seq [_] (concat (seq left) (seq right))) clojure.core.protocols/CollReduce (coll-reduce [this f1] (clojure.core.protocols/coll-reduce this f1 (f1))) (coll-reduce [_ f1 init] (clojure.core.protocols/coll-reduce right f1 (clojure.core.protocols/coll-reduce left f1 init))) CollFold (coll-fold [_ n combinef reducef] (fjinvoke (fn [] (let [rt (fjfork (fjtask #(coll-fold right n combinef reducef)))] (combinef (coll-fold left n combinef reducef) (fjjoin rt))))))) (defn cat "A high-performance combining fn that yields the catenation of the reduced values. The result is reducible, foldable, seqable and counted, providing the identity collections are reducible, seqable and counted. The single argument version will build a combining fn with the supplied identity constructor. Tests for identity with (zero? (count x)). See also foldcat." {:added "1.5"} ([] (java.util.ArrayList.)) ([ctor] (fn ([] (ctor)) ([left right] (cat left right)))) ([left right] (cond (zero? (count left)) right (zero? (count right)) left :else (Cat. (+ (count left) (count right)) left right)))) (defn append! ".adds x to acc and returns acc" {:added "1.5"} [^java.util.Collection acc x] (doto acc (.add x))) (defn foldcat "Equivalent to (fold cat append! coll)" {:added "1.5"} [coll] (fold cat append! coll)) (defn monoid "Builds a combining fn out of the supplied operator and identity constructor. op must be associative and ctor called with no args must return an identity value for it." {:added "1.5"} [op ctor] (fn m ([] (ctor)) ([a b] (op a b)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fold impls ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- foldvec [v n combinef reducef] (cond (empty? v) (combinef) (<= (count v) n) (reduce reducef (combinef) v) :else (let [split (quot (count v) 2) v1 (subvec v 0 split) v2 (subvec v split (count v)) fc (fn [child] #(foldvec child n combinef reducef))] (fjinvoke #(let [f1 (fc v1) t2 (fjtask (fc v2))] (fjfork t2) (combinef (f1) (fjjoin t2))))))) (extend-protocol CollFold nil (coll-fold [coll n combinef reducef] (combinef)) Object (coll-fold [coll n combinef reducef] ;;can't fold, single reduce (reduce reducef (combinef) coll)) clojure.lang.IPersistentVector (coll-fold [v n combinef reducef] (foldvec v n combinef reducef)) clojure.lang.PersistentHashMap (coll-fold [m n combinef reducef] (.fold m n combinef reducef fjinvoke fjtask fjfork fjjoin))) ================================================ FILE: src/clj/clojure/core.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "The core Clojure language." :author "Rich Hickey"} clojure.core) (def unquote) (def unquote-splicing) (def ^{:arglists '([& items]) :doc "Creates a new list containing the items." :added "1.0"} list (. clojure.lang.PersistentList creator)) (def ^{:arglists '([x seq]) :doc "Returns a new seq where x is the first element and seq is the rest." :added "1.0" :static true} cons (fn* ^:static cons [x seq] (. clojure.lang.RT (cons x seq)))) ;during bootstrap we don't have destructuring let, loop or fn, will redefine later (def ^{:macro true :added "1.0"} let (fn* let [&form &env & decl] (cons 'let* decl))) (def ^{:macro true :added "1.0"} loop (fn* loop [&form &env & decl] (cons 'loop* decl))) (def ^{:macro true :added "1.0"} fn (fn* fn [&form &env & decl] (.withMeta ^clojure.lang.IObj (cons 'fn* decl) (.meta ^clojure.lang.IMeta &form)))) (def ^{:arglists '([coll]) :doc "Returns the first item in the collection. Calls seq on its argument. If coll is nil, returns nil." :added "1.0" :static true} first (fn ^:static first [coll] (. clojure.lang.RT (first coll)))) (def ^{:arglists '([coll]) :tag clojure.lang.ISeq :doc "Returns a seq of the items after the first. Calls seq on its argument. If there are no more items, returns nil." :added "1.0" :static true} next (fn ^:static next [x] (. clojure.lang.RT (next x)))) (def ^{:arglists '([coll]) :tag clojure.lang.ISeq :doc "Returns a possibly empty seq of the items after the first. Calls seq on its argument." :added "1.0" :static true} rest (fn ^:static rest [x] (. clojure.lang.RT (more x)))) (def ^{:arglists '([coll x] [coll x & xs]) :doc "conj[oin]. Returns a new collection with the xs 'added'. (conj nil item) returns (item). The 'addition' may happen at different 'places' depending on the concrete type." :added "1.0" :static true} conj (fn ^:static conj ([] []) ([coll] coll) ([coll x] (. clojure.lang.RT (conj coll x))) ([coll x & xs] (if xs (recur (conj coll x) (first xs) (next xs)) (conj coll x))))) (def ^{:doc "Same as (first (next x))" :arglists '([x]) :added "1.0" :static true} second (fn ^:static second [x] (first (next x)))) (def ^{:doc "Same as (first (first x))" :arglists '([x]) :added "1.0" :static true} ffirst (fn ^:static ffirst [x] (first (first x)))) (def ^{:doc "Same as (next (first x))" :arglists '([x]) :added "1.0" :static true} nfirst (fn ^:static nfirst [x] (next (first x)))) (def ^{:doc "Same as (first (next x))" :arglists '([x]) :added "1.0" :static true} fnext (fn ^:static fnext [x] (first (next x)))) (def ^{:doc "Same as (next (next x))" :arglists '([x]) :added "1.0" :static true} nnext (fn ^:static nnext [x] (next (next x)))) (def ^{:arglists '(^clojure.lang.ISeq [coll]) :doc "Returns a seq on the collection. If the collection is empty, returns nil. (seq nil) returns nil. seq also works on Strings, native Java arrays (of reference types) and any objects that implement Iterable. Note that seqs cache values, thus seq should not be used on any Iterable whose iterator repeatedly returns the same mutable object." :tag clojure.lang.ISeq :added "1.0" :static true} seq (fn ^:static seq ^clojure.lang.ISeq [coll] (. clojure.lang.RT (seq coll)))) (def ^{:arglists '([^Class c x]) :doc "Evaluates x and tests if it is an instance of the class c. Returns true or false" :added "1.0"} instance? (fn instance? [^Class c x] (. c (isInstance x)))) (def ^{:arglists '([x]) :doc "Return true if x implements ISeq" :added "1.0" :static true} seq? (fn ^:static seq? [x] (instance? clojure.lang.ISeq x))) (def ^{:arglists '([x]) :doc "Return true if x is a Character" :added "1.0" :static true} char? (fn ^:static char? [x] (instance? Character x))) (def ^{:arglists '([x]) :doc "Return true if x is a String" :added "1.0" :static true} string? (fn ^:static string? [x] (instance? String x))) (def ^{:arglists '([x]) :doc "Return true if x implements IPersistentMap" :added "1.0" :static true} map? (fn ^:static map? [x] (instance? clojure.lang.IPersistentMap x))) (def ^{:arglists '([x]) :doc "Return true if x implements IPersistentVector" :added "1.0" :static true} vector? (fn ^:static vector? [x] (instance? clojure.lang.IPersistentVector x))) (def ^{:arglists '([map key val] [map key val & kvs]) :doc "assoc[iate]. When applied to a map, returns a new map of the same (hashed/sorted) type, that contains the mapping of key(s) to val(s). When applied to a vector, returns a new vector that contains val at index. Note - index must be <= (count vector)." :added "1.0" :static true} assoc (fn ^:static assoc ([map key val] (. clojure.lang.RT (assoc map key val))) ([map key val & kvs] (let [ret (assoc map key val)] (if kvs (if (next kvs) (recur ret (first kvs) (second kvs) (nnext kvs)) (throw (IllegalArgumentException. "assoc expects even number of arguments after map/vector, found odd number"))) ret))))) ;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:arglists '([obj]) :doc "Returns the metadata of obj, returns nil if there is no metadata." :added "1.0" :static true} meta (fn ^:static meta [x] (if (instance? clojure.lang.IMeta x) (. ^clojure.lang.IMeta x (meta))))) (def ^{:arglists '([^clojure.lang.IObj obj m]) :doc "Returns an object of the same type and value as obj, with map m as its metadata." :added "1.0" :static true} with-meta (fn ^:static with-meta [^clojure.lang.IObj x m] (. x (withMeta m)))) (def ^{:private true :dynamic true} assert-valid-fdecl (fn [fdecl])) (def ^{:private true} sigs (fn [fdecl] (assert-valid-fdecl fdecl) (let [asig (fn [fdecl] (let [arglist (first fdecl) ;elide implicit macro args arglist (if (clojure.lang.Util/equals '&form (first arglist)) (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist)) arglist) body (next fdecl)] (if (map? (first body)) (if (next body) (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body))) arglist) arglist)))] (if (seq? (first fdecl)) (loop [ret [] fdecls fdecl] (if fdecls (recur (conj ret (asig (first fdecls))) (next fdecls)) (seq ret))) (list (asig fdecl)))))) (def ^{:arglists '([coll]) :doc "Return the last item in coll, in linear time" :added "1.0" :static true} last (fn ^:static last [s] (if (next s) (recur (next s)) (first s)))) (def ^{:arglists '([coll]) :doc "Return a seq of all but the last item in coll, in linear time" :added "1.0" :static true} butlast (fn ^:static butlast [s] (loop [ret [] s s] (if (next s) (recur (conj ret (first s)) (next s)) (seq ret))))) (def ^{:doc "Same as (def name (fn [params* ] exprs*)) or (def name (fn ([params* ] exprs*)+)) with any doc-string or attrs added to the var metadata. prepost-map defines a map with optional keys :pre and :post that contain collections of pre or post conditions." :arglists '([name doc-string? attr-map? [params*] prepost-map? body] [name doc-string? attr-map? ([params*] prepost-map? body)+ attr-map?]) :added "1.0" :macro true} defn (fn defn [&form &env name & fdecl] ;; Note: Cannot delegate this check to def because of the call to (with-meta name ..) (if (instance? clojure.lang.Symbol name) nil (throw (IllegalArgumentException. "First argument to defn must be a symbol"))) (let [m (if (string? (first fdecl)) {:doc (first fdecl)} {}) fdecl (if (string? (first fdecl)) (next fdecl) fdecl) m (if (map? (first fdecl)) (conj m (first fdecl)) m) fdecl (if (map? (first fdecl)) (next fdecl) fdecl) fdecl (if (vector? (first fdecl)) (list fdecl) fdecl) m (if (map? (last fdecl)) (conj m (last fdecl)) m) fdecl (if (map? (last fdecl)) (butlast fdecl) fdecl) m (conj {:arglists (list 'quote (sigs fdecl))} m) m (let [inline (:inline m) ifn (first inline) iname (second inline)] ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...) (if (if (clojure.lang.Util/equiv 'fn ifn) (if (instance? clojure.lang.Symbol iname) false true)) ;; inserts the same fn name to the inline fn if it does not have one (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName ^clojure.lang.Symbol name) "__inliner")) (next inline)))) m)) m (conj (if (meta name) (meta name) {}) m)] (list 'def (with-meta name m) ;;todo - restore propagation of fn name ;;must figure out how to convey primitive hints to self calls first (cons `fn fdecl) )))) (defn to-array "Returns an array of Objects containing the contents of coll, which can be any Collection. Maps to java.util.Collection.toArray()." {:tag "[Ljava.lang.Object;" :added "1.0" :static true} [coll] (. clojure.lang.RT (toArray coll))) (defn cast "Throws a ClassCastException if x is not a c, else returns x." {:added "1.0" :static true} [^Class c x] (. c (cast x))) (defn vector "Creates a new vector containing the args." {:added "1.0" :static true} ([] []) ([a] [a]) ([a b] [a b]) ([a b c] [a b c]) ([a b c d] [a b c d]) ([a b c d & args] (. clojure.lang.LazilyPersistentVector (create (cons a (cons b (cons c (cons d args)))))))) (defn vec "Creates a new vector containing the contents of coll. Java arrays will be aliased and should not be modified." {:added "1.0" :static true} ([coll] (if (vector? coll) (if (instance? clojure.lang.IObj coll) (with-meta coll nil) (clojure.lang.LazilyPersistentVector/create coll)) (clojure.lang.LazilyPersistentVector/create coll)))) (defn hash-map "keyval => key val Returns a new hash map with supplied mappings. If any keys are equal, they are handled as if by repeated uses of assoc." {:added "1.0" :static true} ([] {}) ([& keyvals] (. clojure.lang.PersistentHashMap (create keyvals)))) (defn hash-set "Returns a new hash set with supplied keys. Any equal keys are handled as if by repeated uses of conj." {:added "1.0" :static true} ([] #{}) ([& keys] (clojure.lang.PersistentHashSet/create keys))) (defn sorted-map "keyval => key val Returns a new sorted map with supplied mappings. If any keys are equal, they are handled as if by repeated uses of assoc." {:added "1.0" :static true} ([& keyvals] (clojure.lang.PersistentTreeMap/create keyvals))) (defn sorted-map-by "keyval => key val Returns a new sorted map with supplied mappings, using the supplied comparator. If any keys are equal, they are handled as if by repeated uses of assoc." {:added "1.0" :static true} ([comparator & keyvals] (clojure.lang.PersistentTreeMap/create comparator keyvals))) (defn sorted-set "Returns a new sorted set with supplied keys. Any equal keys are handled as if by repeated uses of conj." {:added "1.0" :static true} ([& keys] (clojure.lang.PersistentTreeSet/create keys))) (defn sorted-set-by "Returns a new sorted set with supplied keys, using the supplied comparator. Any equal keys are handled as if by repeated uses of conj." {:added "1.1" :static true} ([comparator & keys] (clojure.lang.PersistentTreeSet/create comparator keys))) ;;;;;;;;;;;;;;;;;;;; (defn nil? "Returns true if x is nil, false otherwise." {:tag Boolean :added "1.0" :static true :inline (fn [x] (list 'clojure.lang.Util/identical x nil))} [x] (clojure.lang.Util/identical x nil)) (def ^{:doc "Like defn, but the resulting function name is declared as a macro and will be used as a macro by the compiler when it is called." :arglists '([name doc-string? attr-map? [params*] body] [name doc-string? attr-map? ([params*] body)+ attr-map?]) :added "1.0" :macro true} defmacro (fn [&form &env name & args] (let [prefix (loop [p (list name) args args] (let [f (first args)] (if (string? f) (recur (cons f p) (next args)) (if (map? f) (recur (cons f p) (next args)) p)))) fdecl (loop [fd args] (if (string? (first fd)) (recur (next fd)) (if (map? (first fd)) (recur (next fd)) fd))) fdecl (if (vector? (first fdecl)) (list fdecl) fdecl) add-implicit-args (fn [fd] (let [args (first fd)] (cons (vec (cons '&form (cons '&env args))) (next fd)))) add-args (fn [acc ds] (if (nil? ds) acc (let [d (first ds)] (if (map? d) (conj acc d) (recur (conj acc (add-implicit-args d)) (next ds)))))) fdecl (seq (add-args [] fdecl)) decl (loop [p prefix d fdecl] (if p (recur (next p) (cons (first p) d)) d)) sym (with-meta (first decl) (assoc (meta (first decl)) :macro true)) decl (cons sym (next decl))] (cons `defn decl)))) (defmacro when "Evaluates test. If logical true, evaluates body in an implicit do." {:added "1.0"} [test & body] (list 'if test (cons 'do body))) (defmacro when-not "Evaluates test. If logical false, evaluates body in an implicit do." {:added "1.0"} [test & body] (list 'if test nil (cons 'do body))) (defn false? "Returns true if x is the value false, false otherwise." {:tag Boolean, :added "1.0" :static true} [x] (clojure.lang.Util/identical x false)) (defn true? "Returns true if x is the value true, false otherwise." {:tag Boolean, :added "1.0" :static true} [x] (clojure.lang.Util/identical x true)) (defn not "Returns true if x is logical false, false otherwise." {:tag Boolean :added "1.0" :static true} [x] (if x false true)) (defn some? "Returns true if x is not nil, false otherwise." {:tag Boolean :added "1.6" :static true} [x] (not (nil? x))) (defn str "With no args, returns the empty string. With one arg x, returns x.toString(). (str nil) returns the empty string. With more than one arg, returns the concatenation of the str values of the args." {:tag String :added "1.0" :static true} (^String [] "") (^String [^Object x] (if (nil? x) "" (. x (toString)))) (^String [x & ys] ((fn [^StringBuilder sb more] (if more (recur (. sb (append (str (first more)))) (next more)) (str sb))) (new StringBuilder (str x)) ys))) (defn symbol? "Return true if x is a Symbol" {:added "1.0" :static true} [x] (instance? clojure.lang.Symbol x)) (defn keyword? "Return true if x is a Keyword" {:added "1.0" :static true} [x] (instance? clojure.lang.Keyword x)) (defn symbol "Returns a Symbol with the given namespace and name." {:tag clojure.lang.Symbol :added "1.0" :static true} ([name] (if (symbol? name) name (clojure.lang.Symbol/intern name))) ([ns name] (clojure.lang.Symbol/intern ns name))) (defn gensym "Returns a new symbol with a unique name. If a prefix string is supplied, the name is prefix# where # is some unique number. If prefix is not supplied, the prefix is 'G__'." {:added "1.0" :static true} ([] (gensym "G__")) ([prefix-string] (. clojure.lang.Symbol (intern (str prefix-string (str (. clojure.lang.RT (nextID)))))))) (defmacro cond "Takes a set of test/expr pairs. It evaluates each test one at a time. If a test returns logical true, cond evaluates and returns the value of the corresponding expr and doesn't evaluate any of the other tests or exprs. (cond) returns nil." {:added "1.0"} [& clauses] (when clauses (list 'if (first clauses) (if (next clauses) (second clauses) (throw (IllegalArgumentException. "cond requires an even number of forms"))) (cons 'clojure.core/cond (next (next clauses)))))) (defn keyword "Returns a Keyword with the given namespace and name. Do not use : in the keyword strings, it will be added automatically." {:tag clojure.lang.Keyword :added "1.0" :static true} ([name] (cond (keyword? name) name (symbol? name) (clojure.lang.Keyword/intern ^clojure.lang.Symbol name) (string? name) (clojure.lang.Keyword/intern ^String name))) ([ns name] (clojure.lang.Keyword/intern ns name))) (defn find-keyword "Returns a Keyword with the given namespace and name if one already exists. This function will not intern a new keyword. If the keyword has not already been interned, it will return nil. Do not use : in the keyword strings, it will be added automatically." {:tag clojure.lang.Keyword :added "1.3" :static true} ([name] (cond (keyword? name) name (symbol? name) (clojure.lang.Keyword/find ^clojure.lang.Symbol name) (string? name) (clojure.lang.Keyword/find ^String name))) ([ns name] (clojure.lang.Keyword/find ns name))) (defn spread {:private true :static true} [arglist] (cond (nil? arglist) nil (nil? (next arglist)) (seq (first arglist)) :else (cons (first arglist) (spread (next arglist))))) (defn list* "Creates a new list containing the items prepended to the rest, the last of which will be treated as a sequence." {:added "1.0" :static true} ([args] (seq args)) ([a args] (cons a args)) ([a b args] (cons a (cons b args))) ([a b c args] (cons a (cons b (cons c args)))) ([a b c d & more] (cons a (cons b (cons c (cons d (spread more))))))) (defn apply "Applies fn f to the argument list formed by prepending intervening arguments to args." {:added "1.0" :static true} ([^clojure.lang.IFn f args] (. f (applyTo (seq args)))) ([^clojure.lang.IFn f x args] (. f (applyTo (list* x args)))) ([^clojure.lang.IFn f x y args] (. f (applyTo (list* x y args)))) ([^clojure.lang.IFn f x y z args] (. f (applyTo (list* x y z args)))) ([^clojure.lang.IFn f a b c d & args] (. f (applyTo (cons a (cons b (cons c (cons d (spread args))))))))) (defn vary-meta "Returns an object of the same type and value as obj, with (apply f (meta obj) args) as its metadata." {:added "1.0" :static true} [obj f & args] (with-meta obj (apply f (meta obj) args))) (defmacro lazy-seq "Takes a body of expressions that returns an ISeq or nil, and yields a Seqable object that will invoke the body only the first time seq is called, and will cache the result and return it on all subsequent seq calls. See also - realized?" {:added "1.0"} [& body] (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body))) (defn ^:static ^clojure.lang.ChunkBuffer chunk-buffer ^clojure.lang.ChunkBuffer [capacity] (clojure.lang.ChunkBuffer. capacity)) (defn ^:static chunk-append [^clojure.lang.ChunkBuffer b x] (.add b x)) (defn ^:static ^clojure.lang.IChunk chunk [^clojure.lang.ChunkBuffer b] (.chunk b)) (defn ^:static ^clojure.lang.IChunk chunk-first ^clojure.lang.IChunk [^clojure.lang.IChunkedSeq s] (.chunkedFirst s)) (defn ^:static ^clojure.lang.ISeq chunk-rest ^clojure.lang.ISeq [^clojure.lang.IChunkedSeq s] (.chunkedMore s)) (defn ^:static ^clojure.lang.ISeq chunk-next ^clojure.lang.ISeq [^clojure.lang.IChunkedSeq s] (.chunkedNext s)) (defn ^:static chunk-cons [chunk rest] (if (clojure.lang.Numbers/isZero (clojure.lang.RT/count chunk)) rest (clojure.lang.ChunkedCons. chunk rest))) (defn ^:static chunked-seq? [s] (instance? clojure.lang.IChunkedSeq s)) (defn concat "Returns a lazy seq representing the concatenation of the elements in the supplied colls." {:added "1.0" :static true} ([] (lazy-seq nil)) ([x] (lazy-seq x)) ([x y] (lazy-seq (let [s (seq x)] (if s (if (chunked-seq? s) (chunk-cons (chunk-first s) (concat (chunk-rest s) y)) (cons (first s) (concat (rest s) y))) y)))) ([x y & zs] (let [cat (fn cat [xys zs] (lazy-seq (let [xys (seq xys)] (if xys (if (chunked-seq? xys) (chunk-cons (chunk-first xys) (cat (chunk-rest xys) zs)) (cons (first xys) (cat (rest xys) zs))) (when zs (cat (first zs) (next zs)))))))] (cat (concat x y) zs)))) ;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;; (defmacro delay "Takes a body of expressions and yields a Delay object that will invoke the body only the first time it is forced (with force or deref/@), and will cache the result and return it on all subsequent force calls. See also - realized?" {:added "1.0"} [& body] (list 'new 'clojure.lang.Delay (list* `^{:once true} fn* [] body))) (defn delay? "returns true if x is a Delay created with delay" {:added "1.0" :static true} [x] (instance? clojure.lang.Delay x)) (defn force "If x is a Delay, returns the (possibly cached) value of its expression, else returns x" {:added "1.0" :static true} [x] (. clojure.lang.Delay (force x))) (defmacro if-not "Evaluates test. If logical false, evaluates and returns then expr, otherwise else expr, if supplied, else nil." {:added "1.0"} ([test then] `(if-not ~test ~then nil)) ([test then else] `(if (not ~test) ~then ~else))) (defn identical? "Tests if 2 arguments are the same object" {:inline (fn [x y] `(. clojure.lang.Util identical ~x ~y)) :inline-arities #{2} :added "1.0"} ([x y] (clojure.lang.Util/identical x y))) ;equiv-based (defn = "Equality. Returns true if x equals y, false if not. Same as Java x.equals(y) except it also works for nil, and compares numbers and collections in a type-independent manner. Clojure's immutable data structures define equals() (and thus =) as a value, not an identity, comparison." {:inline (fn [x y] `(. clojure.lang.Util equiv ~x ~y)) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (clojure.lang.Util/equiv x y)) ([x y & more] (if (clojure.lang.Util/equiv x y) (if (next more) (recur y (first more) (next more)) (clojure.lang.Util/equiv y (first more))) false))) ;equals-based #_(defn = "Equality. Returns true if x equals y, false if not. Same as Java x.equals(y) except it also works for nil. Boxed numbers must have same type. Clojure's immutable data structures define equals() (and thus =) as a value, not an identity, comparison." {:inline (fn [x y] `(. clojure.lang.Util equals ~x ~y)) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (clojure.lang.Util/equals x y)) ([x y & more] (if (= x y) (if (next more) (recur y (first more) (next more)) (= y (first more))) false))) (defn not= "Same as (not (= obj1 obj2))" {:tag Boolean :added "1.0" :static true} ([x] false) ([x y] (not (= x y))) ([x y & more] (not (apply = x y more)))) (defn compare "Comparator. Returns a negative number, zero, or a positive number when x is logically 'less than', 'equal to', or 'greater than' y. Same as Java x.compareTo(y) except it also works for nil, and compares numbers and collections in a type-independent manner. x must implement Comparable" { :inline (fn [x y] `(. clojure.lang.Util compare ~x ~y)) :added "1.0"} [x y] (. clojure.lang.Util (compare x y))) (defmacro and "Evaluates exprs one at a time, from left to right. If a form returns logical false (nil or false), and returns that value and doesn't evaluate any of the other expressions, otherwise it returns the value of the last expr. (and) returns true." {:added "1.0"} ([] true) ([x] x) ([x & next] `(let [and# ~x] (if and# (and ~@next) and#)))) (defmacro or "Evaluates exprs one at a time, from left to right. If a form returns a logical true value, or returns that value and doesn't evaluate any of the other expressions, otherwise it returns the value of the last expression. (or) returns nil." {:added "1.0"} ([] nil) ([x] x) ([x & next] `(let [or# ~x] (if or# or# (or ~@next))))) ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; (defn zero? "Returns true if num is zero, else false" { :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (isZero x))) (defn count "Returns the number of items in the collection. (count nil) returns 0. Also works on strings, arrays, and Java Collections and Maps" { :inline (fn [x] `(. clojure.lang.RT (count ~x))) :added "1.0"} [coll] (clojure.lang.RT/count coll)) (defn int "Coerce to int" { :inline (fn [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedIntCast 'intCast) ~x))) :added "1.0"} [x] (. clojure.lang.RT (intCast x))) (defn nth "Returns the value at the index. get returns nil if index out of bounds, nth throws an exception unless not-found is supplied. nth also works for strings, Java arrays, regex Matchers and Lists, and, in O(n) time, for sequences." {:inline (fn [c i & nf] `(. clojure.lang.RT (nth ~c ~i ~@nf))) :inline-arities #{2 3} :added "1.0"} ([coll index] (. clojure.lang.RT (nth coll index))) ([coll index not-found] (. clojure.lang.RT (nth coll index not-found)))) (defn < "Returns non-nil if nums are in monotonically increasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (lt ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (lt x y))) ([x y & more] (if (< x y) (if (next more) (recur y (first more) (next more)) (< y (first more))) false))) (defn inc' "Returns a number one greater than num. Supports arbitrary precision. See also: inc" {:inline (fn [x] `(. clojure.lang.Numbers (incP ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (incP x))) (defn inc "Returns a number one greater than num. Does not auto-promote longs, will throw on overflow. See also: inc'" {:inline (fn [x] `(. clojure.lang.Numbers (~(if *unchecked-math* 'unchecked_inc 'inc) ~x))) :added "1.2"} [x] (. clojure.lang.Numbers (inc x))) ;; reduce is defined again later after InternalReduce loads (defn ^:private ^:static reduce1 ([f coll] (let [s (seq coll)] (if s (reduce1 f (first s) (next s)) (f)))) ([f val coll] (let [s (seq coll)] (if s (if (chunked-seq? s) (recur f (.reduce (chunk-first s) f val) (chunk-next s)) (recur f (f val (first s)) (next s))) val)))) (defn reverse "Returns a seq of the items in coll in reverse order. Not lazy." {:added "1.0" :static true} [coll] (reduce1 conj () coll)) ;;math stuff (defn ^:private nary-inline ([op] (nary-inline op op)) ([op unchecked-op] (fn ([x] (let [op (if *unchecked-math* unchecked-op op)] `(. clojure.lang.Numbers (~op ~x)))) ([x y] (let [op (if *unchecked-math* unchecked-op op)] `(. clojure.lang.Numbers (~op ~x ~y)))) ([x y & more] (let [op (if *unchecked-math* unchecked-op op)] (reduce1 (fn [a b] `(. clojure.lang.Numbers (~op ~a ~b))) `(. clojure.lang.Numbers (~op ~x ~y)) more)))))) (defn ^:private >1? [n] (clojure.lang.Numbers/gt n 1)) (defn ^:private >0? [n] (clojure.lang.Numbers/gt n 0)) (defn +' "Returns the sum of nums. (+) returns 0. Supports arbitrary precision. See also: +" {:inline (nary-inline 'addP) :inline-arities >1? :added "1.0"} ([] 0) ([x] (cast Number x)) ([x y] (. clojure.lang.Numbers (addP x y))) ([x y & more] (reduce1 +' (+' x y) more))) (defn + "Returns the sum of nums. (+) returns 0. Does not auto-promote longs, will throw on overflow. See also: +'" {:inline (nary-inline 'add 'unchecked_add) :inline-arities >1? :added "1.2"} ([] 0) ([x] (cast Number x)) ([x y] (. clojure.lang.Numbers (add x y))) ([x y & more] (reduce1 + (+ x y) more))) (defn *' "Returns the product of nums. (*) returns 1. Supports arbitrary precision. See also: *" {:inline (nary-inline 'multiplyP) :inline-arities >1? :added "1.0"} ([] 1) ([x] (cast Number x)) ([x y] (. clojure.lang.Numbers (multiplyP x y))) ([x y & more] (reduce1 *' (*' x y) more))) (defn * "Returns the product of nums. (*) returns 1. Does not auto-promote longs, will throw on overflow. See also: *'" {:inline (nary-inline 'multiply 'unchecked_multiply) :inline-arities >1? :added "1.2"} ([] 1) ([x] (cast Number x)) ([x y] (. clojure.lang.Numbers (multiply x y))) ([x y & more] (reduce1 * (* x y) more))) (defn / "If no denominators are supplied, returns 1/numerator, else returns numerator divided by all of the denominators." {:inline (nary-inline 'divide) :inline-arities >1? :added "1.0"} ([x] (/ 1 x)) ([x y] (. clojure.lang.Numbers (divide x y))) ([x y & more] (reduce1 / (/ x y) more))) (defn -' "If no ys are supplied, returns the negation of x, else subtracts the ys from x and returns the result. Supports arbitrary precision. See also: -" {:inline (nary-inline 'minusP) :inline-arities >0? :added "1.0"} ([x] (. clojure.lang.Numbers (minusP x))) ([x y] (. clojure.lang.Numbers (minusP x y))) ([x y & more] (reduce1 -' (-' x y) more))) (defn - "If no ys are supplied, returns the negation of x, else subtracts the ys from x and returns the result. Does not auto-promote longs, will throw on overflow. See also: -'" {:inline (nary-inline 'minus 'unchecked_minus) :inline-arities >0? :added "1.2"} ([x] (. clojure.lang.Numbers (minus x))) ([x y] (. clojure.lang.Numbers (minus x y))) ([x y & more] (reduce1 - (- x y) more))) (defn <= "Returns non-nil if nums are in monotonically non-decreasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (lte ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (lte x y))) ([x y & more] (if (<= x y) (if (next more) (recur y (first more) (next more)) (<= y (first more))) false))) (defn > "Returns non-nil if nums are in monotonically decreasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (gt ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (gt x y))) ([x y & more] (if (> x y) (if (next more) (recur y (first more) (next more)) (> y (first more))) false))) (defn >= "Returns non-nil if nums are in monotonically non-increasing order, otherwise false." {:inline (fn [x y] `(. clojure.lang.Numbers (gte ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (gte x y))) ([x y & more] (if (>= x y) (if (next more) (recur y (first more) (next more)) (>= y (first more))) false))) (defn == "Returns non-nil if nums all have the equivalent value (type-independent), otherwise false" {:inline (fn [x y] `(. clojure.lang.Numbers (equiv ~x ~y))) :inline-arities #{2} :added "1.0"} ([x] true) ([x y] (. clojure.lang.Numbers (equiv x y))) ([x y & more] (if (== x y) (if (next more) (recur y (first more) (next more)) (== y (first more))) false))) (defn max "Returns the greatest of the nums." {:added "1.0" :inline-arities >1? :inline (nary-inline 'max)} ([x] x) ([x y] (. clojure.lang.Numbers (max x y))) ([x y & more] (reduce1 max (max x y) more))) (defn min "Returns the least of the nums." {:added "1.0" :inline-arities >1? :inline (nary-inline 'min)} ([x] x) ([x y] (. clojure.lang.Numbers (min x y))) ([x y & more] (reduce1 min (min x y) more))) (defn dec' "Returns a number one less than num. Supports arbitrary precision. See also: dec" {:inline (fn [x] `(. clojure.lang.Numbers (decP ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (decP x))) (defn dec "Returns a number one less than num. Does not auto-promote longs, will throw on overflow. See also: dec'" {:inline (fn [x] `(. clojure.lang.Numbers (~(if *unchecked-math* 'unchecked_dec 'dec) ~x))) :added "1.2"} [x] (. clojure.lang.Numbers (dec x))) (defn unchecked-inc-int "Returns a number one greater than x, an int. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_int_inc ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_int_inc x))) (defn unchecked-inc "Returns a number one greater than x, a long. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_inc ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_inc x))) (defn unchecked-dec-int "Returns a number one less than x, an int. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_int_dec ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_int_dec x))) (defn unchecked-dec "Returns a number one less than x, a long. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_dec ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_dec x))) (defn unchecked-negate-int "Returns the negation of x, an int. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_int_negate ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_int_negate x))) (defn unchecked-negate "Returns the negation of x, a long. Note - uses a primitive operator subject to overflow." {:inline (fn [x] `(. clojure.lang.Numbers (unchecked_minus ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (unchecked_minus x))) (defn unchecked-add-int "Returns the sum of x and y, both int. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_add ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_int_add x y))) (defn unchecked-add "Returns the sum of x and y, both long. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_add ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_add x y))) (defn unchecked-subtract-int "Returns the difference of x and y, both int. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_subtract ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_int_subtract x y))) (defn unchecked-subtract "Returns the difference of x and y, both long. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_minus ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_minus x y))) (defn unchecked-multiply-int "Returns the product of x and y, both int. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_multiply ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_int_multiply x y))) (defn unchecked-multiply "Returns the product of x and y, both long. Note - uses a primitive operator subject to overflow." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_multiply ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_multiply x y))) (defn unchecked-divide-int "Returns the division of x by y, both int. Note - uses a primitive operator subject to truncation." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_divide ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_int_divide x y))) (defn unchecked-remainder-int "Returns the remainder of division of x by y, both int. Note - uses a primitive operator subject to truncation." {:inline (fn [x y] `(. clojure.lang.Numbers (unchecked_int_remainder ~x ~y))) :added "1.0"} [x y] (. clojure.lang.Numbers (unchecked_int_remainder x y))) (defn pos? "Returns true if num is greater than zero, else false" { :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (isPos x))) (defn neg? "Returns true if num is less than zero, else false" { :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (isNeg x))) (defn quot "quot[ient] of dividing numerator by denominator." {:added "1.0" :static true :inline (fn [x y] `(. clojure.lang.Numbers (quotient ~x ~y)))} [num div] (. clojure.lang.Numbers (quotient num div))) (defn rem "remainder of dividing numerator by denominator." {:added "1.0" :static true :inline (fn [x y] `(. clojure.lang.Numbers (remainder ~x ~y)))} [num div] (. clojure.lang.Numbers (remainder num div))) (defn rationalize "returns the rational value of num" {:added "1.0" :static true} [num] (. clojure.lang.Numbers (rationalize num))) ;;Bit ops (defn bit-not "Bitwise complement" {:inline (fn [x] `(. clojure.lang.Numbers (not ~x))) :added "1.0"} [x] (. clojure.lang.Numbers not x)) (defn bit-and "Bitwise and" {:inline (nary-inline 'and) :inline-arities >1? :added "1.0"} ([x y] (. clojure.lang.Numbers and x y)) ([x y & more] (reduce1 bit-and (bit-and x y) more))) (defn bit-or "Bitwise or" {:inline (nary-inline 'or) :inline-arities >1? :added "1.0"} ([x y] (. clojure.lang.Numbers or x y)) ([x y & more] (reduce1 bit-or (bit-or x y) more))) (defn bit-xor "Bitwise exclusive or" {:inline (nary-inline 'xor) :inline-arities >1? :added "1.0"} ([x y] (. clojure.lang.Numbers xor x y)) ([x y & more] (reduce1 bit-xor (bit-xor x y) more))) (defn bit-and-not "Bitwise and with complement" {:inline (nary-inline 'andNot) :inline-arities >1? :added "1.0" :static true} ([x y] (. clojure.lang.Numbers andNot x y)) ([x y & more] (reduce1 bit-and-not (bit-and-not x y) more))) (defn bit-clear "Clear bit at index n" {:added "1.0" :static true} [x n] (. clojure.lang.Numbers clearBit x n)) (defn bit-set "Set bit at index n" {:added "1.0" :static true} [x n] (. clojure.lang.Numbers setBit x n)) (defn bit-flip "Flip bit at index n" {:added "1.0" :static true} [x n] (. clojure.lang.Numbers flipBit x n)) (defn bit-test "Test bit at index n" {:added "1.0" :static true} [x n] (. clojure.lang.Numbers testBit x n)) (defn bit-shift-left "Bitwise shift left" {:inline (fn [x n] `(. clojure.lang.Numbers (shiftLeft ~x ~n))) :added "1.0"} [x n] (. clojure.lang.Numbers shiftLeft x n)) (defn bit-shift-right "Bitwise shift right" {:inline (fn [x n] `(. clojure.lang.Numbers (shiftRight ~x ~n))) :added "1.0"} [x n] (. clojure.lang.Numbers shiftRight x n)) (defn unsigned-bit-shift-right "Bitwise shift right, without sign-extension." {:inline (fn [x n] `(. clojure.lang.Numbers (unsignedShiftRight ~x ~n))) :added "1.6"} [x n] (. clojure.lang.Numbers unsignedShiftRight x n)) (defn integer? "Returns true if n is an integer" {:added "1.0" :static true} [n] (or (instance? Integer n) (instance? Long n) (instance? clojure.lang.BigInt n) (instance? BigInteger n) (instance? Short n) (instance? Byte n))) (defn even? "Returns true if n is even, throws an exception if n is not an integer" {:added "1.0" :static true} [n] (if (integer? n) (zero? (bit-and (clojure.lang.RT/uncheckedLongCast n) 1)) (throw (IllegalArgumentException. (str "Argument must be an integer: " n))))) (defn odd? "Returns true if n is odd, throws an exception if n is not an integer" {:added "1.0" :static true} [n] (not (even? n))) ;; (defn complement "Takes a fn f and returns a fn that takes the same arguments as f, has the same effects, if any, and returns the opposite truth value." {:added "1.0" :static true} [f] (fn ([] (not (f))) ([x] (not (f x))) ([x y] (not (f x y))) ([x y & zs] (not (apply f x y zs))))) (defn constantly "Returns a function that takes any number of arguments and returns x." {:added "1.0" :static true} [x] (fn [& args] x)) (defn identity "Returns its argument." {:added "1.0" :static true} [x] x) ;;Collection stuff ;;list stuff (defn peek "For a list or queue, same as first, for a vector, same as, but much more efficient than, last. If the collection is empty, returns nil." {:added "1.0" :static true} [coll] (. clojure.lang.RT (peek coll))) (defn pop "For a list or queue, returns a new list/queue without the first item, for a vector, returns a new vector without the last item. If the collection is empty, throws an exception. Note - not the same as next/butlast." {:added "1.0" :static true} [coll] (. clojure.lang.RT (pop coll))) ;;map stuff (defn contains? "Returns true if key is present in the given collection, otherwise returns false. Note that for numerically indexed collections like vectors and Java arrays, this tests if the numeric key is within the range of indexes. 'contains?' operates constant or logarithmic time; it will not perform a linear search for a value. See also 'some'." {:added "1.0" :static true} [coll key] (. clojure.lang.RT (contains coll key))) (defn get "Returns the value mapped to key, not-found or nil if key not present." {:inline (fn [m k & nf] `(. clojure.lang.RT (get ~m ~k ~@nf))) :inline-arities #{2 3} :added "1.0"} ([map key] (. clojure.lang.RT (get map key))) ([map key not-found] (. clojure.lang.RT (get map key not-found)))) (defn dissoc "dissoc[iate]. Returns a new map of the same (hashed/sorted) type, that does not contain a mapping for key(s)." {:added "1.0" :static true} ([map] map) ([map key] (. clojure.lang.RT (dissoc map key))) ([map key & ks] (let [ret (dissoc map key)] (if ks (recur ret (first ks) (next ks)) ret)))) (defn disj "disj[oin]. Returns a new set of the same (hashed/sorted) type, that does not contain key(s)." {:added "1.0" :static true} ([set] set) ([^clojure.lang.IPersistentSet set key] (when set (. set (disjoin key)))) ([set key & ks] (when set (let [ret (disj set key)] (if ks (recur ret (first ks) (next ks)) ret))))) (defn find "Returns the map entry for key, or nil if key not present." {:added "1.0" :static true} [map key] (. clojure.lang.RT (find map key))) (defn select-keys "Returns a map containing only those entries in map whose key is in keys" {:added "1.0" :static true} [map keyseq] (loop [ret {} keys (seq keyseq)] (if keys (let [entry (. clojure.lang.RT (find map (first keys)))] (recur (if entry (conj ret entry) ret) (next keys))) (with-meta ret (meta map))))) (defn keys "Returns a sequence of the map's keys, in the same order as (seq map)." {:added "1.0" :static true} [map] (. clojure.lang.RT (keys map))) (defn vals "Returns a sequence of the map's values, in the same order as (seq map)." {:added "1.0" :static true} [map] (. clojure.lang.RT (vals map))) (defn key "Returns the key of the map entry." {:added "1.0" :static true} [^java.util.Map$Entry e] (. e (getKey))) (defn val "Returns the value in the map entry." {:added "1.0" :static true} [^java.util.Map$Entry e] (. e (getValue))) (defn rseq "Returns, in constant time, a seq of the items in rev (which can be a vector or sorted-map), in reverse order. If rev is empty returns nil" {:added "1.0" :static true} [^clojure.lang.Reversible rev] (. rev (rseq))) (defn name "Returns the name String of a string, symbol or keyword." {:tag String :added "1.0" :static true} [x] (if (string? x) x (. ^clojure.lang.Named x (getName)))) (defn namespace "Returns the namespace String of a symbol or keyword, or nil if not present." {:tag String :added "1.0" :static true} [^clojure.lang.Named x] (. x (getNamespace))) (defmacro locking "Executes exprs in an implicit do, while holding the monitor of x. Will release the monitor of x in all circumstances." {:added "1.0"} [x & body] `(let [lockee# ~x] (try (monitor-enter lockee#) ~@body (finally (monitor-exit lockee#))))) (defmacro .. "form => fieldName-symbol or (instanceMethodName-symbol args*) Expands into a member access (.) of the first member on the first argument, followed by the next member on the result, etc. For instance: (.. System (getProperties) (get \"os.name\")) expands to: (. (. System (getProperties)) (get \"os.name\")) but is easier to write, read, and understand." {:added "1.0"} ([x form] `(. ~x ~form)) ([x form & more] `(.. (. ~x ~form) ~@more))) (defmacro -> "Threads the expr through the forms. Inserts x as the second item in the first form, making a list of it if it is not a list already. If there are more forms, inserts the first form as the second item in second form, etc." {:added "1.0"} [x & forms] (loop [x x, forms forms] (if forms (let [form (first forms) threaded (if (seq? form) (with-meta `(~(first form) ~x ~@(next form)) (meta form)) (list form x))] (recur threaded (next forms))) x))) (defmacro ->> "Threads the expr through the forms. Inserts x as the last item in the first form, making a list of it if it is not a list already. If there are more forms, inserts the first form as the last item in second form, etc." {:added "1.1"} [x & forms] (loop [x x, forms forms] (if forms (let [form (first forms) threaded (if (seq? form) (with-meta `(~(first form) ~@(next form) ~x) (meta form)) (list form x))] (recur threaded (next forms))) x))) (def map) (defn ^:private check-valid-options "Throws an exception if the given option map contains keys not listed as valid, else returns nil." [options & valid-keys] (when (seq (apply disj (apply hash-set (keys options)) valid-keys)) (throw (IllegalArgumentException. ^String (apply str "Only these options are valid: " (first valid-keys) (map #(str ", " %) (rest valid-keys))))))) ;;multimethods (def global-hierarchy) (defmacro defmulti "Creates a new multimethod with the associated dispatch function. The docstring and attr-map are optional. Options are key-value pairs and may be one of: :default The default dispatch value, defaults to :default :hierarchy The value used for hierarchical dispatch (e.g. ::square is-a ::shape) Hierarchies are type-like relationships that do not depend upon type inheritance. By default Clojure's multimethods dispatch off of a global hierarchy map. However, a hierarchy relationship can be created with the derive function used to augment the root ancestor created with make-hierarchy. Multimethods expect the value of the hierarchy option to be supplied as a reference type e.g. a var (i.e. via the Var-quote dispatch macro #' or the var special form)." {:arglists '([name docstring? attr-map? dispatch-fn & options]) :added "1.0"} [mm-name & options] (let [docstring (if (string? (first options)) (first options) nil) options (if (string? (first options)) (next options) options) m (if (map? (first options)) (first options) {}) options (if (map? (first options)) (next options) options) dispatch-fn (first options) options (next options) m (if docstring (assoc m :doc docstring) m) m (if (meta mm-name) (conj (meta mm-name) m) m)] (when (= (count options) 1) (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))) (let [options (apply hash-map options) default (get options :default :default) hierarchy (get options :hierarchy #'global-hierarchy)] (check-valid-options options :default :hierarchy) `(let [v# (def ~mm-name)] (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#))) (def ~(with-meta mm-name m) (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy))))))) (defmacro defmethod "Creates and installs a new method of multimethod associated with dispatch-value. " {:added "1.0"} [multifn dispatch-val & fn-tail] `(. ~(with-meta multifn {:tag 'clojure.lang.MultiFn}) addMethod ~dispatch-val (fn ~@fn-tail))) (defn remove-all-methods "Removes all of the methods of multimethod." {:added "1.2" :static true} [^clojure.lang.MultiFn multifn] (.reset multifn)) (defn remove-method "Removes the method of multimethod associated with dispatch-value." {:added "1.0" :static true} [^clojure.lang.MultiFn multifn dispatch-val] (. multifn removeMethod dispatch-val)) (defn prefer-method "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y when there is a conflict" {:added "1.0" :static true} [^clojure.lang.MultiFn multifn dispatch-val-x dispatch-val-y] (. multifn preferMethod dispatch-val-x dispatch-val-y)) (defn methods "Given a multimethod, returns a map of dispatch values -> dispatch fns" {:added "1.0" :static true} [^clojure.lang.MultiFn multifn] (.getMethodTable multifn)) (defn get-method "Given a multimethod and a dispatch value, returns the dispatch fn that would apply to that value, or nil if none apply and no default" {:added "1.0" :static true} [^clojure.lang.MultiFn multifn dispatch-val] (.getMethod multifn dispatch-val)) (defn prefers "Given a multimethod, returns a map of preferred value -> set of other values" {:added "1.0" :static true} [^clojure.lang.MultiFn multifn] (.getPreferTable multifn)) ;;;;;;;;; var stuff (defmacro ^{:private true} assert-args [& pairs] `(do (when-not ~(first pairs) (throw (IllegalArgumentException. (str (first ~'&form) " requires " ~(second pairs) " in " ~'*ns* ":" (:line (meta ~'&form)))))) ~(let [more (nnext pairs)] (when more (list* `assert-args more))))) (defmacro if-let "bindings => binding-form test If test is true, evaluates then with binding-form bound to the value of test, if not, yields else" {:added "1.0"} ([bindings then] `(if-let ~bindings ~then nil)) ([bindings then else & oldform] (assert-args (vector? bindings) "a vector for its binding" (nil? oldform) "1 or 2 forms after binding vector" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [form (bindings 0) tst (bindings 1)] `(let [temp# ~tst] (if temp# (let [~form temp#] ~then) ~else))))) (defmacro when-let "bindings => binding-form test When test is true, evaluates body with binding-form bound to the value of test" {:added "1.0"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [form (bindings 0) tst (bindings 1)] `(let [temp# ~tst] (when temp# (let [~form temp#] ~@body))))) (defmacro if-some "bindings => binding-form test If test is not nil, evaluates then with binding-form bound to the value of test, if not, yields else" {:added "1.6"} ([bindings then] `(if-some ~bindings ~then nil)) ([bindings then else & oldform] (assert-args (vector? bindings) "a vector for its binding" (nil? oldform) "1 or 2 forms after binding vector" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [form (bindings 0) tst (bindings 1)] `(let [temp# ~tst] (if (nil? temp#) ~else (let [~form temp#] ~then)))))) (defmacro when-some "bindings => binding-form test When test is not nil, evaluates body with binding-form bound to the value of test" {:added "1.6"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [form (bindings 0) tst (bindings 1)] `(let [temp# ~tst] (if (nil? temp#) nil (let [~form temp#] ~@body))))) (defn push-thread-bindings "WARNING: This is a low-level function. Prefer high-level macros like binding where ever possible. Takes a map of Var/value pairs. Binds each Var to the associated value for the current thread. Each call *MUST* be accompanied by a matching call to pop-thread-bindings wrapped in a try-finally! (push-thread-bindings bindings) (try ... (finally (pop-thread-bindings)))" {:added "1.1" :static true} [bindings] (clojure.lang.Var/pushThreadBindings bindings)) (defn pop-thread-bindings "Pop one set of bindings pushed with push-binding before. It is an error to pop bindings without pushing before." {:added "1.1" :static true} [] (clojure.lang.Var/popThreadBindings)) (defn get-thread-bindings "Get a map with the Var/value pairs which is currently in effect for the current thread." {:added "1.1" :static true} [] (clojure.lang.Var/getThreadBindings)) (defmacro binding "binding => var-symbol init-expr Creates new bindings for the (already-existing) vars, with the supplied initial values, executes the exprs in an implicit do, then re-establishes the bindings that existed before. The new bindings are made in parallel (unlike let); all init-exprs are evaluated before the vars are bound to their new values." {:added "1.0"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (let [var-ize (fn [var-vals] (loop [ret [] vvs (seq var-vals)] (if vvs (recur (conj (conj ret `(var ~(first vvs))) (second vvs)) (next (next vvs))) (seq ret))))] `(let [] (push-thread-bindings (hash-map ~@(var-ize bindings))) (try ~@body (finally (pop-thread-bindings)))))) (defn with-bindings* "Takes a map of Var/value pairs. Installs for the given Vars the associated values as thread-local bindings. Then calls f with the supplied arguments. Pops the installed bindings after f returned. Returns whatever f returns." {:added "1.1" :static true} [binding-map f & args] (push-thread-bindings binding-map) (try (apply f args) (finally (pop-thread-bindings)))) (defmacro with-bindings "Takes a map of Var/value pairs. Installs for the given Vars the associated values as thread-local bindings. The executes body. Pops the installed bindings after body was evaluated. Returns the value of body." {:added "1.1"} [binding-map & body] `(with-bindings* ~binding-map (fn [] ~@body))) (defn bound-fn* "Returns a function, which will install the same bindings in effect as in the thread at the time bound-fn* was called and then call f with any given arguments. This may be used to define a helper function which runs on a different thread, but needs the same bindings in place." {:added "1.1" :static true} [f] (let [bindings (get-thread-bindings)] (fn [& args] (apply with-bindings* bindings f args)))) (defmacro bound-fn "Returns a function defined by the given fntail, which will install the same bindings in effect as in the thread at the time bound-fn was called. This may be used to define a helper function which runs on a different thread, but needs the same bindings in place." {:added "1.1"} [& fntail] `(bound-fn* (fn ~@fntail))) (defn find-var "Returns the global var named by the namespace-qualified symbol, or nil if no var with that name." {:added "1.0" :static true} [sym] (. clojure.lang.Var (find sym))) (defn binding-conveyor-fn {:private true :added "1.3"} [f] (let [frame (clojure.lang.Var/cloneThreadBindingFrame)] (fn ([] (clojure.lang.Var/resetThreadBindingFrame frame) (f)) ([x] (clojure.lang.Var/resetThreadBindingFrame frame) (f x)) ([x y] (clojure.lang.Var/resetThreadBindingFrame frame) (f x y)) ([x y z] (clojure.lang.Var/resetThreadBindingFrame frame) (f x y z)) ([x y z & args] (clojure.lang.Var/resetThreadBindingFrame frame) (apply f x y z args))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Refs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn ^{:private true} setup-reference [^clojure.lang.ARef r options] (let [opts (apply hash-map options)] (when (:meta opts) (.resetMeta r (:meta opts))) (when (:validator opts) (.setValidator r (:validator opts))) r)) (defn agent "Creates and returns an agent with an initial value of state and zero or more options (in any order): :meta metadata-map :validator validate-fn :error-handler handler-fn :error-mode mode-keyword If metadata-map is supplied, it will become the metadata on the agent. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception. handler-fn is called if an action throws an exception or if validate-fn rejects a new state -- see set-error-handler! for details. The mode-keyword may be either :continue (the default if an error-handler is given) or :fail (the default if no error-handler is given) -- see set-error-mode! for details." {:added "1.0" :static true } ([state & options] (let [a (new clojure.lang.Agent state) opts (apply hash-map options)] (setup-reference a options) (when (:error-handler opts) (.setErrorHandler a (:error-handler opts))) (.setErrorMode a (or (:error-mode opts) (if (:error-handler opts) :continue :fail))) a))) (defn set-agent-send-executor! "Sets the ExecutorService to be used by send" {:added "1.5"} [executor] (set! clojure.lang.Agent/pooledExecutor executor)) (defn set-agent-send-off-executor! "Sets the ExecutorService to be used by send-off" {:added "1.5"} [executor] (set! clojure.lang.Agent/soloExecutor executor)) (defn send-via "Dispatch an action to an agent. Returns the agent immediately. Subsequently, in a thread supplied by executor, the state of the agent will be set to the value of: (apply action-fn state-of-agent args)" {:added "1.5"} [executor ^clojure.lang.Agent a f & args] (.dispatch a (binding [*agent* a] (binding-conveyor-fn f)) args executor)) (defn send "Dispatch an action to an agent. Returns the agent immediately. Subsequently, in a thread from a thread pool, the state of the agent will be set to the value of: (apply action-fn state-of-agent args)" {:added "1.0" :static true} [^clojure.lang.Agent a f & args] (apply send-via clojure.lang.Agent/pooledExecutor a f args)) (defn send-off "Dispatch a potentially blocking action to an agent. Returns the agent immediately. Subsequently, in a separate thread, the state of the agent will be set to the value of: (apply action-fn state-of-agent args)" {:added "1.0" :static true} [^clojure.lang.Agent a f & args] (apply send-via clojure.lang.Agent/soloExecutor a f args)) (defn release-pending-sends "Normally, actions sent directly or indirectly during another action are held until the action completes (changes the agent's state). This function can be used to dispatch any pending sent actions immediately. This has no impact on actions sent during a transaction, which are still held until commit. If no action is occurring, does nothing. Returns the number of actions dispatched." {:added "1.0" :static true} [] (clojure.lang.Agent/releasePendingSends)) (defn add-watch "Adds a watch function to an agent/atom/var/ref reference. The watch fn must be a fn of 4 args: a key, the reference, its old-state, its new-state. Whenever the reference's state might have been changed, any registered watches will have their functions called. The watch fn will be called synchronously, on the agent's thread if an agent, before any pending sends if agent or ref. Note that an atom's or ref's state may have changed again prior to the fn call, so use old/new-state rather than derefing the reference. Note also that watch fns may be called from multiple threads simultaneously. Var watchers are triggered only by root binding changes, not thread-local set!s. Keys must be unique per reference, and can be used to remove the watch with remove-watch, but are otherwise considered opaque by the watch mechanism." {:added "1.0" :static true} [^clojure.lang.IRef reference key fn] (.addWatch reference key fn)) (defn remove-watch "Removes a watch (set by add-watch) from a reference" {:added "1.0" :static true} [^clojure.lang.IRef reference key] (.removeWatch reference key)) (defn agent-error "Returns the exception thrown during an asynchronous action of the agent if the agent is failed. Returns nil if the agent is not failed." {:added "1.2" :static true} [^clojure.lang.Agent a] (.getError a)) (defn restart-agent "When an agent is failed, changes the agent state to new-state and then un-fails the agent so that sends are allowed again. If a :clear-actions true option is given, any actions queued on the agent that were being held while it was failed will be discarded, otherwise those held actions will proceed. The new-state must pass the validator if any, or restart will throw an exception and the agent will remain failed with its old state and error. Watchers, if any, will NOT be notified of the new state. Throws an exception if the agent is not failed." {:added "1.2" :static true } [^clojure.lang.Agent a, new-state & options] (let [opts (apply hash-map options)] (.restart a new-state (if (:clear-actions opts) true false)))) (defn set-error-handler! "Sets the error-handler of agent a to handler-fn. If an action being run by the agent throws an exception or doesn't pass the validator fn, handler-fn will be called with two arguments: the agent and the exception." {:added "1.2" :static true} [^clojure.lang.Agent a, handler-fn] (.setErrorHandler a handler-fn)) (defn error-handler "Returns the error-handler of agent a, or nil if there is none. See set-error-handler!" {:added "1.2" :static true} [^clojure.lang.Agent a] (.getErrorHandler a)) (defn set-error-mode! "Sets the error-mode of agent a to mode-keyword, which must be either :fail or :continue. If an action being run by the agent throws an exception or doesn't pass the validator fn, an error-handler may be called (see set-error-handler!), after which, if the mode is :continue, the agent will continue as if neither the action that caused the error nor the error itself ever happened. If the mode is :fail, the agent will become failed and will stop accepting new 'send' and 'send-off' actions, and any previously queued actions will be held until a 'restart-agent'. Deref will still work, returning the state of the agent before the error." {:added "1.2" :static true} [^clojure.lang.Agent a, mode-keyword] (.setErrorMode a mode-keyword)) (defn error-mode "Returns the error-mode of agent a. See set-error-mode!" {:added "1.2" :static true} [^clojure.lang.Agent a] (.getErrorMode a)) (defn agent-errors "DEPRECATED: Use 'agent-error' instead. Returns a sequence of the exceptions thrown during asynchronous actions of the agent." {:added "1.0" :deprecated "1.2"} [a] (when-let [e (agent-error a)] (list e))) (defn clear-agent-errors "DEPRECATED: Use 'restart-agent' instead. Clears any exceptions thrown during asynchronous actions of the agent, allowing subsequent actions to occur." {:added "1.0" :deprecated "1.2"} [^clojure.lang.Agent a] (restart-agent a (.deref a))) (defn shutdown-agents "Initiates a shutdown of the thread pools that back the agent system. Running actions will complete, but no new actions will be accepted" {:added "1.0" :static true} [] (. clojure.lang.Agent shutdown)) (defn ref "Creates and returns a Ref with an initial value of x and zero or more options (in any order): :meta metadata-map :validator validate-fn :min-history (default 0) :max-history (default 10) If metadata-map is supplied, it will become the metadata on the ref. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception. validate-fn will be called on transaction commit, when all refs have their final values. Normally refs accumulate history dynamically as needed to deal with read demands. If you know in advance you will need history you can set :min-history to ensure it will be available when first needed (instead of after a read fault). History is limited, and the limit can be set with :max-history." {:added "1.0" :static true } ([x] (new clojure.lang.Ref x)) ([x & options] (let [r ^clojure.lang.Ref (setup-reference (ref x) options) opts (apply hash-map options)] (when (:max-history opts) (.setMaxHistory r (:max-history opts))) (when (:min-history opts) (.setMinHistory r (:min-history opts))) r))) (defn ^:private deref-future ([^java.util.concurrent.Future fut] (.get fut)) ([^java.util.concurrent.Future fut timeout-ms timeout-val] (try (.get fut timeout-ms java.util.concurrent.TimeUnit/MILLISECONDS) (catch java.util.concurrent.TimeoutException e timeout-val)))) (defn deref "Also reader macro: @ref/@agent/@var/@atom/@delay/@future/@promise. Within a transaction, returns the in-transaction-value of ref, else returns the most-recently-committed value of ref. When applied to a var, agent or atom, returns its current state. When applied to a delay, forces it if not already forced. When applied to a future, will block if computation not complete. When applied to a promise, will block until a value is delivered. The variant taking a timeout can be used for blocking references (futures and promises), and will return timeout-val if the timeout (in milliseconds) is reached before a value is available. See also - realized?." {:added "1.0" :static true} ([ref] (if (instance? clojure.lang.IDeref ref) (.deref ^clojure.lang.IDeref ref) (deref-future ref))) ([ref timeout-ms timeout-val] (if (instance? clojure.lang.IBlockingDeref ref) (.deref ^clojure.lang.IBlockingDeref ref timeout-ms timeout-val) (deref-future ref timeout-ms timeout-val)))) (defn atom "Creates and returns an Atom with an initial value of x and zero or more options (in any order): :meta metadata-map :validator validate-fn If metadata-map is supplied, it will become the metadata on the atom. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception." {:added "1.0" :static true} ([x] (new clojure.lang.Atom x)) ([x & options] (setup-reference (atom x) options))) (defn swap! "Atomically swaps the value of atom to be: (apply f current-value-of-atom args). Note that f may be called multiple times, and thus should be free of side effects. Returns the value that was swapped in." {:added "1.0" :static true} ([^clojure.lang.IAtom atom f] (.swap atom f)) ([^clojure.lang.IAtom atom f x] (.swap atom f x)) ([^clojure.lang.IAtom atom f x y] (.swap atom f x y)) ([^clojure.lang.IAtom atom f x y & args] (.swap atom f x y args))) (defn compare-and-set! "Atomically sets the value of atom to newval if and only if the current value of the atom is identical to oldval. Returns true if set happened, else false" {:added "1.0" :static true} [^clojure.lang.IAtom atom oldval newval] (.compareAndSet atom oldval newval)) (defn reset! "Sets the value of atom to newval without regard for the current value. Returns newval." {:added "1.0" :static true} [^clojure.lang.IAtom atom newval] (.reset atom newval)) (defn set-validator! "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validator-fn should return false or throw an exception. If the current state (root value if var) is not acceptable to the new validator, an exception will be thrown and the validator will not be changed." {:added "1.0" :static true} [^clojure.lang.IRef iref validator-fn] (. iref (setValidator validator-fn))) (defn get-validator "Gets the validator-fn for a var/ref/agent/atom." {:added "1.0" :static true} [^clojure.lang.IRef iref] (. iref (getValidator))) (defn alter-meta! "Atomically sets the metadata for a namespace/var/ref/agent/atom to be: (apply f its-current-meta args) f must be free of side-effects" {:added "1.0" :static true} [^clojure.lang.IReference iref f & args] (.alterMeta iref f args)) (defn reset-meta! "Atomically resets the metadata for a namespace/var/ref/agent/atom" {:added "1.0" :static true} [^clojure.lang.IReference iref metadata-map] (.resetMeta iref metadata-map)) (defn commute "Must be called in a transaction. Sets the in-transaction-value of ref to: (apply fun in-transaction-value-of-ref args) and returns the in-transaction-value of ref. At the commit point of the transaction, sets the value of ref to be: (apply fun most-recently-committed-value-of-ref args) Thus fun should be commutative, or, failing that, you must accept last-one-in-wins behavior. commute allows for more concurrency than ref-set." {:added "1.0" :static true} [^clojure.lang.Ref ref fun & args] (. ref (commute fun args))) (defn alter "Must be called in a transaction. Sets the in-transaction-value of ref to: (apply fun in-transaction-value-of-ref args) and returns the in-transaction-value of ref." {:added "1.0" :static true} [^clojure.lang.Ref ref fun & args] (. ref (alter fun args))) (defn ref-set "Must be called in a transaction. Sets the value of ref. Returns val." {:added "1.0" :static true} [^clojure.lang.Ref ref val] (. ref (set val))) (defn ref-history-count "Returns the history count of a ref" {:added "1.1" :static true} [^clojure.lang.Ref ref] (.getHistoryCount ref)) (defn ref-min-history "Gets the min-history of a ref, or sets it and returns the ref" {:added "1.1" :static true} ([^clojure.lang.Ref ref] (.getMinHistory ref)) ([^clojure.lang.Ref ref n] (.setMinHistory ref n))) (defn ref-max-history "Gets the max-history of a ref, or sets it and returns the ref" {:added "1.1" :static true} ([^clojure.lang.Ref ref] (.getMaxHistory ref)) ([^clojure.lang.Ref ref n] (.setMaxHistory ref n))) (defn ensure "Must be called in a transaction. Protects the ref from modification by other transactions. Returns the in-transaction-value of ref. Allows for more concurrency than (ref-set ref @ref)" {:added "1.0" :static true} [^clojure.lang.Ref ref] (. ref (touch)) (. ref (deref))) (defmacro sync "transaction-flags => TBD, pass nil for now Runs the exprs (in an implicit do) in a transaction that encompasses exprs and any nested calls. Starts a transaction if none is already running on this thread. Any uncaught exception will abort the transaction and flow out of sync. The exprs may be run more than once, but any effects on Refs will be atomic." {:added "1.0"} [flags-ignored-for-now & body] `(. clojure.lang.LockingTransaction (runInTransaction (fn [] ~@body)))) (defmacro io! "If an io! block occurs in a transaction, throws an IllegalStateException, else runs body in an implicit do. If the first expression in body is a literal string, will use that as the exception message." {:added "1.0"} [& body] (let [message (when (string? (first body)) (first body)) body (if message (next body) body)] `(if (clojure.lang.LockingTransaction/isRunning) (throw (new IllegalStateException ~(or message "I/O in transaction"))) (do ~@body)))) (defn volatile! "Creates and returns a Volatile with an initial value of val." {:added "1.7" :tag clojure.lang.Volatile} [val] (clojure.lang.Volatile. val)) (defn vreset! "Sets the value of volatile to newval without regard for the current value. Returns newval." {:added "1.7"} [^clojure.lang.Volatile vol newval] (.reset vol newval)) (defmacro vswap! "Non-atomically swaps the value of the volatile as if: (apply f current-value-of-vol args). Returns the value that was swapped in." {:added "1.7"} [vol f & args] (let [v (with-meta vol {:tag 'clojure.lang.Volatile})] `(.reset ~v (~f (.deref ~v) ~@args)))) (defn volatile? "Returns true if x is a volatile." {:added "1.7"} [x] (instance? clojure.lang.Volatile x)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn stuff ;;;;;;;;;;;;;;;; (defn comp "Takes a set of functions and returns a fn that is the composition of those fns. The returned fn takes a variable number of args, applies the rightmost of fns to the args, the next fn (right-to-left) to the result, etc." {:added "1.0" :static true} ([] identity) ([f] f) ([f g] (fn ([] (f (g))) ([x] (f (g x))) ([x y] (f (g x y))) ([x y z] (f (g x y z))) ([x y z & args] (f (apply g x y z args))))) ([f g & fs] (reduce1 comp (list* f g fs)))) (defn juxt "Takes a set of functions and returns a fn that is the juxtaposition of those fns. The returned fn takes a variable number of args, and returns a vector containing the result of applying each fn to the args (left-to-right). ((juxt a b c) x) => [(a x) (b x) (c x)]" {:added "1.1" :static true} ([f] (fn ([] [(f)]) ([x] [(f x)]) ([x y] [(f x y)]) ([x y z] [(f x y z)]) ([x y z & args] [(apply f x y z args)]))) ([f g] (fn ([] [(f) (g)]) ([x] [(f x) (g x)]) ([x y] [(f x y) (g x y)]) ([x y z] [(f x y z) (g x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args)]))) ([f g h] (fn ([] [(f) (g) (h)]) ([x] [(f x) (g x) (h x)]) ([x y] [(f x y) (g x y) (h x y)]) ([x y z] [(f x y z) (g x y z) (h x y z)]) ([x y z & args] [(apply f x y z args) (apply g x y z args) (apply h x y z args)]))) ([f g h & fs] (let [fs (list* f g h fs)] (fn ([] (reduce1 #(conj %1 (%2)) [] fs)) ([x] (reduce1 #(conj %1 (%2 x)) [] fs)) ([x y] (reduce1 #(conj %1 (%2 x y)) [] fs)) ([x y z] (reduce1 #(conj %1 (%2 x y z)) [] fs)) ([x y z & args] (reduce1 #(conj %1 (apply %2 x y z args)) [] fs)))))) (defn partial "Takes a function f and fewer than the normal arguments to f, and returns a fn that takes a variable number of additional args. When called, the returned function calls f with args + additional args." {:added "1.0" :static true} ([f] f) ([f arg1] (fn ([] (f arg1)) ([x] (f arg1 x)) ([x y] (f arg1 x y)) ([x y z] (f arg1 x y z)) ([x y z & args] (apply f arg1 x y z args)))) ([f arg1 arg2] (fn ([] (f arg1 arg2)) ([x] (f arg1 arg2 x)) ([x y] (f arg1 arg2 x y)) ([x y z] (f arg1 arg2 x y z)) ([x y z & args] (apply f arg1 arg2 x y z args)))) ([f arg1 arg2 arg3] (fn ([] (f arg1 arg2 arg3)) ([x] (f arg1 arg2 arg3 x)) ([x y] (f arg1 arg2 arg3 x y)) ([x y z] (f arg1 arg2 arg3 x y z)) ([x y z & args] (apply f arg1 arg2 arg3 x y z args)))) ([f arg1 arg2 arg3 & more] (fn [& args] (apply f arg1 arg2 arg3 (concat more args))))) ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; (defn sequence "Coerces coll to a (possibly empty) sequence, if it is not already one. Will not force a lazy seq. (sequence nil) yields (), When a transducer is supplied, returns a lazy sequence of applications of the transform to the items in coll(s), i.e. to the set of first items of each coll, followed by the set of second items in each coll, until any one of the colls is exhausted. Any remaining items in other colls are ignored. The transform should accept number-of-colls arguments" {:added "1.0" :static true} ([coll] (if (seq? coll) coll (or (seq coll) ()))) ([xform coll] (or (clojure.lang.RT/chunkIteratorSeq (clojure.lang.TransformerIterator/create xform (clojure.lang.RT/iter coll))) ())) ([xform coll & colls] (or (clojure.lang.RT/chunkIteratorSeq (clojure.lang.TransformerIterator/createMulti xform (map #(clojure.lang.RT/iter %) (cons coll colls)))) ()))) (defn every? "Returns true if (pred x) is logical true for every x in coll, else false." {:tag Boolean :added "1.0" :static true} [pred coll] (cond (nil? (seq coll)) true (pred (first coll)) (recur pred (next coll)) :else false)) (def ^{:tag Boolean :doc "Returns false if (pred x) is logical true for every x in coll, else true." :arglists '([pred coll]) :added "1.0"} not-every? (comp not every?)) (defn some "Returns the first logical true value of (pred x) for any x in coll, else nil. One common idiom is to use a set as pred, for example this will return :fred if :fred is in the sequence, otherwise nil: (some #{:fred} coll)" {:added "1.0" :static true} [pred coll] (when (seq coll) (or (pred (first coll)) (recur pred (next coll))))) (def ^{:tag Boolean :doc "Returns false if (pred x) is logical true for any x in coll, else true." :arglists '([pred coll]) :added "1.0"} not-any? (comp not some)) ;will be redefed later with arg checks (defmacro dotimes "bindings => name n Repeatedly executes body (presumably for side-effects) with name bound to integers from 0 through n-1." {:added "1.0"} [bindings & body] (let [i (first bindings) n (second bindings)] `(let [n# (clojure.lang.RT/longCast ~n)] (loop [~i 0] (when (< ~i n#) ~@body (recur (unchecked-inc ~i))))))) (defn map "Returns a lazy sequence consisting of the result of applying f to the set of first items of each coll, followed by applying f to the set of second items in each coll, until any one of the colls is exhausted. Any remaining items in other colls are ignored. Function f should accept number-of-colls arguments. Returns a transducer when no collection is provided." {:added "1.0" :static true} ([f] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (rf result (f input))) ([result input & inputs] (rf result (apply f input inputs)))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (int (count c)) b (chunk-buffer size)] (dotimes [i size] (chunk-append b (f (.nth c i)))) (chunk-cons (chunk b) (map f (chunk-rest s)))) (cons (f (first s)) (map f (rest s))))))) ([f c1 c2] (lazy-seq (let [s1 (seq c1) s2 (seq c2)] (when (and s1 s2) (cons (f (first s1) (first s2)) (map f (rest s1) (rest s2))))))) ([f c1 c2 c3] (lazy-seq (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] (when (and s1 s2 s3) (cons (f (first s1) (first s2) (first s3)) (map f (rest s1) (rest s2) (rest s3))))))) ([f c1 c2 c3 & colls] (let [step (fn step [cs] (lazy-seq (let [ss (map seq cs)] (when (every? identity ss) (cons (map first ss) (step (map rest ss)))))))] (map #(apply f %) (step (conj colls c3 c2 c1)))))) (defmacro declare "defs the supplied var names with no bindings, useful for making forward declarations." {:added "1.0"} [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names))) (declare cat) (defn mapcat "Returns the result of applying concat to the result of applying map to f and colls. Thus function f should return a collection. Returns a transducer when no collections are provided" {:added "1.0" :static true} ([f] (comp (map f) cat)) ([f & colls] (apply concat (apply map f colls)))) (defn filter "Returns a lazy sequence of the items in coll for which (pred item) returns true. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} ([pred] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (if (pred input) (rf result input) result))))) ([pred coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [v (.nth c i)] (when (pred v) (chunk-append b v)))) (chunk-cons (chunk b) (filter pred (chunk-rest s)))) (let [f (first s) r (rest s)] (if (pred f) (cons f (filter pred r)) (filter pred r)))))))) (defn remove "Returns a lazy sequence of the items in coll for which (pred item) returns false. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} ([pred] (filter (complement pred))) ([pred coll] (filter (complement pred) coll))) (defn reduced "Wraps x in a way such that a reduce will terminate with the value x" {:added "1.5"} [x] (clojure.lang.Reduced. x)) (defn reduced? "Returns true if x is the result of a call to reduced" {:inline (fn [x] `(clojure.lang.RT/isReduced ~x )) :inline-arities #{1} :added "1.5"} ([x] (clojure.lang.RT/isReduced x))) (defn ensure-reduced "If x is already reduced?, returns it, else returns (reduced x)" {:added "1.7"} [x] (if (reduced? x) x (reduced x))) (defn unreduced "If x is reduced?, returns (deref x), else returns x" {:added "1.7"} [x] (if (reduced? x) (deref x) x)) (defn take "Returns a lazy sequence of the first n items in coll, or all items if there are fewer than n. Returns a stateful transducer when no collection is provided." {:added "1.0" :static true} ([n] (fn [rf] (let [nv (volatile! n)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [n @nv nn (vswap! nv dec) result (if (pos? n) (rf result input) result)] (if (not (pos? nn)) (ensure-reduced result) result))))))) ([n coll] (lazy-seq (when (pos? n) (when-let [s (seq coll)] (cons (first s) (take (dec n) (rest s)))))))) (defn take-while "Returns a lazy sequence of successive items from coll while (pred item) returns true. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} ([pred] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (if (pred input) (rf result input) (reduced result)))))) ([pred coll] (lazy-seq (when-let [s (seq coll)] (when (pred (first s)) (cons (first s) (take-while pred (rest s)))))))) (defn drop "Returns a lazy sequence of all but the first n items in coll. Returns a stateful transducer when no collection is provided." {:added "1.0" :static true} ([n] (fn [rf] (let [nv (volatile! n)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [n @nv] (vswap! nv dec) (if (pos? n) result (rf result input)))))))) ([n coll] (let [step (fn [n coll] (let [s (seq coll)] (if (and (pos? n) s) (recur (dec n) (rest s)) s)))] (lazy-seq (step n coll))))) (defn drop-last "Return a lazy sequence of all but the last n (default 1) items in coll" {:added "1.0" :static true} ([s] (drop-last 1 s)) ([n s] (map (fn [x _] x) s (drop n s)))) (defn take-last "Returns a seq of the last n items in coll. Depending on the type of coll may be no better than linear time. For vectors, see also subvec." {:added "1.1" :static true} [n coll] (loop [s (seq coll), lead (seq (drop n coll))] (if lead (recur (next s) (next lead)) s))) (defn drop-while "Returns a lazy sequence of the items in coll starting from the first item for which (pred item) returns logical false. Returns a stateful transducer when no collection is provided." {:added "1.0" :static true} ([pred] (fn [rf] (let [dv (volatile! true)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [drop? @dv] (if (and drop? (pred input)) result (do (vreset! dv nil) (rf result input))))))))) ([pred coll] (let [step (fn [pred coll] (let [s (seq coll)] (if (and s (pred (first s))) (recur pred (rest s)) s)))] (lazy-seq (step pred coll))))) (defn cycle "Returns a lazy (infinite!) sequence of repetitions of the items in coll." {:added "1.0" :static true} [coll] (clojure.lang.Cycle/create (seq coll))) (defn split-at "Returns a vector of [(take n coll) (drop n coll)]" {:added "1.0" :static true} [n coll] [(take n coll) (drop n coll)]) (defn split-with "Returns a vector of [(take-while pred coll) (drop-while pred coll)]" {:added "1.0" :static true} [pred coll] [(take-while pred coll) (drop-while pred coll)]) (defn repeat "Returns a lazy (infinite!, or length n if supplied) sequence of xs." {:added "1.0" :static true} ([x] (clojure.lang.Repeat/create x)) ([n x] (clojure.lang.Repeat/create n x))) (defn replicate "DEPRECATED: Use 'repeat' instead. Returns a lazy seq of n xs." {:added "1.0" :deprecated "1.3"} [n x] (take n (repeat x))) (defn iterate "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects" {:added "1.0" :static true} [f x] (clojure.lang.Iterate/create f x) ) (defn range "Returns a lazy seq of nums from start (inclusive) to end (exclusive), by step, where start defaults to 0, step to 1, and end to infinity. When step is equal to 0, returns an infinite sequence of start. When start is equal to end, returns empty list." {:added "1.0" :static true} ([] (iterate inc' 0)) ([end] (if (instance? Long end) (clojure.lang.LongRange/create end) (clojure.lang.Range/create end))) ([start end] (if (and (instance? Long start) (instance? Long end)) (clojure.lang.LongRange/create start end) (clojure.lang.Range/create start end))) ([start end step] (if (and (instance? Long start) (instance? Long end) (instance? Long step)) (clojure.lang.LongRange/create start end step) (clojure.lang.Range/create start end step)))) (defn merge "Returns a map that consists of the rest of the maps conj-ed onto the first. If a key occurs in more than one map, the mapping from the latter (left-to-right) will be the mapping in the result." {:added "1.0" :static true} [& maps] (when (some identity maps) (reduce1 #(conj (or %1 {}) %2) maps))) (defn merge-with "Returns a map that consists of the rest of the maps conj-ed onto the first. If a key occurs in more than one map, the mapping(s) from the latter (left-to-right) will be combined with the mapping in the result by calling (f val-in-result val-in-latter)." {:added "1.0" :static true} [f & maps] (when (some identity maps) (let [merge-entry (fn [m e] (let [k (key e) v (val e)] (if (contains? m k) (assoc m k (f (get m k) v)) (assoc m k v)))) merge2 (fn [m1 m2] (reduce1 merge-entry (or m1 {}) (seq m2)))] (reduce1 merge2 maps)))) (defn zipmap "Returns a map with the keys mapped to the corresponding vals." {:added "1.0" :static true} [keys vals] (loop [map {} ks (seq keys) vs (seq vals)] (if (and ks vs) (recur (assoc map (first ks) (first vs)) (next ks) (next vs)) map))) (defn line-seq "Returns the lines of text from rdr as a lazy sequence of strings. rdr must implement java.io.BufferedReader." {:added "1.0" :static true} [^java.io.BufferedReader rdr] (when-let [line (.readLine rdr)] (cons line (lazy-seq (line-seq rdr))))) (defn comparator "Returns an implementation of java.util.Comparator based upon pred." {:added "1.0" :static true} [pred] (fn [x y] (cond (pred x y) -1 (pred y x) 1 :else 0))) (defn sort "Returns a sorted sequence of the items in coll. If no comparator is supplied, uses compare. comparator must implement java.util.Comparator. If coll is a Java array, it will be modified. To avoid this, sort a copy of the array." {:added "1.0" :static true} ([coll] (sort compare coll)) ([^java.util.Comparator comp coll] (if (seq coll) (let [a (to-array coll)] (. java.util.Arrays (sort a comp)) (seq a)) ()))) (defn sort-by "Returns a sorted sequence of the items in coll, where the sort order is determined by comparing (keyfn item). If no comparator is supplied, uses compare. comparator must implement java.util.Comparator. If coll is a Java array, it will be modified. To avoid this, sort a copy of the array." {:added "1.0" :static true} ([keyfn coll] (sort-by keyfn compare coll)) ([keyfn ^java.util.Comparator comp coll] (sort (fn [x y] (. comp (compare (keyfn x) (keyfn y)))) coll))) (defn dorun "When lazy sequences are produced via functions that have side effects, any effects other than those needed to produce the first element in the seq do not occur until the seq is consumed. dorun can be used to force any effects. Walks through the successive nexts of the seq, does not retain the head and returns nil." {:added "1.0" :static true} ([coll] (when-let [s (seq coll)] (recur (next s)))) ([n coll] (when (and (seq coll) (pos? n)) (recur (dec n) (next coll))))) (defn doall "When lazy sequences are produced via functions that have side effects, any effects other than those needed to produce the first element in the seq do not occur until the seq is consumed. doall can be used to force any effects. Walks through the successive nexts of the seq, retains the head and returns it, thus causing the entire seq to reside in memory at one time." {:added "1.0" :static true} ([coll] (dorun coll) coll) ([n coll] (dorun n coll) coll)) (defn nthnext "Returns the nth next of coll, (seq coll) when n is 0." {:added "1.0" :static true} [coll n] (loop [n n xs (seq coll)] (if (and xs (pos? n)) (recur (dec n) (next xs)) xs))) (defn nthrest "Returns the nth rest of coll, coll when n is 0." {:added "1.3" :static true} [coll n] (loop [n n xs coll] (if-let [xs (and (pos? n) (seq xs))] (recur (dec n) (rest xs)) xs))) (defn partition "Returns a lazy sequence of lists of n items each, at offsets step apart. If step is not supplied, defaults to n, i.e. the partitions do not overlap. If a pad collection is supplied, use its elements as necessary to complete last partition upto n items. In case there are not enough padding elements, return a partition with less than n items." {:added "1.0" :static true} ([n coll] (partition n n coll)) ([n step coll] (lazy-seq (when-let [s (seq coll)] (let [p (doall (take n s))] (when (= n (count p)) (cons p (partition n step (nthrest s step)))))))) ([n step pad coll] (lazy-seq (when-let [s (seq coll)] (let [p (doall (take n s))] (if (= n (count p)) (cons p (partition n step pad (nthrest s step))) (list (take n (concat p pad))))))))) ;; evaluation (defn eval "Evaluates the form data structure (not text!) and returns the result." {:added "1.0" :static true} [form] (. clojure.lang.Compiler (eval form))) (defmacro doseq "Repeatedly executes body (presumably for side-effects) with bindings and filtering as provided by \"for\". Does not retain the head of the sequence. Returns nil." {:added "1.0"} [seq-exprs & body] (assert-args (vector? seq-exprs) "a vector for its binding" (even? (count seq-exprs)) "an even number of forms in binding vector") (let [step (fn step [recform exprs] (if-not exprs [true `(do ~@body)] (let [k (first exprs) v (second exprs)] (if (keyword? k) (let [steppair (step recform (nnext exprs)) needrec (steppair 0) subform (steppair 1)] (cond (= k :let) [needrec `(let ~v ~subform)] (= k :while) [false `(when ~v ~subform ~@(when needrec [recform]))] (= k :when) [false `(if ~v (do ~subform ~@(when needrec [recform])) ~recform)])) (let [seq- (gensym "seq_") chunk- (with-meta (gensym "chunk_") {:tag 'clojure.lang.IChunk}) count- (gensym "count_") i- (gensym "i_") recform `(recur (next ~seq-) nil 0 0) steppair (step recform (nnext exprs)) needrec (steppair 0) subform (steppair 1) recform-chunk `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-)) steppair-chunk (step recform-chunk (nnext exprs)) subform-chunk (steppair-chunk 1)] [true `(loop [~seq- (seq ~v), ~chunk- nil, ~count- 0, ~i- 0] (if (< ~i- ~count-) (let [~k (.nth ~chunk- ~i-)] ~subform-chunk ~@(when needrec [recform-chunk])) (when-let [~seq- (seq ~seq-)] (if (chunked-seq? ~seq-) (let [c# (chunk-first ~seq-)] (recur (chunk-rest ~seq-) c# (int (count c#)) (int 0))) (let [~k (first ~seq-)] ~subform ~@(when needrec [recform]))))))])))))] (nth (step nil (seq seq-exprs)) 1))) (defn await "Blocks the current thread (indefinitely!) until all actions dispatched thus far, from this thread or agent, to the agent(s) have occurred. Will block on failed agents. Will never return if a failed agent is restarted with :clear-actions true." {:added "1.0" :static true} [& agents] (io! "await in transaction" (when *agent* (throw (new Exception "Can't await in agent action"))) (let [latch (new java.util.concurrent.CountDownLatch (count agents)) count-down (fn [agent] (. latch (countDown)) agent)] (doseq [agent agents] (send agent count-down)) (. latch (await))))) (defn ^:static await1 [^clojure.lang.Agent a] (when (pos? (.getQueueCount a)) (await a)) a) (defn await-for "Blocks the current thread until all actions dispatched thus far (from this thread or agent) to the agents have occurred, or the timeout (in milliseconds) has elapsed. Returns logical false if returning due to timeout, logical true otherwise." {:added "1.0" :static true} [timeout-ms & agents] (io! "await-for in transaction" (when *agent* (throw (new Exception "Can't await in agent action"))) (let [latch (new java.util.concurrent.CountDownLatch (count agents)) count-down (fn [agent] (. latch (countDown)) agent)] (doseq [agent agents] (send agent count-down)) (. latch (await timeout-ms (. java.util.concurrent.TimeUnit MILLISECONDS)))))) (defmacro dotimes "bindings => name n Repeatedly executes body (presumably for side-effects) with name bound to integers from 0 through n-1." {:added "1.0"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [i (first bindings) n (second bindings)] `(let [n# (long ~n)] (loop [~i 0] (when (< ~i n#) ~@body (recur (unchecked-inc ~i))))))) #_(defn into "Returns a new coll consisting of to-coll with all of the items of from-coll conjoined." {:added "1.0"} [to from] (let [ret to items (seq from)] (if items (recur (conj ret (first items)) (next items)) ret))) ;;;;;;;;;;;;;;;;;;;;; editable collections ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn transient "Returns a new, transient version of the collection, in constant time." {:added "1.1" :static true} [^clojure.lang.IEditableCollection coll] (.asTransient coll)) (defn persistent! "Returns a new, persistent version of the transient collection, in constant time. The transient collection cannot be used after this call, any such use will throw an exception." {:added "1.1" :static true} [^clojure.lang.ITransientCollection coll] (.persistent coll)) (defn conj! "Adds x to the transient collection, and return coll. The 'addition' may happen at different 'places' depending on the concrete type." {:added "1.1" :static true} ([] (transient [])) ([coll] coll) ([^clojure.lang.ITransientCollection coll x] (.conj coll x))) (defn assoc! "When applied to a transient map, adds mapping of key(s) to val(s). When applied to a transient vector, sets the val at index. Note - index must be <= (count vector). Returns coll." {:added "1.1" :static true} ([^clojure.lang.ITransientAssociative coll key val] (.assoc coll key val)) ([^clojure.lang.ITransientAssociative coll key val & kvs] (let [ret (.assoc coll key val)] (if kvs (recur ret (first kvs) (second kvs) (nnext kvs)) ret)))) (defn dissoc! "Returns a transient map that doesn't contain a mapping for key(s)." {:added "1.1" :static true} ([^clojure.lang.ITransientMap map key] (.without map key)) ([^clojure.lang.ITransientMap map key & ks] (let [ret (.without map key)] (if ks (recur ret (first ks) (next ks)) ret)))) (defn pop! "Removes the last item from a transient vector. If the collection is empty, throws an exception. Returns coll" {:added "1.1" :static true} [^clojure.lang.ITransientVector coll] (.pop coll)) (defn disj! "disj[oin]. Returns a transient set of the same (hashed/sorted) type, that does not contain key(s)." {:added "1.1" :static true} ([set] set) ([^clojure.lang.ITransientSet set key] (. set (disjoin key))) ([^clojure.lang.ITransientSet set key & ks] (let [ret (. set (disjoin key))] (if ks (recur ret (first ks) (next ks)) ret)))) ;redef into with batch support (defn ^:private into1 "Returns a new coll consisting of to-coll with all of the items of from-coll conjoined." {:added "1.0" :static true} [to from] (if (instance? clojure.lang.IEditableCollection to) (persistent! (reduce1 conj! (transient to) from)) (reduce1 conj to from))) (defmacro import "import-list => (package-symbol class-name-symbols*) For each name in class-name-symbols, adds a mapping from name to the class named by package.name to the current namespace. Use :import in the ns macro in preference to calling this directly." {:added "1.0"} [& import-symbols-or-lists] (let [specs (map #(if (and (seq? %) (= 'quote (first %))) (second %) %) import-symbols-or-lists)] `(do ~@(map #(list 'clojure.core/import* %) (reduce1 (fn [v spec] (if (symbol? spec) (conj v (name spec)) (let [p (first spec) cs (rest spec)] (into1 v (map #(str p "." %) cs))))) [] specs))))) (defn into-array "Returns an array with components set to the values in aseq. The array's component type is type if provided, or the type of the first value in aseq if present, or Object. All values in aseq must be compatible with the component type. Class objects for the primitive types can be obtained using, e.g., Integer/TYPE." {:added "1.0" :static true} ([aseq] (clojure.lang.RT/seqToTypedArray (seq aseq))) ([type aseq] (clojure.lang.RT/seqToTypedArray type (seq aseq)))) (defn ^{:private true} array [& items] (into-array items)) (defn class "Returns the Class of x" {:added "1.0" :static true} ^Class [^Object x] (if (nil? x) x (. x (getClass)))) (defn type "Returns the :type metadata of x, or its Class if none" {:added "1.0" :static true} [x] (or (get (meta x) :type) (class x))) (defn num "Coerce to Number" {:tag Number :inline (fn [x] `(. clojure.lang.Numbers (num ~x))) :added "1.0"} [x] (. clojure.lang.Numbers (num x))) (defn long "Coerce to long" {:inline (fn [x] `(. clojure.lang.RT (longCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/longCast x)) (defn float "Coerce to float" {:inline (fn [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedFloatCast 'floatCast) ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/floatCast x)) (defn double "Coerce to double" {:inline (fn [x] `(. clojure.lang.RT (doubleCast ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/doubleCast x)) (defn short "Coerce to short" {:inline (fn [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedShortCast 'shortCast) ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/shortCast x)) (defn byte "Coerce to byte" {:inline (fn [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedByteCast 'byteCast) ~x))) :added "1.0"} [^Number x] (clojure.lang.RT/byteCast x)) (defn char "Coerce to char" {:inline (fn [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedCharCast 'charCast) ~x))) :added "1.1"} [x] (. clojure.lang.RT (charCast x))) (defn boolean "Coerce to boolean" { :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) :added "1.0"} [x] (clojure.lang.RT/booleanCast x)) (defn unchecked-byte "Coerce to byte. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedByteCast ~x))) :added "1.3"} [^Number x] (clojure.lang.RT/uncheckedByteCast x)) (defn unchecked-short "Coerce to short. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedShortCast ~x))) :added "1.3"} [^Number x] (clojure.lang.RT/uncheckedShortCast x)) (defn unchecked-char "Coerce to char. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedCharCast ~x))) :added "1.3"} [x] (. clojure.lang.RT (uncheckedCharCast x))) (defn unchecked-int "Coerce to int. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedIntCast ~x))) :added "1.3"} [^Number x] (clojure.lang.RT/uncheckedIntCast x)) (defn unchecked-long "Coerce to long. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedLongCast ~x))) :added "1.3"} [^Number x] (clojure.lang.RT/uncheckedLongCast x)) (defn unchecked-float "Coerce to float. Subject to rounding." {:inline (fn [x] `(. clojure.lang.RT (uncheckedFloatCast ~x))) :added "1.3"} [^Number x] (clojure.lang.RT/uncheckedFloatCast x)) (defn unchecked-double "Coerce to double. Subject to rounding." {:inline (fn [x] `(. clojure.lang.RT (uncheckedDoubleCast ~x))) :added "1.3"} [^Number x] (clojure.lang.RT/uncheckedDoubleCast x)) (defn number? "Returns true if x is a Number" {:added "1.0" :static true} [x] (instance? Number x)) (defn mod "Modulus of num and div. Truncates toward negative infinity." {:added "1.0" :static true} [num div] (let [m (rem num div)] (if (or (zero? m) (= (pos? num) (pos? div))) m (+ m div)))) (defn ratio? "Returns true if n is a Ratio" {:added "1.0" :static true} [n] (instance? clojure.lang.Ratio n)) (defn numerator "Returns the numerator part of a Ratio." {:tag BigInteger :added "1.2" :static true} [r] (.numerator ^clojure.lang.Ratio r)) (defn denominator "Returns the denominator part of a Ratio." {:tag BigInteger :added "1.2" :static true} [r] (.denominator ^clojure.lang.Ratio r)) (defn decimal? "Returns true if n is a BigDecimal" {:added "1.0" :static true} [n] (instance? BigDecimal n)) (defn float? "Returns true if n is a floating point number" {:added "1.0" :static true} [n] (or (instance? Double n) (instance? Float n))) (defn rational? "Returns true if n is a rational number" {:added "1.0" :static true} [n] (or (integer? n) (ratio? n) (decimal? n))) (defn bigint "Coerce to BigInt" {:tag clojure.lang.BigInt :static true :added "1.3"} [x] (cond (instance? clojure.lang.BigInt x) x (instance? BigInteger x) (clojure.lang.BigInt/fromBigInteger x) (decimal? x) (bigint (.toBigInteger ^BigDecimal x)) (float? x) (bigint (. BigDecimal valueOf (double x))) (ratio? x) (bigint (.bigIntegerValue ^clojure.lang.Ratio x)) (number? x) (clojure.lang.BigInt/valueOf (long x)) :else (bigint (BigInteger. ^String x)))) (defn biginteger "Coerce to BigInteger" {:tag BigInteger :added "1.0" :static true} [x] (cond (instance? BigInteger x) x (instance? clojure.lang.BigInt x) (.toBigInteger ^clojure.lang.BigInt x) (decimal? x) (.toBigInteger ^BigDecimal x) (float? x) (.toBigInteger (. BigDecimal valueOf (double x))) (ratio? x) (.bigIntegerValue ^clojure.lang.Ratio x) (number? x) (BigInteger/valueOf (long x)) :else (BigInteger. ^String x))) (defn bigdec "Coerce to BigDecimal" {:tag BigDecimal :added "1.0" :static true} [x] (cond (decimal? x) x (float? x) (. BigDecimal valueOf (double x)) (ratio? x) (/ (BigDecimal. (.numerator ^clojure.lang.Ratio x)) (.denominator ^clojure.lang.Ratio x)) (instance? clojure.lang.BigInt x) (.toBigDecimal ^clojure.lang.BigInt x) (instance? BigInteger x) (BigDecimal. ^BigInteger x) (number? x) (BigDecimal/valueOf (long x)) :else (BigDecimal. ^String x))) (def ^:dynamic ^{:private true} print-initialized false) (defmulti print-method (fn [x writer] (let [t (get (meta x) :type)] (if (keyword? t) t (class x))))) (defmulti print-dup (fn [x writer] (class x))) (defn pr-on {:private true :static true} [x w] (if *print-dup* (print-dup x w) (print-method x w)) nil) (defn pr "Prints the object(s) to the output stream that is the current value of *out*. Prints the object(s), separated by spaces if there is more than one. By default, pr and prn print in a way that objects can be read by the reader" {:dynamic true :added "1.0"} ([] nil) ([x] (pr-on x *out*)) ([x & more] (pr x) (. *out* (append \space)) (if-let [nmore (next more)] (recur (first more) nmore) (apply pr more)))) (def ^:private ^String system-newline (System/getProperty "line.separator")) (defn newline "Writes a platform-specific newline to *out*" {:added "1.0" :static true} [] (. *out* (append system-newline)) nil) (defn flush "Flushes the output stream that is the current value of *out*" {:added "1.0" :static true} [] (. *out* (flush)) nil) (defn prn "Same as pr followed by (newline). Observes *flush-on-newline*" {:added "1.0" :static true} [& more] (apply pr more) (newline) (when *flush-on-newline* (flush))) (defn print "Prints the object(s) to the output stream that is the current value of *out*. print and println produce output for human consumption." {:added "1.0" :static true} [& more] (binding [*print-readably* nil] (apply pr more))) (defn println "Same as print followed by (newline)" {:added "1.0" :static true} [& more] (binding [*print-readably* nil] (apply prn more))) (defn read "Reads the next object from stream, which must be an instance of java.io.PushbackReader or some derivee. stream defaults to the current value of *in*. Opts is a persistent map with valid keys: :read-cond - :allow to process reader conditionals, or :preserve to keep all branches :features - persistent set of feature keywords for reader conditionals :eof - on eof, return value unless :eofthrow, then throw. if not specified, will throw Note that read can execute code (controlled by *read-eval*), and as such should be used only with trusted sources. For data structure interop use clojure.edn/read" {:added "1.0" :static true} ([] (read *in*)) ([stream] (read stream true nil)) ([stream eof-error? eof-value] (read stream eof-error? eof-value false)) ([stream eof-error? eof-value recursive?] (. clojure.lang.LispReader (read stream (boolean eof-error?) eof-value recursive?))) ([opts stream] (. clojure.lang.LispReader (read stream opts)))) (defn read-line "Reads the next line from stream that is the current value of *in* ." {:added "1.0" :static true} [] (if (instance? clojure.lang.LineNumberingPushbackReader *in*) (.readLine ^clojure.lang.LineNumberingPushbackReader *in*) (.readLine ^java.io.BufferedReader *in*))) (defn read-string "Reads one object from the string s. Optionally include reader options, as specified in read. Note that read-string can execute code (controlled by *read-eval*), and as such should be used only with trusted sources. For data structure interop use clojure.edn/read-string" {:added "1.0" :static true} ([s] (clojure.lang.RT/readString s)) ([opts s] (clojure.lang.RT/readString s opts))) (defn subvec "Returns a persistent vector of the items in vector from start (inclusive) to end (exclusive). If end is not supplied, defaults to (count vector). This operation is O(1) and very fast, as the resulting vector shares structure with the original and no trimming is done." {:added "1.0" :static true} ([v start] (subvec v start (count v))) ([v start end] (. clojure.lang.RT (subvec v start end)))) (defmacro with-open "bindings => [name init ...] Evaluates body in a try expression with names bound to the values of the inits, and a finally clause that calls (.close name) on each name in reverse order." {:added "1.0"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (cond (= (count bindings) 0) `(do ~@body) (symbol? (bindings 0)) `(let ~(subvec bindings 0 2) (try (with-open ~(subvec bindings 2) ~@body) (finally (. ~(bindings 0) close)))) :else (throw (IllegalArgumentException. "with-open only allows Symbols in bindings")))) (defmacro doto "Evaluates x then calls all of the methods and functions with the value of x supplied at the front of the given arguments. The forms are evaluated in order. Returns x. (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))" {:added "1.0"} [x & forms] (let [gx (gensym)] `(let [~gx ~x] ~@(map (fn [f] (if (seq? f) `(~(first f) ~gx ~@(next f)) `(~f ~gx))) forms) ~gx))) (defmacro memfn "Expands into code that creates a fn that expects to be passed an object and any args and calls the named instance method on the object passing the args. Use when you want to treat a Java method as a first-class fn. name may be type-hinted with the method receiver's type in order to avoid reflective calls." {:added "1.0"} [name & args] (let [t (with-meta (gensym "target") (meta name))] `(fn [~t ~@args] (. ~t (~name ~@args))))) (defmacro time "Evaluates expr and prints the time it took. Returns the value of expr." {:added "1.0"} [expr] `(let [start# (. System (nanoTime)) ret# ~expr] (prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs")) ret#)) (import '(java.lang.reflect Array)) (defn alength "Returns the length of the Java array. Works on arrays of all types." {:inline (fn [a] `(. clojure.lang.RT (alength ~a))) :added "1.0"} [array] (. clojure.lang.RT (alength array))) (defn aclone "Returns a clone of the Java array. Works on arrays of known types." {:inline (fn [a] `(. clojure.lang.RT (aclone ~a))) :added "1.0"} [array] (. clojure.lang.RT (aclone array))) (defn aget "Returns the value at the index/indices. Works on Java arrays of all types." {:inline (fn [a i] `(. clojure.lang.RT (aget ~a (int ~i)))) :inline-arities #{2} :added "1.0"} ([array idx] (clojure.lang.Reflector/prepRet (.getComponentType (class array)) (. Array (get array idx)))) ([array idx & idxs] (apply aget (aget array idx) idxs))) (defn aset "Sets the value at the index/indices. Works on Java arrays of reference types. Returns val." {:inline (fn [a i v] `(. clojure.lang.RT (aset ~a (int ~i) ~v))) :inline-arities #{3} :added "1.0"} ([array idx val] (. Array (set array idx val)) val) ([array idx idx2 & idxv] (apply aset (aget array idx) idx2 idxv))) (defmacro ^{:private true} def-aset [name method coerce] `(defn ~name {:arglists '([~'array ~'idx ~'val] [~'array ~'idx ~'idx2 & ~'idxv])} ([array# idx# val#] (. Array (~method array# idx# (~coerce val#))) val#) ([array# idx# idx2# & idxv#] (apply ~name (aget array# idx#) idx2# idxv#)))) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of int. Returns val." :added "1.0"} aset-int setInt int) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of long. Returns val." :added "1.0"} aset-long setLong long) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of boolean. Returns val." :added "1.0"} aset-boolean setBoolean boolean) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of float. Returns val." :added "1.0"} aset-float setFloat float) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of double. Returns val." :added "1.0"} aset-double setDouble double) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of short. Returns val." :added "1.0"} aset-short setShort short) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of byte. Returns val." :added "1.0"} aset-byte setByte byte) (def-aset ^{:doc "Sets the value at the index/indices. Works on arrays of char. Returns val." :added "1.0"} aset-char setChar char) (defn make-array "Creates and returns an array of instances of the specified class of the specified dimension(s). Note that a class object is required. Class objects can be obtained by using their imported or fully-qualified name. Class objects for the primitive types can be obtained using, e.g., Integer/TYPE." {:added "1.0" :static true} ([^Class type len] (. Array (newInstance type (int len)))) ([^Class type dim & more-dims] (let [dims (cons dim more-dims) ^"[I" dimarray (make-array (. Integer TYPE) (count dims))] (dotimes [i (alength dimarray)] (aset-int dimarray i (nth dims i))) (. Array (newInstance type dimarray))))) (defn to-array-2d "Returns a (potentially-ragged) 2-dimensional array of Objects containing the contents of coll, which can be any Collection of any Collection." {:tag "[[Ljava.lang.Object;" :added "1.0" :static true} [^java.util.Collection coll] (let [ret (make-array (. Class (forName "[Ljava.lang.Object;")) (. coll (size)))] (loop [i 0 xs (seq coll)] (when xs (aset ret i (to-array (first xs))) (recur (inc i) (next xs)))) ret)) (defn macroexpand-1 "If form represents a macro form, returns its expansion, else returns form." {:added "1.0" :static true} [form] (. clojure.lang.Compiler (macroexpand1 form))) (defn macroexpand "Repeatedly calls macroexpand-1 on form until it no longer represents a macro form, then returns it. Note neither macroexpand-1 nor macroexpand expand macros in subforms." {:added "1.0" :static true} [form] (let [ex (macroexpand-1 form)] (if (identical? ex form) form (macroexpand ex)))) (defn create-struct "Returns a structure basis object." {:added "1.0" :static true} [& keys] (. clojure.lang.PersistentStructMap (createSlotMap keys))) (defmacro defstruct "Same as (def name (create-struct keys...))" {:added "1.0" :static true} [name & keys] `(def ~name (create-struct ~@keys))) (defn struct-map "Returns a new structmap instance with the keys of the structure-basis. keyvals may contain all, some or none of the basis keys - where values are not supplied they will default to nil. keyvals can also contain keys not in the basis." {:added "1.0" :static true} [s & inits] (. clojure.lang.PersistentStructMap (create s inits))) (defn struct "Returns a new structmap instance with the keys of the structure-basis. vals must be supplied for basis keys in order - where values are not supplied they will default to nil." {:added "1.0" :static true} [s & vals] (. clojure.lang.PersistentStructMap (construct s vals))) (defn accessor "Returns a fn that, given an instance of a structmap with the basis, returns the value at the key. The key must be in the basis. The returned function should be (slightly) more efficient than using get, but such use of accessors should be limited to known performance-critical areas." {:added "1.0" :static true} [s key] (. clojure.lang.PersistentStructMap (getAccessor s key))) (defn load-reader "Sequentially read and evaluate the set of forms contained in the stream/file" {:added "1.0" :static true} [rdr] (. clojure.lang.Compiler (load rdr))) (defn load-string "Sequentially read and evaluate the set of forms contained in the string" {:added "1.0" :static true} [s] (let [rdr (-> (java.io.StringReader. s) (clojure.lang.LineNumberingPushbackReader.))] (load-reader rdr))) (defn set? "Returns true if x implements IPersistentSet" {:added "1.0" :static true} [x] (instance? clojure.lang.IPersistentSet x)) (defn set "Returns a set of the distinct elements of coll." {:added "1.0" :static true} [coll] (if (set? coll) (with-meta coll nil) (if (instance? clojure.lang.IReduceInit coll) (persistent! (.reduce ^clojure.lang.IReduceInit coll conj! (transient #{}))) (persistent! (reduce1 conj! (transient #{}) coll))))) (defn ^{:private true :static true} filter-key [keyfn pred amap] (loop [ret {} es (seq amap)] (if es (if (pred (keyfn (first es))) (recur (assoc ret (key (first es)) (val (first es))) (next es)) (recur ret (next es))) ret))) (defn find-ns "Returns the namespace named by the symbol or nil if it doesn't exist." {:added "1.0" :static true} [sym] (clojure.lang.Namespace/find sym)) (defn create-ns "Create a new namespace named by the symbol if one doesn't already exist, returns it or the already-existing namespace of the same name." {:added "1.0" :static true} [sym] (clojure.lang.Namespace/findOrCreate sym)) (defn remove-ns "Removes the namespace named by the symbol. Use with caution. Cannot be used to remove the clojure namespace." {:added "1.0" :static true} [sym] (clojure.lang.Namespace/remove sym)) (defn all-ns "Returns a sequence of all namespaces." {:added "1.0" :static true} [] (clojure.lang.Namespace/all)) (defn the-ns "If passed a namespace, returns it. Else, when passed a symbol, returns the namespace named by it, throwing an exception if not found." {:added "1.0" :static true} ^clojure.lang.Namespace [x] (if (instance? clojure.lang.Namespace x) x (or (find-ns x) (throw (Exception. (str "No namespace: " x " found")))))) (defn ns-name "Returns the name of the namespace, a symbol." {:added "1.0" :static true} [ns] (.getName (the-ns ns))) (defn ns-map "Returns a map of all the mappings for the namespace." {:added "1.0" :static true} [ns] (.getMappings (the-ns ns))) (defn ns-unmap "Removes the mappings for the symbol from the namespace." {:added "1.0" :static true} [ns sym] (.unmap (the-ns ns) sym)) ;(defn export [syms] ; (doseq [sym syms] ; (.. *ns* (intern sym) (setExported true)))) (defn ns-publics "Returns a map of the public intern mappings for the namespace." {:added "1.0" :static true} [ns] (let [ns (the-ns ns)] (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) (= ns (.ns v)) (.isPublic v))) (ns-map ns)))) (defn ns-imports "Returns a map of the import mappings for the namespace." {:added "1.0" :static true} [ns] (filter-key val (partial instance? Class) (ns-map ns))) (defn ns-interns "Returns a map of the intern mappings for the namespace." {:added "1.0" :static true} [ns] (let [ns (the-ns ns)] (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) (= ns (.ns v)))) (ns-map ns)))) (defn refer "refers to all public vars of ns, subject to filters. filters can include at most one each of: :exclude list-of-symbols :only list-of-symbols :rename map-of-fromsymbol-tosymbol For each public interned var in the namespace named by the symbol, adds a mapping from the name of the var to the var to the current namespace. Throws an exception if name is already mapped to something else in the current namespace. Filters can be used to select a subset, via inclusion or exclusion, or to provide a mapping to a symbol different from the var's name, in order to prevent clashes. Use :use in the ns macro in preference to calling this directly." {:added "1.0"} [ns-sym & filters] (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym))))] (.referNs *ns* ns (apply hash-map filters)))) (defn ns-refers "Returns a map of the refer mappings for the namespace." {:added "1.0" :static true} [ns] (let [ns (the-ns ns)] (filter-key val (fn [^clojure.lang.Var v] (and (instance? clojure.lang.Var v) (not= ns (.ns v)))) (ns-map ns)))) (defn alias "Add an alias in the current namespace to another namespace. Arguments are two symbols: the alias to be used, and the symbolic name of the target namespace. Use :as in the ns macro in preference to calling this directly." {:added "1.0" :static true} [alias namespace-sym] (.addAlias *ns* alias (the-ns namespace-sym))) (defn ns-aliases "Returns a map of the aliases for the namespace." {:added "1.0" :static true} [ns] (.getAliases (the-ns ns))) (defn ns-unalias "Removes the alias for the symbol from the namespace." {:added "1.0" :static true} [ns sym] (.removeAlias (the-ns ns) sym)) (defn take-nth "Returns a lazy seq of every nth item in coll. Returns a stateful transducer when no collection is provided." {:added "1.0" :static true} ([n] (fn [rf] (let [iv (volatile! -1)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [i (vswap! iv inc)] (if (zero? (rem i n)) (rf result input) result))))))) ([n coll] (lazy-seq (when-let [s (seq coll)] (cons (first s) (take-nth n (drop n s))))))) (defn interleave "Returns a lazy seq of the first item in each coll, then the second etc." {:added "1.0" :static true} ([] ()) ([c1] (lazy-seq c1)) ([c1 c2] (lazy-seq (let [s1 (seq c1) s2 (seq c2)] (when (and s1 s2) (cons (first s1) (cons (first s2) (interleave (rest s1) (rest s2)))))))) ([c1 c2 & colls] (lazy-seq (let [ss (map seq (conj colls c2 c1))] (when (every? identity ss) (concat (map first ss) (apply interleave (map rest ss)))))))) (defn var-get "Gets the value in the var object" {:added "1.0" :static true} [^clojure.lang.Var x] (. x (get))) (defn var-set "Sets the value in the var object to val. The var must be thread-locally bound." {:added "1.0" :static true} [^clojure.lang.Var x val] (. x (set val))) (defmacro with-local-vars "varbinding=> symbol init-expr Executes the exprs in a context in which the symbols are bound to vars with per-thread bindings to the init-exprs. The symbols refer to the var objects themselves, and must be accessed with var-get and var-set" {:added "1.0"} [name-vals-vec & body] (assert-args (vector? name-vals-vec) "a vector for its binding" (even? (count name-vals-vec)) "an even number of forms in binding vector") `(let [~@(interleave (take-nth 2 name-vals-vec) (repeat '(.. clojure.lang.Var create setDynamic)))] (. clojure.lang.Var (pushThreadBindings (hash-map ~@name-vals-vec))) (try ~@body (finally (. clojure.lang.Var (popThreadBindings)))))) (defn ns-resolve "Returns the var or Class to which a symbol will be resolved in the namespace (unless found in the environment), else nil. Note that if the symbol is fully qualified, the var/Class to which it resolves need not be present in the namespace." {:added "1.0" :static true} ([ns sym] (ns-resolve ns nil sym)) ([ns env sym] (when-not (contains? env sym) (clojure.lang.Compiler/maybeResolveIn (the-ns ns) sym)))) (defn resolve "same as (ns-resolve *ns* symbol) or (ns-resolve *ns* &env symbol)" {:added "1.0" :static true} ([sym] (ns-resolve *ns* sym)) ([env sym] (ns-resolve *ns* env sym))) (defn array-map "Constructs an array-map. If any keys are equal, they are handled as if by repeated uses of assoc." {:added "1.0" :static true} ([] (. clojure.lang.PersistentArrayMap EMPTY)) ([& keyvals] (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array keyvals)))) ;redefine let and loop with destructuring (defn destructure [bindings] (let [bents (partition 2 bindings) pb (fn pb [bvec b v] (let [pvec (fn [bvec b val] (let [gvec (gensym "vec__")] (loop [ret (-> bvec (conj gvec) (conj val)) n 0 bs b seen-rest? false] (if (seq bs) (let [firstb (first bs)] (cond (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n)) n (nnext bs) true) (= firstb :as) (pb ret (second bs) gvec) :else (if seen-rest? (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) (recur (pb ret firstb (list `nth gvec n nil)) (inc n) (next bs) seen-rest?)))) ret)))) pmap (fn [bvec b v] (let [gmap (gensym "map__") gmapseq (with-meta gmap {:tag 'clojure.lang.ISeq}) defaults (:or b)] (loop [ret (-> bvec (conj gmap) (conj v) (conj gmap) (conj `(if (seq? ~gmap) (clojure.lang.PersistentHashMap/create (seq ~gmapseq)) ~gmap)) ((fn [ret] (if (:as b) (conj ret (:as b) gmap) ret)))) bes (reduce1 (fn [bes entry] (reduce1 #(assoc %1 %2 ((val entry) %2)) (dissoc bes (key entry)) ((key entry) bes))) (dissoc b :as :or) {:keys #(if (keyword? %) % (keyword (str %))), :strs str, :syms #(list `quote %)})] (if (seq bes) (let [bb (key (first bes)) bk (val (first bes)) has-default (contains? defaults bb)] (recur (pb ret bb (if has-default (list `get gmap bk (defaults bb)) (list `get gmap bk))) (next bes))) ret))))] (cond (symbol? b) (-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v)) (keyword? b) (-> bvec (conj (symbol (name b))) (conj v)) (vector? b) (pvec bvec b v) (map? b) (pmap bvec b v) :else (throw (new Exception (str "Unsupported binding form: " b)))))) process-entry (fn [bvec b] (pb bvec (first b) (second b)))] (if (every? symbol? (map first bents)) bindings (if-let [kwbs (seq (filter #(keyword? (first %)) bents))] (throw (new Exception (str "Unsupported binding key: " (ffirst kwbs)))) (reduce1 process-entry [] bents))))) (defmacro let "binding => binding-form init-expr Evaluates the exprs in a lexical context in which the symbols in the binding-forms are bound to their respective init-exprs or parts therein." {:added "1.0", :special-form true, :forms '[(let [bindings*] exprs*)]} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") `(let* ~(destructure bindings) ~@body)) (defn ^{:private true} maybe-destructured [params body] (if (every? symbol? params) (cons params body) (loop [params params new-params (with-meta [] (meta params)) lets []] (if params (if (symbol? (first params)) (recur (next params) (conj new-params (first params)) lets) (let [gparam (gensym "p__")] (recur (next params) (conj new-params gparam) (-> lets (conj (first params)) (conj gparam))))) `(~new-params (let ~lets ~@body)))))) ;redefine fn with destructuring and pre/post conditions (defmacro fn "params => positional-params* , or positional-params* & next-param positional-param => binding-form next-param => binding-form name => symbol Defines a function" {:added "1.0", :special-form true, :forms '[(fn name? [params* ] exprs*) (fn name? ([params* ] exprs*)+)]} [& sigs] (let [name (if (symbol? (first sigs)) (first sigs) nil) sigs (if name (next sigs) sigs) sigs (if (vector? (first sigs)) (list sigs) (if (seq? (first sigs)) sigs ;; Assume single arity syntax (throw (IllegalArgumentException. ^String (if (seq sigs) (str "Parameter declaration " (first sigs) " should be a vector") (str "Parameter declaration missing")))))) psig (fn* [sig] ;; Ensure correct type before destructuring sig (when (not (seq? sig)) (throw (IllegalArgumentException. (str "Invalid signature " sig " should be a list")))) (let [[params & body] sig _ (when (not (vector? params)) (throw (IllegalArgumentException. ^String (if (seq? (first sigs)) (str "Parameter declaration " params " should be a vector") (str "Invalid signature " sig " should be a list"))))) conds (when (and (next body) (map? (first body))) (first body)) body (if conds (next body) body) conds (or conds (meta params)) pre (:pre conds) post (:post conds) body (if post `((let [~'% ~(if (< 1 (count body)) `(do ~@body) (first body))] ~@(map (fn* [c] `(assert ~c)) post) ~'%)) body) body (if pre (concat (map (fn* [c] `(assert ~c)) pre) body) body)] (maybe-destructured params body))) new-sigs (map psig sigs)] (with-meta (if name (list* 'fn* name new-sigs) (cons 'fn* new-sigs)) (meta &form)))) (defmacro loop "Evaluates the exprs in a lexical context in which the symbols in the binding-forms are bound to their respective init-exprs or parts therein. Acts as a recur target." {:added "1.0", :special-form true, :forms '[(loop [bindings*] exprs*)]} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (even? (count bindings)) "an even number of forms in binding vector") (let [db (destructure bindings)] (if (= db bindings) `(loop* ~bindings ~@body) (let [vs (take-nth 2 (drop 1 bindings)) bs (take-nth 2 bindings) gs (map (fn [b] (if (symbol? b) b (gensym))) bs) bfs (reduce1 (fn [ret [b v g]] (if (symbol? b) (conj ret g v) (conj ret g v b g))) [] (map vector bs vs gs))] `(let ~bfs (loop* ~(vec (interleave gs gs)) (let ~(vec (interleave bs gs)) ~@body))))))) (defmacro when-first "bindings => x xs Roughly the same as (when (seq xs) (let [x (first xs)] body)) but xs is evaluated only once" {:added "1.0"} [bindings & body] (assert-args (vector? bindings) "a vector for its binding" (= 2 (count bindings)) "exactly 2 forms in binding vector") (let [[x xs] bindings] `(when-let [xs# (seq ~xs)] (let [~x (first xs#)] ~@body)))) (defmacro lazy-cat "Expands to code which yields a lazy sequence of the concatenation of the supplied colls. Each coll expr is not evaluated until it is needed. (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))" {:added "1.0"} [& colls] `(concat ~@(map #(list `lazy-seq %) colls))) (defmacro for "List comprehension. Takes a vector of one or more binding-form/collection-expr pairs, each followed by zero or more modifiers, and yields a lazy sequence of evaluations of expr. Collections are iterated in a nested fashion, rightmost fastest, and nested coll-exprs can refer to bindings created in prior binding-forms. Supported modifiers are: :let [binding-form expr ...], :while test, :when test. (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))" {:added "1.0"} [seq-exprs body-expr] (assert-args (vector? seq-exprs) "a vector for its binding" (even? (count seq-exprs)) "an even number of forms in binding vector") (let [to-groups (fn [seq-exprs] (reduce1 (fn [groups [k v]] (if (keyword? k) (conj (pop groups) (conj (peek groups) [k v])) (conj groups [k v]))) [] (partition 2 seq-exprs))) err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg)))) emit-bind (fn emit-bind [[[bind expr & mod-pairs] & [[_ next-expr] :as next-groups]]] (let [giter (gensym "iter__") gxs (gensym "s__") do-mod (fn do-mod [[[k v :as pair] & etc]] (cond (= k :let) `(let ~v ~(do-mod etc)) (= k :while) `(when ~v ~(do-mod etc)) (= k :when) `(if ~v ~(do-mod etc) (recur (rest ~gxs))) (keyword? k) (err "Invalid 'for' keyword " k) next-groups `(let [iterys# ~(emit-bind next-groups) fs# (seq (iterys# ~next-expr))] (if fs# (concat fs# (~giter (rest ~gxs))) (recur (rest ~gxs)))) :else `(cons ~body-expr (~giter (rest ~gxs)))))] (if next-groups #_"not the inner-most loop" `(fn ~giter [~gxs] (lazy-seq (loop [~gxs ~gxs] (when-first [~bind ~gxs] ~(do-mod mod-pairs))))) #_"inner-most loop" (let [gi (gensym "i__") gb (gensym "b__") do-cmod (fn do-cmod [[[k v :as pair] & etc]] (cond (= k :let) `(let ~v ~(do-cmod etc)) (= k :while) `(when ~v ~(do-cmod etc)) (= k :when) `(if ~v ~(do-cmod etc) (recur (unchecked-inc ~gi))) (keyword? k) (err "Invalid 'for' keyword " k) :else `(do (chunk-append ~gb ~body-expr) (recur (unchecked-inc ~gi)))))] `(fn ~giter [~gxs] (lazy-seq (loop [~gxs ~gxs] (when-let [~gxs (seq ~gxs)] (if (chunked-seq? ~gxs) (let [c# (chunk-first ~gxs) size# (int (count c#)) ~gb (chunk-buffer size#)] (if (loop [~gi (int 0)] (if (< ~gi size#) (let [~bind (.nth c# ~gi)] ~(do-cmod mod-pairs)) true)) (chunk-cons (chunk ~gb) (~giter (chunk-rest ~gxs))) (chunk-cons (chunk ~gb) nil))) (let [~bind (first ~gxs)] ~(do-mod mod-pairs)))))))))))] `(let [iter# ~(emit-bind (to-groups seq-exprs))] (iter# ~(second seq-exprs))))) (defmacro comment "Ignores body, yields nil" {:added "1.0"} [& body]) (defmacro with-out-str "Evaluates exprs in a context in which *out* is bound to a fresh StringWriter. Returns the string created by any nested printing calls." {:added "1.0"} [& body] `(let [s# (new java.io.StringWriter)] (binding [*out* s#] ~@body (str s#)))) (defmacro with-in-str "Evaluates body in a context in which *in* is bound to a fresh StringReader initialized with the string s." {:added "1.0"} [s & body] `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)] (binding [*in* s#] ~@body))) (defn pr-str "pr to a string, returning it" {:tag String :added "1.0" :static true} [& xs] (with-out-str (apply pr xs))) (defn prn-str "prn to a string, returning it" {:tag String :added "1.0" :static true} [& xs] (with-out-str (apply prn xs))) (defn print-str "print to a string, returning it" {:tag String :added "1.0" :static true} [& xs] (with-out-str (apply print xs))) (defn println-str "println to a string, returning it" {:tag String :added "1.0" :static true} [& xs] (with-out-str (apply println xs))) (import clojure.lang.ExceptionInfo clojure.lang.IExceptionInfo) (defn ex-info "Create an instance of ExceptionInfo, a RuntimeException subclass that carries a map of additional data." {:added "1.4"} ([msg map] (ExceptionInfo. msg map)) ([msg map cause] (ExceptionInfo. msg map cause))) (defn ex-data "Returns exception data (a map) if ex is an IExceptionInfo. Otherwise returns nil." {:added "1.4"} [ex] (when (instance? IExceptionInfo ex) (.getData ^IExceptionInfo ex))) (defmacro assert "Evaluates expr and throws an exception if it does not evaluate to logical true." {:added "1.0"} ([x] (when *assert* `(when-not ~x (throw (new AssertionError (str "Assert failed: " (pr-str '~x))))))) ([x message] (when *assert* `(when-not ~x (throw (new AssertionError (str "Assert failed: " ~message "\n" (pr-str '~x)))))))) (defn test "test [v] finds fn at key :test in var metadata and calls it, presuming failure will throw exception" {:added "1.0"} [v] (let [f (:test (meta v))] (if f (do (f) :ok) :no-test))) (defn re-pattern "Returns an instance of java.util.regex.Pattern, for use, e.g. in re-matcher." {:tag java.util.regex.Pattern :added "1.0" :static true} [s] (if (instance? java.util.regex.Pattern s) s (. java.util.regex.Pattern (compile s)))) (defn re-matcher "Returns an instance of java.util.regex.Matcher, for use, e.g. in re-find." {:tag java.util.regex.Matcher :added "1.0" :static true} [^java.util.regex.Pattern re s] (. re (matcher s))) (defn re-groups "Returns the groups from the most recent match/find. If there are no nested groups, returns a string of the entire match. If there are nested groups, returns a vector of the groups, the first element being the entire match." {:added "1.0" :static true} [^java.util.regex.Matcher m] (let [gc (. m (groupCount))] (if (zero? gc) (. m (group)) (loop [ret [] c 0] (if (<= c gc) (recur (conj ret (. m (group c))) (inc c)) ret))))) (defn re-seq "Returns a lazy sequence of successive matches of pattern in string, using java.util.regex.Matcher.find(), each such match processed with re-groups." {:added "1.0" :static true} [^java.util.regex.Pattern re s] (let [m (re-matcher re s)] ((fn step [] (when (. m (find)) (cons (re-groups m) (lazy-seq (step)))))))) (defn re-matches "Returns the match, if any, of string to pattern, using java.util.regex.Matcher.matches(). Uses re-groups to return the groups." {:added "1.0" :static true} [^java.util.regex.Pattern re s] (let [m (re-matcher re s)] (when (. m (matches)) (re-groups m)))) (defn re-find "Returns the next regex match, if any, of string to pattern, using java.util.regex.Matcher.find(). Uses re-groups to return the groups." {:added "1.0" :static true} ([^java.util.regex.Matcher m] (when (. m (find)) (re-groups m))) ([^java.util.regex.Pattern re s] (let [m (re-matcher re s)] (re-find m)))) (defn rand "Returns a random floating point number between 0 (inclusive) and n (default 1) (exclusive)." {:added "1.0" :static true} ([] (. Math (random))) ([n] (* n (rand)))) (defn rand-int "Returns a random integer between 0 (inclusive) and n (exclusive)." {:added "1.0" :static true} [n] (int (rand n))) (defmacro defn- "same as defn, yielding non-public def" {:added "1.0"} [name & decls] (list* `defn (with-meta name (assoc (meta name) :private true)) decls)) (defn tree-seq "Returns a lazy sequence of the nodes in a tree, via a depth-first walk. branch? must be a fn of one arg that returns true if passed a node that can have children (but may not). children must be a fn of one arg that returns a sequence of the children. Will only be called on nodes for which branch? returns true. Root is the root node of the tree." {:added "1.0" :static true} [branch? children root] (let [walk (fn walk [node] (lazy-seq (cons node (when (branch? node) (mapcat walk (children node))))))] (walk root))) (defn file-seq "A tree seq on java.io.Files" {:added "1.0" :static true} [dir] (tree-seq (fn [^java.io.File f] (. f (isDirectory))) (fn [^java.io.File d] (seq (. d (listFiles)))) dir)) (defn xml-seq "A tree seq on the xml elements as per xml/parse" {:added "1.0" :static true} [root] (tree-seq (complement string?) (comp seq :content) root)) (defn special-symbol? "Returns true if s names a special form" {:added "1.0" :static true} [s] (contains? (. clojure.lang.Compiler specials) s)) (defn var? "Returns true if v is of type clojure.lang.Var" {:added "1.0" :static true} [v] (instance? clojure.lang.Var v)) (defn subs "Returns the substring of s beginning at start inclusive, and ending at end (defaults to length of string), exclusive." {:added "1.0" :static true} (^String [^String s start] (. s (substring start))) (^String [^String s start end] (. s (substring start end)))) (defn max-key "Returns the x for which (k x), a number, is greatest." {:added "1.0" :static true} ([k x] x) ([k x y] (if (> (k x) (k y)) x y)) ([k x y & more] (reduce1 #(max-key k %1 %2) (max-key k x y) more))) (defn min-key "Returns the x for which (k x), a number, is least." {:added "1.0" :static true} ([k x] x) ([k x y] (if (< (k x) (k y)) x y)) ([k x y & more] (reduce1 #(min-key k %1 %2) (min-key k x y) more))) (defn distinct "Returns a lazy sequence of the elements of coll with duplicates removed. Returns a stateful transducer when no collection is provided." {:added "1.0" :static true} ([] (fn [rf] (let [seen (volatile! #{})] (fn ([] (rf)) ([result] (rf result)) ([result input] (if (contains? @seen input) result (do (vswap! seen conj input) (rf result input)))))))) ([coll] (let [step (fn step [xs seen] (lazy-seq ((fn [[f :as xs] seen] (when-let [s (seq xs)] (if (contains? seen f) (recur (rest s) seen) (cons f (step (rest s) (conj seen f)))))) xs seen)))] (step coll #{})))) (defn replace "Given a map of replacement pairs and a vector/collection, returns a vector/seq with any elements = a key in smap replaced with the corresponding val in smap. Returns a transducer when no collection is provided." {:added "1.0" :static true} ([smap] (map #(if-let [e (find smap %)] (val e) %))) ([smap coll] (if (vector? coll) (reduce1 (fn [v i] (if-let [e (find smap (nth v i))] (assoc v i (val e)) v)) coll (range (count coll))) (map #(if-let [e (find smap %)] (val e) %) coll)))) (defmacro dosync "Runs the exprs (in an implicit do) in a transaction that encompasses exprs and any nested calls. Starts a transaction if none is already running on this thread. Any uncaught exception will abort the transaction and flow out of dosync. The exprs may be run more than once, but any effects on Refs will be atomic." {:added "1.0"} [& exprs] `(sync nil ~@exprs)) (defmacro with-precision "Sets the precision and rounding mode to be used for BigDecimal operations. Usage: (with-precision 10 (/ 1M 3)) or: (with-precision 10 :rounding HALF_DOWN (/ 1M 3)) The rounding mode is one of CEILING, FLOOR, HALF_UP, HALF_DOWN, HALF_EVEN, UP, DOWN and UNNECESSARY; it defaults to HALF_UP." {:added "1.0"} [precision & exprs] (let [[body rm] (if (= (first exprs) :rounding) [(next (next exprs)) `((. java.math.RoundingMode ~(second exprs)))] [exprs nil])] `(binding [*math-context* (java.math.MathContext. ~precision ~@rm)] ~@body))) (defn mk-bound-fn {:private true} [^clojure.lang.Sorted sc test key] (fn [e] (test (.. sc comparator (compare (. sc entryKey e) key)) 0))) (defn subseq "sc must be a sorted collection, test(s) one of <, <=, > or >=. Returns a seq of those entries with keys ek for which (test (.. sc comparator (compare ek key)) 0) is true" {:added "1.0" :static true} ([^clojure.lang.Sorted sc test key] (let [include (mk-bound-fn sc test key)] (if (#{> >=} test) (when-let [[e :as s] (. sc seqFrom key true)] (if (include e) s (next s))) (take-while include (. sc seq true))))) ([^clojure.lang.Sorted sc start-test start-key end-test end-key] (when-let [[e :as s] (. sc seqFrom start-key true)] (take-while (mk-bound-fn sc end-test end-key) (if ((mk-bound-fn sc start-test start-key) e) s (next s)))))) (defn rsubseq "sc must be a sorted collection, test(s) one of <, <=, > or >=. Returns a reverse seq of those entries with keys ek for which (test (.. sc comparator (compare ek key)) 0) is true" {:added "1.0" :static true} ([^clojure.lang.Sorted sc test key] (let [include (mk-bound-fn sc test key)] (if (#{< <=} test) (when-let [[e :as s] (. sc seqFrom key false)] (if (include e) s (next s))) (take-while include (. sc seq false))))) ([^clojure.lang.Sorted sc start-test start-key end-test end-key] (when-let [[e :as s] (. sc seqFrom end-key false)] (take-while (mk-bound-fn sc start-test start-key) (if ((mk-bound-fn sc end-test end-key) e) s (next s)))))) (defn repeatedly "Takes a function of no args, presumably with side effects, and returns an infinite (or length n if supplied) lazy sequence of calls to it" {:added "1.0" :static true} ([f] (lazy-seq (cons (f) (repeatedly f)))) ([n f] (take n (repeatedly f)))) (defn add-classpath "DEPRECATED Adds the url (String or URL object) to the classpath per URLClassLoader.addURL" {:added "1.0" :deprecated "1.1"} [url] (println "WARNING: add-classpath is deprecated") (clojure.lang.RT/addURL url)) (defn hash "Returns the hash code of its argument. Note this is the hash code consistent with =, and thus is different than .hashCode for Integer, Short, Byte and Clojure collections." {:added "1.0" :static true} [x] (. clojure.lang.Util (hasheq x))) (defn mix-collection-hash "Mix final collection hash for ordered or unordered collections. hash-basis is the combined collection hash, count is the number of elements included in the basis. Note this is the hash code consistent with =, different from .hashCode. See http://clojure.org/data_structures#hash for full algorithms." {:added "1.6" :static true} ^long [^long hash-basis ^long count] (clojure.lang.Murmur3/mixCollHash hash-basis count)) (defn hash-ordered-coll "Returns the hash code, consistent with =, for an external ordered collection implementing Iterable. See http://clojure.org/data_structures#hash for full algorithms." {:added "1.6" :static true} ^long [coll] (clojure.lang.Murmur3/hashOrdered coll)) (defn hash-unordered-coll "Returns the hash code, consistent with =, for an external unordered collection implementing Iterable. For maps, the iterator should return map entries whose hash is computed as (hash-ordered-coll [k v]). See http://clojure.org/data_structures#hash for full algorithms." {:added "1.6" :static true} ^long [coll] (clojure.lang.Murmur3/hashUnordered coll)) (defn interpose "Returns a lazy seq of the elements of coll separated by sep. Returns a stateful transducer when no collection is provided." {:added "1.0" :static true} ([sep] (fn [rf] (let [started (volatile! false)] (fn ([] (rf)) ([result] (rf result)) ([result input] (if @started (let [sepr (rf result sep)] (if (reduced? sepr) sepr (rf sepr input))) (do (vreset! started true) (rf result input)))))))) ([sep coll] (drop 1 (interleave (repeat sep) coll)))) (defmacro definline "Experimental - like defmacro, except defines a named function whose body is the expansion, calls to which may be expanded inline as if it were a macro. Cannot be used with variadic (&) args." {:added "1.0"} [name & decl] (let [[pre-args [args expr]] (split-with (comp not vector?) decl)] `(do (defn ~name ~@pre-args ~args ~(apply (eval (list `fn args expr)) args)) (alter-meta! (var ~name) assoc :inline (fn ~args ~expr)) (var ~name)))) (defn empty "Returns an empty collection of the same category as coll, or nil" {:added "1.0" :static true} [coll] (when (instance? clojure.lang.IPersistentCollection coll) (.empty ^clojure.lang.IPersistentCollection coll))) (defmacro amap "Maps an expression across an array a, using an index named idx, and return value named ret, initialized to a clone of a, then setting each element of ret to the evaluation of expr, returning the new array ret." {:added "1.0"} [a idx ret expr] `(let [a# ~a ~ret (aclone a#)] (loop [~idx 0] (if (< ~idx (alength a#)) (do (aset ~ret ~idx ~expr) (recur (unchecked-inc ~idx))) ~ret)))) (defmacro areduce "Reduces an expression across an array a, using an index named idx, and return value named ret, initialized to init, setting ret to the evaluation of expr at each step, returning ret." {:added "1.0"} [a idx ret init expr] `(let [a# ~a] (loop [~idx 0 ~ret ~init] (if (< ~idx (alength a#)) (recur (unchecked-inc ~idx) ~expr) ~ret)))) (defn float-array "Creates an array of floats" {:inline (fn [& args] `(. clojure.lang.Numbers float_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers float_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers float_array size init-val-or-seq))) (defn boolean-array "Creates an array of booleans" {:inline (fn [& args] `(. clojure.lang.Numbers boolean_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers boolean_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers boolean_array size init-val-or-seq))) (defn byte-array "Creates an array of bytes" {:inline (fn [& args] `(. clojure.lang.Numbers byte_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers byte_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers byte_array size init-val-or-seq))) (defn char-array "Creates an array of chars" {:inline (fn [& args] `(. clojure.lang.Numbers char_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers char_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers char_array size init-val-or-seq))) (defn short-array "Creates an array of shorts" {:inline (fn [& args] `(. clojure.lang.Numbers short_array ~@args)) :inline-arities #{1 2} :added "1.1"} ([size-or-seq] (. clojure.lang.Numbers short_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers short_array size init-val-or-seq))) (defn double-array "Creates an array of doubles" {:inline (fn [& args] `(. clojure.lang.Numbers double_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers double_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers double_array size init-val-or-seq))) (defn object-array "Creates an array of objects" {:inline (fn [arg] `(. clojure.lang.RT object_array ~arg)) :inline-arities #{1} :added "1.2"} ([size-or-seq] (. clojure.lang.RT object_array size-or-seq))) (defn int-array "Creates an array of ints" {:inline (fn [& args] `(. clojure.lang.Numbers int_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers int_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers int_array size init-val-or-seq))) (defn long-array "Creates an array of longs" {:inline (fn [& args] `(. clojure.lang.Numbers long_array ~@args)) :inline-arities #{1 2} :added "1.0"} ([size-or-seq] (. clojure.lang.Numbers long_array size-or-seq)) ([size init-val-or-seq] (. clojure.lang.Numbers long_array size init-val-or-seq))) (definline booleans "Casts to boolean[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers booleans ~xs)) (definline bytes "Casts to bytes[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers bytes ~xs)) (definline chars "Casts to chars[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers chars ~xs)) (definline shorts "Casts to shorts[]" {:added "1.1"} [xs] `(. clojure.lang.Numbers shorts ~xs)) (definline floats "Casts to float[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers floats ~xs)) (definline ints "Casts to int[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers ints ~xs)) (definline doubles "Casts to double[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers doubles ~xs)) (definline longs "Casts to long[]" {:added "1.0"} [xs] `(. clojure.lang.Numbers longs ~xs)) (import '(java.util.concurrent BlockingQueue LinkedBlockingQueue)) (defn seque "Creates a queued seq on another (presumably lazy) seq s. The queued seq will produce a concrete seq in the background, and can get up to n items ahead of the consumer. n-or-q can be an integer n buffer size, or an instance of java.util.concurrent BlockingQueue. Note that reading from a seque can block if the reader gets ahead of the producer." {:added "1.0" :static true} ([s] (seque 100 s)) ([n-or-q s] (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q) n-or-q (LinkedBlockingQueue. (int n-or-q))) NIL (Object.) ;nil sentinel since LBQ doesn't support nils agt (agent (lazy-seq s)) ; never start with nil; that signifies we've already put eos log-error (fn [q e] (if (.offer q q) (throw e) e)) fill (fn [s] (when s (if (instance? Exception s) ; we failed to .offer an error earlier (log-error q s) (try (loop [[x & xs :as s] (seq s)] (if s (if (.offer q (if (nil? x) NIL x)) (recur xs) s) (when-not (.offer q q) ; q itself is eos sentinel ()))) ; empty seq, not nil, so we know to put eos next time (catch Exception e (log-error q e)))))) drain (fn drain [] (lazy-seq (let [x (.take q)] (if (identical? x q) ;q itself is eos sentinel (do @agt nil) ;touch agent just to propagate errors (do (send-off agt fill) (release-pending-sends) (cons (if (identical? x NIL) nil x) (drain)))))))] (send-off agt fill) (drain)))) (defn class? "Returns true if x is an instance of Class" {:added "1.0" :static true} [x] (instance? Class x)) (defn- is-annotation? [c] (and (class? c) (.isAssignableFrom java.lang.annotation.Annotation c))) (defn- is-runtime-annotation? [^Class c] (boolean (and (is-annotation? c) (when-let [^java.lang.annotation.Retention r (.getAnnotation c java.lang.annotation.Retention)] (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME))))) (defn- descriptor [^Class c] (clojure.asm.Type/getDescriptor c)) (declare process-annotation) (declare process-print-annotation) (defn- print-annotation-value [v] (cond (vector? v) (str "{" (apply str (interpose ", " (map print-annotation-value v))) "}") (symbol? v) (let [ev (eval v)] (cond (instance? java.lang.Enum ev) (str (.getCanonicalName (class ev)) "." (str ev)) (class? ev) (str (.getCanonicalName ev) ".class") :else (throw (IllegalArgumentException. (str "Unsupported annotation value: " v " of class " (class ev)))))) (seq? v) (let [[nested nv] v c (resolve nested)] (str "@" (.getCanonicalName c) "(" (process-print-annotation nv) ")")) (string? v) (str "\"" (clojure.lang.Compiler/escapeString ^String v) "\"") (nil? v) "" :else v)) (defn- add-annotation [^clojure.asm.AnnotationVisitor av name v] (cond (vector? v) (let [avec (.visitArray av name)] (doseq [vval v] (add-annotation avec "value" vval)) (.visitEnd avec)) (symbol? v) (let [ev (eval v)] (cond (instance? java.lang.Enum ev) (.visitEnum av name (descriptor (class ev)) (str ev)) (class? ev) (.visit av name (clojure.asm.Type/getType ev)) :else (throw (IllegalArgumentException. (str "Unsupported annotation value: " v " of class " (class ev)))))) (seq? v) (let [[nested nv] v c (resolve nested) nav (.visitAnnotation av name (descriptor c))] (process-annotation nav nv) (.visitEnd nav)) :else (.visit av name v))) (defn- process-annotation [av v] (if (map? v) (doseq [[k v] v] (add-annotation av (name k) v)) (add-annotation av "value" v))) (defn- process-print-annotation [v] (if (map? v) (apply str (interpose ", " (map (fn [[k v]] (str (name k) "=" (print-annotation-value v))) v))) (print-annotation-value v))) (defn- add-annotations ([visitor m] (add-annotations visitor m nil)) ([visitor m i] (doseq [[k v] m] (when (symbol? k) (when-let [c (resolve k)] (when (is-annotation? c) ;this is known duck/reflective as no common base of ASM Visitors (let [av (if i (.visitParameterAnnotation visitor i (descriptor c) (is-runtime-annotation? c)) (.visitAnnotation visitor (descriptor c) (is-runtime-annotation? c)))] (clojure.lang.Compiler/emitSource (str "@" (.getCanonicalName c) (if (= 0 (count (.getDeclaredMethods c))) "" (str "(" (process-print-annotation v) ")")))) (process-annotation av v) (.visitEnd av)))))))) (defn alter-var-root "Atomically alters the root binding of var v by applying f to its current value plus any args" {:added "1.0" :static true} [^clojure.lang.Var v f & args] (.alterRoot v f args)) (defn bound? "Returns true if all of the vars provided as arguments have any bound value, root or thread-local. Implies that deref'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2" :static true} [& vars] (every? #(.isBound ^clojure.lang.Var %) vars)) (defn thread-bound? "Returns true if all of the vars provided as arguments have thread-local bindings. Implies that set!'ing the provided vars will succeed. Returns true if no vars are provided." {:added "1.2" :static true} [& vars] (every? #(.getThreadBinding ^clojure.lang.Var %) vars)) (defn make-hierarchy "Creates a hierarchy object for use with derive, isa? etc." {:added "1.0" :static true} [] {:parents {} :descendants {} :ancestors {}}) (def ^{:private true} global-hierarchy (make-hierarchy)) (defn not-empty "If coll is empty, returns nil, else coll" {:added "1.0" :static true} [coll] (when (seq coll) coll)) (defn bases "Returns the immediate superclass and direct interfaces of c, if any" {:added "1.0" :static true} [^Class c] (when c (let [i (seq (.getInterfaces c)) s (.getSuperclass c)] (if s (cons s i) i)))) (defn supers "Returns the immediate and indirect superclasses and interfaces of c, if any" {:added "1.0" :static true} [^Class class] (loop [ret (set (bases class)) cs ret] (if (seq cs) (let [c (first cs) bs (bases c)] (recur (into1 ret bs) (into1 (disj cs c) bs))) (not-empty ret)))) (defn isa? "Returns true if (= child parent), or child is directly or indirectly derived from parent, either via a Java type inheritance relationship or a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" {:added "1.0"} ([child parent] (isa? global-hierarchy child parent)) ([h child parent] (or (= child parent) (and (class? parent) (class? child) (. ^Class parent isAssignableFrom child)) (contains? ((:ancestors h) child) parent) (and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child))) (and (vector? parent) (vector? child) (= (count parent) (count child)) (loop [ret true i 0] (if (or (not ret) (= i (count parent))) ret (recur (isa? h (child i) (parent i)) (inc i)))))))) (defn parents "Returns the immediate parents of tag, either via a Java type inheritance relationship or a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" {:added "1.0"} ([tag] (parents global-hierarchy tag)) ([h tag] (not-empty (let [tp (get (:parents h) tag)] (if (class? tag) (into1 (set (bases tag)) tp) tp))))) (defn ancestors "Returns the immediate and indirect parents of tag, either via a Java type inheritance relationship or a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" {:added "1.0"} ([tag] (ancestors global-hierarchy tag)) ([h tag] (not-empty (let [ta (get (:ancestors h) tag)] (if (class? tag) (let [superclasses (set (supers tag))] (reduce1 into1 superclasses (cons ta (map #(get (:ancestors h) %) superclasses)))) ta))))) (defn descendants "Returns the immediate and indirect children of tag, through a relationship established via derive. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy. Note: does not work on Java type inheritance relationships." {:added "1.0"} ([tag] (descendants global-hierarchy tag)) ([h tag] (if (class? tag) (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes")) (not-empty (get (:descendants h) tag))))) (defn derive "Establishes a parent/child relationship between parent and tag. Parent must be a namespace-qualified symbol or keyword and child can be either a namespace-qualified symbol or keyword or a class. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (assert (namespace parent)) (assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag)))) (alter-var-root #'global-hierarchy derive tag parent) nil) ([h tag parent] (assert (not= tag parent)) (assert (or (class? tag) (instance? clojure.lang.Named tag))) (assert (instance? clojure.lang.Named parent)) (let [tp (:parents h) td (:descendants h) ta (:ancestors h) tf (fn [m source sources target targets] (reduce1 (fn [ret k] (assoc ret k (reduce1 conj (get targets k #{}) (cons target (targets target))))) m (cons source (sources source))))] (or (when-not (contains? (tp tag) parent) (when (contains? (ta tag) parent) (throw (Exception. (print-str tag "already has" parent "as ancestor")))) (when (contains? (ta parent) tag) (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor")))) {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent)) :ancestors (tf (:ancestors h) tag td parent ta) :descendants (tf (:descendants h) parent ta tag td)}) h)))) (declare flatten) (defn underive "Removes a parent/child relationship between parent and tag. h must be a hierarchy obtained from make-hierarchy, if not supplied defaults to, and modifies, the global hierarchy." {:added "1.0"} ([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil) ([h tag parent] (let [parentMap (:parents h) childsParents (if (parentMap tag) (disj (parentMap tag) parent) #{}) newParents (if (not-empty childsParents) (assoc parentMap tag childsParents) (dissoc parentMap tag)) deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %))) (seq newParents)))] (if (contains? (parentMap tag) parent) (reduce1 #(apply derive %1 %2) (make-hierarchy) (partition 2 deriv-seq)) h)))) (defn distinct? "Returns true if no two of the arguments are =" {:tag Boolean :added "1.0" :static true} ([x] true) ([x y] (not (= x y))) ([x y & more] (if (not= x y) (loop [s #{x y} [x & etc :as xs] more] (if xs (if (contains? s x) false (recur (conj s x) etc)) true)) false))) (comment (defn resultset-seq "Creates and returns a lazy sequence of structmaps corresponding to the rows in the java.sql.ResultSet rs" {:added "1.0"} [^java.sql.ResultSet rs] (let [rsmeta (. rs (getMetaData)) idxs (range 1 (inc (. rsmeta (getColumnCount)))) keys (map (comp keyword #(.toLowerCase ^String %)) (map (fn [i] (. rsmeta (getColumnLabel i))) idxs)) check-keys (or (apply distinct? keys) (throw (Exception. "ResultSet must have unique column labels"))) row-struct (apply create-struct keys) row-values (fn [] (map (fn [^Integer i] (. rs (getObject i))) idxs)) rows (fn thisfn [] (when (. rs (next)) (cons (apply struct row-struct (row-values)) (lazy-seq (thisfn)))))] (rows)))) (defn iterator-seq "Returns a seq on a java.util.Iterator. Note that most collections providing iterators implement Iterable and thus support seq directly. Seqs cache values, thus iterator-seq should not be used on any iterator that repeatedly returns the same mutable object." {:added "1.0" :static true} [iter] (clojure.lang.RT/chunkIteratorSeq iter)) (defn enumeration-seq "Returns a seq on a java.util.Enumeration" {:added "1.0" :static true} [e] (clojure.lang.EnumerationSeq/create e)) (defn format "Formats a string using java.lang.String.format, see java.util.Formatter for format string syntax" {:added "1.0" :static true} ^String [fmt & args] (String/format fmt (to-array args))) (defn printf "Prints formatted output, as per format" {:added "1.0" :static true} [fmt & args] (print (apply format fmt args))) (declare gen-class) (defmacro with-loading-context [& body] `((fn loading# [] (. clojure.lang.Var (pushThreadBindings {clojure.lang.Compiler/LOADER (.getClassLoader (.getClass ^Object loading#))})) (try ~@body (finally (. clojure.lang.Var (popThreadBindings))))))) (defmacro ns "Sets *ns* to the namespace named by name (unevaluated), creating it if needed. references can be zero or more of: (:refer-clojure ...) (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class) with the syntax of refer-clojure/require/use/import/load/gen-class respectively, except the arguments are unevaluated and need not be quoted. (:gen-class ...), when supplied, defaults to :name corresponding to the ns name, :main true, :impl-ns same as ns, and :init-impl-ns true. All options of gen-class are supported. The :gen-class directive is ignored when not compiling. If :gen-class is not supplied, when compiled only an nsname__init.class will be generated. If :refer-clojure is not used, a default (refer 'clojure.core) is used. Use of ns is preferred to individual calls to in-ns/require/use/import: (ns foo.bar (:refer-clojure :exclude [ancestors printf]) (:require (clojure.contrib sql combinatorics)) (:use (my.lib this that)) (:import (java.util Date Timer Random) (java.sql Connection Statement)))" {:arglists '([name docstring? attr-map? references*]) :added "1.0"} [name & references] (let [process-reference (fn [[kname & args]] `(~(symbol "clojure.core" (clojure.core/name kname)) ~@(map #(list 'quote %) args))) docstring (when (string? (first references)) (first references)) references (if docstring (next references) references) name (if docstring (vary-meta name assoc :doc docstring) name) metadata (when (map? (first references)) (first references)) references (if metadata (next references) references) name (if metadata (vary-meta name merge metadata) name) gen-class-clause (first (filter #(= :gen-class (first %)) references)) gen-class-call (when gen-class-clause (list* `gen-class :name (.replace (str name) \- \_) :impl-ns name :main true (next gen-class-clause))) references (remove #(= :gen-class (first %)) references) ;ns-effect (clojure.core/in-ns name) ] `(do (clojure.core/in-ns '~name) (with-loading-context ~@(when gen-class-call (list gen-class-call)) ~@(when (and (not= name 'clojure.core) (not-any? #(= :refer-clojure (first %)) references)) `((clojure.core/refer '~'clojure.core))) ~@(map process-reference references)) (if (.equals '~name 'clojure.core) nil (do (dosync (commute @#'*loaded-libs* conj '~name)) nil))))) (defmacro refer-clojure "Same as (refer 'clojure.core )" {:added "1.0"} [& filters] `(clojure.core/refer '~'clojure.core ~@filters)) (defmacro defonce "defs name to have the root value of the expr iff the named var has no root value, else expr is unevaluated" {:added "1.0"} [name expr] `(let [v# (def ~name)] (when-not (.hasRoot v#) (def ~name ~expr)))) ;;;;;;;;;;; require/use/load, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;; (defonce ^:dynamic ^{:private true :doc "A ref to a sorted set of symbols representing loaded libs"} *loaded-libs* (ref (sorted-set))) (defonce ^:dynamic ^{:private true :doc "A stack of paths currently being loaded by this thread"} *pending-paths* ()) (defonce ^:dynamic ^{:private true :doc "True while a verbose load is pending"} *loading-verbosely* false) (defn- throw-if "Throws a CompilerException with a message if pred is true" [pred fmt & args] (when pred (let [^String message (apply format fmt args) exception (Exception. message) raw-trace (.getStackTrace exception) boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke") trace (into-array (drop 2 (drop-while boring? raw-trace)))] (.setStackTrace exception trace) (throw (clojure.lang.Compiler$CompilerException. *file* (.deref clojure.lang.Compiler/LINE) (.deref clojure.lang.Compiler/COLUMN) exception))))) (defn- libspec? "Returns true if x is a libspec" [x] (or (symbol? x) (and (vector? x) (or (nil? (second x)) (keyword? (second x)))))) (defn- prependss "Prepends a symbol or a seq to coll" [x coll] (if (symbol? x) (cons x coll) (concat x coll))) (defn- root-resource "Returns the root directory path for a lib" {:tag String} [lib] (str \/ (.. (name lib) (replace \- \_) (replace \. \/)))) (defn- root-directory "Returns the root resource path for a lib" [lib] (let [d (root-resource lib)] (subs d 0 (.lastIndexOf d "/")))) (declare load) (defn- load-one "Loads a lib given its name. If need-ns, ensures that the associated namespace exists after loading. If require, records the load so any duplicate loads can be skipped." [lib need-ns require] (load (root-resource lib)) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found after loading '%s'" lib (root-resource lib)) (when require (dosync (commute *loaded-libs* conj lib)))) (defn- load-all "Loads a lib given its name and forces a load of any libs it directly or indirectly loads. If need-ns, ensures that the associated namespace exists after loading. If require, records the load so any duplicate loads can be skipped." [lib need-ns require] (dosync (commute *loaded-libs* #(reduce1 conj %1 %2) (binding [*loaded-libs* (ref (sorted-set))] (load-one lib need-ns require) @*loaded-libs*)))) (defn- load-lib "Loads a lib with options" [prefix lib & options] (throw-if (and prefix (pos? (.indexOf (name lib) (int \.)))) "Found lib name '%s' containing period with prefix '%s'. lib names inside prefix lists must not contain periods" (name lib) prefix) (let [lib (if prefix (symbol (str prefix \. lib)) lib) opts (apply hash-map options) {:keys [as reload reload-all require use verbose]} opts loaded (contains? @*loaded-libs* lib) load (cond reload-all load-all (or reload (not require) (not loaded)) load-one) need-ns (or as use) filter-opts (select-keys opts '(:exclude :only :rename :refer)) undefined-on-entry (not (find-ns lib))] (binding [*loading-verbosely* (or *loading-verbosely* verbose)] (if load (try (load lib need-ns require) (catch Exception e (when undefined-on-entry (remove-ns lib)) (throw e))) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found" lib)) (when (and need-ns *loading-verbosely*) (printf "(clojure.core/in-ns '%s)\n" (ns-name *ns*))) (when as (when *loading-verbosely* (printf "(clojure.core/alias '%s '%s)\n" as lib)) (alias as lib)) (when (or use (:refer filter-opts)) (when *loading-verbosely* (printf "(clojure.core/refer '%s" lib) (doseq [opt filter-opts] (printf " %s '%s" (key opt) (print-str (val opt)))) (printf ")\n")) (apply refer lib (mapcat seq filter-opts)))))) (defn- load-libs "Loads libs, interpreting libspecs, prefix lists, and flags for forwarding to load-lib" [& args] (let [flags (filter keyword? args) opts (interleave flags (repeat true)) args (filter (complement keyword?) args)] ; check for unsupported options (let [supported #{:as :reload :reload-all :require :use :verbose :refer} unsupported (seq (remove supported flags))] (throw-if unsupported (apply str "Unsupported option(s) supplied: " (interpose \, unsupported)))) ; check a load target was specified (throw-if (not (seq args)) "Nothing specified to load") (doseq [arg args] (if (libspec? arg) (apply load-lib nil (prependss arg opts)) (let [[prefix & args] arg] (throw-if (nil? prefix) "prefix cannot be nil") (doseq [arg args] (apply load-lib prefix (prependss arg opts)))))))) (defn- check-cyclic-dependency "Detects and rejects non-trivial cyclic load dependencies. The exception message shows the dependency chain with the cycle highlighted. Ignores the trivial case of a file attempting to load itself because that can occur when a gen-class'd class loads its implementation." [path] (when (some #{path} (rest *pending-paths*)) (let [pending (map #(if (= % path) (str "[ " % " ]") %) (cons path *pending-paths*)) chain (apply str (interpose "->" pending))] (throw-if true "Cyclic load dependency: %s" chain)))) ;; Public (defn require "Loads libs, skipping any that are already loaded. Each argument is either a libspec that identifies a lib, a prefix list that identifies multiple libs whose names share a common prefix, or a flag that modifies how all the identified libs are loaded. Use :require in the ns macro in preference to calling this directly. Libs A 'lib' is a named set of resources in classpath whose contents define a library of Clojure code. Lib names are symbols and each lib is associated with a Clojure namespace and a Java package that share its name. A lib's name also locates its root directory within classpath using Java's package name to classpath-relative path mapping. All resources in a lib should be contained in the directory structure under its root directory. All definitions a lib makes should be in its associated namespace. 'require loads a lib by loading its root resource. The root resource path is derived from the lib name in the following manner: Consider a lib named by the symbol 'x.y.z; it has the root directory /x/y/, and its root resource is /x/y/z.clj. The root resource should contain code to create the lib's namespace (usually by using the ns macro) and load any additional lib resources. Libspecs A libspec is a lib name or a vector containing a lib name followed by options expressed as sequential keywords and arguments. Recognized options: :as takes a symbol as its argument and makes that symbol an alias to the lib's namespace in the current namespace. :refer takes a list of symbols to refer from the namespace or the :all keyword to bring in all public vars. Prefix Lists It's common for Clojure code to depend on several libs whose names have the same prefix. When specifying libs, prefix lists can be used to reduce repetition. A prefix list contains the shared prefix followed by libspecs with the shared prefix removed from the lib names. After removing the prefix, the names that remain must not contain any periods. Flags A flag is a keyword. Recognized flags: :reload, :reload-all, :verbose :reload forces loading of all the identified libs even if they are already loaded :reload-all implies :reload and also forces loading of all libs that the identified libs directly or indirectly load via require or use :verbose triggers printing information about each load, alias, and refer Example: The following would load the libraries clojure.zip and clojure.set abbreviated as 's'. (require '(clojure zip [set :as s]))" {:added "1.0"} [& args] (apply load-libs :require args)) (defn use "Like 'require, but also refers to each lib's namespace using clojure.core/refer. Use :use in the ns macro in preference to calling this directly. 'use accepts additional options in libspecs: :exclude, :only, :rename. The arguments and semantics for :exclude, :only, and :rename are the same as those documented for clojure.core/refer." {:added "1.0"} [& args] (apply load-libs :require :use args)) (defn loaded-libs "Returns a sorted set of symbols naming the currently loaded libs" {:added "1.0"} [] @*loaded-libs*) (defn load "Loads Clojure code from resources in classpath. A path is interpreted as classpath-relative if it begins with a slash or relative to the root directory for the current namespace otherwise." {:added "1.0"} [& paths] (doseq [^String path paths] (let [^String path (if (.startsWith path "/") path (str (root-directory (ns-name *ns*)) \/ path))] (when *loading-verbosely* (printf "(clojure.core/load \"%s\")\n" path) (flush)) (check-cyclic-dependency path) (when-not (= path (first *pending-paths*)) (binding [*pending-paths* (conj *pending-paths* path)] (clojure.lang.RT/load (.substring path 1))))))) (defn compile "Compiles the namespace named by the symbol lib into a set of classfiles. The source for the lib must be in a proper classpath-relative directory. The output files will go into the directory specified by *compile-path*, and that directory too must be in the classpath." {:added "1.0"} [lib] (binding [*compile-files* true *compiler-options* {:elide-meta (if (= "true" (System/getenv "KEEP_META")) [] [:arglists :file :line :column :ns :name :added :static :doc])}] (load-one lib true true)) lib) ;;;;;;;;;;;;; nested associative ops ;;;;;;;;;;; (defn get-in "Returns the value in a nested associative structure, where ks is a sequence of keys. Returns nil if the key is not present, or the not-found value if supplied." {:added "1.2" :static true} ([m ks] (reduce1 get m ks)) ([m ks not-found] (loop [sentinel (Object.) m m ks (seq ks)] (if ks (let [m (get m (first ks) sentinel)] (if (identical? sentinel m) not-found (recur sentinel m (next ks)))) m)))) (defn assoc-in "Associates a value in a nested associative structure, where ks is a sequence of keys and v is the new value and returns a new nested structure. If any levels do not exist, hash-maps will be created." {:added "1.0" :static true} [m [k & ks] v] (if ks (assoc m k (assoc-in (get m k) ks v)) (assoc m k v))) (defn update-in "'Updates' a value in a nested associative structure, where ks is a sequence of keys and f is a function that will take the old value and any supplied args and return the new value, and returns a new nested structure. If any levels do not exist, hash-maps will be created." {:added "1.0" :static true} ([m [k & ks] f & args] (if ks (assoc m k (apply update-in (get m k) ks f args)) (assoc m k (apply f (get m k) args))))) (defn update "'Updates' a value in an associative structure, where k is a key and f is a function that will take the old value and any supplied args and return the new value, and returns a new structure. If the key does not exist, nil is passed as the old value." {:added "1.7" :static true} ([m k f] (assoc m k (f (get m k)))) ([m k f x] (assoc m k (f (get m k) x))) ([m k f x y] (assoc m k (f (get m k) x y))) ([m k f x y z] (assoc m k (f (get m k) x y z))) ([m k f x y z & more] (assoc m k (apply f (get m k) x y z more)))) (defn empty? "Returns true if coll has no items - same as (not (seq coll)). Please use the idiom (seq x) rather than (not (empty? x))" {:added "1.0" :static true} [coll] (not (seq coll))) (defn coll? "Returns true if x implements IPersistentCollection" {:added "1.0" :static true} [x] (instance? clojure.lang.IPersistentCollection x)) (defn list? "Returns true if x implements IPersistentList" {:added "1.0" :static true} [x] (instance? clojure.lang.IPersistentList x)) (defn ifn? "Returns true if x implements IFn. Note that many data structures (e.g. sets and maps) implement IFn" {:added "1.0" :static true} [x] (instance? clojure.lang.IFn x)) (defn fn? "Returns true if x implements Fn, i.e. is an object created via fn." {:added "1.0" :static true} [x] (instance? clojure.lang.Fn x)) (defn associative? "Returns true if coll implements Associative" {:added "1.0" :static true} [coll] (instance? clojure.lang.Associative coll)) (defn sequential? "Returns true if coll implements Sequential" {:added "1.0" :static true} [coll] (instance? clojure.lang.Sequential coll)) (defn sorted? "Returns true if coll implements Sorted" {:added "1.0" :static true} [coll] (instance? clojure.lang.Sorted coll)) (defn counted? "Returns true if coll implements count in constant time" {:added "1.0" :static true} [coll] (instance? clojure.lang.Counted coll)) (defn reversible? "Returns true if coll implements Reversible" {:added "1.0" :static true} [coll] (instance? clojure.lang.Reversible coll)) (def ^:dynamic ^{:doc "bound in a repl thread to the most recent value printed" :added "1.0"} *1) (def ^:dynamic ^{:doc "bound in a repl thread to the second most recent value printed" :added "1.0"} *2) (def ^:dynamic ^{:doc "bound in a repl thread to the third most recent value printed" :added "1.0"} *3) (def ^:dynamic ^{:doc "bound in a repl thread to the most recent exception caught by the repl" :added "1.0"} *e) (defn trampoline "trampoline can be used to convert algorithms requiring mutual recursion without stack consumption. Calls f with supplied args, if any. If f returns a fn, calls that fn with no arguments, and continues to repeat, until the return value is not a fn, then returns that non-fn value. Note that if you want to return a fn as a final value, you must wrap it in some data structure and unpack it after trampoline returns." {:added "1.0" :static true} ([f] (let [ret (f)] (if (fn? ret) (recur ret) ret))) ([f & args] (trampoline #(apply f args)))) (defn intern "Finds or creates a var named by the symbol name in the namespace ns (which can be a symbol or a namespace), setting its root binding to val if supplied. The namespace must exist. The var will adopt any metadata from the name symbol. Returns the var." {:added "1.0" :static true} ([ns ^clojure.lang.Symbol name] (let [v (clojure.lang.Var/intern (the-ns ns) name)] (when (meta name) (.setMeta v (meta name))) v)) ([ns name val] (let [v (clojure.lang.Var/intern (the-ns ns) name val)] (when (meta name) (.setMeta v (meta name))) v))) (defmacro while "Repeatedly executes body while test expression is true. Presumes some side-effect will cause test to become false/nil. Returns nil" {:added "1.0"} [test & body] `(loop [] (when ~test ~@body (recur)))) (defn memoize "Returns a memoized version of a referentially transparent function. The memoized version of the function keeps a cache of the mapping from arguments to results and, when calls with the same arguments are repeated often, has higher performance at the expense of higher memory use." {:added "1.0" :static true} [f] (let [mem (atom {})] (fn [& args] (if-let [e (find @mem args)] (val e) (let [ret (apply f args)] (swap! mem assoc args ret) ret))))) (def supers (memoize supers)) (def bases (memoize bases)) (defmacro condp "Takes a binary predicate, an expression, and a set of clauses. Each clause can take the form of either: test-expr result-expr test-expr :>> result-fn Note :>> is an ordinary keyword. For each clause, (pred test-expr expr) is evaluated. If it returns logical true, the clause is a match. If a binary clause matches, the result-expr is returned, if a ternary clause matches, its result-fn, which must be a unary function, is called with the result of the predicate as its argument, the result of that call being the return value of condp. A single default expression can follow the clauses, and its value will be returned if no clause matches. If no default expression is provided and no clause matches, an IllegalArgumentException is thrown." {:added "1.0"} [pred expr & clauses] (let [gpred (gensym "pred__") gexpr (gensym "expr__") emit (fn emit [pred expr args] (let [[[a b c :as clause] more] (split-at (if (= :>> (second args)) 3 2) args) n (count clause)] (cond (= 0 n) `(throw (IllegalArgumentException. (str "No matching clause: " ~expr))) (= 1 n) a (= 2 n) `(if (~pred ~a ~expr) ~b ~(emit pred expr more)) :else `(if-let [p# (~pred ~a ~expr)] (~c p#) ~(emit pred expr more))))) gres (gensym "res__")] `(let [~gpred ~pred ~gexpr ~expr] ~(emit gpred gexpr clauses)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; var documentation ;;;;;;;;;;;;;;;;;;;;;;;;;; (alter-meta! #'*agent* assoc :added "1.0") (alter-meta! #'in-ns assoc :added "1.0") (alter-meta! #'load-file assoc :added "1.0") (defmacro add-doc-and-meta {:private true} [name docstring meta] `(alter-meta! (var ~name) merge (assoc ~meta :doc ~docstring))) (add-doc-and-meta *file* "The path of the file being evaluated, as a String. When there is no file, e.g. in the REPL, the value is not defined." {:added "1.0"}) (add-doc-and-meta *command-line-args* "A sequence of the supplied command line arguments, or nil if none were supplied" {:added "1.0"}) (add-doc-and-meta *warn-on-reflection* "When set to true, the compiler will emit warnings when reflection is needed to resolve Java method calls or field accesses. Defaults to false." {:added "1.0"}) (add-doc-and-meta *compile-path* "Specifies the directory where 'compile' will write out .class files. This directory must be in the classpath for 'compile' to work. Defaults to \"classes\"" {:added "1.0"}) (add-doc-and-meta *compile-files* "Set to true when compiling files, false otherwise." {:added "1.0"}) (add-doc-and-meta *unchecked-math* "While bound to true, compilations of +, -, *, inc, dec and the coercions will be done without overflow checks. While bound to :warn-on-boxed, same behavior as true, and a warning is emitted when compilation uses boxed math. Default: false." {:added "1.3"}) (add-doc-and-meta *compiler-options* "A map of keys to options. Note, when binding dynamically make sure to merge with previous value. Supported options: :elide-meta - a collection of metadata keys to elide during compilation. :disable-locals-clearing - set to true to disable clearing, useful for using a debugger Alpha, subject to change." {:added "1.4"}) (add-doc-and-meta *ns* "A clojure.lang.Namespace object representing the current namespace." {:added "1.0"}) (add-doc-and-meta *in* "A java.io.Reader object representing standard input for read operations. Defaults to System/in, wrapped in a LineNumberingPushbackReader" {:added "1.0"}) (add-doc-and-meta *out* "A java.io.Writer object representing standard output for print operations. Defaults to System/out, wrapped in an OutputStreamWriter" {:added "1.0"}) (add-doc-and-meta *err* "A java.io.Writer object representing standard error for print operations. Defaults to System/err, wrapped in a PrintWriter" {:added "1.0"}) (add-doc-and-meta *flush-on-newline* "When set to true, output will be flushed whenever a newline is printed. Defaults to true." {:added "1.0"}) (add-doc-and-meta *print-meta* "If set to logical true, when printing an object, its metadata will also be printed in a form that can be read back by the reader. Defaults to false." {:added "1.0"}) (add-doc-and-meta *print-dup* "When set to logical true, objects will be printed in a way that preserves their type when read in later. Defaults to false." {:added "1.0"}) (add-doc-and-meta *print-readably* "When set to logical false, strings and characters will be printed with non-alphanumeric characters converted to the appropriate escape sequences. Defaults to true" {:added "1.0"}) (add-doc-and-meta *read-eval* "Defaults to true (or value specified by system property, see below) ***This setting implies that the full power of the reader is in play, including syntax that can cause code to execute. It should never be used with untrusted sources. See also: clojure.edn/read.*** When set to logical false in the thread-local binding, the eval reader (#=) and record/type literal syntax are disabled in read/load. Example (will fail): (binding [*read-eval* false] (read-string \"#=(* 2 21)\")) The default binding can be controlled by the system property 'clojure.read.eval' System properties can be set on the command line like this: java -Dclojure.read.eval=false ... The system property can also be set to 'unknown' via -Dclojure.read.eval=unknown, in which case the default binding is :unknown and all reads will fail in contexts where *read-eval* has not been explicitly bound to either true or false. This setting can be a useful diagnostic tool to ensure that all of your reads occur in considered contexts. You can also accomplish this in a particular scope by binding *read-eval* to :unknown " {:added "1.0"}) (defn future? "Returns true if x is a future" {:added "1.1" :static true} [x] (instance? java.util.concurrent.Future x)) (defn future-done? "Returns true if future f is done" {:added "1.1" :static true} [^java.util.concurrent.Future f] (.isDone f)) (defmacro letfn "fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+) Takes a vector of function specs and a body, and generates a set of bindings of functions to their names. All of the names are available in all of the definitions of the functions, as well as the body." {:added "1.0", :forms '[(letfn [fnspecs*] exprs*)], :special-form true, :url nil} [fnspecs & body] `(letfn* ~(vec (interleave (map first fnspecs) (map #(cons `fn %) fnspecs))) ~@body)) (defn fnil "Takes a function f, and returns a function that calls f, replacing a nil first argument to f with the supplied value x. Higher arity versions can replace arguments in the second and third positions (y, z). Note that the function f can take any number of arguments, not just the one(s) being nil-patched." {:added "1.2" :static true} ([f x] (fn ([a] (f (if (nil? a) x a))) ([a b] (f (if (nil? a) x a) b)) ([a b c] (f (if (nil? a) x a) b c)) ([a b c & ds] (apply f (if (nil? a) x a) b c ds)))) ([f x y] (fn ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c)) ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds)))) ([f x y z] (fn ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c))) ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds))))) ;;;;;;; case ;;;;;;;;;;;;; (defn- shift-mask [shift mask x] (-> x (bit-shift-right shift) (bit-and mask))) (def ^:private max-mask-bits 13) (def ^:private max-switch-table-size (bit-shift-left 1 max-mask-bits)) (defn- maybe-min-hash "takes a collection of hashes and returns [shift mask] or nil if none found" [hashes] (first (filter (fn [[s m]] (apply distinct? (map #(shift-mask s m %) hashes))) (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 (inc max-mask-bits))) shift (range 0 31)] [shift mask])))) (defn- case-map "Transforms a sequence of test constants and a corresponding sequence of then expressions into a sorted map to be consumed by case*. The form of the map entries are {(case-f test) [(test-f test) then]}." [case-f test-f tests thens] (into1 (sorted-map) (zipmap (map case-f tests) (map vector (map test-f tests) thens)))) (defn- fits-table? "Returns true if the collection of ints can fit within the max-table-switch-size, false otherwise." [ints] (< (- (apply max (seq ints)) (apply min (seq ints))) max-switch-table-size)) (defn- prep-ints "Takes a sequence of int-sized test constants and a corresponding sequence of then expressions. Returns a tuple of [shift mask case-map switch-type] where case-map is a map of int case values to [test then] tuples, and switch-type is either :sparse or :compact." [tests thens] (if (fits-table? tests) ; compact case ints, no shift-mask [0 0 (case-map int int tests thens) :compact] (let [[shift mask] (or (maybe-min-hash (map int tests)) [0 0])] (if (zero? mask) ; sparse case ints, no shift-mask [0 0 (case-map int int tests thens) :sparse] ; compact case ints, with shift-mask [shift mask (case-map #(shift-mask shift mask (int %)) int tests thens) :compact])))) (defn- merge-hash-collisions "Takes a case expression, default expression, and a sequence of test constants and a corresponding sequence of then expressions. Returns a tuple of [tests thens skip-check-set] where no tests have the same hash. Each set of input test constants with the same hash is replaced with a single test constant (the case int), and their respective thens are combined into: (condp = expr test-1 then-1 ... test-n then-n default). The skip-check is a set of case ints for which post-switch equivalence checking must not be done (the cases holding the above condp thens)." [expr-sym default tests thens] (let [buckets (loop [m {} ks tests vs thens] (if (and ks vs) (recur (update m (clojure.lang.Util/hash (first ks)) (fnil conj []) [(first ks) (first vs)]) (next ks) (next vs)) m)) assoc-multi (fn [m h bucket] (let [testexprs (apply concat bucket) expr `(condp = ~expr-sym ~@testexprs ~default)] (assoc m h expr))) hmap (reduce1 (fn [m [h bucket]] (if (== 1 (count bucket)) (assoc m (ffirst bucket) (second (first bucket))) (assoc-multi m h bucket))) {} buckets) skip-check (->> buckets (filter #(< 1 (count (second %)))) (map first) (into1 #{}))] [(keys hmap) (vals hmap) skip-check])) (defn- prep-hashes "Takes a sequence of test constants and a corresponding sequence of then expressions. Returns a tuple of [shift mask case-map switch-type skip-check] where case-map is a map of int case values to [test then] tuples, switch-type is either :sparse or :compact, and skip-check is a set of case ints for which post-switch equivalence checking must not be done (occurs with hash collisions)." [expr-sym default tests thens] (let [hashcode #(clojure.lang.Util/hash %) hashes (into1 #{} (map hashcode tests))] (if (== (count tests) (count hashes)) (if (fits-table? hashes) ; compact case ints, no shift-mask [0 0 (case-map hashcode identity tests thens) :compact] (let [[shift mask] (or (maybe-min-hash hashes) [0 0])] (if (zero? mask) ; sparse case ints, no shift-mask [0 0 (case-map hashcode identity tests thens) :sparse] ; compact case ints, with shift-mask [shift mask (case-map #(shift-mask shift mask (hashcode %)) identity tests thens) :compact]))) ; resolve hash collisions and try again (let [[tests thens skip-check] (merge-hash-collisions expr-sym default tests thens) [shift mask case-map switch-type] (prep-hashes expr-sym default tests thens) skip-check (if (zero? mask) skip-check (into1 #{} (map #(shift-mask shift mask %) skip-check)))] [shift mask case-map switch-type skip-check])))) (defmacro case "Takes an expression, and a set of clauses. Each clause can take the form of either: test-constant result-expr (test-constant1 ... test-constantN) result-expr The test-constants are not evaluated. They must be compile-time literals, and need not be quoted. If the expression is equal to a test-constant, the corresponding result-expr is returned. A single default expression can follow the clauses, and its value will be returned if no clause matches. If no default expression is provided and no clause matches, an IllegalArgumentException is thrown. Unlike cond and condp, case does a constant-time dispatch, the clauses are not considered sequentially. All manner of constant expressions are acceptable in case, including numbers, strings, symbols, keywords, and (Clojure) composites thereof. Note that since lists are used to group multiple constants that map to the same expression, a vector can be used to match a list if needed. The test-constants need not be all of the same type." {:added "1.2"} [e & clauses] (let [ge (with-meta (gensym) {:tag Object}) default (if (odd? (count clauses)) (last clauses) `(throw (IllegalArgumentException. (str "No matching clause: " ~ge))))] (if (> 2 (count clauses)) `(let [~ge ~e] ~default) (let [pairs (partition 2 clauses) assoc-test (fn assoc-test [m test expr] (if (contains? m test) (throw (IllegalArgumentException. (str "Duplicate case test constant: " test))) (assoc m test expr))) pairs (reduce1 (fn [m [test expr]] (if (seq? test) (reduce1 #(assoc-test %1 %2 expr) m test) (assoc-test m test expr))) {} pairs) tests (keys pairs) thens (vals pairs) mode (cond (every? #(and (integer? %) (<= Integer/MIN_VALUE % Integer/MAX_VALUE)) tests) :ints (every? keyword? tests) :identity :else :hashes)] (condp = mode :ints (let [[shift mask imap switch-type] (prep-ints tests thens)] `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :int))) :hashes (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)] `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :hash-equiv ~skip-check))) :identity (let [[shift mask imap switch-type skip-check] (prep-hashes ge default tests thens)] `(let [~ge ~e] (case* ~ge ~shift ~mask ~default ~imap ~switch-type :hash-identity ~skip-check)))))))) ;; redefine reduce with internal-reduce ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language") (load "core_proxy") (load "core_print") (load "genclass") (load "core_deftype") (load "core/protocols") (load "gvec") (load "instant") (load "uuid") (defn reduce "f should be a function of 2 arguments. If val is not supplied, returns the result of applying f to the first 2 items in coll, then applying f to that result and the 3rd item, etc. If coll contains no items, f must accept no arguments as well, and reduce returns the result of calling f with no arguments. If coll has only 1 item, it is returned and f is not called. If val is supplied, returns the result of applying f to val and the first item in coll, then applying f to that result and the 2nd item, etc. If coll contains no items, returns val and f is not called." {:added "1.0"} ([f coll] (if (instance? clojure.lang.IReduce coll) (.reduce ^clojure.lang.IReduce coll f) (clojure.core.protocols/coll-reduce coll f))) ([f val coll] (if (instance? clojure.lang.IReduceInit coll) (.reduce ^clojure.lang.IReduceInit coll f val) (clojure.core.protocols/coll-reduce coll f val)))) (extend-protocol clojure.core.protocols/IKVReduce nil (kv-reduce [_ f init] init) ;;slow path default clojure.lang.IPersistentMap (kv-reduce [amap f init] (reduce (fn [ret [k v]] (f ret k v)) init amap)) clojure.lang.PersistentHashMap (kv-reduce [amap f init] (.kvreduce amap f init)) clojure.lang.PersistentArrayMap (kv-reduce [amap f init] (.kvreduce amap f init)) clojure.lang.PersistentTreeMap (kv-reduce [amap f init] (.kvreduce amap f init)) clojure.lang.PersistentVector (kv-reduce [vec f init] (.kvreduce vec f init))) (defn reduce-kv "Reduces an associative collection. f should be a function of 3 arguments. Returns the result of applying f to init, the first key and the first value in coll, then applying f to that result and the 2nd key and value, etc. If coll contains no entries, returns init and f is not called. Note that reduce-kv is supported on vectors, where the keys will be the ordinals." {:added "1.4"} ([f init coll] (clojure.core.protocols/kv-reduce coll f init))) (defn completing "Takes a reducing function f of 2 args and returns a fn suitable for transduce by adding an arity-1 signature that calls cf (default - identity) on the result argument." {:added "1.7"} ([f] (completing f identity)) ([f cf] (fn ([] (f)) ([x] (cf x)) ([x y] (f x y))))) (defn transduce "reduce with a transformation of f (xf). If init is not supplied, (f) will be called to produce it. f should be a reducing step function that accepts both 1 and 2 arguments, if it accepts only 2 you can add the arity-1 with 'completing'. Returns the result of applying (the transformed) xf to init and the first item in coll, then applying xf to that result and the 2nd item, etc. If coll contains no items, returns init and f is not called. Note that certain transforms may inject or skip items." {:added "1.7"} ([xform f coll] (transduce xform f (f) coll)) ([xform f init coll] (let [f (xform f) ret (if (instance? clojure.lang.IReduceInit coll) (.reduce ^clojure.lang.IReduceInit coll f init) (clojure.core.protocols/coll-reduce coll f init))] (f ret)))) (defn into "Returns a new coll consisting of to-coll with all of the items of from-coll conjoined. A transducer may be supplied." {:added "1.0" :static true} ([to from] (if (instance? clojure.lang.IEditableCollection to) (with-meta (persistent! (reduce conj! (transient to) from)) (meta to)) (reduce conj to from))) ([to xform from] (if (instance? clojure.lang.IEditableCollection to) (with-meta (persistent! (transduce xform conj! (transient to) from)) (meta to)) (transduce xform conj to from)))) (defn mapv "Returns a vector consisting of the result of applying f to the set of first items of each coll, followed by applying f to the set of second items in each coll, until any one of the colls is exhausted. Any remaining items in other colls are ignored. Function f should accept number-of-colls arguments." {:added "1.4" :static true} ([f coll] (-> (reduce (fn [v o] (conj! v (f o))) (transient []) coll) persistent!)) ([f c1 c2] (into [] (map f c1 c2))) ([f c1 c2 c3] (into [] (map f c1 c2 c3))) ([f c1 c2 c3 & colls] (into [] (apply map f c1 c2 c3 colls)))) (defn filterv "Returns a vector of the items in coll for which (pred item) returns true. pred must be free of side-effects." {:added "1.4" :static true} [pred coll] (-> (reduce (fn [v o] (if (pred o) (conj! v o) v)) (transient []) coll) persistent!)) (load "java/io") (defn- normalize-slurp-opts [opts] (if (string? (first opts)) (do (println "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).") [:encoding (first opts)]) opts)) (defn slurp "Opens a reader on f and reads all its contents, returning a string. See clojure.java.io/reader for a complete list of supported arguments." {:added "1.0"} ([f & opts] (let [opts (normalize-slurp-opts opts) sb (StringBuilder.)] (with-open [^java.io.Reader r (apply clojure.java.io/reader f opts)] (loop [c (.read r)] (if (neg? c) (str sb) (do (.append sb (char c)) (recur (.read r))))))))) (defn spit "Opposite of slurp. Opens f with writer, writes content, then closes f. Options passed to clojure.java.io/writer." {:added "1.2"} [f content & options] (with-open [^java.io.Writer w (apply clojure.java.io/writer f options)] (.write w (str content)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;; (defn future-call "Takes a function of no args and yields a future object that will invoke the function in another thread, and will cache the result and return it on all subsequent calls to deref/@. If the computation has not yet finished, calls to deref/@ will block, unless the variant of deref with timeout is used. See also - realized?." {:added "1.1" :static true} [f] (let [f (binding-conveyor-fn f) fut (.submit clojure.lang.Agent/soloExecutor ^Callable f)] (reify clojure.lang.IDeref (deref [_] (deref-future fut)) clojure.lang.IBlockingDeref (deref [_ timeout-ms timeout-val] (deref-future fut timeout-ms timeout-val)) clojure.lang.IPending (isRealized [_] (.isDone fut)) java.util.concurrent.Future (get [_] (.get fut)) (get [_ timeout unit] (.get fut timeout unit)) (isCancelled [_] (.isCancelled fut)) (isDone [_] (.isDone fut)) (cancel [_ interrupt?] (.cancel fut interrupt?))))) (defmacro future "Takes a body of expressions and yields a future object that will invoke the body in another thread, and will cache the result and return it on all subsequent calls to deref/@. If the computation has not yet finished, calls to deref/@ will block, unless the variant of deref with timeout is used. See also - realized?." {:added "1.1"} [& body] `(future-call (^{:once true} fn* [] ~@body))) (defn future-cancel "Cancels the future, if possible." {:added "1.1" :static true} [^java.util.concurrent.Future f] (.cancel f true)) (defn future-cancelled? "Returns true if future f is cancelled" {:added "1.1" :static true} [^java.util.concurrent.Future f] (.isCancelled f)) (defn pmap "Like map, except f is applied in parallel. Semi-lazy in that the parallel computation stays ahead of the consumption, but doesn't realize the entire result unless required. Only useful for computationally intensive functions where the time of f dominates the coordination overhead." {:added "1.0" :static true} ([f coll] (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) rets (map #(future (f %)) coll) step (fn step [[x & xs :as vs] fs] (lazy-seq (if-let [s (seq fs)] (cons (deref x) (step xs (rest s))) (map deref vs))))] (step rets (drop n rets)))) ([f coll & colls] (let [step (fn step [cs] (lazy-seq (let [ss (map seq cs)] (when (every? identity ss) (cons (map first ss) (step (map rest ss)))))))] (pmap #(apply f %) (step (cons coll colls)))))) (defn pcalls "Executes the no-arg fns in parallel, returning a lazy sequence of their values" {:added "1.0" :static true} [& fns] (pmap #(%) fns)) (defmacro pvalues "Returns a lazy sequence of the values of the exprs, which are evaluated in parallel" {:added "1.0" :static true} [& exprs] `(pcalls ~@(map #(list `fn [] %) exprs))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; clojure version number ;;;;;;;;;;;;;;;;;;;;;; ;(let [properties (with-open [version-stream (.getResourceAsStream ; (ClassLoader/getSystemClassLoader) ; "clojure/version.properties")] ; (doto (new java.util.Properties) ; (.load version-stream))) ; version-string (.getProperty properties "version") ; [_ major minor incremental qualifier snapshot] ; (re-matches ; #"(\d+)\.(\d+)\.(\d+)(?:-([a-zA-Z0-9_]+))?(?:-(SNAPSHOT))?" ; version-string) ; clojure-version {:major (Integer/valueOf ^String major) ; :minor (Integer/valueOf ^String minor) ; :incremental (Integer/valueOf ^String incremental) ; :qualifier (if (= qualifier "SNAPSHOT") nil qualifier)}] ; (def ^:dynamic *clojure-version* ; (if (.contains version-string "SNAPSHOT") ; (clojure.lang.RT/assoc clojure-version :interim true) ; clojure-version))) (def ^:dynamic *clojure-version* {:major 1, :minor 5, :incremental 1, :qualifier nil}) ;(add-doc-and-meta *clojure-version* ; "The version info for Clojure core, as a map containing :major :minor ; :incremental and :qualifier keys. Feature releases may increment ; :minor and/or :major, bugfix releases will increment :incremental. ; Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\"" ; {:added "1.0"}) (defn clojure-version "Returns clojure version as a printable string." {:added "1.0"} [] (str (:major *clojure-version*) "." (:minor *clojure-version*) (when-let [i (:incremental *clojure-version*)] (str "." i)) (when-let [q (:qualifier *clojure-version*)] (when (pos? (count q)) (str "-" q))) (when (:interim *clojure-version*) "-SNAPSHOT"))) (defn promise "Returns a promise object that can be read with deref/@, and set, once only, with deliver. Calls to deref/@ prior to delivery will block, unless the variant of deref with timeout is used. All subsequent derefs will return the same delivered value without blocking. See also - realized?." {:added "1.1" :static true} [] (let [d (java.util.concurrent.CountDownLatch. 1) v (atom d)] (reify clojure.lang.IDeref (deref [_] (.await d) @v) clojure.lang.IBlockingDeref (deref [_ timeout-ms timeout-val] (if (.await d timeout-ms java.util.concurrent.TimeUnit/MILLISECONDS) @v timeout-val)) clojure.lang.IPending (isRealized [this] (zero? (.getCount d))) clojure.lang.IFn (invoke [this x] (when (and (pos? (.getCount d)) (compare-and-set! v d x)) (.countDown d) this))))) (defn deliver "Delivers the supplied value to the promise, releasing any pending derefs. A subsequent call to deliver on a promise will have no effect." {:added "1.1" :static true} [promise val] (promise val)) (defn flatten "Takes any nested combination of sequential things (lists, vectors, etc.) and returns their contents as a single, flat sequence. (flatten nil) returns an empty sequence." {:added "1.2" :static true} [x] (filter (complement sequential?) (rest (tree-seq sequential? seq x)))) (defn group-by "Returns a map of the elements of coll keyed by the result of f on each element. The value at each key will be a vector of the corresponding elements, in the order they appeared in coll." {:added "1.2" :static true} [f coll] (persistent! (reduce (fn [ret x] (let [k (f x)] (assoc! ret k (conj (get ret k []) x)))) (transient {}) coll))) (defn partition-by "Applies f to each value in coll, splitting it each time f returns a new value. Returns a lazy seq of partitions. Returns a stateful transducer when no collection is provided." {:added "1.2" :static true} ([f] (fn [rf] (let [a (java.util.ArrayList.) pv (volatile! ::none)] (fn ([] (rf)) ([result] (let [result (if (.isEmpty a) result (let [v (vec (.toArray a))] ;;clear first! (.clear a) (unreduced (rf result v))))] (rf result))) ([result input] (let [pval @pv val (f input)] (vreset! pv val) (if (or (identical? pval ::none) (= val pval)) (do (.add a input) result) (let [v (vec (.toArray a))] (.clear a) (let [ret (rf result v)] (when-not (reduced? ret) (.add a input)) ret))))))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (let [fst (first s) fv (f fst) run (cons fst (take-while #(= fv (f %)) (next s)))] (cons run (partition-by f (seq (drop (count run) s))))))))) (defn frequencies "Returns a map from distinct items in coll to the number of times they appear." {:added "1.2" :static true} [coll] (persistent! (reduce (fn [counts x] (assoc! counts x (inc (get counts x 0)))) (transient {}) coll))) (defn reductions "Returns a lazy seq of the intermediate values of the reduction (as per reduce) of coll by f, starting with init." {:added "1.2"} ([f coll] (lazy-seq (if-let [s (seq coll)] (reductions f (first s) (rest s)) (list (f))))) ([f init coll] (if (reduced? init) (list @init) (cons init (lazy-seq (when-let [s (seq coll)] (reductions f (f init (first s)) (rest s)))))))) (defn rand-nth "Return a random element of the (sequential) collection. Will have the same performance characteristics as nth for the given collection." {:added "1.2" :static true} [coll] (nth coll (rand-int (count coll)))) (defn partition-all "Returns a lazy sequence of lists like partition, but may include partitions with fewer than n items at the end. Returns a stateful transducer when no collection is provided." {:added "1.2" :static true} ([^long n] (fn [rf] (let [a (java.util.ArrayList. n)] (fn ([] (rf)) ([result] (let [result (if (.isEmpty a) result (let [v (vec (.toArray a))] ;;clear first! (.clear a) (unreduced (rf result v))))] (rf result))) ([result input] (.add a input) (if (= n (.size a)) (let [v (vec (.toArray a))] (.clear a) (rf result v)) result)))))) ([n coll] (partition-all n n coll)) ([n step coll] (lazy-seq (when-let [s (seq coll)] (let [seg (doall (take n s))] (cons seg (partition-all n step (nthrest s step)))))))) (defn shuffle "Return a random permutation of coll" {:added "1.2" :static true} [^java.util.Collection coll] (let [al (java.util.ArrayList. coll)] (java.util.Collections/shuffle al) (clojure.lang.RT/vector (.toArray al)))) (defn map-indexed "Returns a lazy sequence consisting of the result of applying f to 0 and the first item of coll, followed by applying f to 1 and the second item in coll, etc, until coll is exhausted. Thus function f should accept 2 arguments, index and item. Returns a stateful transducer when no collection is provided." {:added "1.2" :static true} ([f] (fn [rf] (let [i (volatile! -1)] (fn ([] (rf)) ([result] (rf result)) ([result input] (rf result (f (vswap! i inc) input))))))) ([f coll] (letfn [(mapi [idx coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (int (count c)) b (chunk-buffer size)] (dotimes [i size] (chunk-append b (f (+ idx i) (.nth c i)))) (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s)))) (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))] (mapi 0 coll)))) (defn keep "Returns a lazy sequence of the non-nil results of (f item). Note, this means false return values will be included. f must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.2" :static true} ([f] (fn [rf] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [v (f input)] (if (nil? v) result (rf result v))))))) ([f coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [x (f (.nth c i))] (when-not (nil? x) (chunk-append b x)))) (chunk-cons (chunk b) (keep f (chunk-rest s)))) (let [x (f (first s))] (if (nil? x) (keep f (rest s)) (cons x (keep f (rest s)))))))))) (defn keep-indexed "Returns a lazy sequence of the non-nil results of (f index item). Note, this means false return values will be included. f must be free of side-effects. Returns a stateful transducer when no collection is provided." {:added "1.2" :static true} ([f] (fn [rf] (let [iv (volatile! -1)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [i (vswap! iv inc) v (f i input)] (if (nil? v) result (rf result v)))))))) ([f coll] (letfn [(keepi [idx coll] (lazy-seq (when-let [s (seq coll)] (if (chunked-seq? s) (let [c (chunk-first s) size (count c) b (chunk-buffer size)] (dotimes [i size] (let [x (f (+ idx i) (.nth c i))] (when-not (nil? x) (chunk-append b x)))) (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s)))) (let [x (f idx (first s))] (if (nil? x) (keepi (inc idx) (rest s)) (cons x (keepi (inc idx) (rest s)))))))))] (keepi 0 coll)))) (defn every-pred "Takes a set of predicates and returns a function f that returns true if all of its composing predicates return a logical true value against all of its arguments, else it returns false. Note that f is short-circuiting in that it will stop execution on the first argument that triggers a logical false result against the original predicates." {:added "1.3"} ([p] (fn ep1 ([] true) ([x] (boolean (p x))) ([x y] (boolean (and (p x) (p y)))) ([x y z] (boolean (and (p x) (p y) (p z)))) ([x y z & args] (boolean (and (ep1 x y z) (every? p args)))))) ([p1 p2] (fn ep2 ([] true) ([x] (boolean (and (p1 x) (p2 x)))) ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y)))) ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z)))) ([x y z & args] (boolean (and (ep2 x y z) (every? #(and (p1 %) (p2 %)) args)))))) ([p1 p2 p3] (fn ep3 ([] true) ([x] (boolean (and (p1 x) (p2 x) (p3 x)))) ([x y] (boolean (and (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y)))) ([x y z] (boolean (and (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y) (p1 z) (p2 z) (p3 z)))) ([x y z & args] (boolean (and (ep3 x y z) (every? #(and (p1 %) (p2 %) (p3 %)) args)))))) ([p1 p2 p3 & ps] (let [ps (list* p1 p2 p3 ps)] (fn epn ([] true) ([x] (every? #(% x) ps)) ([x y] (every? #(and (% x) (% y)) ps)) ([x y z] (every? #(and (% x) (% y) (% z)) ps)) ([x y z & args] (boolean (and (epn x y z) (every? #(every? % args) ps)))))))) (defn some-fn "Takes a set of predicates and returns a function f that returns the first logical true value returned by one of its composing predicates against any of its arguments, else it returns logical false. Note that f is short-circuiting in that it will stop execution on the first argument that triggers a logical true result against the original predicates." {:added "1.3"} ([p] (fn sp1 ([] nil) ([x] (p x)) ([x y] (or (p x) (p y))) ([x y z] (or (p x) (p y) (p z))) ([x y z & args] (or (sp1 x y z) (some p args))))) ([p1 p2] (fn sp2 ([] nil) ([x] (or (p1 x) (p2 x))) ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y))) ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z))) ([x y z & args] (or (sp2 x y z) (some #(or (p1 %) (p2 %)) args))))) ([p1 p2 p3] (fn sp3 ([] nil) ([x] (or (p1 x) (p2 x) (p3 x))) ([x y] (or (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y))) ([x y z] (or (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y) (p1 z) (p2 z) (p3 z))) ([x y z & args] (or (sp3 x y z) (some #(or (p1 %) (p2 %) (p3 %)) args))))) ([p1 p2 p3 & ps] (let [ps (list* p1 p2 p3 ps)] (fn spn ([] nil) ([x] (some #(% x) ps)) ([x y] (some #(or (% x) (% y)) ps)) ([x y z] (some #(or (% x) (% y) (% z)) ps)) ([x y z & args] (or (spn x y z) (some #(some % args) ps))))))) (defn- ^{:dynamic true} assert-valid-fdecl "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn." [fdecl] (when (empty? fdecl) (throw (IllegalArgumentException. "Parameter declaration missing"))) (let [argdecls (map #(if (seq? %) (first %) (throw (IllegalArgumentException. ^String (if (seq? (first fdecl)) (str "Invalid signature \"" % "\" should be a list") (str "Parameter declaration \"" % "\" should be a vector"))))) fdecl) bad-args (seq (remove #(vector? %) argdecls))] (when bad-args (throw (IllegalArgumentException. (str "Parameter declaration \"" (first bad-args) "\" should be a vector")))))) (defn with-redefs-fn "Temporarily redefines Vars during a call to func. Each val of binding-map will replace the root value of its key which must be a Var. After func is called with no args, the root values of all the Vars will be set back to their old values. These temporary changes will be visible in all threads. Useful for mocking out functions during testing." {:added "1.3"} [binding-map func] (let [root-bind (fn [m] (doseq [[a-var a-val] m] (.bindRoot ^clojure.lang.Var a-var a-val))) old-vals (zipmap (keys binding-map) (map #(.getRawRoot ^clojure.lang.Var %) (keys binding-map)))] (try (root-bind binding-map) (func) (finally (root-bind old-vals))))) (defmacro with-redefs "binding => var-symbol temp-value-expr Temporarily redefines Vars while executing the body. The temp-value-exprs will be evaluated and each resulting value will replace in parallel the root value of its Var. After the body is executed, the root values of all the Vars will be set back to their old values. These temporary changes will be visible in all threads. Useful for mocking out functions during testing." {:added "1.3"} [bindings & body] `(with-redefs-fn ~(zipmap (map #(list `var %) (take-nth 2 bindings)) (take-nth 2 (next bindings))) (fn [] ~@body))) (defn realized? "Returns true if a value has been produced for a promise, delay, future or lazy sequence." {:added "1.3"} [^clojure.lang.IPending x] (.isRealized x)) (defmacro cond-> "Takes an expression and a set of test/form pairs. Threads expr (via ->) through each form for which the corresponding test expression is true. Note that, unlike cond branching, cond-> threading does not short circuit after the first true test expression." {:added "1.5"} [expr & clauses] (assert (even? (count clauses))) (let [g (gensym) pstep (fn [[test step]] `(if ~test (-> ~g ~step) ~g))] `(let [~g ~expr ~@(interleave (repeat g) (map pstep (partition 2 clauses)))] ~g))) (defmacro cond->> "Takes an expression and a set of test/form pairs. Threads expr (via ->>) through each form for which the corresponding test expression is true. Note that, unlike cond branching, cond->> threading does not short circuit after the first true test expression." {:added "1.5"} [expr & clauses] (assert (even? (count clauses))) (let [g (gensym) pstep (fn [[test step]] `(if ~test (->> ~g ~step) ~g))] `(let [~g ~expr ~@(interleave (repeat g) (map pstep (partition 2 clauses)))] ~g))) (defmacro as-> "Binds name to expr, evaluates the first form in the lexical context of that binding, then binds name to that result, repeating for each successive form, returning the result of the last form." {:added "1.5"} [expr name & forms] `(let [~name ~expr ~@(interleave (repeat name) forms)] ~name)) (defmacro some-> "When expr is not nil, threads it into the first form (via ->), and when that result is not nil, through the next etc" {:added "1.5"} [expr & forms] (let [g (gensym) pstep (fn [step] `(if (nil? ~g) nil (-> ~g ~step)))] `(let [~g ~expr ~@(interleave (repeat g) (map pstep forms))] ~g))) (defmacro some->> "When expr is not nil, threads it into the first form (via ->>), and when that result is not nil, through the next etc" {:added "1.5"} [expr & forms] (let [g (gensym) pstep (fn [step] `(if (nil? ~g) nil (->> ~g ~step)))] `(let [~g ~expr ~@(interleave (repeat g) (map pstep forms))] ~g))) (defn ^:private preserving-reduced [rf] #(let [ret (rf %1 %2)] (if (reduced? ret) (reduced ret) ret))) (defn cat "A transducer which concatenates the contents of each input, which must be a collection, into the reduction." {:added "1.7"} [rf] (let [rrf (preserving-reduced rf)] (fn ([] (rf)) ([result] (rf result)) ([result input] (reduce rrf result input))))) (defn dedupe "Returns a lazy sequence removing consecutive duplicates in coll. Returns a transducer when no collection is provided." {:added "1.7"} ([] (fn [rf] (let [pv (volatile! ::none)] (fn ([] (rf)) ([result] (rf result)) ([result input] (let [prior @pv] (vreset! pv input) (if (= prior input) result (rf result input)))))))) ([coll] (sequence (dedupe) coll))) (defn random-sample "Returns items from coll with random probability of prob (0.0 - 1.0). Returns a transducer when no collection is provided." {:added "1.7"} ([prob] (filter (fn [_] (< (rand) prob)))) ([prob coll] (filter (fn [_] (< (rand) prob)) coll))) (deftype Eduction [xform coll] Iterable (iterator [_] (clojure.lang.TransformerIterator/create xform (clojure.lang.RT/iter coll))) clojure.lang.IReduceInit (reduce [_ f init] ;; NB (completing f) isolates completion of inner rf from outer rf (transduce xform (completing f) init coll)) clojure.lang.Sequential) (defn eduction "Returns a reducible/iterable application of the transducers to the items in coll. Transducers are applied in order as if combined with comp. Note that these applications will be performed every time reduce/iterator is called." {:arglists '([xform* coll]) :added "1.7"} [& xforms] (Eduction. (apply comp (butlast xforms)) (last xforms))) (defmethod print-method Eduction [c, ^Writer w] (if *print-readably* (do (print-sequential "(" pr-on " " ")" c w)) (print-object c w))) (defn run! "Runs the supplied procedure (via reduce), for purposes of side effects, on successive items in the collection. Returns nil" {:added "1.7"} [proc coll] (reduce #(proc %2) nil coll)) (defn tagged-literal? "Return true if the value is the data representation of a tagged literal" {:added "1.7"} [value] (instance? clojure.lang.TaggedLiteral value)) (defn tagged-literal "Construct a data representation of a tagged literal from a tag symbol and a form." {:added "1.7"} [^clojure.lang.Symbol tag form] (clojure.lang.TaggedLiteral/create tag form)) (defn reader-conditional? "Return true if the value is the data representation of a reader conditional" {:added "1.7"} [value] (instance? clojure.lang.ReaderConditional value)) (defn reader-conditional "Construct a data representation of a reader conditional. If true, splicing? indicates read-cond-splicing." {:added "1.7"} [form ^Boolean splicing?] (clojure.lang.ReaderConditional/create form splicing?)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; data readers ;;;;;;;;;;;;;;;;;; (def ^{:added "1.4"} default-data-readers "Default map of data reader functions provided by Clojure. May be overridden by binding *data-readers*." {'inst #'clojure.instant/read-instant-date 'uuid #'clojure.uuid/default-uuid-reader}) (def ^{:added "1.4" :dynamic true} *data-readers* "Map from reader tag symbols to data reader Vars. When Clojure starts, it searches for files named 'data_readers.clj' at the root of the classpath. Each such file must contain a literal map of symbols, like this: {foo/bar my.project.foo/bar foo/baz my.project/baz} The first symbol in each pair is a tag that will be recognized by the Clojure reader. The second symbol in the pair is the fully-qualified name of a Var which will be invoked by the reader to parse the form following the tag. For example, given the data_readers.clj file above, the Clojure reader would parse this form: #foo/bar [1 2 3] by invoking the Var #'my.project.foo/bar on the vector [1 2 3]. The data reader function is invoked on the form AFTER it has been read as a normal Clojure data structure by the reader. Reader tags without namespace qualifiers are reserved for Clojure. Default reader tags are defined in clojure.core/default-data-readers but may be overridden in data_readers.clj or by rebinding this Var." {}) (def ^{:added "1.5" :dynamic true} *default-data-reader-fn* "When no data reader is found for a tag and *default-data-reader-fn* is non-nil, it will be called with two arguments, the tag and the value. If *default-data-reader-fn* is nil (the default), an exception will be thrown for the unknown tag." nil) ;(defn- data-reader-urls [] ; (enumeration-seq ; (.getResources (ClassLoader/getSystemClassLoader) "data_readers.clj"))) ;(defn- data-reader-var [sym] ; (intern (create-ns (symbol (namespace sym))) ; (symbol (name sym)))) ;(defn- load-data-reader-file [mappings ^java.net.URL url] ; (with-open [rdr (clojure.lang.LineNumberingPushbackReader. ; (java.io.InputStreamReader. ; (.openStream url) "UTF-8"))] ; (binding [*file* (.getFile url)] ; (let [new-mappings (read rdr false nil)] ; (when (not (map? new-mappings)) ; (throw (ex-info (str "Not a valid data-reader map") ; {:url url}))) ; (reduce ; (fn [m [k v]] ; (when (not (symbol? k)) ; (throw (ex-info (str "Invalid form in data-reader file") ; {:url url ; :form k}))) ; (let [v-var (data-reader-var v)] ; (when (and (contains? mappings k) ; (not= (mappings k) v-var)) ; (throw (ex-info "Conflicting data-reader mapping" ; {:url url ; :conflict k ; :mappings m}))) ; (assoc m k v-var))) ; mappings ; new-mappings))))) ;(defn- load-data-readers [] ; (alter-var-root #'*data-readers* ; (fn [mappings] ; (reduce load-data-reader-file ; mappings (data-reader-urls))))) ;(try ; (load-data-readers) ; (catch Throwable t ; (.printStackTrace t) ; (throw t))) (load "core_objc") ================================================ FILE: src/clj/clojure/core_deftype.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; definterface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn namespace-munge "Convert a Clojure namespace name to a legal Java package name." {:added "1.2"} [ns] (.replace (str ns) \- \_)) ;for now, built on gen-interface (defmacro definterface "Creates a new Java interface with the given name and method sigs. The method return types and parameter types may be specified with type hints, defaulting to Object if omitted. (definterface MyInterface (^int method1 [x]) (^Bar method2 [^Baz b ^Quux q]))" {:added "1.2"} ;; Present since 1.2, but made public in 1.5. [name & sigs] (let [tag (fn [x] (or (:tag (meta x)) Object)) psig (fn [[name [& args]]] (vector name (vec (map tag args)) (tag name) (map meta args))) cname (with-meta (symbol (str (namespace-munge *ns*) "." (namespace-munge name))) (meta name))] `(do (gen-interface :name ~cname :methods ~(vec (map psig sigs))) (import ~cname)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; reify/deftype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- parse-opts [s] (loop [opts {} [k v & rs :as s] s] (if (keyword? k) (recur (assoc opts k v) rs) [opts s]))) (defn- parse-impls [specs] (loop [ret {} s specs] (if (seq s) (recur (assoc ret (first s) (take-while seq? (next s))) (drop-while seq? (next s))) ret))) (defn- parse-opts+specs [opts+specs] (let [[opts specs] (parse-opts opts+specs) impls (parse-impls specs) interfaces (-> (map #(if (var? (resolve %)) (:on (deref (resolve %))) %) (keys impls)) set (disj 'Object 'java.lang.Object) vec) methods (map (fn [[name params & body]] (cons name (maybe-destructured params body))) (apply concat (vals impls)))] (when-let [bad-opts (seq (remove #{:no-print} (keys opts)))] (throw (IllegalArgumentException. ^String (apply print-str "Unsupported option(s) -" bad-opts)))) [interfaces methods opts])) (defmacro reify "reify is a macro with the following structure: (reify options* specs*) Currently there are no options. Each spec consists of the protocol or interface name followed by zero or more method bodies: protocol-or-interface-or-Object (methodName [args+] body)* Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for methods of Object. Note that the first parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method head should *not* pass the target object, it will be supplied automatically and can not be substituted. The return type can be indicated by a type hint on the method name, and arg types can be indicated by a type hint on arg names. If you leave out all hints, reify will try to match on same name/arity method in the protocol(s)/interface(s) - this is preferred. If you supply any hints at all, no inference is done, so all hints (or default of Object) must be correct, for both arguments and return type. If a method is overloaded in a protocol/interface, multiple independent method definitions must be supplied. If overloaded with same arity in an interface you must specify complete hints to disambiguate - a missing hint implies Object. recur works to method heads The method bodies of reify are lexical closures, and can refer to the surrounding local scope: (str (let [f \"foo\"] (reify Object (toString [this] f)))) == \"foo\" (seq (let [f \"foo\"] (reify clojure.lang.Seqable (seq [this] (seq f))))) == (\\f \\o \\o)) reify always implements clojure.lang.IObj and transfers meta data of the form to the created object. (meta ^{:k :v} (reify Object (toString [this] \"foo\"))) == {:k :v}" {:added "1.2"} [& opts+specs] (let [[interfaces methods] (parse-opts+specs opts+specs)] (with-meta `(reify* ~interfaces ~@methods) (meta &form)))) (defn hash-combine [x y] (clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y))) (defn munge [s] ((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s)))) (defn- imap-cons [^IPersistentMap this o] (cond (instance? java.util.Map$Entry o) (let [^java.util.Map$Entry pair o] (.assoc this (.getKey pair) (.getValue pair))) (instance? clojure.lang.IPersistentVector o) (let [^clojure.lang.IPersistentVector vec o] (.assoc this (.nth vec 0) (.nth vec 1))) :else (loop [this this o o] (if (seq o) (let [^java.util.Map$Entry pair (first o)] (recur (.assoc this (.getKey pair) (.getValue pair)) (rest o))) this)))) (defn- emit-defrecord "Do not use this directly - use defrecord" {:added "1.2"} [tagname name fields interfaces methods] (let [classname (with-meta (symbol (str (namespace-munge *ns*) "." (namespace-munge name))) (meta name)) interfaces (vec interfaces) interface-set (set (map resolve interfaces)) methodname-set (set (map first methods)) hinted-fields fields fields (vec (map #(with-meta % nil) fields)) base-fields fields fields (conj fields '__meta '__extmap) type-hash (hash classname)] (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields)) (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields"))) (let [gs (gensym)] (letfn [(irecord [[i m]] [(conj i 'clojure.lang.IRecord) m]) (eqhash [[i m]] [(conj i 'clojure.lang.IHashEq) (conj m `(hasheq [this#] (bit-xor ~type-hash (clojure.lang.APersistentMap/mapHasheq this#))) `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#)) `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))]) (iobj [[i m]] [(conj i 'clojure.lang.IObj) (conj m `(meta [this#] ~'__meta) `(withMeta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))))]) (ilookup [[i m]] [(conj i 'clojure.lang.ILookup 'clojure.lang.IKeywordLookup) (conj m `(valAt [this# k#] (.valAt this# k# nil)) `(valAt [this# k# else#] (case k# ~@(mapcat (fn [fld] [(keyword fld) fld]) base-fields) (get ~'__extmap k# else#))) `(getLookupThunk [this# k#] (let [~'gclass (class this#)] (case k# ~@(let [hinted-target (with-meta 'gtarget {:tag tagname})] (mapcat (fn [fld] [(keyword fld) `(reify clojure.lang.ILookupThunk (get [~'thunk ~'gtarget] (if (identical? (class ~'gtarget) ~'gclass) (. ~hinted-target ~(symbol (str "-" fld))) ~'thunk)))]) base-fields)) nil))))]) (imap [[i m]] [(conj i 'clojure.lang.IPersistentMap) (conj m `(count [this#] (+ ~(count base-fields) (count ~'__extmap))) `(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname))))) `(cons [this# e#] ((var imap-cons) this# e#)) `(equiv [this# ~gs] (boolean (or (identical? this# ~gs) (when (identical? (class this#) (class ~gs)) (let [~gs ~(with-meta gs {:tag tagname})] (and ~@(map (fn [fld] `(= ~fld (. ~gs ~(symbol (str "-" fld))))) base-fields) (= ~'__extmap (. ~gs ~'__extmap)))))))) `(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#)))) `(entryAt [this# k#] (let [v# (.valAt this# k# this#)] (when-not (identical? this# v#) (clojure.lang.MapEntry. k# v#)))) `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)] ~'__extmap))) `(iterator [~gs] (clojure.lang.RecordIterator. ~gs [~@(map keyword base-fields)] (RT/iter ~'__extmap))) `(assoc [this# k# ~gs] (condp identical? k# ~@(mapcat (fn [fld] [(keyword fld) (list* `new tagname (replace {fld gs} fields))]) base-fields) (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs)))) `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#) (dissoc (with-meta (into {} this#) ~'__meta) k#) (new ~tagname ~@(remove #{'__extmap} fields) (not-empty (dissoc ~'__extmap k#))))))]) (ijavamap [[i m]] [(conj i 'java.util.Map 'java.io.Serializable) (conj m `(size [this#] (.count this#)) `(isEmpty [this#] (= 0 (.count this#))) `(containsValue [this# v#] (boolean (some #{v#} (vals this#)))) `(get [this# k#] (.valAt this# k#)) `(put [this# k# v#] (throw (UnsupportedOperationException.))) `(remove [this# k#] (throw (UnsupportedOperationException.))) `(putAll [this# m#] (throw (UnsupportedOperationException.))) `(clear [this#] (throw (UnsupportedOperationException.))) `(keySet [this#] (set (keys this#))) `(values [this#] (vals this#)) `(entrySet [this#] (set this#)))]) ] (let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)] `(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap) :implements ~(vec i) ~@m)))))) (defn- build-positional-factory "Used to build a positional factory for a given type/record. Because of the limitation of 20 arguments to Clojure functions, this factory needs to be constructed to deal with more arguments. It does this by building a straight forward type/record ctor call in the <=20 case, and a call to the same ctor pulling the extra args out of the & overage parameter. Finally, the arity is constrained to the number of expected fields and an ArityException will be thrown at runtime if the actual arg count does not match." [nom classname fields] (let [fn-name (symbol (str '-> nom)) [field-args over] (split-at 20 fields) field-count (count fields) arg-count (count field-args) over-count (count over) docstring (str "Positional factory function for class " classname ".")] `(defn ~fn-name ~docstring [~@field-args ~@(if (seq over) '[& overage] [])] ~(if (seq over) `(if (= (count ~'overage) ~over-count) (new ~classname ~@field-args ~@(for [i (range 0 (count over))] (list `nth 'overage i))) (throw (clojure.lang.ArityException. (+ ~arg-count (count ~'overage)) (name '~fn-name)))) `(new ~classname ~@field-args))))) (defn- validate-fields "" [fields name] (when-not (vector? fields) (throw (AssertionError. "No fields vector given."))) (let [specials #{'__meta '__extmap}] (when (some specials fields) (throw (AssertionError. (str "The names in " specials " cannot be used as field names for types or records."))))) (let [non-syms (remove symbol? fields)] (when (seq non-syms) (throw (clojure.lang.Compiler$CompilerException. *file* (.deref clojure.lang.Compiler/LINE) (.deref clojure.lang.Compiler/COLUMN) (AssertionError. (str "defrecord and deftype fields must be symbols, " *ns* "." name " had: " (apply str (interpose ", " non-syms))))))))) (defmacro defrecord "(defrecord name [fields*] options* specs*) Currently there are no options. Each spec consists of a protocol or interface name followed by zero or more method bodies: protocol-or-interface-or-Object (methodName [args*] body)* Dynamically generates compiled bytecode for class with the given name, in a package with the same name as the current namespace, the given fields, and, optionally, methods for protocols and/or interfaces. The class will have the (immutable) fields named by fields, which can have type hints. Protocols/interfaces and methods are optional. The only methods that can be supplied are those declared in the protocols/interfaces. Note that method bodies are not closures, the local environment includes only the named fields, and those fields can be accessed directly. Method definitions take the form: (methodname [args*] body) The argument and return types can be hinted on the arg and methodname symbols. If not supplied, they will be inferred, so type hints should be reserved for disambiguation. Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for methods of Object. Note that a parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method head should *not* pass the target object, it will be supplied automatically and can not be substituted. In the method bodies, the (unqualified) name can be used to name the class (for calls to new, instance? etc). The class will have implementations of several (clojure.lang) interfaces generated automatically: IObj (metadata support) and IPersistentMap, and all of their superinterfaces. In addition, defrecord will define type-and-value-based =, and will defined Java .hashCode and .equals consistent with the contract for java.util.Map. When AOT compiling, generates compiled bytecode for a class with the given name (a symbol), prepends the current ns as the package, and writes the .class file to the *compile-path* directory. Two constructors will be defined, one taking the designated fields followed by a metadata map (nil for none) and an extension field map (nil for none), and one taking only the fields (using nil for meta and extension fields). Note that the field names __meta and __extmap are currently reserved and should not be used when defining your own records. Given (defrecord TypeName ...), two factory functions will be defined: ->TypeName, taking positional parameters for the fields, and map->TypeName, taking a map of keywords to field values." {:added "1.2" :arglists '([name [& fields] & opts+specs])} [name fields & opts+specs] (validate-fields fields name) (let [gname (namespace-munge name) [interfaces methods opts] (parse-opts+specs opts+specs) ns-part (namespace-munge *ns*) classname (symbol (str ns-part "." gname)) hinted-fields fields fields (vec (map #(with-meta % nil) fields))] `(do (declare ~(symbol (str '-> gname))) (declare ~(symbol (str 'map-> gname))) ~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods) (import ~classname) ~(build-positional-factory gname classname fields) (defn ~(symbol (str 'map-> gname)) ~(str "Factory function for class " classname ", taking a map of keywords to field values.") ([m#] (~(symbol (str classname "/create")) (if (instance? clojure.lang.MapEquivalence m#) m# (into {} m#))))) ~classname))) (defn record? "Returns true if x is a record" {:added "1.6" :static true} [x] (instance? clojure.lang.IRecord x)) (defn- emit-deftype* "Do not use this directly - use deftype" [tagname name fields interfaces methods] (let [classname (with-meta (symbol (str (namespace-munge *ns*) "." (namespace-munge name))) (meta name)) interfaces (conj interfaces 'clojure.lang.IType)] `(deftype* ~tagname ~classname ~fields :implements ~interfaces ~@methods))) (defmacro deftype "(deftype name [fields*] options* specs*) Currently there are no options. Each spec consists of a protocol or interface name followed by zero or more method bodies: protocol-or-interface-or-Object (methodName [args*] body)* Dynamically generates compiled bytecode for class with the given name, in a package with the same name as the current namespace, the given fields, and, optionally, methods for protocols and/or interfaces. The class will have the (by default, immutable) fields named by fields, which can have type hints. Protocols/interfaces and methods are optional. The only methods that can be supplied are those declared in the protocols/interfaces. Note that method bodies are not closures, the local environment includes only the named fields, and those fields can be accessed directly. Fields can be qualified with the metadata :volatile-mutable true or :unsynchronized-mutable true, at which point (set! afield aval) will be supported in method bodies. Note well that mutable fields are extremely difficult to use correctly, and are present only to facilitate the building of higher level constructs, such as Clojure's reference types, in Clojure itself. They are for experts only - if the semantics and implications of :volatile-mutable or :unsynchronized-mutable are not immediately apparent to you, you should not be using them. Method definitions take the form: (methodname [args*] body) The argument and return types can be hinted on the arg and methodname symbols. If not supplied, they will be inferred, so type hints should be reserved for disambiguation. Methods should be supplied for all methods of the desired protocol(s) and interface(s). You can also define overrides for methods of Object. Note that a parameter must be supplied to correspond to the target object ('this' in Java parlance). Thus methods for interfaces will take one more argument than do the interface declarations. Note also that recur calls to the method head should *not* pass the target object, it will be supplied automatically and can not be substituted. In the method bodies, the (unqualified) name can be used to name the class (for calls to new, instance? etc). When AOT compiling, generates compiled bytecode for a class with the given name (a symbol), prepends the current ns as the package, and writes the .class file to the *compile-path* directory. One constructor will be defined, taking the designated fields. Note that the field names __meta and __extmap are currently reserved and should not be used when defining your own types. Given (deftype TypeName ...), a factory function called ->TypeName will be defined, taking positional parameters for the fields" {:added "1.2" :arglists '([name [& fields] & opts+specs])} [name fields & opts+specs] (validate-fields fields name) (let [gname (namespace-munge name) [interfaces methods opts] (parse-opts+specs opts+specs) ns-part (namespace-munge *ns*) classname (symbol (str ns-part "." gname)) hinted-fields fields fields (vec (map #(with-meta % nil) fields)) [field-args over] (split-at 20 fields)] `(do ~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods) (import ~classname) ~(build-positional-factory gname classname fields) ~classname))) ;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;; (defn- expand-method-impl-cache [^clojure.lang.MethodImplCache cache c f] (if (.map cache) (let [cs (assoc (.map cache) c (clojure.lang.MethodImplCache$Entry. c f))] (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) cs)) (let [cs (into1 {} (remove (fn [[c e]] (nil? e)) (map vec (partition 2 (.table cache))))) cs (assoc cs c (clojure.lang.MethodImplCache$Entry. c f))] (if-let [[shift mask] (maybe-min-hash (map hash (keys cs)))] (let [table (make-array Object (* 2 (inc mask))) table (reduce1 (fn [^objects t [c e]] (let [i (* 2 (int (shift-mask shift mask (hash c))))] (aset t i c) (aset t (inc i) e) t)) table cs)] (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) shift mask table)) (clojure.lang.MethodImplCache. (.protocol cache) (.methodk cache) cs))))) (defn- super-chain [^Class c] (when c (cons c (super-chain (.getSuperclass c))))) (defn- pref ([] nil) ([a] a) ([^Class a ^Class b] (if (.isAssignableFrom a b) b a))) (defn find-protocol-impl [protocol x] (if (instance? (:on-interface protocol) x) x (let [c (class x) impl #(get (:impls protocol) %)] (or (impl c) (and c (or (first (remove nil? (map impl (butlast (super-chain c))))) (when-let [t (reduce1 pref (filter impl (disj (supers c) Object)))] (impl t)) (impl Object))))))) (defn find-protocol-method [protocol methodk x] (get (find-protocol-impl protocol x) methodk)) (defn- protocol? [maybe-p] (boolean (:on-interface maybe-p))) (defn- implements? [protocol atype] (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype))) (defn extends? "Returns true if atype extends protocol" {:added "1.2"} [protocol atype] (boolean (or (implements? protocol atype) (get (:impls protocol) atype)))) (defn extenders "Returns a collection of the types explicitly extending protocol" {:added "1.2"} [protocol] (keys (:impls protocol))) (defn satisfies? "Returns true if x satisfies the protocol" {:added "1.2"} [protocol x] (boolean (find-protocol-impl protocol x))) (defn -cache-protocol-fn [^clojure.lang.AFunction pf x ^Class c ^clojure.lang.IFn interf] (let [cache (.__methodImplCache pf) f (if (.isInstance c x) interf (find-protocol-method (.protocol cache) (.methodk cache) x))] (when-not f (throw (IllegalArgumentException. (str "No implementation of method: " (.methodk cache) " of protocol: " (:var (.protocol cache)) " found for class: " (if (nil? x) "nil" (.getName (class x))))))) (set! (.__methodImplCache pf) (expand-method-impl-cache cache (class x) f)) f)) (defn- emit-method-builder [on-interface method on-method arglists] (let [methodk (keyword method) gthis (with-meta (gensym) {:tag 'clojure.lang.AFunction}) ginterf (gensym)] `(fn [cache#] (let [~ginterf (fn ~@(map (fn [args] (let [gargs (map #(gensym (str "gf__" % "__")) args) target (first gargs)] `([~@gargs] (. ~(with-meta target {:tag on-interface}) (~(or on-method method) ~@(rest gargs)))))) arglists)) ^clojure.lang.AFunction f# (fn ~gthis ~@(map (fn [args] (let [gargs (map #(gensym (str "gf__" % "__")) args) target (first gargs)] `([~@gargs] (let [cache# (.__methodImplCache ~gthis) f# (.fnFor cache# (clojure.lang.Util/classOf ~target))] (if f# (f# ~@gargs) ((-cache-protocol-fn ~gthis ~target ~on-interface ~ginterf) ~@gargs)))))) arglists))] (set! (.__methodImplCache f#) cache#) f#)))) (defn -reset-methods [protocol] (doseq [[^clojure.lang.Var v build] (:method-builders protocol)] (let [cache (clojure.lang.MethodImplCache. protocol (keyword (.sym v)))] (.bindRoot v (build cache))))) (defn- assert-same-protocol [protocol-var method-syms] (doseq [m method-syms] (let [^clojure.lang.Var v (resolve m) ^clojure.lang.Var p (:protocol (meta v))] (when (and v (bound? v) (not= protocol-var p)) (binding [*out* *err*] (println "Warning: protocol" protocol-var "is overwriting" (if p (str "method " (.sym v) " of protocol " (.sym p)) (str "function " (.sym v))))))))) (defn- emit-protocol [name opts+sigs] (let [iname (symbol (str (munge (namespace-munge *ns*)) "." (munge (namespace-munge name)))) [opts sigs] (loop [opts {:on (list 'quote iname) :on-interface iname} sigs opts+sigs] (condp #(%1 %2) (first sigs) string? (recur (assoc opts :doc (first sigs)) (next sigs)) keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs)) [opts sigs])) sigs (when sigs (reduce1 (fn [m s] (let [name-meta (meta (first s)) mname (with-meta (first s) nil) [arglists doc] (loop [as [] rs (rest s)] (if (vector? (first rs)) (recur (conj as (first rs)) (next rs)) [(seq as) (first rs)]))] (when (some #{0} (map count arglists)) (throw (IllegalArgumentException. (str "Definition of function " mname " in protocol " name " must take at least one arg.")))) (when (m (keyword mname)) (throw (IllegalArgumentException. (str "Function " mname " in protocol " name " was redefined. Specify all arities in single definition.")))) (assoc m (keyword mname) (merge name-meta {:name (vary-meta mname assoc :doc doc :arglists arglists) :arglists arglists :doc doc})))) {} sigs)) meths (mapcat (fn [sig] (let [m (munge (:name sig))] (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object) (:arglists sig)))) (vals sigs))] `(do (defonce ~name {}) (gen-interface :name ~iname :methods ~meths) (alter-meta! (var ~name) assoc :doc ~(:doc opts)) ~(when sigs `(#'assert-same-protocol (var ~name) '~(map :name (vals sigs)))) (alter-var-root (var ~name) merge (assoc ~opts :sigs '~sigs :var (var ~name) :method-map ~(and (:on opts) (apply hash-map (mapcat (fn [s] [(keyword (:name s)) (keyword (or (:on s) (:name s)))]) (vals sigs)))) :method-builders ~(apply hash-map (mapcat (fn [s] [`(intern *ns* (with-meta '~(:name s) (merge '~s {:protocol (var ~name)}))) (emit-method-builder (:on-interface opts) (:name s) (:on s) (:arglists s))]) (vals sigs))))) (-reset-methods ~name) '~name))) (defmacro defprotocol "A protocol is a named set of named methods and their signatures: (defprotocol AProtocolName ;optional doc string \"A doc string for AProtocol abstraction\" ;method signatures (bar [this a b] \"bar docs\") (baz [this a] [this a b] [this a b c] \"baz docs\")) No implementations are provided. Docs can be specified for the protocol overall and for each method. The above yields a set of polymorphic functions and a protocol object. All are namespace-qualified by the ns enclosing the definition The resulting functions dispatch on the type of their first argument, which is required and corresponds to the implicit target object ('this' in Java parlance). defprotocol is dynamic, has no special compile-time effect, and defines no new types or classes. Implementations of the protocol methods can be provided using extend. defprotocol will automatically generate a corresponding interface, with the same name as the protocol, i.e. given a protocol: my.ns/Protocol, an interface: my.ns.Protocol. The interface will have methods corresponding to the protocol functions, and the protocol will automatically work with instances of the interface. Note that you should not use this interface with deftype or reify, as they support the protocol directly: (defprotocol P (foo [this]) (bar-me [this] [this y])) (deftype Foo [a b c] P (foo [this] a) (bar-me [this] b) (bar-me [this y] (+ c y))) (bar-me (Foo. 1 2 3) 42) => 45 (foo (let [x 42] (reify P (foo [this] 17) (bar-me [this] x) (bar-me [this y] x)))) => 17" {:added "1.2"} [name & opts+sigs] (emit-protocol name opts+sigs)) (defn- emit-impl [[p fs]] [p (zipmap (map #(-> % first keyword) fs) (map #(cons `fn (drop 1 %)) fs))]) (defn- emit-hinted-impl [c [p fs]] (let [hint (fn [specs] (let [specs (if (vector? (first specs)) (list specs) specs)] (map (fn [[[target & args] & body]] (cons (apply vector (vary-meta target assoc :tag c) args) body)) specs)))] [p (zipmap (map #(-> % first name keyword) fs) (map #(cons `fn (hint (drop 1 %))) fs))])) (defn- emit-extend-type [c specs] (let [impls (parse-impls specs)] `(extend ~c ~@(mapcat (partial emit-hinted-impl c) impls)))) (defmacro extend-type "A macro that expands into an extend call. Useful when you are supplying the definitions explicitly inline, extend-type automatically creates the maps required by extend. Propagates the class as a type hint on the first argument of all fns. (extend-type MyType Countable (cnt [c] ...) Foo (bar [x y] ...) (baz ([x] ...) ([x y & zs] ...))) expands into: (extend MyType Countable {:cnt (fn [c] ...)} Foo {:baz (fn ([x] ...) ([x y & zs] ...)) :bar (fn [x y] ...)})" {:added "1.2"} [t & specs] (emit-extend-type t specs)) (defn- emit-extend-protocol [p specs] (let [impls (parse-impls specs)] `(do ~@(map (fn [[t fs]] `(extend-type ~t ~p ~@fs)) impls)))) (defmacro extend-protocol "Useful when you want to provide several implementations of the same protocol all at once. Takes a single protocol and the implementation of that protocol for one or more types. Expands into calls to extend-type: (extend-protocol Protocol AType (foo [x] ...) (bar [x y] ...) BType (foo [x] ...) (bar [x y] ...) AClass (foo [x] ...) (bar [x y] ...) nil (foo [x] ...) (bar [x y] ...)) expands into: (do (clojure.core/extend-type AType Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type BType Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type AClass Protocol (foo [x] ...) (bar [x y] ...)) (clojure.core/extend-type nil Protocol (foo [x] ...) (bar [x y] ...)))" {:added "1.2"} [p & specs] (emit-extend-protocol p specs)) (defn extend "Implementations of protocol methods can be provided using the extend construct: (extend AType AProtocol {:foo an-existing-fn :bar (fn [a b] ...) :baz (fn ([a]...) ([a b] ...)...)} BProtocol {...} ...) extend takes a type/class (or interface, see below), and one or more protocol + method map pairs. It will extend the polymorphism of the protocol's methods to call the supplied methods when an AType is provided as the first argument. Method maps are maps of the keyword-ized method names to ordinary fns. This facilitates easy reuse of existing fns and fn maps, for code reuse/mixins without derivation or composition. You can extend an interface to a protocol. This is primarily to facilitate interop with the host (e.g. Java) but opens the door to incidental multiple inheritance of implementation since a class can inherit from more than one interface, both of which extend the protocol. It is TBD how to specify which impl to use. You can extend a protocol on nil. If you are supplying the definitions explicitly (i.e. not reusing exsting functions or mixin maps), you may find it more convenient to use the extend-type or extend-protocol macros. Note that multiple independent extend clauses can exist for the same type, not all protocols need be defined in a single extend call. See also: extends?, satisfies?, extenders" {:added "1.2"} [atype & proto+mmaps] (doseq [[proto mmap] (partition 2 proto+mmaps)] (when-not (protocol? proto) (throw (IllegalArgumentException. (str proto " is not a protocol")))) (when (implements? proto atype) (throw (IllegalArgumentException. (str atype " already directly implements " (:on-interface proto) " for protocol:" (:var proto))))) (-reset-methods (alter-var-root (:var proto) assoc-in [:impls atype] mmap)))) ================================================ FILE: src/clj/clojure/core_objc.clj ================================================ (in-ns 'clojure.core) (require 'clojure.string) (def ^:dynamic dispatch-class) (def ^:dynamic force-main-thread) (def objc? (clojure.lang.ObjC/objc)) (when-not objc? (require '[clojure.walk :as walk])) (defmacro ^{:added "1.6"} dispatch-main "Runs the body with dispatch_sync in the main queue dispatch_sync(dispatch_get_main_queue(), ^{ ... });" [& body] `(clojure.lang.RT/dispatchInMainSync (fn [] ~@body))) (defn ^{:added "1.6"} sel "Creates an objc selector. (sel \"some:selector:\")" [^String s] (clojure.lang.Selector. s)) (defn ^{:added "1.6"} objc-class "Lookup an objc class by name. (objc-class \"UIView\")" [s] (RT/objcClass (name s))) (defmacro ^{:added "1.6"} $ "The objc interop macro. Use to lookup a class or to msgSend. [UIView class] -> ($ UIView) [MyObject objectWithString:myString] -> ($ MyObject :objectWithString myString) [@\"Hello\" description] -> ($ \"Hello\" :description) [UIView alloc] -> ($ ($ UIView) :alloc) " [& args] (let [is-class (= 1 (count args)) t (first args)] (if is-class `(objc-class '~t) (let [args (vec (next args)) has-params (even? (count args)) args (partition 2 (if has-params args (conj args nil))) params (mapv second args) selector (str (subs (apply str (map first args)) 1) (if has-params ":" ""))] (if has-params `(clojure.lang.Selector/invokeSelector ~selector ~t ~params) `(clojure.lang.Selector/invokeSelector ~selector ~t)))))) (defmacro ^{:added "1.6"} $$ "Like $ but calls super. [super initWithFrame:frame] -> ($$ self :initWithFrame frame) " [& args] (let [t (first args) dispatch-class (if (bound? #'dispatch-class) dispatch-class nil) args (vec (next args)) has-params (even? (count args)) args (if has-params (partition 2 args) args) params (if has-params (mapv second args) []) selector (if has-params (str (subs (apply str (map first args)) 1) ":") (name (first args)))] `($ ($ NSCommon) :invokeSuperSel ~t :withDispatchClass ~dispatch-class :withSelector ~selector :withArgs ~params))) (def objc-types {:void \v :float \f :longlong \q :long \l :char \c :short \s :int \i :double \d :ulonglong \Q :ulong \L :uchar \C :ushort \S :uint \I :bool \b :cgpoint \P :nsrange \N :uiedge \E :cgsize \Z :cgaffinetransform \A :catransform3d \T :uioffset \O :cgrect \R :id \p :pointer \Y :cgfloat (if ($ ($ NSCommon) :cgfloatIsDouble) \d \f)}) (defmethod print-method clojure.lang.RemoteRef [^clojure.lang.RemoteRef r, ^java.io.Writer w] (.write w (str "#remote-ref \"" (.getId r) "\""))) (defmethod print-method clojure.lang.ObjCClass [^clojure.lang.ObjCClass r, ^java.io.Writer w] (.write w (str "#objc-class \"" (.getName r) "\""))) (defn ^{:added "1.6"} read-remote-ref [id] (.get (clojure.lang.RemoteRef. id))) (defn ^{:added "1.6"} read-sel [name] (clojure.lang.Selector. name)) (alter-var-root #'*data-readers* (fn [m] (merge m {'sel #'read-sel 'remote-ref #'read-remote-ref 'objc-class #'objc-class}))) (defn ^{:added "1.6"} class->types "Lookup a type for a class simple name" [c] (case c :long :longlong :integer :int :boolean :bool :float :float :double :double :short :short :void :void :character :char :remoteref :pointer (if ($ c :isKindOfClass ($ NSValue)) (some #(if (= (val %) ($ ($ NSCommon) :signatureToType ($ c :objCType))) (key %)) objc-types) :id))) (defn ^{:added "1.6"} types-for-vals [vals] (map (comp objc-types class->types keyword clojure.string/lower-case #(.getSimpleName %) class) vals)) (defn ^{:added "1.6"} ccall "The c interop. To use a c function you need to register it in using: #import \"NSCommon.h\" reg_c(CGRectMake); // From now on you can use CGRectMake in ccall The args are unboxed when necessary and the return is always a boxed value. fun: the c function name types: a vector with the return type followed by the parameters types. Types map: clojure.core/objc-types args: the arguments vector CGRectMake(1, 2, 3, 4) -> (ccall \"CGRectMake\" [\\R \\f \\f \\f \\f] [1 2 3 4]) " [fun types args] ($ ($ NSCommon) :ccall (name fun) :types (vec types) :args (vec args))) (defmacro ^{:added "1.6"} defc "Defines a c function. Supports variadic functions. Takes the function name, the return type and a vector of the arguments types. (defc CGRectMake :cgrect [:cgfloat :cgfloat :cgfloat :cgfloat]) (CGRectMake 12 23 44 55) ;; Variadic (defc NSLog :void [:id &]) (NSLog \"%@ %@ %d\" \"Hello\" \"World\" 44) " [n r types] (let [nn (name n) variadic? (= '& (last types)) types (if variadic? (drop-last types) types) types (vec (cons r types))] (if variadic? `(defn ~n [& args#] (ccall ~nn (apply conj (mapv objc-types ~types) (types-for-vals (drop (dec (count ~types)) args#))) args#)) `(defn ~n [& args#] (ccall ~nn (mapv objc-types ~types) args#))))) (defmacro ^{:added "1.6"} nsproxy "nsproxy mocks an object. It's intended to implement protocols/delegators. (nsproxy ([^id self :doSomething] \"I don't do anything\") ([^:bool self :textFieldShouldReturn ^:id field] ($ field :resignFirstResponder) true)) " [& methods] (let [objc-meta-type (comp objc-types ffirst meta) has-class (not (list? (first methods))) clazz (when has-class (name (first methods))) methods (if has-class (next methods) methods) i (map (fn [[args & body]] (let [self-sym (first args) args (next args) sel (take-nth 2 args) fields (take-nth 2 (next args)) types (map objc-meta-type (cons self-sym fields)) sel (if (pos? (count fields)) (reduce str (map #(str (name %) ":") sel)) (reduce str (map name sel)))] `[~sel [[~@types] (fn [~self-sym ~@fields] ~@body)]])) methods) i (into {} i)] `($ ($ ($ NSProxyImpl) :alloc) :initWithClass ~clazz :map ~i))) (defc ^{:added "1.6"} objc_setAssociatedObject :void [:id :pointer :id :int]) (defc ^{:added "1.6"} objc_getAssociatedObject :id [:id :pointer]) (def objc-keys-map (atom {})) (defn ^{:added "1.6"} objc-tag [tag] (if-let [t (tag @objc-keys-map)] t (let [t ($ (str "__" (name tag) "__") :UTF8String)] (swap! objc-keys-map assoc tag t) t))) (defn ^{:added "1.6"} objc-set! "Retains and sets a value into an object." [self tag value] (objc_setAssociatedObject self (objc-tag tag) value 1)) ; retain assign (defn ^{:added "1.6"} objc-get "Gets a value for a tag set with objc-set!." [self tag] (objc_getAssociatedObject self (objc-tag tag))) (defmacro ^{:added "1.6"} defnstype "nstype creates a new objc class. Takes a name, a superclass and a list of methods. The signature on the methods is optional when the method exists on the superclass, otherwise is mandatory. For the list of all available types see: clojure.core/objc-types (nstype MyTextField UITextField ([self :initWithFrame frame] ; Here the signature is not needed (doto ($$ self :initWithFrame frame) ($ :setDelegate self))) ([^:bool self :textFieldShouldReturn ^:id field] ($ self :resignFirstResponder) true)) " [na super & methods] (let [methods (binding [dispatch-class (name na)] (mapv walk/macroexpand-all methods)) na (name na) super (name super) fnsi (map (fn [[args & body]] (let [objc-meta-type (comp objc-types ffirst meta) self-sym (first args) args (next args) sel (take-nth 2 args) fields-vec (take-nth 2 (next args)) fields (take (count fields-vec) (repeatedly gensym)) fields-let (interleave fields-vec fields) types (map objc-meta-type (cons self-sym fields-vec)) types (if (nil? (first types)) nil (vec types)) sel (if (pos? (count fields)) (reduce str (map #(str (name %) ":") sel)) (reduce str (map name sel))) fnname (symbol (str na ":" sel))] [`(defn ~fnname [~self-sym ~@fields] (let [~@fields-let] ~@body)) `[~sel [~types ~fnname]]])) methods) fns (map first fnsi) i (into {} (map second fnsi))] `(do ~@fns ($ ($ NSTypeImpl) :makeClassWithName ~na :superclass ~super :map ~i)))) (defn ^{:added "1.6"} remote-repl "Starts a remote repl" [] (clojure.lang.RemoteRepl/listen)) ================================================ FILE: src/clj/clojure/core_print.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (import '(java.io Writer)) (set! *warn-on-reflection* true) (def ^:dynamic ^{:doc "*print-length* controls how many items of each collection the printer will print. If it is bound to logical false, there is no limit. Otherwise, it must be bound to an integer indicating the maximum number of items of each collection to print. If a collection contains more items, the printer will print items up to the limit followed by '...' to represent the remaining items. The root binding is nil indicating no limit." :added "1.0"} *print-length* nil) (def ^:dynamic ^{:doc "*print-level* controls how many levels deep the printer will print nested objects. If it is bound to logical false, there is no limit. Otherwise, it must be bound to an integer indicating the maximum level to print. Each argument to print is at level 0; if an argument is a collection, its items are at level 1; and so on. If an object is a collection and is at a level greater than or equal to the value bound to *print-level*, the printer prints '#' to represent it. The root binding is nil indicating no limit." :added "1.0"} *print-level* nil) (def ^:dynamic *verbose-defrecords* false) (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w] (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))] (if (and *print-level* (neg? *print-level*)) (.write w "#") (do (.write w begin) (when-let [xs (seq sequence)] (if (and (not *print-dup*) *print-length*) (loop [[x & xs] xs print-length *print-length*] (if (zero? print-length) (.write w "...") (do (print-one x w) (when xs (.write w sep) (recur xs (dec print-length)))))) (loop [[x & xs] xs] (print-one x w) (when xs (.write w sep) (recur xs))))) (.write w end))))) (defn- print-meta [o, ^Writer w] (when-let [m (meta o)] (when (and (pos? (count m)) (or *print-dup* (and *print-meta* *print-readably*))) (.write w "^") (if (and (= (count m) 1) (:tag m)) (pr-on (:tag m) w) (pr-on m w)) (.write w " ")))) (defn print-simple [o, ^Writer w] (print-meta o w) (.write w (str o))) (defmethod print-method :default [o, ^Writer w] (if (instance? clojure.lang.IObj o) (print-method (vary-meta o #(dissoc % :type)) w) (print-simple o w))) (defmethod print-method nil [o, ^Writer w] (.write w "nil")) (defmethod print-dup nil [o w] (print-method o w)) (defn print-ctor [o print-args ^Writer w] (.write w "#=(") (.write w (.getName ^Class (class o))) (.write w ". ") (print-args o w) (.write w ")")) (defn- print-tagged-object [o rep ^Writer w] (when (instance? clojure.lang.IMeta o) (print-meta o w)) (if clojure.lang.RemoteRepl/connected (.write w (str "#remote-ref \"" (clojure.lang.RemoteRef/register o) "\"")) (do (.write w "#object[") (let [c (class o)] (if (.isArray c) (print-method (.getName c) w) (.write w (.getName c)))) (.write w " ") (.write w (format "0x%x " (System/identityHashCode o))) (print-method rep w) (.write w "]")))) (defn- print-object [o, ^Writer w] (if clojure.lang.RemoteRepl/connected (.write w (str "#remote-ref \"" (clojure.lang.RemoteRef/register o) "\"")) (print-tagged-object o (str o) w))) (defmethod print-method Object [o, ^Writer w] (print-object o w)) (defmethod print-method clojure.lang.Keyword [o, ^Writer w] (.write w (str o))) (defmethod print-dup clojure.lang.Keyword [o w] (print-method o w)) (defmethod print-method clojure.lang.Selector [^clojure.lang.Selector o, ^Writer w] (.write w (str "#sel \"" (. o sel) "\""))) (defmethod print-dup clojure.lang.Selector [o w] (print-method o w)) (defmethod print-method Number [o, ^Writer w] (.write w (str o))) (defmethod print-dup Number [o, ^Writer w] (print-ctor o (fn [o w] (print-dup (str o) w)) w)) (defmethod print-dup clojure.lang.Fn [o, ^Writer w] (print-ctor o (fn [o w]) w)) (prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn) (prefer-method print-dup java.util.Map clojure.lang.Fn) (prefer-method print-dup java.util.Collection clojure.lang.Fn) (defmethod print-method Boolean [o, ^Writer w] (.write w (str o))) (defmethod print-dup Boolean [o w] (print-method o w)) (defmethod print-method clojure.lang.Symbol [o, ^Writer w] (print-simple o w)) (defmethod print-dup clojure.lang.Symbol [o w] (print-method o w)) (defmethod print-method clojure.lang.Var [o, ^Writer w] (print-simple o w)) (defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w] (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")"))) (defmethod print-method clojure.lang.ISeq [o, ^Writer w] (print-meta o w) (print-sequential "(" pr-on " " ")" o w)) (defmethod print-dup clojure.lang.ISeq [o w] (print-method o w)) (defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w)) (prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection) (prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection) (prefer-method print-method clojure.lang.ISeq java.util.Collection) (prefer-method print-dup clojure.lang.ISeq java.util.Collection) (defmethod print-dup java.util.Collection [o, ^Writer w] (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w)) (defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w] (print-meta o w) (.write w "#=(") (.write w (.getName ^Class (class o))) (.write w "/create ") (print-sequential "[" print-dup " " "]" o w) (.write w ")")) (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection) (def ^{:tag String :doc "Returns escape string for char or nil if none" :added "1.0"} char-escape-string {\newline "\\n" \tab "\\t" \return "\\r" \" "\\\"" \\ "\\\\" \formfeed "\\f" \backspace "\\b"}) (defmethod print-method String [^String s, ^Writer w] (if (or *print-dup* *print-readably*) (do (.append w \") (dotimes [n (count s)] (let [c (.charAt s n) e (char-escape-string c)] (if e (.write w e) (.append w c)))) (.append w \")) (.write w s)) nil) (defmethod print-dup String [s w] (print-method s w)) (defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w] (print-meta v w) (print-sequential "[" pr-on " " "]" v w)) (defn- print-map [m print-one w] (print-sequential "{" (fn [e ^Writer w] (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) ", " "}" (seq m) w)) (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) (print-map m pr-on w)) (defmethod print-dup java.util.Map [m, ^Writer w] (print-ctor m #(print-map (seq %1) print-dup %2) w)) (defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) (.write w "#=(") (.write w (.getName (class m))) (.write w "/create ") (print-map m print-dup w) (.write w ")")) ;; java.util (prefer-method print-method clojure.lang.IPersistentCollection java.util.Collection) (prefer-method print-method clojure.lang.IPersistentCollection java.util.RandomAccess) (prefer-method print-method java.util.RandomAccess java.util.List) (prefer-method print-method clojure.lang.IPersistentCollection java.util.Map) (defmethod print-method java.util.List [c, ^Writer w] (if *print-readably* (do (print-meta c w) (print-sequential "(" pr-on " " ")" c w)) (print-object c w))) (defmethod print-method java.util.RandomAccess [v, ^Writer w] (if *print-readably* (do (print-meta v w) (print-sequential "[" pr-on " " "]" v w)) (print-object v w))) (defmethod print-method java.util.Map [m, ^Writer w] (if *print-readably* (do (print-meta m w) (print-map m pr-on w)) (print-object m w))) (defmethod print-method java.util.Set [s, ^Writer w] (if *print-readably* (do (print-meta s w) (print-sequential "#{" pr-on " " "}" (seq s) w)) (print-object s w))) ;; Records (defmethod print-method clojure.lang.IRecord [r, ^Writer w] (print-meta r w) (.write w "#") (.write w (.getName (class r))) (print-map r pr-on w)) (defmethod print-dup clojure.lang.IRecord [r, ^Writer w] (print-meta r w) (.write w "#") (.write w (.getName (class r))) (if *verbose-defrecords* (print-map r print-dup w) (print-sequential "[" pr-on ", " "]" (vals r) w))) (prefer-method print-method clojure.lang.IRecord java.util.Map) (prefer-method print-method clojure.lang.IRecord clojure.lang.IPersistentMap) (prefer-method print-dup clojure.lang.IRecord clojure.lang.IPersistentMap) (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map) (prefer-method print-dup clojure.lang.IRecord clojure.lang.IPersistentCollection) (prefer-method print-dup clojure.lang.IRecord java.util.Map) (defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w] (print-meta s w) (print-sequential "#{" pr-on " " "}" (seq s) w)) (def ^{:tag String :doc "Returns name string for char or nil if none" :added "1.0"} char-name-string {\newline "newline" \tab "tab" \space "space" \backspace "backspace" \formfeed "formfeed" \return "return"}) (defmethod print-method java.lang.Character [^Character c, ^Writer w] (if (or *print-dup* *print-readably*) (do (.append w \\) (let [n (char-name-string c)] (if n (.write w n) (.append w c)))) (.append w c)) nil) (defmethod print-dup java.lang.Character [c w] (print-method c w)) (defmethod print-dup java.lang.Long [o w] (print-method o w)) (defmethod print-dup java.lang.Double [o w] (print-method o w)) (defmethod print-dup clojure.lang.Ratio [o w] (print-method o w)) (defmethod print-dup java.math.BigDecimal [o w] (print-method o w)) (defmethod print-dup clojure.lang.BigInt [o w] (print-method o w)) (defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w)) (defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w)) (defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w)) (defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w)) (def primitives-classnames {Float/TYPE "Float/TYPE" Integer/TYPE "Integer/TYPE" Long/TYPE "Long/TYPE" Boolean/TYPE "Boolean/TYPE" Character/TYPE "Character/TYPE" Double/TYPE "Double/TYPE" Byte/TYPE "Byte/TYPE" Short/TYPE "Short/TYPE"}) (defmethod print-method Class [^Class c, ^Writer w] (.write w (.getName c))) (defmethod print-dup Class [^Class c, ^Writer w] (cond (.isPrimitive c) (do (.write w "#=(identity ") (.write w ^String (primitives-classnames c)) (.write w ")")) (.isArray c) (do (.write w "#=(java.lang.Class/forName \"") (.write w (.getName c)) (.write w "\")")) :else (do (.write w "#=") (.write w (.getName c))))) (defmethod print-method java.math.BigDecimal [b, ^Writer w] (.write w (str b)) (.write w "M")) (defmethod print-method clojure.lang.BigInt [b, ^Writer w] (.write w (str b)) (.write w "N")) (defmethod print-method java.util.regex.Pattern [p ^Writer w] (.write w "#\"") (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p)) qmode false] (when s (cond (= c \\) (let [[^Character c2 & r2] r] (.append w \\) (.append w c2) (if qmode (recur r2 (not= c2 \E)) (recur r2 (= c2 \Q)))) (= c \") (do (if qmode (.write w "\\E\\\"\\Q") (.write w "\\\"")) (recur r qmode)) :else (do (.append w c) (recur r qmode))))) (.append w \")) (defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w)) (defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w] (.write w "#=(find-ns ") (print-dup (.name n) w) (.write w ")")) (defn- deref-as-map [^clojure.lang.IDeref o] (let [pending (and (instance? clojure.lang.IPending o) (not (.isRealized ^clojure.lang.IPending o))) [ex val] (when-not pending (try [false (deref o)] (catch Throwable e [true e])))] {:status (cond (or ex (and (instance? clojure.lang.Agent o) (agent-error o))) :failed pending :pending :else :ready) :val val})) (defmethod print-method clojure.lang.IDeref [o ^Writer w] (print-tagged-object o (deref-as-map o) w)) (defmethod print-method StackTraceElement [^StackTraceElement o ^Writer w] (print-method [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)] w)) (defn Throwable->map "Constructs a data representation for a Throwable." {:added "1.7"} [^Throwable o] (let [base (fn [^Throwable t] (let [m {:type (class t) :message (.getLocalizedMessage t) :at (get (.getStackTrace t) 0)} data (ex-data t)] (if data (assoc m :data data) m))) via (loop [via [], ^Throwable t o] (if t (recur (conj via t) (.getCause t)) via)) ^Throwable root (peek via) m {:cause (.getLocalizedMessage root) :via (vec (map base via)) :trace (vec (.getStackTrace ^Throwable (or root o)))} data (ex-data root)] (if data (assoc m :data data) m))) (defn- print-throwable [^Throwable o ^Writer w] (.write w "#error {\n :cause ") (let [{:keys [cause data via trace]} (Throwable->map o) print-via #(do (.write w "{:type ") (print-method (:type %) w) (.write w "\n :message ") (print-method (:message %) w) (when-let [data (:data %)] (.write w "\n :data ") (print-method data w)) (.write w "\n :at ") (print-method (:at %) w) (.write w "}"))] (print-method cause w) (when data (.write w "\n :data ") (print-method data w)) (when via (.write w "\n :via\n [") (when-let [fv (first via)] (print-via fv) (doseq [v (rest via)] (.write w "\n ") (print-via v))) (.write w "]")) (when trace (.write w "\n :trace\n [") (when-let [ft (first trace)] (print-method ft w) (doseq [t (rest trace)] (.write w "\n ") (print-method t w))) (.write w "]"))) (.write w "}")) (defmethod print-method Throwable [^Throwable o ^Writer w] (print-throwable o w)) (defmethod print-method clojure.lang.TaggedLiteral [o ^Writer w] (.write w "#") (print-method (:tag o) w) (.write w " ") (print-method (:form o) w)) (defmethod print-method clojure.lang.ReaderConditional [o ^Writer w] (.write w "#?") (when (:splicing? o) (.write w "@")) (print-method (:form o) w)) (def ^{:private true} print-initialized true) ================================================ FILE: src/clj/clojure/core_proxy.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (import '(clojure.asm ClassWriter ClassVisitor Opcodes Type) '(java.lang.reflect Modifier Constructor) '(clojure.asm.commons Method GeneratorAdapter) '(clojure.lang Var IProxy Reflector DynamicClassLoader Compiler IPersistentMap PersistentHashMap RT)) (defn method-sig [^java.lang.reflect.Method meth] [(. meth (getName)) (seq (. meth (getParameterTypes))) (. meth getReturnType)]) (defn- most-specific [rtypes] (or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes) (throw (Exception. "Incompatible return types")))) (defn- group-by-sig "takes a collection of [msig meth] and returns a seq of maps from return-types to meths." [coll] (vals (reduce1 (fn [m [msig meth]] (let [rtype (peek msig) argsig (pop msig)] (assoc m argsig (assoc (m argsig {}) rtype meth)))) {} coll))) (defn proxy-name {:tag String} [^Class super interfaces] (let [inames (into1 (sorted-set) (map #(.getName ^Class %) interfaces))] (apply str (.replace (str *ns*) \- \_) ".proxy" (interleave (repeat "$") (concat [(.getName super)] (map #(subs % (inc (.lastIndexOf ^String % "."))) inames) [(Integer/toHexString (hash inames))]))))) (defn- generate-proxy [^Class super interfaces] (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))] (binding [*source-writer* (.getSc cv)] (let [sname (proxy-name super interfaces) cname (.replace sname \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) ctype (. Type (getObjectType cname)) lastdot (.lastIndexOf sname ".") classname (subs sname (inc lastdot)) packagename (subs sname 0 lastdot) iname (fn [^Class c] (.. Type (getType c) (getInternalName))) fmap "__clojureFnMap" totype (fn [^Class c] (. Type (getType c))) to-types (fn [cs] (if (pos? (count cs)) (into-array (map totype cs)) (make-array Type 0))) super-type ^Type (totype super) imap-type ^Type (totype IPersistentMap) ifn-type (totype clojure.lang.IFn) obj-type (totype Object) sym-type (totype clojure.lang.Symbol) rt-type (totype clojure.lang.RT) ex-type (totype java.lang.UnsupportedOperationException) gen-bridge (fn [^java.lang.reflect.Method meth ^java.lang.reflect.Method dest] (let [pclasses (. meth (getParameterTypes)) ptypes (to-types pclasses) rclass (. meth (getReturnType)) rtype ^Type (totype rclass) mname (. meth (getName)) m (new Method mname rtype ptypes) dtype (totype (.getDeclaringClass dest)) dm (new Method (. dest (getName)) (totype (. dest (getReturnType))) (to-types (. dest (getParameterTypes)))) gen (new GeneratorAdapter (bit-or (. Opcodes ACC_PUBLIC) (. Opcodes ACC_BRIDGE)) m nil nil cv)] (comment (Compiler/emitSource (str "public " (.getCanonicalName rclass) " " mname "(" (apply str (interpose ", " (map #(str (.getCanonicalName (nth pclasses %)) " p" %) (range (count pclasses))))) ") {")) (Compiler/tab)) (. gen (visitCode)) (. gen (loadThis)) (dotimes [i (count ptypes)] (. gen (loadArg i))) (if (-> dest .getDeclaringClass .isInterface) (. gen (invokeInterface dtype dm)) (. gen (invokeVirtual dtype dm))) (comment (Compiler/emitSource (str (if (= (.getCanonicalName rclass) "void") "" "return ") "super." mname "(" (apply str (interpose ", " (map #(str "p" %) (range (count pclasses))))) ");")) (Compiler/untab) (Compiler/emitSource "}")) (. gen (returnValue)) (. gen (endMethod)))) gen-method (fn [^java.lang.reflect.Method meth else-gen] (let [pclasses (. meth (getParameterTypes)) abstract? (Modifier/isAbstract (.getModifiers meth)) ptypes (to-types pclasses) rclass (. meth (getReturnType)) extypes (. meth (getExceptionTypes)) exdecl (reduce1 str (interpose ", " (map #(.getCanonicalName %) extypes))) rcanonical (.getCanonicalName rclass) rtype ^Type (totype rclass) mname (. meth (getName)) m (new Method mname rtype ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) else-label (. gen (newLabel)) end-label (. gen (newLabel)) decl-type (. Type (getType (. meth (getDeclaringClass))))] (. gen (visitCode)) (Compiler/emitSource (str "public " (.getCanonicalName rclass) " " mname "(" (apply str (interpose ", " (map #(str (.getCanonicalName (nth pclasses %)) " p" %) (range (count pclasses))))) ")" (if (empty? exdecl) "" (str " throws " exdecl " ")) " {")) (Compiler/tab) (if (> (count pclasses) 18) (else-gen gen m) (do (. gen (loadThis)) (. gen (getField ctype fmap imap-type)) (. gen (push mname)) ;lookup fn in map (Compiler/emitSource (str "final Object value = RT.get(this.__clojureFnMap, \"" mname "\");")) (. gen (invokeStatic rt-type (. Method (getMethod "Object get(Object, Object)")))) (. gen (dup)) (. gen (ifNull else-label)) ;if found (.checkCast gen ifn-type) (. gen (loadThis)) ;box args (dotimes [i (count ptypes)] (. gen (loadArg i)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i) ""))) ;call fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (into-array (cons obj-type (replicate (count ptypes) obj-type)))))) ;unbox return ;return (value != null) ? ((IMapEntry)((IFn)value).invoke(this, o)) : super.entryAt(o); (let [param-list (apply str (interpose ", " (map #(str "p" %) (range (count pclasses)))))] (if (= rcanonical "void") (Compiler/emitSource (str "if (value != null) {" "((IFn)value).invoke(this" (if (empty? param-list) "" ", ") param-list "); } " (if abstract? "" (str "else { super." mname "(" param-list "); }")))) (Compiler/emitSource (str "return (value != null) ? " "(" rcanonical ")" (. gen (unbox rtype (str "((IFn)value).invoke(this" (if (empty? param-list) "" ", ") param-list ")"))) " : " (if abstract? "null;" (str "super." mname "(" param-list ");")))))) (. gen (unbox rtype)) (when (= (. rtype (getSort)) (. Type VOID)) (. gen (pop))) (. gen (goTo end-label)) ;else call supplied alternative generator (Var/pushThreadBindings {Compiler/STOP_EMIT_SOURCE true}) (. gen (mark else-label)) (. gen (pop)) (else-gen gen m) (Var/popThreadBindings) (. gen (mark end-label)))) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod))))] (Compiler/emitSource (str "package " packagename ";")) (Compiler/emitSource) (Compiler/emitSource "import java.util.*;") (Compiler/emitSource "import clojure.lang.*;") (Compiler/emitSource) (Compiler/emitSource (str "public class " classname " extends " (.getCanonicalName super) " implements " (apply str (interpose ", " (cons "IProxy" (map #(.getCanonicalName %) interfaces)))) " {")) (Compiler/tab) (Compiler/emitSource) (Compiler/emitSource "private volatile IPersistentMap __clojureFnMap;") (Compiler/emitSource) ;start class definition (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) cname nil (iname super) (into-array (map iname (cons IProxy interfaces))))) ;add field for fn mappings (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_VOLATILE)) fmap (. imap-type (getDescriptor)) nil nil)) ;add ctors matching/calling super's (doseq [^Constructor ctor (. super (getDeclaredConstructors))] (when-not (. Modifier (isPrivate (. ctor (getModifiers)))) (let [pclasses (. ctor (getParameterTypes)) ptypes (to-types pclasses) m (new Method "" (. Type VOID_TYPE) ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (Compiler/emitSource (str "public " classname "(" (apply str (interpose ", " (map #(str (.getCanonicalName (nth pclasses %)) " p" %) (range (count pclasses))))) ") {")) (Compiler/tab) ;call super ctor (. gen (loadThis)) (. gen (dup)) (. gen (loadArgs)) (. gen (invokeConstructor super-type m)) (Compiler/emitSource (str "super(" (apply str (interpose ", " (map #(str "p" %) (range (count pclasses))))) ");")) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod))))) ;add IProxy methods (let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (. gen (loadArgs)) (. gen (putField ctype fmap imap-type)) (. gen (returnValue)) (. gen (endMethod))) (Compiler/emitSource (str "public void __initClojureFnMappings(final IPersistentMap _clojureFnMap) {")) (Compiler/tab) (Compiler/emitSource "this.__clojureFnMap = _clojureFnMap;") (Compiler/untab) (Compiler/emitSource (str "}")) (let [m (. Method (getMethod "void __updateClojureFnMappings(clojure.lang.IPersistentMap)")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (. gen (dup)) (. gen (getField ctype fmap imap-type)) (.checkCast gen (totype clojure.lang.IPersistentCollection)) (. gen (loadArgs)) (. gen (invokeInterface (totype clojure.lang.IPersistentCollection) (. Method (getMethod "clojure.lang.IPersistentCollection cons(Object)")))) (. gen (checkCast imap-type)) (. gen (putField ctype fmap imap-type)) (. gen (returnValue)) (. gen (endMethod))) (Compiler/emitSource (str "public void __updateClojureFnMappings(final IPersistentMap persistentMap) {")) (Compiler/tab) (Compiler/emitSource "this.__clojureFnMap = (IPersistentMap)((IPersistentCollection)this.__clojureFnMap).cons(persistentMap);") (Compiler/untab) (Compiler/emitSource (str "}")) (let [m (. Method (getMethod "clojure.lang.IPersistentMap __getClojureFnMappings()")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] (. gen (visitCode)) (. gen (loadThis)) (. gen (getField ctype fmap imap-type)) (. gen (returnValue)) (. gen (endMethod))) (Compiler/emitSource (str "public IPersistentMap __getClojureFnMappings() {")) (Compiler/tab) (Compiler/emitSource "return this.__clojureFnMap;") (Compiler/untab) (Compiler/emitSource (str "}")) ;calc set of supers' non-private instance methods (let [[mm considered] (loop [mm {} considered #{} c super] (if c (let [[mm considered] (loop [mm mm considered considered meths (concat (seq (. c (getDeclaredMethods))) (seq (. c (getMethods))))] (if (seq meths) (let [^java.lang.reflect.Method meth (first meths) mods (. meth (getModifiers)) mk (method-sig meth)] (if (or (considered mk) (not (or (Modifier/isPublic mods) (Modifier/isProtected mods))) ;(. Modifier (isPrivate mods)) (. Modifier (isStatic mods)) (. Modifier (isFinal mods)) (= "finalize" (.getName meth))) (recur mm (conj considered mk) (next meths)) (recur (assoc mm mk meth) (conj considered mk) (next meths)))) [mm considered]))] (recur mm considered (. c (getSuperclass)))) [mm considered])) ifaces-meths (into1 {} (for [^Class iface interfaces meth (. iface (getMethods)) :let [msig (method-sig meth)] :when (not (considered msig))] {msig meth})) mgroups (group-by-sig (concat mm ifaces-meths)) rtypes (map #(most-specific (keys %)) mgroups) mb (map #(vector (%1 %2) (vals (dissoc %1 %2))) mgroups rtypes) bridge? (reduce1 into1 #{} (map second mb)) ifaces-meths (remove bridge? (vals ifaces-meths)) mm (remove bridge? (vals mm))] ;add methods matching supers', if no mapping -> call super (doseq [[^java.lang.reflect.Method dest bridges] mb ^java.lang.reflect.Method meth bridges] (gen-bridge meth dest)) (doseq [^java.lang.reflect.Method meth mm] (gen-method meth (fn [^GeneratorAdapter gen ^Method m] (. gen (loadThis)) ;push args (. gen (loadArgs)) ;call super (Compiler/emitSource (str "return " "super." (. meth (getName)) "(" (apply str (interpose ", " (map #(str "p" %) (range (count (. meth (getParameterTypes))))))) ");")) (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) (. super-type (getInternalName)) (. m (getName)) (. m (getDescriptor))))))) ;add methods matching interfaces', if no mapping -> throw (doseq [^java.lang.reflect.Method meth ifaces-meths] (gen-method meth (fn [^GeneratorAdapter gen ^Method m] (. gen (throwException ex-type (. m (getName)))))))) ;finish class def (. cv (visitEnd)) (Compiler/untab) (Compiler/emitSource "}") (when *compile-files* (Compiler/writeSourceFile cname (str *source-writer*))) [cname (. cv toByteArray)])))) (defn- get-super-and-interfaces [bases] (if (. ^Class (first bases) (isInterface)) [Object bases] [(first bases) (next bases)])) (defn get-proxy-class "Takes an optional single class followed by zero or more interfaces. If not supplied class defaults to Object. Creates an returns an instance of a proxy class derived from the supplied classes. The resulting value is cached and used for any subsequent requests for the same class set. Returns a Class object." {:added "1.0"} [& bases] (let [[super interfaces] (get-super-and-interfaces bases) pname (proxy-name super interfaces)] (or (RT/loadClassForName pname) (let [[cname bytecode] (generate-proxy super interfaces)] (. ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (defineClass pname bytecode [super interfaces])))))) (defn construct-proxy "Takes a proxy class and any arguments for its superclass ctor and creates and returns an instance of the proxy." {:added "1.0"} [c & ctor-args] (. Reflector (invokeConstructor c (to-array ctor-args)))) (defn init-proxy "Takes a proxy instance and a map of strings (which must correspond to methods of the proxy superclass/superinterfaces) to fns (which must take arguments matching the corresponding method, plus an additional (explicit) first arg corresponding to this, and sets the proxy's fn map. Returns the proxy." {:added "1.0"} [^IProxy proxy mappings] (. proxy (__initClojureFnMappings mappings)) proxy) (defn update-proxy "Takes a proxy instance and a map of strings (which must correspond to methods of the proxy superclass/superinterfaces) to fns (which must take arguments matching the corresponding method, plus an additional (explicit) first arg corresponding to this, and updates (via assoc) the proxy's fn map. nil can be passed instead of a fn, in which case the corresponding method will revert to the default behavior. Note that this function can be used to update the behavior of an existing instance without changing its identity. Returns the proxy." {:added "1.0"} [^IProxy proxy mappings] (. proxy (__updateClojureFnMappings mappings)) proxy) (defn proxy-mappings "Takes a proxy instance and returns the proxy's fn map." {:added "1.0"} [^IProxy proxy] (. proxy (__getClojureFnMappings))) (defmacro proxy "class-and-interfaces - a vector of class names args - a (possibly empty) vector of arguments to the superclass constructor. f => (name [params*] body) or (name ([params*] body) ([params+] body) ...) Expands to code which creates a instance of a proxy class that implements the named class/interface(s) by calling the supplied fns. A single class, if provided, must be first. If not provided it defaults to Object. The interfaces names must be valid interface types. If a method fn is not provided for a class method, the superclass methd will be called. If a method fn is not provided for an interface method, an UnsupportedOperationException will be thrown should it be called. Method fns are closures and can capture the environment in which proxy is called. Each method fn takes an additional implicit first arg, which is bound to 'this. Note that while method fns can be provided to override protected methods, they have no other access to protected members, nor to super, as these capabilities cannot be proxied." {:added "1.0"} [class-and-interfaces args & fs] (let [bases (map #(or (resolve %) (throw (Exception. (str "Can't resolve: " %)))) class-and-interfaces) [super interfaces] (get-super-and-interfaces bases) compile-effect (when *compile-files* (let [[cname bytecode] (generate-proxy super interfaces)] (clojure.lang.Compiler/writeClassFile cname bytecode))) pc-effect (apply get-proxy-class bases) pname (proxy-name super interfaces)] ;remember the class to prevent it from disappearing before use (intern *ns* (symbol pname) pc-effect) `(let [;pc# (get-proxy-class ~@class-and-interfaces) p# (new ~(symbol pname) ~@args)] ;(construct-proxy pc# ~@args)] (init-proxy p# ~(loop [fmap {} fs fs] (if fs (let [[sym & meths] (first fs) meths (if (vector? (first meths)) (list meths) meths) meths (map (fn [[params & body]] (cons (apply vector 'this params) body)) meths)] (if-not (contains? fmap (name sym)) (recur (assoc fmap (name sym) (cons `fn meths)) (next fs)) (throw (IllegalArgumentException. (str "Method '" (name sym) "' redefined"))))) fmap))) p#))) (defn proxy-call-with-super [call this meth] (let [m (proxy-mappings this)] (update-proxy this (assoc m meth nil)) (try (call) (finally (update-proxy this m))))) (defmacro proxy-super "Use to call a superclass method in the body of a proxy method. Note, expansion captures 'this" {:added "1.0"} [meth & args] `(proxy-call-with-super (fn [] (. ~'this ~meth ~@args)) ~'this ~(name meth))) (comment (defn bean "Takes a Java object and returns a read-only implementation of the map abstraction based upon its JavaBean properties." {:added "1.0"} [^Object x] (let [c (. x (getClass)) pmap (reduce1 (fn [m ^java.beans.PropertyDescriptor pd] (let [name (. pd (getName)) method (. pd (getReadMethod))] (if (and method (zero? (alength (. method (getParameterTypes))))) (assoc m (keyword name) (fn [] (clojure.lang.Reflector/prepRet (.getPropertyType pd) (. method (invoke x nil))))) m))) {} (seq (.. java.beans.Introspector (getBeanInfo c) (getPropertyDescriptors)))) v (fn [k] ((pmap k))) snapshot (fn [] (reduce1 (fn [m e] (assoc m (key e) ((val e)))) {} (seq pmap)))] (proxy [clojure.lang.APersistentMap] [] (iterator [] (.iterator ^Iterable pmap)) (containsKey [k] (contains? pmap k)) (entryAt [k] (when (contains? pmap k) (new clojure.lang.MapEntry k (v k)))) (valAt ([k] (when (contains? pmap k) (v k))) ([k default] (if (contains? pmap k) (v k) default))) (cons [m] (conj (snapshot) m)) (count [] (count pmap)) (assoc [k v] (assoc (snapshot) k v)) (without [k] (dissoc (snapshot) k)) (seq [] ((fn thisfn [plseq] (lazy-seq (when-let [pseq (seq plseq)] (cons (new clojure.lang.MapEntry (first pseq) (v (first pseq))) (thisfn (rest pseq)))))) (keys pmap))))))) ================================================ FILE: src/clj/clojure/data.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Stuart Halloway", :doc "Non-core data functions."} clojure.data (:require [clojure.set :as set])) (declare diff) (defn- atom-diff "Internal helper for diff." [a b] (if (= a b) [nil nil a] [a b nil])) ;; for big things a sparse vector class would be better (defn- vectorize "Convert an associative-by-numeric-index collection into an equivalent vector, with nil for any missing keys" [m] (when (seq m) (reduce (fn [result [k v]] (assoc result k v)) (vec (repeat (apply max (keys m)) nil)) m))) (defn- diff-associative-key "Diff associative things a and b, comparing only the key k." [a b k] (let [va (get a k) vb (get b k) [a* b* ab] (diff va vb) in-a (contains? a k) in-b (contains? b k) same (and in-a in-b (or (not (nil? ab)) (and (nil? va) (nil? vb))))] [(when (and in-a (or (not (nil? a*)) (not same))) {k a*}) (when (and in-b (or (not (nil? b*)) (not same))) {k b*}) (when same {k ab}) ])) (defn- diff-associative "Diff associative things a and b, comparing only keys in ks." [a b ks] (reduce (fn [diff1 diff2] (doall (map merge diff1 diff2))) [nil nil nil] (map (partial diff-associative-key a b) ks))) (defn- diff-sequential [a b] (vec (map vectorize (diff-associative (if (vector? a) a (vec a)) (if (vector? b) b (vec b)) (range (max (count a) (count b))))))) (defprotocol ^{:added "1.3"} EqualityPartition "Implementation detail. Subject to change." (^{:added "1.3"} equality-partition [x] "Implementation detail. Subject to change.")) (defprotocol ^{:added "1.3"} Diff "Implementation detail. Subject to change." (^{:added "1.3"} diff-similar [a b] "Implementation detail. Subject to change.")) (extend nil Diff {:diff-similar atom-diff}) (extend Object Diff {:diff-similar (fn [a b] ((if (.. a getClass isArray) diff-sequential atom-diff) a b))} EqualityPartition {:equality-partition (fn [x] (if (.. x getClass isArray) :sequential :atom))}) (extend-protocol EqualityPartition nil (equality-partition [x] :atom) java.util.Set (equality-partition [x] :set) java.util.List (equality-partition [x] :sequential) java.util.Map (equality-partition [x] :map)) (defn- as-set-value [s] (if (set? s) s (into #{} s))) (extend-protocol Diff java.util.Set (diff-similar [a b] (let [aval (as-set-value a) bval (as-set-value b)] [(not-empty (set/difference aval bval)) (not-empty (set/difference bval aval)) (not-empty (set/intersection aval bval))])) java.util.List (diff-similar [a b] (diff-sequential a b)) java.util.Map (diff-similar [a b] (diff-associative a b (set/union (keys a) (keys b))))) (defn diff "Recursively compares a and b, returning a tuple of [things-only-in-a things-only-in-b things-in-both]. Comparison rules: * For equal a and b, return [nil nil a]. * Maps are subdiffed where keys match and values differ. * Sets are never subdiffed. * All sequential things are treated as associative collections by their indexes, with results returned as vectors. * Everything else (including strings!) is treated as an atom and compared for equality." {:added "1.3"} [a b] (if (= a b) [nil nil a] (if (= (equality-partition a) (equality-partition b)) (diff-similar a b) (atom-diff a b)))) ================================================ FILE: src/clj/clojure/edn.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "edn reading." :author "Rich Hickey"} clojure.edn (:refer-clojure :exclude [read read-string])) (defn read "Reads the next object from stream, which must be an instance of java.io.PushbackReader or some derivee. stream defaults to the current value of *in*. Reads data in the edn format (subset of Clojure data): http://edn-format.org opts is a map that can include the following keys: :eof - value to return on end-of-file. When not supplied, eof throws an exception. :readers - a map of tag symbols to data-reader functions to be considered before default-data-readers. When not supplied, only the default-data-readers will be used. :default - A function of two args, that will, if present and no reader is found for a tag, be called with the tag and the value." {:added "1.5"} ([] (read *in*)) ([stream] (read {} stream)) ([opts stream] (clojure.lang.EdnReader/read stream opts))) (defn read-string "Reads one object from the string s. Returns nil when s is nil or empty. Reads data in the edn format (subset of Clojure data): http://edn-format.org opts is a map as per clojure.edn/read" {:added "1.5"} ([s] (read-string {:eof nil} s)) ([opts s] (when s (clojure.lang.EdnReader/readString s opts)))) ================================================ FILE: src/clj/clojure/genclass.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.core) (import '(java.lang.reflect Modifier Constructor) '(clojure.asm ClassWriter ClassVisitor Opcodes Type) '(clojure.asm.commons Method GeneratorAdapter) '(clojure.lang IPersistentMap Compiler Compiler$HostExpr)) ;(defn method-sig [^java.lang.reflect.Method meth] ; [(. meth (getName)) (seq (. meth (getParameterTypes)))]) (defn- filter-methods [^Class c invalid-method?] (loop [mm {} considered #{} c c] (if c (let [[mm considered] (loop [mm mm considered considered meths (seq (concat (seq (. c (getDeclaredMethods))) (seq (. c (getMethods)))))] (if meths (let [^java.lang.reflect.Method meth (first meths) mods (. meth (getModifiers)) mk (method-sig meth)] (if (or (considered mk) (invalid-method? meth)) (recur mm (conj considered mk) (next meths)) (recur (assoc mm mk meth) (conj considered mk) (next meths)))) [mm considered]))] (recur mm considered (. c (getSuperclass)))) mm))) (defn- non-private-methods [^Class c] (let [not-overridable? (fn [^java.lang.reflect.Method meth] (let [mods (. meth (getModifiers))] (or (not (or (Modifier/isPublic mods) (Modifier/isProtected mods))) (. Modifier (isStatic mods)) (. Modifier (isFinal mods)) (= "finalize" (.getName meth)))))] (filter-methods c not-overridable?))) (defn- protected-final-methods [^Class c] (let [not-exposable? (fn [^java.lang.reflect.Method meth] (let [mods (. meth (getModifiers))] (not (and (Modifier/isProtected mods) (Modifier/isFinal mods) (not (Modifier/isStatic mods))))))] (filter-methods c not-exposable?))) (defn- ctor-sigs [^Class super] (for [^Constructor ctor (. super (getDeclaredConstructors)) :when (not (. Modifier (isPrivate (. ctor (getModifiers)))))] (apply vector (. ctor (getParameterTypes))))) (defn- escape-class-name [^Class c] (.. (.getSimpleName c) (replace "[]" "<>"))) (defn- overload-name [mname pclasses] (if (seq pclasses) (apply str mname (interleave (repeat \-) (map escape-class-name pclasses))) (str mname "-void"))) (defn- ^java.lang.reflect.Field find-field [^Class c f] (let [start-class c] (loop [c c] (if (= c Object) (throw (new Exception (str "field, " f ", not defined in class, " start-class ", or its ancestors"))) (let [dflds (.getDeclaredFields c) rfld (first (filter #(= f (.getName ^java.lang.reflect.Field %)) dflds))] (or rfld (recur (.getSuperclass c)))))))) ;(distinct (map first(keys (mapcat non-private-methods [Object IPersistentMap])))) (def ^{:private true} prim->class {'int Integer/TYPE 'ints (Class/forName "[I") 'long Long/TYPE 'longs (Class/forName "[J") 'float Float/TYPE 'floats (Class/forName "[F") 'double Double/TYPE 'doubles (Class/forName "[D") 'void Void/TYPE 'short Short/TYPE 'shorts (Class/forName "[S") 'boolean Boolean/TYPE 'booleans (Class/forName "[Z") 'byte Byte/TYPE 'bytes (Class/forName "[B") 'char Character/TYPE 'chars (Class/forName "[C")}) (defn- ^Class the-class [x] (cond (class? x) x (contains? prim->class x) (prim->class x) :else (let [strx (str x)] (clojure.lang.RT/classForName (if (some #{\. \[} strx) strx (str "java.lang." strx)))))) ;; someday this can be made codepoint aware (defn- valid-java-method-name [^String s] (= s (clojure.lang.Compiler/munge s))) (defn- validate-generate-class-options [{:keys [methods]}] (let [[mname] (remove valid-java-method-name (map (comp str first) methods))] (when mname (throw (IllegalArgumentException. (str "Not a valid method name: " mname)))))) (defn- generate-class [options-map] (validate-generate-class-options options-map) (let [default-options {:prefix "-" :load-impl-ns true :impl-ns (ns-name *ns*)} {:keys [name extends implements constructors methods main factory state init exposes exposes-methods prefix load-impl-ns impl-ns post-init]} (merge default-options options-map) name-meta (meta name) name (str name) package-name (subs name 0 (.lastIndexOf name ".")) class-name (subs name (inc (.lastIndexOf name "."))) super (if extends (the-class extends) Object) interfaces (map the-class implements) supers (cons super interfaces) ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super))) cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) cname (. name (replace "." "/")) pkg-name name impl-pkg-name (str impl-ns) impl-cname (.. impl-pkg-name (replace "." "/") (replace \- \_)) ctype (. Type (getObjectType cname)) iname (fn [^Class c] (.. Type (getType c) (getInternalName))) totype (fn [^Class c] (. Type (getType c))) to-types (fn [cs] (if (pos? (count cs)) (into-array (map totype cs)) (make-array Type 0))) obj-type ^Type (totype Object) arg-types (fn [n] (if (pos? n) (into-array (replicate n obj-type)) (make-array Type 0))) super-type ^Type (totype super) init-name (str init) post-init-name (str post-init) factory-name (str factory) state-name (str state) main-name "main" var-name (fn [s] (clojure.lang.Compiler/munge (str s "__var"))) class-type (totype Class) rt-type (totype clojure.lang.RT) var-type ^Type (totype clojure.lang.Var) ifn-type (totype clojure.lang.IFn) iseq-type (totype clojure.lang.ISeq) ex-type (totype java.lang.UnsupportedOperationException) all-sigs (distinct (concat (map #(let[[m p] (key %)] {m [p]}) (mapcat non-private-methods supers)) (map (fn [[m p]] {(str m) [p]}) methods))) sigs-by-name (apply merge-with concat {} all-sigs) overloads (into1 {} (filter (fn [[m s]] (next s)) sigs-by-name)) var-fields (concat (when init [init-name]) (when post-init [post-init-name]) (when main [main-name]) ;(when exposes-methods (map str (vals exposes-methods))) (distinct (concat (keys sigs-by-name) (mapcat (fn [[m s]] (map #(overload-name m (map the-class %)) s)) overloads) (mapcat (comp (partial map str) vals val) exposes)))) emit-get-var (fn [^GeneratorAdapter gen v] (let [false-label (. gen newLabel) end-label (. gen newLabel)] (. gen getStatic ctype (var-name v) var-type) (. gen dup) (. gen invokeVirtual var-type (. Method (getMethod "boolean isBound()"))) (. gen ifZCmp (. GeneratorAdapter EQ) false-label) (. gen invokeVirtual var-type (. Method (getMethod "Object get()"))) (. gen goTo end-label) (. gen mark false-label) (. gen pop) (. gen visitInsn (. Opcodes ACONST_NULL)) (. gen mark end-label) (Compiler/emitSource "value = null;") (Compiler/emitSource (str "if (" (var-name v) ".isBound()) {")) (Compiler/tab) (Compiler/emitSource (str "value = " (var-name v) ".get();")) (Compiler/untab) (Compiler/emitSource "}"))) emit-unsupported (fn [^GeneratorAdapter gen ^Method m] (let [msg (str (. m (getName)) " (" impl-pkg-name "/" prefix (.getName m) " not defined?)")] (Compiler/emitSource (str "throw new " (Compiler/printClass ex-type) "(\"" msg "\");")) (. gen (throwException ex-type msg)))) emit-forwarding-method (fn [name pclasses rclass exclasses as-static else-gen] (let [mname (str name) pmetas (map meta pclasses) pclasses (map the-class pclasses) rclass (the-class rclass) ptypes (to-types pclasses) rtype ^Type (totype rclass) m (new Method mname rtype ptypes) is-overload (seq (overloads mname)) gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (if as-static (. Opcodes ACC_STATIC) 0)) m nil nil cv) found-label (. gen (newLabel)) else-label (. gen (newLabel)) end-label (. gen (newLabel)) rvoid (= (. rtype (getSort)) (. Type VOID))] (add-annotations gen (meta name)) (dotimes [i (count pmetas)] (add-annotations gen (nth pmetas i) i)) (Compiler/emitSource (str "public " (if as-static "static " "") (Compiler/printClass rclass) " " mname "(" (reduce1 str (interpose ", " (map #(str (Compiler/printClass (nth pclasses %)) " p" %) (range (count pclasses))))) ")" (if (empty? exclasses) "" (str " throws " (reduce1 str (interpose ", " (map #(Compiler/printClass %) exclasses))))) " {")) (Compiler/tab) (. gen (visitCode)) (Compiler/emitSource "Object value = null;") (if (> (count pclasses) 18) (else-gen gen m) (do (when is-overload ; TODO ? (emit-get-var gen (overload-name mname pclasses)) (. gen (dup)) (. gen (ifNonNull found-label)) (. gen (pop))) (emit-get-var gen mname) (. gen (dup)) (Compiler/emitSource (str "if (value != null) {")) (Compiler/tab) (. gen (ifNull else-label)) (when is-overload (. gen (mark found-label))) ;if found (.checkCast gen ifn-type) (when-not as-static (. gen (loadThis))) ;box args (Compiler/emitSource (str (if rvoid "" "return ") (Compiler/unboxVal rclass (str "((IFn)value).invoke(" (reduce1 str (interpose ", " (map #(do (. gen (loadArg %)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses %) (str "p" %)))) (range (count ptypes))))) ")")) ";")) ;call fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (to-types (replicate (+ (count ptypes) (if as-static 0 1)) Object))))) ;(into-array (cons obj-type ; (replicate (count ptypes) obj-type)))))) ;unbox return (. gen (unbox rtype)) (when rvoid (. gen (pop))) (. gen (goTo end-label)) ;else call supplied alternative generator (. gen (mark else-label)) (. gen (pop)) (Compiler/untab) (Compiler/emitSource "} else {") (Compiler/tab) (else-gen gen m) (Compiler/untab) (Compiler/emitSource "}") (. gen (mark end-label)))) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod)))) ] (binding [*source-writer* (.getSc cv)] (Compiler/emitSource (str "package " package-name ";")) (Compiler/emitSource) (Compiler/emitSource (str "import clojure.lang.*;")) (Compiler/emitSource) ;start class definition (. cv (visit (. Opcodes V1_5) (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_SUPER)) cname nil (iname super) (when-let [ifc (seq interfaces)] (into-array (map iname ifc))))) ; class annotations (add-annotations cv name-meta) (Compiler/emitSource (str "public class " class-name " extends " (Compiler/printClass super) (if (empty? interfaces) "" (str " implements " (apply str (interpose ", " (map #(Compiler/printClass %) interfaces))))) " {")) (Compiler/tab) ;static fields for vars (doseq [v var-fields] (. cv (visitField (+ (. Opcodes ACC_PRIVATE) (. Opcodes ACC_FINAL) (. Opcodes ACC_STATIC)) (var-name v) (. var-type getDescriptor) nil nil)) (Compiler/emitSource (str "private final static Var " (var-name v) ";"))) ;instance field for state (when state (. cv (visitField (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL)) state-name (. obj-type getDescriptor) nil nil)) (Compiler/emitSource (str "public final Object " state-name ";"))) ;static init to set up var fields and load init (let [gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) (. Method getMethod "void ()") nil nil cv)] (Compiler/emitSource "static {") (Compiler/tab) (. gen (visitCode)) (doseq [v var-fields] (. gen push impl-pkg-name) (. gen push (str prefix v)) (. gen (invokeStatic var-type (. Method (getMethod "clojure.lang.Var internPrivate(String,String)")))) (. gen putStatic ctype (var-name v) var-type) (Compiler/emitSource (str (var-name v) " = Var.internPrivate(\"" impl-pkg-name "\", \"" (str prefix v) "\");"))) (when load-impl-ns (. gen push "clojure.core") (. gen push "load") (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.Var var(String,String)")))) (. gen push (str "/" impl-cname)) (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (to-types [Object])))) ; (. gen push (str (.replace impl-pkg-name \- \_) "__init")) ; (. gen (invokeStatic class-type (. Method (getMethod "Class forName(String)")))) (. gen pop) (Compiler/emitSource (str "RT.var(\"clojure.core\", " "\"load\").invoke(\"" (str "/" impl-cname) "\");"))) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod))) ;ctors (doseq [[pclasses super-pclasses] ctor-sig-map] (let [constructor-annotations (meta pclasses) pclasses (map the-class pclasses) super-pclasses (map the-class super-pclasses) ptypes (to-types pclasses) super-ptypes (to-types super-pclasses) m (new Method "" (. Type VOID_TYPE) ptypes) super-m (new Method "" (. Type VOID_TYPE) super-ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv) _ (add-annotations gen constructor-annotations) no-init-label (. gen newLabel) end-label (. gen newLabel) no-post-init-label (. gen newLabel) end-post-init-label (. gen newLabel) nth-method (. Method (getMethod "Object nth(Object,int)")) local (. gen newLocal obj-type)] (. gen (visitCode)) (Compiler/emitSource (str "public " class-name "(" (reduce1 str (interpose ", " (map #(str (Compiler/printClass (nth pclasses %)) " p" %) (range (count pclasses))))) ") {")) ; TODO init and post-init (comment (Compiler/tab) (Compiler/emitSource "Object value = null;")) (if init (do (Compiler/emitSource "{") (Compiler/tab) (emit-get-var gen init-name) (. gen dup) (. gen ifNull no-init-label) (Compiler/emitSource "if (value != null) {") (Compiler/tab) (.checkCast gen ifn-type) ;box init args (Compiler/emitSource (str "final Object found = RT.nth(((IFn)value).invoke(" (reduce1 str (interpose ", " (map #(do (. gen (loadArg %)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses %) (str "p" %)))) (range (count pclasses))))) "), 0);")) ;call init fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (arg-types (count ptypes))))) ;expecting [[super-ctor-args] state] returned (. gen dup) (. gen push (int 0)) (. gen (invokeStatic rt-type nth-method)) (. gen storeLocal local) (. gen (loadThis)) (. gen dupX1) (Compiler/emitSource (str "super(" (reduce1 str (interpose ", " (map #(do (. gen loadLocal local) (. gen push (int %)) (. gen (invokeStatic rt-type nth-method)) (. clojure.lang.Compiler$HostExpr (emitUnboxArg nil gen (nth super-pclasses %) (str "RT.nth(" "found" ", " % ")")))) (range (count super-pclasses))))) ");")) (. gen (invokeConstructor super-type super-m)) (if state (do (Compiler/emitSource (str state-name " = RT.nth(" "found" ", 1);")) (. gen push (int 1)) (. gen (invokeStatic rt-type nth-method)) (. gen (putField ctype state-name obj-type))) (. gen pop)) (. gen goTo end-label) ;no init found (Compiler/untab) (Compiler/emitSource "} else {") (Compiler/tab) (. gen mark no-init-label) (let [msg (str impl-pkg-name "/" prefix init-name " not defined")] (. gen (throwException ex-type msg)) (Compiler/emitSource (str "throw new " (Compiler/printClass ex-type) "(\"" msg "\");"))) (. gen mark end-label) (Compiler/untab) (Compiler/emitSource "}") (Compiler/untab) (Compiler/emitSource "}")) (if (= pclasses super-pclasses) (do (. gen (loadThis)) (. gen (loadArgs)) (. gen (invokeConstructor super-type super-m)) (Compiler/emitSource (str "super(" (reduce1 str (interpose ", " (map #(str "p" %) (range (count pclasses))))) ");"))) (throw (new Exception ":init not specified, but ctor and super ctor args differ")))) (when post-init (Compiler/emitSource "{") (Compiler/tab) (emit-get-var gen post-init-name) (. gen dup) (Compiler/emitSource "if (value != null) {") (Compiler/tab) (. gen ifNull no-post-init-label) (.checkCast gen ifn-type) (. gen (loadThis)) ;box init args (Compiler/emitSource (str "((IFn)value).invoke(" (reduce1 str (interpose ", " (map #(do (. gen (loadArg %)) (. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses %) (str "p" %)))) (range (count pclasses))))) ")")) ;call init fn (. gen (invokeInterface ifn-type (new Method "invoke" obj-type (arg-types (inc (count ptypes)))))) (. gen pop) (. gen goTo end-post-init-label) ;no init found (. gen mark no-post-init-label) (Compiler/untab) (Compiler/emitSource "} else {") (let [msg (str impl-pkg-name "/" prefix post-init-name " not defined")] (Compiler/emitSource (str "throw new " (Compiler/printClass ex-type) "(\"" msg "\");")) (. gen (throwException ex-type msg))) (Compiler/untab) (Compiler/emitSource "}") (Compiler/untab) (Compiler/emitSource "}") (. gen mark end-post-init-label)) (. gen (returnValue)) (. gen (endMethod)) (Compiler/untab) (Compiler/emitSource "}") ;factory (when factory (let [fm (new Method factory-name ctype ptypes) gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) fm nil nil cv)] (Compiler/emitSource (str "public static " (Compiler/printClass ctype) " " factory-name "(" (reduce1 str (interpose ", " (map #(str (Compiler/printClass (nth pclasses %)) " p" %) (range (count pclasses))))) ") {")) (Compiler/tab) (. gen (visitCode)) (. gen newInstance ctype) (. gen dup) (. gen (loadArgs)) (. gen (invokeConstructor ctype m)) (Compiler/emitSource (str "return new " (Compiler/printClass ctype) "(" (reduce1 str (interpose ", " (map #(str "p" %) (range (count pclasses))))) ");")) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod)))))) ;add methods matching supers', if no fn -> call super (let [mm (non-private-methods super)] (doseq [^java.lang.reflect.Method meth (vals mm)] (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) (.getExceptionTypes meth) false (fn [^GeneratorAdapter gen ^Method m] (. gen (loadThis)) ;push args (. gen (loadArgs)) ;call super (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) (. super-type (getInternalName)) (. m (getName)) (. m (getDescriptor)))) (let [pclasses (map the-class (.getParameterTypes meth)) rclass (the-class (.getReturnType meth)) rtype ^Type (totype rclass) rvoid (= (. rtype (getSort)) (. Type VOID))] (Compiler/emitSource (str (if rvoid "" "return ") "super." (.getName m) "(" (reduce1 str (interpose ", " (map #(str "p" %) (range (count pclasses))))) ");")))))) ;add methods matching interfaces', if no fn -> throw (reduce1 (fn [mm ^java.lang.reflect.Method meth] (if (contains? mm (method-sig meth)) mm (do (emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth) (.getExceptionTypes meth) false emit-unsupported) (assoc mm (method-sig meth) meth)))) mm (mapcat #(.getMethods ^Class %) interfaces)) ;extra methods (doseq [[mname pclasses rclass :as msig] methods] (emit-forwarding-method mname pclasses rclass nil (:static (meta msig)) emit-unsupported)) ;expose specified overridden superclass methods (doseq [[local-mname ^java.lang.reflect.Method m] (reduce1 (fn [ms [[name _ _] m]] (if (contains? exposes-methods (symbol name)) (conj ms [((symbol name) exposes-methods) m]) ms)) [] (concat (seq mm) (seq (protected-final-methods super))))] (let [pclasses (.getParameterTypes m) ptypes (to-types pclasses) rtype (totype (.getReturnType m)) rvoid (= (. rtype (getSort)) (. Type VOID)) exposer-m (new Method (str local-mname) rtype ptypes) target-m (new Method (.getName m) rtype ptypes) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) exposer-m nil nil cv)] (Compiler/emitSource (str "public " (Compiler/printClass rtype) " " (.getName m) "(" (reduce1 str (interpose ", " (map #(str (Compiler/printClass (nth pclasses %)) " p" %) (range (count pclasses))))) ") {")) (Compiler/tab) (. gen (loadThis)) (. gen (loadArgs)) (. gen (visitMethodInsn (. Opcodes INVOKESPECIAL) (. super-type (getInternalName)) (. target-m (getName)) (. target-m (getDescriptor)))) (Compiler/emitSource (str (if rvoid "" "return ") "super." (.getName target-m) "(" (reduce1 str (interpose ", " (map #(str "p" %) (range (count pclasses))))) ");")) (. gen (returnValue)) (Compiler/untab) (Compiler/emitSource "}") (. gen (endMethod))))) ;main (when main (let [m (. Method getMethod "void main (String[])") gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC)) m nil nil cv) no-main-label (. gen newLabel) end-label (. gen newLabel)] (. gen (visitCode)) (Compiler/emitSource (str "public static void main(String[] args) {")) (Compiler/tab) (Compiler/emitSource "Object value = null;") (emit-get-var gen main-name) (Compiler/emitSource (str "if (value != null) {")) (Compiler/tab) (Compiler/emitSource (str "((IFn)value).applyTo(RT.seq(args));")) (Compiler/emitSource "return;") (Compiler/untab) (Compiler/emitSource "}") (. gen dup) (. gen ifNull no-main-label) (.checkCast gen ifn-type) (. gen loadArgs) (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.ISeq seq(Object)")))) (. gen (invokeInterface ifn-type (new Method "applyTo" obj-type (into-array [iseq-type])))) (. gen pop) (. gen goTo end-label) ;no main found (. gen mark no-main-label) (let [msg (str impl-pkg-name "/" prefix main-name " not defined")] (Compiler/emitSource (str "throw new " (Compiler/printClass ex-type) "(\"" msg "\");")) (. gen (throwException ex-type msg))) (. gen mark end-label) (. gen (returnValue)) (Compiler/untab) (Compiler/emitSource "}") (. gen (endMethod)))) ;field exposers (doseq [[f {getter :get setter :set}] exposes] (let [fld (find-field super (str f)) ftype (totype (.getType fld)) static? (Modifier/isStatic (.getModifiers fld)) acc (+ Opcodes/ACC_PUBLIC (if static? Opcodes/ACC_STATIC 0))] (when getter (let [m (new Method (str getter) ftype (to-types [])) gen (new GeneratorAdapter acc m nil nil cv)] (Compiler/emitSource (str "public " (if static? "static " "") (Compiler/printClass ftype) " " (str getter) "() {")) (Compiler/tab) (. gen (visitCode)) (Compiler/emitSource (str "return " f ";")) (if static? (. gen getStatic ctype (str f) ftype) (do (. gen loadThis) (. gen getField ctype (str f) ftype))) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod)))) (when setter (let [m (new Method (str setter) Type/VOID_TYPE (into-array [ftype])) gen (new GeneratorAdapter acc m nil nil cv)] (Compiler/emitSource (str "public " (if static? "static " "") "void " (str setter) "(" (Compiler/printClass ftype) " value) {")) (Compiler/tab) (. gen (visitCode)) (if static? (do (Compiler/emitSource (str (Compiler/printClass ctype) "." f " = value;")) (. gen loadArgs) (. gen putStatic ctype (str f) ftype)) (do (Compiler/emitSource (str "this." f " = value;")) (. gen loadThis) (. gen loadArgs) (. gen putField ctype (str f) ftype))) (Compiler/untab) (Compiler/emitSource "}") (. gen (returnValue)) (. gen (endMethod)))))) ;finish class def (. cv (visitEnd)) (Compiler/untab) (Compiler/emitSource "}") (Compiler/writeSourceFile cname (str *source-writer*)) [cname (. cv (toByteArray))]))) (defmacro gen-class "When compiling, generates compiled bytecode for a class with the given package-qualified :name (which, as all names in these parameters, can be a string or symbol), and writes the .class file to the *compile-path* directory. When not compiling, does nothing. The gen-class construct contains no implementation, as the implementation will be dynamically sought by the generated class in functions in an implementing Clojure namespace. Given a generated class org.mydomain.MyClass with a method named mymethod, gen-class will generate an implementation that looks for a function named by (str prefix mymethod) (default prefix: \"-\") in a Clojure namespace specified by :impl-ns (defaults to the current namespace). All inherited methods, generated methods, and init and main functions (see :methods, :init, and :main below) will be found similarly prefixed. By default, the static initializer for the generated class will attempt to load the Clojure support code for the class as a resource from the classpath, e.g. in the example case, ``org/mydomain/MyClass__init.class``. This behavior can be controlled by :load-impl-ns Note that methods with a maximum of 18 parameters are supported. In all subsequent sections taking types, the primitive types can be referred to by their Java names (int, float etc), and classes in the java.lang package can be used without a package qualifier. All other classes must be fully qualified. Options should be a set of key/value pairs, all except for :name are optional: :name aname The package-qualified name of the class to be generated :extends aclass Specifies the superclass, the non-private methods of which will be overridden by the class. If not provided, defaults to Object. :implements [interface ...] One or more interfaces, the methods of which will be implemented by the class. :init name If supplied, names a function that will be called with the arguments to the constructor. Must return [ [superclass-constructor-args] state] If not supplied, the constructor args are passed directly to the superclass constructor and the state will be nil :constructors {[param-types] [super-param-types], ...} By default, constructors are created for the generated class which match the signature(s) of the constructors for the superclass. This parameter may be used to explicitly specify constructors, each entry providing a mapping from a constructor signature to a superclass constructor signature. When you supply this, you must supply an :init specifier. :post-init name If supplied, names a function that will be called with the object as the first argument, followed by the arguments to the constructor. It will be called every time an object of this class is created, immediately after all the inherited constructors have completed. Its return value is ignored. :methods [ [name [param-types] return-type], ...] The generated class automatically defines all of the non-private methods of its superclasses/interfaces. This parameter can be used to specify the signatures of additional methods of the generated class. Static methods can be specified with ^{:static true} in the signature's metadata. Do not repeat superclass/interface signatures here. :main boolean If supplied and true, a static public main function will be generated. It will pass each string of the String[] argument as a separate argument to a function called (str prefix main). :factory name If supplied, a (set of) public static factory function(s) will be created with the given name, and the same signature(s) as the constructor(s). :state name If supplied, a public final instance field with the given name will be created. You must supply an :init function in order to provide a value for the state. Note that, though final, the state can be a ref or agent, supporting the creation of Java objects with transactional or asynchronous mutation semantics. :exposes {protected-field-name {:get name :set name}, ...} Since the implementations of the methods of the generated class occur in Clojure functions, they have no access to the inherited protected fields of the superclass. This parameter can be used to generate public getter/setter methods exposing the protected field(s) for use in the implementation. :exposes-methods {super-method-name exposed-name, ...} It is sometimes necessary to call the superclass' implementation of an overridden method. Those methods may be exposed and referred in the new method implementation by a local name. :prefix string Default: \"-\" Methods called e.g. Foo will be looked up in vars called prefixFoo in the implementing ns. :impl-ns name Default: the name of the current ns. Implementations of methods will be looked up in this namespace. :load-impl-ns boolean Default: true. Causes the static initializer for the generated class to reference the load code for the implementing namespace. Should be true when implementing-ns is the default, false if you intend to load the code via some other method." {:added "1.0"} [& options] (when *compile-files* (let [options-map (into1 {} (map vec (partition 2 options))) [cname bytecode] (generate-class options-map)] (Compiler/writeClassFile cname bytecode)))) ;;;;;;;;;;;;;;;;;;;; gen-interface ;;;;;;;;;;;;;;;;;;;;;; ;; based on original contribution by Chris Houser (defn- ^Type asm-type "Returns an asm Type object for c, which may be a primitive class (such as Integer/TYPE), any other class (such as Double), or a fully-qualified class name given as a string or symbol (such as 'java.lang.String)" [c] (if (or (instance? Class c) (prim->class c)) (Type/getType (the-class c)) (let [strx (str c)] (Type/getObjectType (.replace (if (some #{\. \[} strx) strx (str "java.lang." strx)) "." "/"))))) (defn- generate-interface [{:keys [name extends methods]}] (when (some #(-> % first clojure.core/name (.contains "-")) methods) (throw (IllegalArgumentException. "Interface methods must not contain '-'"))) (let [sname (str name) iname (.replace sname "." "/") cv (ClassWriter. ClassWriter/COMPUTE_MAXS) lastdot (.lastIndexOf sname ".") classname (subs sname (inc lastdot)) packagename (subs sname 0 lastdot)] (binding [*source-writer* (.getSc cv)] (Compiler/emitSource (str "package " packagename ";")) (Compiler/emitSource) (Compiler/emitSource (str "public interface " classname " {")) (Compiler/tab) (. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE) iname nil "java/lang/Object" (when (seq extends) (into-array (map #(.getInternalName (asm-type %)) extends)))) (add-annotations cv (meta name)) (doseq [[mname pclasses rclass pmetas] methods] (Compiler/emitSource (str (Compiler$HostExpr/tagToCanonical rclass) " " (str mname) "(" (let [names (map #(str (let [c (nth pclasses %)] (Compiler$HostExpr/tagToCanonical c)) " p" %) (range (count pclasses)))] (apply str (interpose ", " names))) ");")) (let [mv (. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) (str mname) (Type/getMethodDescriptor (asm-type rclass) (if pclasses (into-array Type (map asm-type pclasses)) (make-array Type 0))) nil nil)] (add-annotations mv (meta mname)) (dotimes [i (count pmetas)] (add-annotations mv (nth pmetas i) i)) (. mv visitEnd))) (. cv visitEnd) (Compiler/untab) (Compiler/emitSource "}") (when *compile-files* (Compiler/writeSourceFile iname (str *source-writer*))) [iname (. cv toByteArray)]))) (defmacro gen-interface "When compiling, generates compiled bytecode for an interface with the given package-qualified :name (which, as all names in these parameters, can be a string or symbol), and writes the .class file to the *compile-path* directory. When not compiling, does nothing. In all subsequent sections taking types, the primitive types can be referred to by their Java names (int, float etc), and classes in the java.lang package can be used without a package qualifier. All other classes must be fully qualified. Options should be a set of key/value pairs, all except for :name are optional: :name aname The package-qualified name of the class to be generated :extends [interface ...] One or more interfaces, which will be extended by this interface. :methods [ [name [param-types] return-type], ...] This parameter is used to specify the signatures of the methods of the generated interface. Do not repeat superinterface signatures here." {:added "1.0"} [& options] (let [options-map (apply hash-map options) [cname bytecode] (generate-interface options-map)] (when *compile-files* (clojure.lang.Compiler/writeClassFile cname bytecode)) (.defineClass ^DynamicClassLoader (deref clojure.lang.Compiler/LOADER) (str (:name options-map)) bytecode options))) (comment (defn gen-and-load-class "Generates and immediately loads the bytecode for the specified class. Note that a class generated this way can be loaded only once - the JVM supports only one class with a given name per classloader. Subsequent to generation you can import it into any desired namespaces just like any other class. See gen-class for a description of the options." {:added "1.0"} [& options] (let [options-map (apply hash-map options) [cname bytecode] (generate-class options-map)] (.. (clojure.lang.RT/getRootClassLoader) (defineClass cname bytecode options)))) ) ================================================ FILE: src/clj/clojure/gvec.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; a generic vector implementation for vectors of primitives (in-ns 'clojure.core) (import '(clojure.lang Murmur3)) (set! *warn-on-reflection* true) (deftype VecNode [edit arr]) (def EMPTY-NODE (VecNode. nil (object-array 32))) (definterface IVecImpl (^int tailoff []) (arrayFor [^int i]) (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode]) (popTail [^int level node]) (newPath [edit ^int level node]) (doAssoc [^int level node ^int i val])) (definterface ArrayManager (array [^int size]) (^int alength [arr]) (aclone [arr]) (aget [arr ^int i]) (aset [arr ^int i val])) (deftype ArrayChunk [^clojure.core.ArrayManager am arr ^int off ^int end] clojure.lang.Indexed (nth [_ i] (.aget am arr (+ off i))) (count [_] (- end off)) clojure.lang.IChunk (dropFirst [_] (if (= off end) (throw (IllegalStateException. "dropFirst of empty chunk")) (new ArrayChunk am arr (inc off) end))) (reduce [_ f init] (loop [ret init i off] (if (< i end) (let [ret (f ret (.aget am arr i))] (if (reduced? ret) ret (recur ret (inc i)))) ret)))) (deftype VecSeq [^clojure.core.ArrayManager am ^clojure.core.IVecImpl vec anode ^int i ^int offset] :no-print true clojure.core.protocols.InternalReduce (internal-reduce [_ f val] (loop [result val aidx (+ i offset)] (if (< aidx (count vec)) (let [node (.arrayFor vec aidx) result (loop [result result node-idx (bit-and 0x1f aidx)] (if (< node-idx (.alength am node)) (let [result (f result (.aget am node node-idx))] (if (reduced? result) result (recur result (inc node-idx)))) result))] (if (reduced? result) @result (recur result (bit-and 0xffe0 (+ aidx 32))))) result))) clojure.lang.ISeq (first [_] (.aget am anode offset)) (next [this] (if (< (inc offset) (.alength am anode)) (new VecSeq am vec anode i (inc offset)) (.chunkedNext this))) (more [this] (let [s (.next this)] (or s (clojure.lang.PersistentList/EMPTY)))) (cons [this o] (clojure.lang.Cons. o this)) (count [this] (loop [i 1 s (next this)] (if s (if (instance? clojure.lang.Counted s) (+ i (.count s)) (recur (inc i) (next s))) i))) (equiv [this o] (cond (identical? this o) true (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) (loop [me this you (seq o)] (if (nil? me) (nil? you) (and (clojure.lang.Util/equiv (first me) (first you)) (recur (next me) (next you))))) :else false)) (empty [_] clojure.lang.PersistentList/EMPTY) clojure.lang.Seqable (seq [this] this) clojure.lang.IChunkedSeq (chunkedFirst [_] (ArrayChunk. am anode offset (.alength am anode))) (chunkedNext [_] (let [nexti (+ i (.alength am anode))] (when (< nexti (count vec)) (new VecSeq am vec (.arrayFor vec nexti) nexti 0)))) (chunkedMore [this] (let [s (.chunkedNext this)] (or s (clojure.lang.PersistentList/EMPTY))))) (defmethod print-method ::VecSeq [v w] ((get (methods print-method) clojure.lang.ISeq) v w)) (deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta] Object (equals [this o] (cond (identical? this o) true (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o)) (and (= cnt (count o)) (loop [i (int 0)] (cond (= i cnt) true (.equals (.nth this i) (nth o i)) (recur (inc i)) :else false))) (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) (if-let [st (seq this)] (.equals st (seq o)) (nil? (seq o))) :else false)) ;todo - cache (hashCode [this] (loop [hash (int 1) i (int 0)] (if (= i cnt) hash (let [val (.nth this i)] (recur (unchecked-add-int (unchecked-multiply-int 31 hash) (clojure.lang.Util/hash val)) (inc i)))))) ;todo - cache clojure.lang.IHashEq (hasheq [this] (Murmur3/hashOrdered this)) clojure.lang.Counted (count [_] cnt) clojure.lang.IMeta (meta [_] _meta) clojure.lang.IObj (withMeta [_ m] (new Vec am cnt shift root tail m)) clojure.lang.Indexed (nth [this i] (let [a (.arrayFor this i)] (.aget am a (bit-and i (int 0x1f))))) (nth [this i not-found] (let [z (int 0)] (if (and (>= i z) (< i (.count this))) (.nth this i) not-found))) clojure.lang.IPersistentCollection (cons [this val] (if (< (- cnt (.tailoff this)) (int 32)) (let [new-tail (.array am (inc (.alength am tail)))] (System/arraycopy tail 0 new-tail 0 (.alength am tail)) (.aset am new-tail (.alength am tail) val) (new Vec am (inc cnt) shift root new-tail (meta this))) (let [tail-node (VecNode. (.edit root) tail)] (if (> (bit-shift-right cnt (int 5)) (bit-shift-left (int 1) shift)) ;overflow root? (let [new-root (VecNode. (.edit root) (object-array 32))] (doto ^objects (.arr new-root) (aset 0 root) (aset 1 (.newPath this (.edit root) shift tail-node))) (new Vec am (inc cnt) (+ shift (int 5)) new-root (let [tl (.array am 1)] (.aset am tl 0 val) tl) (meta this))) (new Vec am (inc cnt) shift (.pushTail this shift root tail-node) (let [tl (.array am 1)] (.aset am tl 0 val) tl) (meta this)))))) (empty [_] (new Vec am 0 5 EMPTY-NODE (.array am 0) nil)) (equiv [this o] (cond (or (instance? clojure.lang.IPersistentVector o) (instance? java.util.RandomAccess o)) (and (= cnt (count o)) (loop [i (int 0)] (cond (= i cnt) true (= (.nth this i) (nth o i)) (recur (inc i)) :else false))) (or (instance? clojure.lang.Sequential o) (instance? java.util.List o)) (clojure.lang.Util/equiv (seq this) (seq o)) :else false)) clojure.lang.IPersistentStack (peek [this] (when (> cnt (int 0)) (.nth this (dec cnt)))) (pop [this] (cond (zero? cnt) (throw (IllegalStateException. "Can't pop empty vector")) (= 1 cnt) (new Vec am 0 5 EMPTY-NODE (.array am 0) (meta this)) (> (- cnt (.tailoff this)) 1) (let [new-tail (.array am (dec (.alength am tail)))] (System/arraycopy tail 0 new-tail 0 (.alength am new-tail)) (new Vec am (dec cnt) shift root new-tail (meta this))) :else (let [new-tail (.arrayFor this (- cnt 2)) new-root ^clojure.core.VecNode (.popTail this shift root)] (cond (nil? new-root) (new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this)) (and (> shift 5) (nil? (aget ^objects (.arr new-root) 1))) (new Vec am (dec cnt) (- shift 5) (aget ^objects (.arr new-root) 0) new-tail (meta this)) :else (new Vec am (dec cnt) shift new-root new-tail (meta this)))))) clojure.lang.IPersistentVector (assocN [this i val] (cond (and (<= (int 0) i) (< i cnt)) (if (>= i (.tailoff this)) (let [new-tail (.array am (.alength am tail))] (System/arraycopy tail 0 new-tail 0 (.alength am tail)) (.aset am new-tail (bit-and i (int 0x1f)) val) (new Vec am cnt shift root new-tail (meta this))) (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this))) (= i cnt) (.cons this val) :else (throw (IndexOutOfBoundsException.)))) clojure.lang.Reversible (rseq [this] (if (> (.count this) 0) (clojure.lang.APersistentVector$RSeq. this (dec (.count this))) nil)) clojure.lang.Associative (assoc [this k v] (if (clojure.lang.Util/isInteger k) (.assocN this k v) (throw (IllegalArgumentException. "Key must be integer")))) (containsKey [this k] (and (clojure.lang.Util/isInteger k) (<= 0 (int k)) (< (int k) cnt))) (entryAt [this k] (if (.containsKey this k) (clojure.lang.MapEntry. k (.nth this (int k))) nil)) clojure.lang.ILookup (valAt [this k not-found] (if (clojure.lang.Util/isInteger k) (let [i (int k)] (if (and (>= i 0) (< i cnt)) (.nth this i) not-found)) not-found)) (valAt [this k] (.valAt this k nil)) clojure.lang.IFn (invoke [this k] (if (clojure.lang.Util/isInteger k) (let [i (int k)] (if (and (>= i 0) (< i cnt)) (.nth this i) (throw (IndexOutOfBoundsException.)))) (throw (IllegalArgumentException. "Key must be integer")))) clojure.lang.Seqable (seq [this] (if (zero? cnt) nil (VecSeq. am this (.arrayFor this 0) 0 0))) clojure.lang.Sequential ;marker, no methods clojure.core.IVecImpl (tailoff [_] (- cnt (.alength am tail))) (arrayFor [this i] (if (and (<= (int 0) i) (< i cnt)) (if (>= i (.tailoff this)) tail (loop [node root level shift] (if (zero? level) (.arr node) (recur (aget ^objects (.arr node) (bit-and (bit-shift-right i level) (int 0x1f))) (- level (int 5)))))) (throw (IndexOutOfBoundsException.)))) (pushTail [this level parent tailnode] (let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f)) parent ^clojure.core.VecNode parent ret (VecNode. (.edit parent) (aclone ^objects (.arr parent))) node-to-insert (if (= level (int 5)) tailnode (let [child (aget ^objects (.arr parent) subidx)] (if child (.pushTail this (- level (int 5)) child tailnode) (.newPath this (.edit root) (- level (int 5)) tailnode))))] (aset ^objects (.arr ret) subidx node-to-insert) ret)) (popTail [this level node] (let [node ^clojure.core.VecNode node subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))] (cond (> level 5) (let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))] (if (and (nil? new-child) (zero? subidx)) nil (let [arr (aclone ^objects (.arr node))] (aset arr subidx new-child) (VecNode. (.edit root) arr)))) (zero? subidx) nil :else (let [arr (aclone ^objects (.arr node))] (aset arr subidx nil) (VecNode. (.edit root) arr))))) (newPath [this edit ^int level node] (if (zero? level) node (let [ret (VecNode. edit (object-array 32))] (aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node)) ret))) (doAssoc [this level node i val] (let [node ^clojure.core.VecNode node] (if (zero? level) ;on this branch, array will need val type (let [arr (.aclone am (.arr node))] (.aset am arr (bit-and i (int 0x1f)) val) (VecNode. (.edit node) arr)) (let [arr (aclone ^objects (.arr node)) subidx (bit-and (bit-shift-right i level) (int 0x1f))] (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val)) (VecNode. (.edit node) arr))))) java.lang.Comparable (compareTo [this o] (if (identical? this o) 0 (let [^clojure.lang.IPersistentVector v (cast clojure.lang.IPersistentVector o) vcnt (.count v)] (cond (< cnt vcnt) -1 (> cnt vcnt) 1 :else (loop [i (int 0)] (if (= i cnt) 0 (let [comp (clojure.lang.Util/compare (.nth this i) (.nth v i))] (if (= 0 comp) (recur (inc i)) comp)))))))) java.lang.Iterable (iterator [this] (let [i (java.util.concurrent.atomic.AtomicInteger. 0)] (reify java.util.Iterator (hasNext [_] (< (.get i) cnt)) (next [_] (.nth this (dec (.incrementAndGet i)))) (remove [_] (throw (UnsupportedOperationException.)))))) java.util.Collection (contains [this o] (boolean (some #(= % o) this))) (containsAll [this c] (every? #(.contains this %) c)) (isEmpty [_] (zero? cnt)) (toArray [this] (into-array Object this)) (toArray [this arr] (if (>= (count arr) cnt) (do (dotimes [i cnt] (aset arr i (.nth this i))) arr) (into-array Object this))) (size [_] cnt) (add [_ o] (throw (UnsupportedOperationException.))) (addAll [_ c] (throw (UnsupportedOperationException.))) (clear [_] (throw (UnsupportedOperationException.))) (^boolean remove [_ o] (throw (UnsupportedOperationException.))) (removeAll [_ c] (throw (UnsupportedOperationException.))) (retainAll [_ c] (throw (UnsupportedOperationException.))) java.util.List (get [this i] (.nth this i)) (indexOf [this o] (loop [i (int 0)] (cond (== i cnt) -1 (= o (.nth this i)) i :else (recur (inc i))))) (lastIndexOf [this o] (loop [i (dec cnt)] (cond (< i 0) -1 (= o (.nth this i)) i :else (recur (dec i))))) (listIterator [this] (.listIterator this 0)) (listIterator [this i] (let [i (java.util.concurrent.atomic.AtomicInteger. i)] (reify java.util.ListIterator (hasNext [_] (< (.get i) cnt)) (hasPrevious [_] (pos? i)) (next [_] (.nth this (dec (.incrementAndGet i)))) (nextIndex [_] (.get i)) (previous [_] (.nth this (.decrementAndGet i))) (previousIndex [_] (dec (.get i))) (add [_ e] (throw (UnsupportedOperationException.))) (remove [_] (throw (UnsupportedOperationException.))) (set [_ e] (throw (UnsupportedOperationException.)))))) (subList [this a z] (subvec this a z)) (add [_ i o] (throw (UnsupportedOperationException.))) (addAll [_ i c] (throw (UnsupportedOperationException.))) (^Object remove [_ ^int i] (throw (UnsupportedOperationException.))) (set [_ i e] (throw (UnsupportedOperationException.))) ) (defmethod print-method ::Vec [v w] ((get (methods print-method) clojure.lang.IPersistentVector) v w)) (defmacro mk-am {:private true} [t] (let [garr (gensym) tgarr (with-meta garr {:tag (symbol (str t "s"))})] `(reify clojure.core.ArrayManager (array [_ size#] (~(symbol (str t "-array")) size#)) (alength [_ ~garr] (alength ~tgarr)) (aclone [_ ~garr] (aclone ~tgarr)) (aget [_ ~garr i#] (aget ~tgarr i#)) (aset [_ ~garr i# val#] (aset ~tgarr i# (~t val#)))))) (def ^{:private true} ams {:int (mk-am int) :long (mk-am long) :float (mk-am float) :double (mk-am double) :byte (mk-am byte) :short (mk-am short) :char (mk-am char) :boolean (mk-am boolean)}) (defn vector-of "Creates a new vector of a single primitive type t, where t is one of :int :long :float :double :byte :short :char or :boolean. The resulting vector complies with the interface of vectors in general, but stores the values unboxed internally. Optionally takes one or more elements to populate the vector." {:added "1.2" :arglists '([t] [t & elements])} ([t] (let [am ^clojure.core.ArrayManager (ams t)] (Vec. am 0 5 EMPTY-NODE (.array am 0) nil))) ([t x1] (let [am ^clojure.core.ArrayManager (ams t) arr (.array am 1)] (.aset am arr 0 x1) (Vec. am 1 5 EMPTY-NODE arr nil))) ([t x1 x2] (let [am ^clojure.core.ArrayManager (ams t) arr (.array am 2)] (.aset am arr 0 x1) (.aset am arr 1 x2) (Vec. am 2 5 EMPTY-NODE arr nil))) ([t x1 x2 x3] (let [am ^clojure.core.ArrayManager (ams t) arr (.array am 3)] (.aset am arr 0 x1) (.aset am arr 1 x2) (.aset am arr 2 x3) (Vec. am 3 5 EMPTY-NODE arr nil))) ([t x1 x2 x3 x4] (let [am ^clojure.core.ArrayManager (ams t) arr (.array am 4)] (.aset am arr 0 x1) (.aset am arr 1 x2) (.aset am arr 2 x3) (.aset am arr 3 x4) (Vec. am 4 5 EMPTY-NODE arr nil))) ([t x1 x2 x3 x4 & xn] (loop [v (vector-of t x1 x2 x3 x4) xn xn] (if xn (recur (conj v (first xn)) (next xn)) v)))) ================================================ FILE: src/clj/clojure/inspector.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Graphical object inspector for Clojure data structures." :author "Rich Hickey"} clojure.inspector (:import (java.awt BorderLayout) (java.awt.event ActionEvent ActionListener) (javax.swing.tree TreeModel) (javax.swing.table TableModel AbstractTableModel) (javax.swing JPanel JTree JTable JScrollPane JFrame JToolBar JButton SwingUtilities))) (defn atom? [x] (not (coll? x))) (defn collection-tag [x] (cond (instance? java.util.Map$Entry x) :entry (instance? java.util.Map x) :seqable (instance? java.util.Set x) :seqable (sequential? x) :seq (instance? clojure.lang.Seqable x) :seqable :else :atom)) (defmulti is-leaf collection-tag) (defmulti get-child (fn [parent index] (collection-tag parent))) (defmulti get-child-count collection-tag) (defmethod is-leaf :default [node] (atom? node)) (defmethod get-child :default [parent index] (nth parent index)) (defmethod get-child-count :default [parent] (count parent)) (defmethod is-leaf :entry [e] (is-leaf (val e))) (defmethod get-child :entry [e index] (get-child (val e) index)) (defmethod get-child-count :entry [e] (count (val e))) (defmethod is-leaf :seqable [parent] false) (defmethod get-child :seqable [parent index] (nth (seq parent) index)) (defmethod get-child-count :seqable [parent] (count (seq parent))) (defn tree-model [data] (proxy [TreeModel] [] (getRoot [] data) (addTreeModelListener [treeModelListener]) (getChild [parent index] (get-child parent index)) (getChildCount [parent] (get-child-count parent)) (isLeaf [node] (is-leaf node)) (valueForPathChanged [path newValue]) (getIndexOfChild [parent child] -1) (removeTreeModelListener [treeModelListener]))) (defn old-table-model [data] (let [row1 (first data) colcnt (count row1) cnt (count data) vals (if (map? row1) vals identity)] (proxy [TableModel] [] (addTableModelListener [tableModelListener]) (getColumnClass [columnIndex] Object) (getColumnCount [] colcnt) (getColumnName [columnIndex] (if (map? row1) (name (nth (keys row1) columnIndex)) (str columnIndex))) (getRowCount [] cnt) (getValueAt [rowIndex columnIndex] (nth (vals (nth data rowIndex)) columnIndex)) (isCellEditable [rowIndex columnIndex] false) (removeTableModelListener [tableModelListener])))) (defn inspect-tree "creates a graphical (Swing) inspector on the supplied hierarchical data" {:added "1.0"} [data] (doto (JFrame. "Clojure Inspector") (.add (JScrollPane. (JTree. (tree-model data)))) (.setSize 400 600) (.setVisible true))) (defn inspect-table "creates a graphical (Swing) inspector on the supplied regular data, which must be a sequential data structure of data structures of equal length" {:added "1.0"} [data] (doto (JFrame. "Clojure Inspector") (.add (JScrollPane. (JTable. (old-table-model data)))) (.setSize 400 600) (.setVisible true))) (defmulti list-provider class) (defmethod list-provider :default [x] {:nrows 1 :get-value (fn [i] x) :get-label (fn [i] (.getName (class x)))}) (defmethod list-provider java.util.List [c] (let [v (if (vector? c) c (vec c))] {:nrows (count v) :get-value (fn [i] (v i)) :get-label (fn [i] i)})) (defmethod list-provider java.util.Map [c] (let [v (vec (sort (map (fn [[k v]] (vector k v)) c)))] {:nrows (count v) :get-value (fn [i] ((v i) 1)) :get-label (fn [i] ((v i) 0))})) (defn list-model [provider] (let [{:keys [nrows get-value get-label]} provider] (proxy [AbstractTableModel] [] (getColumnCount [] 2) (getRowCount [] nrows) (getValueAt [rowIndex columnIndex] (cond (= 0 columnIndex) (get-label rowIndex) (= 1 columnIndex) (print-str (get-value rowIndex))))))) (defmulti table-model class) (defmethod table-model :default [x] (proxy [AbstractTableModel] [] (getColumnCount [] 2) (getRowCount [] 1) (getValueAt [rowIndex columnIndex] (if (zero? columnIndex) (class x) x)))) ;(defn make-inspector [x] ; (agent {:frame frame :data x :parent nil :index 0})) (defn inspect "creates a graphical (Swing) inspector on the supplied object" {:added "1.0"} [x] (doto (JFrame. "Clojure Inspector") (.add (doto (JPanel. (BorderLayout.)) (.add (doto (JToolBar.) (.add (JButton. "Back")) (.addSeparator) (.add (JButton. "List")) (.add (JButton. "Table")) (.add (JButton. "Bean")) (.add (JButton. "Line")) (.add (JButton. "Bar")) (.addSeparator) (.add (JButton. "Prev")) (.add (JButton. "Next"))) BorderLayout/NORTH) (.add (JScrollPane. (doto (JTable. (list-model (list-provider x))) (.setAutoResizeMode JTable/AUTO_RESIZE_LAST_COLUMN))) BorderLayout/CENTER))) (.setSize 400 400) (.setVisible true))) (comment (load-file "src/inspector.clj") (refer 'inspector) (inspect-tree {:a 1 :b 2 :c [1 2 3 {:d 4 :e 5 :f [6 7 8]}]}) (inspect-table [[1 2 3][4 5 6][7 8 9][10 11 12]]) ) ================================================ FILE: src/clj/clojure/instant.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.instant (:import [java.util Calendar Date GregorianCalendar TimeZone] [java.sql Timestamp])) ;;; ------------------------------------------------------------------------ ;;; convenience macros (defmacro ^:private fail [msg] `(throw (RuntimeException. ~msg))) (defmacro ^:private verify ([test msg] `(when-not ~test (fail ~msg))) ([test] `(verify ~test ~(str "failed: " (pr-str test))))) (defn- divisible? [num div] (zero? (mod num div))) (defn- indivisible? [num div] (not (divisible? num div))) ;;; ------------------------------------------------------------------------ ;;; parser implementation (defn- parse-int [^String s] (Long/parseLong s)) (defn- zero-fill-right [^String s width] (cond (= width (count s)) s (< width (count s)) (.substring s 0 width) :else (loop [b (StringBuilder. s)] (if (< (.length b) width) (recur (.append b \0)) (.toString b))))) (def parse-timestamp "Parse a string containing an RFC3339-like like timestamp. The function new-instant is called with the following arguments. min max default --- ------------ ------- years 0 9999 N/A (s must provide years) months 1 12 1 days 1 31 1 (actual max days depends hours 0 23 0 on month and year) minutes 0 59 0 seconds 0 60 0 (though 60 is only valid nanoseconds 0 999999999 0 when minutes is 59) offset-sign -1 1 0 offset-hours 0 23 0 offset-minutes 0 59 0 These are all integers and will be non-nil. (The listed defaults will be passed if the corresponding field is not present in s.) Grammar (of s): date-fullyear = 4DIGIT date-month = 2DIGIT ; 01-12 date-mday = 2DIGIT ; 01-28, 01-29, 01-30, 01-31 based on ; month/year time-hour = 2DIGIT ; 00-23 time-minute = 2DIGIT ; 00-59 time-second = 2DIGIT ; 00-58, 00-59, 00-60 based on leap second ; rules time-secfrac = '.' 1*DIGIT time-numoffset = ('+' / '-') time-hour ':' time-minute time-offset = 'Z' / time-numoffset time-part = time-hour [ ':' time-minute [ ':' time-second [time-secfrac] [time-offset] ] ] timestamp = date-year [ '-' date-month [ '-' date-mday [ 'T' time-part ] ] ] Unlike RFC3339: - we only parse the timestamp format - timestamp can elide trailing components - time-offset is optional (defaults to +00:00) Though time-offset is syntactically optional, a missing time-offset will be treated as if the time-offset zero (+00:00) had been specified. " (let [timestamp #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?"] (fn [new-instant ^CharSequence cs] (if-let [[_ years months days hours minutes seconds fraction offset-sign offset-hours offset-minutes] (re-matches timestamp cs)] (new-instant (parse-int years) (if-not months 1 (parse-int months)) (if-not days 1 (parse-int days)) (if-not hours 0 (parse-int hours)) (if-not minutes 0 (parse-int minutes)) (if-not seconds 0 (parse-int seconds)) (if-not fraction 0 (parse-int (zero-fill-right fraction 9))) (cond (= "-" offset-sign) -1 (= "+" offset-sign) 1 :else 0) (if-not offset-hours 0 (parse-int offset-hours)) (if-not offset-minutes 0 (parse-int offset-minutes))) (fail (str "Unrecognized date/time syntax: " cs)))))) ;;; ------------------------------------------------------------------------ ;;; Verification of Extra-Grammatical Restrictions from RFC3339 (defn- leap-year? [year] (and (divisible? year 4) (or (indivisible? year 100) (divisible? year 400)))) (def ^:private days-in-month (let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31] dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]] (fn [month leap-year?] ((if leap-year? dim-leap dim-norm) month)))) (defn validated "Return a function which constructs and instant by calling constructor after first validating that those arguments are in range and otherwise plausible. The resulting function will throw an exception if called with invalid arguments." [new-instance] (fn [years months days hours minutes seconds nanoseconds offset-sign offset-hours offset-minutes] (verify (<= 1 months 12)) (verify (<= 1 days (days-in-month months (leap-year? years)))) (verify (<= 0 hours 23)) (verify (<= 0 minutes 59)) (verify (<= 0 seconds (if (= minutes 59) 60 59))) (verify (<= 0 nanoseconds 999999999)) (verify (<= -1 offset-sign 1)) (verify (<= 0 offset-hours 23)) (verify (<= 0 offset-minutes 59)) (new-instance years months days hours minutes seconds nanoseconds offset-sign offset-hours offset-minutes))) ;;; ------------------------------------------------------------------------ ;;; print integration (def ^{:private true :tag ThreadLocal} thread-local-utc-date-format ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 (proxy [ThreadLocal] [] (initialValue [] (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00") ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) (defn- print-date "Print a java.util.Date as RFC3339 timestamp, always in UTC." [^java.util.Date d, ^java.io.Writer w] (let [^java.text.SimpleDateFormat utc-format (.get thread-local-utc-date-format)] (.write w "#inst \"") (.write w (.format utc-format d)) (.write w "\""))) (defmethod print-method java.util.Date [^java.util.Date d, ^java.io.Writer w] (print-date d w)) (defmethod print-dup java.util.Date [^java.util.Date d, ^java.io.Writer w] (print-date d w)) (defn- print-calendar "Print a java.util.Calendar as RFC3339 timestamp, preserving timezone." [^java.util.Calendar c, ^java.io.Writer w] (let [calstr (format "%1$tFT%1$tT.%1$tL%1$tz" c) offset-minutes (- (.length calstr) 2)] ;; calstr is almost right, but is missing the colon in the offset (.write w "#inst \"") (.write w calstr 0 offset-minutes) (.write w ":") (.write w calstr offset-minutes 2) (.write w "\""))) (defmethod print-method java.util.Calendar [^java.util.Calendar c, ^java.io.Writer w] (print-calendar c w)) (defmethod print-dup java.util.Calendar [^java.util.Calendar c, ^java.io.Writer w] (print-calendar c w)) (def ^{:private true :tag ThreadLocal} thread-local-utc-timestamp-format ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 (proxy [ThreadLocal] [] (initialValue [] (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss") (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) (defn- print-timestamp "Print a java.sql.Timestamp as RFC3339 timestamp, always in UTC." [^java.sql.Timestamp ts, ^java.io.Writer w] (let [^java.text.SimpleDateFormat utc-format (.get thread-local-utc-timestamp-format)] (.write w "#inst \"") (.write w (.format utc-format ts)) ;; add on nanos and offset ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) (.write w (format ".%09d-00:00" (.getNanos ts))) (.write w "\""))) (defmethod print-method java.sql.Timestamp [^java.sql.Timestamp ts, ^java.io.Writer w] (print-timestamp ts w)) (defmethod print-dup java.sql.Timestamp [^java.sql.Timestamp ts, ^java.io.Writer w] (print-timestamp ts w)) ;;; ------------------------------------------------------------------------ ;;; reader integration (defn- construct-calendar "Construct a java.util.Calendar, preserving the timezone offset, but truncating the subsecond fraction to milliseconds." ^GregorianCalendar [years months days hours minutes seconds nanoseconds offset-sign offset-hours offset-minutes] (doto (GregorianCalendar. years (dec months) days hours minutes seconds) (.set Calendar/MILLISECOND (quot nanoseconds 1000000)) (.setTimeZone (TimeZone/getTimeZone (format "GMT%s%02d:%02d" (if (neg? offset-sign) "-" "+") offset-hours offset-minutes))))) (defn- construct-date "Construct a java.util.Date, which expresses the original instant as milliseconds since the epoch, UTC." [years months days hours minutes seconds nanoseconds offset-sign offset-hours offset-minutes] (.getTime (construct-calendar years months days hours minutes seconds nanoseconds offset-sign offset-hours offset-minutes))) (defn- construct-timestamp "Construct a java.sql.Timestamp, which has nanosecond precision." [years months days hours minutes seconds nanoseconds offset-sign offset-hours offset-minutes] (doto (Timestamp. (.getTimeInMillis (construct-calendar years months days hours minutes seconds 0 offset-sign offset-hours offset-minutes))) ;; nanos must be set separately, pass 0 above for the base calendar (.setNanos nanoseconds))) (def read-instant-date "To read an instant as a java.util.Date, bind *data-readers* to a map with this var as the value for the 'inst key. The timezone offset will be used to convert into UTC." (partial parse-timestamp (validated construct-date))) (def read-instant-calendar "To read an instant as a java.util.Calendar, bind *data-readers* to a map with this var as the value for the 'inst key. Calendar preserves the timezone offset." (partial parse-timestamp (validated construct-calendar))) (def read-instant-timestamp "To read an instant as a java.sql.Timestamp, bind *data-readers* to a map with this var as the value for the 'inst key. Timestamp preserves fractional seconds with nanosecond precision. The timezone offset will be used to convert into UTC." (partial parse-timestamp (validated construct-timestamp))) ================================================ FILE: src/clj/clojure/java/browse.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Christophe Grand", :doc "Start a web browser from Clojure"} clojure.java.browse (:require [clojure.java.shell :as sh] [clojure.string :as str]) (:import (java.net URI))) (defn- macosx? [] (-> "os.name" System/getProperty .toLowerCase (.startsWith "mac os x"))) (defn- xdg-open-loc [] ;; try/catch needed to mask exception on Windows without Cygwin (let [which-out (try (:out (sh/sh "which" "xdg-open")) (catch Exception e ""))] (if (= which-out "") nil (str/trim-newline which-out)))) (defn- open-url-script-val [] (if (macosx?) "/usr/bin/open" (xdg-open-loc))) ;; We could assign (open-url-script-val) to *open-url-script* right ;; away in the def below, but clojure.java.shell/sh creates a future ;; that causes a long wait for the JVM to exit during Clojure compiles ;; (unless we can somehow here make it call (shutdown-agents) later). ;; Better to initialize it when we first need it, in browse-url. (def ^:dynamic *open-url-script* (atom :uninitialized)) (defn- open-url-in-browser "Opens url (a string) in the default system web browser. May not work on all platforms. Returns url on success, nil if not supported." [url] (try (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" "isDesktopSupported" (to-array nil)) (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" "getDesktop" (to-array nil)) (.browse (URI. url))) url) (catch Exception e nil))) (defn- open-url-in-swing "Opens url (a string) in a Swing window." [url] ; the implementation of this function resides in another namespace to be loaded "on demand" ; this fixes a bug on mac os x where the process turns into a GUI app ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32 (require 'clojure.java.browse-ui) ((find-var 'clojure.java.browse-ui/open-url-in-swing) url)) (defn browse-url "Open url in a browser" {:added "1.2"} [url] (let [script @*open-url-script* script (if (= :uninitialized script) (reset! *open-url-script* (open-url-script-val)) script)] (or (when script (sh/sh script (str url)) true) (open-url-in-browser url) (open-url-in-swing url)))) ================================================ FILE: src/clj/clojure/java/browse_ui.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Christophe Grand", :doc "Helper namespace for clojure.java.browse. Prevents console apps from becoming GUI unnecessarily."} clojure.java.browse-ui) (defn- open-url-in-swing [url] (let [htmlpane (javax.swing.JEditorPane. url)] (.setEditable htmlpane false) (.addHyperlinkListener htmlpane (proxy [javax.swing.event.HyperlinkListener] [] (hyperlinkUpdate [^javax.swing.event.HyperlinkEvent e] (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED)) (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e) (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e)) (.setPage htmlpane (.getURL e))))))) (doto (javax.swing.JFrame.) (.setContentPane (javax.swing.JScrollPane. htmlpane)) (.setBounds 32 32 700 900) (.show)))) ================================================ FILE: src/clj/clojure/java/io.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Stuart Sierra, Chas Emerick, Stuart Halloway", :doc "This file defines polymorphic I/O utility functions for Clojure."} clojure.java.io (:require clojure.string) (:import (java.io Reader InputStream InputStreamReader PushbackReader BufferedReader File OutputStream OutputStreamWriter BufferedWriter Writer FileInputStream FileOutputStream ByteArrayOutputStream StringReader ByteArrayInputStream BufferedInputStream BufferedOutputStream CharArrayReader Closeable) (java.net URI URL MalformedURLException Socket URLDecoder URLEncoder))) (def ^{:doc "Type object for a Java primitive byte array." :private true } byte-array-type (class (make-array Byte/TYPE 0))) (def ^{:doc "Type object for a Java primitive char array." :private true} char-array-type (class (make-array Character/TYPE 0))) (defprotocol ^{:added "1.2"} Coercions "Coerce between various 'resource-namish' things." (^{:tag java.io.File, :added "1.2"} as-file [x] "Coerce argument to a file.") (^{:tag java.net.URL, :added "1.2"} as-url [x] "Coerce argument to a URL.")) (defn- escaped-utf8-urlstring->str [s] (-> (clojure.string/replace s "+" (URLEncoder/encode "+" "UTF-8")) (URLDecoder/decode "UTF-8"))) (extend-protocol Coercions nil (as-file [_] nil) (as-url [_] nil) String (as-file [s] (File. s)) (as-url [s] (URL. s)) File (as-file [f] f) (as-url [f] (.toURL (.toURI f))) URL (as-url [u] u) (as-file [u] (if (= "file" (.getProtocol u)) (as-file (escaped-utf8-urlstring->str (.replace (.getFile u) \/ File/separatorChar))) (throw (IllegalArgumentException. (str "Not a file: " u))))) URI (as-url [u] (.toURL u)) (as-file [u] (as-file (as-url u)))) (defprotocol ^{:added "1.2"} IOFactory "Factory functions that create ready-to-use, buffered versions of the various Java I/O stream types, on top of anything that can be unequivocally converted to the requested kind of stream. Common options include :append true to open stream in append mode :encoding string name of encoding to use, e.g. \"UTF-8\". Callers should generally prefer the higher level API provided by reader, writer, input-stream, and output-stream." (^{:added "1.2"} make-reader [x opts] "Creates a BufferedReader. See also IOFactory docs.") (^{:added "1.2"} make-writer [x opts] "Creates a BufferedWriter. See also IOFactory docs.") (^{:added "1.2"} make-input-stream [x opts] "Creates a BufferedInputStream. See also IOFactory docs.") (^{:added "1.2"} make-output-stream [x opts] "Creates a BufferedOutputStream. See also IOFactory docs.")) (defn ^Reader reader "Attempts to coerce its argument into an open java.io.Reader. Default implementations always return a java.io.BufferedReader. Default implementations are provided for Reader, BufferedReader, InputStream, File, URI, URL, Socket, byte arrays, character arrays, and String. If argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the Reader is properly closed." {:added "1.2"} [x & opts] (make-reader x (when opts (apply hash-map opts)))) (defn ^Writer writer "Attempts to coerce its argument into an open java.io.Writer. Default implementations always return a java.io.BufferedWriter. Default implementations are provided for Writer, BufferedWriter, OutputStream, File, URI, URL, Socket, and String. If the argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the Writer is properly closed." {:added "1.2"} [x & opts] (make-writer x (when opts (apply hash-map opts)))) (defn ^InputStream input-stream "Attempts to coerce its argument into an open java.io.InputStream. Default implementations always return a java.io.BufferedInputStream. Default implementations are defined for InputStream, File, URI, URL, Socket, byte array, and String arguments. If the argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the InputStream is properly closed." {:added "1.2"} [x & opts] (make-input-stream x (when opts (apply hash-map opts)))) (defn ^OutputStream output-stream "Attempts to coerce its argument into an open java.io.OutputStream. Default implementations always return a java.io.BufferedOutputStream. Default implementations are defined for OutputStream, File, URI, URL, Socket, and String arguments. If the argument is a String, it tries to resolve it first as a URI, then as a local file name. URIs with a 'file' protocol are converted to local file names. Should be used inside with-open to ensure the OutputStream is properly closed." {:added "1.2"} [x & opts] (make-output-stream x (when opts (apply hash-map opts)))) (defn- ^Boolean append? [opts] (boolean (:append opts))) (defn- ^String encoding [opts] (or (:encoding opts) "UTF-8")) (defn- buffer-size [opts] (or (:buffer-size opts) 1024)) (def default-streams-impl {:make-reader (fn [x opts] (make-reader (make-input-stream x opts) opts)) :make-writer (fn [x opts] (make-writer (make-output-stream x opts) opts)) :make-input-stream (fn [x opts] (throw (IllegalArgumentException. (str "Cannot open <" (pr-str x) "> as an InputStream.")))) :make-output-stream (fn [x opts] (throw (IllegalArgumentException. (str "Cannot open <" (pr-str x) "> as an OutputStream."))))}) (defn- inputstream->reader [^InputStream is opts] (make-reader (InputStreamReader. is (encoding opts)) opts)) (defn- outputstream->writer [^OutputStream os opts] (make-writer (OutputStreamWriter. os (encoding opts)) opts)) (extend BufferedInputStream IOFactory (assoc default-streams-impl :make-input-stream (fn [x opts] x) :make-reader inputstream->reader)) (extend InputStream IOFactory (assoc default-streams-impl :make-input-stream (fn [x opts] (BufferedInputStream. x)) :make-reader inputstream->reader)) (extend Reader IOFactory (assoc default-streams-impl :make-reader (fn [x opts] (BufferedReader. x)))) (extend BufferedReader IOFactory (assoc default-streams-impl :make-reader (fn [x opts] x))) (extend Writer IOFactory (assoc default-streams-impl :make-writer (fn [x opts] (BufferedWriter. x)))) (extend BufferedWriter IOFactory (assoc default-streams-impl :make-writer (fn [x opts] x))) (extend OutputStream IOFactory (assoc default-streams-impl :make-output-stream (fn [x opts] (BufferedOutputStream. x)) :make-writer outputstream->writer)) (extend BufferedOutputStream IOFactory (assoc default-streams-impl :make-output-stream (fn [x opts] x) :make-writer outputstream->writer)) (extend File IOFactory (assoc default-streams-impl :make-input-stream (fn [^File x opts] (make-input-stream (FileInputStream. x) opts)) :make-output-stream (fn [^File x opts] (make-output-stream (FileOutputStream. x (append? opts)) opts)))) (extend URL IOFactory (assoc default-streams-impl :make-input-stream (fn [^URL x opts] (make-input-stream (if (= "file" (.getProtocol x)) (FileInputStream. (as-file x)) (.openStream x)) opts)) :make-output-stream (fn [^URL x opts] (if (= "file" (.getProtocol x)) (make-output-stream (as-file x) opts) (throw (IllegalArgumentException. (str "Can not write to non-file URL <" x ">"))))))) (extend URI IOFactory (assoc default-streams-impl :make-input-stream (fn [^URI x opts] (make-input-stream (.toURL x) opts)) :make-output-stream (fn [^URI x opts] (make-output-stream (.toURL x) opts)))) (extend String IOFactory (assoc default-streams-impl :make-input-stream (fn [^String x opts] (try (make-input-stream (URL. x) opts) (catch MalformedURLException e (make-input-stream (File. x) opts)))) :make-output-stream (fn [^String x opts] (try (make-output-stream (URL. x) opts) (catch MalformedURLException err (make-output-stream (File. x) opts)))))) (extend Socket IOFactory (assoc default-streams-impl :make-input-stream (fn [^Socket x opts] (make-input-stream (.getInputStream x) opts)) :make-output-stream (fn [^Socket x opts] (make-output-stream (.getOutputStream x) opts)))) (extend byte-array-type IOFactory (assoc default-streams-impl :make-input-stream (fn [x opts] (make-input-stream (ByteArrayInputStream. x) opts)))) (extend char-array-type IOFactory (assoc default-streams-impl :make-reader (fn [x opts] (make-reader (CharArrayReader. x) opts)))) (extend Object IOFactory default-streams-impl) (defmulti ^{:doc "Internal helper for copy" :private true :arglists '([input output opts])} do-copy (fn [input output opts] [(type input) (type output)])) (defmethod do-copy [InputStream OutputStream] [^InputStream input ^OutputStream output opts] (let [buffer (make-array Byte/TYPE (buffer-size opts))] (loop [] (let [size (.read input buffer)] (when (pos? size) (do (.write output buffer 0 size) (recur))))))) (defmethod do-copy [InputStream Writer] [^InputStream input ^Writer output opts] (let [^"[C" buffer (make-array Character/TYPE (buffer-size opts)) in (InputStreamReader. input (encoding opts))] (loop [] (let [size (.read in buffer 0 (alength buffer))] (if (pos? size) (do (.write output buffer 0 size) (recur))))))) (defmethod do-copy [InputStream File] [^InputStream input ^File output opts] (with-open [out (FileOutputStream. output)] (do-copy input out opts))) (defmethod do-copy [Reader OutputStream] [^Reader input ^OutputStream output opts] (let [^"[C" buffer (make-array Character/TYPE (buffer-size opts)) out (OutputStreamWriter. output (encoding opts))] (loop [] (let [size (.read input buffer)] (if (pos? size) (do (.write out buffer 0 size) (recur)) (.flush out)))))) (defmethod do-copy [Reader Writer] [^Reader input ^Writer output opts] (let [^"[C" buffer (make-array Character/TYPE (buffer-size opts))] (loop [] (let [size (.read input buffer)] (when (pos? size) (do (.write output buffer 0 size) (recur))))))) (defmethod do-copy [Reader File] [^Reader input ^File output opts] (with-open [out (FileOutputStream. output)] (do-copy input out opts))) (defmethod do-copy [File OutputStream] [^File input ^OutputStream output opts] (with-open [in (FileInputStream. input)] (do-copy in output opts))) (defmethod do-copy [File Writer] [^File input ^Writer output opts] (with-open [in (FileInputStream. input)] (do-copy in output opts))) (defmethod do-copy [File File] [^File input ^File output opts] (with-open [in (-> input FileInputStream. .getChannel) out (-> output FileOutputStream. .getChannel)] (let [sz (.size in)] (loop [pos 0] (let [bytes-xferred (.transferTo in pos (- sz pos) out) pos (+ pos bytes-xferred)] (when (< pos sz) (recur pos))))))) (defmethod do-copy [String OutputStream] [^String input ^OutputStream output opts] (do-copy (StringReader. input) output opts)) (defmethod do-copy [String Writer] [^String input ^Writer output opts] (do-copy (StringReader. input) output opts)) (defmethod do-copy [String File] [^String input ^File output opts] (do-copy (StringReader. input) output opts)) (defmethod do-copy [char-array-type OutputStream] [input ^OutputStream output opts] (do-copy (CharArrayReader. input) output opts)) (defmethod do-copy [char-array-type Writer] [input ^Writer output opts] (do-copy (CharArrayReader. input) output opts)) (defmethod do-copy [char-array-type File] [input ^File output opts] (do-copy (CharArrayReader. input) output opts)) (defmethod do-copy [byte-array-type OutputStream] [^"[B" input ^OutputStream output opts] (do-copy (ByteArrayInputStream. input) output opts)) (defmethod do-copy [byte-array-type Writer] [^"[B" input ^Writer output opts] (do-copy (ByteArrayInputStream. input) output opts)) (defmethod do-copy [byte-array-type File] [^"[B" input ^Writer output opts] (do-copy (ByteArrayInputStream. input) output opts)) (defn copy "Copies input to output. Returns nil or throws IOException. Input may be an InputStream, Reader, File, byte[], or String. Output may be an OutputStream, Writer, or File. Options are key/value pairs and may be one of :buffer-size buffer size to use, default is 1024. :encoding encoding to use if converting between byte and char streams. Does not close any streams except those it opens itself (on a File)." {:added "1.2"} [input output & opts] (do-copy input output (when opts (apply hash-map opts)))) (defn ^String as-relative-path "Take an as-file-able thing and return a string if it is a relative path, else IllegalArgumentException." {:added "1.2"} [x] (let [^File f (as-file x)] (if (.isAbsolute f) (throw (IllegalArgumentException. (str f " is not a relative path"))) (.getPath f)))) (defn ^File file "Returns a java.io.File, passing each arg to as-file. Multiple-arg versions treat the first argument as parent and subsequent args as children relative to the parent." {:added "1.2"} ([arg] (as-file arg)) ([parent child] (File. ^File (as-file parent) ^String (as-relative-path child))) ([parent child & more] (reduce file (file parent child) more))) (defn delete-file "Delete file f. Raise an exception if it fails unless silently is true." {:added "1.2"} [f & [silently]] (or (.delete (file f)) silently (throw (java.io.IOException. (str "Couldn't delete " f))))) (defn make-parents "Given the same arg(s) as for file, creates all parent directories of the file they represent." {:added "1.2"} [f & more] (when-let [parent (.getParentFile ^File (apply file f more))] (.mkdirs parent))) (defn ^URL resource "Returns the URL for a named resource. Use the context class loader if no loader is specified." {:added "1.2"} ([n] (resource n (.getContextClassLoader (Thread/currentThread)))) ([n ^ClassLoader loader] (.getResource loader n))) ================================================ FILE: src/clj/clojure/java/javadoc.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Christophe Grand, Stuart Sierra", :doc "A repl helper to quickly open javadocs."} clojure.java.javadoc (:use [clojure.java.browse :only (browse-url)] ) (:import (java.io File))) (def ^:dynamic *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:") (def ^:dynamic *feeling-lucky* true) (def ^:dynamic *local-javadocs* (ref (list))) (def ^:dynamic *core-java-api* (case (System/getProperty "java.specification.version") "1.6" "http://java.sun.com/javase/6/docs/api/" "http://java.sun.com/javase/7/docs/api/")) (def ^:dynamic *remote-javadocs* (ref (sorted-map "java." *core-java-api* "javax." *core-java-api* "org.ietf.jgss." *core-java-api* "org.omg." *core-java-api* "org.w3c.dom." *core-java-api* "org.xml.sax." *core-java-api* "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" "org.apache.commons.io." "http://commons.apache.org/io/api-release/" "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) (defn add-local-javadoc "Adds to the list of local Javadoc paths." {:added "1.2"} [path] (dosync (commute *local-javadocs* conj path))) (defn add-remote-javadoc "Adds to the list of remote Javadoc URLs. package-prefix is the beginning of the package name that has docs at this URL." {:added "1.2"} [package-prefix url] (dosync (commute *remote-javadocs* assoc package-prefix url))) (defn- javadoc-url "Searches for a URL for the given class name. Tries *local-javadocs* first, then *remote-javadocs*. Returns a string." {:tag String, :added "1.2"} [^String classname] (let [file-path (.replace classname \. File/separatorChar) url-path (.replace classname \. \/)] (if-let [file ^File (first (filter #(.exists ^File %) (map #(File. (str %) (str file-path ".html")) @*local-javadocs*)))] (-> file .toURI str) ;; If no local file, try remote URLs: (or (some (fn [[prefix url]] (when (.startsWith classname prefix) (str url url-path ".html"))) @*remote-javadocs*) ;; if *feeling-lucky* try a web search (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html")))))) (defn javadoc "Opens a browser window displaying the javadoc for the argument. Tries *local-javadocs* first, then *remote-javadocs*." {:added "1.2"} [class-or-object] (let [^Class c (if (instance? Class class-or-object) class-or-object (class class-or-object))] (if-let [url (javadoc-url (.getName c))] (browse-url url) (println "Could not find Javadoc for" c)))) ================================================ FILE: src/clj/clojure/java/shell.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Chris Houser, Stuart Halloway", :doc "Conveniently launch a sub-process providing its stdin and collecting its stdout"} clojure.java.shell (:use [clojure.java.io :only (as-file copy)]) (:import (java.io ByteArrayOutputStream StringWriter) (java.nio.charset Charset))) (def ^:dynamic *sh-dir* nil) (def ^:dynamic *sh-env* nil) (defmacro with-sh-dir "Sets the directory for use with sh, see sh for details." {:added "1.2"} [dir & forms] `(binding [*sh-dir* ~dir] ~@forms)) (defmacro with-sh-env "Sets the environment for use with sh, see sh for details." {:added "1.2"} [env & forms] `(binding [*sh-env* ~env] ~@forms)) (defn- aconcat "Concatenates arrays of given type." [type & xs] (let [target (make-array type (apply + (map count xs)))] (loop [i 0 idx 0] (when-let [a (nth xs i nil)] (System/arraycopy a 0 target idx (count a)) (recur (inc i) (+ idx (count a))))) target)) (defn- parse-args [args] (let [default-encoding "UTF-8" ;; see sh doc string default-opts {:out-enc default-encoding :in-enc default-encoding :dir *sh-dir* :env *sh-env*} [cmd opts] (split-with string? args)] [cmd (merge default-opts (apply hash-map opts))])) (defn- ^"[Ljava.lang.String;" as-env-strings "Helper so that callers can pass a Clojure map for the :env to sh." [arg] (cond (nil? arg) nil (map? arg) (into-array String (map (fn [[k v]] (str (name k) "=" v)) arg)) true arg)) (defn- stream-to-bytes [in] (with-open [bout (ByteArrayOutputStream.)] (copy in bout) (.toByteArray bout))) (defn- stream-to-string ([in] (stream-to-string in (.name (Charset/defaultCharset)))) ([in enc] (with-open [bout (StringWriter.)] (copy in bout :encoding enc) (.toString bout)))) (defn- stream-to-enc [stream enc] (if (= enc :bytes) (stream-to-bytes stream) (stream-to-string stream enc))) (defn sh "Passes the given strings to Runtime.exec() to launch a sub-process. Options are :in may be given followed by any legal input source for clojure.java.io/copy, e.g. InputStream, Reader, File, byte[], or String, to be fed to the sub-process's stdin. :in-enc option may be given followed by a String, used as a character encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to convert the input string specified by the :in option to the sub-process's stdin. Defaults to UTF-8. If the :in option provides a byte array, then the bytes are passed unencoded, and this option is ignored. :out-enc option may be given followed by :bytes or a String. If a String is given, it will be used as a character encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to convert the sub-process's stdout to a String which is returned. If :bytes is given, the sub-process's stdout will be stored in a byte array and returned. Defaults to UTF-8. :env override the process env with a map (or the underlying Java String[] if you are a masochist). :dir override the process dir with a String or java.io.File. You can bind :env or :dir for multiple operations using with-sh-env and with-sh-dir. sh returns a map of :exit => sub-process's exit code :out => sub-process's stdout (as byte[] or String) :err => sub-process's stderr (String via platform default encoding)" {:added "1.2"} [& args] (let [[cmd opts] (parse-args args) proc (.exec (Runtime/getRuntime) ^"[Ljava.lang.String;" (into-array cmd) (as-env-strings (:env opts)) (as-file (:dir opts))) {:keys [in in-enc out-enc]} opts] (if in (future (with-open [os (.getOutputStream proc)] (copy in os :encoding in-enc))) (.close (.getOutputStream proc))) (with-open [stdout (.getInputStream proc) stderr (.getErrorStream proc)] (let [out (future (stream-to-enc stdout out-enc)) err (future (stream-to-string stderr)) exit-code (.waitFor proc)] {:exit exit-code :out @out :err @err})))) (comment (println (sh "ls" "-l")) (println (sh "ls" "-l" "/no-such-thing")) (println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) (println (sh "sed" "s/[aeiou]/oo/g" :in (java.io.StringReader. "hello there\n"))) (println (sh "cat" :in "x\u25bax\n")) (println (sh "echo" "x\u25bax")) (println (sh "echo" "x\u25bax" :out-enc "ISO-8859-1")) ; reads 4 single-byte chars (println (sh "cat" "myimage.png" :out-enc :bytes)) ; reads binary file into bytes[] (println (sh "cmd" "/c dir 1>&2")) ) ================================================ FILE: src/clj/clojure/main.clj ================================================ ;; Copyright (c) Rich Hickey All rights reserved. The use and ;; distribution terms for this software are covered by the Eclipse Public ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found ;; in the file epl-v10.html at the root of this distribution. By using this ;; software in any fashion, you are agreeing to be bound by the terms of ;; this license. You must not remove this notice, or any other, from this ;; software. ;; Originally contributed by Stephen C. Gilardi (ns ^{:doc "Top-level main function for Clojure REPL and scripts." :author "Stephen C. Gilardi and Rich Hickey"} clojure.main (:refer-clojure :exclude [with-bindings]) (:import (clojure.lang Compiler Compiler$CompilerException LineNumberingPushbackReader RT)) ;;(:use [clojure.repl :only (demunge root-cause stack-element-str)]) ) (declare main) ;;;;;;;;;;;;;;;;;;; redundantly copied from clojure.repl to avoid dep ;;;;;;;;;;;;;; #_(defn root-cause [x] x) #_(defn stack-element-str "Returns a (possibly unmunged) string representation of a StackTraceElement" {:added "1.3"} [^StackTraceElement el] (.getClassName el)) (defn demunge "Given a string representation of a fn class, as in a stack trace element, returns a readable version." {:added "1.3"} [fn-name] (clojure.lang.Compiler/demunge fn-name)) (defn root-cause "Returns the initial cause of an exception or error by peeling off all of its wrappers" {:added "1.3"} [^Throwable t] (loop [cause t] (if (and (instance? clojure.lang.Compiler$CompilerException cause) (not= (.source ^clojure.lang.Compiler$CompilerException cause) "NO_SOURCE_FILE")) cause (if-let [cause (.getCause cause)] (recur cause) cause)))) (defn stack-element-str "Returns a (possibly unmunged) string representation of a StackTraceElement" {:added "1.3"} [^StackTraceElement el] (let [file (.getFileName el) clojure-fn? (and file (or (.endsWith file ".clj") (.endsWith file ".cljc") (= file "NO_SOURCE_FILE")))] (str (if clojure-fn? (demunge (.getClassName el)) (str (.getClassName el) "." (.getMethodName el))) " (" (.getFileName el) ":" (.getLineNumber el) ")"))) ;;;;;;;;;;;;;;;;;;; end of redundantly copied from clojure.repl to avoid dep ;;;;;;;;;;;;;; (defmacro with-bindings "Executes body in the context of thread-local bindings for several vars that often need to be set!: *ns* *warn-on-reflection* *math-context* *print-meta* *print-length* *print-level* *compile-path* *command-line-args* *1 *2 *3 *e" [& body] `(binding [*ns* *ns* *warn-on-reflection* *warn-on-reflection* *math-context* *math-context* *print-meta* *print-meta* *print-length* *print-length* *print-level* *print-level* *data-readers* *data-readers* *default-data-reader-fn* *default-data-reader-fn* *compile-path* (System/getProperty "clojure.compile.path" "classes") *command-line-args* *command-line-args* *unchecked-math* *unchecked-math* *assert* *assert* *1 nil *2 nil *3 nil *e nil] ~@body)) (defn repl-prompt "Default :prompt hook for repl" [] (printf "%s=> " (ns-name *ns*))) (defn skip-if-eol "If the next character on stream s is a newline, skips it, otherwise leaves the stream untouched. Returns :line-start, :stream-end, or :body to indicate the relative location of the next character on s. The stream must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing all of CR, LF, and CRLF to a single \\newline." [s] (let [c (.read s)] (cond (= c (int \newline)) :line-start (= c -1) :stream-end :else (do (.unread s c) :body)))) (defn skip-whitespace "Skips whitespace characters on stream s. Returns :line-start, :stream-end, or :body to indicate the relative location of the next character on s. Interprets comma as whitespace and semicolon as comment to end of line. Does not interpret #! as comment to end of line because only one character of lookahead is available. The stream must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing all of CR, LF, and CRLF to a single \\newline." [s] (loop [c (.read s)] (cond (= c (int \newline)) :line-start (= c -1) :stream-end (= c (int \;)) (do (.readLine s) :line-start) (or (Character/isWhitespace (char c)) (= c (int \,))) (recur (.read s)) :else (do (.unread s c) :body)))) (defn repl-read "Default :read hook for repl. Reads from *in* which must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing all of CR, LF, and CRLF into a single \\newline. repl-read: - skips whitespace, then - returns request-prompt on start of line, or - returns request-exit on end of stream, or - reads an object from the input stream, then - skips the next input character if it's end of line, then - returns the object." [request-prompt request-exit] (or ({:line-start request-prompt :stream-end request-exit} (skip-whitespace *in*)) (let [input (read {:read-cond :allow} *in*)] (skip-if-eol *in*) input))) (defn repl-exception "Returns the root cause of throwables" [throwable] (root-cause throwable)) (defn repl-caught "Default :caught hook for repl" [e] (let [ex (repl-exception e) tr (.getStackTrace ex) el (when-not (zero? (count tr)) (aget tr 0))] (binding [*out* *err*] (println (str (-> ex class .getSimpleName) " " (.getMessage ex) " " (when-not (instance? clojure.lang.Compiler$CompilerException ex) (str " " (if el (stack-element-str el) "[trace missing]")))))))) (def ^{:doc "A sequence of lib specs that are applied to `require` by default when a new command-line REPL is started."} repl-requires '[[clojure.repl :refer (source apropos dir pst doc find-doc)] [clojure.java.javadoc :refer (javadoc)] [clojure.pprint :refer (pp pprint)]]) (defmacro with-read-known "Evaluates body with *read-eval* set to a \"known\" value, i.e. substituting true for :unknown if necessary." [& body] `(binding [*read-eval* (if (= :unknown *read-eval*) true *read-eval*)] ~@body)) (defn repl "Generic, reusable, read-eval-print loop. By default, reads from *in*, writes to *out*, and prints exception summaries to *err*. If you use the default :read hook, *in* must either be an instance of LineNumberingPushbackReader or duplicate its behavior of both supporting .unread and collapsing CR, LF, and CRLF into a single \\newline. Options are sequential keyword-value pairs. Available options and their defaults: - :init, function of no arguments, initialization hook called with bindings for set!-able vars in place. default: #() - :need-prompt, function of no arguments, called before each read-eval-print except the first, the user will be prompted if it returns true. default: (if (instance? LineNumberingPushbackReader *in*) #(.atLineStart *in*) #(identity true)) - :prompt, function of no arguments, prompts for more input. default: repl-prompt - :flush, function of no arguments, flushes output default: flush - :read, function of two arguments, reads from *in*: - returns its first argument to request a fresh prompt - depending on need-prompt, this may cause the repl to prompt before reading again - returns its second argument to request an exit from the repl - else returns the next object read from the input stream default: repl-read - :eval, function of one argument, returns the evaluation of its argument default: eval - :print, function of one argument, prints its argument to the output default: prn - :caught, function of one argument, a throwable, called when read, eval, or print throws an exception or error default: repl-caught" [& options] (let [cl (.getContextClassLoader (Thread/currentThread))] (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl))) (let [{:keys [init need-prompt prompt flush read eval print caught] :or {init #() need-prompt (if (instance? LineNumberingPushbackReader *in*) #(.atLineStart ^LineNumberingPushbackReader *in*) #(identity true)) prompt repl-prompt flush flush read repl-read eval eval print prn caught repl-caught}} (apply hash-map options) request-prompt (Object.) request-exit (Object.) read-eval-print (fn [] (try (let [read-eval *read-eval* input (with-read-known (read request-prompt request-exit))] (or (#{request-prompt request-exit} input) (let [value (binding [*read-eval* read-eval] (eval input))] (print value) (set! *3 *2) (set! *2 *1) (set! *1 value)))) (catch Throwable e (caught e) (set! *e e))))] (with-bindings (try (init) (catch Throwable e (caught e) (set! *e e))) (prompt) (flush) (loop [] (when-not (try (identical? (read-eval-print) request-exit) (catch Throwable e (caught e) (set! *e e) nil)) (when (need-prompt) (prompt) (flush)) (recur)))))) (defn load-script "Loads Clojure source from a file or resource given its path. Paths beginning with @ or @/ are considered relative to classpath." [^String path] (if (.startsWith path "@") (RT/loadResourceScript (.substring path (if (.startsWith path "@/") 2 1))) (Compiler/loadFile path))) (defn- init-opt "Load a script" [path] (load-script path)) (defn- eval-opt "Evals expressions in str, prints each non-nil result using prn" [str] (let [eof (Object.) reader (LineNumberingPushbackReader. (java.io.StringReader. str))] (loop [input (with-read-known (read reader false eof))] (when-not (= input eof) (let [value (eval input)] (when-not (nil? value) (prn value)) (recur (with-read-known (read reader false eof)))))))) (defn- init-dispatch "Returns the handler associated with an init opt" [opt] ({"-i" init-opt "--init" init-opt "-e" eval-opt "--eval" eval-opt} opt)) (defn- initialize "Common initialize routine for repl, script, and null opts" [args inits] (in-ns 'user) (set! *command-line-args* args) (doseq [[opt arg] inits] ((init-dispatch opt) arg))) (defn- main-opt "Call the -main function from a namespace with string arguments from the command line." [[_ main-ns & args] inits] (with-bindings (initialize args inits) (apply (ns-resolve (doto (symbol main-ns) require) '-main) args))) (defn- repl-opt "Start a repl with args and inits. Print greeting if no eval options were present" [[_ & args] inits] (when-not (some #(= eval-opt (init-dispatch (first %))) inits) (println "Clojure" (clojure-version))) (repl :init (fn [] (initialize args inits) (apply require repl-requires))) (prn) (System/exit 0)) (defn- script-opt "Run a script from a file, resource, or standard in with args and inits" [[path & args] inits] (with-bindings (initialize args inits) (if (= path "-") (load-reader *in*) (load-script path)))) (defn- null-opt "No repl or script opt present, just bind args and run inits" [args inits] (with-bindings (initialize args inits))) (defn- help-opt "Print help text for main" [_ _] (println (:doc (meta (var main))))) (defn- main-dispatch "Returns the handler associated with a main option" [opt] (or ({"-r" repl-opt "--repl" repl-opt "-m" main-opt "--main" main-opt nil null-opt "-h" help-opt "--help" help-opt "-?" help-opt} opt) script-opt)) (defn- legacy-repl "Called by the clojure.lang.Repl.main stub to run a repl with args specified the old way" [args] (println "WARNING: clojure.lang.Repl is deprecated. Instead, use clojure.main like this: java -cp clojure.jar clojure.main -i init.clj -r args...") (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits)))) (defn- legacy-script "Called by the clojure.lang.Script.main stub to run a script with args specified the old way" [args] (println "WARNING: clojure.lang.Script is deprecated. Instead, use clojure.main like this: java -cp clojure.jar clojure.main -i init.clj script.clj args...") (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] (null-opt args (map vector (repeat "-i") inits)))) (defn main "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*] With no options or args, runs an interactive Read-Eval-Print Loop init options: -i, --init path Load a file or resource -e, --eval string Evaluate expressions in string; print non-nil values main options: -m, --main ns-name Call the -main function from a namespace with args -r, --repl Run a repl path Run a script from a file or resource - Run a script from standard input -h, -?, --help Print this help message and exit operation: - Establishes thread-local bindings for commonly set!-able vars - Enters the user namespace - Binds *command-line-args* to a seq of strings containing command line args that appear after any main option - Runs all init options in order - Calls a -main function or runs a repl or script if requested The init options may be repeated and mixed freely, but must appear before any main option. The appearance of any eval option before running a repl suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\". Paths may be absolute or relative in the filesystem or relative to classpath. Classpath-relative paths have prefix of @ or @/" [& args] (try (if args (loop [[opt arg & more :as args] args inits []] (if (init-dispatch opt) (recur more (conj inits [opt arg])) ((main-dispatch opt) args inits))) (repl-opt nil nil)) (finally (flush)))) ================================================ FILE: src/clj/clojure/parallel.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "DEPRECATED Wrapper of the ForkJoin library (JSR-166)." :author "Rich Hickey"} clojure.parallel) (alias 'parallel 'clojure.parallel) (comment " The parallel library wraps the ForkJoin library scheduled for inclusion in JDK 7: http://gee.cs.oswego.edu/dl/concurrency-interest/index.html You'll need jsr166y.jar in your classpath in order to use this library. The basic idea is that Clojure collections, and most efficiently vectors, can be turned into parallel arrays for use by this library with the function par, although most of the functions take collections and will call par if needed, so normally you will only need to call par explicitly in order to attach bound/filter/map ops. Parallel arrays support the attachment of bounds, filters and mapping functions prior to realization/calculation, which happens as the result of any of several operations on the array (pvec/psort/pfilter-nils/pfilter-dupes). Rather than perform composite operations in steps, as would normally be done with sequences, maps and filters are instead attached and thus composed by providing ops to par. Note that there is an order sensitivity to the attachments - bounds precede filters precede mappings. All operations then happen in parallel, using multiple threads and a sophisticated work-stealing system supported by fork-join, either when the array is realized, or to perform aggregate operations like preduce/pmin/pmax etc. A parallel array can be realized into a Clojure vector using pvec. ") (import '(jsr166y.forkjoin ParallelArray ParallelArrayWithBounds ParallelArrayWithFilter ParallelArrayWithMapping Ops$Op Ops$BinaryOp Ops$Reducer Ops$Predicate Ops$BinaryPredicate Ops$IntAndObjectPredicate Ops$IntAndObjectToObject)) (defn- op [f] (proxy [Ops$Op] [] (op [x] (f x)))) (defn- binary-op [f] (proxy [Ops$BinaryOp] [] (op [x y] (f x y)))) (defn- int-and-object-to-object [f] (proxy [Ops$IntAndObjectToObject] [] (op [i x] (f x i)))) (defn- reducer [f] (proxy [Ops$Reducer] [] (op [x y] (f x y)))) (defn- predicate [f] (proxy [Ops$Predicate] [] (op [x] (boolean (f x))))) (defn- binary-predicate [f] (proxy [Ops$BinaryPredicate] [] (op [x y] (boolean (f x y))))) (defn- int-and-object-predicate [f] (proxy [Ops$IntAndObjectPredicate] [] (op [i x] (boolean (f x i))))) (defn par "Creates a parallel array from coll. ops, if supplied, perform on-the-fly filtering or transformations during parallel realization or calculation. ops form a chain, and bounds must precede filters, must precede maps. ops must be a set of keyword value pairs of the following forms: :bound [start end] Only elements from start (inclusive) to end (exclusive) will be processed when the array is realized. :filter pred Filter preds remove elements from processing when the array is realized. pred must be a function of one argument whose return will be processed via boolean. :filter-index pred2 pred2 must be a function of two arguments, which will be an element of the collection and the corresponding index, whose return will be processed via boolean. :filter-with [pred2 coll2] pred2 must be a function of two arguments, which will be corresponding elements of the 2 collections. :map f Map fns will be used to transform elements when the array is realized. f must be a function of one argument. :map-index f2 f2 must be a function of two arguments, which will be an element of the collection and the corresponding index. :map-with [f2 coll2] f2 must be a function of two arguments, which will be corresponding elements of the 2 collections." ([coll] (if (instance? ParallelArrayWithMapping coll) coll (. ParallelArray createUsingHandoff (to-array coll) (. ParallelArray defaultExecutor)))) ([coll & ops] (reduce (fn [pa [op args]] (cond (= op :bound) (. pa withBounds (args 0) (args 1)) (= op :filter) (. pa withFilter (predicate args)) (= op :filter-with) (. pa withFilter (binary-predicate (args 0)) (par (args 1))) (= op :filter-index) (. pa withIndexedFilter (int-and-object-predicate args)) (= op :map) (. pa withMapping (parallel/op args)) (= op :map-with) (. pa withMapping (binary-op (args 0)) (par (args 1))) (= op :map-index) (. pa withIndexedMapping (int-and-object-to-object args)) :else (throw (Exception. (str "Unsupported par op: " op))))) (par coll) (partition 2 ops)))) ;;;;;;;;;;;;;;;;;;;;; aggregate operations ;;;;;;;;;;;;;;;;;;;;;; (defn pany "Returns some (random) element of the coll if it satisfies the bound/filter/map" [coll] (. (par coll) any)) (defn pmax "Returns the maximum element, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (. (par coll) max)) ([coll comp] (. (par coll) max comp))) (defn pmin "Returns the minimum element, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (. (par coll) min)) ([coll comp] (. (par coll) min comp))) (defn- summary-map [s] {:min (.min s) :max (.max s) :size (.size s) :min-index (.indexOfMin s) :max-index (.indexOfMax s)}) (defn psummary "Returns a map of summary statistics (min. max, size, min-index, max-index, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (summary-map (. (par coll) summary))) ([coll comp] (summary-map (. (par coll) summary comp)))) (defn preduce "Returns the reduction of the realized elements of coll using function f. Note f will not necessarily be called consecutively, and so must be commutative. Also note that (f base an-element) might be performed many times, i.e. base is not an initial value as with sequential reduce." [f base coll] (. (par coll) (reduce (reducer f) base))) ;;;;;;;;;;;;;;;;;;;;; collection-producing operations ;;;;;;;;;;;;;;;;;;;;;; (defn- pa-to-vec [pa] (vec (. pa getArray))) (defn- pall "Realizes a copy of the coll as a parallel array, with any bounds/filters/maps applied" [coll] (if (instance? ParallelArrayWithMapping coll) (. coll all) (par coll))) (defn pvec "Returns the realized contents of the parallel array pa as a Clojure vector" [pa] (pa-to-vec (pall pa))) (defn pdistinct "Returns a parallel array of the distinct elements of coll" [coll] (pa-to-vec (. (pall coll) allUniqueElements))) ;this doesn't work, passes null to reducer? (defn- pcumulate [coll f init] (.. (pall coll) (precumulate (reducer f) init))) (defn psort "Returns a new vector consisting of the realized items in coll, sorted, presuming Comparable elements, unless a Comparator comp is supplied" ([coll] (pa-to-vec (. (pall coll) sort))) ([coll comp] (pa-to-vec (. (pall coll) sort comp)))) (defn pfilter-nils "Returns a vector containing the non-nil (realized) elements of coll" [coll] (pa-to-vec (. (pall coll) removeNulls))) (defn pfilter-dupes "Returns a vector containing the (realized) elements of coll, without any consecutive duplicates" [coll] (pa-to-vec (. (pall coll) removeConsecutiveDuplicates))) (comment (load-file "src/parallel.clj") (refer 'parallel) (pdistinct [1 2 3 2 1]) ;(pcumulate [1 2 3 2 1] + 0) ;broken, not exposed (def a (make-array Object 1000000)) (dotimes i (count a) (aset a i (rand-int i))) (time (reduce + 0 a)) (time (preduce + 0 a)) (time (count (distinct a))) (time (count (pdistinct a))) (preduce + 0 [1 2 3 2 1]) (preduce + 0 (psort a)) (pvec (par [11 2 3 2] :filter-index (fn [x i] (> i x)))) (pvec (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]])) (psummary ;or pvec/pmax etc (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]] :map #(* % 2))) (preduce + 0 (par [11 2 3 2] :filter-with [< [110 2 33 2]])) (time (reduce + 0 (map #(* % %) (range 1000000)))) (time (preduce + 0 (par (range 1000000) :map-index *))) (def v (range 1000000)) (time (preduce + 0 (par v :map-index *))) (time (preduce + 0 (par v :map #(* % %)))) (time (reduce + 0 (map #(* % %) v))) ) ================================================ FILE: src/clj/clojure/pprint/cl_format.clj ================================================ ;;; cl_format.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements the Common Lisp compatible format function as documented ;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at: ;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) (in-ns 'clojure.pprint) ;;; Forward references (declare compile-format) (declare execute-format) (declare init-navigator) ;;; End forward references (defn cl-format "An implementation of a Common Lisp compatible format function. cl-format formats its arguments to an output stream or string based on the format control string given. It supports sophisticated formatting of structured data. Writer is an instance of java.io.Writer, true to output to *out* or nil to output to a string, format-in is the format control string and the remaining arguments are the data to be formatted. The format control string is a string to be output with embedded 'format directives' describing how to format the various arguments passed in. If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format returns nil. For example: (let [results [46 38 22]] (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" (count results) results)) Prints to *out*: There are 3 results: 46, 38, 22 Detailed documentation on format control strings is available in the \"Common Lisp the Language, 2nd edition\", Chapter 22 (available online at: http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) and in the Common Lisp HyperSpec at http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm " {:added "1.2", :see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" "Common Lisp the Language"] ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" "Common Lisp HyperSpec"]]} [writer format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format writer compiled-format navigator))) (def ^:dynamic ^{:private true} *format-str* nil) (defn- format-error [message offset] (let [full-message (str message \newline *format-str* \newline (apply str (repeat offset \space)) "^" \newline)] (throw (RuntimeException. full-message)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Argument navigators manage the argument list ;;; as the format statement moves through the list ;;; (possibly going forwards and backwards as it does so) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct ^{:private true} arg-navigator :seq :rest :pos ) (defn- init-navigator "Create a new arg-navigator from the sequence with the position set to 0" {:skip-wiki true} [s] (let [s (seq s)] (struct arg-navigator s s 0))) ;; TODO call format-error with offset (defn- next-arg [ navigator ] (let [ rst (:rest navigator) ] (if rst [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] (throw (new Exception "Not enough arguments for format definition"))))) (defn- next-arg-or-nil [navigator] (let [rst (:rest navigator)] (if rst [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] [nil navigator]))) ;; Get an argument off the arg list and compile it if it's not already compiled (defn- get-format-arg [navigator] (let [[raw-format navigator] (next-arg navigator) compiled-format (if (instance? String raw-format) (compile-format raw-format) raw-format)] [compiled-format navigator])) (declare relative-reposition) (defn- absolute-reposition [navigator position] (if (>= position (:pos navigator)) (relative-reposition navigator (- (:pos navigator) position)) (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position))) (defn- relative-reposition [navigator position] (let [newpos (+ (:pos navigator) position)] (if (neg? position) (absolute-reposition navigator newpos) (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos)))) (defstruct ^{:private true} compiled-directive :func :def :params :offset) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; When looking at the parameter list, we may need to manipulate ;;; the argument list as well (for 'V' and '#' parameter types). ;;; We hide all of this behind a function, but clients need to ;;; manage changing arg navigator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: validate parameters when they come from arg list (defn- realize-parameter [[param [raw-val offset]] navigator] (let [[real-param new-navigator] (cond (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary [raw-val navigator] (= raw-val :parameter-from-args) (next-arg navigator) (= raw-val :remaining-arg-count) [(count (:rest navigator)) navigator] true [raw-val navigator])] [[param [real-param offset]] new-navigator])) (defn- realize-parameter-list [parameter-map navigator] (let [[pairs new-navigator] (map-passing-context realize-parameter navigator parameter-map)] [(into {} pairs) new-navigator])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions that support individual directives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Common handling code for ~A and ~S ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare opt-base-str) (def ^{:private true} special-radix-markers {2 "#b" 8 "#o", 16 "#x"}) (defn- format-simple-number [n] (cond (integer? n) (if (= *print-base* 10) (str n (if *print-radix* ".")) (str (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) (opt-base-str *print-base* n))) (ratio? n) (str (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) (opt-base-str *print-base* (.numerator n)) "/" (opt-base-str *print-base* (.denominator n))) :else nil)) (defn- format-ascii [print-func params arg-navigator offsets] (let [ [arg arg-navigator] (next-arg arg-navigator) ^String base-output (or (format-simple-number arg) (print-func arg)) base-width (.length base-output) min-width (+ base-width (:minpad params)) width (if (>= min-width (:mincol params)) min-width (+ min-width (* (+ (quot (- (:mincol params) min-width 1) (:colinc params) ) 1) (:colinc params)))) chars (apply str (repeat (- width base-width) (:padchar params)))] (if (:at params) (print (str chars base-output)) (print (str base-output chars))) arg-navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the integer directives ~D, ~X, ~O, ~B and some ;;; of ~R ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- integral? "returns true if a number is actually an integer (that is, has no fractional part)" [x] (cond (integer? x) true (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part (float? x) (= x (Math/floor x)) (ratio? x) (let [^clojure.lang.Ratio r x] (= 0 (rem (.numerator r) (.denominator r)))) :else false)) (defn- remainders "Return the list of remainders (essentially the 'digits') of val in the given base" [base val] (reverse (first (consume #(if (pos? %) [(rem % base) (quot % base)] [nil nil]) val)))) ;;; TODO: xlated-val does not seem to be used here. (defn- base-str "Return val as a string in the given base" [base val] (if (zero? val) "0" (let [xlated-val (cond (float? val) (bigdec val) (ratio? val) (let [^clojure.lang.Ratio r val] (/ (.numerator r) (.denominator r))) :else val)] (apply str (map #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) (remainders base val)))))) (def ^{:private true} java-base-formats {8 "%o", 10 "%d", 16 "%x"}) (defn- opt-base-str "Return val as a string in the given base, using clojure.core/format if supported for improved performance" [base val] (let [format-str (get java-base-formats base)] (if (and format-str (integer? val) (not (instance? clojure.lang.BigInt val))) (clojure.core/format format-str val) (base-str base val)))) (defn- group-by* [unit lis] (reverse (first (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis))))) (defn- format-integer [base params arg-navigator offsets] (let [[arg arg-navigator] (next-arg arg-navigator)] (if (integral? arg) (let [neg (neg? arg) pos-arg (if neg (- arg) arg) raw-str (opt-base-str base pos-arg) group-str (if (:colon params) (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str)) commas (repeat (count groups) (:commachar params))] (apply str (next (interleave commas groups)))) raw-str) ^String signed-str (cond neg (str "-" group-str) (:at params) (str "+" group-str) true group-str) padded-str (if (< (.length signed-str) (:mincol params)) (str (apply str (repeat (- (:mincol params) (.length signed-str)) (:padchar params))) signed-str) signed-str)] (print padded-str)) (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 :padchar (:padchar params) :at true} (init-navigator [arg]) nil)) arg-navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for english formats (~R and ~:R) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} english-cardinal-units ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"]) (def ^{:private true} english-ordinal-units ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth" "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"]) (def ^{:private true} english-cardinal-tens ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"]) (def ^{:private true} english-ordinal-tens ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth" "seventieth" "eightieth" "ninetieth"]) ;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales) ;; Number names from http://www.jimloy.com/math/billion.htm ;; We follow the rules for writing numbers from the Blue Book ;; (http://www.grammarbook.com/numbers/numbers.asp) (def ^{:private true} english-scale-numbers ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" "sextillion" "septillion" "octillion" "nonillion" "decillion" "undecillion" "duodecillion" "tredecillion" "quattuordecillion" "quindecillion" "sexdecillion" "septendecillion" "octodecillion" "novemdecillion" "vigintillion"]) (defn- format-simple-cardinal "Convert a number less than 1000 to a cardinal english string" [num] (let [hundreds (quot num 100) tens (rem num 100)] (str (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) (if (and (pos? hundreds) (pos? tens)) " ") (if (pos? tens) (if (< tens 20) (nth english-cardinal-units tens) (let [ten-digit (quot tens 10) unit-digit (rem tens 10)] (str (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) (if (and (pos? ten-digit) (pos? unit-digit)) "-") (if (pos? unit-digit) (nth english-cardinal-units unit-digit))))))))) (defn- add-english-scales "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string offset is a factor of 10^3 to multiply by" [parts offset] (let [cnt (count parts)] (loop [acc [] pos (dec cnt) this (first parts) remainder (next parts)] (if (nil? remainder) (str (apply str (interpose ", " acc)) (if (and (not (empty? this)) (not (empty? acc))) ", ") this (if (and (not (empty? this)) (pos? (+ pos offset))) (str " " (nth english-scale-numbers (+ pos offset))))) (recur (if (empty? this) acc (conj acc (str this " " (nth english-scale-numbers (+ pos offset))))) (dec pos) (first remainder) (next remainder)))))) (defn- format-cardinal-english [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (= 0 arg) (print "zero") (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs parts (remainders 1000 abs-arg)] (if (<= (count parts) (count english-scale-numbers)) (let [parts-strs (map format-simple-cardinal parts) full-str (add-english-scales parts-strs 0)] (print (str (if (neg? arg) "minus ") full-str))) (format-integer ;; for numbers > 10^63, we fall back on ~D 10 { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} (init-navigator [arg]) { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})))) navigator)) (defn- format-simple-ordinal "Convert a number less than 1000 to a ordinal english string Note this should only be used for the last one in the sequence" [num] (let [hundreds (quot num 100) tens (rem num 100)] (str (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) (if (and (pos? hundreds) (pos? tens)) " ") (if (pos? tens) (if (< tens 20) (nth english-ordinal-units tens) (let [ten-digit (quot tens 10) unit-digit (rem tens 10)] (if (and (pos? ten-digit) (not (pos? unit-digit))) (nth english-ordinal-tens ten-digit) (str (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) (if (and (pos? ten-digit) (pos? unit-digit)) "-") (if (pos? unit-digit) (nth english-ordinal-units unit-digit)))))) (if (pos? hundreds) "th"))))) (defn- format-ordinal-english [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (= 0 arg) (print "zeroth") (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs parts (remainders 1000 abs-arg)] (if (<= (count parts) (count english-scale-numbers)) (let [parts-strs (map format-simple-cardinal (drop-last parts)) head-str (add-english-scales parts-strs 1) tail-str (format-simple-ordinal (last parts))] (print (str (if (neg? arg) "minus ") (cond (and (not (empty? head-str)) (not (empty? tail-str))) (str head-str ", " tail-str) (not (empty? head-str)) (str head-str "th") :else tail-str)))) (do (format-integer ;; for numbers > 10^63, we fall back on ~D 10 { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} (init-navigator [arg]) { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}) (let [low-two-digits (rem arg 100) not-teens (or (< 11 low-two-digits) (> 19 low-two-digits)) low-digit (rem low-two-digits 10)] (print (cond (and (== low-digit 1) not-teens) "st" (and (== low-digit 2) not-teens) "nd" (and (== low-digit 3) not-teens) "rd" :else "th"))))))) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for roman numeral formats (~@R and ~@:R) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} old-roman-table [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"] [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"] [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"] [ "M" "MM" "MMM"]]) (def ^{:private true} new-roman-table [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"] [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"] [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"] [ "M" "MM" "MMM"]]) (defn- format-roman "Format a roman numeral using the specified look-up table" [table params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (and (number? arg) (> arg 0) (< arg 4000)) (let [digits (remainders 10 arg)] (loop [acc [] pos (dec (count digits)) digits digits] (if (empty? digits) (print (apply str acc)) (let [digit (first digits)] (recur (if (= 0 digit) acc (conj acc (nth (nth table pos) (dec digit)))) (dec pos) (next digits)))))) (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D 10 { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} (init-navigator [arg]) { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})) navigator)) (defn- format-old-roman [params navigator offsets] (format-roman old-roman-table params navigator offsets)) (defn- format-new-roman [params navigator offsets] (format-roman new-roman-table params navigator offsets)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for character formats (~C) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} special-chars { 8 "Backspace", 9 "Tab", 10 "Newline", 13 "Return", 32 "Space"}) (defn- pretty-character [params navigator offsets] (let [[c navigator] (next-arg navigator) as-int (int c) base-char (bit-and as-int 127) meta (bit-and as-int 128) special (get special-chars base-char)] (if (> meta 0) (print "Meta-")) (print (cond special special (< base-char 32) (str "Control-" (char (+ base-char 64))) (= base-char 127) "Control-?" :else (char base-char))) navigator)) (defn- readable-character [params navigator offsets] (let [[c navigator] (next-arg navigator)] (condp = (:char-format params) \o (cl-format true "\\o~3,'0o" (int c)) \u (cl-format true "\\u~4,'0x" (int c)) nil (pr c)) navigator)) (defn- plain-character [params navigator offsets] (let [[char navigator] (next-arg navigator)] (print char) navigator)) ;; Check to see if a result is an abort (~^) construct ;; TODO: move these funcs somewhere more appropriate (defn- abort? [context] (let [token (first context)] (or (= :up-arrow token) (= :colon-up-arrow token)))) ;; Handle the execution of "sub-clauses" in bracket constructions (defn- execute-sub-format [format args base-args] (second (map-passing-context (fn [element context] (if (abort? context) [nil context] ; just keep passing it along (let [[params args] (realize-parameter-list (:params element) context) [params offsets] (unzip-map params) params (assoc params :base-args base-args)] [nil (apply (:func element) [params args offsets])]))) args format))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for real number formats ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO - return exponent as int to eliminate double conversion (defn- float-parts-base "Produce string parts for the mantissa (normalized 1-9) and exponent" [^Object f] (let [^String s (.toLowerCase (.toString f)) exploc (.indexOf s (int \e)) dotloc (.indexOf s (int \.))] (if (neg? exploc) (if (neg? dotloc) [s (str (dec (count s)))] [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))]) (if (neg? dotloc) [(subs s 0 exploc) (subs s (inc exploc))] [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))])))) (defn- float-parts "Take care of leading and trailing zeros in decomposed floats" [f] (let [[m ^String e] (float-parts-base f) m1 (rtrim m \0) m2 (ltrim m1 \0) delta (- (count m1) (count m2)) ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)] (if (empty? m2) ["0" 0] [m2 (- (Integer/valueOf e) delta)]))) (defn- ^String inc-s "Assumption: The input string consists of one or more decimal digits, and no other characters. Return a string containing one or more decimal digits containing a decimal number one larger than the input string. The output string will always be the same length as the input string, or one character longer." [^String s] (let [len-1 (dec (count s))] (loop [i (int len-1)] (cond (neg? i) (apply str "1" (repeat (inc len-1) "0")) (= \9 (.charAt s i)) (recur (dec i)) :else (apply str (subs s 0 i) (char (inc (int (.charAt s i)))) (repeat (- len-1 i) "0")))))) (defn- round-str [m e d w] (if (or d w) (let [len (count m) ;; Every formatted floating point number should include at ;; least one decimal digit and a decimal point. w (if w (max 2 w)) round-pos (cond ;; If d was given, that forces the rounding ;; position, regardless of any width that may ;; have been specified. d (+ e d 1) ;; Otherwise w was specified, so pick round-pos ;; based upon that. ;; If e>=0, then abs value of number is >= 1.0, ;; and e+1 is number of decimal digits before the ;; decimal point when the number is written ;; without scientific notation. Never round the ;; number before the decimal point. (>= e 0) (max (inc e) (dec w)) ;; e < 0, so number abs value < 1.0 :else (+ w e)) [m1 e1 round-pos len] (if (= round-pos 0) [(str "0" m) (inc e) 1 (inc len)] [m e round-pos len])] (if round-pos (if (neg? round-pos) ["0" 0 false] (if (> len round-pos) (let [round-char (nth m1 round-pos) ^String result (subs m1 0 round-pos)] (if (>= (int round-char) (int \5)) (let [round-up-result (inc-s result) expanded (> (count round-up-result) (count result))] [(if expanded (subs round-up-result 0 (dec (count round-up-result))) round-up-result) e1 expanded]) [result e1 false])) [m e false])) [m e false])) [m e false])) (defn- expand-fixed [m e d] (let [[m1 e1] (if (neg? e) [(str (apply str (repeat (dec (- e)) \0)) m) -1] [m e]) len (count m1) target-len (if d (+ e1 d 1) (inc e1))] (if (< len target-len) (str m1 (apply str (repeat (- target-len len) \0))) m1))) (defn- insert-decimal "Insert the decimal point at the right spot in the number to match an exponent" [m e] (if (neg? e) (str "." m) (let [loc (inc e)] (str (subs m 0 loc) "." (subs m loc))))) (defn- get-fixed [m e d] (insert-decimal (expand-fixed m e d) e)) (defn- insert-scaled-decimal "Insert the decimal point at the right spot in the number to match an exponent" [m k] (if (neg? k) (str "." m) (str (subs m 0 k) "." (subs m k)))) (defn- convert-ratio [x] (if (ratio? x) ;; Usually convert to a double, only resorting to the slower ;; bigdec conversion if the result does not fit within the range ;; of a double. (let [d (double x)] (if (== d 0.0) (if (not= x 0) (bigdec x) d) (if (or (== d Double/POSITIVE_INFINITY) (== d Double/NEGATIVE_INFINITY)) (bigdec x) d))) x)) ;; the function to render ~F directives ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases (defn- fixed-float [params navigator offsets] (let [w (:w params) d (:d params) [arg navigator] (next-arg navigator) [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg]) abs (convert-ratio abs) [mantissa exp] (float-parts abs) scaled-exp (+ exp (:k params)) add-sign (or (:at params) (neg? arg)) append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp)) [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp d (if w (- w (if add-sign 1 0)))) fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) fixed-repr (if (and w d (>= d 1) (= (.charAt fixed-repr 0) \0) (= (.charAt fixed-repr 1) \.) (> (count fixed-repr) (- w (if add-sign 1 0)))) (subs fixed-repr 1) ; chop off leading 0 fixed-repr) prepend-zero (= (first fixed-repr) \.)] (if w (let [len (count fixed-repr) signed-len (if add-sign (inc len) len) prepend-zero (and prepend-zero (not (>= signed-len w))) append-zero (and append-zero (not (>= signed-len w))) full-len (if (or prepend-zero append-zero) (inc signed-len) signed-len)] (if (and (> full-len w) (:overflowchar params)) (print (apply str (repeat w (:overflowchar params)))) (print (str (apply str (repeat (- w full-len) (:padchar params))) (if add-sign sign) (if prepend-zero "0") fixed-repr (if append-zero "0"))))) (print (str (if add-sign sign) (if prepend-zero "0") fixed-repr (if append-zero "0")))) navigator)) ;; the function to render ~E directives ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases ;; TODO: define ~E representation for Infinity (defn- exponential-float [params navigator offsets] (let [[arg navigator] (next-arg navigator) arg (convert-ratio arg)] (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))] (let [w (:w params) d (:d params) e (:e params) k (:k params) expchar (or (:exponentchar params) \E) add-sign (or (:at params) (neg? arg)) prepend-zero (<= k 0) ^Integer scaled-exp (- exp (dec k)) scaled-exp-str (str (Math/abs scaled-exp)) scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) (if e (apply str (repeat (- e (count scaled-exp-str)) \0))) scaled-exp-str) exp-width (count scaled-exp-str) base-mantissa-width (count mantissa) scaled-mantissa (str (apply str (repeat (- k) \0)) mantissa (if d (apply str (repeat (- d (dec base-mantissa-width) (if (neg? k) (- k) 0)) \0)))) w-mantissa (if w (- w exp-width)) [rounded-mantissa _ incr-exp] (round-str scaled-mantissa 0 (cond (= k 0) (dec d) (pos? k) d (neg? k) (dec d)) (if w-mantissa (- w-mantissa (if add-sign 1 0)))) full-mantissa (insert-scaled-decimal rounded-mantissa k) append-zero (and (= k (count rounded-mantissa)) (nil? d))] (if (not incr-exp) (if w (let [len (+ (count full-mantissa) exp-width) signed-len (if add-sign (inc len) len) prepend-zero (and prepend-zero (not (= signed-len w))) full-len (if prepend-zero (inc signed-len) signed-len) append-zero (and append-zero (< full-len w))] (if (and (or (> full-len w) (and e (> (- exp-width 2) e))) (:overflowchar params)) (print (apply str (repeat w (:overflowchar params)))) (print (str (apply str (repeat (- w full-len (if append-zero 1 0) ) (:padchar params))) (if add-sign (if (neg? arg) \- \+)) (if prepend-zero "0") full-mantissa (if append-zero "0") scaled-exp-str)))) (print (str (if add-sign (if (neg? arg) \- \+)) (if prepend-zero "0") full-mantissa (if append-zero "0") scaled-exp-str))) (recur [rounded-mantissa (inc exp)])))) navigator)) ;; the function to render ~G directives ;; This just figures out whether to pass the request off to ~F or ~E based ;; on the algorithm in CLtL. ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases ;; TODO: refactor so that float-parts isn't called twice (defn- general-float [params navigator offsets] (let [[arg _] (next-arg navigator) arg (convert-ratio arg) [mantissa exp] (float-parts (if (neg? arg) (- arg) arg)) w (:w params) d (:d params) e (:e params) n (if (= arg 0.0) 0 (inc exp)) ee (if e (+ e 2) 4) ww (if w (- w ee)) d (if d d (max (count mantissa) (min n 7))) dd (- d n)] (if (<= 0 dd d) (let [navigator (fixed-float {:w ww, :d dd, :k 0, :overflowchar (:overflowchar params), :padchar (:padchar params), :at (:at params)} navigator offsets)] (print (apply str (repeat ee \space))) navigator) (exponential-float params navigator offsets)))) ;; the function to render ~$ directives ;; TODO: support rationals. Back off to ~D/~A is the appropriate cases (defn- dollar-float [params navigator offsets] (let [[^Double arg navigator] (next-arg navigator) [mantissa exp] (float-parts (Math/abs arg)) d (:d params) ; digits after the decimal n (:n params) ; minimum digits before the decimal w (:w params) ; minimum field width add-sign (or (:at params) (neg? arg)) [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil) ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr) full-len (+ (count full-repr) (if add-sign 1 0))] (print (str (if (and (:colon params) add-sign) (if (neg? arg) \- \+)) (apply str (repeat (- w full-len) (:padchar params))) (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+)) full-repr)) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the '~[...~]' conditional construct in its ;;; different flavors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ~[...~] without any modifiers chooses one of the clauses based on the param or ;; next argument ;; TODO check arg is positive int (defn- choice-conditional [params arg-navigator offsets] (let [arg (:selector params) [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator)) clauses (:clauses params) clause (if (or (neg? arg) (>= arg (count clauses))) (first (:else params)) (nth clauses arg))] (if clause (execute-sub-format clause navigator (:base-args params)) navigator))) ;; ~:[...~] with the colon reads the next argument treating it as a truth value (defn- boolean-conditional [params arg-navigator offsets] (let [[arg navigator] (next-arg arg-navigator) clauses (:clauses params) clause (if arg (second clauses) (first clauses))] (if clause (execute-sub-format clause navigator (:base-args params)) navigator))) ;; ~@[...~] with the at sign executes the conditional if the next arg is not ;; nil/false without consuming the arg (defn- check-arg-conditional [params arg-navigator offsets] (let [[arg navigator] (next-arg arg-navigator) clauses (:clauses params) clause (if arg (first clauses))] (if arg (if clause (execute-sub-format clause arg-navigator (:base-args params)) arg-navigator) navigator))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the '~{...~}' iteration construct in its ;;; different flavors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ~{...~} without any modifiers uses the next argument as an argument list that ;; is consumed by all the iterations (defn- iterate-sublist [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator]) [arg-list navigator] (next-arg navigator) args (init-navigator arg-list)] (loop [count 0 args args last-pos (num -1)] (if (and (not max-count) (= (:pos args) last-pos) (> count 1)) ;; TODO get the offset in here and call format exception (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!"))) (if (or (and (empty? (:rest args)) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [iter-result (execute-sub-format clause args (:base-args params))] (if (= :up-arrow (first iter-result)) navigator (recur (inc count) iter-result (:pos args)))))))) ;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the ;; sublists is used as the arglist for a single iteration. (defn- iterate-list-of-sublists [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator]) [arg-list navigator] (next-arg navigator)] (loop [count 0 arg-list arg-list] (if (or (and (empty? arg-list) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [iter-result (execute-sub-format clause (init-navigator (first arg-list)) (init-navigator (next arg-list)))] (if (= :colon-up-arrow (first iter-result)) navigator (recur (inc count) (next arg-list)))))))) ;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations ;; is consumed by all the iterations (defn- iterate-main-list [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator])] (loop [count 0 navigator navigator last-pos (num -1)] (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1)) ;; TODO get the offset in here and call format exception (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!"))) (if (or (and (empty? (:rest navigator)) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [iter-result (execute-sub-format clause navigator (:base-args params))] (if (= :up-arrow (first iter-result)) (second iter-result) (recur (inc count) iter-result (:pos navigator)))))))) ;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one ;; of which is consumed with each iteration (defn- iterate-main-sublists [params navigator offsets] (let [max-count (:max-iterations params) param-clause (first (:clauses params)) [clause navigator] (if (empty? param-clause) (get-format-arg navigator) [param-clause navigator]) ] (loop [count 0 navigator navigator] (if (or (and (empty? (:rest navigator)) (or (not (:colon (:right-params params))) (> count 0))) (and max-count (>= count max-count))) navigator (let [[sublist navigator] (next-arg-or-nil navigator) iter-result (execute-sub-format clause (init-navigator sublist) navigator)] (if (= :colon-up-arrow (first iter-result)) navigator (recur (inc count) navigator))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The '~< directive has two completely different meanings ;;; in the '~<...~>' form it does justification, but with ;;; ~<...~:>' it represents the logical block operation of the ;;; pretty printer. ;;; ;;; Unfortunately, the current architecture decides what function ;;; to call at form parsing time before the sub-clauses have been ;;; folded, so it is left to run-time to make the decision. ;;; ;;; TODO: make it possible to make these decisions at compile-time. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare format-logical-block) (declare justify-clauses) (defn- logical-block-or-justify [params navigator offsets] (if (:colon (:right-params params)) (format-logical-block params navigator offsets) (justify-clauses params navigator offsets))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for the '~<...~>' justification directive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- render-clauses [clauses navigator base-navigator] (loop [clauses clauses acc [] navigator navigator] (if (empty? clauses) [acc navigator] (let [clause (first clauses) [iter-result result-str] (binding [*out* (java.io.StringWriter.)] [(execute-sub-format clause navigator base-navigator) (.toString *out*)])] (if (= :up-arrow (first iter-result)) [acc (second iter-result)] (recur (next clauses) (conj acc result-str) iter-result)))))) ;; TODO support for ~:; constructions (defn- justify-clauses [params navigator offsets] (let [[[eol-str] new-navigator] (when-let [else (:else params)] (render-clauses else navigator (:base-args params))) navigator (or new-navigator navigator) [else-params new-navigator] (when-let [p (:else-params params)] (realize-parameter-list p navigator)) navigator (or new-navigator navigator) min-remaining (or (first (:min-remaining else-params)) 0) max-columns (or (first (:max-columns else-params)) (get-max-column *out*)) clauses (:clauses params) [strs navigator] (render-clauses clauses navigator (:base-args params)) slots (max 1 (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0))) chars (reduce + (map count strs)) mincol (:mincol params) minpad (:minpad params) colinc (:colinc params) minout (+ chars (* slots minpad)) result-columns (if (<= minout mincol) mincol (+ mincol (* colinc (+ 1 (quot (- minout mincol 1) colinc))))) total-pad (- result-columns chars) pad (max minpad (quot total-pad slots)) extra-pad (- total-pad (* pad slots)) pad-str (apply str (repeat pad (:padchar params)))] (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) max-columns)) (print eol-str)) (loop [slots slots extra-pad extra-pad strs strs pad-only (or (:colon params) (and (= (count strs) 1) (not (:at params))))] (if (seq strs) (do (print (str (if (not pad-only) (first strs)) (if (or pad-only (next strs) (:at params)) pad-str) (if (pos? extra-pad) (:padchar params)))) (recur (dec slots) (dec extra-pad) (if pad-only strs (next strs)) false)))) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for case modification with ~(...~). ;;; We do this by wrapping the underlying writer with ;;; a special writer to do the appropriate modification. This ;;; allows us to support arbitrary-sized output and sources ;;; that may block. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- downcase-writer "Returns a proxy that wraps writer, converting all characters to lower case" [^java.io.Writer writer] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s ^String x] (.write writer (.toLowerCase s))) Integer (let [c ^Character x] (.write writer (int (Character/toLowerCase (char c)))))))))) (defn- upcase-writer "Returns a proxy that wraps writer, converting all characters to upper case" [^java.io.Writer writer] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s ^String x] (.write writer (.toUpperCase s))) Integer (let [c ^Character x] (.write writer (int (Character/toUpperCase (char c)))))))))) (defn- capitalize-string "Capitalizes the words in a string. If first? is false, don't capitalize the first character of the string even if it's a letter." [s first?] (let [^Character f (first s) s (if (and first? f (Character/isLetter f)) (str (Character/toUpperCase f) (subs s 1)) s)] (apply str (first (consume (fn [s] (if (empty? s) [nil nil] (let [m (re-matcher #"\W\w" s) match (re-find m) offset (and match (inc (.start m)))] (if offset [(str (subs s 0 offset) (Character/toUpperCase ^Character (nth s offset))) (subs s (inc offset))] [s nil])))) s))))) (defn- capitalize-word-writer "Returns a proxy that wraps writer, capitalizing all words" [^java.io.Writer writer] (let [last-was-whitespace? (ref true)] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s ^String x] (.write writer ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?)) (when (pos? (.length s)) (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (nth s (dec (count s)))))))) Integer (let [c (char x)] (let [mod-c (if @last-was-whitespace? (Character/toUpperCase (char x)) c)] (.write writer (int mod-c)) (dosync (ref-set last-was-whitespace? (Character/isWhitespace (char x)))))))))))) (defn- init-cap-writer "Returns a proxy that wraps writer, capitalizing the first word" [^java.io.Writer writer] (let [capped (ref false)] (proxy [java.io.Writer] [] (close [] (.close writer)) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (.write writer cbuf off len)) ([x] (condp = (class x) String (let [s (.toLowerCase ^String x)] (if (not @capped) (let [m (re-matcher #"\S" s) match (re-find m) offset (and match (.start m))] (if offset (do (.write writer (str (subs s 0 offset) (Character/toUpperCase ^Character (nth s offset)) (.toLowerCase ^String (subs s (inc offset))))) (dosync (ref-set capped true))) (.write writer s))) (.write writer (.toLowerCase s)))) Integer (let [c ^Character (char x)] (if (and (not @capped) (Character/isLetter c)) (do (dosync (ref-set capped true)) (.write writer (int (Character/toUpperCase c)))) (.write writer (int (Character/toLowerCase c))))))))))) (defn- modify-case [make-writer params navigator offsets] (let [clause (first (:clauses params))] (binding [*out* (make-writer *out*)] (execute-sub-format clause navigator (:base-args params))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; If necessary, wrap the writer in a PrettyWriter object ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn get-pretty-writer "Returns the java.io.Writer passed in wrapped in a pretty writer proxy, unless it's already a pretty writer. Generally, it is unnecessary to call this function, since pprint, write, and cl-format all call it if they need to. However if you want the state to be preserved across calls, you will want to wrap them with this. For example, when you want to generate column-aware output with multiple calls to cl-format, do it like in this example: (defn print-table [aseq column-width] (binding [*out* (get-pretty-writer *out*)] (doseq [row aseq] (doseq [col row] (cl-format true \"~4D~7,vT\" col column-width)) (prn)))) Now when you run: user> (print-table (map #(vector % (* % %) (* % % %)) (range 1 11)) 8) It prints a table of squares and cubes for the numbers from 1 to 10: 1 1 1 2 4 8 3 9 27 4 16 64 5 25 125 6 36 216 7 49 343 8 64 512 9 81 729 10 100 1000" {:added "1.2"} [writer] (if (pretty-writer? writer) writer (pretty-writer writer *print-right-margin* *print-miser-width*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for column-aware operations ~&, ~T ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn fresh-line "Make a newline if *out* is not already at the beginning of the line. If *out* is not a pretty writer (which keeps track of columns), this function always outputs a newline." {:added "1.2"} [] (if (instance? clojure.lang.IDeref *out*) (if (not (= 0 (get-column (:base @@*out*)))) (prn)) (prn))) (defn- absolute-tabulation [params navigator offsets] (let [colnum (:colnum params) colinc (:colinc params) current (get-column (:base @@*out*)) space-count (cond (< current colnum) (- colnum current) (= colinc 0) 0 :else (- colinc (rem (- current colnum) colinc)))] (print (apply str (repeat space-count \space)))) navigator) (defn- relative-tabulation [params navigator offsets] (let [colrel (:colnum params) colinc (:colinc params) start-col (+ colrel (get-column (:base @@*out*))) offset (if (pos? colinc) (rem start-col colinc) 0) space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))] (print (apply str (repeat space-count \space)))) navigator) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Support for accessing the pretty printer from a format ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: support ~@; per-line-prefix separator ;; TODO: get the whole format wrapped so we can start the lb at any column (defn- format-logical-block [params navigator offsets] (let [clauses (:clauses params) clause-count (count clauses) prefix (cond (> clause-count 1) (:string (:params (first (first clauses)))) (:colon params) "(") body (nth clauses (if (> clause-count 1) 1 0)) suffix (cond (> clause-count 2) (:string (:params (first (nth clauses 2)))) (:colon params) ")") [arg navigator] (next-arg navigator)] (pprint-logical-block :prefix prefix :suffix suffix (execute-sub-format body (init-navigator arg) (:base-args params))) navigator)) (defn- set-indent [params navigator offsets] (let [relative-to (if (:colon params) :current :block)] (pprint-indent relative-to (:n params)) navigator)) ;;; TODO: support ~:T section options for ~T (defn- conditional-newline [params navigator offsets] (let [kind (if (:colon params) (if (:at params) :mandatory :fill) (if (:at params) :miser :linear))] (pprint-newline kind) navigator)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The table of directives we support, each with its params, ;;; properties, and the compilation function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; We start with a couple of helpers (defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ] [char, {:directive char, :params `(array-map ~@params), :flags flags, :bracket-info bracket-info, :generator-fn (concat '(fn [ params offset]) generator-fn) }]) (defmacro ^{:private true} defdirectives [ & directives ] `(def ^{:private true} directive-table (hash-map ~@(mapcat process-directive-table-element directives)))) (defdirectives (\A [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] #{ :at :colon :both} {} #(format-ascii print-str %1 %2 %3)) (\S [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] #{ :at :colon :both} {} #(format-ascii pr-str %1 %2 %3)) (\D [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 10 %1 %2 %3)) (\B [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 2 %1 %2 %3)) (\O [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 8 %1 %2 %3)) (\X [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} #(format-integer 16 %1 %2 %3)) (\R [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] :commainterval [ 3 Integer]] #{ :at :colon :both } {} (do (cond ; ~R is overloaded with bizareness (first (:base params)) #(format-integer (:base %1) %1 %2 %3) (and (:at params) (:colon params)) #(format-old-roman %1 %2 %3) (:at params) #(format-new-roman %1 %2 %3) (:colon params) #(format-ordinal-english %1 %2 %3) true #(format-cardinal-english %1 %2 %3)))) (\P [ ] #{ :at :colon :both } {} (fn [params navigator offsets] (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator) strs (if (:at params) ["y" "ies"] ["" "s"]) [arg navigator] (next-arg navigator)] (print (if (= arg 1) (first strs) (second strs))) navigator))) (\C [:char-format [nil Character]] #{ :at :colon :both } {} (cond (:colon params) pretty-character (:at params) readable-character :else plain-character)) (\F [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] :padchar [\space Character] ] #{ :at } {} fixed-float) (\E [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] :overflowchar [nil Character] :padchar [\space Character] :exponentchar [nil Character] ] #{ :at } {} exponential-float) (\G [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] :overflowchar [nil Character] :padchar [\space Character] :exponentchar [nil Character] ] #{ :at } {} general-float) (\$ [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]] #{ :at :colon :both} {} dollar-float) (\% [ :count [1 Integer] ] #{ } {} (fn [params arg-navigator offsets] (dotimes [i (:count params)] (prn)) arg-navigator)) (\& [ :count [1 Integer] ] #{ :pretty } {} (fn [params arg-navigator offsets] (let [cnt (:count params)] (if (pos? cnt) (fresh-line)) (dotimes [i (dec cnt)] (prn))) arg-navigator)) (\| [ :count [1 Integer] ] #{ } {} (fn [params arg-navigator offsets] (dotimes [i (:count params)] (print \formfeed)) arg-navigator)) (\~ [ :n [1 Integer] ] #{ } {} (fn [params arg-navigator offsets] (let [n (:n params)] (print (apply str (repeat n \~))) arg-navigator))) (\newline ;; Whitespace supression is handled in the compilation loop [ ] #{:colon :at} {} (fn [params arg-navigator offsets] (if (:at params) (prn)) arg-navigator)) (\T [ :colnum [1 Integer] :colinc [1 Integer] ] #{ :at :pretty } {} (if (:at params) #(relative-tabulation %1 %2 %3) #(absolute-tabulation %1 %2 %3))) (\* [ :n [1 Integer] ] #{ :colon :at } {} (fn [params navigator offsets] (let [n (:n params)] (if (:at params) (absolute-reposition navigator n) (relative-reposition navigator (if (:colon params) (- n) n))) ))) (\? [ ] #{ :at } {} (if (:at params) (fn [params navigator offsets] ; args from main arg list (let [[subformat navigator] (get-format-arg navigator)] (execute-sub-format subformat navigator (:base-args params)))) (fn [params navigator offsets] ; args from sub-list (let [[subformat navigator] (get-format-arg navigator) [subargs navigator] (next-arg navigator) sub-navigator (init-navigator subargs)] (execute-sub-format subformat sub-navigator (:base-args params)) navigator)))) (\( [ ] #{ :colon :at :both} { :right \), :allows-separator nil, :else nil } (let [mod-case-writer (cond (and (:at params) (:colon params)) upcase-writer (:colon params) capitalize-word-writer (:at params) init-cap-writer :else downcase-writer)] #(modify-case mod-case-writer %1 %2 %3))) (\) [] #{} {} nil) (\[ [ :selector [nil Integer] ] #{ :colon :at } { :right \], :allows-separator true, :else :last } (cond (:colon params) boolean-conditional (:at params) check-arg-conditional true choice-conditional)) (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] #{ :colon } { :separator true } nil) (\] [] #{} {} nil) (\{ [ :max-iterations [nil Integer] ] #{ :colon :at :both} { :right \}, :allows-separator false } (cond (and (:at params) (:colon params)) iterate-main-sublists (:colon params) iterate-list-of-sublists (:at params) iterate-main-list true iterate-sublist)) (\} [] #{:colon} {} nil) (\< [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]] #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first } logical-block-or-justify) (\> [] #{:colon} {} nil) ;; TODO: detect errors in cases where colon not allowed (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] #{:colon} {} (fn [params navigator offsets] (let [arg1 (:arg1 params) arg2 (:arg2 params) arg3 (:arg3 params) exit (if (:colon params) :colon-up-arrow :up-arrow)] (cond (and arg1 arg2 arg3) (if (<= arg1 arg2 arg3) [exit navigator] navigator) (and arg1 arg2) (if (= arg1 arg2) [exit navigator] navigator) arg1 (if (= arg1 0) [exit navigator] navigator) true ; TODO: handle looking up the arglist stack for info (if (if (:colon params) (empty? (:rest (:base-args params))) (empty? (:rest navigator))) [exit navigator] navigator))))) (\W [] #{:at :colon :both :pretty} {} (if (or (:at params) (:colon params)) (let [bindings (concat (if (:at params) [:level nil :length nil] []) (if (:colon params) [:pretty true] []))] (fn [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (apply write arg bindings) [:up-arrow navigator] navigator)))) (fn [params navigator offsets] (let [[arg navigator] (next-arg navigator)] (if (write-out arg) [:up-arrow navigator] navigator))))) (\_ [] #{:at :colon :both} {} conditional-newline) (\I [:n [0 Integer]] #{:colon} {} set-indent) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code to manage the parameters and flags associated with each ;;; directive in the format string. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))") (def ^{:private true} special-params #{ :parameter-from-args :remaining-arg-count }) (defn- extract-param [[s offset saw-comma]] (let [m (re-matcher param-pattern s) param (re-find m)] (if param (let [token-str (first (re-groups m)) remainder (subs s (.end m)) new-offset (+ offset (.end m))] (if (not (= \, (nth remainder 0))) [ [token-str offset] [remainder new-offset false]] [ [token-str offset] [(subs remainder 1) (inc new-offset) true]])) (if saw-comma (format-error "Badly formed parameters in format directive" offset) [ nil [s offset]])))) (defn- extract-params [s offset] (consume extract-param [s offset false])) (defn- translate-param "Translate the string representation of a param to the internalized representation" [[^String p offset]] [(cond (= (.length p) 0) nil (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1) true (new Integer p)) offset]) (def ^{:private true} flag-defs { \: :colon, \@ :at }) (defn- extract-flags [s offset] (consume (fn [[s offset flags]] (if (empty? s) [nil [s offset flags]] (let [flag (get flag-defs (first s))] (if flag (if (contains? flags flag) (format-error (str "Flag \"" (first s) "\" appears more than once in a directive") offset) [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]]) [nil [s offset flags]])))) [s offset {}])) (defn- check-flags [def flags] (let [allowed (:flags def)] (if (and (not (:at allowed)) (:at flags)) (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"") (nth (:at flags) 1))) (if (and (not (:colon allowed)) (:colon flags)) (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"") (nth (:colon flags) 1))) (if (and (not (:both allowed)) (:at flags) (:colon flags)) (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" (:directive def) "\"") (min (nth (:colon flags) 1) (nth (:at flags) 1)))))) (defn- map-params "Takes a directive definition and the list of actual parameters and a map of flags and returns a map of the parameters and flags with defaults filled in. We check to make sure that there are the right types and number of parameters as well." [def params flags offset] (check-flags def flags) (if (> (count params) (count (:params def))) (format-error (cl-format nil "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed" (:directive def) (count params) (count (:params def))) (second (first params)))) (doall (map #(let [val (first %1)] (if (not (or (nil? val) (contains? special-params val) (instance? (second (second %2)) val))) (format-error (str "Parameter " (name (first %2)) " has bad type in directive \"" (:directive def) "\": " (class val)) (second %1))) ) params (:params def))) (merge ; create the result map (into (array-map) ; start with the default values, make sure the order is right (reverse (for [[name [default]] (:params def)] [name [default offset]]))) (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils flags)) ; and finally add the flags (defn- compile-directive [s offset] (let [[raw-params [rest offset]] (extract-params s offset) [_ [rest offset flags]] (extract-flags rest offset) directive (first rest) def (get directive-table (Character/toUpperCase ^Character directive)) params (if def (map-params def (map translate-param raw-params) flags offset))] (if (not directive) (format-error "Format string ended in the middle of a directive" offset)) (if (not def) (format-error (str "Directive \"" directive "\" is undefined") offset)) [(struct compiled-directive ((:generator-fn def) params offset) def params offset) (let [remainder (subs rest 1) offset (inc offset) trim? (and (= \newline (:directive def)) (not (:colon params))) trim-count (if trim? (prefix-count remainder [\space \tab]) 0) remainder (subs remainder trim-count) offset (+ offset trim-count)] [remainder offset])])) (defn- compile-raw-string [s offset] (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset)) (defn- right-bracket [this] (:right (:bracket-info (:def this)))) (defn- separator? [this] (:separator (:bracket-info (:def this)))) (defn- else-separator? [this] (and (:separator (:bracket-info (:def this))) (:colon (:params this)))) (declare collect-clauses) (defn- process-bracket [this remainder] (let [[subex remainder] (collect-clauses (:bracket-info (:def this)) (:offset this) remainder)] [(struct compiled-directive (:func this) (:def this) (merge (:params this) (tuple-map subex (:offset this))) (:offset this)) remainder])) (defn- process-clause [bracket-info offset remainder] (consume (fn [remainder] (if (empty? remainder) (format-error "No closing bracket found." offset) (let [this (first remainder) remainder (next remainder)] (cond (right-bracket this) (process-bracket this remainder) (= (:right bracket-info) (:directive (:def this))) [ nil [:right-bracket (:params this) nil remainder]] (else-separator? this) [nil [:else nil (:params this) remainder]] (separator? this) [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~; true [this remainder])))) remainder)) (defn- collect-clauses [bracket-info offset remainder] (second (consume (fn [[clause-map saw-else remainder]] (let [[clause [type right-params else-params remainder]] (process-clause bracket-info offset remainder)] (cond (= type :right-bracket) [nil [(merge-with concat clause-map {(if saw-else :else :clauses) [clause] :right-params right-params}) remainder]] (= type :else) (cond (:else clause-map) (format-error "Two else clauses (\"~:;\") inside bracket construction." offset) (not (:else bracket-info)) (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." offset) (and (= :first (:else bracket-info)) (seq (:clauses clause-map))) (format-error "The else clause (\"~:;\") is only allowed in the first position for this directive." offset) true ; if the ~:; is in the last position, the else clause ; is next, this was a regular clause (if (= :first (:else bracket-info)) [true [(merge-with concat clause-map { :else [clause] :else-params else-params}) false remainder]] [true [(merge-with concat clause-map { :clauses [clause] }) true remainder]])) (= type :separator) (cond saw-else (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset) (not (:allows-separator bracket-info)) (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." offset) true [true [(merge-with concat clause-map { :clauses [clause] }) false remainder]])))) [{ :clauses [] } false remainder]))) (defn- process-nesting "Take a linearly compiled format and process the bracket directives to give it the appropriate tree structure" [format] (first (consume (fn [remainder] (let [this (first remainder) remainder (next remainder) bracket (:bracket-info (:def this))] (if (:right bracket) (process-bracket this remainder) [this remainder]))) format))) (defn- compile-format "Compiles format-str into a compiled format which can be used as an argument to cl-format just like a plain format string. Use this function for improved performance when you're using the same format string repeatedly" [ format-str ] ; (prlabel compiling format-str) (binding [*format-str* format-str] (process-nesting (first (consume (fn [[^String s offset]] (if (empty? s) [nil s] (let [tilde (.indexOf s (int \~))] (cond (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]] (zero? tilde) (compile-directive (subs s 1) (inc offset)) true [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]])))) [format-str 0]))))) (defn- needs-pretty "determine whether a given compiled format has any directives that depend on the column number or pretty printing" [format] (loop [format format] (if (empty? format) false (if (or (:pretty (:flags (:def (first format)))) (some needs-pretty (first (:clauses (:params (first format))))) (some needs-pretty (first (:else (:params (first format)))))) true (recur (next format)))))) (defn- execute-format "Executes the format with the arguments." {:skip-wiki true} ([stream format args] (let [^java.io.Writer real-stream (cond (not stream) (java.io.StringWriter.) (true? stream) *out* :else stream) ^java.io.Writer wrapped-stream (if (and (needs-pretty format) (not (pretty-writer? real-stream))) (get-pretty-writer real-stream) real-stream)] (binding [*out* wrapped-stream] (try (execute-format format args) (finally (if-not (identical? real-stream wrapped-stream) (.flush wrapped-stream)))) (if (not stream) (.toString real-stream))))) ([format args] (map-passing-context (fn [element context] (if (abort? context) [nil context] (let [[params args] (realize-parameter-list (:params element) context) [params offsets] (unzip-map params) params (assoc params :base-args args)] [nil (apply (:func element) [params args offsets])]))) args format) nil)) ;;; This is a bad idea, but it prevents us from leaking private symbols ;;; This should all be replaced by really compiled formats anyway. (def ^{:private true} cached-compile (memoize compile-format)) (defmacro formatter "Makes a function which can directly run format-in. The function is fn [stream & args] ... and returns nil unless the stream is nil (meaning output to a string) in which case it returns the resulting string. format-in can be either a control string or a previously compiled format." {:added "1.2"} [format-in] `(let [format-in# ~format-in my-c-c# (var-get (get (ns-interns (the-ns 'clojure.pprint)) '~'cached-compile)) my-e-f# (var-get (get (ns-interns (the-ns 'clojure.pprint)) '~'execute-format)) my-i-n# (var-get (get (ns-interns (the-ns 'clojure.pprint)) '~'init-navigator)) cf# (if (string? format-in#) (my-c-c# format-in#) format-in#)] (fn [stream# & args#] (let [navigator# (my-i-n# args#)] (my-e-f# stream# cf# navigator#))))) (defmacro formatter-out "Makes a function which can directly run format-in. The function is fn [& args] ... and returns nil. This version of the formatter macro is designed to be used with *out* set to an appropriate Writer. In particular, this is meant to be used as part of a pretty printer dispatch method. format-in can be either a control string or a previously compiled format." {:added "1.2"} [format-in] `(let [format-in# ~format-in cf# (if (string? format-in#) (#'clojure.pprint/cached-compile format-in#) format-in#)] (fn [& args#] (let [navigator# (#'clojure.pprint/init-navigator args#)] (#'clojure.pprint/execute-format cf# navigator#))))) ================================================ FILE: src/clj/clojure/pprint/column_writer.clj ================================================ ;;; column_writer.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; Revised to use proxy instead of gen-class April 2010 ;; This module implements a column-aware wrapper around an instance of java.io.Writer (in-ns 'clojure.pprint) (import [clojure.lang IDeref] [java.io Writer]) (def ^:dynamic ^{:private true} *default-page-width* 72) (defn- get-field [^Writer this sym] (sym @@this)) (defn- set-field [^Writer this sym new-val] (alter @this assoc sym new-val)) (defn- get-column [this] (get-field this :cur)) (defn- get-line [this] (get-field this :line)) (defn- get-max-column [this] (get-field this :max)) (defn- set-max-column [this new-max] (dosync (set-field this :max new-max)) nil) (defn- get-writer [this] (get-field this :base)) (defn- c-write-char [^Writer this ^Integer c] (dosync (if (= c (int \newline)) (do (set-field this :cur 0) (set-field this :line (inc (get-field this :line)))) (set-field this :cur (inc (get-field this :cur))))) (.write ^Writer (get-field this :base) c)) (defn- column-writer ([writer] (column-writer writer *default-page-width*)) ([writer max-columns] (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})] (proxy [Writer IDeref] [] (deref [] fields) (flush [] (.flush writer)) (write ([^chars cbuf ^Integer off ^Integer len] (let [^Writer writer (get-field this :base)] (.write writer cbuf off len))) ([x] (condp = (class x) String (let [^String s x nl (.lastIndexOf s (int \newline))] (dosync (if (neg? nl) (set-field this :cur (+ (get-field this :cur) (count s))) (do (set-field this :cur (- (count s) nl 1)) (set-field this :line (+ (get-field this :line) (count (filter #(= % \newline) s))))))) (.write ^Writer (get-field this :base) s)) Integer (c-write-char this x) Long (c-write-char this x)))))))) ================================================ FILE: src/clj/clojure/pprint/dispatch.clj ================================================ ;; dispatch.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements the default dispatch tables for pretty printing code and ;; data. (in-ns 'clojure.pprint) (defn- use-method "Installs a function as a new method of multimethod associated with dispatch-value. " [multifn dispatch-val func] (. multifn addMethod dispatch-val func)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementations of specific dispatch table entries ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handle forms that can be "back-translated" to reader macros ;;; Not all reader macros can be dealt with this way or at all. ;;; Macros that we can't deal with at all are: ;;; ; - The comment character is absorbed by the reader and never is part of the form ;;; ` - Is fully processed at read time into a lisp expression (which will contain concats ;;; and regular quotes). ;;; ~@ - Also fully eaten by the processing of ` and can't be used outside. ;;; , - is whitespace and is lost (like all other whitespace). Formats can generate commas ;;; where they deem them useful to help readability. ;;; ^ - Adding metadata completely disappears at read time and the data appears to be ;;; completely lost. ;;; ;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{}) ;;; or directly by printing the objects using Clojure's built-in print functions (like ;;; :keyword, \char, or ""). The notable exception is #() which is special-cased. (def ^{:private true} reader-macros {'quote "'", 'clojure.core/deref "@", 'var "#'", 'clojure.core/unquote "~"}) (defn- pprint-reader-macro [alis] (let [^String macro-char (reader-macros (first alis))] (when (and macro-char (= 2 (count alis))) (.write ^java.io.Writer *out* macro-char) (write-out (second alis)) true))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Dispatch for the basic data types when interpreted ;; as data (as opposed to code). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; TODO: inline these formatter statements into funcs so that we ;;; are a little easier on the stack. (Or, do "real" compilation, a ;;; la Common Lisp) ;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>")) (defn- pprint-simple-list [alis] (pprint-logical-block :prefix "(" :suffix ")" (print-length-loop [alis (seq alis)] (when alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next alis))))))) (defn- pprint-list [alis] (if-not (pprint-reader-macro alis) (pprint-simple-list alis))) ;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>")) (defn- pprint-vector [avec] (pprint-logical-block :prefix "[" :suffix "]" (print-length-loop [aseq (seq avec)] (when aseq (write-out (first aseq)) (when (next aseq) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next aseq))))))) (def ^{:private true} pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) ;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) (defn- pprint-map [amap] (pprint-logical-block :prefix "{" :suffix "}" (print-length-loop [aseq (seq amap)] (when aseq (pprint-logical-block (write-out (ffirst aseq)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (set! *current-length* 0) ; always print both parts of the [k v] pair (write-out (fnext (first aseq)))) (when (next aseq) (.write ^java.io.Writer *out* ", ") (pprint-newline :linear) (recur (next aseq))))))) (def ^{:private true} pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) (def ^{:private true} type-map {"core$future_call" "Future", "core$promise" "Promise"}) (defn- map-ref-type "Map ugly type names to something simpler" [name] (or (when-let [match (re-find #"^[^$]+\$[^$]+" name)] (type-map match)) name)) (defn- pprint-ideref [o] (let [prefix (format "#<%s@%x%s: " (map-ref-type (.getSimpleName (class o))) (System/identityHashCode o) (if (and (instance? clojure.lang.Agent o) (agent-error o)) " FAILED" ""))] (pprint-logical-block :prefix prefix :suffix ">" (pprint-indent :block (-> (count prefix) (- 2) -)) (pprint-newline :linear) (write-out (cond (and (future? o) (not (future-done? o))) :pending (and (instance? clojure.lang.IPending o) (not (.isRealized o))) :not-delivered :else @o))))) (def ^{:private true} pprint-pqueue (formatter-out "~<<-(~;~@{~w~^ ~_~}~;)-<~:>")) (defn- pprint-simple-default [obj] (cond (.isArray (class obj)) (pprint-array obj) (and *print-suppress-namespaces* (symbol? obj)) (print (name obj)) :else (pr obj))) (defmulti simple-dispatch "The pretty print dispatch function for simple data structure format." {:added "1.2" :arglists '[[object]]} class) (use-method simple-dispatch clojure.lang.ISeq pprint-list) (use-method simple-dispatch clojure.lang.IPersistentVector pprint-vector) (use-method simple-dispatch clojure.lang.IPersistentMap pprint-map) (use-method simple-dispatch clojure.lang.IPersistentSet pprint-set) (use-method simple-dispatch clojure.lang.PersistentQueue pprint-pqueue) (use-method simple-dispatch clojure.lang.IDeref pprint-ideref) (use-method simple-dispatch nil pr) (use-method simple-dispatch :default pprint-simple-default) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Dispatch for the code table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare pprint-simple-code-list) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format the namespace ("ns") macro. This is quite complicated because of all the ;;; different forms supported and because programmers can choose lists or vectors ;;; in various places. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- brackets "Figure out which kind of brackets to use" [form] (if (vector? form) ["[" "]"] ["(" ")"])) (defn- pprint-ns-reference "Pretty print a single reference (import, use, etc.) from a namespace decl" [reference] (if (sequential? reference) (let [[start end] (brackets reference) [keyw & args] reference] (pprint-logical-block :prefix start :suffix end ((formatter-out "~w~:i") keyw) (loop [args args] (when (seq args) ((formatter-out " ")) (let [arg (first args)] (if (sequential? arg) (let [[start end] (brackets arg)] (pprint-logical-block :prefix start :suffix end (if (and (= (count arg) 3) (keyword? (second arg))) (let [[ns kw lis] arg] ((formatter-out "~w ~w ") ns kw) (if (sequential? lis) ((formatter-out (if (vector? lis) "~<[~;~@{~w~^ ~:_~}~;]~:>" "~<(~;~@{~w~^ ~:_~}~;)~:>")) lis) (write-out lis))) (apply (formatter-out "~w ~:i~@{~w~^ ~:_~}") arg))) (when (next args) ((formatter-out "~_")))) (do (write-out arg) (when (next args) ((formatter-out "~:_")))))) (recur (next args)))))) (write-out reference))) (defn- pprint-ns "The pretty print dispatch chunk for the ns macro" [alis] (if (next alis) (let [[ns-sym ns-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map references] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block :prefix "(" :suffix ")" ((formatter-out "~w ~1I~@_~w") ns-sym ns-name) (when (or doc-str attr-map (seq references)) ((formatter-out "~@:_"))) (when doc-str (cl-format true "\"~a\"~:[~;~:@_~]" doc-str (or attr-map (seq references)))) (when attr-map ((formatter-out "~w~:[~;~:@_~]") attr-map (seq references))) (loop [references references] (pprint-ns-reference (first references)) (when-let [references (next references)] (pprint-newline :linear) (recur references))))) (write-out alis))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something that looks like a simple def (sans metadata, since the reader ;;; won't give it to us now). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something that looks like a defn or defmacro ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format the params and body of a defn with a single arity (defn- single-defn [alis has-doc-str?] (if (seq alis) (do (if has-doc-str? ((formatter-out " ~_")) ((formatter-out " ~@_"))) ((formatter-out "~{~w~^ ~_~}") alis)))) ;;; Format the param and body sublists of a defn with multiple arities (defn- multi-defn [alis has-doc-str?] (if (seq alis) ((formatter-out " ~_~{~w~^ ~_~}") alis))) ;;; TODO: figure out how to support capturing metadata in defns (we might need a ;;; special reader) (defn- pprint-defn [alis] (if (next alis) (let [[defn-sym defn-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map stuff] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block :prefix "(" :suffix ")" ((formatter-out "~w ~1I~@_~w") defn-sym defn-name) (if doc-str ((formatter-out " ~_~w") doc-str)) (if attr-map ((formatter-out " ~_~w") attr-map)) ;; Note: the multi-defn case will work OK for malformed defns too (cond (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) :else (multi-defn stuff (or doc-str attr-map))))) (pprint-simple-code-list alis))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something with a binding form ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- pprint-binding-form [binding-vec] (pprint-logical-block :prefix "[" :suffix "]" (print-length-loop [binding binding-vec] (when (seq binding) (pprint-logical-block binding (write-out (first binding)) (when (next binding) (.write ^java.io.Writer *out* " ") (pprint-newline :miser) (write-out (second binding)))) (when (next (rest binding)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next (rest binding)))))))) (defn- pprint-let [alis] (let [base-sym (first alis)] (pprint-logical-block :prefix "(" :suffix ")" (if (and (next alis) (vector? (second alis))) (do ((formatter-out "~w ~1I~@_") base-sym) (pprint-binding-form (second alis)) ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis)))) (pprint-simple-code-list alis))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Format something that looks like "if" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^{:private true} pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>")) (defn- pprint-cond [alis] (pprint-logical-block :prefix "(" :suffix ")" (pprint-indent :block 1) (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (print-length-loop [alis (next alis)] (when alis (pprint-logical-block alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :miser) (write-out (second alis)))) (when (next (rest alis)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next (rest alis))))))))) (defn- pprint-condp [alis] (if (> (count alis) 3) (pprint-logical-block :prefix "(" :suffix ")" (pprint-indent :block 1) (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis) (print-length-loop [alis (seq (drop 3 alis))] (when alis (pprint-logical-block alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :miser) (write-out (second alis)))) (when (next (rest alis)) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next (rest alis))))))) (pprint-simple-code-list alis))) ;;; The map of symbols that are defined in an enclosing #() anonymous function (def ^:dynamic ^{:private true} *symbol-map* {}) (defn- pprint-anon-func [alis] (let [args (second alis) nlis (first (rest (rest alis)))] (if (vector? args) (binding [*symbol-map* (if (= 1 (count args)) {(first args) "%"} (into {} (map #(vector %1 (str \% %2)) args (range 1 (inc (count args))))))] ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis)) (pprint-simple-code-list alis)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The master definitions for formatting lists in code (that is, (fn args...) or ;;; special forms). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is ;;; easier on the stack. (defn- pprint-simple-code-list [alis] (pprint-logical-block :prefix "(" :suffix ")" (pprint-indent :block 1) (print-length-loop [alis (seq alis)] (when alis (write-out (first alis)) (when (next alis) (.write ^java.io.Writer *out* " ") (pprint-newline :linear) (recur (next alis))))))) ;;; Take a map with symbols as keys and add versions with no namespace. ;;; That is, if ns/sym->val is in the map, add sym->val to the result. (defn- two-forms [amap] (into {} (mapcat identity (for [x amap] [x [(symbol (name (first x))) (second x)]])))) (defn- add-core-ns [amap] (let [core "clojure.core"] (into {} (map #(let [[s f] %] (if (not (or (namespace s) (special-symbol? s))) [(symbol core (name s)) f] %)) amap)))) (def ^:dynamic ^{:private true} *code-table* (two-forms (add-core-ns {'def pprint-hold-first, 'defonce pprint-hold-first, 'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn, 'let pprint-let, 'loop pprint-let, 'binding pprint-let, 'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let, 'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let, 'when-first pprint-let, 'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if, 'cond pprint-cond, 'condp pprint-condp, 'fn* pprint-anon-func, '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first, 'locking pprint-hold-first, 'struct pprint-hold-first, 'struct-map pprint-hold-first, 'ns pprint-ns }))) (defn- pprint-code-list [alis] (if-not (pprint-reader-macro alis) (if-let [special-form (*code-table* (first alis))] (special-form alis) (pprint-simple-code-list alis)))) (defn- pprint-code-symbol [sym] (if-let [arg-num (sym *symbol-map*)] (print arg-num) (if *print-suppress-namespaces* (print (name sym)) (pr sym)))) (defmulti code-dispatch "The pretty print dispatch function for pretty printing Clojure code." {:added "1.2" :arglists '[[object]]} class) (use-method code-dispatch clojure.lang.ISeq pprint-code-list) (use-method code-dispatch clojure.lang.Symbol pprint-code-symbol) ;; The following are all exact copies of simple-dispatch (use-method code-dispatch clojure.lang.IPersistentVector pprint-vector) (use-method code-dispatch clojure.lang.IPersistentMap pprint-map) (use-method code-dispatch clojure.lang.IPersistentSet pprint-set) (use-method code-dispatch clojure.lang.PersistentQueue pprint-pqueue) (use-method code-dispatch clojure.lang.IDeref pprint-ideref) (use-method code-dispatch nil pr) (use-method code-dispatch :default pprint-simple-default) (set-pprint-dispatch simple-dispatch) ;;; For testing (comment (with-pprint-dispatch code-dispatch (pprint '(defn cl-format "An implementation of a Common Lisp compatible format function" [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))))) (with-pprint-dispatch code-dispatch (pprint '(defn cl-format [stream format-in & args] (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) navigator (init-navigator args)] (execute-format stream compiled-format navigator))))) (with-pprint-dispatch code-dispatch (pprint '(defn- -write ([this x] (condp = (class x) String (let [s0 (write-initial-lines this x) s (.replaceFirst s0 "\\s+$" "") white-space (.substring s0 (count s)) mode (getf :mode)] (if (= mode :writing) (dosync (write-white-space this) (.col_write this s) (setf :trailing-white-space white-space)) (add-to-buffer this (make-buffer-blob s white-space)))) Integer (let [c ^Character x] (if (= (getf :mode) :writing) (do (write-white-space this) (.col_write this x)) (if (= c (int \newline)) (write-initial-lines this "\n") (add-to-buffer this (make-buffer-blob (str (char c)) nil)))))))))) (with-pprint-dispatch code-dispatch (pprint '(defn pprint-defn [writer alis] (if (next alis) (let [[defn-sym defn-name & stuff] alis [doc-str stuff] (if (string? (first stuff)) [(first stuff) (next stuff)] [nil stuff]) [attr-map stuff] (if (map? (first stuff)) [(first stuff) (next stuff)] [nil stuff])] (pprint-logical-block writer :prefix "(" :suffix ")" (cl-format true "~w ~1I~@_~w" defn-sym defn-name) (if doc-str (cl-format true " ~_~w" doc-str)) (if attr-map (cl-format true " ~_~w" attr-map)) ;; Note: the multi-defn case will work OK for malformed defns too (cond (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) :else (multi-defn stuff (or doc-str attr-map))))) (pprint-simple-code-list writer alis))))) ) nil ================================================ FILE: src/clj/clojure/pprint/pprint_base.clj ================================================ ;;; pprint_base.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements the generic pretty print functions and special variables (in-ns 'clojure.pprint) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Variables that control the pretty printer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core ;;; TODO: use *print-dup* here (or is it supplanted by other variables?) ;;; TODO: make dispatch items like "(let..." get counted in *print-length* ;;; constructs (def ^:dynamic ^{:doc "Bind to true if you want write to use pretty printing", :added "1.2"} *print-pretty* true) (defonce ^:dynamic ; If folks have added stuff here, don't overwrite ^{:doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch to modify.", :added "1.2"} *print-pprint-dispatch* nil) (def ^:dynamic ^{:doc "Pretty printing will try to avoid anything going beyond this column. Set it to nil to have pprint let the line be arbitrarily long. This will ignore all non-mandatory newlines.", :added "1.2"} *print-right-margin* 72) (def ^:dynamic ^{:doc "The column at which to enter miser style. Depending on the dispatch table, miser style add newlines in more places to try to keep lines short allowing for further levels of nesting.", :added "1.2"} *print-miser-width* 40) ;;; TODO implement output limiting (def ^:dynamic ^{:private true, :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"} *print-lines* nil) ;;; TODO: implement circle and shared (def ^:dynamic ^{:private true, :doc "Mark circular structures (N.B. This is not yet used)"} *print-circle* nil) ;;; TODO: should we just use *print-dup* here? (def ^:dynamic ^{:private true, :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"} *print-shared* nil) (def ^:dynamic ^{:doc "Don't print namespaces with symbols. This is particularly useful when pretty printing the results of macro expansions" :added "1.2"} *print-suppress-namespaces* nil) ;;; TODO: support print-base and print-radix in cl-format ;;; TODO: support print-base and print-radix in rationals (def ^:dynamic ^{:doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the radix specifier is in the form #XXr where XX is the decimal value of *print-base* " :added "1.2"} *print-radix* nil) (def ^:dynamic ^{:doc "The base to use for printing integers and rationals." :added "1.2"} *print-base* 10) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal variables that keep track of where we are in the ;; structure ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^:dynamic ^{ :private true } *current-level* 0) (def ^:dynamic ^{ :private true } *current-length* nil) ;; TODO: add variables for length, lines. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for the write function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare format-simple-number) (def ^{:private true} orig-pr pr) (defn- pr-with-base [x] (if-let [s (format-simple-number x)] (print s) (orig-pr x))) (def ^{:private true} write-option-table {;:array *print-array* :base 'clojure.pprint/*print-base*, ;;:case *print-case*, :circle 'clojure.pprint/*print-circle*, ;;:escape *print-escape*, ;;:gensym *print-gensym*, :length 'clojure.core/*print-length*, :level 'clojure.core/*print-level*, :lines 'clojure.pprint/*print-lines*, :miser-width 'clojure.pprint/*print-miser-width*, :dispatch 'clojure.pprint/*print-pprint-dispatch*, :pretty 'clojure.pprint/*print-pretty*, :radix 'clojure.pprint/*print-radix*, :readably 'clojure.core/*print-readably*, :right-margin 'clojure.pprint/*print-right-margin*, :suppress-namespaces 'clojure.pprint/*print-suppress-namespaces*}) (defmacro ^{:private true} binding-map [amap & body] (let [] `(do (. clojure.lang.Var (pushThreadBindings ~amap)) (try ~@body (finally (. clojure.lang.Var (popThreadBindings))))))) (defn- table-ize [t m] (apply hash-map (mapcat #(when-let [v (get t (key %))] [(find-var v) (val %)]) m))) (defn- pretty-writer? "Return true iff x is a PrettyWriter" [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x))) (defn- make-pretty-writer "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width" [base-writer right-margin miser-width] (pretty-writer base-writer right-margin miser-width)) (defmacro ^{:private true} with-pretty-writer [base-writer & body] `(let [base-writer# ~base-writer new-writer# (not (pretty-writer? base-writer#))] (binding [*out* (if new-writer# (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*) base-writer#)] ~@body (.ppflush *out*)))) ;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc. (defn write-out "Write an object to *out* subject to the current bindings of the printer control variables. Use the kw-args argument to override individual variables for this call (and any recursive calls). *out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility of the caller. This method is primarily intended for use by pretty print dispatch functions that already know that the pretty printer will have set up their environment appropriately. Normal library clients should use the standard \"write\" interface. " {:added "1.2"} [object] (let [length-reached (and *current-length* *print-length* (>= *current-length* *print-length*))] (if-not *print-pretty* (pr object) (if length-reached (print "...") (do (if *current-length* (set! *current-length* (inc *current-length*))) (*print-pprint-dispatch* object)))) length-reached)) (defn write "Write an object subject to the current bindings of the printer control variables. Use the kw-args argument to override individual variables for this call (and any recursive calls). Returns the string result if :stream is nil or nil otherwise. The following keyword arguments can be passed with values: Keyword Meaning Default value :stream Writer for output or nil true (indicates *out*) :base Base to use for writing rationals Current value of *print-base* :circle* If true, mark circular structures Current value of *print-circle* :length Maximum elements to show in sublists Current value of *print-length* :level Maximum depth Current value of *print-level* :lines* Maximum lines of output Current value of *print-lines* :miser-width Width to enter miser mode Current value of *print-miser-width* :dispatch The pretty print dispatch function Current value of *print-pprint-dispatch* :pretty If true, do pretty printing Current value of *print-pretty* :radix If true, prepend a radix specifier Current value of *print-radix* :readably* If true, print readably Current value of *print-readably* :right-margin The column for the right margin Current value of *print-right-margin* :suppress-namespaces If true, no namespaces in symbols Current value of *print-suppress-namespaces* * = not yet supported " {:added "1.2"} [object & kw-args] (let [options (merge {:stream true} (apply hash-map kw-args))] (binding-map (table-ize write-option-table options) (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) (let [optval (if (contains? options :stream) (:stream options) true) base-writer (condp = optval nil (java.io.StringWriter.) true *out* optval)] (if *print-pretty* (with-pretty-writer base-writer (write-out object)) (binding [*out* base-writer] (pr object))) (if (nil? optval) (.toString ^java.io.StringWriter base-writer))))))) (defn pprint "Pretty print object to the optional output writer. If the writer is not provided, print the object to the currently bound value of *out*." {:added "1.2"} ([object] (pprint object *out*)) ([object writer] (with-pretty-writer writer (binding [*print-pretty* true] (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) (write-out object))) (if (not (= 0 (get-column *out*))) (prn))))) (defmacro pp "A convenience macro that pretty prints the last thing output. This is exactly equivalent to (pprint *1)." {:added "1.2"} [] `(pprint *1)) (defn set-pprint-dispatch "Set the pretty print dispatch function to a function matching (fn [obj] ...) where obj is the object to pretty print. That function will be called with *out* set to a pretty printing writer to which it should do its printing. For example functions, see simple-dispatch and code-dispatch in clojure.pprint.dispatch.clj." {:added "1.2"} [function] (let [old-meta (meta #'*print-pprint-dispatch*)] (alter-var-root #'*print-pprint-dispatch* (constantly function)) (alter-meta! #'*print-pprint-dispatch* (constantly old-meta))) nil) (defmacro with-pprint-dispatch "Execute body with the pretty print dispatch function bound to function." {:added "1.2"} [function & body] `(binding [*print-pprint-dispatch* ~function] ~@body)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for the functional interface to the pretty printer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- parse-lb-options [opts body] (loop [body body acc []] (if (opts (first body)) (recur (drop 2 body) (concat acc (take 2 body))) [(apply hash-map acc) body]))) (defn- check-enumerated-arg [arg choices] (if-not (choices arg) (throw (IllegalArgumentException. ;; TODO clean up choices string (str "Bad argument: " arg ". It must be one of " choices))))) (defn- level-exceeded [] (and *print-level* (>= *current-level* *print-level*))) (defmacro pprint-logical-block "Execute the body as a pretty printing logical block with output to *out* which must be a pretty printing writer. When used from pprint or cl-format, this can be assumed. This function is intended for use when writing custom dispatch functions. Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, and :suffix." {:added "1.2", :arglists '[[options* body]]} [& args] (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] `(do (if (#'clojure.pprint/level-exceeded) (.write ^java.io.Writer *out* "#") (do (push-thread-bindings {#'clojure.pprint/*current-level* (inc (var-get #'clojure.pprint/*current-level*)) #'clojure.pprint/*current-length* 0}) (try (#'clojure.pprint/start-block *out* ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) ~@body (#'clojure.pprint/end-block *out*) (finally (pop-thread-bindings))))) nil))) (defn pprint-newline "Print a conditional newline to a pretty printing stream. kind specifies if the newline is :linear, :miser, :fill, or :mandatory. This function is intended for use when writing custom dispatch functions. Output is sent to *out* which must be a pretty printing writer." {:added "1.2"} [kind] (check-enumerated-arg kind #{:linear :miser :fill :mandatory}) (nl *out* kind)) (defn pprint-indent "Create an indent at this point in the pretty printing stream. This defines how following lines are indented. relative-to can be either :block or :current depending whether the indent should be computed relative to the start of the logical block or the current column position. n is an offset. This function is intended for use when writing custom dispatch functions. Output is sent to *out* which must be a pretty printing writer." {:added "1.2"} [relative-to n] (check-enumerated-arg relative-to #{:block :current}) (indent *out* relative-to n)) ;; TODO a real implementation for pprint-tab (defn pprint-tab "Tab at this point in the pretty printing stream. kind specifies whether the tab is :line, :section, :line-relative, or :section-relative. Colnum and colinc specify the target column and the increment to move the target forward if the output is already past the original target. This function is intended for use when writing custom dispatch functions. Output is sent to *out* which must be a pretty printing writer. THIS FUNCTION IS NOT YET IMPLEMENTED." {:added "1.2"} [kind colnum colinc] (check-enumerated-arg kind #{:line :section :line-relative :section-relative}) (throw (UnsupportedOperationException. "pprint-tab is not yet implemented"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Helpers for dispatch function writing ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- pll-mod-body [var-sym body] (letfn [(inner [form] (if (seq? form) (let [form (macroexpand form)] (condp = (first form) 'loop* form 'recur (concat `(recur (inc ~var-sym)) (rest form)) (walk inner identity form))) form))] (walk inner identity body))) (defmacro print-length-loop "A version of loop that iterates at most *print-length* times. This is designed for use in pretty-printer dispatch functions." {:added "1.3"} [bindings & body] (let [count-var (gensym "length-count") mod-body (pll-mod-body count-var body)] `(loop ~(apply vector count-var 0 bindings) (if (or (not *print-length*) (< ~count-var *print-length*)) (do ~@mod-body) (.write ^java.io.Writer *out* "..."))))) nil ================================================ FILE: src/clj/clojure/pprint/pretty_writer.clj ================================================ ;;; pretty_writer.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; Revised to use proxy instead of gen-class April 2010 ;; This module implements a wrapper around a java.io.Writer which implements the ;; core of the XP algorithm. (in-ns 'clojure.pprint) (import [clojure.lang IDeref] [java.io Writer]) ;; TODO: Support for tab directives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Forward declarations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare get-miser-width) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Macros to simplify dealing with types and classes. These are ;;; really utilities, but I'm experimenting with them here. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro ^{:private true} getf "Get the value of the field a named by the argument (which should be a keyword)." [sym] `(~sym @@~'this)) (defmacro ^{:private true} setf [sym new-val] "Set the value of the field SYM to NEW-VAL" `(alter @~'this assoc ~sym ~new-val)) (defmacro ^{:private true} deftype [type-name & fields] (let [name-str (name type-name)] `(do (defstruct ~type-name :type-tag ~@fields) (alter-meta! #'~type-name assoc :private true) (defn- ~(symbol (str "make-" name-str)) [& vals#] (apply struct ~type-name ~(keyword name-str) vals#)) (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The data structures used by pretty-writer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct ^{:private true} logical-block :parent :section :start-col :indent :done-nl :intra-block-nl :prefix :per-line-prefix :suffix :logical-block-callback) (defn- ancestor? [parent child] (loop [child (:parent child)] (cond (nil? child) false (identical? parent child) true :else (recur (:parent child))))) (defstruct ^{:private true} section :parent) (defn- buffer-length [l] (let [l (seq l)] (if l (- (:end-pos (last l)) (:start-pos (first l))) 0))) ; A blob of characters (aka a string) (deftype buffer-blob :data :trailing-white-space :start-pos :end-pos) ; A newline (deftype nl-t :type :logical-block :start-pos :end-pos) (deftype start-block-t :logical-block :start-pos :end-pos) (deftype end-block-t :logical-block :start-pos :end-pos) (deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions to write tokens in the output buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def ^:private pp-newline (memoize #(System/getProperty "line.separator"))) (declare emit-nl) (defmulti ^{:private true} write-token #(:type-tag %2)) (defmethod write-token :start-block-t [^Writer this token] (when-let [cb (getf :logical-block-callback)] (cb :start)) (let [lb (:logical-block token)] (dosync (when-let [^String prefix (:prefix lb)] (.write (getf :base) prefix)) (let [col (get-column (getf :base))] (ref-set (:start-col lb) col) (ref-set (:indent lb) col))))) (defmethod write-token :end-block-t [^Writer this token] (when-let [cb (getf :logical-block-callback)] (cb :end)) (when-let [^String suffix (:suffix (:logical-block token))] (.write (getf :base) suffix))) (defmethod write-token :indent-t [^Writer this token] (let [lb (:logical-block token)] (ref-set (:indent lb) (+ (:offset token) (condp = (:relative-to token) :block @(:start-col lb) :current (get-column (getf :base))))))) (defmethod write-token :buffer-blob [^Writer this token] (.write (getf :base) ^String (:data token))) (defmethod write-token :nl-t [^Writer this token] ; (prlabel wt @(:done-nl (:logical-block token))) ; (prlabel wt (:type token) (= (:type token) :mandatory)) (if (or (= (:type token) :mandatory) (and (not (= (:type token) :fill)) @(:done-nl (:logical-block token)))) (emit-nl this token) (if-let [^String tws (getf :trailing-white-space)] (.write (getf :base) tws))) (dosync (setf :trailing-white-space nil))) (defn- write-tokens [^Writer this tokens force-trailing-whitespace] (doseq [token tokens] (if-not (= (:type-tag token) :nl-t) (if-let [^String tws (getf :trailing-white-space)] (.write (getf :base) tws))) (write-token this token) (setf :trailing-white-space (:trailing-white-space token))) (let [^String tws (getf :trailing-white-space)] (when (and force-trailing-whitespace tws) (.write (getf :base) tws) (setf :trailing-white-space nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; emit-nl? method defs for each type of new line. This makes ;;; the decision about whether to print this type of new line. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- tokens-fit? [^Writer this tokens] ;;; (prlabel tf? (get-column (getf :base) (buffer-length tokens)) (let [maxcol (get-max-column (getf :base))] (or (nil? maxcol) (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol)))) (defn- linear-nl? [this lb section] ; (prlabel lnl? @(:done-nl lb) (tokens-fit? this section)) (or @(:done-nl lb) (not (tokens-fit? this section)))) (defn- miser-nl? [^Writer this lb section] (let [miser-width (get-miser-width this) maxcol (get-max-column (getf :base))] (and miser-width maxcol (>= @(:start-col lb) (- maxcol miser-width)) (linear-nl? this lb section)))) (defmulti ^{:private true} emit-nl? (fn [t _ _ _] (:type t))) (defmethod emit-nl? :linear [newl this section _] (let [lb (:logical-block newl)] (linear-nl? this lb section))) (defmethod emit-nl? :miser [newl this section _] (let [lb (:logical-block newl)] (miser-nl? this lb section))) (defmethod emit-nl? :fill [newl this section subsection] (let [lb (:logical-block newl)] (or @(:intra-block-nl lb) (not (tokens-fit? this subsection)) (miser-nl? this lb section)))) (defmethod emit-nl? :mandatory [_ _ _ _] true) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Various support functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- get-section [buffer] (let [nl (first buffer) lb (:logical-block nl) section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb))) (next buffer)))] [section (seq (drop (inc (count section)) buffer))])) (defn- get-sub-section [buffer] (let [nl (first buffer) lb (:logical-block nl) section (seq (take-while #(let [nl-lb (:logical-block %)] (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb))))) (next buffer)))] section)) (defn- update-nl-state [lb] (dosync (ref-set (:intra-block-nl lb) false) (ref-set (:done-nl lb) true) (loop [lb (:parent lb)] (if lb (do (ref-set (:done-nl lb) true) (ref-set (:intra-block-nl lb) true) (recur (:parent lb))))))) (defn- emit-nl [^Writer this nl] (.write (getf :base) (pp-newline)) (dosync (setf :trailing-white-space nil)) (let [lb (:logical-block nl) ^String prefix (:per-line-prefix lb)] (if prefix (.write (getf :base) prefix)) (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix)) \space))] (.write (getf :base) istr)) (update-nl-state lb))) (defn- split-at-newline [tokens] (let [pre (seq (take-while #(not (nl-t? %)) tokens))] [pre (seq (drop (count pre) tokens))])) ;;; Methods for showing token strings for debugging (defmulti ^{:private true} tok :type-tag) (defmethod tok :nl-t [token] (:type token)) (defmethod tok :buffer-blob [token] (str \" (:data token) (:trailing-white-space token) \")) (defmethod tok :default [token] (:type-tag token)) (defn- toks [toks] (map tok toks)) ;;; write-token-string is called when the set of tokens in the buffer ;;; is longer than the available space on the line (defn- write-token-string [this tokens] (let [[a b] (split-at-newline tokens)] ;; (prlabel wts (toks a) (toks b)) (if a (write-tokens this a false)) (if b (let [[section remainder] (get-section b) newl (first b)] ;; (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) (let [do-nl (emit-nl? newl this section (get-sub-section b)) result (if do-nl (do ;; (prlabel emit-nl (:type newl)) (emit-nl this newl) (next b)) b) long-section (not (tokens-fit? this result)) result (if long-section (let [rem2 (write-token-string this section)] ;;; (prlabel recurse (toks rem2)) (if (= rem2 section) (do ; If that didn't produce any output, it has no nls ; so we'll force it (write-tokens this section false) remainder) (into [] (concat rem2 remainder)))) result) ;; ff (prlabel wts (toks result)) ] result))))) (defn- write-line [^Writer this] (dosync (loop [buffer (getf :buffer)] ;; (prlabel wl1 (toks buffer)) (setf :buffer (into [] buffer)) (if (not (tokens-fit? this buffer)) (let [new-buffer (write-token-string this buffer)] ;; (prlabel wl new-buffer) (if-not (identical? buffer new-buffer) (recur new-buffer))))))) ;;; Add a buffer token to the buffer and see if it's time to start ;;; writing (defn- add-to-buffer [^Writer this token] ; (prlabel a2b token) (dosync (setf :buffer (conj (getf :buffer) token)) (if (not (tokens-fit? this (getf :buffer))) (write-line this)))) ;;; Write all the tokens that have been buffered (defn- write-buffered-output [^Writer this] (write-line this) (if-let [buf (getf :buffer)] (do (write-tokens this buf true) (setf :buffer [])))) (defn- write-white-space [^Writer this] (when-let [^String tws (getf :trailing-white-space)] ; (prlabel wws (str "*" tws "*")) (.write (getf :base) tws) (dosync (setf :trailing-white-space nil)))) ;;; If there are newlines in the string, print the lines up until the last newline, ;;; making the appropriate adjustments. Return the remainder of the string (defn- write-initial-lines [^Writer this ^String s] (let [lines (.split s "\n" -1)] (if (= (count lines) 1) s (dosync (let [^String prefix (:per-line-prefix (first (getf :logical-blocks))) ^String l (first lines)] (if (= :buffering (getf :mode)) (let [oldpos (getf :pos) newpos (+ oldpos (count l))] (setf :pos newpos) (add-to-buffer this (make-buffer-blob l nil oldpos newpos)) (write-buffered-output this)) (do (write-white-space this) (.write (getf :base) l))) (.write (getf :base) (int \newline)) (doseq [^String l (next (butlast lines))] (.write (getf :base) l) (.write (getf :base) (pp-newline)) (if prefix (.write (getf :base) prefix))) (setf :buffering :writing) (last lines)))))) (defn- p-write-char [^Writer this ^Integer c] (if (= (getf :mode) :writing) (do (write-white-space this) (.write (getf :base) c)) (if (= c \newline) (write-initial-lines this "\n") (let [oldpos (getf :pos) newpos (inc oldpos)] (dosync (setf :pos newpos) (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Initialize the pretty-writer instance ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- pretty-writer [writer max-columns miser-width] (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false)) fields (ref {:pretty-writer true :base (column-writer writer max-columns) :logical-blocks lb :sections nil :mode :writing :buffer [] :buffer-block lb :buffer-level 1 :miser-width miser-width :trailing-white-space nil :pos 0})] (proxy [Writer IDeref PrettyFlush] [] (deref [] fields) (write ([x] ;; (prlabel write x (getf :mode)) (condp = (class x) String (let [^String s0 (write-initial-lines this x) ^String s (.replaceFirst s0 "\\s+$" "") white-space (.substring s0 (count s)) mode (getf :mode)] (dosync (if (= mode :writing) (do (write-white-space this) (.write (getf :base) s) (setf :trailing-white-space white-space)) (let [oldpos (getf :pos) newpos (+ oldpos (count s0))] (setf :pos newpos) (add-to-buffer this (make-buffer-blob s white-space oldpos newpos)))))) Integer (p-write-char this x) Long (p-write-char this x)))) (ppflush [] (if (= (getf :mode) :buffering) (dosync (write-tokens this (getf :buffer) true) (setf :buffer [])) (write-white-space this))) (flush [] (.ppflush this) (.flush (getf :base))) (close [] (.flush this))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Methods for pretty-writer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- start-block [^Writer this ^String prefix ^String per-line-prefix ^String suffix] (dosync (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0) (ref false) (ref false) prefix per-line-prefix suffix)] (setf :logical-blocks lb) (if (= (getf :mode) :writing) (do (write-white-space this) (when-let [cb (getf :logical-block-callback)] (cb :start)) (if prefix (.write (getf :base) prefix)) (let [col (get-column (getf :base))] (ref-set (:start-col lb) col) (ref-set (:indent lb) col))) (let [oldpos (getf :pos) newpos (+ oldpos (if prefix (count prefix) 0))] (setf :pos newpos) (add-to-buffer this (make-start-block-t lb oldpos newpos))))))) (defn- end-block [^Writer this] (dosync (let [lb (getf :logical-blocks) ^String suffix (:suffix lb)] (if (= (getf :mode) :writing) (do (write-white-space this) (if suffix (.write (getf :base) suffix)) (when-let [cb (getf :logical-block-callback)] (cb :end))) (let [oldpos (getf :pos) newpos (+ oldpos (if suffix (count suffix) 0))] (setf :pos newpos) (add-to-buffer this (make-end-block-t lb oldpos newpos)))) (setf :logical-blocks (:parent lb))))) (defn- nl [^Writer this type] (dosync (setf :mode :buffering) (let [pos (getf :pos)] (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos))))) (defn- indent [^Writer this relative-to offset] (dosync (let [lb (getf :logical-blocks)] (if (= (getf :mode) :writing) (do (write-white-space this) (ref-set (:indent lb) (+ offset (condp = relative-to :block @(:start-col lb) :current (get-column (getf :base)))))) (let [pos (getf :pos)] (add-to-buffer this (make-indent-t lb relative-to offset pos pos))))))) (defn- get-miser-width [^Writer this] (getf :miser-width)) (defn- set-miser-width [^Writer this new-miser-width] (dosync (setf :miser-width new-miser-width))) (defn- set-logical-block-callback [^Writer this f] (dosync (setf :logical-block-callback f))) ================================================ FILE: src/clj/clojure/pprint/print_table.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (in-ns 'clojure.pprint) (defn print-table "Prints a collection of maps in a textual table. Prints table headings ks, and then a line of output for each row, corresponding to the keys in ks. If ks are not specified, use the keys of the first item in rows." {:added "1.3"} ([ks rows] (when (seq rows) (let [widths (map (fn [k] (apply max (count (str k)) (map #(count (str (get % k))) rows))) ks) spacers (map #(apply str (repeat % "-")) widths) fmts (map #(str "%" % "s") widths) fmt-row (fn [leader divider trailer row] (str leader (apply str (interpose divider (for [[col fmt] (map vector (map #(get row %) ks) fmts)] (format fmt (str col))))) trailer))] (println) (println (fmt-row "| " " | " " |" (zipmap ks ks))) (println (fmt-row "|-" "-+-" "-|" (zipmap ks spacers))) (doseq [row rows] (println (fmt-row "| " " | " " |" row)))))) ([rows] (print-table (keys (first rows)) rows))) ================================================ FILE: src/clj/clojure/pprint/utilities.clj ================================================ ;;; utilities.clj -- part of the pretty printer for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 ;; This module implements some utility function used in formatting and pretty ;; printing. The functions here could go in a more general purpose library, ;; perhaps. (in-ns 'clojure.pprint) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helper functions for digesting formats in the various ;;; phases of their lives. ;;; These functions are actually pretty general. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- map-passing-context [func initial-context lis] (loop [context initial-context lis lis acc []] (if (empty? lis) [acc context] (let [this (first lis) remainder (next lis) [result new-context] (apply func [this context])] (recur new-context remainder (conj acc result)))))) (defn- consume [func initial-context] (loop [context initial-context acc []] (let [[result new-context] (apply func [context])] (if (not result) [acc new-context] (recur new-context (conj acc result)))))) (defn- consume-while [func initial-context] (loop [context initial-context acc []] (let [[result continue new-context] (apply func [context])] (if (not continue) [acc context] (recur new-context (conj acc result)))))) (defn- unzip-map [m] "Take a map that has pairs in the value slots and produce a pair of maps, the first having all the first elements of the pairs and the second all the second elements of the pairs" [(into {} (for [[k [v1 v2]] m] [k v1])) (into {} (for [[k [v1 v2]] m] [k v2]))]) (defn- tuple-map [m v1] "For all the values, v, in the map, replace them with [v v1]" (into {} (for [[k v] m] [k [v v1]]))) (defn- rtrim [s c] "Trim all instances of c from the end of sequence s" (let [len (count s)] (if (and (pos? len) (= (nth s (dec (count s))) c)) (loop [n (dec len)] (cond (neg? n) "" (not (= (nth s n) c)) (subs s 0 (inc n)) true (recur (dec n)))) s))) (defn- ltrim [s c] "Trim all instances of c from the beginning of sequence s" (let [len (count s)] (if (and (pos? len) (= (nth s 0) c)) (loop [n 0] (if (or (= n len) (not (= (nth s n) c))) (subs s n) (recur (inc n)))) s))) (defn- prefix-count [aseq val] "Return the number of times that val occurs at the start of sequence aseq, if val is a seq itself, count the number of times any element of val occurs at the beginning of aseq" (let [test (if (coll? val) (set val) #{val})] (loop [pos 0] (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) pos (recur (inc pos)))))) (defn- prerr [& args] "Println to *err*" (binding [*out* *err*] (apply println args))) (defmacro ^{:private true} prlabel [prefix arg & more-args] "Print args to *err* in name = value format" `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) (cons arg (seq more-args)))))) ;; Flush the pretty-print buffer without flushing the underlying stream (definterface PrettyFlush (^void ppflush [])) ================================================ FILE: src/clj/clojure/pprint.clj ================================================ ;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Author: Tom Faulhaber ;; April 3, 2009 (ns ^{:author "Tom Faulhaber", :doc "A Pretty Printer for Clojure clojure.pprint implements a flexible system for printing structured data in a pleasing, easy-to-understand format. Basic use of the pretty printer is simple, just call pprint instead of println. More advanced users can use the building blocks provided to create custom output formats. Out of the box, pprint supports a simple structured format for basic data and a specialized format for Clojure source code. More advanced formats, including formats that don't look like Clojure data at all like XML and JSON, can be rendered by creating custom dispatch functions. In addition to the pprint function, this module contains cl-format, a text formatting function which is fully compatible with the format function in Common Lisp. Because pretty printing directives are directly integrated with cl-format, it supports very concise custom dispatch. It also provides a more powerful alternative to Clojure's standard format function. See documentation for pprint and cl-format for more information or complete documentation on the the clojure web site on github.", :added "1.2"} clojure.pprint (:refer-clojure :exclude (deftype)) (:use [clojure.walk :only [walk]])) (load "pprint/utilities") (load "pprint/column_writer") (load "pprint/pretty_writer") (load "pprint/pprint_base") (load "pprint/cl_format") (load "pprint/dispatch") (load "pprint/print_table") nil ================================================ FILE: src/clj/clojure/reflect/java.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; Java-specific parts of clojure.reflect (in-ns 'clojure.reflect) (require '[clojure.set :as set] '[clojure.string :as str]) (import '[clojure.asm ClassReader ClassVisitor Type Opcodes] '[java.lang.reflect Modifier] java.io.InputStream) (extend-protocol TypeReference clojure.lang.Symbol (typename [s] (str/replace (str s) "<>" "[]")) Class ;; neither .getName not .getSimpleName returns the right thing, so best to delegate to Type (typename [c] (typename (Type/getType c))) Type (typename [t] (-> (.getClassName t)))) (defn- typesym "Given a typeref, create a legal Clojure symbol version of the type's name." [t] (-> (typename t) (str/replace "[]" "<>") (symbol))) (defn- resource-name "Given a typeref, return implied resource name. Used by Reflectors such as ASM that need to find and read classbytes from files." [typeref] (-> (typename typeref) (str/replace "." "/") (str ".class"))) (defn- access-flag [[name flag & contexts]] {:name name :flag flag :contexts (set (map keyword contexts))}) (defn- field-descriptor->class-symbol "Convert a Java field descriptor to a Clojure class symbol. Field descriptors are described in section 4.3.2 of the JVM spec, 2nd ed.: http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html#14152" [^String d] {:pre [(string? d)]} (typesym (Type/getType d))) (defn- internal-name->class-symbol "Convert a Java internal name to a Clojure class symbol. Internal names uses slashes instead of dots, e.g. java/lang/String. See Section 4.2 of the JVM spec, 2nd ed.: http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html#14757" [d] {:pre [(string? d)]} (typesym (Type/getObjectType d))) (def ^{:doc "The Java access bitflags, along with their friendly names and the kinds of objects to which they can apply."} flag-descriptors (vec (map access-flag [[:public 0x0001 :class :field :method] [:private 0x002 :class :field :method] [:protected 0x0004 :class :field :method] [:static 0x0008 :field :method] [:final 0x0010 :class :field :method] ;; :super is ancient history and is unfindable (?) by ;; reflection. skip it #_[:super 0x0020 :class] [:synchronized 0x0020 :method] [:volatile 0x0040 :field] [:bridge 0x0040 :method] [:varargs 0x0080 :method] [:transient 0x0080 :field] [:native 0x0100 :method] [:interface 0x0200 :class] [:abstract 0x0400 :class :method] [:strict 0x0800 :method] [:synthetic 0x1000 :class :field :method] [:annotation 0x2000 :class] [:enum 0x4000 :class :field :inner]]))) (defn- parse-flags "Convert reflection bitflags into a set of keywords." [flags context] (reduce (fn [result fd] (if (and (get (:contexts fd) context) (not (zero? (bit-and flags (:flag fd))))) (conj result (:name fd)) result)) #{} flag-descriptors)) (defrecord Constructor [name declaring-class parameter-types exception-types flags]) (defn- constructor->map [^java.lang.reflect.Constructor constructor] (Constructor. (symbol (.getName constructor)) (typesym (.getDeclaringClass constructor)) (vec (map typesym (.getParameterTypes constructor))) (vec (map typesym (.getExceptionTypes constructor))) (parse-flags (.getModifiers constructor) :method))) (defn- declared-constructors "Return a set of the declared constructors of class as a Clojure map." [^Class cls] (set (map constructor->map (.getDeclaredConstructors cls)))) (defrecord Method [name return-type declaring-class parameter-types exception-types flags]) (defn- method->map [^java.lang.reflect.Method method] (Method. (symbol (.getName method)) (typesym (.getReturnType method)) (typesym (.getDeclaringClass method)) (vec (map typesym (.getParameterTypes method))) (vec (map typesym (.getExceptionTypes method))) (parse-flags (.getModifiers method) :method))) (defn- declared-methods "Return a set of the declared constructors of class as a Clojure map." [^Class cls] (set (map method->map (.getDeclaredMethods cls)))) (defrecord Field [name type declaring-class flags]) (defn- field->map [^java.lang.reflect.Field field] (Field. (symbol (.getName field)) (typesym (.getType field)) (typesym (.getDeclaringClass field)) (parse-flags (.getModifiers field) :field))) (defn- declared-fields "Return a set of the declared fields of class as a Clojure map." [^Class cls] (set (map field->map (.getDeclaredFields cls)))) (deftype JavaReflector [classloader] Reflector (do-reflect [_ typeref] (let [cls (clojure.lang.RT/classForName (typename typeref) false classloader)] {:bases (not-empty (set (map typesym (bases cls)))) :flags (parse-flags (.getModifiers cls) :class) :members (set/union (declared-fields cls) (declared-methods cls) (declared-constructors cls))}))) (def ^:private default-reflector (JavaReflector. (.getContextClassLoader (Thread/currentThread)))) (defn- parse-method-descriptor [^String md] {:parameter-types (vec (map typesym (Type/getArgumentTypes md))) :return-type (typesym (Type/getReturnType md))}) (defprotocol ClassResolver (^InputStream resolve-class [this name] "Given a class name, return that typeref's class bytes as an InputStream.")) (extend-protocol ClassResolver clojure.lang.Fn (resolve-class [this typeref] (this typeref)) ClassLoader (resolve-class [this typeref] (.getResourceAsStream this (resource-name typeref)))) (deftype AsmReflector [class-resolver] Reflector (do-reflect [_ typeref] (with-open [is (resolve-class class-resolver typeref)] (let [class-symbol (typesym typeref) r (ClassReader. is) result (atom {:bases #{} :flags #{} :members #{}})] (.accept r (proxy [ClassVisitor] [Opcodes/ASM4] (visit [version access name signature superName interfaces] (let [flags (parse-flags access :class) ;; ignore java.lang.Object on interfaces to match reflection superName (if (and (flags :interface) (= superName "java/lang/Object")) nil superName) bases (->> (cons superName interfaces) (remove nil?) (map internal-name->class-symbol) (map symbol) (set) (not-empty))] (swap! result merge {:bases bases :flags flags}))) (visitAnnotation [desc visible]) (visitSource [name debug]) (visitInnerClass [name outerName innerName access]) (visitField [access name desc signature value] (swap! result update :members (fnil conj #{}) (Field. (symbol name) (field-descriptor->class-symbol desc) class-symbol (parse-flags access :field))) nil) (visitMethod [access name desc signature exceptions] (when-not (= name "") (let [constructor? (= name "")] (swap! result update :members (fnil conj #{}) (let [{:keys [parameter-types return-type]} (parse-method-descriptor desc) flags (parse-flags access :method)] (if constructor? (Constructor. class-symbol class-symbol parameter-types (vec (map internal-name->class-symbol exceptions)) flags) (Method. (symbol name) return-type class-symbol parameter-types (vec (map internal-name->class-symbol exceptions)) flags)))))) nil) (visitEnd []) ) 0) @result)))) ================================================ FILE: src/clj/clojure/reflect.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:author "Stuart Halloway" :added "1.3" :doc "Reflection on Host Types Alpha - subject to change. Two main entry points: * type-reflect reflects on something that implements TypeReference. * reflect (for REPL use) reflects on the class of an instance, or on a class if passed a class Key features: * Exposes the read side of reflection as pure data. Reflecting on a type returns a map with keys :bases, :flags, and :members. * Canonicalizes class names as Clojure symbols. Types can extend to the TypeReference protocol to indicate that they can be unambiguously resolved as a type name. The canonical format requires one non-Java-ish convention: array brackets are <> instead of [] so they can be part of a Clojure symbol. * Pluggable Reflectors for different implementations. The default JavaReflector is good when you have a class in hand, or use the AsmReflector for \"hands off\" reflection without forcing classes to load. Platform implementers must: * Create an implementation of Reflector. * Create one or more implementations of TypeReference. * def default-reflector to be an instance that satisfies Reflector."} clojure.reflect (:require [clojure.set :as set])) (defprotocol Reflector "Protocol for reflection implementers." (do-reflect [reflector typeref])) (defprotocol TypeReference "A TypeReference can be unambiguously converted to a type name on the host platform. All typerefs are normalized into symbols. If you need to normalize a typeref yourself, call typesym." (typename [o] "Returns Java name as returned by ASM getClassName, e.g. byte[], java.lang.String[]")) (declare default-reflector) (defn type-reflect "Alpha - subject to change. Reflect on a typeref, returning a map with :bases, :flags, and :members. In the discussion below, names are always Clojure symbols. :bases a set of names of the type's bases :flags a set of keywords naming the boolean attributes of the type. :members a set of the type's members. Each member is a map and can be a constructor, method, or field. Keys common to all members: :name name of the type :declaring-class name of the declarer :flags keyword naming boolean attributes of the member Keys specific to constructors: :parameter-types vector of parameter type names :exception-types vector of exception type names Key specific to methods: :parameter-types vector of parameter type names :exception-types vector of exception type names :return-type return type name Keys specific to fields: :type type name Options: :ancestors in addition to the keys described above, also include an :ancestors key with the entire set of ancestors, and add all ancestor members to :members. :reflector implementation to use. Defaults to JavaReflector, AsmReflector is also an option." {:added "1.3"} [typeref & options] (let [{:keys [ancestors reflector]} (merge {:reflector default-reflector} (apply hash-map options)) refl (partial do-reflect reflector) result (refl typeref)] ;; could make simpler loop of two args: names an (if ancestors (let [make-ancestor-map (fn [names] (zipmap names (map refl names)))] (loop [reflections (make-ancestor-map (:bases result))] (let [ancestors-visited (set (keys reflections)) ancestors-to-visit (set/difference (set (mapcat :bases (vals reflections))) ancestors-visited)] (if (seq ancestors-to-visit) (recur (merge reflections (make-ancestor-map ancestors-to-visit))) (apply merge-with into result {:ancestors ancestors-visited} (map #(select-keys % [:members]) (vals reflections))))))) result))) (defn reflect "Alpha - subject to change. Reflect on the type of obj (or obj itself if obj is a class). Return value and options are the same as for type-reflect. " {:added "1.3"} [obj & options] (apply type-reflect (if (class? obj) obj (class obj)) options)) (load "reflect/java") ================================================ FILE: src/clj/clojure/remoterepl.clj ================================================ (ns clojure.remoterepl (:import [java.net ServerSocket Socket] [clojure.lang LineNumberingPushbackReader] [java.io PrintWriter InputStreamReader OutputStreamWriter])) (defn uuid [] (str (java.util.UUID/randomUUID))) (def server1 (atom nil)) (def server2 (atom nil)) (def repl-main-thread (atom nil)) (def socket (atom nil)) (def socket1 (atom nil)) (def socket2 (atom nil)) (defn socket-println [s d] (let [c (str (count (.getBytes d "UTF-8")))] (.println s (str (apply str (for [n (range (- 10 (count c)))] " ")) c)) (.println s d))) (defn process-msg [out f] (let [[run-in-main id f args] f] (->> [id (binding [force-main-thread true] (apply f args))] pr-str (socket-println out)))) (defn call-remote [sel args] (let [args (vec args) id (keyword (uuid))] (socket-println (:out @socket) (pr-str [(or (= (Thread/currentThread) @repl-main-thread) force-main-thread) id sel args])) (loop [msg (read (:in @socket))] (if (instance? String msg) (throw (Exception. msg)) (if (= 2 (count msg)) (let [[rid r] msg] (if (= rid id) r (do (socket-println (:out @socket) (pr-str [:retry id])) ; retries until the sender gets the response (recur (read (:in @socket)))))) (do (process-msg (:out @socket) msg) (recur (read (:in @socket))))))))) (defn start-remote-repl [] (clojure.lang.RemoteRef/reset) (let [s (.accept @server1) s2 (.accept @server2) out (PrintWriter. (.getOutputStream s) true) in (LineNumberingPushbackReader. (InputStreamReader. (.getInputStream s))) out2 (PrintWriter. (.getOutputStream s2) true) in2 (LineNumberingPushbackReader. (InputStreamReader. (.getInputStream s2)))] (clojure.lang.RemoteRepl/setConnected true) (reset! socket {:out out :in in}) (reset! socket1 {:out out :in in}) (reset! socket2 {:out out2 :in in2}) (future (try (loop [f (read in2)] (let [s @socket] (reset! socket @socket2) (process-msg out2 f) (reset! socket s)) (recur (read in2))) (catch Exception e (println "REPL DISCONNECTED") (.printStackTrace e) (.close s) (.close s2) (start-remote-repl)))))) (defn connected? [] clojure.lang.RemoteRepl/connected) (defn listen [] (reset! repl-main-thread (Thread/currentThread)) (reset! server1 (ServerSocket. 35813)) (reset! server2 (ServerSocket. 35814)) (start-remote-repl)) ================================================ FILE: src/clj/clojure/repl.clj ================================================ ; Copyright (c) Chris Houser, Dec 2008. All rights reserved. ; The use and distribution terms for this software are covered by the ; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) ; which can be found in the file CPL.TXT at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ; Utilities meant to be used interactively at the REPL (ns ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim" :doc "Utilities meant to be used interactively at the REPL"} clojure.repl (:import (java.io LineNumberReader InputStreamReader PushbackReader) (clojure.lang RT Reflector))) (def ^:private special-doc-map '{. {:url "java_interop#dot" :forms [(.instanceMember instance args*) (.instanceMember Classname args*) (Classname/staticMethod args*) Classname/staticField] :doc "The instance member form works for both fields and methods. They all expand into calls to the dot operator at macroexpansion time."} def {:forms [(def symbol doc-string? init?)] :doc "Creates and interns a global var with the name of symbol in the current namespace (*ns*) or locates such a var if it already exists. If init is supplied, it is evaluated, and the root binding of the var is set to the resulting value. If init is not supplied, the root binding of the var is unaffected."} do {:forms [(do exprs*)] :doc "Evaluates the expressions in order and returns the value of the last. If no expressions are supplied, returns nil."} if {:forms [(if test then else?)] :doc "Evaluates test. If not the singular values nil or false, evaluates and yields then, otherwise, evaluates and yields else. If else is not supplied it defaults to nil."} monitor-enter {:forms [(monitor-enter x)] :doc "Synchronization primitive that should be avoided in user code. Use the 'locking' macro."} monitor-exit {:forms [(monitor-exit x)] :doc "Synchronization primitive that should be avoided in user code. Use the 'locking' macro."} new {:forms [(Classname. args*) (new Classname args*)] :url "java_interop#new" :doc "The args, if any, are evaluated from left to right, and passed to the constructor of the class named by Classname. The constructed object is returned."} quote {:forms [(quote form)] :doc "Yields the unevaluated form."} recur {:forms [(recur exprs*)] :doc "Evaluates the exprs in order, then, in parallel, rebinds the bindings of the recursion point to the values of the exprs. Execution then jumps back to the recursion point, a loop or fn method."} set! {:forms[(set! var-symbol expr) (set! (. instance-expr instanceFieldName-symbol) expr) (set! (. Classname-symbol staticFieldName-symbol) expr)] :url "vars#set" :doc "Used to set thread-local-bound vars, Java object instance fields, and Java class static fields."} throw {:forms [(throw expr)] :doc "The expr is evaluated and thrown, therefore it should yield an instance of some derivee of Throwable."} try {:forms [(try expr* catch-clause* finally-clause?)] :doc "catch-clause => (catch classname name expr*) finally-clause => (finally expr*) Catches and handles Java exceptions."} var {:forms [(var symbol)] :doc "The symbol must resolve to a var, and the Var object itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (defn- special-doc [name-symbol] (assoc (or (special-doc-map name-symbol) (meta (resolve name-symbol))) :name name-symbol :special-form true)) (defn- namespace-doc [nspace] (assoc (meta nspace) :name (ns-name nspace))) (defn- print-doc [m] (println "-------------------------") (println (str (when-let [ns (:ns m)] (str (ns-name ns) "/")) (:name m))) (cond (:forms m) (doseq [f (:forms m)] (print " ") (prn f)) (:arglists m) (prn (:arglists m))) (if (:special-form m) (do (println "Special Form") (println " " (:doc m)) (if (contains? m :url) (when (:url m) (println (str "\n Please see http://clojure.org/" (:url m)))) (println (str "\n Please see http://clojure.org/special_forms#" (:name m))))) (do (when (:macro m) (println "Macro")) (println " " (:doc m))))) (defn find-doc "Prints documentation for any var whose documentation or name contains a match for re-string-or-pattern" {:added "1.0"} [re-string-or-pattern] (let [re (re-pattern re-string-or-pattern) ms (concat (mapcat #(sort-by :name (map meta (vals (ns-interns %)))) (all-ns)) (map namespace-doc (all-ns)) (map special-doc (keys special-doc-map)))] (doseq [m ms :when (and (:doc m) (or (re-find (re-matcher re (:doc m))) (re-find (re-matcher re (str (:name m))))))] (print-doc m)))) (defmacro doc "Prints documentation for a var or special form given its name" {:added "1.0"} [name] (if-let [special-name ('{& fn catch try finally try} name)] (#'print-doc (#'special-doc special-name)) (cond (special-doc-map name) `(#'print-doc (#'special-doc '~name)) (find-ns name) `(#'print-doc (#'namespace-doc (find-ns '~name))) (resolve name) `(#'print-doc (meta (var ~name)))))) ;; ---------------------------------------------------------------------- ;; Examine Clojure functions (Vars, really) (defn source-fn "Returns a string of the source code for the given symbol, if it can find it. This requires that the symbol resolve to a Var defined in a namespace for which the .clj is in the classpath. Returns nil if it can't find the source. For most REPL usage, 'source' is more convenient. Example: (source-fn 'filter)" [x] (when-let [v (resolve x)] (when-let [filepath (:file (meta v))] (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)] (with-open [rdr (LineNumberReader. (InputStreamReader. strm))] (dotimes [_ (dec (:line (meta v)))] (.readLine rdr)) (let [text (StringBuilder.) pbr (proxy [PushbackReader] [rdr] (read [] (let [i (proxy-super read)] (.append text (char i)) i))) read-opts (if (.endsWith ^String filepath "cljc") {:read-cond :allow} {})] (if (= :unknown *read-eval*) (throw (IllegalStateException. "Unable to read source while *read-eval* is :unknown.")) (read read-opts (PushbackReader. pbr))) (str text))))))) (defmacro source "Prints the source code for the given symbol, if it can find it. This requires that the symbol resolve to a Var defined in a namespace for which the .clj is in the classpath. Example: (source filter)" [n] `(println (or (source-fn '~n) (str "Source not found")))) (defn apropos "Given a regular expression or stringable thing, return a seq of all public definitions in all currently-loaded namespaces that match the str-or-pattern." [str-or-pattern] (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) #(re-find str-or-pattern (str %)) #(.contains (str %) (str str-or-pattern)))] (sort (mapcat (fn [ns] (let [ns-name (str ns)] (map #(symbol ns-name (str %)) (filter matches? (keys (ns-publics ns)))))) (all-ns))))) (defn dir-fn "Returns a sorted seq of symbols naming public vars in a namespace" [ns] (sort (map first (ns-publics (the-ns ns))))) (defmacro dir "Prints a sorted directory of public vars in a namespace" [nsname] `(doseq [v# (dir-fn '~nsname)] (println v#))) (defn demunge "Given a string representation of a fn class, as in a stack trace element, returns a readable version." {:added "1.3"} [fn-name] (clojure.lang.Compiler/demunge fn-name)) (defn root-cause "Returns the initial cause of an exception or error by peeling off all of its wrappers" {:added "1.3"} [^Throwable t] (loop [cause t] (if (and (instance? clojure.lang.Compiler$CompilerException cause) (not= (.source ^clojure.lang.Compiler$CompilerException cause) "NO_SOURCE_FILE")) cause (if-let [cause (.getCause cause)] (recur cause) cause)))) (defn stack-element-str "Returns a (possibly unmunged) string representation of a StackTraceElement" {:added "1.3"} [^StackTraceElement el] (let [file (.getFileName el) clojure-fn? (and file (or (.endsWith file ".clj") (.endsWith file ".cljc") (= file "NO_SOURCE_FILE")))] (str (if clojure-fn? (demunge (.getClassName el)) (str (.getClassName el) "." (.getMethodName el))) " (" (.getFileName el) ":" (.getLineNumber el) ")"))) (defn pst "Prints a stack trace of the exception, to the depth requested. If none supplied, uses the root cause of the most recent repl exception (*e), and a depth of 12." {:added "1.3"} ([] (pst 12)) ([e-or-depth] (if (instance? Throwable e-or-depth) (pst e-or-depth 12) (when-let [e *e] (pst (root-cause e) e-or-depth)))) ([^Throwable e depth] (binding [*out* *err*] (println (str (-> e class .getSimpleName) " " (.getMessage e) (when-let [info (ex-data e)] (str " " (pr-str info))))) (let [st (.getStackTrace e) cause (.getCause e)] (doseq [el (take depth (remove #(#{"clojure.lang.RestFn" "clojure.lang.AFn"} (.getClassName %)) st))] (println (str \tab (stack-element-str el)))) (when cause (println "Caused by:") (pst cause (min depth (+ 2 (- (count (.getStackTrace cause)) (count st)))))))))) ;; ---------------------------------------------------------------------- ;; Handle Ctrl-C keystrokes (defn thread-stopper "Returns a function that takes one arg and uses that as an exception message to stop the given thread. Defaults to the current thread" ([] (thread-stopper (Thread/currentThread))) ([thread] (fn [msg] (.stop thread (Error. msg))))) (defn set-break-handler! "Register INT signal handler. After calling this, Ctrl-C will cause the given function f to be called with a single argument, the signal. Uses thread-stopper if no function given." ([] (set-break-handler! (thread-stopper))) ([f] (sun.misc.Signal/handle (sun.misc.Signal. "INT") (proxy [sun.misc.SignalHandler] [] (handle [signal] (f (str "-- caught signal " signal))))))) ================================================ FILE: src/clj/clojure/set.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Set operations such as union/intersection." :author "Rich Hickey"} clojure.set) (defn- bubble-max-key [k coll] "Move a maximal element of coll according to fn k (which returns a number) to the front of coll." (let [max (apply max-key k coll)] (cons max (remove #(identical? max %) coll)))) (defn union "Return a set that is the union of the input sets" {:added "1.0"} ([] #{}) ([s1] s1) ([s1 s2] (if (< (count s1) (count s2)) (reduce conj s2 s1) (reduce conj s1 s2))) ([s1 s2 & sets] (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))] (reduce into (first bubbled-sets) (rest bubbled-sets))))) (defn intersection "Return a set that is the intersection of the input sets" {:added "1.0"} ([s1] s1) ([s1 s2] (if (< (count s2) (count s1)) (recur s2 s1) (reduce (fn [result item] (if (contains? s2 item) result (disj result item))) s1 s1))) ([s1 s2 & sets] (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))] (reduce intersection (first bubbled-sets) (rest bubbled-sets))))) (defn difference "Return a set that is the first set without elements of the remaining sets" {:added "1.0"} ([s1] s1) ([s1 s2] (if (< (count s1) (count s2)) (reduce (fn [result item] (if (contains? s2 item) (disj result item) result)) s1 s1) (reduce disj s1 s2))) ([s1 s2 & sets] (reduce difference s1 (conj sets s2)))) (defn select "Returns a set of the elements for which pred is true" {:added "1.0"} [pred xset] (reduce (fn [s k] (if (pred k) s (disj s k))) xset xset)) (defn project "Returns a rel of the elements of xrel with only the keys in ks" {:added "1.0"} [xrel ks] (with-meta (set (map #(select-keys % ks) xrel)) (meta xrel))) (defn rename-keys "Returns the map with the keys in kmap renamed to the vals in kmap" {:added "1.0"} [map kmap] (reduce (fn [m [old new]] (if (contains? map old) (assoc m new (get map old)) m)) (apply dissoc map (keys kmap)) kmap)) (defn rename "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap" {:added "1.0"} [xrel kmap] (with-meta (set (map #(rename-keys % kmap) xrel)) (meta xrel))) (defn index "Returns a map of the distinct values of ks in the xrel mapped to a set of the maps in xrel with the corresponding values of ks." {:added "1.0"} [xrel ks] (reduce (fn [m x] (let [ik (select-keys x ks)] (assoc m ik (conj (get m ik #{}) x)))) {} xrel)) (defn map-invert "Returns the map with the vals mapped to the keys." {:added "1.0"} [m] (reduce (fn [m [k v]] (assoc m v k)) {} m)) (defn join "When passed 2 rels, returns the rel corresponding to the natural join. When passed an additional keymap, joins on the corresponding keys." {:added "1.0"} ([xrel yrel] ;natural join (if (and (seq xrel) (seq yrel)) (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel)))) [r s] (if (<= (count xrel) (count yrel)) [xrel yrel] [yrel xrel]) idx (index r ks)] (reduce (fn [ret x] (let [found (idx (select-keys x ks))] (if found (reduce #(conj %1 (merge %2 x)) ret found) ret))) #{} s)) #{})) ([xrel yrel km] ;arbitrary key mapping (let [[r s k] (if (<= (count xrel) (count yrel)) [xrel yrel (map-invert km)] [yrel xrel km]) idx (index r (vals k))] (reduce (fn [ret x] (let [found (idx (rename-keys (select-keys x (keys k)) k))] (if found (reduce #(conj %1 (merge %2 x)) ret found) ret))) #{} s)))) (defn subset? "Is set1 a subset of set2?" {:added "1.2", :tag Boolean} [set1 set2] (and (<= (count set1) (count set2)) (every? #(contains? set2 %) set1))) (defn superset? "Is set1 a superset of set2?" {:added "1.2", :tag Boolean} [set1 set2] (and (>= (count set1) (count set2)) (every? #(contains? set1 %) set2))) (comment (refer 'set) (def xs #{{:a 11 :b 1 :c 1 :d 4} {:a 2 :b 12 :c 2 :d 6} {:a 3 :b 3 :c 3 :d 8 :f 42}}) (def ys #{{:a 11 :b 11 :c 11 :e 5} {:a 12 :b 11 :c 12 :e 3} {:a 3 :b 3 :c 3 :e 7 }}) (join xs ys) (join xs (rename ys {:b :yb :c :yc}) {:a :a}) (union #{:a :b :c} #{:c :d :e }) (difference #{:a :b :c} #{:c :d :e}) (intersection #{:a :b :c} #{:c :d :e}) (index ys [:b]) ) ================================================ FILE: src/clj/clojure/stacktrace.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; stacktrace.clj: print Clojure-centric stack traces ;; by Stuart Sierra ;; January 6, 2009 (ns ^{:doc "Print stack traces oriented towards Clojure, not Java." :author "Stuart Sierra"} clojure.stacktrace) (defn root-cause "Returns the last 'cause' Throwable in a chain of Throwables." {:added "1.1"} [^Throwable tr] (if-let [cause (.getCause tr)] (recur cause) tr)) (defn print-trace-element "Prints a Clojure-oriented view of one element in a stack trace." {:added "1.1"} [^StackTraceElement e] (let [class (.getClassName e) method (.getMethodName e)] (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" (str class))] (if (and match (= "invoke" method)) (apply printf "%s/%s" (rest match)) (printf "%s.%s" class method)))) (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e))) (defn print-throwable "Prints the class and message of a Throwable." {:added "1.1"} [^Throwable tr] (printf "%s: %s" (.getName (class tr)) (.getMessage tr))) (defn print-stack-trace "Prints a Clojure-oriented stack trace of tr, a Throwable. Prints a maximum of n stack frames (default: unlimited). Does not print chained exceptions (causes)." {:added "1.1"} ([tr] (print-stack-trace tr nil)) ([^Throwable tr n] (let [^StackTraceElement st (.getStackTrace tr)] (print-throwable tr) (newline) (print " at ") (if-let [e (first st)] (print-trace-element e) (print "[empty stack trace]")) (newline) (doseq [e (if (nil? n) (rest st) (take (dec n) (rest st)))] (print " ") (print-trace-element e) (newline))))) (defn print-cause-trace "Like print-stack-trace but prints chained exceptions (causes)." {:added "1.1"} ([^Throwable tr] (print-cause-trace tr nil)) ([^Throwable tr n] (print-stack-trace tr n) (when-let [cause (.getCause tr)] (print "Caused by: " ) (recur cause n)))) (defn e "REPL utility. Prints a brief stack trace for the root cause of the most recent exception." {:added "1.1"} [] (print-stack-trace (root-cause *e) 8)) ================================================ FILE: src/clj/clojure/string.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "Clojure String utilities It is poor form to (:use clojure.string). Instead, use require with :as to specify a prefix, e.g. (ns your.namespace.here (:require [clojure.string :as str])) Design notes for clojure.string: 1. Strings are objects (as opposed to sequences). As such, the string being manipulated is the first argument to a function; passing nil will result in a NullPointerException unless documented otherwise. If you want sequence-y behavior instead, use a sequence. 2. Functions are generally not lazy, and call straight to host methods where those are available and efficient. 3. Functions take advantage of String implementation details to write high-performing loop/recurs instead of using higher-order functions. (This is not idiomatic in general-purpose application code.) 4. When a function is documented to accept a string argument, it will take any implementation of the correct *interface* on the host platform. In Java, this is CharSequence, which is more general than String. In ordinary usage you will almost always pass concrete strings. If you are doing something unusual, e.g. passing a mutable implementation of CharSequence, then thread-safety is your responsibility." :author "Stuart Sierra, Stuart Halloway, David Liebke"} clojure.string (:refer-clojure :exclude (replace reverse)) (:import (java.util.regex Pattern Matcher) clojure.lang.LazilyPersistentVector)) (defn ^String reverse "Returns s with its characters reversed." {:added "1.2"} [^CharSequence s] (.toString (.reverse (StringBuilder. s)))) (defn ^String re-quote-replacement "Given a replacement string that you wish to be a literal replacement for a pattern match in replace or replace-first, do the necessary escaping of special characters in the replacement." {:added "1.5"} [^CharSequence replacement] (Matcher/quoteReplacement (.toString ^CharSequence replacement))) (defn- replace-by [^CharSequence s re f] (let [m (re-matcher re s)] (if (.find m) (let [buffer (StringBuffer. (.length s))] (loop [found true] (if found (do (.appendReplacement m buffer (Matcher/quoteReplacement (f (re-groups m)))) (recur (.find m))) (do (.appendTail m buffer) (.toString buffer))))) s))) (defn ^String replace "Replaces all instance of match with replacement in s. match/replacement can be: string / string char / char pattern / (string or function of match). See also replace-first. The replacement is literal (i.e. none of its characters are treated specially) for all cases above except pattern / string. For pattern / string, $1, $2, etc. in the replacement string are substituted with the string that matched the corresponding parenthesized group in the pattern. If you wish your replacement string r to be used literally, use (re-quote-replacement r) as the replacement argument. See also documentation for java.util.regex.Matcher's appendReplacement method. Example: (clojure.string/replace \"Almost Pig Latin\" #\"\\b(\\w)(\\w+)\\b\" \"$2$1ay\") -> \"lmostAay igPay atinLay\"" {:added "1.2"} [^CharSequence s match replacement] (let [s (.toString s)] (cond (instance? Character match) (.replace s ^Character match ^Character replacement) (instance? CharSequence match) (.replace s ^CharSequence match ^CharSequence replacement) (instance? Pattern match) (if (instance? CharSequence replacement) (.replaceAll (re-matcher ^Pattern match s) (.toString ^CharSequence replacement)) (replace-by s match replacement)) :else (throw (IllegalArgumentException. (str "Invalid match arg: " match)))))) (defn- replace-first-by [^CharSequence s ^Pattern re f] (let [m (re-matcher re s)] (if (.find m) (let [buffer (StringBuffer. (.length s)) rep (Matcher/quoteReplacement (f (re-groups m)))] (.appendReplacement m buffer rep) (.appendTail m buffer) (str buffer)) s))) (defn- replace-first-char [^CharSequence s ^Character match replace] (let [s (.toString s) i (.indexOf s (int match))] (if (= -1 i) s (str (subs s 0 i) replace (subs s (inc i)))))) (defn- replace-first-str [^CharSequence s ^String match ^String replace] (let [^String s (.toString s) i (.indexOf s match)] (if (= -1 i) s (str (subs s 0 i) replace (subs s (+ i (.length match))))))) (defn ^String replace-first "Replaces the first instance of match with replacement in s. match/replacement can be: char / char string / string pattern / (string or function of match). See also replace. The replacement is literal (i.e. none of its characters are treated specially) for all cases above except pattern / string. For pattern / string, $1, $2, etc. in the replacement string are substituted with the string that matched the corresponding parenthesized group in the pattern. If you wish your replacement string r to be used literally, use (re-quote-replacement r) as the replacement argument. See also documentation for java.util.regex.Matcher's appendReplacement method. Example: (clojure.string/replace-first \"swap first two words\" #\"(\\w+)(\\s+)(\\w+)\" \"$3$2$1\") -> \"first swap two words\"" {:added "1.2"} [^CharSequence s match replacement] (let [s (.toString s)] (cond (instance? Character match) (replace-first-char s match replacement) (instance? CharSequence match) (replace-first-str s (.toString ^CharSequence match) (.toString ^CharSequence replacement)) (instance? Pattern match) (if (instance? CharSequence replacement) (.replaceFirst (re-matcher ^Pattern match s) (.toString ^CharSequence replacement)) (replace-first-by s match replacement)) :else (throw (IllegalArgumentException. (str "Invalid match arg: " match)))))) (defn ^String join "Returns a string of all elements in coll, as returned by (seq coll), separated by an optional separator." {:added "1.2"} ([coll] (apply str coll)) ([separator coll] (loop [sb (StringBuilder. (str (first coll))) more (next coll) sep (str separator)] (if more (recur (-> sb (.append sep) (.append (str (first more)))) (next more) sep) (str sb))))) (defn ^String capitalize "Converts first character of the string to upper-case, all other characters to lower-case." {:added "1.2"} [^CharSequence s] (let [s (.toString s)] (if (< (count s) 2) (.toUpperCase s) (str (.toUpperCase (subs s 0 1)) (.toLowerCase (subs s 1)))))) (defn ^String upper-case "Converts string to all upper-case." {:added "1.2"} [^CharSequence s] (.. s toString toUpperCase)) (defn ^String lower-case "Converts string to all lower-case." {:added "1.2"} [^CharSequence s] (.. s toString toLowerCase)) (defn split "Splits string on a regular expression. Optional argument limit is the maximum number of splits. Not lazy. Returns vector of the splits." {:added "1.2"} ([^CharSequence s ^Pattern re] (LazilyPersistentVector/createOwning (.split re s))) ([ ^CharSequence s ^Pattern re limit] (LazilyPersistentVector/createOwning (.split re s limit)))) (defn split-lines "Splits s on \\n or \\r\\n." {:added "1.2"} [^CharSequence s] (split s #"\r?\n")) (defn ^String trim "Removes whitespace from both ends of string." {:added "1.2"} [^CharSequence s] (let [len (.length s)] (loop [rindex len] (if (zero? rindex) "" (if (Character/isWhitespace (.charAt s (dec rindex))) (recur (dec rindex)) ;; there is at least one non-whitespace char in the string, ;; so no need to check for lindex reaching len. (loop [lindex 0] (if (Character/isWhitespace (.charAt s lindex)) (recur (inc lindex)) (.. s (subSequence lindex rindex) toString)))))))) (defn ^String triml "Removes whitespace from the left side of string." {:added "1.2"} [^CharSequence s] (let [len (.length s)] (loop [index 0] (if (= len index) "" (if (Character/isWhitespace (.charAt s index)) (recur (unchecked-inc index)) (.. s (subSequence index len) toString)))))) (defn ^String trimr "Removes whitespace from the right side of string." {:added "1.2"} [^CharSequence s] (loop [index (.length s)] (if (zero? index) "" (if (Character/isWhitespace (.charAt s (unchecked-dec index))) (recur (unchecked-dec index)) (.. s (subSequence 0 index) toString))))) (defn ^String trim-newline "Removes all trailing newline \\n or return \\r characters from string. Similar to Perl's chomp." {:added "1.2"} [^CharSequence s] (loop [index (.length s)] (if (zero? index) "" (let [ch (.charAt s (dec index))] (if (or (= ch \newline) (= ch \return)) (recur (dec index)) (.. s (subSequence 0 index) toString)))))) (defn blank? "True if s is nil, empty, or contains only whitespace." {:added "1.2"} [^CharSequence s] (if s (loop [index (int 0)] (if (= (.length s) index) true (if (Character/isWhitespace (.charAt s index)) (recur (inc index)) false))) true)) (defn ^String escape "Return a new string, using cmap to escape each character ch from s as follows: If (cmap ch) is nil, append ch to the new string. If (cmap ch) is non-nil, append (str (cmap ch)) instead." {:added "1.2"} [^CharSequence s cmap] (loop [index (int 0) buffer (StringBuilder. (.length s))] (if (= (.length s) index) (.toString buffer) (let [ch (.charAt s index)] (if-let [replacement (cmap ch)] (.append buffer replacement) (.append buffer ch)) (recur (inc index) buffer))))) ================================================ FILE: src/clj/clojure/template.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; template.clj - anonymous functions that pre-evaluate sub-expressions ;; By Stuart Sierra ;; June 23, 2009 ;; CHANGE LOG ;; ;; June 23, 2009: complete rewrite, eliminated _1,_2,... argument ;; syntax ;; ;; January 20, 2009: added "template?" and checks for valid template ;; expressions. ;; ;; December 15, 2008: first version (ns ^{:doc "Macros that expand to repeated copies of a template expression." :author "Stuart Sierra"} clojure.template (:require [clojure.walk :as walk])) (defn apply-template "For use in macros. argv is an argument list, as in defn. expr is a quoted expression using the symbols in argv. values is a sequence of values to be used for the arguments. apply-template will recursively replace argument symbols in expr with their corresponding values, returning a modified expr. Example: (apply-template '[x] '(+ x x) '[2]) ;=> (+ 2 2)" [argv expr values] (assert (vector? argv)) (assert (every? symbol? argv)) (walk/prewalk-replace (zipmap argv values) expr)) (defmacro do-template "Repeatedly copies expr (in a do block) for each group of arguments in values. values are automatically partitioned by the number of arguments in argv, an argument vector as in defn. Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5)) ;=> (do (+ 4 2) (+ 5 3))" [argv expr & values] (let [c (count argv)] `(do ~@(map (fn [a] (apply-template argv expr a)) (partition c values))))) ================================================ FILE: src/clj/clojure/test/junit.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;; test/junit.clj: Extension to clojure.test for JUnit-compatible XML output ;; by Jason Sankey ;; June 2009 ;; DOCUMENTATION ;; (ns ^{:doc "clojure.test extension for JUnit-compatible XML output. JUnit (http://junit.org/) is the most popular unit-testing library for Java. As such, tool support for JUnit output formats is common. By producing compatible output from tests, this tool support can be exploited. To use, wrap any calls to clojure.test/run-tests in the with-junit-output macro, like this: (use 'clojure.test) (use 'clojure.test.junit) (with-junit-output (run-tests 'my.cool.library)) To write the output to a file, rebind clojure.test/*test-out* to your own PrintWriter (perhaps opened using clojure.java.io/writer)." :author "Jason Sankey"} clojure.test.junit (:require [clojure.stacktrace :as stack] [clojure.test :as t])) ;; copied from clojure.contrib.lazy-xml (def ^{:private true} escape-xml-map (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp]))) (defn- escape-xml [text] (apply str (map #(escape-xml-map % %) text))) (def ^:dynamic *var-context*) (def ^:dynamic *depth*) (defn indent [] (dotimes [n (* *depth* 4)] (print " "))) (defn start-element [tag pretty & [attrs]] (if pretty (indent)) (print (str "<" tag)) (if (seq attrs) (doseq [[key value] attrs] (print (str " " (name key) "=\"" (escape-xml value) "\"")))) (print ">") (if pretty (println)) (set! *depth* (inc *depth*))) (defn element-content [content] (print (escape-xml content))) (defn finish-element [tag pretty] (set! *depth* (dec *depth*)) (if pretty (indent)) (print (str "")) (if pretty (println))) (defn test-name [vars] (apply str (interpose "." (reverse (map #(:name (meta %)) vars))))) (defn package-class [name] (let [i (.lastIndexOf name ".")] (if (< i 0) [nil name] [(.substring name 0 i) (.substring name (+ i 1))]))) (defn start-case [name classname] (start-element 'testcase true {:name name :classname classname})) (defn finish-case [] (finish-element 'testcase true)) (defn suite-attrs [package classname] (let [attrs {:name classname}] (if package (assoc attrs :package package) attrs))) (defn start-suite [name] (let [[package classname] (package-class name)] (start-element 'testsuite true (suite-attrs package classname)))) (defn finish-suite [] (finish-element 'testsuite true)) (defn message-el [tag message expected-str actual-str] (indent) (start-element tag false (if message {:message message} {})) (element-content (let [[file line] (t/file-position 5) detail (apply str (interpose "\n" [(str "expected: " expected-str) (str " actual: " actual-str) (str " at: " file ":" line)]))] (if message (str message "\n" detail) detail))) (finish-element tag false) (println)) (defn failure-el [message expected actual] (message-el 'failure message (pr-str expected) (pr-str actual))) (defn error-el [message expected actual] (message-el 'error message (pr-str expected) (if (instance? Throwable actual) (with-out-str (stack/print-cause-trace actual t/*stack-trace-depth*)) (prn actual)))) ;; This multimethod will override test-is/report (defmulti ^:dynamic junit-report :type) (defmethod junit-report :begin-test-ns [m] (t/with-test-out (start-suite (name (ns-name (:ns m)))))) (defmethod junit-report :end-test-ns [_] (t/with-test-out (finish-suite))) (defmethod junit-report :begin-test-var [m] (t/with-test-out (let [var (:var m)] (binding [*var-context* (conj *var-context* var)] (start-case (test-name *var-context*) (name (ns-name (:ns (meta var))))))))) (defmethod junit-report :end-test-var [m] (t/with-test-out (finish-case))) (defmethod junit-report :pass [m] (t/with-test-out (t/inc-report-counter :pass))) (defmethod junit-report :fail [m] (t/with-test-out (t/inc-report-counter :fail) (failure-el (:message m) (:expected m) (:actual m)))) (defmethod junit-report :error [m] (t/with-test-out (t/inc-report-counter :error) (error-el (:message m) (:expected m) (:actual m)))) (defmethod junit-report :default [_]) (defmacro with-junit-output "Execute body with modified test-is reporting functions that write JUnit-compatible XML output." {:added "1.1"} [& body] `(binding [t/report junit-report *var-context* (list) *depth* 1] (t/with-test-out (println "") (println "")) (let [result# ~@body] (t/with-test-out (println "")) result#))) ================================================ FILE: src/clj/clojure/test/tap.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; test_is/tap.clj: Extension to test for TAP output ;; by Stuart Sierra ;; March 31, 2009 ;; Inspired by ClojureCheck by Meikel Brandmeyer: ;; http://kotka.de/projects/clojure/clojurecheck.html ;; DOCUMENTATION ;; (ns ^{:doc "clojure.test extensions for the Test Anything Protocol (TAP) TAP is a simple text-based syntax for reporting test results. TAP was originally developed for Perl, and now has implementations in several languages. For more information on TAP, see http://testanything.org/ and http://search.cpan.org/~petdance/TAP-1.0.0/TAP.pm To use this library, wrap any calls to clojure.test/run-tests in the with-tap-output macro, like this: (use 'clojure.test) (use 'clojure.test.tap) (with-tap-output (run-tests 'my.cool.library))" :author "Stuart Sierra"} clojure.test.tap (:require [clojure.test :as t] [clojure.stacktrace :as stack])) (defn print-tap-plan "Prints a TAP plan line like '1..n'. n is the number of tests" {:added "1.1"} [n] (println (str "1.." n))) (defn print-tap-diagnostic "Prints a TAP diagnostic line. data is a (possibly multi-line) string." {:added "1.1"} [data] (doseq [line (.split ^String data "\n")] (println "#" line))) (defn print-tap-pass "Prints a TAP 'ok' line. msg is a string, with no line breaks" {:added "1.1"} [msg] (println "ok" msg)) (defn print-tap-fail "Prints a TAP 'not ok' line. msg is a string, with no line breaks" {:added "1.1"} [msg] (println "not ok" msg)) ;; This multimethod will override test/report (defmulti ^:dynamic tap-report :type) (defmethod tap-report :default [data] (t/with-test-out (print-tap-diagnostic (pr-str data)))) (defn print-diagnostics [data] (when (seq t/*testing-contexts*) (print-tap-diagnostic (t/testing-contexts-str))) (when (:message data) (print-tap-diagnostic (:message data))) (print-tap-diagnostic (str "expected:" (pr-str (:expected data)))) (if (= :pass (:type data)) (print-tap-diagnostic (str " actual:" (pr-str (:actual data)))) (do (print-tap-diagnostic (str " actual:" (with-out-str (if (instance? Throwable (:actual data)) (stack/print-cause-trace (:actual data) t/*stack-trace-depth*) (prn (:actual data))))))))) (defmethod tap-report :pass [data] (t/with-test-out (t/inc-report-counter :pass) (print-tap-pass (t/testing-vars-str data)) (print-diagnostics data))) (defmethod tap-report :error [data] (t/with-test-out (t/inc-report-counter :error) (print-tap-fail (t/testing-vars-str data)) (print-diagnostics data))) (defmethod tap-report :fail [data] (t/with-test-out (t/inc-report-counter :fail) (print-tap-fail (t/testing-vars-str data)) (print-diagnostics data))) (defmethod tap-report :summary [data] (t/with-test-out (print-tap-plan (+ (:pass data) (:fail data) (:error data))))) (defmacro with-tap-output "Execute body with modified test reporting functions that produce TAP output" {:added "1.1"} [& body] `(binding [t/report tap-report] ~@body)) ================================================ FILE: src/clj/clojure/test.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; test.clj: test framework for Clojure ;; by Stuart Sierra ;; March 28, 2009 ;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for ;; contributions and suggestions. (ns ^{:author "Stuart Sierra, with contributions and suggestions by Chas Emerick, Allen Rohner, and Stuart Halloway", :doc "A unit testing framework. ASSERTIONS The core of the library is the \"is\" macro, which lets you make assertions of any arbitrary expression: (is (= 4 (+ 2 2))) (is (instance? Integer 256)) (is (.startsWith \"abcde\" \"ab\")) You can type an \"is\" expression directly at the REPL, which will print a message if it fails. user> (is (= 5 (+ 2 2))) FAIL in (:1) expected: (= 5 (+ 2 2)) actual: (not (= 5 4)) false The \"expected:\" line shows you the original expression, and the \"actual:\" shows you what actually happened. In this case, it shows that (+ 2 2) returned 4, which is not = to 5. Finally, the \"false\" on the last line is the value returned from the expression. The \"is\" macro always returns the result of the inner expression. There are two special assertions for testing exceptions. The \"(is (thrown? c ...))\" form tests if an exception of class c is thrown: (is (thrown? ArithmeticException (/ 1 0))) \"(is (thrown-with-msg? c re ...))\" does the same thing and also tests that the message on the exception matches the regular expression re: (is (thrown-with-msg? ArithmeticException #\"Divide by zero\" (/ 1 0))) DOCUMENTING TESTS \"is\" takes an optional second argument, a string describing the assertion. This message will be included in the error report. (is (= 5 (+ 2 2)) \"Crazy arithmetic\") In addition, you can document groups of assertions with the \"testing\" macro, which takes a string followed by any number of assertions. The string will be included in failure reports. Calls to \"testing\" may be nested, and all of the strings will be joined together with spaces in the final report, in a style similar to RSpec (testing \"Arithmetic\" (testing \"with positive integers\" (is (= 4 (+ 2 2))) (is (= 7 (+ 3 4)))) (testing \"with negative integers\" (is (= -4 (+ -2 -2))) (is (= -1 (+ 3 -4))))) Note that, unlike RSpec, the \"testing\" macro may only be used INSIDE a \"deftest\" or \"with-test\" form (see below). DEFINING TESTS There are two ways to define tests. The \"with-test\" macro takes a defn or def form as its first argument, followed by any number of assertions. The tests will be stored as metadata on the definition. (with-test (defn my-function [x y] (+ x y)) (is (= 4 (my-function 2 2))) (is (= 7 (my-function 3 4)))) As of Clojure SVN rev. 1221, this does not work with defmacro. See http://code.google.com/p/clojure/issues/detail?id=51 The other way lets you define tests separately from the rest of your code, even in a different namespace: (deftest addition (is (= 4 (+ 2 2))) (is (= 7 (+ 3 4)))) (deftest subtraction (is (= 1 (- 4 3))) (is (= 3 (- 7 4)))) This creates functions named \"addition\" and \"subtraction\", which can be called like any other function. Therefore, tests can be grouped and composed, in a style similar to the test framework in Peter Seibel's \"Practical Common Lisp\" (deftest arithmetic (addition) (subtraction)) The names of the nested tests will be joined in a list, like \"(arithmetic addition)\", in failure reports. You can use nested tests to set up a context shared by several tests. RUNNING TESTS Run tests with the function \"(run-tests namespaces...)\": (run-tests 'your.namespace 'some.other.namespace) If you don't specify any namespaces, the current namespace is used. To run all tests in all namespaces, use \"(run-all-tests)\". By default, these functions will search for all tests defined in a namespace and run them in an undefined order. However, if you are composing tests, as in the \"arithmetic\" example above, you probably do not want the \"addition\" and \"subtraction\" tests run separately. In that case, you must define a special function named \"test-ns-hook\" that runs your tests in the correct order: (defn test-ns-hook [] (arithmetic)) Note: test-ns-hook prevents execution of fixtures (see below). OMITTING TESTS FROM PRODUCTION CODE You can bind the variable \"*load-tests*\" to false when loading or compiling code in production. This will prevent any tests from being created by \"with-test\" or \"deftest\". FIXTURES Fixtures allow you to run code before and after tests, to set up the context in which tests should be run. A fixture is just a function that calls another function passed as an argument. It looks like this: (defn my-fixture [f] Perform setup, establish bindings, whatever. (f) Then call the function we were passed. Tear-down / clean-up code here. ) Fixtures are attached to namespaces in one of two ways. \"each\" fixtures are run repeatedly, once for each test function created with \"deftest\" or \"with-test\". \"each\" fixtures are useful for establishing a consistent before/after state for each test, like clearing out database tables. \"each\" fixtures can be attached to the current namespace like this: (use-fixtures :each fixture1 fixture2 ...) The fixture1, fixture2 are just functions like the example above. They can also be anonymous functions, like this: (use-fixtures :each (fn [f] setup... (f) cleanup...)) The other kind of fixture, a \"once\" fixture, is only run once, around ALL the tests in the namespace. \"once\" fixtures are useful for tasks that only need to be performed once, like establishing database connections, or for time-consuming tasks. Attach \"once\" fixtures to the current namespace like this: (use-fixtures :once fixture1 fixture2 ...) Note: Fixtures and test-ns-hook are mutually incompatible. If you are using test-ns-hook, fixture functions will *never* be run. SAVING TEST OUTPUT TO A FILE All the test reporting functions write to the var *test-out*. By default, this is the same as *out*, but you can rebind it to any PrintWriter. For example, it could be a file opened with clojure.java.io/writer. EXTENDING TEST-IS (ADVANCED) You can extend the behavior of the \"is\" macro by defining new methods for the \"assert-expr\" multimethod. These methods are called during expansion of the \"is\" macro, so they should return quoted forms to be evaluated. You can plug in your own test-reporting framework by rebinding the \"report\" function: (report event) The 'event' argument is a map. It will always have a :type key, whose value will be a keyword signaling the type of event being reported. Standard events with :type value of :pass, :fail, and :error are called when an assertion passes, fails, and throws an exception, respectively. In that case, the event will also have the following keys: :expected The form that was expected to be true :actual A form representing what actually occurred :message The string message given as an argument to 'is' The \"testing\" strings will be a list in \"*testing-contexts*\", and the vars being tested will be a list in \"*testing-vars*\". Your \"report\" function should wrap any printing calls in the \"with-test-out\" macro, which rebinds *out* to the current value of *test-out*. For additional event types, see the examples in the code. "} clojure.test (:require [clojure.stacktrace :as stack])) (require '[clojure.template :as temp]) ;; Nothing is marked "private" here, so you can rebind things to plug ;; in your own testing or reporting frameworks. ;;; USER-MODIFIABLE GLOBALS (defonce ^:dynamic ^{:doc "True by default. If set to false, no test functions will be created by deftest, set-test, or with-test. Use this to omit tests when compiling or loading production code." :added "1.1"} *load-tests* true) (def ^:dynamic ^{:doc "The maximum depth of stack traces to print when an Exception is thrown during a test. Defaults to nil, which means print the complete stack trace." :added "1.1"} *stack-trace-depth* nil) ;;; GLOBALS USED BY THE REPORTING FUNCTIONS (def ^:dynamic *report-counters* nil) ; bound to a ref of a map in test-ns (def ^:dynamic *initial-report-counters* ; used to initialize *report-counters* {:test 0, :pass 0, :fail 0, :error 0}) (def ^:dynamic *testing-vars* (list)) ; bound to hierarchy of vars being tested (def ^:dynamic *testing-contexts* (list)) ; bound to hierarchy of "testing" strings (def ^:dynamic *test-out* *out*) ; PrintWriter for test reporting output (defmacro with-test-out "Runs body with *out* bound to the value of *test-out*." {:added "1.1"} [& body] `(binding [*out* *test-out*] ~@body)) ;;; UTILITIES FOR REPORTING FUNCTIONS (defn file-position "Returns a vector [filename line-number] for the nth call up the stack. Deprecated in 1.2: The information needed for test reporting is now on :file and :line keys in the result map." {:added "1.1" :deprecated "1.2"} [n] (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)] [(.getFileName s) (.getLineNumber s)])) (defn testing-vars-str "Returns a string representation of the current test. Renders names in *testing-vars* as a list, then the source file and line of current assertion." {:added "1.1"} [m] (let [{:keys [file line]} m] (str ;; Uncomment to include namespace in failure report: ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ " (reverse (map #(:name (meta %)) *testing-vars*)) " (" file ":" line ")"))) (defn testing-contexts-str "Returns a string representation of the current test context. Joins strings in *testing-contexts* with spaces." {:added "1.1"} [] (apply str (interpose " " (reverse *testing-contexts*)))) (defn inc-report-counter "Increments the named counter in *report-counters*, a ref to a map. Does nothing if *report-counters* is nil." {:added "1.1"} [name] (when *report-counters* (dosync (commute *report-counters* assoc name (inc (or (*report-counters* name) 0)))))) ;;; TEST RESULT REPORTING (defmulti ^{:doc "Generic reporting function, may be overridden to plug in different report formats (e.g., TAP, JUnit). Assertions such as 'is' call 'report' to indicate results. The argument given to 'report' will be a map with a :type key. See the documentation at the top of test_is.clj for more information on the types of arguments for 'report'." :dynamic true :added "1.1"} report :type) (defn- file-and-line [^Throwable exception depth] (let [stacktrace (.getStackTrace exception)] (if (< depth (count stacktrace)) (let [^StackTraceElement s (nth stacktrace depth)] {:file (.getFileName s) :line (.getLineNumber s)}) {:file nil :line nil}))) (defn do-report "Add file and line information to a test result and call report. If you are writing a custom assert-expr method, call this function to pass test results to report." {:added "1.2"} [m] (report (case (:type m) :fail (merge (file-and-line (new java.lang.Throwable) 1) m) :error (merge (file-and-line (:actual m) 0) m) m))) (defmethod report :default [m] (with-test-out (prn m))) (defmethod report :pass [m] (with-test-out (inc-report-counter :pass))) (defmethod report :fail [m] (with-test-out (inc-report-counter :fail) (println "\nFAIL in" (testing-vars-str m)) (when (seq *testing-contexts*) (println (testing-contexts-str))) (when-let [message (:message m)] (println message)) (println "expected:" (pr-str (:expected m))) (println " actual:" (pr-str (:actual m))))) (defmethod report :error [m] (with-test-out (inc-report-counter :error) (println "\nERROR in" (testing-vars-str m)) (when (seq *testing-contexts*) (println (testing-contexts-str))) (when-let [message (:message m)] (println message)) (println "expected:" (pr-str (:expected m))) (print " actual: ") (let [actual (:actual m)] (if (instance? Throwable actual) (stack/print-cause-trace actual *stack-trace-depth*) (prn actual))))) (defmethod report :summary [m] (with-test-out (println "\nRan" (:test m) "tests containing" (+ (:pass m) (:fail m) (:error m)) "assertions.") (println (:fail m) "failures," (:error m) "errors."))) (defmethod report :begin-test-ns [m] (with-test-out (println "\nTesting" (ns-name (:ns m))))) ;; Ignore these message types: (defmethod report :end-test-ns [m]) (defmethod report :begin-test-var [m]) (defmethod report :end-test-var [m]) ;;; UTILITIES FOR ASSERTIONS (defn get-possibly-unbound-var "Like var-get but returns nil if the var is unbound." {:added "1.1"} [v] (try (var-get v) (catch IllegalStateException e nil))) (defn function? "Returns true if argument is a function or a symbol that resolves to a function (not a macro)." {:added "1.1"} [x] (if (symbol? x) (when-let [v (resolve x)] (when-let [value (get-possibly-unbound-var v)] (and (fn? value) (not (:macro (meta v)))))) (fn? x))) (defn assert-predicate "Returns generic assertion code for any functional predicate. The 'expected' argument to 'report' will contains the original form, the 'actual' argument will contain the form with all its sub-forms evaluated. If the predicate returns false, the 'actual' form will be wrapped in (not...)." {:added "1.1"} [msg form] (let [args (rest form) pred (first form)] `(let [values# (list ~@args) result# (apply ~pred values#)] (if result# (do-report {:type :pass, :message ~msg, :expected '~form, :actual (cons ~pred values#)}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual (list '~'not (cons '~pred values#))})) result#))) (defn assert-any "Returns generic assertion code for any test, including macros, Java method calls, or isolated symbols." {:added "1.1"} [msg form] `(let [value# ~form] (if value# (do-report {:type :pass, :message ~msg, :expected '~form, :actual value#}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual value#})) value#)) ;;; ASSERTION METHODS ;; You don't call these, but you can add methods to extend the 'is' ;; macro. These define different kinds of tests, based on the first ;; symbol in the test expression. (defmulti assert-expr (fn [msg form] (cond (nil? form) :always-fail (seq? form) (first form) :else :default))) (defmethod assert-expr :always-fail [msg form] ;; nil test: always fail `(do-report {:type :fail, :message ~msg})) (defmethod assert-expr :default [msg form] (if (and (sequential? form) (function? (first form))) (assert-predicate msg form) (assert-any msg form))) (defmethod assert-expr 'instance? [msg form] ;; Test if x is an instance of y. `(let [klass# ~(nth form 1) object# ~(nth form 2)] (let [result# (instance? klass# object#)] (if result# (do-report {:type :pass, :message ~msg, :expected '~form, :actual (class object#)}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual (class object#)})) result#))) (defmethod assert-expr 'thrown? [msg form] ;; (is (thrown? c expr)) ;; Asserts that evaluating expr throws an exception of class c. ;; Returns the exception thrown. (let [klass (second form) body (nthnext form 2)] `(try ~@body (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch ~klass e# (do-report {:type :pass, :message ~msg, :expected '~form, :actual e#}) e#)))) (defmethod assert-expr 'thrown-with-msg? [msg form] ;; (is (thrown-with-msg? c re expr)) ;; Asserts that evaluating expr throws an exception of class c. ;; Also asserts that the message string of the exception matches ;; (with re-find) the regular expression re. (let [klass (nth form 1) re (nth form 2) body (nthnext form 3)] `(try ~@body (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch ~klass e# (let [m# (.getMessage e#)] (if (re-find ~re m#) (do-report {:type :pass, :message ~msg, :expected '~form, :actual e#}) (do-report {:type :fail, :message ~msg, :expected '~form, :actual e#}))) e#)))) (defmacro try-expr "Used by the 'is' macro to catch unexpected exceptions. You don't call this." {:added "1.1"} [msg form] `(try ~(assert-expr msg form) (catch Throwable t# (do-report {:type :error, :message ~msg, :expected '~form, :actual t#})))) ;;; ASSERTION MACROS ;; You use these in your tests. (defmacro is "Generic assertion macro. 'form' is any predicate test. 'msg' is an optional message to attach to the assertion. Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\") Special forms: (is (thrown? c body)) checks that an instance of c is thrown from body, fails if not; then returns the thing thrown. (is (thrown-with-msg? c re body)) checks that an instance of c is thrown AND that the message on the exception matches (with re-find) the regular expression re." {:added "1.1"} ([form] `(is ~form nil)) ([form msg] `(try-expr ~msg ~form))) (defmacro are "Checks multiple assertions with a template expression. See clojure.template/do-template for an explanation of templates. Example: (are [x y] (= x y) 2 (+ 1 1) 4 (* 2 2)) Expands to: (do (is (= 2 (+ 1 1))) (is (= 4 (* 2 2)))) Note: This breaks some reporting features, such as line numbers." {:added "1.1"} [argv expr & args] (if (or ;; (are [] true) is meaningless but ok (and (empty? argv) (empty? args)) ;; Catch wrong number of args (and (pos? (count argv)) (pos? (count args)) (zero? (mod (count args) (count argv))))) `(temp/do-template ~argv (is ~expr) ~@args) (throw (IllegalArgumentException. "The number of args doesn't match are's argv.")))) (defmacro testing "Adds a new string to the list of testing contexts. May be nested, but must occur inside a test function (deftest)." {:added "1.1"} [string & body] `(binding [*testing-contexts* (conj *testing-contexts* ~string)] ~@body)) ;;; DEFINING TESTS (defmacro with-test "Takes any definition form (that returns a Var) as the first argument. Remaining body goes in the :test metadata function for that Var. When *load-tests* is false, only evaluates the definition, ignoring the tests." {:added "1.1"} [definition & body] (if *load-tests* `(doto ~definition (alter-meta! assoc :test (fn [] ~@body))) definition)) (defmacro deftest "Defines a test function with no arguments. Test functions may call other tests, so tests may be composed. If you compose tests, you should also define a function named test-ns-hook; run-tests will call test-ns-hook instead of testing all vars. Note: Actually, the test body goes in the :test metadata on the var, and the real function (the value of the var) calls test-var on itself. When *load-tests* is false, deftest is ignored." {:added "1.1"} [name & body] (when *load-tests* `(def ~(vary-meta name assoc :test `(fn [] ~@body)) (fn [] (test-var (var ~name)))))) (defmacro deftest- "Like deftest but creates a private var." {:added "1.1"} [name & body] (when *load-tests* `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true) (fn [] (test-var (var ~name)))))) (defmacro set-test "Experimental. Sets :test metadata of the named var to a fn with the given body. The var must already exist. Does not modify the value of the var. When *load-tests* is false, set-test is ignored." {:added "1.1"} [name & body] (when *load-tests* `(alter-meta! (var ~name) assoc :test (fn [] ~@body)))) ;;; DEFINING FIXTURES (defn- add-ns-meta "Adds elements in coll to the current namespace metadata as the value of key." {:added "1.1"} [key coll] (alter-meta! *ns* assoc key coll)) (defmulti use-fixtures "Wrap test runs in a fixture function to perform setup and teardown. Using a fixture-type of :each wraps every test individually, while:once wraps the whole run in a single function." {:added "1.1"} (fn [fixture-type & args] fixture-type)) (defmethod use-fixtures :each [fixture-type & args] (add-ns-meta ::each-fixtures args)) (defmethod use-fixtures :once [fixture-type & args] (add-ns-meta ::once-fixtures args)) (defn- default-fixture "The default, empty, fixture function. Just calls its argument." {:added "1.1"} [f] (f)) (defn compose-fixtures "Composes two fixture functions, creating a new fixture function that combines their behavior." {:added "1.1"} [f1 f2] (fn [g] (f1 (fn [] (f2 g))))) (defn join-fixtures "Composes a collection of fixtures, in order. Always returns a valid fixture function, even if the collection is empty." {:added "1.1"} [fixtures] (reduce compose-fixtures default-fixture fixtures)) ;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS (defn test-var "If v has a function in its :test metadata, calls that function, with *testing-vars* bound to (conj *testing-vars* v)." {:dynamic true, :added "1.1"} [v] (when-let [t (:test (meta v))] (binding [*testing-vars* (conj *testing-vars* v)] (do-report {:type :begin-test-var, :var v}) (inc-report-counter :test) (try (t) (catch Throwable e (do-report {:type :error, :message "Uncaught exception, not in assertion." :expected nil, :actual e}))) (do-report {:type :end-test-var, :var v})))) (defn test-vars "Groups vars by their namespace and runs test-vars on them with appropriate fixtures applied." {:added "1.6"} [vars] (doseq [[ns vars] (group-by (comp :ns meta) vars)] (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns))) each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))] (once-fixture-fn (fn [] (doseq [v vars] (when (:test (meta v)) (each-fixture-fn (fn [] (test-var v)))))))))) (defn test-all-vars "Calls test-vars on every var interned in the namespace, with fixtures." {:added "1.1"} [ns] (test-vars (vals (ns-interns ns)))) (defn test-ns "If the namespace defines a function named test-ns-hook, calls that. Otherwise, calls test-all-vars on the namespace. 'ns' is a namespace object or a symbol. Internally binds *report-counters* to a ref initialized to *initial-report-counters*. Returns the final, dereferenced state of *report-counters*." {:added "1.1"} [ns] (binding [*report-counters* (ref *initial-report-counters*)] (let [ns-obj (the-ns ns)] (do-report {:type :begin-test-ns, :ns ns-obj}) ;; If the namespace has a test-ns-hook function, call that: (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))] ((var-get v)) ;; Otherwise, just test every var in the namespace. (test-all-vars ns-obj)) (do-report {:type :end-test-ns, :ns ns-obj})) @*report-counters*)) ;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS (defn run-tests "Runs all tests in the given namespaces; prints results. Defaults to current namespace if none given. Returns a map summarizing test results." {:added "1.1"} ([] (run-tests *ns*)) ([& namespaces] (let [summary (assoc (apply merge-with + (map test-ns namespaces)) :type :summary)] (do-report summary) summary))) (defn run-all-tests "Runs all tests in all namespaces; prints results. Optional argument is a regular expression; only namespaces with names matching the regular expression (with re-matches) will be tested." {:added "1.1"} ([] (apply run-tests (all-ns))) ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns))))) (defn successful? "Returns true if the given test summary indicates all tests were successful, false otherwise." {:added "1.1"} [summary] (and (zero? (:fail summary 0)) (zero? (:error summary 0)))) ================================================ FILE: src/clj/clojure/uuid.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns clojure.uuid) (defn- default-uuid-reader [form] {:pre [(string? form)]} (java.util.UUID/fromString form)) (defmethod print-method java.util.UUID [uuid ^java.io.Writer w] (.write w (str "#uuid \"" (str uuid) "\""))) (defmethod print-dup java.util.UUID [o w] (print-method o w)) ================================================ FILE: src/clj/clojure/walk.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;;; walk.clj - generic tree walker with replacement ;; by Stuart Sierra ;; December 15, 2008 ;; CHANGE LOG: ;; ;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk' ;; ;; * December 9, 2008: first version (ns ^{:author "Stuart Sierra", :doc "This file defines a generic tree walker for Clojure data structures. It takes any data structure (list, vector, map, set, seq), calls a function on every element, and uses the return value of the function in place of the original. This makes it fairly easy to write recursive search-and-replace functions, as shown in the examples. Note: \"walk\" supports all Clojure data structures EXCEPT maps created with sorted-map-by. There is no (obvious) way to retrieve the sorting function."} clojure.walk) (defn walk "Traverses form, an arbitrary data structure. inner and outer are functions. Applies inner to each element of form, building up a data structure of the same type, then applies outer to the result. Recognizes all Clojure data structures. Consumes seqs as with doall." {:added "1.1"} [inner outer form] (cond (list? form) (outer (apply list (map inner form))) (instance? clojure.lang.IMapEntry form) (outer (vec (map inner form))) (seq? form) (outer (doall (map inner form))) (instance? clojure.lang.IRecord form) (outer (reduce (fn [r x] (conj r (inner x))) form form)) (coll? form) (outer (into (empty form) (map inner form))) :else (outer form))) (defn postwalk "Performs a depth-first, post-order traversal of form. Calls f on each sub-form, uses f's return value in place of the original. Recognizes all Clojure data structures. Consumes seqs as with doall." {:added "1.1"} [f form] (walk (partial postwalk f) f form)) (defn prewalk "Like postwalk, but does pre-order traversal." {:added "1.1"} [f form] (walk (partial prewalk f) identity (f form))) ;; Note: I wanted to write: ;; ;; (defn walk ;; [f form] ;; (let [pf (partial walk f)] ;; (if (coll? form) ;; (f (into (empty form) (map pf form))) ;; (f form)))) ;; ;; but this throws a ClassCastException when applied to a map. (defn postwalk-demo "Demonstrates the behavior of postwalk by printing each form as it is walked. Returns form." {:added "1.1"} [form] (postwalk (fn [x] (print "Walked: ") (prn x) x) form)) (defn prewalk-demo "Demonstrates the behavior of prewalk by printing each form as it is walked. Returns form." {:added "1.1"} [form] (prewalk (fn [x] (print "Walked: ") (prn x) x) form)) (defn keywordize-keys "Recursively transforms all map keys from strings to keywords." {:added "1.1"} [m] (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))] ;; only apply to maps (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) (defn stringify-keys "Recursively transforms all map keys from keywords to strings." {:added "1.1"} [m] (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))] ;; only apply to maps (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) (defn prewalk-replace "Recursively transforms form by replacing keys in smap with their values. Like clojure/replace but works on any data structure. Does replacement at the root of the tree first." {:added "1.1"} [smap form] (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form)) (defn postwalk-replace "Recursively transforms form by replacing keys in smap with their values. Like clojure/replace but works on any data structure. Does replacement at the leaves of the tree first." {:added "1.1"} [smap form] (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form)) (defn macroexpand-all "Recursively performs all possible macroexpansions in form." {:added "1.1"} [form] (prewalk (fn [x] (if (seq? x) (macroexpand x) x)) form)) ================================================ FILE: src/clj/clojure/xml.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. (ns ^{:doc "XML reading/writing." :author "Rich Hickey"} clojure.xml (:import (org.xml.sax ContentHandler Attributes SAXException) (javax.xml.parsers SAXParser SAXParserFactory))) (def ^:dynamic *stack*) (def ^:dynamic *current*) (def ^:dynamic *state*) ; :element :chars :between (def ^:dynamic *sb*) (defstruct element :tag :attrs :content) (def tag (accessor element :tag)) (def attrs (accessor element :attrs)) (def content (accessor element :content)) (def content-handler (let [push-content (fn [e c] (assoc e :content (conj (or (:content e) []) c))) push-chars (fn [] (when (and (= *state* :chars) (some (complement #(Character/isWhitespace (char %))) (str *sb*))) (set! *current* (push-content *current* (str *sb*)))))] (new clojure.lang.XMLHandler (proxy [ContentHandler] [] (startElement [uri local-name q-name ^Attributes atts] (let [attrs (fn [ret i] (if (neg? i) ret (recur (assoc ret (clojure.lang.Keyword/intern (symbol (.getQName atts i))) (.getValue atts (int i))) (dec i)))) e (struct element (. clojure.lang.Keyword (intern (symbol q-name))) (when (pos? (.getLength atts)) (attrs {} (dec (.getLength atts)))))] (push-chars) (set! *stack* (conj *stack* *current*)) (set! *current* e) (set! *state* :element)) nil) (endElement [uri local-name q-name] (push-chars) (set! *current* (push-content (peek *stack*) *current*)) (set! *stack* (pop *stack*)) (set! *state* :between) nil) (characters [^chars ch start length] (when-not (= *state* :chars) (set! *sb* (new StringBuilder))) (let [^StringBuilder sb *sb*] (.append sb ch (int start) (int length)) (set! *state* :chars)) nil) (setDocumentLocator [locator]) (startDocument []) (endDocument []) (startPrefixMapping [prefix uri]) (endPrefixMapping [prefix]) (ignorableWhitespace [ch start length]) (processingInstruction [target data]) (skippedEntity [name]) )))) (defn startparse-sax [s ch] (.parse ^javax.xml.parsers.SAXParser (.. SAXParserFactory (newInstance) (newSAXParser)) s ch)) (defn parse "Parses and loads the source s, which can be a File, InputStream or String naming a URI. Returns a tree of the xml/element struct-map, which has the keys :tag, :attrs, and :content. and accessor fns tag, attrs, and content. Other parsers can be supplied by passing startparse, a fn taking a source and a ContentHandler and returning a parser" {:added "1.0"} ([s] (parse s startparse-sax)) ([s startparse] (binding [*stack* nil *current* (struct element) *state* :between *sb* nil] (startparse s content-handler) ((:content *current*) 0)))) (defn emit-element [e] (if (instance? String e) (println e) (do (print (str "<" (name (:tag e)))) (when (:attrs e) (doseq [attr (:attrs e)] (print (str " " (name (key attr)) "='" (val attr)"'")))) (if (:content e) (do (println ">") (doseq [c (:content e)] (emit-element c)) (println (str ""))) (println "/>"))))) (defn emit [x] (println "") (emit-element x)) ;(export '(tag attrs content parse element emit emit-element)) ;(load-file "/Users/rich/dev/clojure/src/xml.clj") ;(def x (xml/parse "http://arstechnica.com/journals.rssx")) ================================================ FILE: src/clj/clojure/zip.clj ================================================ ; Copyright (c) Rich Hickey. All rights reserved. ; The use and distribution terms for this software are covered by the ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ; which can be found in the file epl-v10.html at the root of this distribution. ; By using this software in any fashion, you are agreeing to be bound by ; the terms of this license. ; You must not remove this notice, or any other, from this software. ;functional hierarchical zipper, with navigation, editing and enumeration ;see Huet (ns ^{:doc "Functional hierarchical zipper, with navigation, editing, and enumeration. See Huet" :author "Rich Hickey"} clojure.zip (:refer-clojure :exclude (replace remove next))) (defn zipper "Creates a new zipper structure. branch? is a fn that, given a node, returns true if can have children, even if it currently doesn't. children is a fn that, given a branch node, returns a seq of its children. make-node is a fn that, given an existing node and a seq of children, returns a new branch node with the supplied children. root is the root node." {:added "1.0"} [branch? children make-node root] ^{:zip/branch? branch? :zip/children children :zip/make-node make-node} [root nil]) (defn seq-zip "Returns a zipper for nested sequences, given a root sequence" {:added "1.0"} [root] (zipper seq? identity (fn [node children] (with-meta children (meta node))) root)) (defn vector-zip "Returns a zipper for nested vectors, given a root vector" {:added "1.0"} [root] (zipper vector? seq (fn [node children] (with-meta (vec children) (meta node))) root)) (defn xml-zip "Returns a zipper for xml elements (as from xml/parse), given a root element" {:added "1.0"} [root] (zipper (complement string?) (comp seq :content) (fn [node children] (assoc node :content (and children (apply vector children)))) root)) (defn node "Returns the node at loc" {:added "1.0"} [loc] (loc 0)) (defn branch? "Returns true if the node at loc is a branch" {:added "1.0"} [loc] ((:zip/branch? (meta loc)) (node loc))) (defn children "Returns a seq of the children of node at loc, which must be a branch" {:added "1.0"} [loc] (if (branch? loc) ((:zip/children (meta loc)) (node loc)) (throw (Exception. "called children on a leaf node")))) (defn make-node "Returns a new branch node, given an existing node and new children. The loc is only used to supply the constructor." {:added "1.0"} [loc node children] ((:zip/make-node (meta loc)) node children)) (defn path "Returns a seq of nodes leading to this loc" {:added "1.0"} [loc] (:pnodes (loc 1))) (defn lefts "Returns a seq of the left siblings of this loc" {:added "1.0"} [loc] (seq (:l (loc 1)))) (defn rights "Returns a seq of the right siblings of this loc" {:added "1.0"} [loc] (:r (loc 1))) (defn down "Returns the loc of the leftmost child of the node at this loc, or nil if no children" {:added "1.0"} [loc] (when (branch? loc) (let [[node path] loc [c & cnext :as cs] (children loc)] (when cs (with-meta [c {:l [] :pnodes (if path (conj (:pnodes path) node) [node]) :ppath path :r cnext}] (meta loc)))))) (defn up "Returns the loc of the parent of the node at this loc, or nil if at the top" {:added "1.0"} [loc] (let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc] (when pnodes (let [pnode (peek pnodes)] (with-meta (if changed? [(make-node loc pnode (concat l (cons node r))) (and ppath (assoc ppath :changed? true))] [pnode ppath]) (meta loc)))))) (defn root "zips all the way up and returns the root node, reflecting any changes." {:added "1.0"} [loc] (if (= :end (loc 1)) (node loc) (let [p (up loc)] (if p (recur p) (node loc))))) (defn right "Returns the loc of the right sibling of the node at this loc, or nil" {:added "1.0"} [loc] (let [[node {l :l [r & rnext :as rs] :r :as path}] loc] (when (and path rs) (with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc))))) (defn rightmost "Returns the loc of the rightmost sibling of the node at this loc, or self" {:added "1.0"} [loc] (let [[node {l :l r :r :as path}] loc] (if (and path r) (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc)) loc))) (defn left "Returns the loc of the left sibling of the node at this loc, or nil" {:added "1.0"} [loc] (let [[node {l :l r :r :as path}] loc] (when (and path (seq l)) (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc))))) (defn leftmost "Returns the loc of the leftmost sibling of the node at this loc, or self" {:added "1.0"} [loc] (let [[node {l :l r :r :as path}] loc] (if (and path (seq l)) (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc)) loc))) (defn insert-left "Inserts the item as the left sibling of the node at this loc, without moving" {:added "1.0"} [loc item] (let [[node {l :l :as path}] loc] (if (nil? path) (throw (new Exception "Insert at top")) (with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc))))) (defn insert-right "Inserts the item as the right sibling of the node at this loc, without moving" {:added "1.0"} [loc item] (let [[node {r :r :as path}] loc] (if (nil? path) (throw (new Exception "Insert at top")) (with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc))))) (defn replace "Replaces the node at this loc, without moving" {:added "1.0"} [loc node] (let [[_ path] loc] (with-meta [node (assoc path :changed? true)] (meta loc)))) (defn edit "Replaces the node at this loc with the value of (f node args)" {:added "1.0"} [loc f & args] (replace loc (apply f (node loc) args))) (defn insert-child "Inserts the item as the leftmost child of the node at this loc, without moving" {:added "1.0"} [loc item] (replace loc (make-node loc (node loc) (cons item (children loc))))) (defn append-child "Inserts the item as the rightmost child of the node at this loc, without moving" {:added "1.0"} [loc item] (replace loc (make-node loc (node loc) (concat (children loc) [item])))) (defn next "Moves to the next loc in the hierarchy, depth-first. When reaching the end, returns a distinguished loc detectable via end?. If already at the end, stays there." {:added "1.0"} [loc] (if (= :end (loc 1)) loc (or (and (branch? loc) (down loc)) (right loc) (loop [p loc] (if (up p) (or (right (up p)) (recur (up p))) [(node p) :end]))))) (defn prev "Moves to the previous loc in the hierarchy, depth-first. If already at the root, returns nil." {:added "1.0"} [loc] (if-let [lloc (left loc)] (loop [loc lloc] (if-let [child (and (branch? loc) (down loc))] (recur (rightmost child)) loc)) (up loc))) (defn end? "Returns true if loc represents the end of a depth-first walk" {:added "1.0"} [loc] (= :end (loc 1))) (defn remove "Removes the node at loc, returning the loc that would have preceded it in a depth-first walk." {:added "1.0"} [loc] (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc] (if (nil? path) (throw (new Exception "Remove at top")) (if (pos? (count l)) (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))] (if-let [child (and (branch? loc) (down loc))] (recur (rightmost child)) loc)) (with-meta [(make-node loc (peek pnodes) rs) (and ppath (assoc ppath :changed? true))] (meta loc)))))) (comment (load-file "/Users/rich/dev/clojure/src/zip.clj") (refer 'zip) (def data '[[a * b] + [c * d]]) (def dz (vector-zip data)) (right (down (right (right (down dz))))) (lefts (right (down (right (right (down dz)))))) (rights (right (down (right (right (down dz)))))) (up (up (right (down (right (right (down dz))))))) (path (right (down (right (right (down dz)))))) (-> dz down right right down right) (-> dz down right right down right (replace '/) root) (-> dz next next (edit str) next next next (replace '/) root) (-> dz next next next next next next next next next remove root) (-> dz next next next next next next next next next remove (insert-right 'e) root) (-> dz next next next next next next next next next remove up (append-child 'e) root) (end? (-> dz next next next next next next next next next remove next)) (-> dz next remove next remove root) (loop [loc dz] (if (end? loc) (root loc) (recur (next (if (= '* (node loc)) (replace loc '/) loc))))) (loop [loc dz] (if (end? loc) (root loc) (recur (next (if (= '* (node loc)) (remove loc) loc))))) ) ================================================ FILE: src/ffi/ffi.h ================================================ #ifdef __arm64__ #include "ffi_arm64.h" #endif #ifdef __i386__ #include "ffi_i386.h" #endif #ifdef __arm__ #include "ffi_armv7.h" #endif #ifdef __x86_64__ #include "ffi_x86_64.h" #endif ================================================ FILE: src/ffi/ffi_arm64.h ================================================ #ifdef __arm64__ /* -----------------------------------------------------------------*-C-*- libffi 3.1-rc1 - Copyright (c) 2011 Anthony Green - Copyright (c) 1996-2003, 2007, 2008 Red Hat, Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ /* ------------------------------------------------------------------- The basic API is described in the README file. The raw API is designed to bypass some of the argument packing and unpacking on architectures for which it can be avoided. The closure API allows interpreted functions to be packaged up inside a C function pointer, so that they can be called as C functions, with no understanding on the client side that they are interpreted. It can also be used in other cases in which it is necessary to package up a user specified parameter and a function pointer as a single function pointer. The closure API must be implemented in order to get its functionality, e.g. for use by gij. Routines are provided to emulate the raw API if the underlying platform doesn't allow faster implementation. More details on the raw and cloure API can be found in: http://gcc.gnu.org/ml/java/1999-q3/msg00138.html and http://gcc.gnu.org/ml/java/1999-q3/msg00174.html -------------------------------------------------------------------- */ #ifndef LIBFFI_H #define LIBFFI_H #ifdef __cplusplus extern "C" { #endif /* Specify which architecture libffi is configured for. */ #ifndef AARCH64 #define AARCH64 #endif /* ---- System configuration information --------------------------------- */ #include "ffitarget.h" #ifndef LIBFFI_ASM #ifdef _MSC_VER #define __attribute__(X) #endif #include #include /* LONG_LONG_MAX is not always defined (not if STRICT_ANSI, for example). But we can find it either under the correct ANSI name, or under GNU C's internal name. */ #define FFI_64_BIT_MAX 9223372036854775807 #ifdef LONG_LONG_MAX # define FFI_LONG_LONG_MAX LONG_LONG_MAX #else # ifdef LLONG_MAX # define FFI_LONG_LONG_MAX LLONG_MAX # ifdef _AIX52 /* or newer has C99 LLONG_MAX */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif /* _AIX52 or newer */ # else # ifdef __GNUC__ # define FFI_LONG_LONG_MAX __LONG_LONG_MAX__ # endif # ifdef _AIX /* AIX 5.1 and earlier have LONGLONG_MAX */ # ifndef __PPC64__ # if defined (__IBMC__) || defined (__IBMCPP__) # define FFI_LONG_LONG_MAX LONGLONG_MAX # endif # endif /* __PPC64__ */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif # endif #endif /* The closure code assumes that this works on pointers, i.e. a size_t */ /* can hold a pointer. */ typedef struct _ffi_type { size_t size; unsigned short alignment; unsigned short type; struct _ffi_type **elements; } ffi_type; #ifndef LIBFFI_HIDE_BASIC_TYPES #if SCHAR_MAX == 127 # define ffi_type_uchar ffi_type_uint8 # define ffi_type_schar ffi_type_sint8 #else #error "char size not supported" #endif #if SHRT_MAX == 32767 # define ffi_type_ushort ffi_type_uint16 # define ffi_type_sshort ffi_type_sint16 #elif SHRT_MAX == 2147483647 # define ffi_type_ushort ffi_type_uint32 # define ffi_type_sshort ffi_type_sint32 #else #error "short size not supported" #endif #if INT_MAX == 32767 # define ffi_type_uint ffi_type_uint16 # define ffi_type_sint ffi_type_sint16 #elif INT_MAX == 2147483647 # define ffi_type_uint ffi_type_uint32 # define ffi_type_sint ffi_type_sint32 #elif INT_MAX == 9223372036854775807 # define ffi_type_uint ffi_type_uint64 # define ffi_type_sint ffi_type_sint64 #else #error "int size not supported" #endif #if LONG_MAX == 2147483647 # if FFI_LONG_LONG_MAX != FFI_64_BIT_MAX #error "no 64-bit data type supported" # endif #elif LONG_MAX != FFI_64_BIT_MAX #error "long size not supported" #endif #if LONG_MAX == 2147483647 # define ffi_type_ulong ffi_type_uint32 # define ffi_type_slong ffi_type_sint32 #elif LONG_MAX == FFI_64_BIT_MAX # define ffi_type_ulong ffi_type_uint64 # define ffi_type_slong ffi_type_sint64 #else #error "long size not supported" #endif /* Need minimal decorations for DLLs to works on Windows. */ /* GCC has autoimport and autoexport. Rely on Libtool to */ /* help MSVC export from a DLL, but always declare data */ /* to be imported for MSVC clients. This costs an extra */ /* indirection for MSVC clients using the static version */ /* of the library, but don't worry about that. Besides, */ /* as a workaround, they can define FFI_BUILDING if they */ /* *know* they are going to link with the static library. */ #if defined _MSC_VER && !defined FFI_BUILDING #define FFI_EXTERN extern __declspec(dllimport) #else #define FFI_EXTERN extern #endif /* These are defined in types.c */ FFI_EXTERN ffi_type ffi_type_void; FFI_EXTERN ffi_type ffi_type_uint8; FFI_EXTERN ffi_type ffi_type_sint8; FFI_EXTERN ffi_type ffi_type_uint16; FFI_EXTERN ffi_type ffi_type_sint16; FFI_EXTERN ffi_type ffi_type_uint32; FFI_EXTERN ffi_type ffi_type_sint32; FFI_EXTERN ffi_type ffi_type_uint64; FFI_EXTERN ffi_type ffi_type_sint64; FFI_EXTERN ffi_type ffi_type_float; FFI_EXTERN ffi_type ffi_type_double; FFI_EXTERN ffi_type ffi_type_pointer; #if 0 FFI_EXTERN ffi_type ffi_type_longdouble; #else #define ffi_type_longdouble ffi_type_double #endif #endif /* LIBFFI_HIDE_BASIC_TYPES */ typedef enum { FFI_OK = 0, FFI_BAD_TYPEDEF, FFI_BAD_ABI } ffi_status; typedef unsigned FFI_TYPE; typedef struct { ffi_abi abi; unsigned nargs; ffi_type **arg_types; ffi_type *rtype; unsigned bytes; unsigned flags; #ifdef FFI_EXTRA_CIF_FIELDS FFI_EXTRA_CIF_FIELDS; #endif } ffi_cif; #if HAVE_LONG_DOUBLE_VARIANT /* Used to adjust size/alignment of ffi types. */ void ffi_prep_types (ffi_abi abi); # endif /* Used internally, but overridden by some architectures */ ffi_status ffi_prep_cif_core(ffi_cif *cif, ffi_abi abi, unsigned int isvariadic, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); /* ---- Definitions for the raw API -------------------------------------- */ #ifndef FFI_SIZEOF_ARG # if LONG_MAX == 2147483647 # define FFI_SIZEOF_ARG 4 # elif LONG_MAX == FFI_64_BIT_MAX # define FFI_SIZEOF_ARG 8 # endif #endif #ifndef FFI_SIZEOF_JAVA_RAW # define FFI_SIZEOF_JAVA_RAW FFI_SIZEOF_ARG #endif typedef union { ffi_sarg sint; ffi_arg uint; float flt; char data[FFI_SIZEOF_ARG]; void* ptr; } ffi_raw; #if FFI_SIZEOF_JAVA_RAW == 4 && FFI_SIZEOF_ARG == 8 /* This is a special case for mips64/n32 ABI (and perhaps others) where sizeof(void *) is 4 and FFI_SIZEOF_ARG is 8. */ typedef union { signed int sint; unsigned int uint; float flt; char data[FFI_SIZEOF_JAVA_RAW]; void* ptr; } ffi_java_raw; #else typedef ffi_raw ffi_java_raw; #endif void ffi_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_raw *avalue); void ffi_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_raw *raw); void ffi_raw_to_ptrarray (ffi_cif *cif, ffi_raw *raw, void **args); size_t ffi_raw_size (ffi_cif *cif); /* This is analogous to the raw API, except it uses Java parameter */ /* packing, even on 64-bit machines. I.e. on 64-bit machines */ /* longs and doubles are followed by an empty 64-bit word. */ void ffi_java_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_java_raw *avalue); void ffi_java_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_java_raw *raw); void ffi_java_raw_to_ptrarray (ffi_cif *cif, ffi_java_raw *raw, void **args); size_t ffi_java_raw_size (ffi_cif *cif); /* ---- Definitions for closures ----------------------------------------- */ #if FFI_CLOSURES #ifdef _MSC_VER __declspec(align(8)) #endif typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; void (*fun)(ffi_cif*,void*,void**,void*); void *user_data; #ifdef __GNUC__ } ffi_closure __attribute__((aligned (8))); #else } ffi_closure; # ifdef __sgi # pragma pack 0 # endif #endif void *ffi_closure_alloc (size_t size, void **code); void ffi_closure_free (void *); ffi_status ffi_prep_closure (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data); ffi_status ffi_prep_closure_loc (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data, void*codeloc); #ifdef __sgi # pragma pack 8 #endif typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_raw*,void*); void *user_data; } ffi_raw_closure; typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*); void *user_data; } ffi_java_raw_closure; ffi_status ffi_prep_raw_closure (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data); ffi_status ffi_prep_raw_closure_loc (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data, void *codeloc); ffi_status ffi_prep_java_raw_closure (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data); ffi_status ffi_prep_java_raw_closure_loc (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data, void *codeloc); #endif /* FFI_CLOSURES */ /* ---- Public interface definition -------------------------------------- */ ffi_status ffi_prep_cif(ffi_cif *cif, ffi_abi abi, unsigned int nargs, ffi_type *rtype, ffi_type **atypes); ffi_status ffi_prep_cif_var(ffi_cif *cif, ffi_abi abi, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); void ffi_call(ffi_cif *cif, void (*fn)(void), void *rvalue, void **avalue); /* Useful for eliminating compiler warnings */ #define FFI_FN(f) ((void (*)(void))f) /* ---- Definitions shared with assembly code ---------------------------- */ #endif /* If these change, update src/mips/ffitarget.h. */ #define FFI_TYPE_VOID 0 #define FFI_TYPE_INT 1 #define FFI_TYPE_FLOAT 2 #define FFI_TYPE_DOUBLE 3 #if 0 #define FFI_TYPE_LONGDOUBLE 4 #else #define FFI_TYPE_LONGDOUBLE FFI_TYPE_DOUBLE #endif #define FFI_TYPE_UINT8 5 #define FFI_TYPE_SINT8 6 #define FFI_TYPE_UINT16 7 #define FFI_TYPE_SINT16 8 #define FFI_TYPE_UINT32 9 #define FFI_TYPE_SINT32 10 #define FFI_TYPE_UINT64 11 #define FFI_TYPE_SINT64 12 #define FFI_TYPE_STRUCT 13 #define FFI_TYPE_POINTER 14 /* This should always refer to the last type code (for sanity checks) */ #define FFI_TYPE_LAST FFI_TYPE_POINTER #ifdef __cplusplus } #endif #endif #endif ================================================ FILE: src/ffi/ffi_armv7.h ================================================ #ifdef __arm__ /* -----------------------------------------------------------------*-C-*- libffi 3.1-rc1 - Copyright (c) 2011 Anthony Green - Copyright (c) 1996-2003, 2007, 2008 Red Hat, Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ /* ------------------------------------------------------------------- The basic API is described in the README file. The raw API is designed to bypass some of the argument packing and unpacking on architectures for which it can be avoided. The closure API allows interpreted functions to be packaged up inside a C function pointer, so that they can be called as C functions, with no understanding on the client side that they are interpreted. It can also be used in other cases in which it is necessary to package up a user specified parameter and a function pointer as a single function pointer. The closure API must be implemented in order to get its functionality, e.g. for use by gij. Routines are provided to emulate the raw API if the underlying platform doesn't allow faster implementation. More details on the raw and cloure API can be found in: http://gcc.gnu.org/ml/java/1999-q3/msg00138.html and http://gcc.gnu.org/ml/java/1999-q3/msg00174.html -------------------------------------------------------------------- */ #ifndef LIBFFI_H #define LIBFFI_H #ifdef __cplusplus extern "C" { #endif /* Specify which architecture libffi is configured for. */ #ifndef ARM #define ARM #endif /* ---- System configuration information --------------------------------- */ #include "ffitarget.h" #ifndef LIBFFI_ASM #ifdef _MSC_VER #define __attribute__(X) #endif #include #include /* LONG_LONG_MAX is not always defined (not if STRICT_ANSI, for example). But we can find it either under the correct ANSI name, or under GNU C's internal name. */ #define FFI_64_BIT_MAX 9223372036854775807 #ifdef LONG_LONG_MAX # define FFI_LONG_LONG_MAX LONG_LONG_MAX #else # ifdef LLONG_MAX # define FFI_LONG_LONG_MAX LLONG_MAX # ifdef _AIX52 /* or newer has C99 LLONG_MAX */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif /* _AIX52 or newer */ # else # ifdef __GNUC__ # define FFI_LONG_LONG_MAX __LONG_LONG_MAX__ # endif # ifdef _AIX /* AIX 5.1 and earlier have LONGLONG_MAX */ # ifndef __PPC64__ # if defined (__IBMC__) || defined (__IBMCPP__) # define FFI_LONG_LONG_MAX LONGLONG_MAX # endif # endif /* __PPC64__ */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif # endif #endif /* The closure code assumes that this works on pointers, i.e. a size_t */ /* can hold a pointer. */ typedef struct _ffi_type { size_t size; unsigned short alignment; unsigned short type; struct _ffi_type **elements; } ffi_type; #ifndef LIBFFI_HIDE_BASIC_TYPES #if SCHAR_MAX == 127 # define ffi_type_uchar ffi_type_uint8 # define ffi_type_schar ffi_type_sint8 #else #error "char size not supported" #endif #if SHRT_MAX == 32767 # define ffi_type_ushort ffi_type_uint16 # define ffi_type_sshort ffi_type_sint16 #elif SHRT_MAX == 2147483647 # define ffi_type_ushort ffi_type_uint32 # define ffi_type_sshort ffi_type_sint32 #else #error "short size not supported" #endif #if INT_MAX == 32767 # define ffi_type_uint ffi_type_uint16 # define ffi_type_sint ffi_type_sint16 #elif INT_MAX == 2147483647 # define ffi_type_uint ffi_type_uint32 # define ffi_type_sint ffi_type_sint32 #elif INT_MAX == 9223372036854775807 # define ffi_type_uint ffi_type_uint64 # define ffi_type_sint ffi_type_sint64 #else #error "int size not supported" #endif #if LONG_MAX == 2147483647 # if FFI_LONG_LONG_MAX != FFI_64_BIT_MAX #error "no 64-bit data type supported" # endif #elif LONG_MAX != FFI_64_BIT_MAX #error "long size not supported" #endif #if LONG_MAX == 2147483647 # define ffi_type_ulong ffi_type_uint32 # define ffi_type_slong ffi_type_sint32 #elif LONG_MAX == FFI_64_BIT_MAX # define ffi_type_ulong ffi_type_uint64 # define ffi_type_slong ffi_type_sint64 #else #error "long size not supported" #endif /* Need minimal decorations for DLLs to works on Windows. */ /* GCC has autoimport and autoexport. Rely on Libtool to */ /* help MSVC export from a DLL, but always declare data */ /* to be imported for MSVC clients. This costs an extra */ /* indirection for MSVC clients using the static version */ /* of the library, but don't worry about that. Besides, */ /* as a workaround, they can define FFI_BUILDING if they */ /* *know* they are going to link with the static library. */ #if defined _MSC_VER && !defined FFI_BUILDING #define FFI_EXTERN extern __declspec(dllimport) #else #define FFI_EXTERN extern #endif /* These are defined in types.c */ FFI_EXTERN ffi_type ffi_type_void; FFI_EXTERN ffi_type ffi_type_uint8; FFI_EXTERN ffi_type ffi_type_sint8; FFI_EXTERN ffi_type ffi_type_uint16; FFI_EXTERN ffi_type ffi_type_sint16; FFI_EXTERN ffi_type ffi_type_uint32; FFI_EXTERN ffi_type ffi_type_sint32; FFI_EXTERN ffi_type ffi_type_uint64; FFI_EXTERN ffi_type ffi_type_sint64; FFI_EXTERN ffi_type ffi_type_float; FFI_EXTERN ffi_type ffi_type_double; FFI_EXTERN ffi_type ffi_type_pointer; #if 0 FFI_EXTERN ffi_type ffi_type_longdouble; #else #define ffi_type_longdouble ffi_type_double #endif #endif /* LIBFFI_HIDE_BASIC_TYPES */ typedef enum { FFI_OK = 0, FFI_BAD_TYPEDEF, FFI_BAD_ABI } ffi_status; typedef unsigned FFI_TYPE; typedef struct { ffi_abi abi; unsigned nargs; ffi_type **arg_types; ffi_type *rtype; unsigned bytes; unsigned flags; #ifdef FFI_EXTRA_CIF_FIELDS FFI_EXTRA_CIF_FIELDS; #endif } ffi_cif; #if HAVE_LONG_DOUBLE_VARIANT /* Used to adjust size/alignment of ffi types. */ void ffi_prep_types (ffi_abi abi); # endif /* Used internally, but overridden by some architectures */ ffi_status ffi_prep_cif_core(ffi_cif *cif, ffi_abi abi, unsigned int isvariadic, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); /* ---- Definitions for the raw API -------------------------------------- */ #ifndef FFI_SIZEOF_ARG # if LONG_MAX == 2147483647 # define FFI_SIZEOF_ARG 4 # elif LONG_MAX == FFI_64_BIT_MAX # define FFI_SIZEOF_ARG 8 # endif #endif #ifndef FFI_SIZEOF_JAVA_RAW # define FFI_SIZEOF_JAVA_RAW FFI_SIZEOF_ARG #endif typedef union { ffi_sarg sint; ffi_arg uint; float flt; char data[FFI_SIZEOF_ARG]; void* ptr; } ffi_raw; #if FFI_SIZEOF_JAVA_RAW == 4 && FFI_SIZEOF_ARG == 8 /* This is a special case for mips64/n32 ABI (and perhaps others) where sizeof(void *) is 4 and FFI_SIZEOF_ARG is 8. */ typedef union { signed int sint; unsigned int uint; float flt; char data[FFI_SIZEOF_JAVA_RAW]; void* ptr; } ffi_java_raw; #else typedef ffi_raw ffi_java_raw; #endif void ffi_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_raw *avalue); void ffi_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_raw *raw); void ffi_raw_to_ptrarray (ffi_cif *cif, ffi_raw *raw, void **args); size_t ffi_raw_size (ffi_cif *cif); /* This is analogous to the raw API, except it uses Java parameter */ /* packing, even on 64-bit machines. I.e. on 64-bit machines */ /* longs and doubles are followed by an empty 64-bit word. */ void ffi_java_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_java_raw *avalue); void ffi_java_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_java_raw *raw); void ffi_java_raw_to_ptrarray (ffi_cif *cif, ffi_java_raw *raw, void **args); size_t ffi_java_raw_size (ffi_cif *cif); /* ---- Definitions for closures ----------------------------------------- */ #if FFI_CLOSURES #ifdef _MSC_VER __declspec(align(8)) #endif typedef struct { #if 1 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; void (*fun)(ffi_cif*,void*,void**,void*); void *user_data; #ifdef __GNUC__ } ffi_closure __attribute__((aligned (8))); #else } ffi_closure; # ifdef __sgi # pragma pack 0 # endif #endif void *ffi_closure_alloc (size_t size, void **code); void ffi_closure_free (void *); ffi_status ffi_prep_closure (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data); ffi_status ffi_prep_closure_loc (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data, void*codeloc); #ifdef __sgi # pragma pack 8 #endif typedef struct { #if 1 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_raw*,void*); void *user_data; } ffi_raw_closure; typedef struct { #if 1 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*); void *user_data; } ffi_java_raw_closure; ffi_status ffi_prep_raw_closure (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data); ffi_status ffi_prep_raw_closure_loc (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data, void *codeloc); ffi_status ffi_prep_java_raw_closure (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data); ffi_status ffi_prep_java_raw_closure_loc (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data, void *codeloc); #endif /* FFI_CLOSURES */ /* ---- Public interface definition -------------------------------------- */ ffi_status ffi_prep_cif(ffi_cif *cif, ffi_abi abi, unsigned int nargs, ffi_type *rtype, ffi_type **atypes); ffi_status ffi_prep_cif_var(ffi_cif *cif, ffi_abi abi, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); void ffi_call(ffi_cif *cif, void (*fn)(void), void *rvalue, void **avalue); /* Useful for eliminating compiler warnings */ #define FFI_FN(f) ((void (*)(void))f) /* ---- Definitions shared with assembly code ---------------------------- */ #endif /* If these change, update src/mips/ffitarget.h. */ #define FFI_TYPE_VOID 0 #define FFI_TYPE_INT 1 #define FFI_TYPE_FLOAT 2 #define FFI_TYPE_DOUBLE 3 #if 0 #define FFI_TYPE_LONGDOUBLE 4 #else #define FFI_TYPE_LONGDOUBLE FFI_TYPE_DOUBLE #endif #define FFI_TYPE_UINT8 5 #define FFI_TYPE_SINT8 6 #define FFI_TYPE_UINT16 7 #define FFI_TYPE_SINT16 8 #define FFI_TYPE_UINT32 9 #define FFI_TYPE_SINT32 10 #define FFI_TYPE_UINT64 11 #define FFI_TYPE_SINT64 12 #define FFI_TYPE_STRUCT 13 #define FFI_TYPE_POINTER 14 /* This should always refer to the last type code (for sanity checks) */ #define FFI_TYPE_LAST FFI_TYPE_POINTER #ifdef __cplusplus } #endif #endif #endif ================================================ FILE: src/ffi/ffi_common.h ================================================ /* ----------------------------------------------------------------------- ffi_common.h - Copyright (C) 2011, 2012, 2013 Anthony Green Copyright (C) 2007 Free Software Foundation, Inc Copyright (c) 1996 Red Hat, Inc. Common internal definitions and macros. Only necessary for building libffi. ----------------------------------------------------------------------- */ #ifndef FFI_COMMON_H #define FFI_COMMON_H #ifdef __cplusplus extern "C" { #endif #include /* Do not move this. Some versions of AIX are very picky about where this is positioned. */ #ifdef __GNUC__ # if HAVE_ALLOCA_H # include # else /* mingw64 defines this already in malloc.h. */ # ifndef alloca # define alloca __builtin_alloca # endif # endif # define MAYBE_UNUSED __attribute__((__unused__)) #else # define MAYBE_UNUSED # if HAVE_ALLOCA_H # include # else # ifdef _AIX # pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ # ifdef _MSC_VER # define alloca _alloca # else char *alloca (); # endif # endif # endif # endif #endif /* Check for the existence of memcpy. */ #if STDC_HEADERS # include #else # ifndef HAVE_MEMCPY # define memcpy(d, s, n) bcopy ((s), (d), (n)) # endif #endif #if defined(FFI_DEBUG) #include #endif #ifdef FFI_DEBUG void ffi_assert(char *expr, char *file, int line); void ffi_stop_here(void); void ffi_type_test(ffi_type *a, char *file, int line); #define FFI_ASSERT(x) ((x) ? (void)0 : ffi_assert(#x, __FILE__,__LINE__)) #define FFI_ASSERT_AT(x, f, l) ((x) ? 0 : ffi_assert(#x, (f), (l))) #define FFI_ASSERT_VALID_TYPE(x) ffi_type_test (x, __FILE__, __LINE__) #else #define FFI_ASSERT(x) #define FFI_ASSERT_AT(x, f, l) #define FFI_ASSERT_VALID_TYPE(x) #endif #define ALIGN(v, a) (((((size_t) (v))-1) | ((a)-1))+1) #define ALIGN_DOWN(v, a) (((size_t) (v)) & -a) /* Perform machine dependent cif processing */ ffi_status ffi_prep_cif_machdep(ffi_cif *cif); ffi_status ffi_prep_cif_machdep_var(ffi_cif *cif, unsigned int nfixedargs, unsigned int ntotalargs); /* Extended cif, used in callback from assembly routine */ typedef struct { ffi_cif *cif; void *rvalue; void **avalue; } extended_cif; /* Terse sized type definitions. */ #if defined(_MSC_VER) || defined(__sgi) || defined(__SUNPRO_C) typedef unsigned char UINT8; typedef signed char SINT8; typedef unsigned short UINT16; typedef signed short SINT16; typedef unsigned int UINT32; typedef signed int SINT32; # ifdef _MSC_VER typedef unsigned __int64 UINT64; typedef signed __int64 SINT64; # else # include typedef uint64_t UINT64; typedef int64_t SINT64; # endif #else typedef unsigned int UINT8 __attribute__((__mode__(__QI__))); typedef signed int SINT8 __attribute__((__mode__(__QI__))); typedef unsigned int UINT16 __attribute__((__mode__(__HI__))); typedef signed int SINT16 __attribute__((__mode__(__HI__))); typedef unsigned int UINT32 __attribute__((__mode__(__SI__))); typedef signed int SINT32 __attribute__((__mode__(__SI__))); typedef unsigned int UINT64 __attribute__((__mode__(__DI__))); typedef signed int SINT64 __attribute__((__mode__(__DI__))); #endif typedef float FLOAT32; #ifndef __GNUC__ #define __builtin_expect(x, expected_value) (x) #endif #define LIKELY(x) __builtin_expect(!!(x),1) #define UNLIKELY(x) __builtin_expect((x)!=0,0) #ifdef __cplusplus } #endif #endif ================================================ FILE: src/ffi/ffi_i386.h ================================================ #ifdef __i386__ /* -----------------------------------------------------------------*-C-*- libffi 3.1-rc1 - Copyright (c) 2011 Anthony Green - Copyright (c) 1996-2003, 2007, 2008 Red Hat, Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ /* ------------------------------------------------------------------- The basic API is described in the README file. The raw API is designed to bypass some of the argument packing and unpacking on architectures for which it can be avoided. The closure API allows interpreted functions to be packaged up inside a C function pointer, so that they can be called as C functions, with no understanding on the client side that they are interpreted. It can also be used in other cases in which it is necessary to package up a user specified parameter and a function pointer as a single function pointer. The closure API must be implemented in order to get its functionality, e.g. for use by gij. Routines are provided to emulate the raw API if the underlying platform doesn't allow faster implementation. More details on the raw and cloure API can be found in: http://gcc.gnu.org/ml/java/1999-q3/msg00138.html and http://gcc.gnu.org/ml/java/1999-q3/msg00174.html -------------------------------------------------------------------- */ #ifndef LIBFFI_H #define LIBFFI_H #ifdef __cplusplus extern "C" { #endif /* Specify which architecture libffi is configured for. */ #ifndef X86_DARWIN #define X86_DARWIN #endif /* ---- System configuration information --------------------------------- */ #include "ffitarget.h" #ifndef LIBFFI_ASM #ifdef _MSC_VER #define __attribute__(X) #endif #include #include /* LONG_LONG_MAX is not always defined (not if STRICT_ANSI, for example). But we can find it either under the correct ANSI name, or under GNU C's internal name. */ #define FFI_64_BIT_MAX 9223372036854775807 #ifdef LONG_LONG_MAX # define FFI_LONG_LONG_MAX LONG_LONG_MAX #else # ifdef LLONG_MAX # define FFI_LONG_LONG_MAX LLONG_MAX # ifdef _AIX52 /* or newer has C99 LLONG_MAX */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif /* _AIX52 or newer */ # else # ifdef __GNUC__ # define FFI_LONG_LONG_MAX __LONG_LONG_MAX__ # endif # ifdef _AIX /* AIX 5.1 and earlier have LONGLONG_MAX */ # ifndef __PPC64__ # if defined (__IBMC__) || defined (__IBMCPP__) # define FFI_LONG_LONG_MAX LONGLONG_MAX # endif # endif /* __PPC64__ */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif # endif #endif /* The closure code assumes that this works on pointers, i.e. a size_t */ /* can hold a pointer. */ typedef struct _ffi_type { size_t size; unsigned short alignment; unsigned short type; struct _ffi_type **elements; } ffi_type; #ifndef LIBFFI_HIDE_BASIC_TYPES #if SCHAR_MAX == 127 # define ffi_type_uchar ffi_type_uint8 # define ffi_type_schar ffi_type_sint8 #else #error "char size not supported" #endif #if SHRT_MAX == 32767 # define ffi_type_ushort ffi_type_uint16 # define ffi_type_sshort ffi_type_sint16 #elif SHRT_MAX == 2147483647 # define ffi_type_ushort ffi_type_uint32 # define ffi_type_sshort ffi_type_sint32 #else #error "short size not supported" #endif #if INT_MAX == 32767 # define ffi_type_uint ffi_type_uint16 # define ffi_type_sint ffi_type_sint16 #elif INT_MAX == 2147483647 # define ffi_type_uint ffi_type_uint32 # define ffi_type_sint ffi_type_sint32 #elif INT_MAX == 9223372036854775807 # define ffi_type_uint ffi_type_uint64 # define ffi_type_sint ffi_type_sint64 #else #error "int size not supported" #endif #if LONG_MAX == 2147483647 # if FFI_LONG_LONG_MAX != FFI_64_BIT_MAX #error "no 64-bit data type supported" # endif #elif LONG_MAX != FFI_64_BIT_MAX #error "long size not supported" #endif #if LONG_MAX == 2147483647 # define ffi_type_ulong ffi_type_uint32 # define ffi_type_slong ffi_type_sint32 #elif LONG_MAX == FFI_64_BIT_MAX # define ffi_type_ulong ffi_type_uint64 # define ffi_type_slong ffi_type_sint64 #else #error "long size not supported" #endif /* Need minimal decorations for DLLs to works on Windows. */ /* GCC has autoimport and autoexport. Rely on Libtool to */ /* help MSVC export from a DLL, but always declare data */ /* to be imported for MSVC clients. This costs an extra */ /* indirection for MSVC clients using the static version */ /* of the library, but don't worry about that. Besides, */ /* as a workaround, they can define FFI_BUILDING if they */ /* *know* they are going to link with the static library. */ #if defined _MSC_VER && !defined FFI_BUILDING #define FFI_EXTERN extern __declspec(dllimport) #else #define FFI_EXTERN extern #endif /* These are defined in types.c */ FFI_EXTERN ffi_type ffi_type_void; FFI_EXTERN ffi_type ffi_type_uint8; FFI_EXTERN ffi_type ffi_type_sint8; FFI_EXTERN ffi_type ffi_type_uint16; FFI_EXTERN ffi_type ffi_type_sint16; FFI_EXTERN ffi_type ffi_type_uint32; FFI_EXTERN ffi_type ffi_type_sint32; FFI_EXTERN ffi_type ffi_type_uint64; FFI_EXTERN ffi_type ffi_type_sint64; FFI_EXTERN ffi_type ffi_type_float; FFI_EXTERN ffi_type ffi_type_double; FFI_EXTERN ffi_type ffi_type_pointer; #if 1 FFI_EXTERN ffi_type ffi_type_longdouble; #else #define ffi_type_longdouble ffi_type_double #endif #endif /* LIBFFI_HIDE_BASIC_TYPES */ typedef enum { FFI_OK = 0, FFI_BAD_TYPEDEF, FFI_BAD_ABI } ffi_status; typedef unsigned FFI_TYPE; typedef struct { ffi_abi abi; unsigned nargs; ffi_type **arg_types; ffi_type *rtype; unsigned bytes; unsigned flags; #ifdef FFI_EXTRA_CIF_FIELDS FFI_EXTRA_CIF_FIELDS; #endif } ffi_cif; #if HAVE_LONG_DOUBLE_VARIANT /* Used to adjust size/alignment of ffi types. */ void ffi_prep_types (ffi_abi abi); # endif /* Used internally, but overridden by some architectures */ ffi_status ffi_prep_cif_core(ffi_cif *cif, ffi_abi abi, unsigned int isvariadic, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); /* ---- Definitions for the raw API -------------------------------------- */ #ifndef FFI_SIZEOF_ARG # if LONG_MAX == 2147483647 # define FFI_SIZEOF_ARG 4 # elif LONG_MAX == FFI_64_BIT_MAX # define FFI_SIZEOF_ARG 8 # endif #endif #ifndef FFI_SIZEOF_JAVA_RAW # define FFI_SIZEOF_JAVA_RAW FFI_SIZEOF_ARG #endif typedef union { ffi_sarg sint; ffi_arg uint; float flt; char data[FFI_SIZEOF_ARG]; void* ptr; } ffi_raw; #if FFI_SIZEOF_JAVA_RAW == 4 && FFI_SIZEOF_ARG == 8 /* This is a special case for mips64/n32 ABI (and perhaps others) where sizeof(void *) is 4 and FFI_SIZEOF_ARG is 8. */ typedef union { signed int sint; unsigned int uint; float flt; char data[FFI_SIZEOF_JAVA_RAW]; void* ptr; } ffi_java_raw; #else typedef ffi_raw ffi_java_raw; #endif void ffi_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_raw *avalue); void ffi_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_raw *raw); void ffi_raw_to_ptrarray (ffi_cif *cif, ffi_raw *raw, void **args); size_t ffi_raw_size (ffi_cif *cif); /* This is analogous to the raw API, except it uses Java parameter */ /* packing, even on 64-bit machines. I.e. on 64-bit machines */ /* longs and doubles are followed by an empty 64-bit word. */ void ffi_java_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_java_raw *avalue); void ffi_java_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_java_raw *raw); void ffi_java_raw_to_ptrarray (ffi_cif *cif, ffi_java_raw *raw, void **args); size_t ffi_java_raw_size (ffi_cif *cif); /* ---- Definitions for closures ----------------------------------------- */ #if FFI_CLOSURES #ifdef _MSC_VER __declspec(align(8)) #endif typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; void (*fun)(ffi_cif*,void*,void**,void*); void *user_data; #ifdef __GNUC__ } ffi_closure __attribute__((aligned (8))); #else } ffi_closure; # ifdef __sgi # pragma pack 0 # endif #endif void *ffi_closure_alloc (size_t size, void **code); void ffi_closure_free (void *); ffi_status ffi_prep_closure (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data); ffi_status ffi_prep_closure_loc (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data, void*codeloc); #ifdef __sgi # pragma pack 8 #endif typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_raw*,void*); void *user_data; } ffi_raw_closure; typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*); void *user_data; } ffi_java_raw_closure; ffi_status ffi_prep_raw_closure (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data); ffi_status ffi_prep_raw_closure_loc (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data, void *codeloc); ffi_status ffi_prep_java_raw_closure (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data); ffi_status ffi_prep_java_raw_closure_loc (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data, void *codeloc); #endif /* FFI_CLOSURES */ /* ---- Public interface definition -------------------------------------- */ ffi_status ffi_prep_cif(ffi_cif *cif, ffi_abi abi, unsigned int nargs, ffi_type *rtype, ffi_type **atypes); ffi_status ffi_prep_cif_var(ffi_cif *cif, ffi_abi abi, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); void ffi_call(ffi_cif *cif, void (*fn)(void), void *rvalue, void **avalue); /* Useful for eliminating compiler warnings */ #define FFI_FN(f) ((void (*)(void))f) /* ---- Definitions shared with assembly code ---------------------------- */ #endif /* If these change, update src/mips/ffitarget.h. */ #define FFI_TYPE_VOID 0 #define FFI_TYPE_INT 1 #define FFI_TYPE_FLOAT 2 #define FFI_TYPE_DOUBLE 3 #if 1 #define FFI_TYPE_LONGDOUBLE 4 #else #define FFI_TYPE_LONGDOUBLE FFI_TYPE_DOUBLE #endif #define FFI_TYPE_UINT8 5 #define FFI_TYPE_SINT8 6 #define FFI_TYPE_UINT16 7 #define FFI_TYPE_SINT16 8 #define FFI_TYPE_UINT32 9 #define FFI_TYPE_SINT32 10 #define FFI_TYPE_UINT64 11 #define FFI_TYPE_SINT64 12 #define FFI_TYPE_STRUCT 13 #define FFI_TYPE_POINTER 14 /* This should always refer to the last type code (for sanity checks) */ #define FFI_TYPE_LAST FFI_TYPE_POINTER #ifdef __cplusplus } #endif #endif #endif ================================================ FILE: src/ffi/ffi_x86_64.h ================================================ #ifdef __x86_64__ /* -----------------------------------------------------------------*-C-*- libffi 3.1-rc1 - Copyright (c) 2011 Anthony Green - Copyright (c) 1996-2003, 2007, 2008 Red Hat, Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ /* ------------------------------------------------------------------- The basic API is described in the README file. The raw API is designed to bypass some of the argument packing and unpacking on architectures for which it can be avoided. The closure API allows interpreted functions to be packaged up inside a C function pointer, so that they can be called as C functions, with no understanding on the client side that they are interpreted. It can also be used in other cases in which it is necessary to package up a user specified parameter and a function pointer as a single function pointer. The closure API must be implemented in order to get its functionality, e.g. for use by gij. Routines are provided to emulate the raw API if the underlying platform doesn't allow faster implementation. More details on the raw and cloure API can be found in: http://gcc.gnu.org/ml/java/1999-q3/msg00138.html and http://gcc.gnu.org/ml/java/1999-q3/msg00174.html -------------------------------------------------------------------- */ #ifndef LIBFFI_H #define LIBFFI_H #ifdef __cplusplus extern "C" { #endif /* Specify which architecture libffi is configured for. */ #ifndef X86_DARWIN #define X86_DARWIN #endif /* ---- System configuration information --------------------------------- */ #include "ffitarget.h" #ifndef LIBFFI_ASM #ifdef _MSC_VER #define __attribute__(X) #endif #include #include /* LONG_LONG_MAX is not always defined (not if STRICT_ANSI, for example). But we can find it either under the correct ANSI name, or under GNU C's internal name. */ #define FFI_64_BIT_MAX 9223372036854775807 #ifdef LONG_LONG_MAX # define FFI_LONG_LONG_MAX LONG_LONG_MAX #else # ifdef LLONG_MAX # define FFI_LONG_LONG_MAX LLONG_MAX # ifdef _AIX52 /* or newer has C99 LLONG_MAX */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif /* _AIX52 or newer */ # else # ifdef __GNUC__ # define FFI_LONG_LONG_MAX __LONG_LONG_MAX__ # endif # ifdef _AIX /* AIX 5.1 and earlier have LONGLONG_MAX */ # ifndef __PPC64__ # if defined (__IBMC__) || defined (__IBMCPP__) # define FFI_LONG_LONG_MAX LONGLONG_MAX # endif # endif /* __PPC64__ */ # undef FFI_64_BIT_MAX # define FFI_64_BIT_MAX 9223372036854775807LL # endif # endif #endif /* The closure code assumes that this works on pointers, i.e. a size_t */ /* can hold a pointer. */ typedef struct _ffi_type { size_t size; unsigned short alignment; unsigned short type; struct _ffi_type **elements; } ffi_type; #ifndef LIBFFI_HIDE_BASIC_TYPES #if SCHAR_MAX == 127 # define ffi_type_uchar ffi_type_uint8 # define ffi_type_schar ffi_type_sint8 #else #error "char size not supported" #endif #if SHRT_MAX == 32767 # define ffi_type_ushort ffi_type_uint16 # define ffi_type_sshort ffi_type_sint16 #elif SHRT_MAX == 2147483647 # define ffi_type_ushort ffi_type_uint32 # define ffi_type_sshort ffi_type_sint32 #else #error "short size not supported" #endif #if INT_MAX == 32767 # define ffi_type_uint ffi_type_uint16 # define ffi_type_sint ffi_type_sint16 #elif INT_MAX == 2147483647 # define ffi_type_uint ffi_type_uint32 # define ffi_type_sint ffi_type_sint32 #elif INT_MAX == 9223372036854775807 # define ffi_type_uint ffi_type_uint64 # define ffi_type_sint ffi_type_sint64 #else #error "int size not supported" #endif #if LONG_MAX == 2147483647 # if FFI_LONG_LONG_MAX != FFI_64_BIT_MAX #error "no 64-bit data type supported" # endif #elif LONG_MAX != FFI_64_BIT_MAX #error "long size not supported" #endif #if LONG_MAX == 2147483647 # define ffi_type_ulong ffi_type_uint32 # define ffi_type_slong ffi_type_sint32 #elif LONG_MAX == FFI_64_BIT_MAX # define ffi_type_ulong ffi_type_uint64 # define ffi_type_slong ffi_type_sint64 #else #error "long size not supported" #endif /* Need minimal decorations for DLLs to works on Windows. */ /* GCC has autoimport and autoexport. Rely on Libtool to */ /* help MSVC export from a DLL, but always declare data */ /* to be imported for MSVC clients. This costs an extra */ /* indirection for MSVC clients using the static version */ /* of the library, but don't worry about that. Besides, */ /* as a workaround, they can define FFI_BUILDING if they */ /* *know* they are going to link with the static library. */ #if defined _MSC_VER && !defined FFI_BUILDING #define FFI_EXTERN extern __declspec(dllimport) #else #define FFI_EXTERN extern #endif /* These are defined in types.c */ FFI_EXTERN ffi_type ffi_type_void; FFI_EXTERN ffi_type ffi_type_uint8; FFI_EXTERN ffi_type ffi_type_sint8; FFI_EXTERN ffi_type ffi_type_uint16; FFI_EXTERN ffi_type ffi_type_sint16; FFI_EXTERN ffi_type ffi_type_uint32; FFI_EXTERN ffi_type ffi_type_sint32; FFI_EXTERN ffi_type ffi_type_uint64; FFI_EXTERN ffi_type ffi_type_sint64; FFI_EXTERN ffi_type ffi_type_float; FFI_EXTERN ffi_type ffi_type_double; FFI_EXTERN ffi_type ffi_type_pointer; #if 1 FFI_EXTERN ffi_type ffi_type_longdouble; #else #define ffi_type_longdouble ffi_type_double #endif #endif /* LIBFFI_HIDE_BASIC_TYPES */ typedef enum { FFI_OK = 0, FFI_BAD_TYPEDEF, FFI_BAD_ABI } ffi_status; typedef unsigned FFI_TYPE; typedef struct { ffi_abi abi; unsigned nargs; ffi_type **arg_types; ffi_type *rtype; unsigned bytes; unsigned flags; #ifdef FFI_EXTRA_CIF_FIELDS FFI_EXTRA_CIF_FIELDS; #endif } ffi_cif; #if HAVE_LONG_DOUBLE_VARIANT /* Used to adjust size/alignment of ffi types. */ void ffi_prep_types (ffi_abi abi); # endif /* Used internally, but overridden by some architectures */ ffi_status ffi_prep_cif_core(ffi_cif *cif, ffi_abi abi, unsigned int isvariadic, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); /* ---- Definitions for the raw API -------------------------------------- */ #ifndef FFI_SIZEOF_ARG # if LONG_MAX == 2147483647 # define FFI_SIZEOF_ARG 4 # elif LONG_MAX == FFI_64_BIT_MAX # define FFI_SIZEOF_ARG 8 # endif #endif #ifndef FFI_SIZEOF_JAVA_RAW # define FFI_SIZEOF_JAVA_RAW FFI_SIZEOF_ARG #endif typedef union { ffi_sarg sint; ffi_arg uint; float flt; char data[FFI_SIZEOF_ARG]; void* ptr; } ffi_raw; #if FFI_SIZEOF_JAVA_RAW == 4 && FFI_SIZEOF_ARG == 8 /* This is a special case for mips64/n32 ABI (and perhaps others) where sizeof(void *) is 4 and FFI_SIZEOF_ARG is 8. */ typedef union { signed int sint; unsigned int uint; float flt; char data[FFI_SIZEOF_JAVA_RAW]; void* ptr; } ffi_java_raw; #else typedef ffi_raw ffi_java_raw; #endif void ffi_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_raw *avalue); void ffi_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_raw *raw); void ffi_raw_to_ptrarray (ffi_cif *cif, ffi_raw *raw, void **args); size_t ffi_raw_size (ffi_cif *cif); /* This is analogous to the raw API, except it uses Java parameter */ /* packing, even on 64-bit machines. I.e. on 64-bit machines */ /* longs and doubles are followed by an empty 64-bit word. */ void ffi_java_raw_call (ffi_cif *cif, void (*fn)(void), void *rvalue, ffi_java_raw *avalue); void ffi_java_ptrarray_to_raw (ffi_cif *cif, void **args, ffi_java_raw *raw); void ffi_java_raw_to_ptrarray (ffi_cif *cif, ffi_java_raw *raw, void **args); size_t ffi_java_raw_size (ffi_cif *cif); /* ---- Definitions for closures ----------------------------------------- */ #if FFI_CLOSURES #ifdef _MSC_VER __declspec(align(8)) #endif typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; void (*fun)(ffi_cif*,void*,void**,void*); void *user_data; #ifdef __GNUC__ } ffi_closure __attribute__((aligned (8))); #else } ffi_closure; # ifdef __sgi # pragma pack 0 # endif #endif void *ffi_closure_alloc (size_t size, void **code); void ffi_closure_free (void *); ffi_status ffi_prep_closure (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data); ffi_status ffi_prep_closure_loc (ffi_closure*, ffi_cif *, void (*fun)(ffi_cif*,void*,void**,void*), void *user_data, void*codeloc); #ifdef __sgi # pragma pack 8 #endif typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_raw*,void*); void *user_data; } ffi_raw_closure; typedef struct { #if 0 void *trampoline_table; void *trampoline_table_entry; #else char tramp[FFI_TRAMPOLINE_SIZE]; #endif ffi_cif *cif; #if !FFI_NATIVE_RAW_API /* if this is enabled, then a raw closure has the same layout as a regular closure. We use this to install an intermediate handler to do the transaltion, void** -> ffi_raw*. */ void (*translate_args)(ffi_cif*,void*,void**,void*); void *this_closure; #endif void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*); void *user_data; } ffi_java_raw_closure; ffi_status ffi_prep_raw_closure (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data); ffi_status ffi_prep_raw_closure_loc (ffi_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_raw*,void*), void *user_data, void *codeloc); ffi_status ffi_prep_java_raw_closure (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data); ffi_status ffi_prep_java_raw_closure_loc (ffi_java_raw_closure*, ffi_cif *cif, void (*fun)(ffi_cif*,void*,ffi_java_raw*,void*), void *user_data, void *codeloc); #endif /* FFI_CLOSURES */ /* ---- Public interface definition -------------------------------------- */ ffi_status ffi_prep_cif(ffi_cif *cif, ffi_abi abi, unsigned int nargs, ffi_type *rtype, ffi_type **atypes); ffi_status ffi_prep_cif_var(ffi_cif *cif, ffi_abi abi, unsigned int nfixedargs, unsigned int ntotalargs, ffi_type *rtype, ffi_type **atypes); void ffi_call(ffi_cif *cif, void (*fn)(void), void *rvalue, void **avalue); /* Useful for eliminating compiler warnings */ #define FFI_FN(f) ((void (*)(void))f) /* ---- Definitions shared with assembly code ---------------------------- */ #endif /* If these change, update src/mips/ffitarget.h. */ #define FFI_TYPE_VOID 0 #define FFI_TYPE_INT 1 #define FFI_TYPE_FLOAT 2 #define FFI_TYPE_DOUBLE 3 #if 1 #define FFI_TYPE_LONGDOUBLE 4 #else #define FFI_TYPE_LONGDOUBLE FFI_TYPE_DOUBLE #endif #define FFI_TYPE_UINT8 5 #define FFI_TYPE_SINT8 6 #define FFI_TYPE_UINT16 7 #define FFI_TYPE_SINT16 8 #define FFI_TYPE_UINT32 9 #define FFI_TYPE_SINT32 10 #define FFI_TYPE_UINT64 11 #define FFI_TYPE_SINT64 12 #define FFI_TYPE_STRUCT 13 #define FFI_TYPE_POINTER 14 /* This should always refer to the last type code (for sanity checks) */ #define FFI_TYPE_LAST FFI_TYPE_POINTER #ifdef __cplusplus } #endif #endif #endif ================================================ FILE: src/ffi/fficonfig.h ================================================ #ifdef __arm64__ #include #endif #ifdef __i386__ #include #endif #ifdef __arm__ #include #endif #ifdef __x86_64__ #include #endif ================================================ FILE: src/ffi/fficonfig_arm64.h ================================================ #ifdef __arm64__ /* fficonfig.h. Generated from fficonfig.h.in by configure. */ /* fficonfig.h.in. Generated from configure.ac by autoheader. */ /* Define if building universal (internal helper macro) */ /* #undef AC_APPLE_UNIVERSAL_BUILD */ /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ /* #undef C_ALLOCA */ /* Define to the flags needed for the .section .eh_frame directive. */ #define EH_FRAME_FLAGS "aw" /* Define this if you want extra debugging. */ /* #undef FFI_DEBUG */ /* Cannot use PROT_EXEC on this target, so, we revert to alternative means */ /* #undef FFI_EXEC_TRAMPOLINE_TABLE */ /* Define this if you want to enable pax emulated trampolines */ /* #undef FFI_MMAP_EXEC_EMUTRAMP_PAX */ /* Cannot use malloc on this target, so, we revert to alternative means */ #define FFI_MMAP_EXEC_WRIT 1 /* Define this if you do not want support for the raw API. */ /* #undef FFI_NO_RAW_API */ /* Define this if you do not want support for aggregate types. */ /* #undef FFI_NO_STRUCTS */ /* Define to 1 if you have `alloca', as a function or macro. */ #define HAVE_ALLOCA 1 /* Define to 1 if you have and it should be used (not on Ultrix). */ #define HAVE_ALLOCA_H 1 /* Define if your assembler supports .ascii. */ /* #undef HAVE_AS_ASCII_PSEUDO_OP */ /* Define if your assembler supports .cfi_* directives. */ #define HAVE_AS_CFI_PSEUDO_OP 1 /* Define if your assembler supports .register. */ /* #undef HAVE_AS_REGISTER_PSEUDO_OP */ /* Define if your assembler and linker support unaligned PC relative relocs. */ /* #undef HAVE_AS_SPARC_UA_PCREL */ /* Define if your assembler supports .string. */ /* #undef HAVE_AS_STRING_PSEUDO_OP */ /* Define if your assembler supports unwind section type. */ /* #undef HAVE_AS_X86_64_UNWIND_SECTION_TYPE */ /* Define if your assembler supports PC relative relocs. */ /* #undef HAVE_AS_X86_PCREL */ /* Define to 1 if you have the header file. */ #define HAVE_DLFCN_H 1 /* Define if __attribute__((visibility("hidden"))) is supported. */ /* #undef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define if you have the long double type and it is bigger than a double */ /* #undef HAVE_LONG_DOUBLE */ /* Define if you support more than one size of the long double type */ /* #undef HAVE_LONG_DOUBLE_VARIANT */ /* Define to 1 if you have the `memcpy' function. */ #define HAVE_MEMCPY 1 /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mmap' function. */ #define HAVE_MMAP 1 /* Define if mmap with MAP_ANON(YMOUS) works. */ #define HAVE_MMAP_ANON 1 /* Define if mmap of /dev/zero works. */ /* #undef HAVE_MMAP_DEV_ZERO */ /* Define if read-only mmap of a plain file works. */ #define HAVE_MMAP_FILE 1 /* Define if .eh_frame sections should be read-only. */ /* #undef HAVE_RO_EH_FRAME */ /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_MMAN_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define to the sub-directory in which libtool stores uninstalled libraries. */ #define LT_OBJDIR ".libs/" /* Name of package */ #define PACKAGE "libffi" /* Define to the address where bug reports for this package should be sent. */ #define PACKAGE_BUGREPORT "http://github.com/atgreen/libffi/issues" /* Define to the full name of this package. */ #define PACKAGE_NAME "libffi" /* Define to the full name and version of this package. */ #define PACKAGE_STRING "libffi 3.1-rc1" /* Define to the one symbol short name of this package. */ #define PACKAGE_TARNAME "libffi" /* Define to the home page for this package. */ #define PACKAGE_URL "" /* Define to the version of this package. */ #define PACKAGE_VERSION "3.1-rc1" /* The size of `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of `long double', as computed by sizeof. */ #define SIZEOF_LONG_DOUBLE 8 /* The size of `size_t', as computed by sizeof. */ #define SIZEOF_SIZE_T 8 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if symbols are underscored. */ #define SYMBOL_UNDERSCORE 1 /* Define this if you are using Purify and want to suppress spurious messages. */ /* #undef USING_PURIFY */ /* Version number of package */ #define VERSION "3.1-rc1" /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel). */ #if defined AC_APPLE_UNIVERSAL_BUILD # if defined __BIG_ENDIAN__ # define WORDS_BIGENDIAN 1 # endif #else # ifndef WORDS_BIGENDIAN /* # undef WORDS_BIGENDIAN */ # endif #endif /* Define to `unsigned int' if does not define. */ /* #undef size_t */ #ifdef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) .hidden name #else #define FFI_HIDDEN __attribute__ ((visibility ("hidden"))) #endif #else #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) #else #define FFI_HIDDEN #endif #endif #endif ================================================ FILE: src/ffi/fficonfig_armv7.h ================================================ #ifdef __arm__ /* fficonfig.h. Generated from fficonfig.h.in by configure. */ /* fficonfig.h.in. Generated from configure.ac by autoheader. */ /* Define if building universal (internal helper macro) */ /* #undef AC_APPLE_UNIVERSAL_BUILD */ /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ /* #undef C_ALLOCA */ /* Define to the flags needed for the .section .eh_frame directive. */ #define EH_FRAME_FLAGS "aw" /* Define this if you want extra debugging. */ /* #undef FFI_DEBUG */ /* Cannot use PROT_EXEC on this target, so, we revert to alternative means */ #define FFI_EXEC_TRAMPOLINE_TABLE 1 /* Define this if you want to enable pax emulated trampolines */ /* #undef FFI_MMAP_EXEC_EMUTRAMP_PAX */ /* Cannot use malloc on this target, so, we revert to alternative means */ /* #undef FFI_MMAP_EXEC_WRIT */ /* Define this if you do not want support for the raw API. */ /* #undef FFI_NO_RAW_API */ /* Define this if you do not want support for aggregate types. */ /* #undef FFI_NO_STRUCTS */ /* Define to 1 if you have `alloca', as a function or macro. */ #define HAVE_ALLOCA 1 /* Define to 1 if you have and it should be used (not on Ultrix). */ #define HAVE_ALLOCA_H 1 /* Define if your assembler supports .ascii. */ /* #undef HAVE_AS_ASCII_PSEUDO_OP */ /* Define if your assembler supports .cfi_* directives. */ #define HAVE_AS_CFI_PSEUDO_OP 1 /* Define if your assembler supports .register. */ /* #undef HAVE_AS_REGISTER_PSEUDO_OP */ /* Define if your assembler and linker support unaligned PC relative relocs. */ /* #undef HAVE_AS_SPARC_UA_PCREL */ /* Define if your assembler supports .string. */ /* #undef HAVE_AS_STRING_PSEUDO_OP */ /* Define if your assembler supports unwind section type. */ /* #undef HAVE_AS_X86_64_UNWIND_SECTION_TYPE */ /* Define if your assembler supports PC relative relocs. */ /* #undef HAVE_AS_X86_PCREL */ /* Define to 1 if you have the header file. */ #define HAVE_DLFCN_H 1 /* Define if __attribute__((visibility("hidden"))) is supported. */ /* #undef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define if you have the long double type and it is bigger than a double */ /* #undef HAVE_LONG_DOUBLE */ /* Define if you support more than one size of the long double type */ /* #undef HAVE_LONG_DOUBLE_VARIANT */ /* Define to 1 if you have the `memcpy' function. */ #define HAVE_MEMCPY 1 /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mmap' function. */ #define HAVE_MMAP 1 /* Define if mmap with MAP_ANON(YMOUS) works. */ #define HAVE_MMAP_ANON 1 /* Define if mmap of /dev/zero works. */ /* #undef HAVE_MMAP_DEV_ZERO */ /* Define if read-only mmap of a plain file works. */ #define HAVE_MMAP_FILE 1 /* Define if .eh_frame sections should be read-only. */ /* #undef HAVE_RO_EH_FRAME */ /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_MMAN_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define to the sub-directory in which libtool stores uninstalled libraries. */ #define LT_OBJDIR ".libs/" /* Name of package */ #define PACKAGE "libffi" /* Define to the address where bug reports for this package should be sent. */ #define PACKAGE_BUGREPORT "http://github.com/atgreen/libffi/issues" /* Define to the full name of this package. */ #define PACKAGE_NAME "libffi" /* Define to the full name and version of this package. */ #define PACKAGE_STRING "libffi 3.1-rc1" /* Define to the one symbol short name of this package. */ #define PACKAGE_TARNAME "libffi" /* Define to the home page for this package. */ #define PACKAGE_URL "" /* Define to the version of this package. */ #define PACKAGE_VERSION "3.1-rc1" /* The size of `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of `long double', as computed by sizeof. */ #define SIZEOF_LONG_DOUBLE 8 /* The size of `size_t', as computed by sizeof. */ #define SIZEOF_SIZE_T 4 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if symbols are underscored. */ #define SYMBOL_UNDERSCORE 1 /* Define this if you are using Purify and want to suppress spurious messages. */ /* #undef USING_PURIFY */ /* Version number of package */ #define VERSION "3.1-rc1" /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel). */ #if defined AC_APPLE_UNIVERSAL_BUILD # if defined __BIG_ENDIAN__ # define WORDS_BIGENDIAN 1 # endif #else # ifndef WORDS_BIGENDIAN /* # undef WORDS_BIGENDIAN */ # endif #endif /* Define to `unsigned int' if does not define. */ /* #undef size_t */ #ifdef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) .hidden name #else #define FFI_HIDDEN __attribute__ ((visibility ("hidden"))) #endif #else #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) #else #define FFI_HIDDEN #endif #endif #endif ================================================ FILE: src/ffi/fficonfig_i386.h ================================================ #ifdef __i386__ /* fficonfig.h. Generated from fficonfig.h.in by configure. */ /* fficonfig.h.in. Generated from configure.ac by autoheader. */ /* Define if building universal (internal helper macro) */ /* #undef AC_APPLE_UNIVERSAL_BUILD */ /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ /* #undef C_ALLOCA */ /* Define to the flags needed for the .section .eh_frame directive. */ #define EH_FRAME_FLAGS "aw" /* Define this if you want extra debugging. */ /* #undef FFI_DEBUG */ /* Cannot use PROT_EXEC on this target, so, we revert to alternative means */ /* #undef FFI_EXEC_TRAMPOLINE_TABLE */ /* Define this if you want to enable pax emulated trampolines */ /* #undef FFI_MMAP_EXEC_EMUTRAMP_PAX */ /* Cannot use malloc on this target, so, we revert to alternative means */ #define FFI_MMAP_EXEC_WRIT 1 /* Define this if you do not want support for the raw API. */ /* #undef FFI_NO_RAW_API */ /* Define this if you do not want support for aggregate types. */ /* #undef FFI_NO_STRUCTS */ /* Define to 1 if you have `alloca', as a function or macro. */ #define HAVE_ALLOCA 1 /* Define to 1 if you have and it should be used (not on Ultrix). */ #define HAVE_ALLOCA_H 1 /* Define if your assembler supports .ascii. */ /* #undef HAVE_AS_ASCII_PSEUDO_OP */ /* Define if your assembler supports .cfi_* directives. */ #define HAVE_AS_CFI_PSEUDO_OP 1 /* Define if your assembler supports .register. */ /* #undef HAVE_AS_REGISTER_PSEUDO_OP */ /* Define if your assembler and linker support unaligned PC relative relocs. */ /* #undef HAVE_AS_SPARC_UA_PCREL */ /* Define if your assembler supports .string. */ /* #undef HAVE_AS_STRING_PSEUDO_OP */ /* Define if your assembler supports unwind section type. */ /* #undef HAVE_AS_X86_64_UNWIND_SECTION_TYPE */ /* Define if your assembler supports PC relative relocs. */ /* #undef HAVE_AS_X86_PCREL */ /* Define to 1 if you have the header file. */ #define HAVE_DLFCN_H 1 /* Define if __attribute__((visibility("hidden"))) is supported. */ /* #undef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define if you have the long double type and it is bigger than a double */ #define HAVE_LONG_DOUBLE 1 /* Define if you support more than one size of the long double type */ /* #undef HAVE_LONG_DOUBLE_VARIANT */ /* Define to 1 if you have the `memcpy' function. */ #define HAVE_MEMCPY 1 /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mmap' function. */ #define HAVE_MMAP 1 /* Define if mmap with MAP_ANON(YMOUS) works. */ #define HAVE_MMAP_ANON 1 /* Define if mmap of /dev/zero works. */ /* #undef HAVE_MMAP_DEV_ZERO */ /* Define if read-only mmap of a plain file works. */ #define HAVE_MMAP_FILE 1 /* Define if .eh_frame sections should be read-only. */ /* #undef HAVE_RO_EH_FRAME */ /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_MMAN_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define to the sub-directory in which libtool stores uninstalled libraries. */ #define LT_OBJDIR ".libs/" /* Name of package */ #define PACKAGE "libffi" /* Define to the address where bug reports for this package should be sent. */ #define PACKAGE_BUGREPORT "http://github.com/atgreen/libffi/issues" /* Define to the full name of this package. */ #define PACKAGE_NAME "libffi" /* Define to the full name and version of this package. */ #define PACKAGE_STRING "libffi 3.1-rc1" /* Define to the one symbol short name of this package. */ #define PACKAGE_TARNAME "libffi" /* Define to the home page for this package. */ #define PACKAGE_URL "" /* Define to the version of this package. */ #define PACKAGE_VERSION "3.1-rc1" /* The size of `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of `long double', as computed by sizeof. */ #define SIZEOF_LONG_DOUBLE 16 /* The size of `size_t', as computed by sizeof. */ #define SIZEOF_SIZE_T 4 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if symbols are underscored. */ #define SYMBOL_UNDERSCORE 1 /* Define this if you are using Purify and want to suppress spurious messages. */ /* #undef USING_PURIFY */ /* Version number of package */ #define VERSION "3.1-rc1" /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel). */ #if defined AC_APPLE_UNIVERSAL_BUILD # if defined __BIG_ENDIAN__ # define WORDS_BIGENDIAN 1 # endif #else # ifndef WORDS_BIGENDIAN /* # undef WORDS_BIGENDIAN */ # endif #endif /* Define to `unsigned int' if does not define. */ /* #undef size_t */ #ifdef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) .hidden name #else #define FFI_HIDDEN __attribute__ ((visibility ("hidden"))) #endif #else #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) #else #define FFI_HIDDEN #endif #endif #endif ================================================ FILE: src/ffi/fficonfig_x86_64.h ================================================ #ifdef __x86_64__ /* fficonfig.h. Generated from fficonfig.h.in by configure. */ /* fficonfig.h.in. Generated from configure.ac by autoheader. */ /* Define if building universal (internal helper macro) */ /* #undef AC_APPLE_UNIVERSAL_BUILD */ /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP systems. This function is required for `alloca.c' support on those systems. */ /* #undef CRAY_STACKSEG_END */ /* Define to 1 if using `alloca.c'. */ /* #undef C_ALLOCA */ /* Define to the flags needed for the .section .eh_frame directive. */ #define EH_FRAME_FLAGS "aw" /* Define this if you want extra debugging. */ /* #undef FFI_DEBUG */ /* Cannot use PROT_EXEC on this target, so, we revert to alternative means */ /* #undef FFI_EXEC_TRAMPOLINE_TABLE */ /* Define this if you want to enable pax emulated trampolines */ /* #undef FFI_MMAP_EXEC_EMUTRAMP_PAX */ /* Cannot use malloc on this target, so, we revert to alternative means */ #define FFI_MMAP_EXEC_WRIT 1 /* Define this if you do not want support for the raw API. */ /* #undef FFI_NO_RAW_API */ /* Define this if you do not want support for aggregate types. */ /* #undef FFI_NO_STRUCTS */ /* Define to 1 if you have `alloca', as a function or macro. */ #define HAVE_ALLOCA 1 /* Define to 1 if you have and it should be used (not on Ultrix). */ #define HAVE_ALLOCA_H 1 /* Define if your assembler supports .ascii. */ /* #undef HAVE_AS_ASCII_PSEUDO_OP */ /* Define if your assembler supports .cfi_* directives. */ #define HAVE_AS_CFI_PSEUDO_OP 1 /* Define if your assembler supports .register. */ /* #undef HAVE_AS_REGISTER_PSEUDO_OP */ /* Define if your assembler and linker support unaligned PC relative relocs. */ /* #undef HAVE_AS_SPARC_UA_PCREL */ /* Define if your assembler supports .string. */ /* #undef HAVE_AS_STRING_PSEUDO_OP */ /* Define if your assembler supports unwind section type. */ /* #undef HAVE_AS_X86_64_UNWIND_SECTION_TYPE */ /* Define if your assembler supports PC relative relocs. */ /* #undef HAVE_AS_X86_PCREL */ /* Define to 1 if you have the header file. */ #define HAVE_DLFCN_H 1 /* Define if __attribute__((visibility("hidden"))) is supported. */ /* #undef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE */ /* Define to 1 if you have the header file. */ #define HAVE_INTTYPES_H 1 /* Define if you have the long double type and it is bigger than a double */ #define HAVE_LONG_DOUBLE 1 /* Define if you support more than one size of the long double type */ /* #undef HAVE_LONG_DOUBLE_VARIANT */ /* Define to 1 if you have the `memcpy' function. */ #define HAVE_MEMCPY 1 /* Define to 1 if you have the header file. */ #define HAVE_MEMORY_H 1 /* Define to 1 if you have the `mmap' function. */ #define HAVE_MMAP 1 /* Define if mmap with MAP_ANON(YMOUS) works. */ #define HAVE_MMAP_ANON 1 /* Define if mmap of /dev/zero works. */ /* #undef HAVE_MMAP_DEV_ZERO */ /* Define if read-only mmap of a plain file works. */ #define HAVE_MMAP_FILE 1 /* Define if .eh_frame sections should be read-only. */ /* #undef HAVE_RO_EH_FRAME */ /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRINGS_H 1 /* Define to 1 if you have the header file. */ #define HAVE_STRING_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_MMAN_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_STAT_H 1 /* Define to 1 if you have the header file. */ #define HAVE_SYS_TYPES_H 1 /* Define to 1 if you have the header file. */ #define HAVE_UNISTD_H 1 /* Define to the sub-directory in which libtool stores uninstalled libraries. */ #define LT_OBJDIR ".libs/" /* Name of package */ #define PACKAGE "libffi" /* Define to the address where bug reports for this package should be sent. */ #define PACKAGE_BUGREPORT "http://github.com/atgreen/libffi/issues" /* Define to the full name of this package. */ #define PACKAGE_NAME "libffi" /* Define to the full name and version of this package. */ #define PACKAGE_STRING "libffi 3.1-rc1" /* Define to the one symbol short name of this package. */ #define PACKAGE_TARNAME "libffi" /* Define to the home page for this package. */ #define PACKAGE_URL "" /* Define to the version of this package. */ #define PACKAGE_VERSION "3.1-rc1" /* The size of `double', as computed by sizeof. */ #define SIZEOF_DOUBLE 8 /* The size of `long double', as computed by sizeof. */ #define SIZEOF_LONG_DOUBLE 16 /* The size of `size_t', as computed by sizeof. */ #define SIZEOF_SIZE_T 8 /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if symbols are underscored. */ #define SYMBOL_UNDERSCORE 1 /* Define this if you are using Purify and want to suppress spurious messages. */ /* #undef USING_PURIFY */ /* Version number of package */ #define VERSION "3.1-rc1" /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel). */ #if defined AC_APPLE_UNIVERSAL_BUILD # if defined __BIG_ENDIAN__ # define WORDS_BIGENDIAN 1 # endif #else # ifndef WORDS_BIGENDIAN /* # undef WORDS_BIGENDIAN */ # endif #endif /* Define to `unsigned int' if does not define. */ /* #undef size_t */ #ifdef HAVE_HIDDEN_VISIBILITY_ATTRIBUTE #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) .hidden name #else #define FFI_HIDDEN __attribute__ ((visibility ("hidden"))) #endif #else #ifdef LIBFFI_ASM #define FFI_HIDDEN(name) #else #define FFI_HIDDEN #endif #endif #endif ================================================ FILE: src/ffi/ffitarget.h ================================================ #ifdef __arm64__ #include "ffitarget_arm64.h" #endif #ifdef __i386__ #include "ffitarget_i386.h" #endif #ifdef __arm__ #include "ffitarget_armv7.h" #endif #ifdef __x86_64__ #include "ffitarget_x86_64.h" #endif ================================================ FILE: src/ffi/ffitarget_arm64.h ================================================ #ifdef __arm64__ /* Copyright (c) 2009, 2010, 2011, 2012 ARM Ltd. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ #ifndef LIBFFI_TARGET_H #define LIBFFI_TARGET_H #ifndef LIBFFI_H #error "Please do not include ffitarget.h directly into your source. Use ffi.h instead." #endif #ifndef LIBFFI_ASM typedef unsigned long ffi_arg; typedef signed long ffi_sarg; typedef enum ffi_abi { FFI_FIRST_ABI = 0, FFI_SYSV, FFI_LAST_ABI, FFI_DEFAULT_ABI = FFI_SYSV } ffi_abi; #endif /* ---- Definitions for closures ----------------------------------------- */ #define FFI_CLOSURES 1 #define FFI_TRAMPOLINE_SIZE 36 #define FFI_NATIVE_RAW_API 0 /* ---- Internal ---- */ #define FFI_EXTRA_CIF_FIELDS unsigned aarch64_flags #define AARCH64_FFI_WITH_V_BIT 0 #define AARCH64_N_XREG 32 #define AARCH64_N_VREG 32 #define AARCH64_CALL_CONTEXT_SIZE (AARCH64_N_XREG * 8 + AARCH64_N_VREG * 16) #endif #endif ================================================ FILE: src/ffi/ffitarget_armv7.h ================================================ #ifdef __arm__ /* -----------------------------------------------------------------*-C-*- ffitarget.h - Copyright (c) 2012 Anthony Green Copyright (c) 2010 CodeSourcery Copyright (c) 1996-2003 Red Hat, Inc. Target configuration macros for ARM. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ #ifndef LIBFFI_TARGET_H #define LIBFFI_TARGET_H #ifndef LIBFFI_H #error "Please do not include ffitarget.h directly into your source. Use ffi.h instead." #endif #ifndef LIBFFI_ASM typedef unsigned long ffi_arg; typedef signed long ffi_sarg; typedef enum ffi_abi { FFI_FIRST_ABI = 0, FFI_SYSV, FFI_VFP, FFI_LAST_ABI, #ifdef __ARM_PCS_VFP FFI_DEFAULT_ABI = FFI_VFP, #else FFI_DEFAULT_ABI = FFI_SYSV, #endif } ffi_abi; #endif #define FFI_EXTRA_CIF_FIELDS \ int vfp_used; \ short vfp_reg_free, vfp_nargs; \ signed char vfp_args[16] \ /* Internally used. */ #define FFI_TYPE_STRUCT_VFP_FLOAT (FFI_TYPE_LAST + 1) #define FFI_TYPE_STRUCT_VFP_DOUBLE (FFI_TYPE_LAST + 2) #define FFI_TARGET_SPECIFIC_VARIADIC /* ---- Definitions for closures ----------------------------------------- */ #define FFI_CLOSURES 1 #define FFI_TRAMPOLINE_SIZE 20 #define FFI_NATIVE_RAW_API 0 #endif #endif ================================================ FILE: src/ffi/ffitarget_i386.h ================================================ #ifdef __i386__ /* -----------------------------------------------------------------*-C-*- ffitarget.h - Copyright (c) 2012 Anthony Green Copyright (c) 1996-2003, 2010 Red Hat, Inc. Copyright (C) 2008 Free Software Foundation, Inc. Target configuration macros for x86 and x86-64. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ #ifndef LIBFFI_TARGET_H #define LIBFFI_TARGET_H #ifndef LIBFFI_H #error "Please do not include ffitarget.h directly into your source. Use ffi.h instead." #endif /* ---- System specific configurations ----------------------------------- */ /* For code common to all platforms on x86 and x86_64. */ #define X86_ANY #if defined (X86_64) && defined (__i386__) #undef X86_64 #define X86 #endif #ifdef X86_WIN64 #define FFI_SIZEOF_ARG 8 #define USE_BUILTIN_FFS 0 /* not yet implemented in mingw-64 */ #endif /* ---- Generic type definitions ----------------------------------------- */ #ifndef LIBFFI_ASM #ifdef X86_WIN64 #ifdef _MSC_VER typedef unsigned __int64 ffi_arg; typedef __int64 ffi_sarg; #else typedef unsigned long long ffi_arg; typedef long long ffi_sarg; #endif #else #if defined __x86_64__ && defined __ILP32__ #define FFI_SIZEOF_ARG 8 #define FFI_SIZEOF_JAVA_RAW 4 typedef unsigned long long ffi_arg; typedef long long ffi_sarg; #else typedef unsigned long ffi_arg; typedef signed long ffi_sarg; #endif #endif typedef enum ffi_abi { FFI_FIRST_ABI = 0, /* ---- Intel x86 Win32 ---------- */ #ifdef X86_WIN32 FFI_SYSV, FFI_STDCALL, FFI_THISCALL, FFI_FASTCALL, FFI_MS_CDECL, FFI_LAST_ABI, #ifdef _MSC_VER FFI_DEFAULT_ABI = FFI_MS_CDECL #else FFI_DEFAULT_ABI = FFI_SYSV #endif #elif defined(X86_WIN64) FFI_WIN64, FFI_LAST_ABI, FFI_DEFAULT_ABI = FFI_WIN64 #else /* ---- Intel x86 and AMD x86-64 - */ FFI_SYSV, FFI_UNIX64, /* Unix variants all use the same ABI for x86-64 */ FFI_THISCALL, FFI_FASTCALL, FFI_STDCALL, FFI_LAST_ABI, #if defined(__i386__) || defined(__i386) FFI_DEFAULT_ABI = FFI_SYSV #else FFI_DEFAULT_ABI = FFI_UNIX64 #endif #endif } ffi_abi; #endif /* ---- Definitions for closures ----------------------------------------- */ #define FFI_CLOSURES 1 #define FFI_TYPE_SMALL_STRUCT_1B (FFI_TYPE_LAST + 1) #define FFI_TYPE_SMALL_STRUCT_2B (FFI_TYPE_LAST + 2) #define FFI_TYPE_SMALL_STRUCT_4B (FFI_TYPE_LAST + 3) #define FFI_TYPE_MS_STRUCT (FFI_TYPE_LAST + 4) #if defined (X86_64) || (defined (__x86_64__) && defined (X86_DARWIN)) #define FFI_TRAMPOLINE_SIZE 24 #define FFI_NATIVE_RAW_API 0 #elif defined(X86_WIN64) #define FFI_TRAMPOLINE_SIZE 29 #define FFI_NATIVE_RAW_API 0 #define FFI_NO_RAW_API 1 #else #define FFI_TRAMPOLINE_SIZE 52 #define FFI_NATIVE_RAW_API 1 /* x86 has native raw api support */ #endif #endif #endif ================================================ FILE: src/ffi/ffitarget_x86_64.h ================================================ #ifdef __x86_64__ /* -----------------------------------------------------------------*-C-*- ffitarget.h - Copyright (c) 2012 Anthony Green Copyright (c) 1996-2003, 2010 Red Hat, Inc. Copyright (C) 2008 Free Software Foundation, Inc. Target configuration macros for x86 and x86-64. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ----------------------------------------------------------------------- */ #ifndef LIBFFI_TARGET_H #define LIBFFI_TARGET_H #ifndef LIBFFI_H #error "Please do not include ffitarget.h directly into your source. Use ffi.h instead." #endif /* ---- System specific configurations ----------------------------------- */ /* For code common to all platforms on x86 and x86_64. */ #define X86_ANY #if defined (X86_64) && defined (__i386__) #undef X86_64 #define X86 #endif #ifdef X86_WIN64 #define FFI_SIZEOF_ARG 8 #define USE_BUILTIN_FFS 0 /* not yet implemented in mingw-64 */ #endif /* ---- Generic type definitions ----------------------------------------- */ #ifndef LIBFFI_ASM #ifdef X86_WIN64 #ifdef _MSC_VER typedef unsigned __int64 ffi_arg; typedef __int64 ffi_sarg; #else typedef unsigned long long ffi_arg; typedef long long ffi_sarg; #endif #else #if defined __x86_64__ && defined __ILP32__ #define FFI_SIZEOF_ARG 8 #define FFI_SIZEOF_JAVA_RAW 4 typedef unsigned long long ffi_arg; typedef long long ffi_sarg; #else typedef unsigned long ffi_arg; typedef signed long ffi_sarg; #endif #endif typedef enum ffi_abi { FFI_FIRST_ABI = 0, /* ---- Intel x86 Win32 ---------- */ #ifdef X86_WIN32 FFI_SYSV, FFI_STDCALL, FFI_THISCALL, FFI_FASTCALL, FFI_MS_CDECL, FFI_LAST_ABI, #ifdef _MSC_VER FFI_DEFAULT_ABI = FFI_MS_CDECL #else FFI_DEFAULT_ABI = FFI_SYSV #endif #elif defined(X86_WIN64) FFI_WIN64, FFI_LAST_ABI, FFI_DEFAULT_ABI = FFI_WIN64 #else /* ---- Intel x86 and AMD x86-64 - */ FFI_SYSV, FFI_UNIX64, /* Unix variants all use the same ABI for x86-64 */ FFI_THISCALL, FFI_FASTCALL, FFI_STDCALL, FFI_LAST_ABI, #if defined(__i386__) || defined(__i386) FFI_DEFAULT_ABI = FFI_SYSV #else FFI_DEFAULT_ABI = FFI_UNIX64 #endif #endif } ffi_abi; #endif /* ---- Definitions for closures ----------------------------------------- */ #define FFI_CLOSURES 1 #define FFI_TYPE_SMALL_STRUCT_1B (FFI_TYPE_LAST + 1) #define FFI_TYPE_SMALL_STRUCT_2B (FFI_TYPE_LAST + 2) #define FFI_TYPE_SMALL_STRUCT_4B (FFI_TYPE_LAST + 3) #define FFI_TYPE_MS_STRUCT (FFI_TYPE_LAST + 4) #if defined (X86_64) || (defined (__x86_64__) && defined (X86_DARWIN)) #define FFI_TRAMPOLINE_SIZE 24 #define FFI_NATIVE_RAW_API 0 #elif defined(X86_WIN64) #define FFI_TRAMPOLINE_SIZE 29 #define FFI_NATIVE_RAW_API 0 #define FFI_NO_RAW_API 1 #else #define FFI_TRAMPOLINE_SIZE 52 #define FFI_NATIVE_RAW_API 1 /* x86 has native raw api support */ #endif #endif #endif ================================================ FILE: src/jvm/clojure/asm/AnnotationVisitor.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A visitor to visit a Java annotation. The methods of this class must be * called in the following order: ( visit | visitEnum | * visitAnnotation | visitArray )* visitEnd. * * @author Eric Bruneton * @author Eugene Kuleshov */ public abstract class AnnotationVisitor { /** * The ASM API version implemented by this visitor. The value of this field * must be one of {@link Opcodes#ASM4}. */ protected final int api; /** * The annotation visitor to which this visitor must delegate method calls. * May be null. */ protected AnnotationVisitor av; /** * Constructs a new {@link AnnotationVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. */ public AnnotationVisitor(final int api) { this(api, null); } /** * Constructs a new {@link AnnotationVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. * @param av * the annotation visitor to which this visitor must delegate * method calls. May be null. */ public AnnotationVisitor(final int api, final AnnotationVisitor av) { if (api != Opcodes.ASM4) { throw new IllegalArgumentException(); } this.api = api; this.av = av; } /** * Visits a primitive value of the annotation. * * @param name * the value name. * @param value * the actual value, whose type must be {@link Byte}, * {@link Boolean}, {@link Character}, {@link Short}, * {@link Integer} , {@link Long}, {@link Float}, {@link Double}, * {@link String} or {@link Type} or OBJECT or ARRAY sort. This * value can also be an array of byte, boolean, short, char, int, * long, float or double values (this is equivalent to using * {@link #visitArray visitArray} and visiting each array element * in turn, but is more convenient). */ public void visit(String name, Object value) { if (av != null) { av.visit(name, value); } } /** * Visits an enumeration value of the annotation. * * @param name * the value name. * @param desc * the class descriptor of the enumeration class. * @param value * the actual enumeration value. */ public void visitEnum(String name, String desc, String value) { if (av != null) { av.visitEnum(name, desc, value); } } /** * Visits a nested annotation value of the annotation. * * @param name * the value name. * @param desc * the class descriptor of the nested annotation class. * @return a visitor to visit the actual nested annotation value, or * null if this visitor is not interested in visiting this * nested annotation. The nested annotation value must be fully * visited before calling other methods on this annotation * visitor. */ public AnnotationVisitor visitAnnotation(String name, String desc) { if (av != null) { return av.visitAnnotation(name, desc); } return null; } /** * Visits an array value of the annotation. Note that arrays of primitive * types (such as byte, boolean, short, char, int, long, float or double) * can be passed as value to {@link #visit visit}. This is what * {@link ClassReader} does. * * @param name * the value name. * @return a visitor to visit the actual array value elements, or * null if this visitor is not interested in visiting these * values. The 'name' parameters passed to the methods of this * visitor are ignored. All the array values must be visited * before calling other methods on this annotation visitor. */ public AnnotationVisitor visitArray(String name) { if (av != null) { return av.visitArray(name); } return null; } /** * Visits the end of the annotation. */ public void visitEnd() { if (av != null) { av.visitEnd(); } } } ================================================ FILE: src/jvm/clojure/asm/AnnotationWriter.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * An {@link AnnotationVisitor} that generates annotations in bytecode form. * * @author Eric Bruneton * @author Eugene Kuleshov */ final class AnnotationWriter extends AnnotationVisitor { /** * The class writer to which this annotation must be added. */ private final ClassWriter cw; /** * The number of values in this annotation. */ private int size; /** * true if values are named, false otherwise. Annotation * writers used for annotation default and annotation arrays use unnamed * values. */ private final boolean named; /** * The annotation values in bytecode form. This byte vector only contains * the values themselves, i.e. the number of values must be stored as a * unsigned short just before these bytes. */ private final ByteVector bv; /** * The byte vector to be used to store the number of values of this * annotation. See {@link #bv}. */ private final ByteVector parent; /** * Where the number of values of this annotation must be stored in * {@link #parent}. */ private final int offset; /** * Next annotation writer. This field is used to store annotation lists. */ AnnotationWriter next; /** * Previous annotation writer. This field is used to store annotation lists. */ AnnotationWriter prev; // ------------------------------------------------------------------------ // Constructor // ------------------------------------------------------------------------ /** * Constructs a new {@link AnnotationWriter}. * * @param cw * the class writer to which this annotation must be added. * @param named * true if values are named, false otherwise. * @param bv * where the annotation values must be stored. * @param parent * where the number of annotation values must be stored. * @param offset * where in parent the number of annotation values must * be stored. */ AnnotationWriter(final ClassWriter cw, final boolean named, final ByteVector bv, final ByteVector parent, final int offset) { super(Opcodes.ASM4); this.cw = cw; this.named = named; this.bv = bv; this.parent = parent; this.offset = offset; } // ------------------------------------------------------------------------ // Implementation of the AnnotationVisitor abstract class // ------------------------------------------------------------------------ @Override public void visit(final String name, final Object value) { ++size; if (named) { bv.putShort(cw.newUTF8(name)); } if (value instanceof String) { bv.put12('s', cw.newUTF8((String) value)); } else if (value instanceof Byte) { bv.put12('B', cw.newInteger(((Byte) value).byteValue()).index); } else if (value instanceof Boolean) { int v = ((Boolean) value).booleanValue() ? 1 : 0; bv.put12('Z', cw.newInteger(v).index); } else if (value instanceof Character) { bv.put12('C', cw.newInteger(((Character) value).charValue()).index); } else if (value instanceof Short) { bv.put12('S', cw.newInteger(((Short) value).shortValue()).index); } else if (value instanceof Type) { bv.put12('c', cw.newUTF8(((Type) value).getDescriptor())); } else if (value instanceof byte[]) { byte[] v = (byte[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('B', cw.newInteger(v[i]).index); } } else if (value instanceof boolean[]) { boolean[] v = (boolean[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('Z', cw.newInteger(v[i] ? 1 : 0).index); } } else if (value instanceof short[]) { short[] v = (short[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('S', cw.newInteger(v[i]).index); } } else if (value instanceof char[]) { char[] v = (char[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('C', cw.newInteger(v[i]).index); } } else if (value instanceof int[]) { int[] v = (int[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('I', cw.newInteger(v[i]).index); } } else if (value instanceof long[]) { long[] v = (long[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('J', cw.newLong(v[i]).index); } } else if (value instanceof float[]) { float[] v = (float[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('F', cw.newFloat(v[i]).index); } } else if (value instanceof double[]) { double[] v = (double[]) value; bv.put12('[', v.length); for (int i = 0; i < v.length; i++) { bv.put12('D', cw.newDouble(v[i]).index); } } else { Item i = cw.newConstItem(value); bv.put12(".s.IFJDCS".charAt(i.type), i.index); } } @Override public void visitEnum(final String name, final String desc, final String value) { ++size; if (named) { bv.putShort(cw.newUTF8(name)); } bv.put12('e', cw.newUTF8(desc)).putShort(cw.newUTF8(value)); } @Override public AnnotationVisitor visitAnnotation(final String name, final String desc) { ++size; if (named) { bv.putShort(cw.newUTF8(name)); } // write tag and type, and reserve space for values count bv.put12('@', cw.newUTF8(desc)).putShort(0); return new AnnotationWriter(cw, true, bv, bv, bv.length - 2); } @Override public AnnotationVisitor visitArray(final String name) { ++size; if (named) { bv.putShort(cw.newUTF8(name)); } // write tag, and reserve space for array size bv.put12('[', 0); return new AnnotationWriter(cw, false, bv, bv, bv.length - 2); } @Override public void visitEnd() { if (parent != null) { byte[] data = parent.data; data[offset] = (byte) (size >>> 8); data[offset + 1] = (byte) size; } } // ------------------------------------------------------------------------ // Utility methods // ------------------------------------------------------------------------ /** * Returns the size of this annotation writer list. * * @return the size of this annotation writer list. */ int getSize() { int size = 0; AnnotationWriter aw = this; while (aw != null) { size += aw.bv.length; aw = aw.next; } return size; } /** * Puts the annotations of this annotation writer list into the given byte * vector. * * @param out * where the annotations must be put. */ void put(final ByteVector out) { int n = 0; int size = 2; AnnotationWriter aw = this; AnnotationWriter last = null; while (aw != null) { ++n; size += aw.bv.length; aw.visitEnd(); // in case user forgot to call visitEnd aw.prev = last; last = aw; aw = aw.next; } out.putInt(size); out.putShort(n); aw = last; while (aw != null) { out.putByteArray(aw.bv.data, 0, aw.bv.length); aw = aw.prev; } } /** * Puts the given annotation lists into the given byte vector. * * @param panns * an array of annotation writer lists. * @param off * index of the first annotation to be written. * @param out * where the annotations must be put. */ static void put(final AnnotationWriter[] panns, final int off, final ByteVector out) { int size = 1 + 2 * (panns.length - off); for (int i = off; i < panns.length; ++i) { size += panns[i] == null ? 0 : panns[i].getSize(); } out.putInt(size).putByte(panns.length - off); for (int i = off; i < panns.length; ++i) { AnnotationWriter aw = panns[i]; AnnotationWriter last = null; int n = 0; while (aw != null) { ++n; aw.visitEnd(); // in case user forgot to call visitEnd aw.prev = last; last = aw; aw = aw.next; } out.putShort(n); aw = last; while (aw != null) { out.putByteArray(aw.bv.data, 0, aw.bv.length); aw = aw.prev; } } } } ================================================ FILE: src/jvm/clojure/asm/Attribute.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A non standard class, field, method or code attribute. * * @author Eric Bruneton * @author Eugene Kuleshov */ public class Attribute { /** * The type of this attribute. */ public final String type; /** * The raw value of this attribute, used only for unknown attributes. */ byte[] value; /** * The next attribute in this attribute list. May be null. */ Attribute next; /** * Constructs a new empty attribute. * * @param type * the type of the attribute. */ protected Attribute(final String type) { this.type = type; } /** * Returns true if this type of attribute is unknown. The default * implementation of this method always returns true. * * @return true if this type of attribute is unknown. */ public boolean isUnknown() { return true; } /** * Returns true if this type of attribute is a code attribute. * * @return true if this type of attribute is a code attribute. */ public boolean isCodeAttribute() { return false; } /** * Returns the labels corresponding to this attribute. * * @return the labels corresponding to this attribute, or null if * this attribute is not a code attribute that contains labels. */ protected Label[] getLabels() { return null; } /** * Reads a {@link #type type} attribute. This method must return a * new {@link Attribute} object, of type {@link #type type}, * corresponding to the len bytes starting at the given offset, in * the given class reader. * * @param cr * the class that contains the attribute to be read. * @param off * index of the first byte of the attribute's content in * {@link ClassReader#b cr.b}. The 6 attribute header bytes, * containing the type and the length of the attribute, are not * taken into account here. * @param len * the length of the attribute's content. * @param buf * buffer to be used to call {@link ClassReader#readUTF8 * readUTF8}, {@link ClassReader#readClass(int,char[]) readClass} * or {@link ClassReader#readConst readConst}. * @param codeOff * index of the first byte of code's attribute content in * {@link ClassReader#b cr.b}, or -1 if the attribute to be read * is not a code attribute. The 6 attribute header bytes, * containing the type and the length of the attribute, are not * taken into account here. * @param labels * the labels of the method's code, or null if the * attribute to be read is not a code attribute. * @return a new {@link Attribute} object corresponding to the given * bytes. */ protected Attribute read(final ClassReader cr, final int off, final int len, final char[] buf, final int codeOff, final Label[] labels) { Attribute attr = new Attribute(type); attr.value = new byte[len]; System.arraycopy(cr.b, off, attr.value, 0, len); return attr; } /** * Returns the byte array form of this attribute. * * @param cw * the class to which this attribute must be added. This * parameter can be used to add to the constant pool of this * class the items that corresponds to this attribute. * @param code * the bytecode of the method corresponding to this code * attribute, or null if this attribute is not a code * attributes. * @param len * the length of the bytecode of the method corresponding to this * code attribute, or null if this attribute is not a * code attribute. * @param maxStack * the maximum stack size of the method corresponding to this * code attribute, or -1 if this attribute is not a code * attribute. * @param maxLocals * the maximum number of local variables of the method * corresponding to this code attribute, or -1 if this attribute * is not a code attribute. * @return the byte array form of this attribute. */ protected ByteVector write(final ClassWriter cw, final byte[] code, final int len, final int maxStack, final int maxLocals) { ByteVector v = new ByteVector(); v.data = value; v.length = value.length; return v; } /** * Returns the length of the attribute list that begins with this attribute. * * @return the length of the attribute list that begins with this attribute. */ final int getCount() { int count = 0; Attribute attr = this; while (attr != null) { count += 1; attr = attr.next; } return count; } /** * Returns the size of all the attributes in this attribute list. * * @param cw * the class writer to be used to convert the attributes into * byte arrays, with the {@link #write write} method. * @param code * the bytecode of the method corresponding to these code * attributes, or null if these attributes are not code * attributes. * @param len * the length of the bytecode of the method corresponding to * these code attributes, or null if these attributes * are not code attributes. * @param maxStack * the maximum stack size of the method corresponding to these * code attributes, or -1 if these attributes are not code * attributes. * @param maxLocals * the maximum number of local variables of the method * corresponding to these code attributes, or -1 if these * attributes are not code attributes. * @return the size of all the attributes in this attribute list. This size * includes the size of the attribute headers. */ final int getSize(final ClassWriter cw, final byte[] code, final int len, final int maxStack, final int maxLocals) { Attribute attr = this; int size = 0; while (attr != null) { cw.newUTF8(attr.type); size += attr.write(cw, code, len, maxStack, maxLocals).length + 6; attr = attr.next; } return size; } /** * Writes all the attributes of this attribute list in the given byte * vector. * * @param cw * the class writer to be used to convert the attributes into * byte arrays, with the {@link #write write} method. * @param code * the bytecode of the method corresponding to these code * attributes, or null if these attributes are not code * attributes. * @param len * the length of the bytecode of the method corresponding to * these code attributes, or null if these attributes * are not code attributes. * @param maxStack * the maximum stack size of the method corresponding to these * code attributes, or -1 if these attributes are not code * attributes. * @param maxLocals * the maximum number of local variables of the method * corresponding to these code attributes, or -1 if these * attributes are not code attributes. * @param out * where the attributes must be written. */ final void put(final ClassWriter cw, final byte[] code, final int len, final int maxStack, final int maxLocals, final ByteVector out) { Attribute attr = this; while (attr != null) { ByteVector b = attr.write(cw, code, len, maxStack, maxLocals); out.putShort(cw.newUTF8(attr.type)).putInt(b.length); out.putByteArray(b.data, 0, b.length); attr = attr.next; } } } ================================================ FILE: src/jvm/clojure/asm/ByteVector.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A dynamically extensible vector of bytes. This class is roughly equivalent to * a DataOutputStream on top of a ByteArrayOutputStream, but is more efficient. * * @author Eric Bruneton */ public class ByteVector { /** * The content of this vector. */ byte[] data; /** * Actual number of bytes in this vector. */ int length; /** * Constructs a new {@link ByteVector ByteVector} with a default initial * size. */ public ByteVector() { data = new byte[64]; } /** * Constructs a new {@link ByteVector ByteVector} with the given initial * size. * * @param initialSize * the initial size of the byte vector to be constructed. */ public ByteVector(final int initialSize) { data = new byte[initialSize]; } /** * Puts a byte into this byte vector. The byte vector is automatically * enlarged if necessary. * * @param b * a byte. * @return this byte vector. */ public ByteVector putByte(final int b) { int length = this.length; if (length + 1 > data.length) { enlarge(1); } data[length++] = (byte) b; this.length = length; return this; } /** * Puts two bytes into this byte vector. The byte vector is automatically * enlarged if necessary. * * @param b1 * a byte. * @param b2 * another byte. * @return this byte vector. */ ByteVector put11(final int b1, final int b2) { int length = this.length; if (length + 2 > data.length) { enlarge(2); } byte[] data = this.data; data[length++] = (byte) b1; data[length++] = (byte) b2; this.length = length; return this; } /** * Puts a short into this byte vector. The byte vector is automatically * enlarged if necessary. * * @param s * a short. * @return this byte vector. */ public ByteVector putShort(final int s) { int length = this.length; if (length + 2 > data.length) { enlarge(2); } byte[] data = this.data; data[length++] = (byte) (s >>> 8); data[length++] = (byte) s; this.length = length; return this; } /** * Puts a byte and a short into this byte vector. The byte vector is * automatically enlarged if necessary. * * @param b * a byte. * @param s * a short. * @return this byte vector. */ ByteVector put12(final int b, final int s) { int length = this.length; if (length + 3 > data.length) { enlarge(3); } byte[] data = this.data; data[length++] = (byte) b; data[length++] = (byte) (s >>> 8); data[length++] = (byte) s; this.length = length; return this; } /** * Puts an int into this byte vector. The byte vector is automatically * enlarged if necessary. * * @param i * an int. * @return this byte vector. */ public ByteVector putInt(final int i) { int length = this.length; if (length + 4 > data.length) { enlarge(4); } byte[] data = this.data; data[length++] = (byte) (i >>> 24); data[length++] = (byte) (i >>> 16); data[length++] = (byte) (i >>> 8); data[length++] = (byte) i; this.length = length; return this; } /** * Puts a long into this byte vector. The byte vector is automatically * enlarged if necessary. * * @param l * a long. * @return this byte vector. */ public ByteVector putLong(final long l) { int length = this.length; if (length + 8 > data.length) { enlarge(8); } byte[] data = this.data; int i = (int) (l >>> 32); data[length++] = (byte) (i >>> 24); data[length++] = (byte) (i >>> 16); data[length++] = (byte) (i >>> 8); data[length++] = (byte) i; i = (int) l; data[length++] = (byte) (i >>> 24); data[length++] = (byte) (i >>> 16); data[length++] = (byte) (i >>> 8); data[length++] = (byte) i; this.length = length; return this; } /** * Puts an UTF8 string into this byte vector. The byte vector is * automatically enlarged if necessary. * * @param s * a String. * @return this byte vector. */ public ByteVector putUTF8(final String s) { int charLength = s.length(); int len = length; if (len + 2 + charLength > data.length) { enlarge(2 + charLength); } byte[] data = this.data; // optimistic algorithm: instead of computing the byte length and then // serializing the string (which requires two loops), we assume the byte // length is equal to char length (which is the most frequent case), and // we start serializing the string right away. During the serialization, // if we find that this assumption is wrong, we continue with the // general method. data[len++] = (byte) (charLength >>> 8); data[len++] = (byte) charLength; for (int i = 0; i < charLength; ++i) { char c = s.charAt(i); if (c >= '\001' && c <= '\177') { data[len++] = (byte) c; } else { int byteLength = i; for (int j = i; j < charLength; ++j) { c = s.charAt(j); if (c >= '\001' && c <= '\177') { byteLength++; } else if (c > '\u07FF') { byteLength += 3; } else { byteLength += 2; } } data[length] = (byte) (byteLength >>> 8); data[length + 1] = (byte) byteLength; if (length + 2 + byteLength > data.length) { length = len; enlarge(2 + byteLength); data = this.data; } for (int j = i; j < charLength; ++j) { c = s.charAt(j); if (c >= '\001' && c <= '\177') { data[len++] = (byte) c; } else if (c > '\u07FF') { data[len++] = (byte) (0xE0 | c >> 12 & 0xF); data[len++] = (byte) (0x80 | c >> 6 & 0x3F); data[len++] = (byte) (0x80 | c & 0x3F); } else { data[len++] = (byte) (0xC0 | c >> 6 & 0x1F); data[len++] = (byte) (0x80 | c & 0x3F); } } break; } } length = len; return this; } /** * Puts an array of bytes into this byte vector. The byte vector is * automatically enlarged if necessary. * * @param b * an array of bytes. May be null to put len * null bytes into this byte vector. * @param off * index of the fist byte of b that must be copied. * @param len * number of bytes of b that must be copied. * @return this byte vector. */ public ByteVector putByteArray(final byte[] b, final int off, final int len) { if (length + len > data.length) { enlarge(len); } if (b != null) { System.arraycopy(b, off, data, length, len); } length += len; return this; } /** * Enlarge this byte vector so that it can receive n more bytes. * * @param size * number of additional bytes that this byte vector should be * able to receive. */ private void enlarge(final int size) { int length1 = 2 * data.length; int length2 = length + size; byte[] newData = new byte[length1 > length2 ? length1 : length2]; System.arraycopy(data, 0, newData, 0, length); data = newData; } } ================================================ FILE: src/jvm/clojure/asm/ClassReader.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; import java.io.IOException; import java.io.InputStream; /** * A Java class parser to make a {@link ClassVisitor} visit an existing class. * This class parses a byte array conforming to the Java class file format and * calls the appropriate visit methods of a given class visitor for each field, * method and bytecode instruction encountered. * * @author Eric Bruneton * @author Eugene Kuleshov */ public class ClassReader { /** * True to enable signatures support. */ static final boolean SIGNATURES = true; /** * True to enable annotations support. */ static final boolean ANNOTATIONS = true; /** * True to enable stack map frames support. */ static final boolean FRAMES = true; /** * True to enable bytecode writing support. */ static final boolean WRITER = true; /** * True to enable JSR_W and GOTO_W support. */ static final boolean RESIZE = true; /** * Flag to skip method code. If this class is set CODE * attribute won't be visited. This can be used, for example, to retrieve * annotations for methods and method parameters. */ public static final int SKIP_CODE = 1; /** * Flag to skip the debug information in the class. If this flag is set the * debug information of the class is not visited, i.e. the * {@link MethodVisitor#visitLocalVariable visitLocalVariable} and * {@link MethodVisitor#visitLineNumber visitLineNumber} methods will not be * called. */ public static final int SKIP_DEBUG = 2; /** * Flag to skip the stack map frames in the class. If this flag is set the * stack map frames of the class is not visited, i.e. the * {@link MethodVisitor#visitFrame visitFrame} method will not be called. * This flag is useful when the {@link ClassWriter#COMPUTE_FRAMES} option is * used: it avoids visiting frames that will be ignored and recomputed from * scratch in the class writer. */ public static final int SKIP_FRAMES = 4; /** * Flag to expand the stack map frames. By default stack map frames are * visited in their original format (i.e. "expanded" for classes whose * version is less than V1_6, and "compressed" for the other classes). If * this flag is set, stack map frames are always visited in expanded format * (this option adds a decompression/recompression step in ClassReader and * ClassWriter which degrades performances quite a lot). */ public static final int EXPAND_FRAMES = 8; /** * The class to be parsed. The content of this array must not be * modified. This field is intended for {@link Attribute} sub classes, and * is normally not needed by class generators or adapters. */ public final byte[] b; /** * The start index of each constant pool item in {@link #b b}, plus one. The * one byte offset skips the constant pool item tag that indicates its type. */ private final int[] items; /** * The String objects corresponding to the CONSTANT_Utf8 items. This cache * avoids multiple parsing of a given CONSTANT_Utf8 constant pool item, * which GREATLY improves performances (by a factor 2 to 3). This caching * strategy could be extended to all constant pool items, but its benefit * would not be so great for these items (because they are much less * expensive to parse than CONSTANT_Utf8 items). */ private final String[] strings; /** * Maximum length of the strings contained in the constant pool of the * class. */ private final int maxStringLength; /** * Start index of the class header information (access, name...) in * {@link #b b}. */ public final int header; // ------------------------------------------------------------------------ // Constructors // ------------------------------------------------------------------------ /** * Constructs a new {@link ClassReader} object. * * @param b * the bytecode of the class to be read. */ public ClassReader(final byte[] b) { this(b, 0, b.length); } /** * Constructs a new {@link ClassReader} object. * * @param b * the bytecode of the class to be read. * @param off * the start offset of the class data. * @param len * the length of the class data. */ public ClassReader(final byte[] b, final int off, final int len) { this.b = b; // checks the class version if (readShort(off + 6) > Opcodes.V1_7) { throw new IllegalArgumentException(); } // parses the constant pool items = new int[readUnsignedShort(off + 8)]; int n = items.length; strings = new String[n]; int max = 0; int index = off + 10; for (int i = 1; i < n; ++i) { items[i] = index + 1; int size; switch (b[index]) { case ClassWriter.FIELD: case ClassWriter.METH: case ClassWriter.IMETH: case ClassWriter.INT: case ClassWriter.FLOAT: case ClassWriter.NAME_TYPE: case ClassWriter.INDY: size = 5; break; case ClassWriter.LONG: case ClassWriter.DOUBLE: size = 9; ++i; break; case ClassWriter.UTF8: size = 3 + readUnsignedShort(index + 1); if (size > max) { max = size; } break; case ClassWriter.HANDLE: size = 4; break; // case ClassWriter.CLASS: // case ClassWriter.STR: // case ClassWriter.MTYPE default: size = 3; break; } index += size; } maxStringLength = max; // the class header information starts just after the constant pool header = index; } /** * Returns the class's access flags (see {@link Opcodes}). This value may * not reflect Deprecated and Synthetic flags when bytecode is before 1.5 * and those flags are represented by attributes. * * @return the class access flags * * @see ClassVisitor#visit(int, int, String, String, String, String[]) */ public int getAccess() { return readUnsignedShort(header); } /** * Returns the internal name of the class (see * {@link Type#getInternalName() getInternalName}). * * @return the internal class name * * @see ClassVisitor#visit(int, int, String, String, String, String[]) */ public String getClassName() { return readClass(header + 2, new char[maxStringLength]); } /** * Returns the internal of name of the super class (see * {@link Type#getInternalName() getInternalName}). For interfaces, the * super class is {@link Object}. * * @return the internal name of super class, or null for * {@link Object} class. * * @see ClassVisitor#visit(int, int, String, String, String, String[]) */ public String getSuperName() { return readClass(header + 4, new char[maxStringLength]); } /** * Returns the internal names of the class's interfaces (see * {@link Type#getInternalName() getInternalName}). * * @return the array of internal names for all implemented interfaces or * null. * * @see ClassVisitor#visit(int, int, String, String, String, String[]) */ public String[] getInterfaces() { int index = header + 6; int n = readUnsignedShort(index); String[] interfaces = new String[n]; if (n > 0) { char[] buf = new char[maxStringLength]; for (int i = 0; i < n; ++i) { index += 2; interfaces[i] = readClass(index, buf); } } return interfaces; } /** * Copies the constant pool data into the given {@link ClassWriter}. Should * be called before the {@link #accept(ClassVisitor,int)} method. * * @param classWriter * the {@link ClassWriter} to copy constant pool into. */ void copyPool(final ClassWriter classWriter) { char[] buf = new char[maxStringLength]; int ll = items.length; Item[] items2 = new Item[ll]; for (int i = 1; i < ll; i++) { int index = items[i]; int tag = b[index - 1]; Item item = new Item(i); int nameType; switch (tag) { case ClassWriter.FIELD: case ClassWriter.METH: case ClassWriter.IMETH: nameType = items[readUnsignedShort(index + 2)]; item.set(tag, readClass(index, buf), readUTF8(nameType, buf), readUTF8(nameType + 2, buf)); break; case ClassWriter.INT: item.set(readInt(index)); break; case ClassWriter.FLOAT: item.set(Float.intBitsToFloat(readInt(index))); break; case ClassWriter.NAME_TYPE: item.set(tag, readUTF8(index, buf), readUTF8(index + 2, buf), null); break; case ClassWriter.LONG: item.set(readLong(index)); ++i; break; case ClassWriter.DOUBLE: item.set(Double.longBitsToDouble(readLong(index))); ++i; break; case ClassWriter.UTF8: { String s = strings[i]; if (s == null) { index = items[i]; s = strings[i] = readUTF(index + 2, readUnsignedShort(index), buf); } item.set(tag, s, null, null); break; } case ClassWriter.HANDLE: { int fieldOrMethodRef = items[readUnsignedShort(index + 1)]; nameType = items[readUnsignedShort(fieldOrMethodRef + 2)]; item.set(ClassWriter.HANDLE_BASE + readByte(index), readClass(fieldOrMethodRef, buf), readUTF8(nameType, buf), readUTF8(nameType + 2, buf)); break; } case ClassWriter.INDY: if (classWriter.bootstrapMethods == null) { copyBootstrapMethods(classWriter, items2, buf); } nameType = items[readUnsignedShort(index + 2)]; item.set(readUTF8(nameType, buf), readUTF8(nameType + 2, buf), readUnsignedShort(index)); break; // case ClassWriter.STR: // case ClassWriter.CLASS: // case ClassWriter.MTYPE default: item.set(tag, readUTF8(index, buf), null, null); break; } int index2 = item.hashCode % items2.length; item.next = items2[index2]; items2[index2] = item; } int off = items[1] - 1; classWriter.pool.putByteArray(b, off, header - off); classWriter.items = items2; classWriter.threshold = (int) (0.75d * ll); classWriter.index = ll; } /** * Copies the bootstrap method data into the given {@link ClassWriter}. * Should be called before the {@link #accept(ClassVisitor,int)} method. * * @param classWriter * the {@link ClassWriter} to copy bootstrap methods into. */ private void copyBootstrapMethods(final ClassWriter classWriter, final Item[] items, final char[] c) { // finds the "BootstrapMethods" attribute int u = getAttributes(); boolean found = false; for (int i = readUnsignedShort(u); i > 0; --i) { String attrName = readUTF8(u + 2, c); if ("BootstrapMethods".equals(attrName)) { found = true; break; } u += 6 + readInt(u + 4); } if (!found) { return; } // copies the bootstrap methods in the class writer int boostrapMethodCount = readUnsignedShort(u + 8); for (int j = 0, v = u + 10; j < boostrapMethodCount; j++) { int position = v - u - 10; int hashCode = readConst(readUnsignedShort(v), c).hashCode(); for (int k = readUnsignedShort(v + 2); k > 0; --k) { hashCode ^= readConst(readUnsignedShort(v + 4), c).hashCode(); v += 2; } v += 4; Item item = new Item(j); item.set(position, hashCode & 0x7FFFFFFF); int index = item.hashCode % items.length; item.next = items[index]; items[index] = item; } int attrSize = readInt(u + 4); ByteVector bootstrapMethods = new ByteVector(attrSize + 62); bootstrapMethods.putByteArray(b, u + 10, attrSize - 2); classWriter.bootstrapMethodsCount = boostrapMethodCount; classWriter.bootstrapMethods = bootstrapMethods; } /** * Constructs a new {@link ClassReader} object. * * @param is * an input stream from which to read the class. * @throws IOException * if a problem occurs during reading. */ public ClassReader(final InputStream is) throws IOException { this(readClass(is, false)); } /** * Constructs a new {@link ClassReader} object. * * @param name * the binary qualified name of the class to be read. * @throws IOException * if an exception occurs during reading. */ public ClassReader(final String name) throws IOException { this(readClass( ClassLoader.getSystemResourceAsStream(name.replace('.', '/') + ".class"), true)); } /** * Reads the bytecode of a class. * * @param is * an input stream from which to read the class. * @param close * true to close the input stream after reading. * @return the bytecode read from the given input stream. * @throws IOException * if a problem occurs during reading. */ private static byte[] readClass(final InputStream is, boolean close) throws IOException { if (is == null) { throw new IOException("Class not found"); } try { byte[] b = new byte[is.available()]; int len = 0; while (true) { int n = is.read(b, len, b.length - len); if (n == -1) { if (len < b.length) { byte[] c = new byte[len]; System.arraycopy(b, 0, c, 0, len); b = c; } return b; } len += n; if (len == b.length) { int last = is.read(); if (last < 0) { return b; } byte[] c = new byte[b.length + 1000]; System.arraycopy(b, 0, c, 0, len); c[len++] = (byte) last; b = c; } } } finally { if (close) { is.close(); } } } // ------------------------------------------------------------------------ // Public methods // ------------------------------------------------------------------------ /** * Makes the given visitor visit the Java class of this {@link ClassReader} * . This class is the one specified in the constructor (see * {@link #ClassReader(byte[]) ClassReader}). * * @param classVisitor * the visitor that must visit this class. * @param flags * option flags that can be used to modify the default behavior * of this class. See {@link #SKIP_DEBUG}, {@link #EXPAND_FRAMES} * , {@link #SKIP_FRAMES}, {@link #SKIP_CODE}. */ public void accept(final ClassVisitor classVisitor, final int flags) { accept(classVisitor, new Attribute[0], flags); } /** * Makes the given visitor visit the Java class of this {@link ClassReader}. * This class is the one specified in the constructor (see * {@link #ClassReader(byte[]) ClassReader}). * * @param classVisitor * the visitor that must visit this class. * @param attrs * prototypes of the attributes that must be parsed during the * visit of the class. Any attribute whose type is not equal to * the type of one the prototypes will not be parsed: its byte * array value will be passed unchanged to the ClassWriter. * This may corrupt it if this value contains references to * the constant pool, or has syntactic or semantic links with a * class element that has been transformed by a class adapter * between the reader and the writer. * @param flags * option flags that can be used to modify the default behavior * of this class. See {@link #SKIP_DEBUG}, {@link #EXPAND_FRAMES} * , {@link #SKIP_FRAMES}, {@link #SKIP_CODE}. */ public void accept(final ClassVisitor classVisitor, final Attribute[] attrs, final int flags) { int u = header; // current offset in the class file char[] c = new char[maxStringLength]; // buffer used to read strings Context context = new Context(); context.attrs = attrs; context.flags = flags; context.buffer = c; // reads the class declaration int access = readUnsignedShort(u); String name = readClass(u + 2, c); String superClass = readClass(u + 4, c); String[] interfaces = new String[readUnsignedShort(u + 6)]; u += 8; for (int i = 0; i < interfaces.length; ++i) { interfaces[i] = readClass(u, c); u += 2; } // reads the class attributes String signature = null; String sourceFile = null; String sourceDebug = null; String enclosingOwner = null; String enclosingName = null; String enclosingDesc = null; int anns = 0; int ianns = 0; int innerClasses = 0; Attribute attributes = null; u = getAttributes(); for (int i = readUnsignedShort(u); i > 0; --i) { String attrName = readUTF8(u + 2, c); // tests are sorted in decreasing frequency order // (based on frequencies observed on typical classes) if ("SourceFile".equals(attrName)) { sourceFile = readUTF8(u + 8, c); } else if ("InnerClasses".equals(attrName)) { innerClasses = u + 8; } else if ("EnclosingMethod".equals(attrName)) { enclosingOwner = readClass(u + 8, c); int item = readUnsignedShort(u + 10); if (item != 0) { enclosingName = readUTF8(items[item], c); enclosingDesc = readUTF8(items[item] + 2, c); } } else if (SIGNATURES && "Signature".equals(attrName)) { signature = readUTF8(u + 8, c); } else if (ANNOTATIONS && "RuntimeVisibleAnnotations".equals(attrName)) { anns = u + 8; } else if ("Deprecated".equals(attrName)) { access |= Opcodes.ACC_DEPRECATED; } else if ("Synthetic".equals(attrName)) { access |= Opcodes.ACC_SYNTHETIC | ClassWriter.ACC_SYNTHETIC_ATTRIBUTE; } else if ("SourceDebugExtension".equals(attrName)) { int len = readInt(u + 4); sourceDebug = readUTF(u + 8, len, new char[len]); } else if (ANNOTATIONS && "RuntimeInvisibleAnnotations".equals(attrName)) { ianns = u + 8; } else if ("BootstrapMethods".equals(attrName)) { int[] bootstrapMethods = new int[readUnsignedShort(u + 8)]; for (int j = 0, v = u + 10; j < bootstrapMethods.length; j++) { bootstrapMethods[j] = v; v += 2 + readUnsignedShort(v + 2) << 1; } context.bootstrapMethods = bootstrapMethods; } else { Attribute attr = readAttribute(attrs, attrName, u + 8, readInt(u + 4), c, -1, null); if (attr != null) { attr.next = attributes; attributes = attr; } } u += 6 + readInt(u + 4); } // visits the class declaration classVisitor.visit(readInt(items[1] - 7), access, name, signature, superClass, interfaces); // visits the source and debug info if ((flags & SKIP_DEBUG) == 0 && (sourceFile != null || sourceDebug != null)) { classVisitor.visitSource(sourceFile, sourceDebug); } // visits the outer class if (enclosingOwner != null) { classVisitor.visitOuterClass(enclosingOwner, enclosingName, enclosingDesc); } // visits the class annotations if (ANNOTATIONS && anns != 0) { for (int i = readUnsignedShort(anns), v = anns + 2; i > 0; --i) { v = readAnnotationValues(v + 2, c, true, classVisitor.visitAnnotation(readUTF8(v, c), true)); } } if (ANNOTATIONS && ianns != 0) { for (int i = readUnsignedShort(ianns), v = ianns + 2; i > 0; --i) { v = readAnnotationValues(v + 2, c, true, classVisitor.visitAnnotation(readUTF8(v, c), false)); } } // visits the attributes while (attributes != null) { Attribute attr = attributes.next; attributes.next = null; classVisitor.visitAttribute(attributes); attributes = attr; } // visits the inner classes if (innerClasses != 0) { int v = innerClasses + 2; for (int i = readUnsignedShort(innerClasses); i > 0; --i) { classVisitor.visitInnerClass(readClass(v, c), readClass(v + 2, c), readUTF8(v + 4, c), readUnsignedShort(v + 6)); v += 8; } } // visits the fields and methods u = header + 10 + 2 * interfaces.length; for (int i = readUnsignedShort(u - 2); i > 0; --i) { u = readField(classVisitor, context, u); } u += 2; for (int i = readUnsignedShort(u - 2); i > 0; --i) { u = readMethod(classVisitor, context, u); } // visits the end of the class classVisitor.visitEnd(); } /** * Reads a field and makes the given visitor visit it. * * @param classVisitor * the visitor that must visit the field. * @param context * information about the class being parsed. * @param u * the start offset of the field in the class file. * @return the offset of the first byte following the field in the class. */ private int readField(final ClassVisitor classVisitor, final Context context, int u) { // reads the field declaration char[] c = context.buffer; int access = readUnsignedShort(u); String name = readUTF8(u + 2, c); String desc = readUTF8(u + 4, c); u += 6; // reads the field attributes String signature = null; int anns = 0; int ianns = 0; Object value = null; Attribute attributes = null; for (int i = readUnsignedShort(u); i > 0; --i) { String attrName = readUTF8(u + 2, c); // tests are sorted in decreasing frequency order // (based on frequencies observed on typical classes) if ("ConstantValue".equals(attrName)) { int item = readUnsignedShort(u + 8); value = item == 0 ? null : readConst(item, c); } else if (SIGNATURES && "Signature".equals(attrName)) { signature = readUTF8(u + 8, c); } else if ("Deprecated".equals(attrName)) { access |= Opcodes.ACC_DEPRECATED; } else if ("Synthetic".equals(attrName)) { access |= Opcodes.ACC_SYNTHETIC | ClassWriter.ACC_SYNTHETIC_ATTRIBUTE; } else if (ANNOTATIONS && "RuntimeVisibleAnnotations".equals(attrName)) { anns = u + 8; } else if (ANNOTATIONS && "RuntimeInvisibleAnnotations".equals(attrName)) { ianns = u + 8; } else { Attribute attr = readAttribute(context.attrs, attrName, u + 8, readInt(u + 4), c, -1, null); if (attr != null) { attr.next = attributes; attributes = attr; } } u += 6 + readInt(u + 4); } u += 2; // visits the field declaration FieldVisitor fv = classVisitor.visitField(access, name, desc, signature, value); if (fv == null) { return u; } // visits the field annotations if (ANNOTATIONS && anns != 0) { for (int i = readUnsignedShort(anns), v = anns + 2; i > 0; --i) { v = readAnnotationValues(v + 2, c, true, fv.visitAnnotation(readUTF8(v, c), true)); } } if (ANNOTATIONS && ianns != 0) { for (int i = readUnsignedShort(ianns), v = ianns + 2; i > 0; --i) { v = readAnnotationValues(v + 2, c, true, fv.visitAnnotation(readUTF8(v, c), false)); } } // visits the field attributes while (attributes != null) { Attribute attr = attributes.next; attributes.next = null; fv.visitAttribute(attributes); attributes = attr; } // visits the end of the field fv.visitEnd(); return u; } /** * Reads a method and makes the given visitor visit it. * * @param classVisitor * the visitor that must visit the method. * @param context * information about the class being parsed. * @param u * the start offset of the method in the class file. * @return the offset of the first byte following the method in the class. */ private int readMethod(final ClassVisitor classVisitor, final Context context, int u) { // reads the method declaration char[] c = context.buffer; int access = readUnsignedShort(u); String name = readUTF8(u + 2, c); String desc = readUTF8(u + 4, c); u += 6; // reads the method attributes int code = 0; int exception = 0; String[] exceptions = null; String signature = null; int anns = 0; int ianns = 0; int dann = 0; int mpanns = 0; int impanns = 0; int firstAttribute = u; Attribute attributes = null; for (int i = readUnsignedShort(u); i > 0; --i) { String attrName = readUTF8(u + 2, c); // tests are sorted in decreasing frequency order // (based on frequencies observed on typical classes) if ("Code".equals(attrName)) { if ((context.flags & SKIP_CODE) == 0) { code = u + 8; } } else if ("Exceptions".equals(attrName)) { exceptions = new String[readUnsignedShort(u + 8)]; exception = u + 10; for (int j = 0; j < exceptions.length; ++j) { exceptions[j] = readClass(exception, c); exception += 2; } } else if (SIGNATURES && "Signature".equals(attrName)) { signature = readUTF8(u + 8, c); } else if ("Deprecated".equals(attrName)) { access |= Opcodes.ACC_DEPRECATED; } else if (ANNOTATIONS && "RuntimeVisibleAnnotations".equals(attrName)) { anns = u + 8; } else if (ANNOTATIONS && "AnnotationDefault".equals(attrName)) { dann = u + 8; } else if ("Synthetic".equals(attrName)) { access |= Opcodes.ACC_SYNTHETIC | ClassWriter.ACC_SYNTHETIC_ATTRIBUTE; } else if (ANNOTATIONS && "RuntimeInvisibleAnnotations".equals(attrName)) { ianns = u + 8; } else if (ANNOTATIONS && "RuntimeVisibleParameterAnnotations".equals(attrName)) { mpanns = u + 8; } else if (ANNOTATIONS && "RuntimeInvisibleParameterAnnotations".equals(attrName)) { impanns = u + 8; } else { Attribute attr = readAttribute(context.attrs, attrName, u + 8, readInt(u + 4), c, -1, null); if (attr != null) { attr.next = attributes; attributes = attr; } } u += 6 + readInt(u + 4); } u += 2; // visits the method declaration MethodVisitor mv = classVisitor.visitMethod(access, name, desc, signature, exceptions); if (mv == null) { return u; } /* * if the returned MethodVisitor is in fact a MethodWriter, it means * there is no method adapter between the reader and the writer. If, in * addition, the writer's constant pool was copied from this reader * (mw.cw.cr == this), and the signature and exceptions of the method * have not been changed, then it is possible to skip all visit events * and just copy the original code of the method to the writer (the * access, name and descriptor can have been changed, this is not * important since they are not copied as is from the reader). */ if (WRITER && mv instanceof MethodWriter) { MethodWriter mw = (MethodWriter) mv; if (mw.cw.cr == this && signature == mw.signature) { boolean sameExceptions = false; if (exceptions == null) { sameExceptions = mw.exceptionCount == 0; } else if (exceptions.length == mw.exceptionCount) { sameExceptions = true; for (int j = exceptions.length - 1; j >= 0; --j) { exception -= 2; if (mw.exceptions[j] != readUnsignedShort(exception)) { sameExceptions = false; break; } } } if (sameExceptions) { /* * we do not copy directly the code into MethodWriter to * save a byte array copy operation. The real copy will be * done in ClassWriter.toByteArray(). */ mw.classReaderOffset = firstAttribute; mw.classReaderLength = u - firstAttribute; return u; } } } // visits the method annotations if (ANNOTATIONS && dann != 0) { AnnotationVisitor dv = mv.visitAnnotationDefault(); readAnnotationValue(dann, c, null, dv); if (dv != null) { dv.visitEnd(); } } if (ANNOTATIONS && anns != 0) { for (int i = readUnsignedShort(anns), v = anns + 2; i > 0; --i) { v = readAnnotationValues(v + 2, c, true, mv.visitAnnotation(readUTF8(v, c), true)); } } if (ANNOTATIONS && ianns != 0) { for (int i = readUnsignedShort(ianns), v = ianns + 2; i > 0; --i) { v = readAnnotationValues(v + 2, c, true, mv.visitAnnotation(readUTF8(v, c), false)); } } if (ANNOTATIONS && mpanns != 0) { readParameterAnnotations(mpanns, desc, c, true, mv); } if (ANNOTATIONS && impanns != 0) { readParameterAnnotations(impanns, desc, c, false, mv); } // visits the method attributes while (attributes != null) { Attribute attr = attributes.next; attributes.next = null; mv.visitAttribute(attributes); attributes = attr; } // visits the method code if (code != 0) { context.access = access; context.name = name; context.desc = desc; mv.visitCode(); readCode(mv, context, code); } // visits the end of the method mv.visitEnd(); return u; } /** * Reads the bytecode of a method and makes the given visitor visit it. * * @param mv * the visitor that must visit the method's code. * @param context * information about the class being parsed. * @param u * the start offset of the code attribute in the class file. */ private void readCode(final MethodVisitor mv, final Context context, int u) { // reads the header byte[] b = this.b; char[] c = context.buffer; int maxStack = readUnsignedShort(u); int maxLocals = readUnsignedShort(u + 2); int codeLength = readInt(u + 4); u += 8; // reads the bytecode to find the labels int codeStart = u; int codeEnd = u + codeLength; Label[] labels = new Label[codeLength + 2]; readLabel(codeLength + 1, labels); while (u < codeEnd) { int offset = u - codeStart; int opcode = b[u] & 0xFF; switch (ClassWriter.TYPE[opcode]) { case ClassWriter.NOARG_INSN: case ClassWriter.IMPLVAR_INSN: u += 1; break; case ClassWriter.LABEL_INSN: readLabel(offset + readShort(u + 1), labels); u += 3; break; case ClassWriter.LABELW_INSN: readLabel(offset + readInt(u + 1), labels); u += 5; break; case ClassWriter.WIDE_INSN: opcode = b[u + 1] & 0xFF; if (opcode == Opcodes.IINC) { u += 6; } else { u += 4; } break; case ClassWriter.TABL_INSN: // skips 0 to 3 padding bytes u = u + 4 - (offset & 3); // reads instruction readLabel(offset + readInt(u), labels); for (int i = readInt(u + 8) - readInt(u + 4) + 1; i > 0; --i) { readLabel(offset + readInt(u + 12), labels); u += 4; } u += 12; break; case ClassWriter.LOOK_INSN: // skips 0 to 3 padding bytes u = u + 4 - (offset & 3); // reads instruction readLabel(offset + readInt(u), labels); for (int i = readInt(u + 4); i > 0; --i) { readLabel(offset + readInt(u + 12), labels); u += 8; } u += 8; break; case ClassWriter.VAR_INSN: case ClassWriter.SBYTE_INSN: case ClassWriter.LDC_INSN: u += 2; break; case ClassWriter.SHORT_INSN: case ClassWriter.LDCW_INSN: case ClassWriter.FIELDORMETH_INSN: case ClassWriter.TYPE_INSN: case ClassWriter.IINC_INSN: u += 3; break; case ClassWriter.ITFMETH_INSN: case ClassWriter.INDYMETH_INSN: u += 5; break; // case MANA_INSN: default: u += 4; break; } } // reads the try catch entries to find the labels, and also visits them for (int i = readUnsignedShort(u); i > 0; --i) { Label start = readLabel(readUnsignedShort(u + 2), labels); Label end = readLabel(readUnsignedShort(u + 4), labels); Label handler = readLabel(readUnsignedShort(u + 6), labels); String type = readUTF8(items[readUnsignedShort(u + 8)], c); mv.visitTryCatchBlock(start, end, handler, type); u += 8; } u += 2; // reads the code attributes int varTable = 0; int varTypeTable = 0; boolean zip = true; boolean unzip = (context.flags & EXPAND_FRAMES) != 0; int stackMap = 0; int stackMapSize = 0; int frameCount = 0; Context frame = null; Attribute attributes = null; for (int i = readUnsignedShort(u); i > 0; --i) { String attrName = readUTF8(u + 2, c); if ("LocalVariableTable".equals(attrName)) { if ((context.flags & SKIP_DEBUG) == 0) { varTable = u + 8; for (int j = readUnsignedShort(u + 8), v = u; j > 0; --j) { int label = readUnsignedShort(v + 10); if (labels[label] == null) { readLabel(label, labels).status |= Label.DEBUG; } label += readUnsignedShort(v + 12); if (labels[label] == null) { readLabel(label, labels).status |= Label.DEBUG; } v += 10; } } } else if ("LocalVariableTypeTable".equals(attrName)) { varTypeTable = u + 8; } else if ("LineNumberTable".equals(attrName)) { if ((context.flags & SKIP_DEBUG) == 0) { for (int j = readUnsignedShort(u + 8), v = u; j > 0; --j) { int label = readUnsignedShort(v + 10); if (labels[label] == null) { readLabel(label, labels).status |= Label.DEBUG; } labels[label].line = readUnsignedShort(v + 12); v += 4; } } } else if (FRAMES && "StackMapTable".equals(attrName)) { if ((context.flags & SKIP_FRAMES) == 0) { stackMap = u + 10; stackMapSize = readInt(u + 4); frameCount = readUnsignedShort(u + 8); } /* * here we do not extract the labels corresponding to the * attribute content. This would require a full parsing of the * attribute, which would need to be repeated in the second * phase (see below). Instead the content of the attribute is * read one frame at a time (i.e. after a frame has been * visited, the next frame is read), and the labels it contains * are also extracted one frame at a time. Thanks to the * ordering of frames, having only a "one frame lookahead" is * not a problem, i.e. it is not possible to see an offset * smaller than the offset of the current insn and for which no * Label exist. */ /* * This is not true for UNINITIALIZED type offsets. We solve * this by parsing the stack map table without a full decoding * (see below). */ } else if (FRAMES && "StackMap".equals(attrName)) { if ((context.flags & SKIP_FRAMES) == 0) { zip = false; stackMap = u + 10; stackMapSize = readInt(u + 4); frameCount = readUnsignedShort(u + 8); } /* * IMPORTANT! here we assume that the frames are ordered, as in * the StackMapTable attribute, although this is not guaranteed * by the attribute format. */ } else { for (int j = 0; j < context.attrs.length; ++j) { if (context.attrs[j].type.equals(attrName)) { Attribute attr = context.attrs[j].read(this, u + 8, readInt(u + 4), c, codeStart - 8, labels); if (attr != null) { attr.next = attributes; attributes = attr; } } } } u += 6 + readInt(u + 4); } u += 2; // generates the first (implicit) stack map frame if (FRAMES && stackMap != 0) { /* * for the first explicit frame the offset is not offset_delta + 1 * but only offset_delta; setting the implicit frame offset to -1 * allow the use of the "offset_delta + 1" rule in all cases */ frame = context; frame.offset = -1; frame.mode = 0; frame.localCount = 0; frame.localDiff = 0; frame.stackCount = 0; frame.local = new Object[maxLocals]; frame.stack = new Object[maxStack]; if (unzip) { getImplicitFrame(context); } /* * Finds labels for UNINITIALIZED frame types. Instead of decoding * each element of the stack map table, we look for 3 consecutive * bytes that "look like" an UNINITIALIZED type (tag 8, offset * within code bounds, NEW instruction at this offset). We may find * false positives (i.e. not real UNINITIALIZED types), but this * should be rare, and the only consequence will be the creation of * an unneeded label. This is better than creating a label for each * NEW instruction, and faster than fully decoding the whole stack * map table. */ for (int i = stackMap; i < stackMap + stackMapSize - 2; ++i) { if (b[i] == 8) { // UNINITIALIZED FRAME TYPE int v = readUnsignedShort(i + 1); if (v >= 0 && v < codeLength) { if ((b[codeStart + v] & 0xFF) == Opcodes.NEW) { readLabel(v, labels); } } } } } // visits the instructions u = codeStart; while (u < codeEnd) { int offset = u - codeStart; // visits the label and line number for this offset, if any Label l = labels[offset]; if (l != null) { mv.visitLabel(l); if ((context.flags & SKIP_DEBUG) == 0 && l.line > 0) { mv.visitLineNumber(l.line, l); } } // visits the frame for this offset, if any while (FRAMES && frame != null && (frame.offset == offset || frame.offset == -1)) { // if there is a frame for this offset, makes the visitor visit // it, and reads the next frame if there is one. if (frame.offset != -1) { if (!zip || unzip) { mv.visitFrame(Opcodes.F_NEW, frame.localCount, frame.local, frame.stackCount, frame.stack); } else { mv.visitFrame(frame.mode, frame.localDiff, frame.local, frame.stackCount, frame.stack); } } if (frameCount > 0) { stackMap = readFrame(stackMap, zip, unzip, labels, frame); --frameCount; } else { frame = null; } } // visits the instruction at this offset int opcode = b[u] & 0xFF; switch (ClassWriter.TYPE[opcode]) { case ClassWriter.NOARG_INSN: mv.visitInsn(opcode); u += 1; break; case ClassWriter.IMPLVAR_INSN: if (opcode > Opcodes.ISTORE) { opcode -= 59; // ISTORE_0 mv.visitVarInsn(Opcodes.ISTORE + (opcode >> 2), opcode & 0x3); } else { opcode -= 26; // ILOAD_0 mv.visitVarInsn(Opcodes.ILOAD + (opcode >> 2), opcode & 0x3); } u += 1; break; case ClassWriter.LABEL_INSN: mv.visitJumpInsn(opcode, labels[offset + readShort(u + 1)]); u += 3; break; case ClassWriter.LABELW_INSN: mv.visitJumpInsn(opcode - 33, labels[offset + readInt(u + 1)]); u += 5; break; case ClassWriter.WIDE_INSN: opcode = b[u + 1] & 0xFF; if (opcode == Opcodes.IINC) { mv.visitIincInsn(readUnsignedShort(u + 2), readShort(u + 4)); u += 6; } else { mv.visitVarInsn(opcode, readUnsignedShort(u + 2)); u += 4; } break; case ClassWriter.TABL_INSN: { // skips 0 to 3 padding bytes u = u + 4 - (offset & 3); // reads instruction int label = offset + readInt(u); int min = readInt(u + 4); int max = readInt(u + 8); Label[] table = new Label[max - min + 1]; u += 12; for (int i = 0; i < table.length; ++i) { table[i] = labels[offset + readInt(u)]; u += 4; } mv.visitTableSwitchInsn(min, max, labels[label], table); break; } case ClassWriter.LOOK_INSN: { // skips 0 to 3 padding bytes u = u + 4 - (offset & 3); // reads instruction int label = offset + readInt(u); int len = readInt(u + 4); int[] keys = new int[len]; Label[] values = new Label[len]; u += 8; for (int i = 0; i < len; ++i) { keys[i] = readInt(u); values[i] = labels[offset + readInt(u + 4)]; u += 8; } mv.visitLookupSwitchInsn(labels[label], keys, values); break; } case ClassWriter.VAR_INSN: mv.visitVarInsn(opcode, b[u + 1] & 0xFF); u += 2; break; case ClassWriter.SBYTE_INSN: mv.visitIntInsn(opcode, b[u + 1]); u += 2; break; case ClassWriter.SHORT_INSN: mv.visitIntInsn(opcode, readShort(u + 1)); u += 3; break; case ClassWriter.LDC_INSN: mv.visitLdcInsn(readConst(b[u + 1] & 0xFF, c)); u += 2; break; case ClassWriter.LDCW_INSN: mv.visitLdcInsn(readConst(readUnsignedShort(u + 1), c)); u += 3; break; case ClassWriter.FIELDORMETH_INSN: case ClassWriter.ITFMETH_INSN: { int cpIndex = items[readUnsignedShort(u + 1)]; String iowner = readClass(cpIndex, c); cpIndex = items[readUnsignedShort(cpIndex + 2)]; String iname = readUTF8(cpIndex, c); String idesc = readUTF8(cpIndex + 2, c); if (opcode < Opcodes.INVOKEVIRTUAL) { mv.visitFieldInsn(opcode, iowner, iname, idesc); } else { mv.visitMethodInsn(opcode, iowner, iname, idesc); } if (opcode == Opcodes.INVOKEINTERFACE) { u += 5; } else { u += 3; } break; } case ClassWriter.INDYMETH_INSN: { int cpIndex = items[readUnsignedShort(u + 1)]; int bsmIndex = context.bootstrapMethods[readUnsignedShort(cpIndex)]; Handle bsm = (Handle) readConst(readUnsignedShort(bsmIndex), c); int bsmArgCount = readUnsignedShort(bsmIndex + 2); Object[] bsmArgs = new Object[bsmArgCount]; bsmIndex += 4; for (int i = 0; i < bsmArgCount; i++) { bsmArgs[i] = readConst(readUnsignedShort(bsmIndex), c); bsmIndex += 2; } cpIndex = items[readUnsignedShort(cpIndex + 2)]; String iname = readUTF8(cpIndex, c); String idesc = readUTF8(cpIndex + 2, c); mv.visitInvokeDynamicInsn(iname, idesc, bsm, bsmArgs); u += 5; break; } case ClassWriter.TYPE_INSN: mv.visitTypeInsn(opcode, readClass(u + 1, c)); u += 3; break; case ClassWriter.IINC_INSN: mv.visitIincInsn(b[u + 1] & 0xFF, b[u + 2]); u += 3; break; // case MANA_INSN: default: mv.visitMultiANewArrayInsn(readClass(u + 1, c), b[u + 3] & 0xFF); u += 4; break; } } if (labels[codeLength] != null) { mv.visitLabel(labels[codeLength]); } // visits the local variable tables if ((context.flags & SKIP_DEBUG) == 0 && varTable != 0) { int[] typeTable = null; if (varTypeTable != 0) { u = varTypeTable + 2; typeTable = new int[readUnsignedShort(varTypeTable) * 3]; for (int i = typeTable.length; i > 0;) { typeTable[--i] = u + 6; // signature typeTable[--i] = readUnsignedShort(u + 8); // index typeTable[--i] = readUnsignedShort(u); // start u += 10; } } u = varTable + 2; for (int i = readUnsignedShort(varTable); i > 0; --i) { int start = readUnsignedShort(u); int length = readUnsignedShort(u + 2); int index = readUnsignedShort(u + 8); String vsignature = null; if (typeTable != null) { for (int j = 0; j < typeTable.length; j += 3) { if (typeTable[j] == start && typeTable[j + 1] == index) { vsignature = readUTF8(typeTable[j + 2], c); break; } } } mv.visitLocalVariable(readUTF8(u + 4, c), readUTF8(u + 6, c), vsignature, labels[start], labels[start + length], index); u += 10; } } // visits the code attributes while (attributes != null) { Attribute attr = attributes.next; attributes.next = null; mv.visitAttribute(attributes); attributes = attr; } // visits the max stack and max locals values mv.visitMaxs(maxStack, maxLocals); } /** * Reads parameter annotations and makes the given visitor visit them. * * @param v * start offset in {@link #b b} of the annotations to be read. * @param desc * the method descriptor. * @param buf * buffer to be used to call {@link #readUTF8 readUTF8}, * {@link #readClass(int,char[]) readClass} or {@link #readConst * readConst}. * @param visible * true if the annotations to be read are visible at * runtime. * @param mv * the visitor that must visit the annotations. */ private void readParameterAnnotations(int v, final String desc, final char[] buf, final boolean visible, final MethodVisitor mv) { int i; int n = b[v++] & 0xFF; // workaround for a bug in javac (javac compiler generates a parameter // annotation array whose size is equal to the number of parameters in // the Java source file, while it should generate an array whose size is // equal to the number of parameters in the method descriptor - which // includes the synthetic parameters added by the compiler). This work- // around supposes that the synthetic parameters are the first ones. int synthetics = Type.getArgumentTypes(desc).length - n; AnnotationVisitor av; for (i = 0; i < synthetics; ++i) { // virtual annotation to detect synthetic parameters in MethodWriter av = mv.visitParameterAnnotation(i, "Ljava/lang/Synthetic;", false); if (av != null) { av.visitEnd(); } } for (; i < n + synthetics; ++i) { int j = readUnsignedShort(v); v += 2; for (; j > 0; --j) { av = mv.visitParameterAnnotation(i, readUTF8(v, buf), visible); v = readAnnotationValues(v + 2, buf, true, av); } } } /** * Reads the values of an annotation and makes the given visitor visit them. * * @param v * the start offset in {@link #b b} of the values to be read * (including the unsigned short that gives the number of * values). * @param buf * buffer to be used to call {@link #readUTF8 readUTF8}, * {@link #readClass(int,char[]) readClass} or {@link #readConst * readConst}. * @param named * if the annotation values are named or not. * @param av * the visitor that must visit the values. * @return the end offset of the annotation values. */ private int readAnnotationValues(int v, final char[] buf, final boolean named, final AnnotationVisitor av) { int i = readUnsignedShort(v); v += 2; if (named) { for (; i > 0; --i) { v = readAnnotationValue(v + 2, buf, readUTF8(v, buf), av); } } else { for (; i > 0; --i) { v = readAnnotationValue(v, buf, null, av); } } if (av != null) { av.visitEnd(); } return v; } /** * Reads a value of an annotation and makes the given visitor visit it. * * @param v * the start offset in {@link #b b} of the value to be read * (not including the value name constant pool index). * @param buf * buffer to be used to call {@link #readUTF8 readUTF8}, * {@link #readClass(int,char[]) readClass} or {@link #readConst * readConst}. * @param name * the name of the value to be read. * @param av * the visitor that must visit the value. * @return the end offset of the annotation value. */ private int readAnnotationValue(int v, final char[] buf, final String name, final AnnotationVisitor av) { int i; if (av == null) { switch (b[v] & 0xFF) { case 'e': // enum_const_value return v + 5; case '@': // annotation_value return readAnnotationValues(v + 3, buf, true, null); case '[': // array_value return readAnnotationValues(v + 1, buf, false, null); default: return v + 3; } } switch (b[v++] & 0xFF) { case 'I': // pointer to CONSTANT_Integer case 'J': // pointer to CONSTANT_Long case 'F': // pointer to CONSTANT_Float case 'D': // pointer to CONSTANT_Double av.visit(name, readConst(readUnsignedShort(v), buf)); v += 2; break; case 'B': // pointer to CONSTANT_Byte av.visit(name, new Byte((byte) readInt(items[readUnsignedShort(v)]))); v += 2; break; case 'Z': // pointer to CONSTANT_Boolean av.visit(name, readInt(items[readUnsignedShort(v)]) == 0 ? Boolean.FALSE : Boolean.TRUE); v += 2; break; case 'S': // pointer to CONSTANT_Short av.visit(name, new Short( (short) readInt(items[readUnsignedShort(v)]))); v += 2; break; case 'C': // pointer to CONSTANT_Char av.visit(name, new Character( (char) readInt(items[readUnsignedShort(v)]))); v += 2; break; case 's': // pointer to CONSTANT_Utf8 av.visit(name, readUTF8(v, buf)); v += 2; break; case 'e': // enum_const_value av.visitEnum(name, readUTF8(v, buf), readUTF8(v + 2, buf)); v += 4; break; case 'c': // class_info av.visit(name, Type.getType(readUTF8(v, buf))); v += 2; break; case '@': // annotation_value v = readAnnotationValues(v + 2, buf, true, av.visitAnnotation(name, readUTF8(v, buf))); break; case '[': // array_value int size = readUnsignedShort(v); v += 2; if (size == 0) { return readAnnotationValues(v - 2, buf, false, av.visitArray(name)); } switch (this.b[v++] & 0xFF) { case 'B': byte[] bv = new byte[size]; for (i = 0; i < size; i++) { bv[i] = (byte) readInt(items[readUnsignedShort(v)]); v += 3; } av.visit(name, bv); --v; break; case 'Z': boolean[] zv = new boolean[size]; for (i = 0; i < size; i++) { zv[i] = readInt(items[readUnsignedShort(v)]) != 0; v += 3; } av.visit(name, zv); --v; break; case 'S': short[] sv = new short[size]; for (i = 0; i < size; i++) { sv[i] = (short) readInt(items[readUnsignedShort(v)]); v += 3; } av.visit(name, sv); --v; break; case 'C': char[] cv = new char[size]; for (i = 0; i < size; i++) { cv[i] = (char) readInt(items[readUnsignedShort(v)]); v += 3; } av.visit(name, cv); --v; break; case 'I': int[] iv = new int[size]; for (i = 0; i < size; i++) { iv[i] = readInt(items[readUnsignedShort(v)]); v += 3; } av.visit(name, iv); --v; break; case 'J': long[] lv = new long[size]; for (i = 0; i < size; i++) { lv[i] = readLong(items[readUnsignedShort(v)]); v += 3; } av.visit(name, lv); --v; break; case 'F': float[] fv = new float[size]; for (i = 0; i < size; i++) { fv[i] = Float .intBitsToFloat(readInt(items[readUnsignedShort(v)])); v += 3; } av.visit(name, fv); --v; break; case 'D': double[] dv = new double[size]; for (i = 0; i < size; i++) { dv[i] = Double .longBitsToDouble(readLong(items[readUnsignedShort(v)])); v += 3; } av.visit(name, dv); --v; break; default: v = readAnnotationValues(v - 3, buf, false, av.visitArray(name)); } } return v; } /** * Computes the implicit frame of the method currently being parsed (as * defined in the given {@link Context}) and stores it in the given context. * * @param frame * information about the class being parsed. */ private void getImplicitFrame(final Context frame) { String desc = frame.desc; Object[] locals = frame.local; int local = 0; if ((frame.access & Opcodes.ACC_STATIC) == 0) { if ("".equals(frame.name)) { locals[local++] = Opcodes.UNINITIALIZED_THIS; } else { locals[local++] = readClass(header + 2, frame.buffer); } } int i = 1; loop: while (true) { int j = i; switch (desc.charAt(i++)) { case 'Z': case 'C': case 'B': case 'S': case 'I': locals[local++] = Opcodes.INTEGER; break; case 'F': locals[local++] = Opcodes.FLOAT; break; case 'J': locals[local++] = Opcodes.LONG; break; case 'D': locals[local++] = Opcodes.DOUBLE; break; case '[': while (desc.charAt(i) == '[') { ++i; } if (desc.charAt(i) == 'L') { ++i; while (desc.charAt(i) != ';') { ++i; } } locals[local++] = desc.substring(j, ++i); break; case 'L': while (desc.charAt(i) != ';') { ++i; } locals[local++] = desc.substring(j + 1, i++); break; default: break loop; } } frame.localCount = local; } /** * Reads a stack map frame and stores the result in the given * {@link Context} object. * * @param stackMap * the start offset of a stack map frame in the class file. * @param zip * if the stack map frame at stackMap is compressed or not. * @param unzip * if the stack map frame must be uncompressed. * @param labels * the labels of the method currently being parsed, indexed by * their offset. A new label for the parsed stack map frame is * stored in this array if it does not already exist. * @param frame * where the parsed stack map frame must be stored. * @return the offset of the first byte following the parsed frame. */ private int readFrame(int stackMap, boolean zip, boolean unzip, Label[] labels, Context frame) { char[] c = frame.buffer; int tag; int delta; if (zip) { tag = b[stackMap++] & 0xFF; } else { tag = MethodWriter.FULL_FRAME; frame.offset = -1; } frame.localDiff = 0; if (tag < MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME) { delta = tag; frame.mode = Opcodes.F_SAME; frame.stackCount = 0; } else if (tag < MethodWriter.RESERVED) { delta = tag - MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME; stackMap = readFrameType(frame.stack, 0, stackMap, c, labels); frame.mode = Opcodes.F_SAME1; frame.stackCount = 1; } else { delta = readUnsignedShort(stackMap); stackMap += 2; if (tag == MethodWriter.SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED) { stackMap = readFrameType(frame.stack, 0, stackMap, c, labels); frame.mode = Opcodes.F_SAME1; frame.stackCount = 1; } else if (tag >= MethodWriter.CHOP_FRAME && tag < MethodWriter.SAME_FRAME_EXTENDED) { frame.mode = Opcodes.F_CHOP; frame.localDiff = MethodWriter.SAME_FRAME_EXTENDED - tag; frame.localCount -= frame.localDiff; frame.stackCount = 0; } else if (tag == MethodWriter.SAME_FRAME_EXTENDED) { frame.mode = Opcodes.F_SAME; frame.stackCount = 0; } else if (tag < MethodWriter.FULL_FRAME) { int local = unzip ? frame.localCount : 0; for (int i = tag - MethodWriter.SAME_FRAME_EXTENDED; i > 0; i--) { stackMap = readFrameType(frame.local, local++, stackMap, c, labels); } frame.mode = Opcodes.F_APPEND; frame.localDiff = tag - MethodWriter.SAME_FRAME_EXTENDED; frame.localCount += frame.localDiff; frame.stackCount = 0; } else { // if (tag == FULL_FRAME) { frame.mode = Opcodes.F_FULL; int n = readUnsignedShort(stackMap); stackMap += 2; frame.localDiff = n; frame.localCount = n; for (int local = 0; n > 0; n--) { stackMap = readFrameType(frame.local, local++, stackMap, c, labels); } n = readUnsignedShort(stackMap); stackMap += 2; frame.stackCount = n; for (int stack = 0; n > 0; n--) { stackMap = readFrameType(frame.stack, stack++, stackMap, c, labels); } } } frame.offset += delta + 1; readLabel(frame.offset, labels); return stackMap; } /** * Reads a stack map frame type and stores it at the given index in the * given array. * * @param frame * the array where the parsed type must be stored. * @param index * the index in 'frame' where the parsed type must be stored. * @param v * the start offset of the stack map frame type to read. * @param buf * a buffer to read strings. * @param labels * the labels of the method currently being parsed, indexed by * their offset. If the parsed type is an Uninitialized type, a * new label for the corresponding NEW instruction is stored in * this array if it does not already exist. * @return the offset of the first byte after the parsed type. */ private int readFrameType(final Object[] frame, final int index, int v, final char[] buf, final Label[] labels) { int type = b[v++] & 0xFF; switch (type) { case 0: frame[index] = Opcodes.TOP; break; case 1: frame[index] = Opcodes.INTEGER; break; case 2: frame[index] = Opcodes.FLOAT; break; case 3: frame[index] = Opcodes.DOUBLE; break; case 4: frame[index] = Opcodes.LONG; break; case 5: frame[index] = Opcodes.NULL; break; case 6: frame[index] = Opcodes.UNINITIALIZED_THIS; break; case 7: // Object frame[index] = readClass(v, buf); v += 2; break; default: // Uninitialized frame[index] = readLabel(readUnsignedShort(v), labels); v += 2; } return v; } /** * Returns the label corresponding to the given offset. The default * implementation of this method creates a label for the given offset if it * has not been already created. * * @param offset * a bytecode offset in a method. * @param labels * the already created labels, indexed by their offset. If a * label already exists for offset this method must not create a * new one. Otherwise it must store the new label in this array. * @return a non null Label, which must be equal to labels[offset]. */ protected Label readLabel(int offset, Label[] labels) { if (labels[offset] == null) { labels[offset] = new Label(); } return labels[offset]; } /** * Returns the start index of the attribute_info structure of this class. * * @return the start index of the attribute_info structure of this class. */ private int getAttributes() { // skips the header int u = header + 8 + readUnsignedShort(header + 6) * 2; // skips fields and methods for (int i = readUnsignedShort(u); i > 0; --i) { for (int j = readUnsignedShort(u + 8); j > 0; --j) { u += 6 + readInt(u + 12); } u += 8; } u += 2; for (int i = readUnsignedShort(u); i > 0; --i) { for (int j = readUnsignedShort(u + 8); j > 0; --j) { u += 6 + readInt(u + 12); } u += 8; } // the attribute_info structure starts just after the methods return u + 2; } /** * Reads an attribute in {@link #b b}. * * @param attrs * prototypes of the attributes that must be parsed during the * visit of the class. Any attribute whose type is not equal to * the type of one the prototypes is ignored (i.e. an empty * {@link Attribute} instance is returned). * @param type * the type of the attribute. * @param off * index of the first byte of the attribute's content in * {@link #b b}. The 6 attribute header bytes, containing the * type and the length of the attribute, are not taken into * account here (they have already been read). * @param len * the length of the attribute's content. * @param buf * buffer to be used to call {@link #readUTF8 readUTF8}, * {@link #readClass(int,char[]) readClass} or {@link #readConst * readConst}. * @param codeOff * index of the first byte of code's attribute content in * {@link #b b}, or -1 if the attribute to be read is not a code * attribute. The 6 attribute header bytes, containing the type * and the length of the attribute, are not taken into account * here. * @param labels * the labels of the method's code, or null if the * attribute to be read is not a code attribute. * @return the attribute that has been read, or null to skip this * attribute. */ private Attribute readAttribute(final Attribute[] attrs, final String type, final int off, final int len, final char[] buf, final int codeOff, final Label[] labels) { for (int i = 0; i < attrs.length; ++i) { if (attrs[i].type.equals(type)) { return attrs[i].read(this, off, len, buf, codeOff, labels); } } return new Attribute(type).read(this, off, len, null, -1, null); } // ------------------------------------------------------------------------ // Utility methods: low level parsing // ------------------------------------------------------------------------ /** * Returns the number of constant pool items in {@link #b b}. * * @return the number of constant pool items in {@link #b b}. */ public int getItemCount() { return items.length; } /** * Returns the start index of the constant pool item in {@link #b b}, plus * one. This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param item * the index a constant pool item. * @return the start index of the constant pool item in {@link #b b}, plus * one. */ public int getItem(final int item) { return items[item]; } /** * Returns the maximum length of the strings contained in the constant pool * of the class. * * @return the maximum length of the strings contained in the constant pool * of the class. */ public int getMaxStringLength() { return maxStringLength; } /** * Reads a byte value in {@link #b b}. This method is intended for * {@link Attribute} sub classes, and is normally not needed by class * generators or adapters. * * @param index * the start index of the value to be read in {@link #b b}. * @return the read value. */ public int readByte(final int index) { return b[index] & 0xFF; } /** * Reads an unsigned short value in {@link #b b}. This method is intended * for {@link Attribute} sub classes, and is normally not needed by class * generators or adapters. * * @param index * the start index of the value to be read in {@link #b b}. * @return the read value. */ public int readUnsignedShort(final int index) { byte[] b = this.b; return ((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF); } /** * Reads a signed short value in {@link #b b}. This method is intended * for {@link Attribute} sub classes, and is normally not needed by class * generators or adapters. * * @param index * the start index of the value to be read in {@link #b b}. * @return the read value. */ public short readShort(final int index) { byte[] b = this.b; return (short) (((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF)); } /** * Reads a signed int value in {@link #b b}. This method is intended for * {@link Attribute} sub classes, and is normally not needed by class * generators or adapters. * * @param index * the start index of the value to be read in {@link #b b}. * @return the read value. */ public int readInt(final int index) { byte[] b = this.b; return ((b[index] & 0xFF) << 24) | ((b[index + 1] & 0xFF) << 16) | ((b[index + 2] & 0xFF) << 8) | (b[index + 3] & 0xFF); } /** * Reads a signed long value in {@link #b b}. This method is intended for * {@link Attribute} sub classes, and is normally not needed by class * generators or adapters. * * @param index * the start index of the value to be read in {@link #b b}. * @return the read value. */ public long readLong(final int index) { long l1 = readInt(index); long l0 = readInt(index + 4) & 0xFFFFFFFFL; return (l1 << 32) | l0; } /** * Reads an UTF8 string constant pool item in {@link #b b}. This method * is intended for {@link Attribute} sub classes, and is normally not needed * by class generators or adapters. * * @param index * the start index of an unsigned short value in {@link #b b}, * whose value is the index of an UTF8 constant pool item. * @param buf * buffer to be used to read the item. This buffer must be * sufficiently large. It is not automatically resized. * @return the String corresponding to the specified UTF8 item. */ public String readUTF8(int index, final char[] buf) { int item = readUnsignedShort(index); if (index == 0 || item == 0) { return null; } String s = strings[item]; if (s != null) { return s; } index = items[item]; return strings[item] = readUTF(index + 2, readUnsignedShort(index), buf); } /** * Reads UTF8 string in {@link #b b}. * * @param index * start offset of the UTF8 string to be read. * @param utfLen * length of the UTF8 string to be read. * @param buf * buffer to be used to read the string. This buffer must be * sufficiently large. It is not automatically resized. * @return the String corresponding to the specified UTF8 string. */ private String readUTF(int index, final int utfLen, final char[] buf) { int endIndex = index + utfLen; byte[] b = this.b; int strLen = 0; int c; int st = 0; char cc = 0; while (index < endIndex) { c = b[index++]; switch (st) { case 0: c = c & 0xFF; if (c < 0x80) { // 0xxxxxxx buf[strLen++] = (char) c; } else if (c < 0xE0 && c > 0xBF) { // 110x xxxx 10xx xxxx cc = (char) (c & 0x1F); st = 1; } else { // 1110 xxxx 10xx xxxx 10xx xxxx cc = (char) (c & 0x0F); st = 2; } break; case 1: // byte 2 of 2-byte char or byte 3 of 3-byte char buf[strLen++] = (char) ((cc << 6) | (c & 0x3F)); st = 0; break; case 2: // byte 2 of 3-byte char cc = (char) ((cc << 6) | (c & 0x3F)); st = 1; break; } } return new String(buf, 0, strLen); } /** * Reads a class constant pool item in {@link #b b}. This method is * intended for {@link Attribute} sub classes, and is normally not needed by * class generators or adapters. * * @param index * the start index of an unsigned short value in {@link #b b}, * whose value is the index of a class constant pool item. * @param buf * buffer to be used to read the item. This buffer must be * sufficiently large. It is not automatically resized. * @return the String corresponding to the specified class item. */ public String readClass(final int index, final char[] buf) { // computes the start index of the CONSTANT_Class item in b // and reads the CONSTANT_Utf8 item designated by // the first two bytes of this CONSTANT_Class item return readUTF8(items[readUnsignedShort(index)], buf); } /** * Reads a numeric or string constant pool item in {@link #b b}. This * method is intended for {@link Attribute} sub classes, and is normally not * needed by class generators or adapters. * * @param item * the index of a constant pool item. * @param buf * buffer to be used to read the item. This buffer must be * sufficiently large. It is not automatically resized. * @return the {@link Integer}, {@link Float}, {@link Long}, {@link Double}, * {@link String}, {@link Type} or {@link Handle} corresponding to * the given constant pool item. */ public Object readConst(final int item, final char[] buf) { int index = items[item]; switch (b[index - 1]) { case ClassWriter.INT: return new Integer(readInt(index)); case ClassWriter.FLOAT: return new Float(Float.intBitsToFloat(readInt(index))); case ClassWriter.LONG: return new Long(readLong(index)); case ClassWriter.DOUBLE: return new Double(Double.longBitsToDouble(readLong(index))); case ClassWriter.CLASS: return Type.getObjectType(readUTF8(index, buf)); case ClassWriter.STR: return readUTF8(index, buf); case ClassWriter.MTYPE: return Type.getMethodType(readUTF8(index, buf)); default: // case ClassWriter.HANDLE_BASE + [1..9]: int tag = readByte(index); int[] items = this.items; int cpIndex = items[readUnsignedShort(index + 1)]; String owner = readClass(cpIndex, buf); cpIndex = items[readUnsignedShort(cpIndex + 2)]; String name = readUTF8(cpIndex, buf); String desc = readUTF8(cpIndex + 2, buf); return new Handle(tag, owner, name, desc); } } } ================================================ FILE: src/jvm/clojure/asm/ClassVisitor.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A visitor to visit a Java class. The methods of this class must be called in * the following order: visit [ visitSource ] [ * visitOuterClass ] ( visitAnnotation | * visitAttribute )* ( visitInnerClass | visitField | * visitMethod )* visitEnd. * * @author Eric Bruneton */ public abstract class ClassVisitor { /** * The ASM API version implemented by this visitor. The value of this field * must be one of {@link Opcodes#ASM4}. */ protected final int api; /** * The class visitor to which this visitor must delegate method calls. May * be null. */ protected ClassVisitor cv; /** * Constructs a new {@link ClassVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. */ public ClassVisitor(final int api) { this(api, null); } /** * Constructs a new {@link ClassVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. * @param cv * the class visitor to which this visitor must delegate method * calls. May be null. */ public ClassVisitor(final int api, final ClassVisitor cv) { if (api != Opcodes.ASM4) { throw new IllegalArgumentException(); } this.api = api; this.cv = cv; } /** * Visits the header of the class. * * @param version * the class version. * @param access * the class's access flags (see {@link Opcodes}). This parameter * also indicates if the class is deprecated. * @param name * the internal name of the class (see * {@link Type#getInternalName() getInternalName}). * @param signature * the signature of this class. May be null if the class * is not a generic one, and does not extend or implement generic * classes or interfaces. * @param superName * the internal of name of the super class (see * {@link Type#getInternalName() getInternalName}). For * interfaces, the super class is {@link Object}. May be * null, but only for the {@link Object} class. * @param interfaces * the internal names of the class's interfaces (see * {@link Type#getInternalName() getInternalName}). May be * null. */ public void visit(int version, int access, String name, String signature, String superName, String[] interfaces) { if (cv != null) { cv.visit(version, access, name, signature, superName, interfaces); } } /** * Visits the source of the class. * * @param source * the name of the source file from which the class was compiled. * May be null. * @param debug * additional debug information to compute the correspondance * between source and compiled elements of the class. May be * null. */ public void visitSource(String source, String debug) { if (cv != null) { cv.visitSource(source, debug); } } /** * Visits the enclosing class of the class. This method must be called only * if the class has an enclosing class. * * @param owner * internal name of the enclosing class of the class. * @param name * the name of the method that contains the class, or * null if the class is not enclosed in a method of its * enclosing class. * @param desc * the descriptor of the method that contains the class, or * null if the class is not enclosed in a method of its * enclosing class. */ public void visitOuterClass(String owner, String name, String desc) { if (cv != null) { cv.visitOuterClass(owner, name, desc); } } /** * Visits an annotation of the class. * * @param desc * the class descriptor of the annotation class. * @param visible * true if the annotation is visible at runtime. * @return a visitor to visit the annotation values, or null if * this visitor is not interested in visiting this annotation. */ public AnnotationVisitor visitAnnotation(String desc, boolean visible) { if (cv != null) { return cv.visitAnnotation(desc, visible); } return null; } /** * Visits a non standard attribute of the class. * * @param attr * an attribute. */ public void visitAttribute(Attribute attr) { if (cv != null) { cv.visitAttribute(attr); } } /** * Visits information about an inner class. This inner class is not * necessarily a member of the class being visited. * * @param name * the internal name of an inner class (see * {@link Type#getInternalName() getInternalName}). * @param outerName * the internal name of the class to which the inner class * belongs (see {@link Type#getInternalName() getInternalName}). * May be null for not member classes. * @param innerName * the (simple) name of the inner class inside its enclosing * class. May be null for anonymous inner classes. * @param access * the access flags of the inner class as originally declared in * the enclosing class. */ public void visitInnerClass(String name, String outerName, String innerName, int access) { if (cv != null) { cv.visitInnerClass(name, outerName, innerName, access); } } /** * Visits a field of the class. * * @param access * the field's access flags (see {@link Opcodes}). This parameter * also indicates if the field is synthetic and/or deprecated. * @param name * the field's name. * @param desc * the field's descriptor (see {@link Type Type}). * @param signature * the field's signature. May be null if the field's * type does not use generic types. * @param value * the field's initial value. This parameter, which may be * null if the field does not have an initial value, * must be an {@link Integer}, a {@link Float}, a {@link Long}, a * {@link Double} or a {@link String} (for int, * float, long or String fields * respectively). This parameter is only used for static * fields. Its value is ignored for non static fields, which * must be initialized through bytecode instructions in * constructors or methods. * @return a visitor to visit field annotations and attributes, or * null if this class visitor is not interested in visiting * these annotations and attributes. */ public FieldVisitor visitField(int access, String name, String desc, String signature, Object value) { if (cv != null) { return cv.visitField(access, name, desc, signature, value); } return null; } /** * Visits a method of the class. This method must return a new * {@link MethodVisitor} instance (or null) each time it is called, * i.e., it should not return a previously returned visitor. * * @param access * the method's access flags (see {@link Opcodes}). This * parameter also indicates if the method is synthetic and/or * deprecated. * @param name * the method's name. * @param desc * the method's descriptor (see {@link Type Type}). * @param signature * the method's signature. May be null if the method * parameters, return type and exceptions do not use generic * types. * @param exceptions * the internal names of the method's exception classes (see * {@link Type#getInternalName() getInternalName}). May be * null. * @return an object to visit the byte code of the method, or null * if this class visitor is not interested in visiting the code of * this method. */ public MethodVisitor visitMethod(int access, String name, String desc, String signature, String[] exceptions) { if (cv != null) { return cv.visitMethod(access, name, desc, signature, exceptions); } return null; } /** * Visits the end of the class. This method, which is the last one to be * called, is used to inform the visitor that all the fields and methods of * the class have been visited. */ public void visitEnd() { if (cv != null) { cv.visitEnd(); } } } ================================================ FILE: src/jvm/clojure/asm/ClassWriter.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; import clojure.lang.SourceWriter; /** * A {@link ClassVisitor} that generates classes in bytecode form. More * precisely this visitor generates a byte array conforming to the Java class * file format. It can be used alone, to generate a Java class "from scratch", * or with one or more {@link ClassReader ClassReader} and adapter class visitor * to generate a modified class from one or more existing Java classes. * * @author Eric Bruneton */ public class ClassWriter extends ClassVisitor { private final SourceWriter sc; /** * Flag to automatically compute the maximum stack size and the maximum * number of local variables of methods. If this flag is set, then the * arguments of the {@link MethodVisitor#visitMaxs visitMaxs} method of the * {@link MethodVisitor} returned by the {@link #visitMethod visitMethod} * method will be ignored, and computed automatically from the signature and * the bytecode of each method. * * @see #ClassWriter(int) */ public static final int COMPUTE_MAXS = 1; /** * Flag to automatically compute the stack map frames of methods from * scratch. If this flag is set, then the calls to the * {@link MethodVisitor#visitFrame} method are ignored, and the stack map * frames are recomputed from the methods bytecode. The arguments of the * {@link MethodVisitor#visitMaxs visitMaxs} method are also ignored and * recomputed from the bytecode. In other words, computeFrames implies * computeMaxs. * * @see #ClassWriter(int) */ public static final int COMPUTE_FRAMES = 2; /** * Pseudo access flag to distinguish between the synthetic attribute and the * synthetic access flag. */ static final int ACC_SYNTHETIC_ATTRIBUTE = 0x40000; /** * Factor to convert from ACC_SYNTHETIC_ATTRIBUTE to Opcode.ACC_SYNTHETIC. */ static final int TO_ACC_SYNTHETIC = ACC_SYNTHETIC_ATTRIBUTE / Opcodes.ACC_SYNTHETIC; /** * The type of instructions without any argument. */ static final int NOARG_INSN = 0; /** * The type of instructions with an signed byte argument. */ static final int SBYTE_INSN = 1; /** * The type of instructions with an signed short argument. */ static final int SHORT_INSN = 2; /** * The type of instructions with a local variable index argument. */ static final int VAR_INSN = 3; /** * The type of instructions with an implicit local variable index argument. */ static final int IMPLVAR_INSN = 4; /** * The type of instructions with a type descriptor argument. */ static final int TYPE_INSN = 5; /** * The type of field and method invocations instructions. */ static final int FIELDORMETH_INSN = 6; /** * The type of the INVOKEINTERFACE/INVOKEDYNAMIC instruction. */ static final int ITFMETH_INSN = 7; /** * The type of the INVOKEDYNAMIC instruction. */ static final int INDYMETH_INSN = 8; /** * The type of instructions with a 2 bytes bytecode offset label. */ static final int LABEL_INSN = 9; /** * The type of instructions with a 4 bytes bytecode offset label. */ static final int LABELW_INSN = 10; /** * The type of the LDC instruction. */ static final int LDC_INSN = 11; /** * The type of the LDC_W and LDC2_W instructions. */ static final int LDCW_INSN = 12; /** * The type of the IINC instruction. */ static final int IINC_INSN = 13; /** * The type of the TABLESWITCH instruction. */ static final int TABL_INSN = 14; /** * The type of the LOOKUPSWITCH instruction. */ static final int LOOK_INSN = 15; /** * The type of the MULTIANEWARRAY instruction. */ static final int MANA_INSN = 16; /** * The type of the WIDE instruction. */ static final int WIDE_INSN = 17; /** * The instruction types of all JVM opcodes. */ static final byte[] TYPE; /** * The type of CONSTANT_Class constant pool items. */ static final int CLASS = 7; /** * The type of CONSTANT_Fieldref constant pool items. */ static final int FIELD = 9; /** * The type of CONSTANT_Methodref constant pool items. */ static final int METH = 10; /** * The type of CONSTANT_InterfaceMethodref constant pool items. */ static final int IMETH = 11; /** * The type of CONSTANT_String constant pool items. */ static final int STR = 8; /** * The type of CONSTANT_Integer constant pool items. */ static final int INT = 3; /** * The type of CONSTANT_Float constant pool items. */ static final int FLOAT = 4; /** * The type of CONSTANT_Long constant pool items. */ static final int LONG = 5; /** * The type of CONSTANT_Double constant pool items. */ static final int DOUBLE = 6; /** * The type of CONSTANT_NameAndType constant pool items. */ static final int NAME_TYPE = 12; /** * The type of CONSTANT_Utf8 constant pool items. */ static final int UTF8 = 1; /** * The type of CONSTANT_MethodType constant pool items. */ static final int MTYPE = 16; /** * The type of CONSTANT_MethodHandle constant pool items. */ static final int HANDLE = 15; /** * The type of CONSTANT_InvokeDynamic constant pool items. */ static final int INDY = 18; /** * The base value for all CONSTANT_MethodHandle constant pool items. * Internally, ASM store the 9 variations of CONSTANT_MethodHandle into 9 * different items. */ static final int HANDLE_BASE = 20; /** * Normal type Item stored in the ClassWriter {@link ClassWriter#typeTable}, * instead of the constant pool, in order to avoid clashes with normal * constant pool items in the ClassWriter constant pool's hash table. */ static final int TYPE_NORMAL = 30; /** * Uninitialized type Item stored in the ClassWriter * {@link ClassWriter#typeTable}, instead of the constant pool, in order to * avoid clashes with normal constant pool items in the ClassWriter constant * pool's hash table. */ static final int TYPE_UNINIT = 31; /** * Merged type Item stored in the ClassWriter {@link ClassWriter#typeTable}, * instead of the constant pool, in order to avoid clashes with normal * constant pool items in the ClassWriter constant pool's hash table. */ static final int TYPE_MERGED = 32; /** * The type of BootstrapMethods items. These items are stored in a special * class attribute named BootstrapMethods and not in the constant pool. */ static final int BSM = 33; /** * The class reader from which this class writer was constructed, if any. */ ClassReader cr; /** * Minor and major version numbers of the class to be generated. */ int version; /** * Index of the next item to be added in the constant pool. */ int index; /** * The constant pool of this class. */ final ByteVector pool; /** * The constant pool's hash table data. */ Item[] items; /** * The threshold of the constant pool's hash table. */ int threshold; /** * A reusable key used to look for items in the {@link #items} hash table. */ final Item key; /** * A reusable key used to look for items in the {@link #items} hash table. */ final Item key2; /** * A reusable key used to look for items in the {@link #items} hash table. */ final Item key3; /** * A reusable key used to look for items in the {@link #items} hash table. */ final Item key4; /** * A type table used to temporarily store internal names that will not * necessarily be stored in the constant pool. This type table is used by * the control flow and data flow analysis algorithm used to compute stack * map frames from scratch. This array associates to each index i * the Item whose index is i. All Item objects stored in this array * are also stored in the {@link #items} hash table. These two arrays allow * to retrieve an Item from its index or, conversely, to get the index of an * Item from its value. Each Item stores an internal name in its * {@link Item#strVal1} field. */ Item[] typeTable; /** * Number of elements in the {@link #typeTable} array. */ private short typeCount; /** * The access flags of this class. */ private int access; /** * The constant pool item that contains the internal name of this class. */ private int name; /** * The internal name of this class. */ String thisName; /** * The constant pool item that contains the signature of this class. */ private int signature; /** * The constant pool item that contains the internal name of the super class * of this class. */ private int superName; /** * Number of interfaces implemented or extended by this class or interface. */ private int interfaceCount; /** * The interfaces implemented or extended by this class or interface. More * precisely, this array contains the indexes of the constant pool items * that contain the internal names of these interfaces. */ private int[] interfaces; /** * The index of the constant pool item that contains the name of the source * file from which this class was compiled. */ private int sourceFile; /** * The SourceDebug attribute of this class. */ private ByteVector sourceDebug; /** * The constant pool item that contains the name of the enclosing class of * this class. */ private int enclosingMethodOwner; /** * The constant pool item that contains the name and descriptor of the * enclosing method of this class. */ private int enclosingMethod; /** * The runtime visible annotations of this class. */ private AnnotationWriter anns; /** * The runtime invisible annotations of this class. */ private AnnotationWriter ianns; /** * The non standard attributes of this class. */ private Attribute attrs; /** * The number of entries in the InnerClasses attribute. */ private int innerClassesCount; /** * The InnerClasses attribute. */ private ByteVector innerClasses; /** * The number of entries in the BootstrapMethods attribute. */ int bootstrapMethodsCount; /** * The BootstrapMethods attribute. */ ByteVector bootstrapMethods; /** * The fields of this class. These fields are stored in a linked list of * {@link FieldWriter} objects, linked to each other by their * {@link FieldWriter#fv} field. This field stores the first element of this * list. */ FieldWriter firstField; /** * The fields of this class. These fields are stored in a linked list of * {@link FieldWriter} objects, linked to each other by their * {@link FieldWriter#fv} field. This field stores the last element of this * list. */ FieldWriter lastField; /** * The methods of this class. These methods are stored in a linked list of * {@link MethodWriter} objects, linked to each other by their * {@link MethodWriter#mv} field. This field stores the first element of * this list. */ MethodWriter firstMethod; /** * The methods of this class. These methods are stored in a linked list of * {@link MethodWriter} objects, linked to each other by their * {@link MethodWriter#mv} field. This field stores the last element of this * list. */ MethodWriter lastMethod; /** * true if the maximum stack size and number of local variables * must be automatically computed. */ private final boolean computeMaxs; /** * true if the stack map frames must be recomputed from scratch. */ private final boolean computeFrames; /** * true if the stack map tables of this class are invalid. The * {@link MethodWriter#resizeInstructions} method cannot transform existing * stack map tables, and so produces potentially invalid classes when it is * executed. In this case the class is reread and rewritten with the * {@link #COMPUTE_FRAMES} option (the resizeInstructions method can resize * stack map tables when this option is used). */ boolean invalidFrames; // ------------------------------------------------------------------------ // Static initializer // ------------------------------------------------------------------------ /** * Computes the instruction types of JVM opcodes. */ static { int i; byte[] b = new byte[220]; String s = "AAAAAAAAAAAAAAAABCLMMDDDDDEEEEEEEEEEEEEEEEEEEEAAAAAAAADD" + "DDDEEEEEEEEEEEEEEEEEEEEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + "AAAAAAAAAAAAAAAAANAAAAAAAAAAAAAAAAAAAAJJJJJJJJJJJJJJJJDOPAA" + "AAAAGGGGGGGHIFBFAAFFAARQJJKKJJJJJJJJJJJJJJJJJJ"; for (i = 0; i < b.length; ++i) { b[i] = (byte) (s.charAt(i) - 'A'); } TYPE = b; // code to generate the above string // // // SBYTE_INSN instructions // b[Constants.NEWARRAY] = SBYTE_INSN; // b[Constants.BIPUSH] = SBYTE_INSN; // // // SHORT_INSN instructions // b[Constants.SIPUSH] = SHORT_INSN; // // // (IMPL)VAR_INSN instructions // b[Constants.RET] = VAR_INSN; // for (i = Constants.ILOAD; i <= Constants.ALOAD; ++i) { // b[i] = VAR_INSN; // } // for (i = Constants.ISTORE; i <= Constants.ASTORE; ++i) { // b[i] = VAR_INSN; // } // for (i = 26; i <= 45; ++i) { // ILOAD_0 to ALOAD_3 // b[i] = IMPLVAR_INSN; // } // for (i = 59; i <= 78; ++i) { // ISTORE_0 to ASTORE_3 // b[i] = IMPLVAR_INSN; // } // // // TYPE_INSN instructions // b[Constants.NEW] = TYPE_INSN; // b[Constants.ANEWARRAY] = TYPE_INSN; // b[Constants.CHECKCAST] = TYPE_INSN; // b[Constants.INSTANCEOF] = TYPE_INSN; // // // (Set)FIELDORMETH_INSN instructions // for (i = Constants.GETSTATIC; i <= Constants.INVOKESTATIC; ++i) { // b[i] = FIELDORMETH_INSN; // } // b[Constants.INVOKEINTERFACE] = ITFMETH_INSN; // b[Constants.INVOKEDYNAMIC] = INDYMETH_INSN; // // // LABEL(W)_INSN instructions // for (i = Constants.IFEQ; i <= Constants.JSR; ++i) { // b[i] = LABEL_INSN; // } // b[Constants.IFNULL] = LABEL_INSN; // b[Constants.IFNONNULL] = LABEL_INSN; // b[200] = LABELW_INSN; // GOTO_W // b[201] = LABELW_INSN; // JSR_W // // temporary opcodes used internally by ASM - see Label and // MethodWriter // for (i = 202; i < 220; ++i) { // b[i] = LABEL_INSN; // } // // // LDC(_W) instructions // b[Constants.LDC] = LDC_INSN; // b[19] = LDCW_INSN; // LDC_W // b[20] = LDCW_INSN; // LDC2_W // // // special instructions // b[Constants.IINC] = IINC_INSN; // b[Constants.TABLESWITCH] = TABL_INSN; // b[Constants.LOOKUPSWITCH] = LOOK_INSN; // b[Constants.MULTIANEWARRAY] = MANA_INSN; // b[196] = WIDE_INSN; // WIDE // // for (i = 0; i < b.length; ++i) { // System.err.print((char)('A' + b[i])); // } // System.err.println(); } // ------------------------------------------------------------------------ // Constructor // ------------------------------------------------------------------------ /** * Constructs a new {@link ClassWriter} object. * * @param flags * option flags that can be used to modify the default behavior * of this class. See {@link #COMPUTE_MAXS}, * {@link #COMPUTE_FRAMES}. */ public ClassWriter(final int flags) { super(Opcodes.ASM4); this.sc = new SourceWriter(); index = 1; pool = new ByteVector(); items = new Item[256]; threshold = (int) (0.75d * items.length); key = new Item(); key2 = new Item(); key3 = new Item(); key4 = new Item(); this.computeMaxs = (flags & COMPUTE_MAXS) != 0; this.computeFrames = (flags & COMPUTE_FRAMES) != 0; } /** * Constructs a new {@link ClassWriter} object and enables optimizations for * "mostly add" bytecode transformations. These optimizations are the * following: * *
    *
  • The constant pool from the original class is copied as is in the new * class, which saves time. New constant pool entries will be added at the * end if necessary, but unused constant pool entries won't be * removed.
    • *
  • Methods that are not transformed are copied as is in the new class, * directly from the original class bytecode (i.e. without emitting visit * events for all the method instructions), which saves a lot of * time. Untransformed methods are detected by the fact that the * {@link ClassReader} receives {@link MethodVisitor} objects that come from * a {@link ClassWriter} (and not from any other {@link ClassVisitor} * instance).
    • *
* * @param classReader * the {@link ClassReader} used to read the original class. It * will be used to copy the entire constant pool from the * original class and also to copy other fragments of original * bytecode where applicable. * @param flags * option flags that can be used to modify the default behavior * of this class. These option flags do not affect methods * that are copied as is in the new class. This means that the * maximum stack size nor the stack frames will be computed for * these methods. See {@link #COMPUTE_MAXS}, * {@link #COMPUTE_FRAMES}. */ public ClassWriter(final ClassReader classReader, final int flags) { this(flags); classReader.copyPool(this); this.cr = classReader; } // ------------------------------------------------------------------------ // Implementation of the ClassVisitor abstract class // ------------------------------------------------------------------------ @Override public final void visit(final int version, final int access, final String name, final String signature, final String superName, final String[] interfaces) { this.version = version; this.access = access; this.name = newClass(name); thisName = name; if (ClassReader.SIGNATURES && signature != null) { this.signature = newUTF8(signature); } this.superName = superName == null ? 0 : newClass(superName); if (interfaces != null && interfaces.length > 0) { interfaceCount = interfaces.length; this.interfaces = new int[interfaceCount]; for (int i = 0; i < interfaceCount; ++i) { this.interfaces[i] = newClass(interfaces[i]); } } } @Override public final void visitSource(final String file, final String debug) { if (file != null) { sourceFile = newUTF8(file); } if (debug != null) { sourceDebug = new ByteVector().putUTF8(debug); } } @Override public final void visitOuterClass(final String owner, final String name, final String desc) { enclosingMethodOwner = newClass(owner); if (name != null && desc != null) { enclosingMethod = newNameType(name, desc); } } @Override public final AnnotationVisitor visitAnnotation(final String desc, final boolean visible) { if (!ClassReader.ANNOTATIONS) { return null; } ByteVector bv = new ByteVector(); // write type, and reserve space for values count bv.putShort(newUTF8(desc)).putShort(0); AnnotationWriter aw = new AnnotationWriter(this, true, bv, bv, 2); if (visible) { aw.next = anns; anns = aw; } else { aw.next = ianns; ianns = aw; } return aw; } @Override public final void visitAttribute(final Attribute attr) { attr.next = attrs; attrs = attr; } @Override public final void visitInnerClass(final String name, final String outerName, final String innerName, final int access) { if (innerClasses == null) { innerClasses = new ByteVector(); } ++innerClassesCount; innerClasses.putShort(name == null ? 0 : newClass(name)); innerClasses.putShort(outerName == null ? 0 : newClass(outerName)); innerClasses.putShort(innerName == null ? 0 : newUTF8(innerName)); innerClasses.putShort(access); } @Override public final FieldVisitor visitField(final int access, final String name, final String desc, final String signature, final Object value) { return new FieldWriter(this, access, name, desc, signature, value); } @Override public final MethodVisitor visitMethod(final int access, final String name, final String desc, final String signature, final String[] exceptions) { return new MethodWriter(this, access, name, desc, signature, exceptions, computeMaxs, computeFrames); } @Override public final void visitEnd() { } // ------------------------------------------------------------------------ // Other public methods // ------------------------------------------------------------------------ /** * Returns the bytecode of the class that was build with this class writer. * * @return the bytecode of the class that was build with this class writer. */ public byte[] toByteArray() { if (index > 0xFFFF) { throw new RuntimeException("Class file too large!"); } // computes the real size of the bytecode of this class int size = 24 + 2 * interfaceCount; int nbFields = 0; FieldWriter fb = firstField; while (fb != null) { ++nbFields; size += fb.getSize(); fb = (FieldWriter) fb.fv; } int nbMethods = 0; MethodWriter mb = firstMethod; while (mb != null) { ++nbMethods; size += mb.getSize(); mb = (MethodWriter) mb.mv; } int attributeCount = 0; if (bootstrapMethods != null) { // we put it as first attribute in order to improve a bit // ClassReader.copyBootstrapMethods ++attributeCount; size += 8 + bootstrapMethods.length; newUTF8("BootstrapMethods"); } if (ClassReader.SIGNATURES && signature != 0) { ++attributeCount; size += 8; newUTF8("Signature"); } if (sourceFile != 0) { ++attributeCount; size += 8; newUTF8("SourceFile"); } if (sourceDebug != null) { ++attributeCount; size += sourceDebug.length + 4; newUTF8("SourceDebugExtension"); } if (enclosingMethodOwner != 0) { ++attributeCount; size += 10; newUTF8("EnclosingMethod"); } if ((access & Opcodes.ACC_DEPRECATED) != 0) { ++attributeCount; size += 6; newUTF8("Deprecated"); } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((version & 0xFFFF) < Opcodes.V1_5 || (access & ACC_SYNTHETIC_ATTRIBUTE) != 0) { ++attributeCount; size += 6; newUTF8("Synthetic"); } } if (innerClasses != null) { ++attributeCount; size += 8 + innerClasses.length; newUTF8("InnerClasses"); } if (ClassReader.ANNOTATIONS && anns != null) { ++attributeCount; size += 8 + anns.getSize(); newUTF8("RuntimeVisibleAnnotations"); } if (ClassReader.ANNOTATIONS && ianns != null) { ++attributeCount; size += 8 + ianns.getSize(); newUTF8("RuntimeInvisibleAnnotations"); } if (attrs != null) { attributeCount += attrs.getCount(); size += attrs.getSize(this, null, 0, -1, -1); } size += pool.length; // allocates a byte vector of this size, in order to avoid unnecessary // arraycopy operations in the ByteVector.enlarge() method ByteVector out = new ByteVector(size); out.putInt(0xCAFEBABE).putInt(version); out.putShort(index).putByteArray(pool.data, 0, pool.length); int mask = Opcodes.ACC_DEPRECATED | ACC_SYNTHETIC_ATTRIBUTE | ((access & ACC_SYNTHETIC_ATTRIBUTE) / TO_ACC_SYNTHETIC); out.putShort(access & ~mask).putShort(name).putShort(superName); out.putShort(interfaceCount); for (int i = 0; i < interfaceCount; ++i) { out.putShort(interfaces[i]); } out.putShort(nbFields); fb = firstField; while (fb != null) { fb.put(out); fb = (FieldWriter) fb.fv; } out.putShort(nbMethods); mb = firstMethod; while (mb != null) { mb.put(out); mb = (MethodWriter) mb.mv; } out.putShort(attributeCount); if (bootstrapMethods != null) { out.putShort(newUTF8("BootstrapMethods")); out.putInt(bootstrapMethods.length + 2).putShort( bootstrapMethodsCount); out.putByteArray(bootstrapMethods.data, 0, bootstrapMethods.length); } if (ClassReader.SIGNATURES && signature != 0) { out.putShort(newUTF8("Signature")).putInt(2).putShort(signature); } if (sourceFile != 0) { out.putShort(newUTF8("SourceFile")).putInt(2).putShort(sourceFile); } if (sourceDebug != null) { int len = sourceDebug.length - 2; out.putShort(newUTF8("SourceDebugExtension")).putInt(len); out.putByteArray(sourceDebug.data, 2, len); } if (enclosingMethodOwner != 0) { out.putShort(newUTF8("EnclosingMethod")).putInt(4); out.putShort(enclosingMethodOwner).putShort(enclosingMethod); } if ((access & Opcodes.ACC_DEPRECATED) != 0) { out.putShort(newUTF8("Deprecated")).putInt(0); } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((version & 0xFFFF) < Opcodes.V1_5 || (access & ACC_SYNTHETIC_ATTRIBUTE) != 0) { out.putShort(newUTF8("Synthetic")).putInt(0); } } if (innerClasses != null) { out.putShort(newUTF8("InnerClasses")); out.putInt(innerClasses.length + 2).putShort(innerClassesCount); out.putByteArray(innerClasses.data, 0, innerClasses.length); } if (ClassReader.ANNOTATIONS && anns != null) { out.putShort(newUTF8("RuntimeVisibleAnnotations")); anns.put(out); } if (ClassReader.ANNOTATIONS && ianns != null) { out.putShort(newUTF8("RuntimeInvisibleAnnotations")); ianns.put(out); } if (attrs != null) { attrs.put(this, null, 0, -1, -1, out); } if (invalidFrames) { ClassWriter cw = new ClassWriter(COMPUTE_FRAMES); new ClassReader(out.data).accept(cw, ClassReader.SKIP_FRAMES); return cw.toByteArray(); } return out.data; } // ------------------------------------------------------------------------ // Utility methods: constant pool management // ------------------------------------------------------------------------ /** * Adds a number or string constant to the constant pool of the class being * build. Does nothing if the constant pool already contains a similar item. * * @param cst * the value of the constant to be added to the constant pool. * This parameter must be an {@link Integer}, a {@link Float}, a * {@link Long}, a {@link Double}, a {@link String} or a * {@link Type}. * @return a new or already existing constant item with the given value. */ Item newConstItem(final Object cst) { if (cst instanceof Integer) { int val = ((Integer) cst).intValue(); return newInteger(val); } else if (cst instanceof Byte) { int val = ((Byte) cst).intValue(); return newInteger(val); } else if (cst instanceof Character) { int val = ((Character) cst).charValue(); return newInteger(val); } else if (cst instanceof Short) { int val = ((Short) cst).intValue(); return newInteger(val); } else if (cst instanceof Boolean) { int val = ((Boolean) cst).booleanValue() ? 1 : 0; return newInteger(val); } else if (cst instanceof Float) { float val = ((Float) cst).floatValue(); return newFloat(val); } else if (cst instanceof Long) { long val = ((Long) cst).longValue(); return newLong(val); } else if (cst instanceof Double) { double val = ((Double) cst).doubleValue(); return newDouble(val); } else if (cst instanceof String) { return newString((String) cst); } else if (cst instanceof Type) { Type t = (Type) cst; int s = t.getSort(); if (s == Type.OBJECT) { return newClassItem(t.getInternalName()); } else if (s == Type.METHOD) { return newMethodTypeItem(t.getDescriptor()); } else { // s == primitive type or array return newClassItem(t.getDescriptor()); } } else if (cst instanceof Handle) { Handle h = (Handle) cst; return newHandleItem(h.tag, h.owner, h.name, h.desc); } else { throw new IllegalArgumentException("value " + cst); } } /** * Adds a number or string constant to the constant pool of the class being * build. Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param cst * the value of the constant to be added to the constant pool. * This parameter must be an {@link Integer}, a {@link Float}, a * {@link Long}, a {@link Double} or a {@link String}. * @return the index of a new or already existing constant item with the * given value. */ public int newConst(final Object cst) { return newConstItem(cst).index; } /** * Adds an UTF8 string to the constant pool of the class being build. Does * nothing if the constant pool already contains a similar item. This * method is intended for {@link Attribute} sub classes, and is normally not * needed by class generators or adapters. * * @param value * the String value. * @return the index of a new or already existing UTF8 item. */ public int newUTF8(final String value) { key.set(UTF8, value, null, null); Item result = get(key); if (result == null) { pool.putByte(UTF8).putUTF8(value); result = new Item(index++, key); put(result); } return result.index; } /** * Adds a class reference to the constant pool of the class being build. * Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param value * the internal name of the class. * @return a new or already existing class reference item. */ Item newClassItem(final String value) { key2.set(CLASS, value, null, null); Item result = get(key2); if (result == null) { pool.put12(CLASS, newUTF8(value)); result = new Item(index++, key2); put(result); } return result; } /** * Adds a class reference to the constant pool of the class being build. * Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param value * the internal name of the class. * @return the index of a new or already existing class reference item. */ public int newClass(final String value) { return newClassItem(value).index; } /** * Adds a method type reference to the constant pool of the class being * build. Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param methodDesc * method descriptor of the method type. * @return a new or already existing method type reference item. */ Item newMethodTypeItem(final String methodDesc) { key2.set(MTYPE, methodDesc, null, null); Item result = get(key2); if (result == null) { pool.put12(MTYPE, newUTF8(methodDesc)); result = new Item(index++, key2); put(result); } return result; } /** * Adds a method type reference to the constant pool of the class being * build. Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param methodDesc * method descriptor of the method type. * @return the index of a new or already existing method type reference * item. */ public int newMethodType(final String methodDesc) { return newMethodTypeItem(methodDesc).index; } /** * Adds a handle to the constant pool of the class being build. Does nothing * if the constant pool already contains a similar item. This method is * intended for {@link Attribute} sub classes, and is normally not needed by * class generators or adapters. * * @param tag * the kind of this handle. Must be {@link Opcodes#H_GETFIELD}, * {@link Opcodes#H_GETSTATIC}, {@link Opcodes#H_PUTFIELD}, * {@link Opcodes#H_PUTSTATIC}, {@link Opcodes#H_INVOKEVIRTUAL}, * {@link Opcodes#H_INVOKESTATIC}, * {@link Opcodes#H_INVOKESPECIAL}, * {@link Opcodes#H_NEWINVOKESPECIAL} or * {@link Opcodes#H_INVOKEINTERFACE}. * @param owner * the internal name of the field or method owner class. * @param name * the name of the field or method. * @param desc * the descriptor of the field or method. * @return a new or an already existing method type reference item. */ Item newHandleItem(final int tag, final String owner, final String name, final String desc) { key4.set(HANDLE_BASE + tag, owner, name, desc); Item result = get(key4); if (result == null) { if (tag <= Opcodes.H_PUTSTATIC) { put112(HANDLE, tag, newField(owner, name, desc)); } else { put112(HANDLE, tag, newMethod(owner, name, desc, tag == Opcodes.H_INVOKEINTERFACE)); } result = new Item(index++, key4); put(result); } return result; } /** * Adds a handle to the constant pool of the class being build. Does nothing * if the constant pool already contains a similar item. This method is * intended for {@link Attribute} sub classes, and is normally not needed by * class generators or adapters. * * @param tag * the kind of this handle. Must be {@link Opcodes#H_GETFIELD}, * {@link Opcodes#H_GETSTATIC}, {@link Opcodes#H_PUTFIELD}, * {@link Opcodes#H_PUTSTATIC}, {@link Opcodes#H_INVOKEVIRTUAL}, * {@link Opcodes#H_INVOKESTATIC}, * {@link Opcodes#H_INVOKESPECIAL}, * {@link Opcodes#H_NEWINVOKESPECIAL} or * {@link Opcodes#H_INVOKEINTERFACE}. * @param owner * the internal name of the field or method owner class. * @param name * the name of the field or method. * @param desc * the descriptor of the field or method. * @return the index of a new or already existing method type reference * item. */ public int newHandle(final int tag, final String owner, final String name, final String desc) { return newHandleItem(tag, owner, name, desc).index; } /** * Adds an invokedynamic reference to the constant pool of the class being * build. Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param name * name of the invoked method. * @param desc * descriptor of the invoke method. * @param bsm * the bootstrap method. * @param bsmArgs * the bootstrap method constant arguments. * * @return a new or an already existing invokedynamic type reference item. */ Item newInvokeDynamicItem(final String name, final String desc, final Handle bsm, final Object... bsmArgs) { // cache for performance ByteVector bootstrapMethods = this.bootstrapMethods; if (bootstrapMethods == null) { bootstrapMethods = this.bootstrapMethods = new ByteVector(); } int position = bootstrapMethods.length; // record current position int hashCode = bsm.hashCode(); bootstrapMethods.putShort(newHandle(bsm.tag, bsm.owner, bsm.name, bsm.desc)); int argsLength = bsmArgs.length; bootstrapMethods.putShort(argsLength); for (int i = 0; i < argsLength; i++) { Object bsmArg = bsmArgs[i]; hashCode ^= bsmArg.hashCode(); bootstrapMethods.putShort(newConst(bsmArg)); } byte[] data = bootstrapMethods.data; int length = (1 + 1 + argsLength) << 1; // (bsm + argCount + arguments) hashCode &= 0x7FFFFFFF; Item result = items[hashCode % items.length]; loop: while (result != null) { if (result.type != BSM || result.hashCode != hashCode) { result = result.next; continue; } // because the data encode the size of the argument // we don't need to test if these size are equals int resultPosition = result.intVal; for (int p = 0; p < length; p++) { if (data[position + p] != data[resultPosition + p]) { result = result.next; continue loop; } } break; } int bootstrapMethodIndex; if (result != null) { bootstrapMethodIndex = result.index; bootstrapMethods.length = position; // revert to old position } else { bootstrapMethodIndex = bootstrapMethodsCount++; result = new Item(bootstrapMethodIndex); result.set(position, hashCode); put(result); } // now, create the InvokeDynamic constant key3.set(name, desc, bootstrapMethodIndex); result = get(key3); if (result == null) { put122(INDY, bootstrapMethodIndex, newNameType(name, desc)); result = new Item(index++, key3); put(result); } return result; } /** * Adds an invokedynamic reference to the constant pool of the class being * build. Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param name * name of the invoked method. * @param desc * descriptor of the invoke method. * @param bsm * the bootstrap method. * @param bsmArgs * the bootstrap method constant arguments. * * @return the index of a new or already existing invokedynamic reference * item. */ public int newInvokeDynamic(final String name, final String desc, final Handle bsm, final Object... bsmArgs) { return newInvokeDynamicItem(name, desc, bsm, bsmArgs).index; } /** * Adds a field reference to the constant pool of the class being build. * Does nothing if the constant pool already contains a similar item. * * @param owner * the internal name of the field's owner class. * @param name * the field's name. * @param desc * the field's descriptor. * @return a new or already existing field reference item. */ Item newFieldItem(final String owner, final String name, final String desc) { key3.set(FIELD, owner, name, desc); Item result = get(key3); if (result == null) { put122(FIELD, newClass(owner), newNameType(name, desc)); result = new Item(index++, key3); put(result); } return result; } /** * Adds a field reference to the constant pool of the class being build. * Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param owner * the internal name of the field's owner class. * @param name * the field's name. * @param desc * the field's descriptor. * @return the index of a new or already existing field reference item. */ public int newField(final String owner, final String name, final String desc) { return newFieldItem(owner, name, desc).index; } /** * Adds a method reference to the constant pool of the class being build. * Does nothing if the constant pool already contains a similar item. * * @param owner * the internal name of the method's owner class. * @param name * the method's name. * @param desc * the method's descriptor. * @param itf * true if owner is an interface. * @return a new or already existing method reference item. */ Item newMethodItem(final String owner, final String name, final String desc, final boolean itf) { int type = itf ? IMETH : METH; key3.set(type, owner, name, desc); Item result = get(key3); if (result == null) { put122(type, newClass(owner), newNameType(name, desc)); result = new Item(index++, key3); put(result); } return result; } /** * Adds a method reference to the constant pool of the class being build. * Does nothing if the constant pool already contains a similar item. * This method is intended for {@link Attribute} sub classes, and is * normally not needed by class generators or adapters. * * @param owner * the internal name of the method's owner class. * @param name * the method's name. * @param desc * the method's descriptor. * @param itf * true if owner is an interface. * @return the index of a new or already existing method reference item. */ public int newMethod(final String owner, final String name, final String desc, final boolean itf) { return newMethodItem(owner, name, desc, itf).index; } /** * Adds an integer to the constant pool of the class being build. Does * nothing if the constant pool already contains a similar item. * * @param value * the int value. * @return a new or already existing int item. */ Item newInteger(final int value) { key.set(value); Item result = get(key); if (result == null) { pool.putByte(INT).putInt(value); result = new Item(index++, key); put(result); } return result; } /** * Adds a float to the constant pool of the class being build. Does nothing * if the constant pool already contains a similar item. * * @param value * the float value. * @return a new or already existing float item. */ Item newFloat(final float value) { key.set(value); Item result = get(key); if (result == null) { pool.putByte(FLOAT).putInt(key.intVal); result = new Item(index++, key); put(result); } return result; } /** * Adds a long to the constant pool of the class being build. Does nothing * if the constant pool already contains a similar item. * * @param value * the long value. * @return a new or already existing long item. */ Item newLong(final long value) { key.set(value); Item result = get(key); if (result == null) { pool.putByte(LONG).putLong(value); result = new Item(index, key); index += 2; put(result); } return result; } /** * Adds a double to the constant pool of the class being build. Does nothing * if the constant pool already contains a similar item. * * @param value * the double value. * @return a new or already existing double item. */ Item newDouble(final double value) { key.set(value); Item result = get(key); if (result == null) { pool.putByte(DOUBLE).putLong(key.longVal); result = new Item(index, key); index += 2; put(result); } return result; } /** * Adds a string to the constant pool of the class being build. Does nothing * if the constant pool already contains a similar item. * * @param value * the String value. * @return a new or already existing string item. */ private Item newString(final String value) { key2.set(STR, value, null, null); Item result = get(key2); if (result == null) { pool.put12(STR, newUTF8(value)); result = new Item(index++, key2); put(result); } return result; } /** * Adds a name and type to the constant pool of the class being build. Does * nothing if the constant pool already contains a similar item. This * method is intended for {@link Attribute} sub classes, and is normally not * needed by class generators or adapters. * * @param name * a name. * @param desc * a type descriptor. * @return the index of a new or already existing name and type item. */ public int newNameType(final String name, final String desc) { return newNameTypeItem(name, desc).index; } /** * Adds a name and type to the constant pool of the class being build. Does * nothing if the constant pool already contains a similar item. * * @param name * a name. * @param desc * a type descriptor. * @return a new or already existing name and type item. */ Item newNameTypeItem(final String name, final String desc) { key2.set(NAME_TYPE, name, desc, null); Item result = get(key2); if (result == null) { put122(NAME_TYPE, newUTF8(name), newUTF8(desc)); result = new Item(index++, key2); put(result); } return result; } /** * Adds the given internal name to {@link #typeTable} and returns its index. * Does nothing if the type table already contains this internal name. * * @param type * the internal name to be added to the type table. * @return the index of this internal name in the type table. */ int addType(final String type) { key.set(TYPE_NORMAL, type, null, null); Item result = get(key); if (result == null) { result = addType(key); } return result.index; } /** * Adds the given "uninitialized" type to {@link #typeTable} and returns its * index. This method is used for UNINITIALIZED types, made of an internal * name and a bytecode offset. * * @param type * the internal name to be added to the type table. * @param offset * the bytecode offset of the NEW instruction that created this * UNINITIALIZED type value. * @return the index of this internal name in the type table. */ int addUninitializedType(final String type, final int offset) { key.type = TYPE_UNINIT; key.intVal = offset; key.strVal1 = type; key.hashCode = 0x7FFFFFFF & (TYPE_UNINIT + type.hashCode() + offset); Item result = get(key); if (result == null) { result = addType(key); } return result.index; } /** * Adds the given Item to {@link #typeTable}. * * @param item * the value to be added to the type table. * @return the added Item, which a new Item instance with the same value as * the given Item. */ private Item addType(final Item item) { ++typeCount; Item result = new Item(typeCount, key); put(result); if (typeTable == null) { typeTable = new Item[16]; } if (typeCount == typeTable.length) { Item[] newTable = new Item[2 * typeTable.length]; System.arraycopy(typeTable, 0, newTable, 0, typeTable.length); typeTable = newTable; } typeTable[typeCount] = result; return result; } /** * Returns the index of the common super type of the two given types. This * method calls {@link #getCommonSuperClass} and caches the result in the * {@link #items} hash table to speedup future calls with the same * parameters. * * @param type1 * index of an internal name in {@link #typeTable}. * @param type2 * index of an internal name in {@link #typeTable}. * @return the index of the common super type of the two given types. */ int getMergedType(final int type1, final int type2) { key2.type = TYPE_MERGED; key2.longVal = type1 | (((long) type2) << 32); key2.hashCode = 0x7FFFFFFF & (TYPE_MERGED + type1 + type2); Item result = get(key2); if (result == null) { String t = typeTable[type1].strVal1; String u = typeTable[type2].strVal1; key2.intVal = addType(getCommonSuperClass(t, u)); result = new Item((short) 0, key2); put(result); } return result.intVal; } /** * Returns the common super type of the two given types. The default * implementation of this method loads the two given classes and uses * the java.lang.Class methods to find the common super class. It can be * overridden to compute this common super type in other ways, in particular * without actually loading any class, or to take into account the class * that is currently being generated by this ClassWriter, which can of * course not be loaded since it is under construction. * * @param type1 * the internal name of a class. * @param type2 * the internal name of another class. * @return the internal name of the common super class of the two given * classes. */ protected String getCommonSuperClass(final String type1, final String type2) { Class c, d; ClassLoader classLoader = getClass().getClassLoader(); try { c = Class.forName(type1.replace('/', '.'), false, classLoader); d = Class.forName(type2.replace('/', '.'), false, classLoader); } catch (Exception e) { throw new RuntimeException(e.toString()); } if (c.isAssignableFrom(d)) { return type1; } if (d.isAssignableFrom(c)) { return type2; } if (c.isInterface() || d.isInterface()) { return "java/lang/Object"; } else { do { c = c.getSuperclass(); } while (!c.isAssignableFrom(d)); return c.getName().replace('.', '/'); } } /** * Returns the constant pool's hash table item which is equal to the given * item. * * @param key * a constant pool item. * @return the constant pool's hash table item which is equal to the given * item, or null if there is no such item. */ private Item get(final Item key) { Item i = items[key.hashCode % items.length]; while (i != null && (i.type != key.type || !key.isEqualTo(i))) { i = i.next; } return i; } /** * Puts the given item in the constant pool's hash table. The hash table * must not already contains this item. * * @param i * the item to be added to the constant pool's hash table. */ private void put(final Item i) { if (index + typeCount > threshold) { int ll = items.length; int nl = ll * 2 + 1; Item[] newItems = new Item[nl]; for (int l = ll - 1; l >= 0; --l) { Item j = items[l]; while (j != null) { int index = j.hashCode % newItems.length; Item k = j.next; j.next = newItems[index]; newItems[index] = j; j = k; } } items = newItems; threshold = (int) (nl * 0.75); } int index = i.hashCode % items.length; i.next = items[index]; items[index] = i; } /** * Puts one byte and two shorts into the constant pool. * * @param b * a byte. * @param s1 * a short. * @param s2 * another short. */ private void put122(final int b, final int s1, final int s2) { pool.put12(b, s1).putShort(s2); } /** * Puts two bytes and one short into the constant pool. * * @param b1 * a byte. * @param b2 * another byte. * @param s * a short. */ private void put112(final int b1, final int b2, final int s) { pool.put11(b1, b2).putShort(s); } public SourceWriter getSc() { return sc; } } ================================================ FILE: src/jvm/clojure/asm/Context.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * Information about a class being parsed in a {@link ClassReader}. * * @author Eric Bruneton */ class Context { /** * Prototypes of the attributes that must be parsed for this class. */ Attribute[] attrs; /** * The {@link ClassReader} option flags for the parsing of this class. */ int flags; /** * The buffer used to read strings. */ char[] buffer; /** * The start index of each bootstrap method. */ int[] bootstrapMethods; /** * The access flags of the method currently being parsed. */ int access; /** * The name of the method currently being parsed. */ String name; /** * The descriptor of the method currently being parsed. */ String desc; /** * The offset of the latest stack map frame that has been parsed. */ int offset; /** * The encoding of the latest stack map frame that has been parsed. */ int mode; /** * The number of locals in the latest stack map frame that has been parsed. */ int localCount; /** * The number locals in the latest stack map frame that has been parsed, * minus the number of locals in the previous frame. */ int localDiff; /** * The local values of the latest stack map frame that has been parsed. */ Object[] local; /** * The stack size of the latest stack map frame that has been parsed. */ int stackCount; /** * The stack values of the latest stack map frame that has been parsed. */ Object[] stack; } ================================================ FILE: src/jvm/clojure/asm/Edge.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * An edge in the control flow graph of a method body. See {@link Label Label}. * * @author Eric Bruneton */ class Edge { /** * Denotes a normal control flow graph edge. */ static final int NORMAL = 0; /** * Denotes a control flow graph edge corresponding to an exception handler. * More precisely any {@link Edge} whose {@link #info} is strictly positive * corresponds to an exception handler. The actual value of {@link #info} is * the index, in the {@link ClassWriter} type table, of the exception that * is catched. */ static final int EXCEPTION = 0x7FFFFFFF; /** * Information about this control flow graph edge. If * {@link ClassWriter#COMPUTE_MAXS} is used this field is the (relative) * stack size in the basic block from which this edge originates. This size * is equal to the stack size at the "jump" instruction to which this edge * corresponds, relatively to the stack size at the beginning of the * originating basic block. If {@link ClassWriter#COMPUTE_FRAMES} is used, * this field is the kind of this control flow graph edge (i.e. NORMAL or * EXCEPTION). */ int info; /** * The successor block of the basic block from which this edge originates. */ Label successor; /** * The next edge in the list of successors of the originating basic block. * See {@link Label#successors successors}. */ Edge next; } ================================================ FILE: src/jvm/clojure/asm/FieldVisitor.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A visitor to visit a Java field. The methods of this class must be called in * the following order: ( visitAnnotation | visitAttribute )* * visitEnd. * * @author Eric Bruneton */ public abstract class FieldVisitor { /** * The ASM API version implemented by this visitor. The value of this field * must be one of {@link Opcodes#ASM4}. */ protected final int api; /** * The field visitor to which this visitor must delegate method calls. May * be null. */ protected FieldVisitor fv; /** * Constructs a new {@link FieldVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. */ public FieldVisitor(final int api) { this(api, null); } /** * Constructs a new {@link FieldVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. * @param fv * the field visitor to which this visitor must delegate method * calls. May be null. */ public FieldVisitor(final int api, final FieldVisitor fv) { if (api != Opcodes.ASM4) { throw new IllegalArgumentException(); } this.api = api; this.fv = fv; } /** * Visits an annotation of the field. * * @param desc * the class descriptor of the annotation class. * @param visible * true if the annotation is visible at runtime. * @return a visitor to visit the annotation values, or null if * this visitor is not interested in visiting this annotation. */ public AnnotationVisitor visitAnnotation(String desc, boolean visible) { if (fv != null) { return fv.visitAnnotation(desc, visible); } return null; } /** * Visits a non standard attribute of the field. * * @param attr * an attribute. */ public void visitAttribute(Attribute attr) { if (fv != null) { fv.visitAttribute(attr); } } /** * Visits the end of the field. This method, which is the last one to be * called, is used to inform the visitor that all the annotations and * attributes of the field have been visited. */ public void visitEnd() { if (fv != null) { fv.visitEnd(); } } } ================================================ FILE: src/jvm/clojure/asm/FieldWriter.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * An {@link FieldVisitor} that generates Java fields in bytecode form. * * @author Eric Bruneton */ final class FieldWriter extends FieldVisitor { /** * The class writer to which this field must be added. */ private final ClassWriter cw; /** * Access flags of this field. */ private final int access; /** * The index of the constant pool item that contains the name of this * method. */ private final int name; /** * The index of the constant pool item that contains the descriptor of this * field. */ private final int desc; /** * The index of the constant pool item that contains the signature of this * field. */ private int signature; /** * The index of the constant pool item that contains the constant value of * this field. */ private int value; /** * The runtime visible annotations of this field. May be null. */ private AnnotationWriter anns; /** * The runtime invisible annotations of this field. May be null. */ private AnnotationWriter ianns; /** * The non standard attributes of this field. May be null. */ private Attribute attrs; // ------------------------------------------------------------------------ // Constructor // ------------------------------------------------------------------------ /** * Constructs a new {@link FieldWriter}. * * @param cw * the class writer to which this field must be added. * @param access * the field's access flags (see {@link Opcodes}). * @param name * the field's name. * @param desc * the field's descriptor (see {@link Type}). * @param signature * the field's signature. May be null. * @param value * the field's constant value. May be null. */ FieldWriter(final ClassWriter cw, final int access, final String name, final String desc, final String signature, final Object value) { super(Opcodes.ASM4); if (cw.firstField == null) { cw.firstField = this; } else { cw.lastField.fv = this; } cw.lastField = this; this.cw = cw; this.access = access; this.name = cw.newUTF8(name); this.desc = cw.newUTF8(desc); if (ClassReader.SIGNATURES && signature != null) { this.signature = cw.newUTF8(signature); } if (value != null) { this.value = cw.newConstItem(value).index; } } // ------------------------------------------------------------------------ // Implementation of the FieldVisitor abstract class // ------------------------------------------------------------------------ @Override public AnnotationVisitor visitAnnotation(final String desc, final boolean visible) { if (!ClassReader.ANNOTATIONS) { return null; } ByteVector bv = new ByteVector(); // write type, and reserve space for values count bv.putShort(cw.newUTF8(desc)).putShort(0); AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2); if (visible) { aw.next = anns; anns = aw; } else { aw.next = ianns; ianns = aw; } return aw; } @Override public void visitAttribute(final Attribute attr) { attr.next = attrs; attrs = attr; } @Override public void visitEnd() { } // ------------------------------------------------------------------------ // Utility methods // ------------------------------------------------------------------------ /** * Returns the size of this field. * * @return the size of this field. */ int getSize() { int size = 8; if (value != 0) { cw.newUTF8("ConstantValue"); size += 8; } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((cw.version & 0xFFFF) < Opcodes.V1_5 || (access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) != 0) { cw.newUTF8("Synthetic"); size += 6; } } if ((access & Opcodes.ACC_DEPRECATED) != 0) { cw.newUTF8("Deprecated"); size += 6; } if (ClassReader.SIGNATURES && signature != 0) { cw.newUTF8("Signature"); size += 8; } if (ClassReader.ANNOTATIONS && anns != null) { cw.newUTF8("RuntimeVisibleAnnotations"); size += 8 + anns.getSize(); } if (ClassReader.ANNOTATIONS && ianns != null) { cw.newUTF8("RuntimeInvisibleAnnotations"); size += 8 + ianns.getSize(); } if (attrs != null) { size += attrs.getSize(cw, null, 0, -1, -1); } return size; } /** * Puts the content of this field into the given byte vector. * * @param out * where the content of this field must be put. */ void put(final ByteVector out) { final int FACTOR = ClassWriter.TO_ACC_SYNTHETIC; int mask = Opcodes.ACC_DEPRECATED | ClassWriter.ACC_SYNTHETIC_ATTRIBUTE | ((access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) / FACTOR); out.putShort(access & ~mask).putShort(name).putShort(desc); int attributeCount = 0; if (value != 0) { ++attributeCount; } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((cw.version & 0xFFFF) < Opcodes.V1_5 || (access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) != 0) { ++attributeCount; } } if ((access & Opcodes.ACC_DEPRECATED) != 0) { ++attributeCount; } if (ClassReader.SIGNATURES && signature != 0) { ++attributeCount; } if (ClassReader.ANNOTATIONS && anns != null) { ++attributeCount; } if (ClassReader.ANNOTATIONS && ianns != null) { ++attributeCount; } if (attrs != null) { attributeCount += attrs.getCount(); } out.putShort(attributeCount); if (value != 0) { out.putShort(cw.newUTF8("ConstantValue")); out.putInt(2).putShort(value); } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((cw.version & 0xFFFF) < Opcodes.V1_5 || (access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) != 0) { out.putShort(cw.newUTF8("Synthetic")).putInt(0); } } if ((access & Opcodes.ACC_DEPRECATED) != 0) { out.putShort(cw.newUTF8("Deprecated")).putInt(0); } if (ClassReader.SIGNATURES && signature != 0) { out.putShort(cw.newUTF8("Signature")); out.putInt(2).putShort(signature); } if (ClassReader.ANNOTATIONS && anns != null) { out.putShort(cw.newUTF8("RuntimeVisibleAnnotations")); anns.put(out); } if (ClassReader.ANNOTATIONS && ianns != null) { out.putShort(cw.newUTF8("RuntimeInvisibleAnnotations")); ianns.put(out); } if (attrs != null) { attrs.put(cw, null, 0, -1, -1, out); } } } ================================================ FILE: src/jvm/clojure/asm/Frame.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * Information about the input and output stack map frames of a basic block. * * @author Eric Bruneton */ final class Frame { /* * Frames are computed in a two steps process: during the visit of each * instruction, the state of the frame at the end of current basic block is * updated by simulating the action of the instruction on the previous state * of this so called "output frame". In visitMaxs, a fix point algorithm is * used to compute the "input frame" of each basic block, i.e. the stack map * frame at the beginning of the basic block, starting from the input frame * of the first basic block (which is computed from the method descriptor), * and by using the previously computed output frames to compute the input * state of the other blocks. * * All output and input frames are stored as arrays of integers. Reference * and array types are represented by an index into a type table (which is * not the same as the constant pool of the class, in order to avoid adding * unnecessary constants in the pool - not all computed frames will end up * being stored in the stack map table). This allows very fast type * comparisons. * * Output stack map frames are computed relatively to the input frame of the * basic block, which is not yet known when output frames are computed. It * is therefore necessary to be able to represent abstract types such as * "the type at position x in the input frame locals" or "the type at * position x from the top of the input frame stack" or even "the type at * position x in the input frame, with y more (or less) array dimensions". * This explains the rather complicated type format used in output frames. * * This format is the following: DIM KIND VALUE (4, 4 and 24 bits). DIM is a * signed number of array dimensions (from -8 to 7). KIND is either BASE, * LOCAL or STACK. BASE is used for types that are not relative to the input * frame. LOCAL is used for types that are relative to the input local * variable types. STACK is used for types that are relative to the input * stack types. VALUE depends on KIND. For LOCAL types, it is an index in * the input local variable types. For STACK types, it is a position * relatively to the top of input frame stack. For BASE types, it is either * one of the constants defined in FrameVisitor, or for OBJECT and * UNINITIALIZED types, a tag and an index in the type table. * * Output frames can contain types of any kind and with a positive or * negative dimension (and even unassigned types, represented by 0 - which * does not correspond to any valid type value). Input frames can only * contain BASE types of positive or null dimension. In all cases the type * table contains only internal type names (array type descriptors are * forbidden - dimensions must be represented through the DIM field). * * The LONG and DOUBLE types are always represented by using two slots (LONG * + TOP or DOUBLE + TOP), for local variable types as well as in the * operand stack. This is necessary to be able to simulate DUPx_y * instructions, whose effect would be dependent on the actual type values * if types were always represented by a single slot in the stack (and this * is not possible, since actual type values are not always known - cf LOCAL * and STACK type kinds). */ /** * Mask to get the dimension of a frame type. This dimension is a signed * integer between -8 and 7. */ static final int DIM = 0xF0000000; /** * Constant to be added to a type to get a type with one more dimension. */ static final int ARRAY_OF = 0x10000000; /** * Constant to be added to a type to get a type with one less dimension. */ static final int ELEMENT_OF = 0xF0000000; /** * Mask to get the kind of a frame type. * * @see #BASE * @see #LOCAL * @see #STACK */ static final int KIND = 0xF000000; /** * Flag used for LOCAL and STACK types. Indicates that if this type happens * to be a long or double type (during the computations of input frames), * then it must be set to TOP because the second word of this value has been * reused to store other data in the basic block. Hence the first word no * longer stores a valid long or double value. */ static final int TOP_IF_LONG_OR_DOUBLE = 0x800000; /** * Mask to get the value of a frame type. */ static final int VALUE = 0x7FFFFF; /** * Mask to get the kind of base types. */ static final int BASE_KIND = 0xFF00000; /** * Mask to get the value of base types. */ static final int BASE_VALUE = 0xFFFFF; /** * Kind of the types that are not relative to an input stack map frame. */ static final int BASE = 0x1000000; /** * Base kind of the base reference types. The BASE_VALUE of such types is an * index into the type table. */ static final int OBJECT = BASE | 0x700000; /** * Base kind of the uninitialized base types. The BASE_VALUE of such types * in an index into the type table (the Item at that index contains both an * instruction offset and an internal class name). */ static final int UNINITIALIZED = BASE | 0x800000; /** * Kind of the types that are relative to the local variable types of an * input stack map frame. The value of such types is a local variable index. */ private static final int LOCAL = 0x2000000; /** * Kind of the the types that are relative to the stack of an input stack * map frame. The value of such types is a position relatively to the top of * this stack. */ private static final int STACK = 0x3000000; /** * The TOP type. This is a BASE type. */ static final int TOP = BASE | 0; /** * The BOOLEAN type. This is a BASE type mainly used for array types. */ static final int BOOLEAN = BASE | 9; /** * The BYTE type. This is a BASE type mainly used for array types. */ static final int BYTE = BASE | 10; /** * The CHAR type. This is a BASE type mainly used for array types. */ static final int CHAR = BASE | 11; /** * The SHORT type. This is a BASE type mainly used for array types. */ static final int SHORT = BASE | 12; /** * The INTEGER type. This is a BASE type. */ static final int INTEGER = BASE | 1; /** * The FLOAT type. This is a BASE type. */ static final int FLOAT = BASE | 2; /** * The DOUBLE type. This is a BASE type. */ static final int DOUBLE = BASE | 3; /** * The LONG type. This is a BASE type. */ static final int LONG = BASE | 4; /** * The NULL type. This is a BASE type. */ static final int NULL = BASE | 5; /** * The UNINITIALIZED_THIS type. This is a BASE type. */ static final int UNINITIALIZED_THIS = BASE | 6; /** * The stack size variation corresponding to each JVM instruction. This * stack variation is equal to the size of the values produced by an * instruction, minus the size of the values consumed by this instruction. */ static final int[] SIZE; /** * Computes the stack size variation corresponding to each JVM instruction. */ static { int i; int[] b = new int[202]; String s = "EFFFFFFFFGGFFFGGFFFEEFGFGFEEEEEEEEEEEEEEEEEEEEDEDEDDDDD" + "CDCDEEEEEEEEEEEEEEEEEEEEBABABBBBDCFFFGGGEDCDCDCDCDCDCDCDCD" + "CDCEEEEDDDDDDDCDCDCEFEFDDEEFFDEDEEEBDDBBDDDDDDCCCCCCCCEFED" + "DDCDCDEEEEEEEEEEFEEEEEEDDEEDDEE"; for (i = 0; i < b.length; ++i) { b[i] = s.charAt(i) - 'E'; } SIZE = b; // code to generate the above string // // int NA = 0; // not applicable (unused opcode or variable size opcode) // // b = new int[] { // 0, //NOP, // visitInsn // 1, //ACONST_NULL, // - // 1, //ICONST_M1, // - // 1, //ICONST_0, // - // 1, //ICONST_1, // - // 1, //ICONST_2, // - // 1, //ICONST_3, // - // 1, //ICONST_4, // - // 1, //ICONST_5, // - // 2, //LCONST_0, // - // 2, //LCONST_1, // - // 1, //FCONST_0, // - // 1, //FCONST_1, // - // 1, //FCONST_2, // - // 2, //DCONST_0, // - // 2, //DCONST_1, // - // 1, //BIPUSH, // visitIntInsn // 1, //SIPUSH, // - // 1, //LDC, // visitLdcInsn // NA, //LDC_W, // - // NA, //LDC2_W, // - // 1, //ILOAD, // visitVarInsn // 2, //LLOAD, // - // 1, //FLOAD, // - // 2, //DLOAD, // - // 1, //ALOAD, // - // NA, //ILOAD_0, // - // NA, //ILOAD_1, // - // NA, //ILOAD_2, // - // NA, //ILOAD_3, // - // NA, //LLOAD_0, // - // NA, //LLOAD_1, // - // NA, //LLOAD_2, // - // NA, //LLOAD_3, // - // NA, //FLOAD_0, // - // NA, //FLOAD_1, // - // NA, //FLOAD_2, // - // NA, //FLOAD_3, // - // NA, //DLOAD_0, // - // NA, //DLOAD_1, // - // NA, //DLOAD_2, // - // NA, //DLOAD_3, // - // NA, //ALOAD_0, // - // NA, //ALOAD_1, // - // NA, //ALOAD_2, // - // NA, //ALOAD_3, // - // -1, //IALOAD, // visitInsn // 0, //LALOAD, // - // -1, //FALOAD, // - // 0, //DALOAD, // - // -1, //AALOAD, // - // -1, //BALOAD, // - // -1, //CALOAD, // - // -1, //SALOAD, // - // -1, //ISTORE, // visitVarInsn // -2, //LSTORE, // - // -1, //FSTORE, // - // -2, //DSTORE, // - // -1, //ASTORE, // - // NA, //ISTORE_0, // - // NA, //ISTORE_1, // - // NA, //ISTORE_2, // - // NA, //ISTORE_3, // - // NA, //LSTORE_0, // - // NA, //LSTORE_1, // - // NA, //LSTORE_2, // - // NA, //LSTORE_3, // - // NA, //FSTORE_0, // - // NA, //FSTORE_1, // - // NA, //FSTORE_2, // - // NA, //FSTORE_3, // - // NA, //DSTORE_0, // - // NA, //DSTORE_1, // - // NA, //DSTORE_2, // - // NA, //DSTORE_3, // - // NA, //ASTORE_0, // - // NA, //ASTORE_1, // - // NA, //ASTORE_2, // - // NA, //ASTORE_3, // - // -3, //IASTORE, // visitInsn // -4, //LASTORE, // - // -3, //FASTORE, // - // -4, //DASTORE, // - // -3, //AASTORE, // - // -3, //BASTORE, // - // -3, //CASTORE, // - // -3, //SASTORE, // - // -1, //POP, // - // -2, //POP2, // - // 1, //DUP, // - // 1, //DUP_X1, // - // 1, //DUP_X2, // - // 2, //DUP2, // - // 2, //DUP2_X1, // - // 2, //DUP2_X2, // - // 0, //SWAP, // - // -1, //IADD, // - // -2, //LADD, // - // -1, //FADD, // - // -2, //DADD, // - // -1, //ISUB, // - // -2, //LSUB, // - // -1, //FSUB, // - // -2, //DSUB, // - // -1, //IMUL, // - // -2, //LMUL, // - // -1, //FMUL, // - // -2, //DMUL, // - // -1, //IDIV, // - // -2, //LDIV, // - // -1, //FDIV, // - // -2, //DDIV, // - // -1, //IREM, // - // -2, //LREM, // - // -1, //FREM, // - // -2, //DREM, // - // 0, //INEG, // - // 0, //LNEG, // - // 0, //FNEG, // - // 0, //DNEG, // - // -1, //ISHL, // - // -1, //LSHL, // - // -1, //ISHR, // - // -1, //LSHR, // - // -1, //IUSHR, // - // -1, //LUSHR, // - // -1, //IAND, // - // -2, //LAND, // - // -1, //IOR, // - // -2, //LOR, // - // -1, //IXOR, // - // -2, //LXOR, // - // 0, //IINC, // visitIincInsn // 1, //I2L, // visitInsn // 0, //I2F, // - // 1, //I2D, // - // -1, //L2I, // - // -1, //L2F, // - // 0, //L2D, // - // 0, //F2I, // - // 1, //F2L, // - // 1, //F2D, // - // -1, //D2I, // - // 0, //D2L, // - // -1, //D2F, // - // 0, //I2B, // - // 0, //I2C, // - // 0, //I2S, // - // -3, //LCMP, // - // -1, //FCMPL, // - // -1, //FCMPG, // - // -3, //DCMPL, // - // -3, //DCMPG, // - // -1, //IFEQ, // visitJumpInsn // -1, //IFNE, // - // -1, //IFLT, // - // -1, //IFGE, // - // -1, //IFGT, // - // -1, //IFLE, // - // -2, //IF_ICMPEQ, // - // -2, //IF_ICMPNE, // - // -2, //IF_ICMPLT, // - // -2, //IF_ICMPGE, // - // -2, //IF_ICMPGT, // - // -2, //IF_ICMPLE, // - // -2, //IF_ACMPEQ, // - // -2, //IF_ACMPNE, // - // 0, //GOTO, // - // 1, //JSR, // - // 0, //RET, // visitVarInsn // -1, //TABLESWITCH, // visiTableSwitchInsn // -1, //LOOKUPSWITCH, // visitLookupSwitch // -1, //IRETURN, // visitInsn // -2, //LRETURN, // - // -1, //FRETURN, // - // -2, //DRETURN, // - // -1, //ARETURN, // - // 0, //RETURN, // - // NA, //GETSTATIC, // visitFieldInsn // NA, //PUTSTATIC, // - // NA, //GETFIELD, // - // NA, //PUTFIELD, // - // NA, //INVOKEVIRTUAL, // visitMethodInsn // NA, //INVOKESPECIAL, // - // NA, //INVOKESTATIC, // - // NA, //INVOKEINTERFACE, // - // NA, //INVOKEDYNAMIC, // visitInvokeDynamicInsn // 1, //NEW, // visitTypeInsn // 0, //NEWARRAY, // visitIntInsn // 0, //ANEWARRAY, // visitTypeInsn // 0, //ARRAYLENGTH, // visitInsn // NA, //ATHROW, // - // 0, //CHECKCAST, // visitTypeInsn // 0, //INSTANCEOF, // - // -1, //MONITORENTER, // visitInsn // -1, //MONITOREXIT, // - // NA, //WIDE, // NOT VISITED // NA, //MULTIANEWARRAY, // visitMultiANewArrayInsn // -1, //IFNULL, // visitJumpInsn // -1, //IFNONNULL, // - // NA, //GOTO_W, // - // NA, //JSR_W, // - // }; // for (i = 0; i < b.length; ++i) { // System.err.print((char)('E' + b[i])); // } // System.err.println(); } /** * The label (i.e. basic block) to which these input and output stack map * frames correspond. */ Label owner; /** * The input stack map frame locals. */ int[] inputLocals; /** * The input stack map frame stack. */ int[] inputStack; /** * The output stack map frame locals. */ private int[] outputLocals; /** * The output stack map frame stack. */ private int[] outputStack; /** * Relative size of the output stack. The exact semantics of this field * depends on the algorithm that is used. * * When only the maximum stack size is computed, this field is the size of * the output stack relatively to the top of the input stack. * * When the stack map frames are completely computed, this field is the * actual number of types in {@link #outputStack}. */ private int outputStackTop; /** * Number of types that are initialized in the basic block. * * @see #initializations */ private int initializationCount; /** * The types that are initialized in the basic block. A constructor * invocation on an UNINITIALIZED or UNINITIALIZED_THIS type must replace * every occurence of this type in the local variables and in the * operand stack. This cannot be done during the first phase of the * algorithm since, during this phase, the local variables and the operand * stack are not completely computed. It is therefore necessary to store the * types on which constructors are invoked in the basic block, in order to * do this replacement during the second phase of the algorithm, where the * frames are fully computed. Note that this array can contain types that * are relative to input locals or to the input stack (see below for the * description of the algorithm). */ private int[] initializations; /** * Returns the output frame local variable type at the given index. * * @param local * the index of the local that must be returned. * @return the output frame local variable type at the given index. */ private int get(final int local) { if (outputLocals == null || local >= outputLocals.length) { // this local has never been assigned in this basic block, // so it is still equal to its value in the input frame return LOCAL | local; } else { int type = outputLocals[local]; if (type == 0) { // this local has never been assigned in this basic block, // so it is still equal to its value in the input frame type = outputLocals[local] = LOCAL | local; } return type; } } /** * Sets the output frame local variable type at the given index. * * @param local * the index of the local that must be set. * @param type * the value of the local that must be set. */ private void set(final int local, final int type) { // creates and/or resizes the output local variables array if necessary if (outputLocals == null) { outputLocals = new int[10]; } int n = outputLocals.length; if (local >= n) { int[] t = new int[Math.max(local + 1, 2 * n)]; System.arraycopy(outputLocals, 0, t, 0, n); outputLocals = t; } // sets the local variable outputLocals[local] = type; } /** * Pushes a new type onto the output frame stack. * * @param type * the type that must be pushed. */ private void push(final int type) { // creates and/or resizes the output stack array if necessary if (outputStack == null) { outputStack = new int[10]; } int n = outputStack.length; if (outputStackTop >= n) { int[] t = new int[Math.max(outputStackTop + 1, 2 * n)]; System.arraycopy(outputStack, 0, t, 0, n); outputStack = t; } // pushes the type on the output stack outputStack[outputStackTop++] = type; // updates the maximun height reached by the output stack, if needed int top = owner.inputStackTop + outputStackTop; if (top > owner.outputStackMax) { owner.outputStackMax = top; } } /** * Pushes a new type onto the output frame stack. * * @param cw * the ClassWriter to which this label belongs. * @param desc * the descriptor of the type to be pushed. Can also be a method * descriptor (in this case this method pushes its return type * onto the output frame stack). */ private void push(final ClassWriter cw, final String desc) { int type = type(cw, desc); if (type != 0) { push(type); if (type == LONG || type == DOUBLE) { push(TOP); } } } /** * Returns the int encoding of the given type. * * @param cw * the ClassWriter to which this label belongs. * @param desc * a type descriptor. * @return the int encoding of the given type. */ private static int type(final ClassWriter cw, final String desc) { String t; int index = desc.charAt(0) == '(' ? desc.indexOf(')') + 1 : 0; switch (desc.charAt(index)) { case 'V': return 0; case 'Z': case 'C': case 'B': case 'S': case 'I': return INTEGER; case 'F': return FLOAT; case 'J': return LONG; case 'D': return DOUBLE; case 'L': // stores the internal name, not the descriptor! t = desc.substring(index + 1, desc.length() - 1); return OBJECT | cw.addType(t); // case '[': default: // extracts the dimensions and the element type int data; int dims = index + 1; while (desc.charAt(dims) == '[') { ++dims; } switch (desc.charAt(dims)) { case 'Z': data = BOOLEAN; break; case 'C': data = CHAR; break; case 'B': data = BYTE; break; case 'S': data = SHORT; break; case 'I': data = INTEGER; break; case 'F': data = FLOAT; break; case 'J': data = LONG; break; case 'D': data = DOUBLE; break; // case 'L': default: // stores the internal name, not the descriptor t = desc.substring(dims + 1, desc.length() - 1); data = OBJECT | cw.addType(t); } return (dims - index) << 28 | data; } } /** * Pops a type from the output frame stack and returns its value. * * @return the type that has been popped from the output frame stack. */ private int pop() { if (outputStackTop > 0) { return outputStack[--outputStackTop]; } else { // if the output frame stack is empty, pops from the input stack return STACK | -(--owner.inputStackTop); } } /** * Pops the given number of types from the output frame stack. * * @param elements * the number of types that must be popped. */ private void pop(final int elements) { if (outputStackTop >= elements) { outputStackTop -= elements; } else { // if the number of elements to be popped is greater than the number // of elements in the output stack, clear it, and pops the remaining // elements from the input stack. owner.inputStackTop -= elements - outputStackTop; outputStackTop = 0; } } /** * Pops a type from the output frame stack. * * @param desc * the descriptor of the type to be popped. Can also be a method * descriptor (in this case this method pops the types * corresponding to the method arguments). */ private void pop(final String desc) { char c = desc.charAt(0); if (c == '(') { pop((Type.getArgumentsAndReturnSizes(desc) >> 2) - 1); } else if (c == 'J' || c == 'D') { pop(2); } else { pop(1); } } /** * Adds a new type to the list of types on which a constructor is invoked in * the basic block. * * @param var * a type on a which a constructor is invoked. */ private void init(final int var) { // creates and/or resizes the initializations array if necessary if (initializations == null) { initializations = new int[2]; } int n = initializations.length; if (initializationCount >= n) { int[] t = new int[Math.max(initializationCount + 1, 2 * n)]; System.arraycopy(initializations, 0, t, 0, n); initializations = t; } // stores the type to be initialized initializations[initializationCount++] = var; } /** * Replaces the given type with the appropriate type if it is one of the * types on which a constructor is invoked in the basic block. * * @param cw * the ClassWriter to which this label belongs. * @param t * a type * @return t or, if t is one of the types on which a constructor is invoked * in the basic block, the type corresponding to this constructor. */ private int init(final ClassWriter cw, final int t) { int s; if (t == UNINITIALIZED_THIS) { s = OBJECT | cw.addType(cw.thisName); } else if ((t & (DIM | BASE_KIND)) == UNINITIALIZED) { String type = cw.typeTable[t & BASE_VALUE].strVal1; s = OBJECT | cw.addType(type); } else { return t; } for (int j = 0; j < initializationCount; ++j) { int u = initializations[j]; int dim = u & DIM; int kind = u & KIND; if (kind == LOCAL) { u = dim + inputLocals[u & VALUE]; } else if (kind == STACK) { u = dim + inputStack[inputStack.length - (u & VALUE)]; } if (t == u) { return s; } } return t; } /** * Initializes the input frame of the first basic block from the method * descriptor. * * @param cw * the ClassWriter to which this label belongs. * @param access * the access flags of the method to which this label belongs. * @param args * the formal parameter types of this method. * @param maxLocals * the maximum number of local variables of this method. */ void initInputFrame(final ClassWriter cw, final int access, final Type[] args, final int maxLocals) { inputLocals = new int[maxLocals]; inputStack = new int[0]; int i = 0; if ((access & Opcodes.ACC_STATIC) == 0) { if ((access & MethodWriter.ACC_CONSTRUCTOR) == 0) { inputLocals[i++] = OBJECT | cw.addType(cw.thisName); } else { inputLocals[i++] = UNINITIALIZED_THIS; } } for (int j = 0; j < args.length; ++j) { int t = type(cw, args[j].getDescriptor()); inputLocals[i++] = t; if (t == LONG || t == DOUBLE) { inputLocals[i++] = TOP; } } while (i < maxLocals) { inputLocals[i++] = TOP; } } /** * Simulates the action of the given instruction on the output stack frame. * * @param opcode * the opcode of the instruction. * @param arg * the operand of the instruction, if any. * @param cw * the class writer to which this label belongs. * @param item * the operand of the instructions, if any. */ void execute(final int opcode, final int arg, final ClassWriter cw, final Item item) { int t1, t2, t3, t4; switch (opcode) { case Opcodes.NOP: case Opcodes.INEG: case Opcodes.LNEG: case Opcodes.FNEG: case Opcodes.DNEG: case Opcodes.I2B: case Opcodes.I2C: case Opcodes.I2S: case Opcodes.GOTO: case Opcodes.RETURN: break; case Opcodes.ACONST_NULL: push(NULL); break; case Opcodes.ICONST_M1: case Opcodes.ICONST_0: case Opcodes.ICONST_1: case Opcodes.ICONST_2: case Opcodes.ICONST_3: case Opcodes.ICONST_4: case Opcodes.ICONST_5: case Opcodes.BIPUSH: case Opcodes.SIPUSH: case Opcodes.ILOAD: push(INTEGER); break; case Opcodes.LCONST_0: case Opcodes.LCONST_1: case Opcodes.LLOAD: push(LONG); push(TOP); break; case Opcodes.FCONST_0: case Opcodes.FCONST_1: case Opcodes.FCONST_2: case Opcodes.FLOAD: push(FLOAT); break; case Opcodes.DCONST_0: case Opcodes.DCONST_1: case Opcodes.DLOAD: push(DOUBLE); push(TOP); break; case Opcodes.LDC: switch (item.type) { case ClassWriter.INT: push(INTEGER); break; case ClassWriter.LONG: push(LONG); push(TOP); break; case ClassWriter.FLOAT: push(FLOAT); break; case ClassWriter.DOUBLE: push(DOUBLE); push(TOP); break; case ClassWriter.CLASS: push(OBJECT | cw.addType("java/lang/Class")); break; case ClassWriter.STR: push(OBJECT | cw.addType("java/lang/String")); break; case ClassWriter.MTYPE: push(OBJECT | cw.addType("java/lang/invoke/MethodType")); break; // case ClassWriter.HANDLE_BASE + [1..9]: default: push(OBJECT | cw.addType("java/lang/invoke/MethodHandle")); } break; case Opcodes.ALOAD: push(get(arg)); break; case Opcodes.IALOAD: case Opcodes.BALOAD: case Opcodes.CALOAD: case Opcodes.SALOAD: pop(2); push(INTEGER); break; case Opcodes.LALOAD: case Opcodes.D2L: pop(2); push(LONG); push(TOP); break; case Opcodes.FALOAD: pop(2); push(FLOAT); break; case Opcodes.DALOAD: case Opcodes.L2D: pop(2); push(DOUBLE); push(TOP); break; case Opcodes.AALOAD: pop(1); t1 = pop(); push(ELEMENT_OF + t1); break; case Opcodes.ISTORE: case Opcodes.FSTORE: case Opcodes.ASTORE: t1 = pop(); set(arg, t1); if (arg > 0) { t2 = get(arg - 1); // if t2 is of kind STACK or LOCAL we cannot know its size! if (t2 == LONG || t2 == DOUBLE) { set(arg - 1, TOP); } else if ((t2 & KIND) != BASE) { set(arg - 1, t2 | TOP_IF_LONG_OR_DOUBLE); } } break; case Opcodes.LSTORE: case Opcodes.DSTORE: pop(1); t1 = pop(); set(arg, t1); set(arg + 1, TOP); if (arg > 0) { t2 = get(arg - 1); // if t2 is of kind STACK or LOCAL we cannot know its size! if (t2 == LONG || t2 == DOUBLE) { set(arg - 1, TOP); } else if ((t2 & KIND) != BASE) { set(arg - 1, t2 | TOP_IF_LONG_OR_DOUBLE); } } break; case Opcodes.IASTORE: case Opcodes.BASTORE: case Opcodes.CASTORE: case Opcodes.SASTORE: case Opcodes.FASTORE: case Opcodes.AASTORE: pop(3); break; case Opcodes.LASTORE: case Opcodes.DASTORE: pop(4); break; case Opcodes.POP: case Opcodes.IFEQ: case Opcodes.IFNE: case Opcodes.IFLT: case Opcodes.IFGE: case Opcodes.IFGT: case Opcodes.IFLE: case Opcodes.IRETURN: case Opcodes.FRETURN: case Opcodes.ARETURN: case Opcodes.TABLESWITCH: case Opcodes.LOOKUPSWITCH: case Opcodes.ATHROW: case Opcodes.MONITORENTER: case Opcodes.MONITOREXIT: case Opcodes.IFNULL: case Opcodes.IFNONNULL: pop(1); break; case Opcodes.POP2: case Opcodes.IF_ICMPEQ: case Opcodes.IF_ICMPNE: case Opcodes.IF_ICMPLT: case Opcodes.IF_ICMPGE: case Opcodes.IF_ICMPGT: case Opcodes.IF_ICMPLE: case Opcodes.IF_ACMPEQ: case Opcodes.IF_ACMPNE: case Opcodes.LRETURN: case Opcodes.DRETURN: pop(2); break; case Opcodes.DUP: t1 = pop(); push(t1); push(t1); break; case Opcodes.DUP_X1: t1 = pop(); t2 = pop(); push(t1); push(t2); push(t1); break; case Opcodes.DUP_X2: t1 = pop(); t2 = pop(); t3 = pop(); push(t1); push(t3); push(t2); push(t1); break; case Opcodes.DUP2: t1 = pop(); t2 = pop(); push(t2); push(t1); push(t2); push(t1); break; case Opcodes.DUP2_X1: t1 = pop(); t2 = pop(); t3 = pop(); push(t2); push(t1); push(t3); push(t2); push(t1); break; case Opcodes.DUP2_X2: t1 = pop(); t2 = pop(); t3 = pop(); t4 = pop(); push(t2); push(t1); push(t4); push(t3); push(t2); push(t1); break; case Opcodes.SWAP: t1 = pop(); t2 = pop(); push(t1); push(t2); break; case Opcodes.IADD: case Opcodes.ISUB: case Opcodes.IMUL: case Opcodes.IDIV: case Opcodes.IREM: case Opcodes.IAND: case Opcodes.IOR: case Opcodes.IXOR: case Opcodes.ISHL: case Opcodes.ISHR: case Opcodes.IUSHR: case Opcodes.L2I: case Opcodes.D2I: case Opcodes.FCMPL: case Opcodes.FCMPG: pop(2); push(INTEGER); break; case Opcodes.LADD: case Opcodes.LSUB: case Opcodes.LMUL: case Opcodes.LDIV: case Opcodes.LREM: case Opcodes.LAND: case Opcodes.LOR: case Opcodes.LXOR: pop(4); push(LONG); push(TOP); break; case Opcodes.FADD: case Opcodes.FSUB: case Opcodes.FMUL: case Opcodes.FDIV: case Opcodes.FREM: case Opcodes.L2F: case Opcodes.D2F: pop(2); push(FLOAT); break; case Opcodes.DADD: case Opcodes.DSUB: case Opcodes.DMUL: case Opcodes.DDIV: case Opcodes.DREM: pop(4); push(DOUBLE); push(TOP); break; case Opcodes.LSHL: case Opcodes.LSHR: case Opcodes.LUSHR: pop(3); push(LONG); push(TOP); break; case Opcodes.IINC: set(arg, INTEGER); break; case Opcodes.I2L: case Opcodes.F2L: pop(1); push(LONG); push(TOP); break; case Opcodes.I2F: pop(1); push(FLOAT); break; case Opcodes.I2D: case Opcodes.F2D: pop(1); push(DOUBLE); push(TOP); break; case Opcodes.F2I: case Opcodes.ARRAYLENGTH: case Opcodes.INSTANCEOF: pop(1); push(INTEGER); break; case Opcodes.LCMP: case Opcodes.DCMPL: case Opcodes.DCMPG: pop(4); push(INTEGER); break; case Opcodes.JSR: case Opcodes.RET: throw new RuntimeException( "JSR/RET are not supported with computeFrames option"); case Opcodes.GETSTATIC: push(cw, item.strVal3); break; case Opcodes.PUTSTATIC: pop(item.strVal3); break; case Opcodes.GETFIELD: pop(1); push(cw, item.strVal3); break; case Opcodes.PUTFIELD: pop(item.strVal3); pop(); break; case Opcodes.INVOKEVIRTUAL: case Opcodes.INVOKESPECIAL: case Opcodes.INVOKESTATIC: case Opcodes.INVOKEINTERFACE: pop(item.strVal3); if (opcode != Opcodes.INVOKESTATIC) { t1 = pop(); if (opcode == Opcodes.INVOKESPECIAL && item.strVal2.charAt(0) == '<') { init(t1); } } push(cw, item.strVal3); break; case Opcodes.INVOKEDYNAMIC: pop(item.strVal2); push(cw, item.strVal2); break; case Opcodes.NEW: push(UNINITIALIZED | cw.addUninitializedType(item.strVal1, arg)); break; case Opcodes.NEWARRAY: pop(); switch (arg) { case Opcodes.T_BOOLEAN: push(ARRAY_OF | BOOLEAN); break; case Opcodes.T_CHAR: push(ARRAY_OF | CHAR); break; case Opcodes.T_BYTE: push(ARRAY_OF | BYTE); break; case Opcodes.T_SHORT: push(ARRAY_OF | SHORT); break; case Opcodes.T_INT: push(ARRAY_OF | INTEGER); break; case Opcodes.T_FLOAT: push(ARRAY_OF | FLOAT); break; case Opcodes.T_DOUBLE: push(ARRAY_OF | DOUBLE); break; // case Opcodes.T_LONG: default: push(ARRAY_OF | LONG); break; } break; case Opcodes.ANEWARRAY: String s = item.strVal1; pop(); if (s.charAt(0) == '[') { push(cw, '[' + s); } else { push(ARRAY_OF | OBJECT | cw.addType(s)); } break; case Opcodes.CHECKCAST: s = item.strVal1; pop(); if (s.charAt(0) == '[') { push(cw, s); } else { push(OBJECT | cw.addType(s)); } break; // case Opcodes.MULTIANEWARRAY: default: pop(arg); push(cw, item.strVal1); break; } } /** * Merges the input frame of the given basic block with the input and output * frames of this basic block. Returns true if the input frame of * the given label has been changed by this operation. * * @param cw * the ClassWriter to which this label belongs. * @param frame * the basic block whose input frame must be updated. * @param edge * the kind of the {@link Edge} between this label and 'label'. * See {@link Edge#info}. * @return true if the input frame of the given label has been * changed by this operation. */ boolean merge(final ClassWriter cw, final Frame frame, final int edge) { boolean changed = false; int i, s, dim, kind, t; int nLocal = inputLocals.length; int nStack = inputStack.length; if (frame.inputLocals == null) { frame.inputLocals = new int[nLocal]; changed = true; } for (i = 0; i < nLocal; ++i) { if (outputLocals != null && i < outputLocals.length) { s = outputLocals[i]; if (s == 0) { t = inputLocals[i]; } else { dim = s & DIM; kind = s & KIND; if (kind == BASE) { t = s; } else { if (kind == LOCAL) { t = dim + inputLocals[s & VALUE]; } else { t = dim + inputStack[nStack - (s & VALUE)]; } if ((s & TOP_IF_LONG_OR_DOUBLE) != 0 && (t == LONG || t == DOUBLE)) { t = TOP; } } } } else { t = inputLocals[i]; } if (initializations != null) { t = init(cw, t); } changed |= merge(cw, t, frame.inputLocals, i); } if (edge > 0) { for (i = 0; i < nLocal; ++i) { t = inputLocals[i]; changed |= merge(cw, t, frame.inputLocals, i); } if (frame.inputStack == null) { frame.inputStack = new int[1]; changed = true; } changed |= merge(cw, edge, frame.inputStack, 0); return changed; } int nInputStack = inputStack.length + owner.inputStackTop; if (frame.inputStack == null) { frame.inputStack = new int[nInputStack + outputStackTop]; changed = true; } for (i = 0; i < nInputStack; ++i) { t = inputStack[i]; if (initializations != null) { t = init(cw, t); } changed |= merge(cw, t, frame.inputStack, i); } for (i = 0; i < outputStackTop; ++i) { s = outputStack[i]; dim = s & DIM; kind = s & KIND; if (kind == BASE) { t = s; } else { if (kind == LOCAL) { t = dim + inputLocals[s & VALUE]; } else { t = dim + inputStack[nStack - (s & VALUE)]; } if ((s & TOP_IF_LONG_OR_DOUBLE) != 0 && (t == LONG || t == DOUBLE)) { t = TOP; } } if (initializations != null) { t = init(cw, t); } changed |= merge(cw, t, frame.inputStack, nInputStack + i); } return changed; } /** * Merges the type at the given index in the given type array with the given * type. Returns true if the type array has been modified by this * operation. * * @param cw * the ClassWriter to which this label belongs. * @param t * the type with which the type array element must be merged. * @param types * an array of types. * @param index * the index of the type that must be merged in 'types'. * @return true if the type array has been modified by this * operation. */ private static boolean merge(final ClassWriter cw, int t, final int[] types, final int index) { int u = types[index]; if (u == t) { // if the types are equal, merge(u,t)=u, so there is no change return false; } if ((t & ~DIM) == NULL) { if (u == NULL) { return false; } t = NULL; } if (u == 0) { // if types[index] has never been assigned, merge(u,t)=t types[index] = t; return true; } int v; if ((u & BASE_KIND) == OBJECT || (u & DIM) != 0) { // if u is a reference type of any dimension if (t == NULL) { // if t is the NULL type, merge(u,t)=u, so there is no change return false; } else if ((t & (DIM | BASE_KIND)) == (u & (DIM | BASE_KIND))) { if ((u & BASE_KIND) == OBJECT) { // if t is also a reference type, and if u and t have the // same dimension merge(u,t) = dim(t) | common parent of the // element types of u and t v = (t & DIM) | OBJECT | cw.getMergedType(t & BASE_VALUE, u & BASE_VALUE); } else { // if u and t are array types, but not with the same element // type, merge(u,t)=java/lang/Object v = OBJECT | cw.addType("java/lang/Object"); } } else if ((t & BASE_KIND) == OBJECT || (t & DIM) != 0) { // if t is any other reference or array type, // merge(u,t)=java/lang/Object v = OBJECT | cw.addType("java/lang/Object"); } else { // if t is any other type, merge(u,t)=TOP v = TOP; } } else if (u == NULL) { // if u is the NULL type, merge(u,t)=t, // or TOP if t is not a reference type v = (t & BASE_KIND) == OBJECT || (t & DIM) != 0 ? t : TOP; } else { // if u is any other type, merge(u,t)=TOP whatever t v = TOP; } if (u != v) { types[index] = v; return true; } return false; } } ================================================ FILE: src/jvm/clojure/asm/Handle.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A reference to a field or a method. * * @author Remi Forax * @author Eric Bruneton */ public final class Handle { /** * The kind of field or method designated by this Handle. Should be * {@link Opcodes#H_GETFIELD}, {@link Opcodes#H_GETSTATIC}, * {@link Opcodes#H_PUTFIELD}, {@link Opcodes#H_PUTSTATIC}, * {@link Opcodes#H_INVOKEVIRTUAL}, {@link Opcodes#H_INVOKESTATIC}, * {@link Opcodes#H_INVOKESPECIAL}, {@link Opcodes#H_NEWINVOKESPECIAL} or * {@link Opcodes#H_INVOKEINTERFACE}. */ final int tag; /** * The internal name of the field or method designed by this handle. */ final String owner; /** * The name of the field or method designated by this handle. */ final String name; /** * The descriptor of the field or method designated by this handle. */ final String desc; /** * Constructs a new field or method handle. * * @param tag * the kind of field or method designated by this Handle. Must be * {@link Opcodes#H_GETFIELD}, {@link Opcodes#H_GETSTATIC}, * {@link Opcodes#H_PUTFIELD}, {@link Opcodes#H_PUTSTATIC}, * {@link Opcodes#H_INVOKEVIRTUAL}, * {@link Opcodes#H_INVOKESTATIC}, * {@link Opcodes#H_INVOKESPECIAL}, * {@link Opcodes#H_NEWINVOKESPECIAL} or * {@link Opcodes#H_INVOKEINTERFACE}. * @param owner * the internal name of the field or method designed by this * handle. * @param name * the name of the field or method designated by this handle. * @param desc * the descriptor of the field or method designated by this * handle. */ public Handle(int tag, String owner, String name, String desc) { this.tag = tag; this.owner = owner; this.name = name; this.desc = desc; } /** * Returns the kind of field or method designated by this handle. * * @return {@link Opcodes#H_GETFIELD}, {@link Opcodes#H_GETSTATIC}, * {@link Opcodes#H_PUTFIELD}, {@link Opcodes#H_PUTSTATIC}, * {@link Opcodes#H_INVOKEVIRTUAL}, {@link Opcodes#H_INVOKESTATIC}, * {@link Opcodes#H_INVOKESPECIAL}, * {@link Opcodes#H_NEWINVOKESPECIAL} or * {@link Opcodes#H_INVOKEINTERFACE}. */ public int getTag() { return tag; } /** * Returns the internal name of the field or method designed by this handle. * * @return the internal name of the field or method designed by this handle. */ public String getOwner() { return owner; } /** * Returns the name of the field or method designated by this handle. * * @return the name of the field or method designated by this handle. */ public String getName() { return name; } /** * Returns the descriptor of the field or method designated by this handle. * * @return the descriptor of the field or method designated by this handle. */ public String getDesc() { return desc; } @Override public boolean equals(Object obj) { if (obj == this) { return true; } if (!(obj instanceof Handle)) { return false; } Handle h = (Handle) obj; return tag == h.tag && owner.equals(h.owner) && name.equals(h.name) && desc.equals(h.desc); } @Override public int hashCode() { return tag + owner.hashCode() * name.hashCode() * desc.hashCode(); } /** * Returns the textual representation of this handle. The textual * representation is: * * 
     * owner '.' name desc ' ' '(' tag ')'
     *
* * . As this format is unambiguous, it can be parsed if necessary. */ @Override public String toString() { return owner + '.' + name + desc + " (" + tag + ')'; } } ================================================ FILE: src/jvm/clojure/asm/Handler.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * Information about an exception handler block. * * @author Eric Bruneton */ class Handler { /** * Beginning of the exception handler's scope (inclusive). */ Label start; /** * End of the exception handler's scope (exclusive). */ Label end; /** * Beginning of the exception handler's code. */ Label handler; /** * Internal name of the type of exceptions handled by this handler, or * null to catch any exceptions. */ String desc; /** * Constant pool index of the internal name of the type of exceptions * handled by this handler, or 0 to catch any exceptions. */ int type; /** * Next exception handler block info. */ Handler next; /** * Removes the range between start and end from the given exception * handlers. * * @param h * an exception handler list. * @param start * the start of the range to be removed. * @param end * the end of the range to be removed. Maybe null. * @return the exception handler list with the start-end range removed. */ static Handler remove(Handler h, Label start, Label end) { if (h == null) { return null; } else { h.next = remove(h.next, start, end); } int hstart = h.start.position; int hend = h.end.position; int s = start.position; int e = end == null ? Integer.MAX_VALUE : end.position; // if [hstart,hend[ and [s,e[ intervals intersect... if (s < hend && e > hstart) { if (s <= hstart) { if (e >= hend) { // [hstart,hend[ fully included in [s,e[, h removed h = h.next; } else { // [hstart,hend[ minus [s,e[ = [e,hend[ h.start = end; } } else if (e >= hend) { // [hstart,hend[ minus [s,e[ = [hstart,s[ h.end = start; } else { // [hstart,hend[ minus [s,e[ = [hstart,s[ + [e,hend[ Handler g = new Handler(); g.start = end; g.end = h.end; g.handler = h.handler; g.desc = h.desc; g.type = h.type; g.next = h.next; h.end = start; h.next = g; } } return h; } } ================================================ FILE: src/jvm/clojure/asm/Item.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A constant pool item. Constant pool items can be created with the 'newXXX' * methods in the {@link ClassWriter} class. * * @author Eric Bruneton */ final class Item { /** * Index of this item in the constant pool. */ int index; /** * Type of this constant pool item. A single class is used to represent all * constant pool item types, in order to minimize the bytecode size of this * package. The value of this field is one of {@link ClassWriter#INT}, * {@link ClassWriter#LONG}, {@link ClassWriter#FLOAT}, * {@link ClassWriter#DOUBLE}, {@link ClassWriter#UTF8}, * {@link ClassWriter#STR}, {@link ClassWriter#CLASS}, * {@link ClassWriter#NAME_TYPE}, {@link ClassWriter#FIELD}, * {@link ClassWriter#METH}, {@link ClassWriter#IMETH}, * {@link ClassWriter#MTYPE}, {@link ClassWriter#INDY}. * * MethodHandle constant 9 variations are stored using a range of 9 values * from {@link ClassWriter#HANDLE_BASE} + 1 to * {@link ClassWriter#HANDLE_BASE} + 9. * * Special Item types are used for Items that are stored in the ClassWriter * {@link ClassWriter#typeTable}, instead of the constant pool, in order to * avoid clashes with normal constant pool items in the ClassWriter constant * pool's hash table. These special item types are * {@link ClassWriter#TYPE_NORMAL}, {@link ClassWriter#TYPE_UNINIT} and * {@link ClassWriter#TYPE_MERGED}. */ int type; /** * Value of this item, for an integer item. */ int intVal; /** * Value of this item, for a long item. */ long longVal; /** * First part of the value of this item, for items that do not hold a * primitive value. */ String strVal1; /** * Second part of the value of this item, for items that do not hold a * primitive value. */ String strVal2; /** * Third part of the value of this item, for items that do not hold a * primitive value. */ String strVal3; /** * The hash code value of this constant pool item. */ int hashCode; /** * Link to another constant pool item, used for collision lists in the * constant pool's hash table. */ Item next; /** * Constructs an uninitialized {@link Item}. */ Item() { } /** * Constructs an uninitialized {@link Item} for constant pool element at * given position. * * @param index * index of the item to be constructed. */ Item(final int index) { this.index = index; } /** * Constructs a copy of the given item. * * @param index * index of the item to be constructed. * @param i * the item that must be copied into the item to be constructed. */ Item(final int index, final Item i) { this.index = index; type = i.type; intVal = i.intVal; longVal = i.longVal; strVal1 = i.strVal1; strVal2 = i.strVal2; strVal3 = i.strVal3; hashCode = i.hashCode; } /** * Sets this item to an integer item. * * @param intVal * the value of this item. */ void set(final int intVal) { this.type = ClassWriter.INT; this.intVal = intVal; this.hashCode = 0x7FFFFFFF & (type + intVal); } /** * Sets this item to a long item. * * @param longVal * the value of this item. */ void set(final long longVal) { this.type = ClassWriter.LONG; this.longVal = longVal; this.hashCode = 0x7FFFFFFF & (type + (int) longVal); } /** * Sets this item to a float item. * * @param floatVal * the value of this item. */ void set(final float floatVal) { this.type = ClassWriter.FLOAT; this.intVal = Float.floatToRawIntBits(floatVal); this.hashCode = 0x7FFFFFFF & (type + (int) floatVal); } /** * Sets this item to a double item. * * @param doubleVal * the value of this item. */ void set(final double doubleVal) { this.type = ClassWriter.DOUBLE; this.longVal = Double.doubleToRawLongBits(doubleVal); this.hashCode = 0x7FFFFFFF & (type + (int) doubleVal); } /** * Sets this item to an item that do not hold a primitive value. * * @param type * the type of this item. * @param strVal1 * first part of the value of this item. * @param strVal2 * second part of the value of this item. * @param strVal3 * third part of the value of this item. */ void set(final int type, final String strVal1, final String strVal2, final String strVal3) { this.type = type; this.strVal1 = strVal1; this.strVal2 = strVal2; this.strVal3 = strVal3; switch (type) { case ClassWriter.UTF8: case ClassWriter.STR: case ClassWriter.CLASS: case ClassWriter.MTYPE: case ClassWriter.TYPE_NORMAL: hashCode = 0x7FFFFFFF & (type + strVal1.hashCode()); return; case ClassWriter.NAME_TYPE: { hashCode = 0x7FFFFFFF & (type + strVal1.hashCode() * strVal2.hashCode()); return; } // ClassWriter.FIELD: // ClassWriter.METH: // ClassWriter.IMETH: // ClassWriter.HANDLE_BASE + 1..9 default: hashCode = 0x7FFFFFFF & (type + strVal1.hashCode() * strVal2.hashCode() * strVal3.hashCode()); } } /** * Sets the item to an InvokeDynamic item. * * @param name * invokedynamic's name. * @param desc * invokedynamic's desc. * @param bsmIndex * zero based index into the class attribute BootrapMethods. */ void set(String name, String desc, int bsmIndex) { this.type = ClassWriter.INDY; this.longVal = bsmIndex; this.strVal1 = name; this.strVal2 = desc; this.hashCode = 0x7FFFFFFF & (ClassWriter.INDY + bsmIndex * strVal1.hashCode() * strVal2.hashCode()); } /** * Sets the item to a BootstrapMethod item. * * @param position * position in byte in the class attribute BootrapMethods. * @param hashCode * hashcode of the item. This hashcode is processed from the * hashcode of the bootstrap method and the hashcode of all * bootstrap arguments. */ void set(int position, int hashCode) { this.type = ClassWriter.BSM; this.intVal = position; this.hashCode = hashCode; } /** * Indicates if the given item is equal to this one. This method assumes * that the two items have the same {@link #type}. * * @param i * the item to be compared to this one. Both items must have the * same {@link #type}. * @return true if the given item if equal to this one, * false otherwise. */ boolean isEqualTo(final Item i) { switch (type) { case ClassWriter.UTF8: case ClassWriter.STR: case ClassWriter.CLASS: case ClassWriter.MTYPE: case ClassWriter.TYPE_NORMAL: return i.strVal1.equals(strVal1); case ClassWriter.TYPE_MERGED: case ClassWriter.LONG: case ClassWriter.DOUBLE: return i.longVal == longVal; case ClassWriter.INT: case ClassWriter.FLOAT: return i.intVal == intVal; case ClassWriter.TYPE_UNINIT: return i.intVal == intVal && i.strVal1.equals(strVal1); case ClassWriter.NAME_TYPE: return i.strVal1.equals(strVal1) && i.strVal2.equals(strVal2); case ClassWriter.INDY: { return i.longVal == longVal && i.strVal1.equals(strVal1) && i.strVal2.equals(strVal2); } // case ClassWriter.FIELD: // case ClassWriter.METH: // case ClassWriter.IMETH: // case ClassWriter.HANDLE_BASE + 1..9 default: return i.strVal1.equals(strVal1) && i.strVal2.equals(strVal2) && i.strVal3.equals(strVal3); } } } ================================================ FILE: src/jvm/clojure/asm/Label.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A label represents a position in the bytecode of a method. Labels are used * for jump, goto, and switch instructions, and for try catch blocks. A label * designates the instruction that is just after. Note however that there * can be other elements between a label and the instruction it designates (such * as other labels, stack map frames, line numbers, etc.). * * @author Eric Bruneton */ public class Label { /** * Indicates if this label is only used for debug attributes. Such a label * is not the start of a basic block, the target of a jump instruction, or * an exception handler. It can be safely ignored in control flow graph * analysis algorithms (for optimization purposes). */ static final int DEBUG = 1; /** * Indicates if the position of this label is known. */ static final int RESOLVED = 2; /** * Indicates if this label has been updated, after instruction resizing. */ static final int RESIZED = 4; /** * Indicates if this basic block has been pushed in the basic block stack. * See {@link MethodWriter#visitMaxs visitMaxs}. */ static final int PUSHED = 8; /** * Indicates if this label is the target of a jump instruction, or the start * of an exception handler. */ static final int TARGET = 16; /** * Indicates if a stack map frame must be stored for this label. */ static final int STORE = 32; /** * Indicates if this label corresponds to a reachable basic block. */ static final int REACHABLE = 64; /** * Indicates if this basic block ends with a JSR instruction. */ static final int JSR = 128; /** * Indicates if this basic block ends with a RET instruction. */ static final int RET = 256; /** * Indicates if this basic block is the start of a subroutine. */ static final int SUBROUTINE = 512; /** * Indicates if this subroutine basic block has been visited by a * visitSubroutine(null, ...) call. */ static final int VISITED = 1024; /** * Indicates if this subroutine basic block has been visited by a * visitSubroutine(!null, ...) call. */ static final int VISITED2 = 2048; /** * Field used to associate user information to a label. Warning: this field * is used by the ASM tree package. In order to use it with the ASM tree * package you must override the * {@link clojure.asm.tree.MethodNode#getLabelNode} method. */ public Object info; /** * Flags that indicate the status of this label. * * @see #DEBUG * @see #RESOLVED * @see #RESIZED * @see #PUSHED * @see #TARGET * @see #STORE * @see #REACHABLE * @see #JSR * @see #RET */ int status; /** * The line number corresponding to this label, if known. */ int line; /** * The position of this label in the code, if known. */ int position; /** * Number of forward references to this label, times two. */ private int referenceCount; /** * Informations about forward references. Each forward reference is * described by two consecutive integers in this array: the first one is the * position of the first byte of the bytecode instruction that contains the * forward reference, while the second is the position of the first byte of * the forward reference itself. In fact the sign of the first integer * indicates if this reference uses 2 or 4 bytes, and its absolute value * gives the position of the bytecode instruction. This array is also used * as a bitset to store the subroutines to which a basic block belongs. This * information is needed in {@linked MethodWriter#visitMaxs}, after all * forward references have been resolved. Hence the same array can be used * for both purposes without problems. */ private int[] srcAndRefPositions; // ------------------------------------------------------------------------ /* * Fields for the control flow and data flow graph analysis algorithms (used * to compute the maximum stack size or the stack map frames). A control * flow graph contains one node per "basic block", and one edge per "jump" * from one basic block to another. Each node (i.e., each basic block) is * represented by the Label object that corresponds to the first instruction * of this basic block. Each node also stores the list of its successors in * the graph, as a linked list of Edge objects. * * The control flow analysis algorithms used to compute the maximum stack * size or the stack map frames are similar and use two steps. The first * step, during the visit of each instruction, builds information about the * state of the local variables and the operand stack at the end of each * basic block, called the "output frame", relatively to the frame * state at the beginning of the basic block, which is called the "input * frame", and which is unknown during this step. The second step, in * {@link MethodWriter#visitMaxs}, is a fix point algorithm that computes * information about the input frame of each basic block, from the input * state of the first basic block (known from the method signature), and by * the using the previously computed relative output frames. * * The algorithm used to compute the maximum stack size only computes the * relative output and absolute input stack heights, while the algorithm * used to compute stack map frames computes relative output frames and * absolute input frames. */ /** * Start of the output stack relatively to the input stack. The exact * semantics of this field depends on the algorithm that is used. * * When only the maximum stack size is computed, this field is the number of * elements in the input stack. * * When the stack map frames are completely computed, this field is the * offset of the first output stack element relatively to the top of the * input stack. This offset is always negative or null. A null offset means * that the output stack must be appended to the input stack. A -n offset * means that the first n output stack elements must replace the top n input * stack elements, and that the other elements must be appended to the input * stack. */ int inputStackTop; /** * Maximum height reached by the output stack, relatively to the top of the * input stack. This maximum is always positive or null. */ int outputStackMax; /** * Information about the input and output stack map frames of this basic * block. This field is only used when {@link ClassWriter#COMPUTE_FRAMES} * option is used. */ Frame frame; /** * The successor of this label, in the order they are visited. This linked * list does not include labels used for debug info only. If * {@link ClassWriter#COMPUTE_FRAMES} option is used then, in addition, it * does not contain successive labels that denote the same bytecode position * (in this case only the first label appears in this list). */ Label successor; /** * The successors of this node in the control flow graph. These successors * are stored in a linked list of {@link Edge Edge} objects, linked to each * other by their {@link Edge#next} field. */ Edge successors; /** * The next basic block in the basic block stack. This stack is used in the * main loop of the fix point algorithm used in the second step of the * control flow analysis algorithms. It is also used in * {@link #visitSubroutine} to avoid using a recursive method. * * @see MethodWriter#visitMaxs */ Label next; // ------------------------------------------------------------------------ // Constructor // ------------------------------------------------------------------------ /** * Constructs a new label. */ public Label() { } // ------------------------------------------------------------------------ // Methods to compute offsets and to manage forward references // ------------------------------------------------------------------------ /** * Returns the offset corresponding to this label. This offset is computed * from the start of the method's bytecode. This method is intended for * {@link Attribute} sub classes, and is normally not needed by class * generators or adapters. * * @return the offset corresponding to this label. * @throws IllegalStateException * if this label is not resolved yet. */ public int getOffset() { if ((status & RESOLVED) == 0) { throw new IllegalStateException( "Label offset position has not been resolved yet"); } return position; } /** * Puts a reference to this label in the bytecode of a method. If the * position of the label is known, the offset is computed and written * directly. Otherwise, a null offset is written and a new forward reference * is declared for this label. * * @param owner * the code writer that calls this method. * @param out * the bytecode of the method. * @param source * the position of first byte of the bytecode instruction that * contains this label. * @param wideOffset * true if the reference must be stored in 4 bytes, or * false if it must be stored with 2 bytes. * @throws IllegalArgumentException * if this label has not been created by the given code writer. */ void put(final MethodWriter owner, final ByteVector out, final int source, final boolean wideOffset) { if ((status & RESOLVED) == 0) { if (wideOffset) { addReference(-1 - source, out.length); out.putInt(-1); } else { addReference(source, out.length); out.putShort(-1); } } else { if (wideOffset) { out.putInt(position - source); } else { out.putShort(position - source); } } } /** * Adds a forward reference to this label. This method must be called only * for a true forward reference, i.e. only if this label is not resolved * yet. For backward references, the offset of the reference can be, and * must be, computed and stored directly. * * @param sourcePosition * the position of the referencing instruction. This position * will be used to compute the offset of this forward reference. * @param referencePosition * the position where the offset for this forward reference must * be stored. */ private void addReference(final int sourcePosition, final int referencePosition) { if (srcAndRefPositions == null) { srcAndRefPositions = new int[6]; } if (referenceCount >= srcAndRefPositions.length) { int[] a = new int[srcAndRefPositions.length + 6]; System.arraycopy(srcAndRefPositions, 0, a, 0, srcAndRefPositions.length); srcAndRefPositions = a; } srcAndRefPositions[referenceCount++] = sourcePosition; srcAndRefPositions[referenceCount++] = referencePosition; } /** * Resolves all forward references to this label. This method must be called * when this label is added to the bytecode of the method, i.e. when its * position becomes known. This method fills in the blanks that where left * in the bytecode by each forward reference previously added to this label. * * @param owner * the code writer that calls this method. * @param position * the position of this label in the bytecode. * @param data * the bytecode of the method. * @return true if a blank that was left for this label was to * small to store the offset. In such a case the corresponding jump * instruction is replaced with a pseudo instruction (using unused * opcodes) using an unsigned two bytes offset. These pseudo * instructions will need to be replaced with true instructions with * wider offsets (4 bytes instead of 2). This is done in * {@link MethodWriter#resizeInstructions}. * @throws IllegalArgumentException * if this label has already been resolved, or if it has not * been created by the given code writer. */ boolean resolve(final MethodWriter owner, final int position, final byte[] data) { boolean needUpdate = false; this.status |= RESOLVED; this.position = position; int i = 0; while (i < referenceCount) { int source = srcAndRefPositions[i++]; int reference = srcAndRefPositions[i++]; int offset; if (source >= 0) { offset = position - source; if (offset < Short.MIN_VALUE || offset > Short.MAX_VALUE) { /* * changes the opcode of the jump instruction, in order to * be able to find it later (see resizeInstructions in * MethodWriter). These temporary opcodes are similar to * jump instruction opcodes, except that the 2 bytes offset * is unsigned (and can therefore represent values from 0 to * 65535, which is sufficient since the size of a method is * limited to 65535 bytes). */ int opcode = data[reference - 1] & 0xFF; if (opcode <= Opcodes.JSR) { // changes IFEQ ... JSR to opcodes 202 to 217 data[reference - 1] = (byte) (opcode + 49); } else { // changes IFNULL and IFNONNULL to opcodes 218 and 219 data[reference - 1] = (byte) (opcode + 20); } needUpdate = true; } data[reference++] = (byte) (offset >>> 8); data[reference] = (byte) offset; } else { offset = position + source + 1; data[reference++] = (byte) (offset >>> 24); data[reference++] = (byte) (offset >>> 16); data[reference++] = (byte) (offset >>> 8); data[reference] = (byte) offset; } } return needUpdate; } /** * Returns the first label of the series to which this label belongs. For an * isolated label or for the first label in a series of successive labels, * this method returns the label itself. For other labels it returns the * first label of the series. * * @return the first label of the series to which this label belongs. */ Label getFirst() { return !ClassReader.FRAMES || frame == null ? this : frame.owner; } // ------------------------------------------------------------------------ // Methods related to subroutines // ------------------------------------------------------------------------ /** * Returns true is this basic block belongs to the given subroutine. * * @param id * a subroutine id. * @return true is this basic block belongs to the given subroutine. */ boolean inSubroutine(final long id) { if ((status & Label.VISITED) != 0) { return (srcAndRefPositions[(int) (id >>> 32)] & (int) id) != 0; } return false; } /** * Returns true if this basic block and the given one belong to a common * subroutine. * * @param block * another basic block. * @return true if this basic block and the given one belong to a common * subroutine. */ boolean inSameSubroutine(final Label block) { if ((status & VISITED) == 0 || (block.status & VISITED) == 0) { return false; } for (int i = 0; i < srcAndRefPositions.length; ++i) { if ((srcAndRefPositions[i] & block.srcAndRefPositions[i]) != 0) { return true; } } return false; } /** * Marks this basic block as belonging to the given subroutine. * * @param id * a subroutine id. * @param nbSubroutines * the total number of subroutines in the method. */ void addToSubroutine(final long id, final int nbSubroutines) { if ((status & VISITED) == 0) { status |= VISITED; srcAndRefPositions = new int[(nbSubroutines - 1) / 32 + 1]; } srcAndRefPositions[(int) (id >>> 32)] |= (int) id; } /** * Finds the basic blocks that belong to a given subroutine, and marks these * blocks as belonging to this subroutine. This method follows the control * flow graph to find all the blocks that are reachable from the current * block WITHOUT following any JSR target. * * @param JSR * a JSR block that jumps to this subroutine. If this JSR is not * null it is added to the successor of the RET blocks found in * the subroutine. * @param id * the id of this subroutine. * @param nbSubroutines * the total number of subroutines in the method. */ void visitSubroutine(final Label JSR, final long id, final int nbSubroutines) { // user managed stack of labels, to avoid using a recursive method // (recursivity can lead to stack overflow with very large methods) Label stack = this; while (stack != null) { // removes a label l from the stack Label l = stack; stack = l.next; l.next = null; if (JSR != null) { if ((l.status & VISITED2) != 0) { continue; } l.status |= VISITED2; // adds JSR to the successors of l, if it is a RET block if ((l.status & RET) != 0) { if (!l.inSameSubroutine(JSR)) { Edge e = new Edge(); e.info = l.inputStackTop; e.successor = JSR.successors.successor; e.next = l.successors; l.successors = e; } } } else { // if the l block already belongs to subroutine 'id', continue if (l.inSubroutine(id)) { continue; } // marks the l block as belonging to subroutine 'id' l.addToSubroutine(id, nbSubroutines); } // pushes each successor of l on the stack, except JSR targets Edge e = l.successors; while (e != null) { // if the l block is a JSR block, then 'l.successors.next' leads // to the JSR target (see {@link #visitJumpInsn}) and must // therefore not be followed if ((l.status & Label.JSR) == 0 || e != l.successors.next) { // pushes e.successor on the stack if it not already added if (e.successor.next == null) { e.successor.next = stack; stack = e.successor; } } e = e.next; } } } // ------------------------------------------------------------------------ // Overriden Object methods // ------------------------------------------------------------------------ /** * Returns a string representation of this label. * * @return a string representation of this label. */ @Override public String toString() { return "L" + System.identityHashCode(this); } } ================================================ FILE: src/jvm/clojure/asm/MethodVisitor.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A visitor to visit a Java method. The methods of this class must be called in * the following order: [ visitAnnotationDefault ] ( * visitAnnotation | visitParameterAnnotation | * visitAttribute )* [ visitCode ( visitFrame | * visitXInsn | visitLabel | * visitTryCatchBlock | visitLocalVariable | * visitLineNumber )* visitMaxs ] visitEnd. In * addition, the visitXInsn and visitLabel methods * must be called in the sequential order of the bytecode instructions of the * visited code, visitTryCatchBlock must be called before the * labels passed as arguments have been visited, and the * visitLocalVariable and visitLineNumber methods must be * called after the labels passed as arguments have been visited. * * @author Eric Bruneton */ public abstract class MethodVisitor { /** * The ASM API version implemented by this visitor. The value of this field * must be one of {@link Opcodes#ASM4}. */ protected final int api; /** * The method visitor to which this visitor must delegate method calls. May * be null. */ protected MethodVisitor mv; /** * Constructs a new {@link MethodVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. */ public MethodVisitor(final int api) { this(api, null); } /** * Constructs a new {@link MethodVisitor}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. * @param mv * the method visitor to which this visitor must delegate method * calls. May be null. */ public MethodVisitor(final int api, final MethodVisitor mv) { if (api != Opcodes.ASM4) { throw new IllegalArgumentException(); } this.api = api; this.mv = mv; } // ------------------------------------------------------------------------- // Annotations and non standard attributes // ------------------------------------------------------------------------- /** * Visits the default value of this annotation interface method. * * @return a visitor to the visit the actual default value of this * annotation interface method, or null if this visitor is * not interested in visiting this default value. The 'name' * parameters passed to the methods of this annotation visitor are * ignored. Moreover, exacly one visit method must be called on this * annotation visitor, followed by visitEnd. */ public AnnotationVisitor visitAnnotationDefault() { if (mv != null) { return mv.visitAnnotationDefault(); } return null; } /** * Visits an annotation of this method. * * @param desc * the class descriptor of the annotation class. * @param visible * true if the annotation is visible at runtime. * @return a visitor to visit the annotation values, or null if * this visitor is not interested in visiting this annotation. */ public AnnotationVisitor visitAnnotation(String desc, boolean visible) { if (mv != null) { return mv.visitAnnotation(desc, visible); } return null; } /** * Visits an annotation of a parameter this method. * * @param parameter * the parameter index. * @param desc * the class descriptor of the annotation class. * @param visible * true if the annotation is visible at runtime. * @return a visitor to visit the annotation values, or null if * this visitor is not interested in visiting this annotation. */ public AnnotationVisitor visitParameterAnnotation(int parameter, String desc, boolean visible) { if (mv != null) { return mv.visitParameterAnnotation(parameter, desc, visible); } return null; } /** * Visits a non standard attribute of this method. * * @param attr * an attribute. */ public void visitAttribute(Attribute attr) { if (mv != null) { mv.visitAttribute(attr); } } /** * Starts the visit of the method's code, if any (i.e. non abstract method). */ public void visitCode() { if (mv != null) { mv.visitCode(); } } /** * Visits the current state of the local variables and operand stack * elements. This method must(*) be called just before any * instruction i that follows an unconditional branch instruction * such as GOTO or THROW, that is the target of a jump instruction, or that * starts an exception handler block. The visited types must describe the * values of the local variables and of the operand stack elements just * before i is executed.
*
* (*) this is mandatory only for classes whose version is greater than or * equal to {@link Opcodes#V1_6 V1_6}.
*
* The frames of a method must be given either in expanded form, or in * compressed form (all frames must use the same format, i.e. you must not * mix expanded and compressed frames within a single method): *
    *
  • In expanded form, all frames must have the F_NEW type.
    • *
  • In compressed form, frames are basically "deltas" from the state of * the previous frame: *
      *
    • {@link Opcodes#F_SAME} representing frame with exactly the same * locals as the previous frame and with the empty stack.
      • *
    • {@link Opcodes#F_SAME1} representing frame with exactly the same * locals as the previous frame and with single value on the stack ( * nStack is 1 and stack[0] contains value for the * type of the stack item).
      • *
    • {@link Opcodes#F_APPEND} representing frame with current locals are * the same as the locals in the previous frame, except that additional * locals are defined (nLocal is 1, 2 or 3 and * local elements contains values representing added types).
      • *
    • {@link Opcodes#F_CHOP} representing frame with current locals are the * same as the locals in the previous frame, except that the last 1-3 locals * are absent and with the empty stack (nLocals is 1, 2 or 3).
      • *
    • {@link Opcodes#F_FULL} representing complete frame data.
      • *
    *

* In both cases the first frame, corresponding to the method's parameters * and access flags, is implicit and must not be visited. Also, it is * illegal to visit two or more frames for the same code location (i.e., at * least one instruction must be visited between two calls to visitFrame). * * @param type * the type of this stack map frame. Must be * {@link Opcodes#F_NEW} for expanded frames, or * {@link Opcodes#F_FULL}, {@link Opcodes#F_APPEND}, * {@link Opcodes#F_CHOP}, {@link Opcodes#F_SAME} or * {@link Opcodes#F_APPEND}, {@link Opcodes#F_SAME1} for * compressed frames. * @param nLocal * the number of local variables in the visited frame. * @param local * the local variable types in this frame. This array must not be * modified. Primitive types are represented by * {@link Opcodes#TOP}, {@link Opcodes#INTEGER}, * {@link Opcodes#FLOAT}, {@link Opcodes#LONG}, * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or * {@link Opcodes#UNINITIALIZED_THIS} (long and double are * represented by a single element). Reference types are * represented by String objects (representing internal names), * and uninitialized types by Label objects (this label * designates the NEW instruction that created this uninitialized * value). * @param nStack * the number of operand stack elements in the visited frame. * @param stack * the operand stack types in this frame. This array must not be * modified. Its content has the same format as the "local" * array. * @throws IllegalStateException * if a frame is visited just after another one, without any * instruction between the two (unless this frame is a * Opcodes#F_SAME frame, in which case it is silently ignored). */ public void visitFrame(int type, int nLocal, Object[] local, int nStack, Object[] stack) { if (mv != null) { mv.visitFrame(type, nLocal, local, nStack, stack); } } // ------------------------------------------------------------------------- // Normal instructions // ------------------------------------------------------------------------- /** * Visits a zero operand instruction. * * @param opcode * the opcode of the instruction to be visited. This opcode is * either NOP, ACONST_NULL, ICONST_M1, ICONST_0, ICONST_1, * ICONST_2, ICONST_3, ICONST_4, ICONST_5, LCONST_0, LCONST_1, * FCONST_0, FCONST_1, FCONST_2, DCONST_0, DCONST_1, IALOAD, * LALOAD, FALOAD, DALOAD, AALOAD, BALOAD, CALOAD, SALOAD, * IASTORE, LASTORE, FASTORE, DASTORE, AASTORE, BASTORE, CASTORE, * SASTORE, POP, POP2, DUP, DUP_X1, DUP_X2, DUP2, DUP2_X1, * DUP2_X2, SWAP, IADD, LADD, FADD, DADD, ISUB, LSUB, FSUB, DSUB, * IMUL, LMUL, FMUL, DMUL, IDIV, LDIV, FDIV, DDIV, IREM, LREM, * FREM, DREM, INEG, LNEG, FNEG, DNEG, ISHL, LSHL, ISHR, LSHR, * IUSHR, LUSHR, IAND, LAND, IOR, LOR, IXOR, LXOR, I2L, I2F, I2D, * L2I, L2F, L2D, F2I, F2L, F2D, D2I, D2L, D2F, I2B, I2C, I2S, * LCMP, FCMPL, FCMPG, DCMPL, DCMPG, IRETURN, LRETURN, FRETURN, * DRETURN, ARETURN, RETURN, ARRAYLENGTH, ATHROW, MONITORENTER, * or MONITOREXIT. */ public void visitInsn(int opcode) { if (mv != null) { mv.visitInsn(opcode); } } /** * Visits an instruction with a single int operand. * * @param opcode * the opcode of the instruction to be visited. This opcode is * either BIPUSH, SIPUSH or NEWARRAY. * @param operand * the operand of the instruction to be visited.
* When opcode is BIPUSH, operand value should be between * Byte.MIN_VALUE and Byte.MAX_VALUE.
* When opcode is SIPUSH, operand value should be between * Short.MIN_VALUE and Short.MAX_VALUE.
* When opcode is NEWARRAY, operand value should be one of * {@link Opcodes#T_BOOLEAN}, {@link Opcodes#T_CHAR}, * {@link Opcodes#T_FLOAT}, {@link Opcodes#T_DOUBLE}, * {@link Opcodes#T_BYTE}, {@link Opcodes#T_SHORT}, * {@link Opcodes#T_INT} or {@link Opcodes#T_LONG}. */ public void visitIntInsn(int opcode, int operand) { if (mv != null) { mv.visitIntInsn(opcode, operand); } } /** * Visits a local variable instruction. A local variable instruction is an * instruction that loads or stores the value of a local variable. * * @param opcode * the opcode of the local variable instruction to be visited. * This opcode is either ILOAD, LLOAD, FLOAD, DLOAD, ALOAD, * ISTORE, LSTORE, FSTORE, DSTORE, ASTORE or RET. * @param var * the operand of the instruction to be visited. This operand is * the index of a local variable. */ public void visitVarInsn(int opcode, int var) { if (mv != null) { mv.visitVarInsn(opcode, var); } } /** * Visits a type instruction. A type instruction is an instruction that * takes the internal name of a class as parameter. * * @param opcode * the opcode of the type instruction to be visited. This opcode * is either NEW, ANEWARRAY, CHECKCAST or INSTANCEOF. * @param type * the operand of the instruction to be visited. This operand * must be the internal name of an object or array class (see * {@link Type#getInternalName() getInternalName}). */ public void visitTypeInsn(int opcode, String type) { if (mv != null) { mv.visitTypeInsn(opcode, type); } } /** * Visits a field instruction. A field instruction is an instruction that * loads or stores the value of a field of an object. * * @param opcode * the opcode of the type instruction to be visited. This opcode * is either GETSTATIC, PUTSTATIC, GETFIELD or PUTFIELD. * @param owner * the internal name of the field's owner class (see * {@link Type#getInternalName() getInternalName}). * @param name * the field's name. * @param desc * the field's descriptor (see {@link Type Type}). */ public void visitFieldInsn(int opcode, String owner, String name, String desc) { if (mv != null) { mv.visitFieldInsn(opcode, owner, name, desc); } } /** * Visits a method instruction. A method instruction is an instruction that * invokes a method. * * @param opcode * the opcode of the type instruction to be visited. This opcode * is either INVOKEVIRTUAL, INVOKESPECIAL, INVOKESTATIC or * INVOKEINTERFACE. * @param owner * the internal name of the method's owner class (see * {@link Type#getInternalName() getInternalName}). * @param name * the method's name. * @param desc * the method's descriptor (see {@link Type Type}). */ public void visitMethodInsn(int opcode, String owner, String name, String desc) { if (mv != null) { mv.visitMethodInsn(opcode, owner, name, desc); } } /** * Visits an invokedynamic instruction. * * @param name * the method's name. * @param desc * the method's descriptor (see {@link Type Type}). * @param bsm * the bootstrap method. * @param bsmArgs * the bootstrap method constant arguments. Each argument must be * an {@link Integer}, {@link Float}, {@link Long}, * {@link Double}, {@link String}, {@link Type} or {@link Handle} * value. This method is allowed to modify the content of the * array so a caller should expect that this array may change. */ public void visitInvokeDynamicInsn(String name, String desc, Handle bsm, Object... bsmArgs) { if (mv != null) { mv.visitInvokeDynamicInsn(name, desc, bsm, bsmArgs); } } /** * Visits a jump instruction. A jump instruction is an instruction that may * jump to another instruction. * * @param opcode * the opcode of the type instruction to be visited. This opcode * is either IFEQ, IFNE, IFLT, IFGE, IFGT, IFLE, IF_ICMPEQ, * IF_ICMPNE, IF_ICMPLT, IF_ICMPGE, IF_ICMPGT, IF_ICMPLE, * IF_ACMPEQ, IF_ACMPNE, GOTO, JSR, IFNULL or IFNONNULL. * @param label * the operand of the instruction to be visited. This operand is * a label that designates the instruction to which the jump * instruction may jump. */ public void visitJumpInsn(int opcode, Label label) { if (mv != null) { mv.visitJumpInsn(opcode, label); } } /** * Visits a label. A label designates the instruction that will be visited * just after it. * * @param label * a {@link Label Label} object. */ public void visitLabel(Label label) { if (mv != null) { mv.visitLabel(label); } } // ------------------------------------------------------------------------- // Special instructions // ------------------------------------------------------------------------- /** * Visits a LDC instruction. Note that new constant types may be added in * future versions of the Java Virtual Machine. To easily detect new * constant types, implementations of this method should check for * unexpected constant types, like this: * * 
     * if (cst instanceof Integer) {
     *     // ...
     * } else if (cst instanceof Float) {
     *     // ...
     * } else if (cst instanceof Long) {
     *     // ...
     * } else if (cst instanceof Double) {
     *     // ...
     * } else if (cst instanceof String) {
     *     // ...
     * } else if (cst instanceof Type) {
     *     int sort = ((Type) cst).getSort();
     *     if (sort == Type.OBJECT) {
     *         // ...
     *     } else if (sort == Type.ARRAY) {
     *         // ...
     *     } else if (sort == Type.METHOD) {
     *         // ...
     *     } else {
     *         // throw an exception
     *     }
     * } else if (cst instanceof Handle) {
     *     // ...
     * } else {
     *     // throw an exception
     * }
     *
* * @param cst * the constant to be loaded on the stack. This parameter must be * a non null {@link Integer}, a {@link Float}, a {@link Long}, a * {@link Double}, a {@link String}, a {@link Type} of OBJECT or * ARRAY sort for .class constants, for classes whose * version is 49.0, a {@link Type} of METHOD sort or a * {@link Handle} for MethodType and MethodHandle constants, for * classes whose version is 51.0. */ public void visitLdcInsn(Object cst) { if (mv != null) { mv.visitLdcInsn(cst); } } /** * Visits an IINC instruction. * * @param var * index of the local variable to be incremented. * @param increment * amount to increment the local variable by. */ public void visitIincInsn(int var, int increment) { if (mv != null) { mv.visitIincInsn(var, increment); } } /** * Visits a TABLESWITCH instruction. * * @param min * the minimum key value. * @param max * the maximum key value. * @param dflt * beginning of the default handler block. * @param labels * beginnings of the handler blocks. labels[i] is the * beginning of the handler block for the min + i key. */ public void visitTableSwitchInsn(int min, int max, Label dflt, Label... labels) { if (mv != null) { mv.visitTableSwitchInsn(min, max, dflt, labels); } } /** * Visits a LOOKUPSWITCH instruction. * * @param dflt * beginning of the default handler block. * @param keys * the values of the keys. * @param labels * beginnings of the handler blocks. labels[i] is the * beginning of the handler block for the keys[i] key. */ public void visitLookupSwitchInsn(Label dflt, int[] keys, Label[] labels) { if (mv != null) { mv.visitLookupSwitchInsn(dflt, keys, labels); } } /** * Visits a MULTIANEWARRAY instruction. * * @param desc * an array type descriptor (see {@link Type Type}). * @param dims * number of dimensions of the array to allocate. */ public void visitMultiANewArrayInsn(String desc, int dims) { if (mv != null) { mv.visitMultiANewArrayInsn(desc, dims); } } // ------------------------------------------------------------------------- // Exceptions table entries, debug information, max stack and max locals // ------------------------------------------------------------------------- /** * Visits a try catch block. * * @param start * beginning of the exception handler's scope (inclusive). * @param end * end of the exception handler's scope (exclusive). * @param handler * beginning of the exception handler's code. * @param type * internal name of the type of exceptions handled by the * handler, or null to catch any exceptions (for * "finally" blocks). * @throws IllegalArgumentException * if one of the labels has already been visited by this visitor * (by the {@link #visitLabel visitLabel} method). */ public void visitTryCatchBlock(Label start, Label end, Label handler, String type) { if (mv != null) { mv.visitTryCatchBlock(start, end, handler, type); } } /** * Visits a local variable declaration. * * @param name * the name of a local variable. * @param desc * the type descriptor of this local variable. * @param signature * the type signature of this local variable. May be * null if the local variable type does not use generic * types. * @param start * the first instruction corresponding to the scope of this local * variable (inclusive). * @param end * the last instruction corresponding to the scope of this local * variable (exclusive). * @param index * the local variable's index. * @throws IllegalArgumentException * if one of the labels has not already been visited by this * visitor (by the {@link #visitLabel visitLabel} method). */ public void visitLocalVariable(String name, String desc, String signature, Label start, Label end, int index) { if (mv != null) { mv.visitLocalVariable(name, desc, signature, start, end, index); } } /** * Visits a line number declaration. * * @param line * a line number. This number refers to the source file from * which the class was compiled. * @param start * the first instruction corresponding to this line number. * @throws IllegalArgumentException * if start has not already been visited by this * visitor (by the {@link #visitLabel visitLabel} method). */ public void visitLineNumber(int line, Label start) { if (mv != null) { mv.visitLineNumber(line, start); } } /** * Visits the maximum stack size and the maximum number of local variables * of the method. * * @param maxStack * maximum stack size of the method. * @param maxLocals * maximum number of local variables for the method. */ public void visitMaxs(int maxStack, int maxLocals) { if (mv != null) { mv.visitMaxs(maxStack, maxLocals); } } /** * Visits the end of the method. This method, which is the last one to be * called, is used to inform the visitor that all the annotations and * attributes of the method have been visited. */ public void visitEnd() { if (mv != null) { mv.visitEnd(); } } } ================================================ FILE: src/jvm/clojure/asm/MethodWriter.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * A {@link MethodVisitor} that generates methods in bytecode form. Each visit * method of this class appends the bytecode corresponding to the visited * instruction to a byte vector, in the order these methods are called. * * @author Eric Bruneton * @author Eugene Kuleshov */ class MethodWriter extends MethodVisitor { /** * Pseudo access flag used to denote constructors. */ static final int ACC_CONSTRUCTOR = 0x80000; /** * Frame has exactly the same locals as the previous stack map frame and * number of stack items is zero. */ static final int SAME_FRAME = 0; // to 63 (0-3f) /** * Frame has exactly the same locals as the previous stack map frame and * number of stack items is 1 */ static final int SAME_LOCALS_1_STACK_ITEM_FRAME = 64; // to 127 (40-7f) /** * Reserved for future use */ static final int RESERVED = 128; /** * Frame has exactly the same locals as the previous stack map frame and * number of stack items is 1. Offset is bigger then 63; */ static final int SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED = 247; // f7 /** * Frame where current locals are the same as the locals in the previous * frame, except that the k last locals are absent. The value of k is given * by the formula 251-frame_type. */ static final int CHOP_FRAME = 248; // to 250 (f8-fA) /** * Frame has exactly the same locals as the previous stack map frame and * number of stack items is zero. Offset is bigger then 63; */ static final int SAME_FRAME_EXTENDED = 251; // fb /** * Frame where current locals are the same as the locals in the previous * frame, except that k additional locals are defined. The value of k is * given by the formula frame_type-251. */ static final int APPEND_FRAME = 252; // to 254 // fc-fe /** * Full frame */ static final int FULL_FRAME = 255; // ff /** * Indicates that the stack map frames must be recomputed from scratch. In * this case the maximum stack size and number of local variables is also * recomputed from scratch. * * @see #compute */ private static final int FRAMES = 0; /** * Indicates that the maximum stack size and number of local variables must * be automatically computed. * * @see #compute */ private static final int MAXS = 1; /** * Indicates that nothing must be automatically computed. * * @see #compute */ private static final int NOTHING = 2; /** * The class writer to which this method must be added. */ final ClassWriter cw; /** * Access flags of this method. */ private int access; /** * The index of the constant pool item that contains the name of this * method. */ private final int name; /** * The index of the constant pool item that contains the descriptor of this * method. */ private final int desc; /** * The descriptor of this method. */ private final String descriptor; /** * The signature of this method. */ String signature; /** * If not zero, indicates that the code of this method must be copied from * the ClassReader associated to this writer in cw.cr. More * precisely, this field gives the index of the first byte to copied from * cw.cr.b. */ int classReaderOffset; /** * If not zero, indicates that the code of this method must be copied from * the ClassReader associated to this writer in cw.cr. More * precisely, this field gives the number of bytes to copied from * cw.cr.b. */ int classReaderLength; /** * Number of exceptions that can be thrown by this method. */ int exceptionCount; /** * The exceptions that can be thrown by this method. More precisely, this * array contains the indexes of the constant pool items that contain the * internal names of these exception classes. */ int[] exceptions; /** * The annotation default attribute of this method. May be null. */ private ByteVector annd; /** * The runtime visible annotations of this method. May be null. */ private AnnotationWriter anns; /** * The runtime invisible annotations of this method. May be null. */ private AnnotationWriter ianns; /** * The runtime visible parameter annotations of this method. May be * null. */ private AnnotationWriter[] panns; /** * The runtime invisible parameter annotations of this method. May be * null. */ private AnnotationWriter[] ipanns; /** * The number of synthetic parameters of this method. */ private int synthetics; /** * The non standard attributes of the method. */ private Attribute attrs; /** * The bytecode of this method. */ private ByteVector code = new ByteVector(); /** * Maximum stack size of this method. */ private int maxStack; /** * Maximum number of local variables for this method. */ private int maxLocals; /** * Number of local variables in the current stack map frame. */ private int currentLocals; /** * Number of stack map frames in the StackMapTable attribute. */ private int frameCount; /** * The StackMapTable attribute. */ private ByteVector stackMap; /** * The offset of the last frame that was written in the StackMapTable * attribute. */ private int previousFrameOffset; /** * The last frame that was written in the StackMapTable attribute. * * @see #frame */ private int[] previousFrame; /** * The current stack map frame. The first element contains the offset of the * instruction to which the frame corresponds, the second element is the * number of locals and the third one is the number of stack elements. The * local variables start at index 3 and are followed by the operand stack * values. In summary frame[0] = offset, frame[1] = nLocal, frame[2] = * nStack, frame[3] = nLocal. All types are encoded as integers, with the * same format as the one used in {@link Label}, but limited to BASE types. */ private int[] frame; /** * Number of elements in the exception handler list. */ private int handlerCount; /** * The first element in the exception handler list. */ private Handler firstHandler; /** * The last element in the exception handler list. */ private Handler lastHandler; /** * Number of entries in the LocalVariableTable attribute. */ private int localVarCount; /** * The LocalVariableTable attribute. */ private ByteVector localVar; /** * Number of entries in the LocalVariableTypeTable attribute. */ private int localVarTypeCount; /** * The LocalVariableTypeTable attribute. */ private ByteVector localVarType; /** * Number of entries in the LineNumberTable attribute. */ private int lineNumberCount; /** * The LineNumberTable attribute. */ private ByteVector lineNumber; /** * The non standard attributes of the method's code. */ private Attribute cattrs; /** * Indicates if some jump instructions are too small and need to be resized. */ private boolean resize; /** * The number of subroutines in this method. */ private int subroutines; // ------------------------------------------------------------------------ /* * Fields for the control flow graph analysis algorithm (used to compute the * maximum stack size). A control flow graph contains one node per "basic * block", and one edge per "jump" from one basic block to another. Each * node (i.e., each basic block) is represented by the Label object that * corresponds to the first instruction of this basic block. Each node also * stores the list of its successors in the graph, as a linked list of Edge * objects. */ /** * Indicates what must be automatically computed. * * @see #FRAMES * @see #MAXS * @see #NOTHING */ private final int compute; /** * A list of labels. This list is the list of basic blocks in the method, * i.e. a list of Label objects linked to each other by their * {@link Label#successor} field, in the order they are visited by * {@link MethodVisitor#visitLabel}, and starting with the first basic * block. */ private Label labels; /** * The previous basic block. */ private Label previousBlock; /** * The current basic block. */ private Label currentBlock; /** * The (relative) stack size after the last visited instruction. This size * is relative to the beginning of the current basic block, i.e., the true * stack size after the last visited instruction is equal to the * {@link Label#inputStackTop beginStackSize} of the current basic block * plus stackSize. */ private int stackSize; /** * The (relative) maximum stack size after the last visited instruction. * This size is relative to the beginning of the current basic block, i.e., * the true maximum stack size after the last visited instruction is equal * to the {@link Label#inputStackTop beginStackSize} of the current basic * block plus stackSize. */ private int maxStackSize; // ------------------------------------------------------------------------ // Constructor // ------------------------------------------------------------------------ /** * Constructs a new {@link MethodWriter}. * * @param cw * the class writer in which the method must be added. * @param access * the method's access flags (see {@link Opcodes}). * @param name * the method's name. * @param desc * the method's descriptor (see {@link Type}). * @param signature * the method's signature. May be null. * @param exceptions * the internal names of the method's exceptions. May be * null. * @param computeMaxs * true if the maximum stack size and number of local * variables must be automatically computed. * @param computeFrames * true if the stack map tables must be recomputed from * scratch. */ MethodWriter(final ClassWriter cw, final int access, final String name, final String desc, final String signature, final String[] exceptions, final boolean computeMaxs, final boolean computeFrames) { super(Opcodes.ASM4); if (cw.firstMethod == null) { cw.firstMethod = this; } else { cw.lastMethod.mv = this; } cw.lastMethod = this; this.cw = cw; this.access = access; if ("".equals(name)) { this.access |= ACC_CONSTRUCTOR; } this.name = cw.newUTF8(name); this.desc = cw.newUTF8(desc); this.descriptor = desc; if (ClassReader.SIGNATURES) { this.signature = signature; } if (exceptions != null && exceptions.length > 0) { exceptionCount = exceptions.length; this.exceptions = new int[exceptionCount]; for (int i = 0; i < exceptionCount; ++i) { this.exceptions[i] = cw.newClass(exceptions[i]); } } this.compute = computeFrames ? FRAMES : (computeMaxs ? MAXS : NOTHING); if (computeMaxs || computeFrames) { // updates maxLocals int size = Type.getArgumentsAndReturnSizes(descriptor) >> 2; if ((access & Opcodes.ACC_STATIC) != 0) { --size; } maxLocals = size; currentLocals = size; // creates and visits the label for the first basic block labels = new Label(); labels.status |= Label.PUSHED; visitLabel(labels); } } // ------------------------------------------------------------------------ // Implementation of the MethodVisitor abstract class // ------------------------------------------------------------------------ @Override public AnnotationVisitor visitAnnotationDefault() { if (!ClassReader.ANNOTATIONS) { return null; } annd = new ByteVector(); return new AnnotationWriter(cw, false, annd, null, 0); } @Override public AnnotationVisitor visitAnnotation(final String desc, final boolean visible) { if (!ClassReader.ANNOTATIONS) { return null; } ByteVector bv = new ByteVector(); // write type, and reserve space for values count bv.putShort(cw.newUTF8(desc)).putShort(0); AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2); if (visible) { aw.next = anns; anns = aw; } else { aw.next = ianns; ianns = aw; } return aw; } @Override public AnnotationVisitor visitParameterAnnotation(final int parameter, final String desc, final boolean visible) { if (!ClassReader.ANNOTATIONS) { return null; } ByteVector bv = new ByteVector(); if ("Ljava/lang/Synthetic;".equals(desc)) { // workaround for a bug in javac with synthetic parameters // see ClassReader.readParameterAnnotations synthetics = Math.max(synthetics, parameter + 1); return new AnnotationWriter(cw, false, bv, null, 0); } // write type, and reserve space for values count bv.putShort(cw.newUTF8(desc)).putShort(0); AnnotationWriter aw = new AnnotationWriter(cw, true, bv, bv, 2); if (visible) { if (panns == null) { panns = new AnnotationWriter[Type.getArgumentTypes(descriptor).length]; } aw.next = panns[parameter]; panns[parameter] = aw; } else { if (ipanns == null) { ipanns = new AnnotationWriter[Type.getArgumentTypes(descriptor).length]; } aw.next = ipanns[parameter]; ipanns[parameter] = aw; } return aw; } @Override public void visitAttribute(final Attribute attr) { if (attr.isCodeAttribute()) { attr.next = cattrs; cattrs = attr; } else { attr.next = attrs; attrs = attr; } } @Override public void visitCode() { } @Override public void visitFrame(final int type, final int nLocal, final Object[] local, final int nStack, final Object[] stack) { if (!ClassReader.FRAMES || compute == FRAMES) { return; } if (type == Opcodes.F_NEW) { if (previousFrame == null) { visitImplicitFirstFrame(); } currentLocals = nLocal; int frameIndex = startFrame(code.length, nLocal, nStack); for (int i = 0; i < nLocal; ++i) { if (local[i] instanceof String) { frame[frameIndex++] = Frame.OBJECT | cw.addType((String) local[i]); } else if (local[i] instanceof Integer) { frame[frameIndex++] = ((Integer) local[i]).intValue(); } else { frame[frameIndex++] = Frame.UNINITIALIZED | cw.addUninitializedType("", ((Label) local[i]).position); } } for (int i = 0; i < nStack; ++i) { if (stack[i] instanceof String) { frame[frameIndex++] = Frame.OBJECT | cw.addType((String) stack[i]); } else if (stack[i] instanceof Integer) { frame[frameIndex++] = ((Integer) stack[i]).intValue(); } else { frame[frameIndex++] = Frame.UNINITIALIZED | cw.addUninitializedType("", ((Label) stack[i]).position); } } endFrame(); } else { int delta; if (stackMap == null) { stackMap = new ByteVector(); delta = code.length; } else { delta = code.length - previousFrameOffset - 1; if (delta < 0) { if (type == Opcodes.F_SAME) { return; } else { throw new IllegalStateException(); } } } switch (type) { case Opcodes.F_FULL: currentLocals = nLocal; stackMap.putByte(FULL_FRAME).putShort(delta).putShort(nLocal); for (int i = 0; i < nLocal; ++i) { writeFrameType(local[i]); } stackMap.putShort(nStack); for (int i = 0; i < nStack; ++i) { writeFrameType(stack[i]); } break; case Opcodes.F_APPEND: currentLocals += nLocal; stackMap.putByte(SAME_FRAME_EXTENDED + nLocal).putShort(delta); for (int i = 0; i < nLocal; ++i) { writeFrameType(local[i]); } break; case Opcodes.F_CHOP: currentLocals -= nLocal; stackMap.putByte(SAME_FRAME_EXTENDED - nLocal).putShort(delta); break; case Opcodes.F_SAME: if (delta < 64) { stackMap.putByte(delta); } else { stackMap.putByte(SAME_FRAME_EXTENDED).putShort(delta); } break; case Opcodes.F_SAME1: if (delta < 64) { stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME + delta); } else { stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED) .putShort(delta); } writeFrameType(stack[0]); break; } previousFrameOffset = code.length; ++frameCount; } maxStack = Math.max(maxStack, nStack); maxLocals = Math.max(maxLocals, currentLocals); } @Override public void visitInsn(final int opcode) { // adds the instruction to the bytecode of the method code.putByte(opcode); // update currentBlock // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, 0, null, null); } else { // updates current and max stack sizes int size = stackSize + Frame.SIZE[opcode]; if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } // if opcode == ATHROW or xRETURN, ends current block (no successor) if ((opcode >= Opcodes.IRETURN && opcode <= Opcodes.RETURN) || opcode == Opcodes.ATHROW) { noSuccessor(); } } } @Override public void visitIntInsn(final int opcode, final int operand) { // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, operand, null, null); } else if (opcode != Opcodes.NEWARRAY) { // updates current and max stack sizes only for NEWARRAY // (stack size variation = 0 for BIPUSH or SIPUSH) int size = stackSize + 1; if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } // adds the instruction to the bytecode of the method if (opcode == Opcodes.SIPUSH) { code.put12(opcode, operand); } else { // BIPUSH or NEWARRAY code.put11(opcode, operand); } } @Override public void visitVarInsn(final int opcode, final int var) { // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, var, null, null); } else { // updates current and max stack sizes if (opcode == Opcodes.RET) { // no stack change, but end of current block (no successor) currentBlock.status |= Label.RET; // save 'stackSize' here for future use // (see {@link #findSubroutineSuccessors}) currentBlock.inputStackTop = stackSize; noSuccessor(); } else { // xLOAD or xSTORE int size = stackSize + Frame.SIZE[opcode]; if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } } if (compute != NOTHING) { // updates max locals int n; if (opcode == Opcodes.LLOAD || opcode == Opcodes.DLOAD || opcode == Opcodes.LSTORE || opcode == Opcodes.DSTORE) { n = var + 2; } else { n = var + 1; } if (n > maxLocals) { maxLocals = n; } } // adds the instruction to the bytecode of the method if (var < 4 && opcode != Opcodes.RET) { int opt; if (opcode < Opcodes.ISTORE) { /* ILOAD_0 */ opt = 26 + ((opcode - Opcodes.ILOAD) << 2) + var; } else { /* ISTORE_0 */ opt = 59 + ((opcode - Opcodes.ISTORE) << 2) + var; } code.putByte(opt); } else if (var >= 256) { code.putByte(196 /* WIDE */).put12(opcode, var); } else { code.put11(opcode, var); } if (opcode >= Opcodes.ISTORE && compute == FRAMES && handlerCount > 0) { visitLabel(new Label()); } } @Override public void visitTypeInsn(final int opcode, final String type) { Item i = cw.newClassItem(type); // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, code.length, cw, i); } else if (opcode == Opcodes.NEW) { // updates current and max stack sizes only if opcode == NEW // (no stack change for ANEWARRAY, CHECKCAST, INSTANCEOF) int size = stackSize + 1; if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } // adds the instruction to the bytecode of the method code.put12(opcode, i.index); } @Override public void visitFieldInsn(final int opcode, final String owner, final String name, final String desc) { Item i = cw.newFieldItem(owner, name, desc); // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, 0, cw, i); } else { int size; // computes the stack size variation char c = desc.charAt(0); switch (opcode) { case Opcodes.GETSTATIC: size = stackSize + (c == 'D' || c == 'J' ? 2 : 1); break; case Opcodes.PUTSTATIC: size = stackSize + (c == 'D' || c == 'J' ? -2 : -1); break; case Opcodes.GETFIELD: size = stackSize + (c == 'D' || c == 'J' ? 1 : 0); break; // case Constants.PUTFIELD: default: size = stackSize + (c == 'D' || c == 'J' ? -3 : -2); break; } // updates current and max stack sizes if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } // adds the instruction to the bytecode of the method code.put12(opcode, i.index); } @Override public void visitMethodInsn(final int opcode, final String owner, final String name, final String desc) { boolean itf = opcode == Opcodes.INVOKEINTERFACE; Item i = cw.newMethodItem(owner, name, desc, itf); int argSize = i.intVal; // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, 0, cw, i); } else { /* * computes the stack size variation. In order not to recompute * several times this variation for the same Item, we use the * intVal field of this item to store this variation, once it * has been computed. More precisely this intVal field stores * the sizes of the arguments and of the return value * corresponding to desc. */ if (argSize == 0) { // the above sizes have not been computed yet, // so we compute them... argSize = Type.getArgumentsAndReturnSizes(desc); // ... and we save them in order // not to recompute them in the future i.intVal = argSize; } int size; if (opcode == Opcodes.INVOKESTATIC) { size = stackSize - (argSize >> 2) + (argSize & 0x03) + 1; } else { size = stackSize - (argSize >> 2) + (argSize & 0x03); } // updates current and max stack sizes if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } // adds the instruction to the bytecode of the method if (itf) { if (argSize == 0) { argSize = Type.getArgumentsAndReturnSizes(desc); i.intVal = argSize; } code.put12(Opcodes.INVOKEINTERFACE, i.index).put11(argSize >> 2, 0); } else { code.put12(opcode, i.index); } } @Override public void visitInvokeDynamicInsn(final String name, final String desc, final Handle bsm, final Object... bsmArgs) { Item i = cw.newInvokeDynamicItem(name, desc, bsm, bsmArgs); int argSize = i.intVal; // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(Opcodes.INVOKEDYNAMIC, 0, cw, i); } else { /* * computes the stack size variation. In order not to recompute * several times this variation for the same Item, we use the * intVal field of this item to store this variation, once it * has been computed. More precisely this intVal field stores * the sizes of the arguments and of the return value * corresponding to desc. */ if (argSize == 0) { // the above sizes have not been computed yet, // so we compute them... argSize = Type.getArgumentsAndReturnSizes(desc); // ... and we save them in order // not to recompute them in the future i.intVal = argSize; } int size = stackSize - (argSize >> 2) + (argSize & 0x03) + 1; // updates current and max stack sizes if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } // adds the instruction to the bytecode of the method code.put12(Opcodes.INVOKEDYNAMIC, i.index); code.putShort(0); } @Override public void visitJumpInsn(final int opcode, final Label label) { Label nextInsn = null; // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(opcode, 0, null, null); // 'label' is the target of a jump instruction label.getFirst().status |= Label.TARGET; // adds 'label' as a successor of this basic block addSuccessor(Edge.NORMAL, label); if (opcode != Opcodes.GOTO) { // creates a Label for the next basic block nextInsn = new Label(); } } else { if (opcode == Opcodes.JSR) { if ((label.status & Label.SUBROUTINE) == 0) { label.status |= Label.SUBROUTINE; ++subroutines; } currentBlock.status |= Label.JSR; addSuccessor(stackSize + 1, label); // creates a Label for the next basic block nextInsn = new Label(); /* * note that, by construction in this method, a JSR block * has at least two successors in the control flow graph: * the first one leads the next instruction after the JSR, * while the second one leads to the JSR target. */ } else { // updates current stack size (max stack size unchanged // because stack size variation always negative in this // case) stackSize += Frame.SIZE[opcode]; addSuccessor(stackSize, label); } } } // adds the instruction to the bytecode of the method if ((label.status & Label.RESOLVED) != 0 && label.position - code.length < Short.MIN_VALUE) { /* * case of a backward jump with an offset < -32768. In this case we * automatically replace GOTO with GOTO_W, JSR with JSR_W and IFxxx * with IFNOTxxx GOTO_W , where IFNOTxxx is the * "opposite" opcode of IFxxx (i.e., IFNE for IFEQ) and where * designates the instruction just after the GOTO_W. */ if (opcode == Opcodes.GOTO) { code.putByte(200); // GOTO_W } else if (opcode == Opcodes.JSR) { code.putByte(201); // JSR_W } else { // if the IF instruction is transformed into IFNOT GOTO_W the // next instruction becomes the target of the IFNOT instruction if (nextInsn != null) { nextInsn.status |= Label.TARGET; } code.putByte(opcode <= 166 ? ((opcode + 1) ^ 1) - 1 : opcode ^ 1); code.putShort(8); // jump offset code.putByte(200); // GOTO_W } label.put(this, code, code.length - 1, true); } else { /* * case of a backward jump with an offset >= -32768, or of a forward * jump with, of course, an unknown offset. In these cases we store * the offset in 2 bytes (which will be increased in * resizeInstructions, if needed). */ code.putByte(opcode); label.put(this, code, code.length - 1, false); } if (currentBlock != null) { if (nextInsn != null) { // if the jump instruction is not a GOTO, the next instruction // is also a successor of this instruction. Calling visitLabel // adds the label of this next instruction as a successor of the // current block, and starts a new basic block visitLabel(nextInsn); } if (opcode == Opcodes.GOTO) { noSuccessor(); } } } @Override public void visitLabel(final Label label) { // resolves previous forward references to label, if any resize |= label.resolve(this, code.length, code.data); // updates currentBlock if ((label.status & Label.DEBUG) != 0) { return; } if (compute == FRAMES) { if (currentBlock != null) { if (label.position == currentBlock.position) { // successive labels, do not start a new basic block currentBlock.status |= (label.status & Label.TARGET); label.frame = currentBlock.frame; return; } // ends current block (with one new successor) addSuccessor(Edge.NORMAL, label); } // begins a new current block currentBlock = label; if (label.frame == null) { label.frame = new Frame(); label.frame.owner = label; } // updates the basic block list if (previousBlock != null) { if (label.position == previousBlock.position) { previousBlock.status |= (label.status & Label.TARGET); label.frame = previousBlock.frame; currentBlock = previousBlock; return; } previousBlock.successor = label; } previousBlock = label; } else if (compute == MAXS) { if (currentBlock != null) { // ends current block (with one new successor) currentBlock.outputStackMax = maxStackSize; addSuccessor(stackSize, label); } // begins a new current block currentBlock = label; // resets the relative current and max stack sizes stackSize = 0; maxStackSize = 0; // updates the basic block list if (previousBlock != null) { previousBlock.successor = label; } previousBlock = label; } } @Override public void visitLdcInsn(final Object cst) { Item i = cw.newConstItem(cst); // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(Opcodes.LDC, 0, cw, i); } else { int size; // computes the stack size variation if (i.type == ClassWriter.LONG || i.type == ClassWriter.DOUBLE) { size = stackSize + 2; } else { size = stackSize + 1; } // updates current and max stack sizes if (size > maxStackSize) { maxStackSize = size; } stackSize = size; } } // adds the instruction to the bytecode of the method int index = i.index; if (i.type == ClassWriter.LONG || i.type == ClassWriter.DOUBLE) { code.put12(20 /* LDC2_W */, index); } else if (index >= 256) { code.put12(19 /* LDC_W */, index); } else { code.put11(Opcodes.LDC, index); } } @Override public void visitIincInsn(final int var, final int increment) { if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(Opcodes.IINC, var, null, null); } } if (compute != NOTHING) { // updates max locals int n = var + 1; if (n > maxLocals) { maxLocals = n; } } // adds the instruction to the bytecode of the method if ((var > 255) || (increment > 127) || (increment < -128)) { code.putByte(196 /* WIDE */).put12(Opcodes.IINC, var) .putShort(increment); } else { code.putByte(Opcodes.IINC).put11(var, increment); } } @Override public void visitTableSwitchInsn(final int min, final int max, final Label dflt, final Label... labels) { // adds the instruction to the bytecode of the method int source = code.length; code.putByte(Opcodes.TABLESWITCH); code.putByteArray(null, 0, (4 - code.length % 4) % 4); dflt.put(this, code, source, true); code.putInt(min).putInt(max); for (int i = 0; i < labels.length; ++i) { labels[i].put(this, code, source, true); } // updates currentBlock visitSwitchInsn(dflt, labels); } @Override public void visitLookupSwitchInsn(final Label dflt, final int[] keys, final Label[] labels) { // adds the instruction to the bytecode of the method int source = code.length; code.putByte(Opcodes.LOOKUPSWITCH); code.putByteArray(null, 0, (4 - code.length % 4) % 4); dflt.put(this, code, source, true); code.putInt(labels.length); for (int i = 0; i < labels.length; ++i) { code.putInt(keys[i]); labels[i].put(this, code, source, true); } // updates currentBlock visitSwitchInsn(dflt, labels); } private void visitSwitchInsn(final Label dflt, final Label[] labels) { // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(Opcodes.LOOKUPSWITCH, 0, null, null); // adds current block successors addSuccessor(Edge.NORMAL, dflt); dflt.getFirst().status |= Label.TARGET; for (int i = 0; i < labels.length; ++i) { addSuccessor(Edge.NORMAL, labels[i]); labels[i].getFirst().status |= Label.TARGET; } } else { // updates current stack size (max stack size unchanged) --stackSize; // adds current block successors addSuccessor(stackSize, dflt); for (int i = 0; i < labels.length; ++i) { addSuccessor(stackSize, labels[i]); } } // ends current block noSuccessor(); } } @Override public void visitMultiANewArrayInsn(final String desc, final int dims) { Item i = cw.newClassItem(desc); // Label currentBlock = this.currentBlock; if (currentBlock != null) { if (compute == FRAMES) { currentBlock.frame.execute(Opcodes.MULTIANEWARRAY, dims, cw, i); } else { // updates current stack size (max stack size unchanged because // stack size variation always negative or null) stackSize += 1 - dims; } } // adds the instruction to the bytecode of the method code.put12(Opcodes.MULTIANEWARRAY, i.index).putByte(dims); } @Override public void visitTryCatchBlock(final Label start, final Label end, final Label handler, final String type) { ++handlerCount; Handler h = new Handler(); h.start = start; h.end = end; h.handler = handler; h.desc = type; h.type = type != null ? cw.newClass(type) : 0; if (lastHandler == null) { firstHandler = h; } else { lastHandler.next = h; } lastHandler = h; } @Override public void visitLocalVariable(final String name, final String desc, final String signature, final Label start, final Label end, final int index) { if (signature != null) { if (localVarType == null) { localVarType = new ByteVector(); } ++localVarTypeCount; localVarType.putShort(start.position) .putShort(end.position - start.position) .putShort(cw.newUTF8(name)).putShort(cw.newUTF8(signature)) .putShort(index); } if (localVar == null) { localVar = new ByteVector(); } ++localVarCount; localVar.putShort(start.position) .putShort(end.position - start.position) .putShort(cw.newUTF8(name)).putShort(cw.newUTF8(desc)) .putShort(index); if (compute != NOTHING) { // updates max locals char c = desc.charAt(0); int n = index + (c == 'J' || c == 'D' ? 2 : 1); if (n > maxLocals) { maxLocals = n; } } } @Override public void visitLineNumber(final int line, final Label start) { if (lineNumber == null) { lineNumber = new ByteVector(); } ++lineNumberCount; lineNumber.putShort(start.position); lineNumber.putShort(line); } @Override public void visitMaxs(final int maxStack, final int maxLocals) { if (ClassReader.FRAMES && compute == FRAMES) { // completes the control flow graph with exception handler blocks Handler handler = firstHandler; while (handler != null) { Label l = handler.start.getFirst(); Label h = handler.handler.getFirst(); Label e = handler.end.getFirst(); // computes the kind of the edges to 'h' String t = handler.desc == null ? "java/lang/Throwable" : handler.desc; int kind = Frame.OBJECT | cw.addType(t); // h is an exception handler h.status |= Label.TARGET; // adds 'h' as a successor of labels between 'start' and 'end' while (l != e) { // creates an edge to 'h' Edge b = new Edge(); b.info = kind; b.successor = h; // adds it to the successors of 'l' b.next = l.successors; l.successors = b; // goes to the next label l = l.successor; } handler = handler.next; } // creates and visits the first (implicit) frame Frame f = labels.frame; Type[] args = Type.getArgumentTypes(descriptor); f.initInputFrame(cw, access, args, this.maxLocals); visitFrame(f); /* * fix point algorithm: mark the first basic block as 'changed' * (i.e. put it in the 'changed' list) and, while there are changed * basic blocks, choose one, mark it as unchanged, and update its * successors (which can be changed in the process). */ int max = 0; Label changed = labels; while (changed != null) { // removes a basic block from the list of changed basic blocks Label l = changed; changed = changed.next; l.next = null; f = l.frame; // a reachable jump target must be stored in the stack map if ((l.status & Label.TARGET) != 0) { l.status |= Label.STORE; } // all visited labels are reachable, by definition l.status |= Label.REACHABLE; // updates the (absolute) maximum stack size int blockMax = f.inputStack.length + l.outputStackMax; if (blockMax > max) { max = blockMax; } // updates the successors of the current basic block Edge e = l.successors; while (e != null) { Label n = e.successor.getFirst(); boolean change = f.merge(cw, n.frame, e.info); if (change && n.next == null) { // if n has changed and is not already in the 'changed' // list, adds it to this list n.next = changed; changed = n; } e = e.next; } } // visits all the frames that must be stored in the stack map Label l = labels; while (l != null) { f = l.frame; if ((l.status & Label.STORE) != 0) { visitFrame(f); } if ((l.status & Label.REACHABLE) == 0) { // finds start and end of dead basic block Label k = l.successor; int start = l.position; int end = (k == null ? code.length : k.position) - 1; // if non empty basic block if (end >= start) { max = Math.max(max, 1); // replaces instructions with NOP ... NOP ATHROW for (int i = start; i < end; ++i) { code.data[i] = Opcodes.NOP; } code.data[end] = (byte) Opcodes.ATHROW; // emits a frame for this unreachable block int frameIndex = startFrame(start, 0, 1); frame[frameIndex] = Frame.OBJECT | cw.addType("java/lang/Throwable"); endFrame(); // removes the start-end range from the exception // handlers firstHandler = Handler.remove(firstHandler, l, k); } } l = l.successor; } handler = firstHandler; handlerCount = 0; while (handler != null) { handlerCount += 1; handler = handler.next; } this.maxStack = max; } else if (compute == MAXS) { // completes the control flow graph with exception handler blocks Handler handler = firstHandler; while (handler != null) { Label l = handler.start; Label h = handler.handler; Label e = handler.end; // adds 'h' as a successor of labels between 'start' and 'end' while (l != e) { // creates an edge to 'h' Edge b = new Edge(); b.info = Edge.EXCEPTION; b.successor = h; // adds it to the successors of 'l' if ((l.status & Label.JSR) == 0) { b.next = l.successors; l.successors = b; } else { // if l is a JSR block, adds b after the first two edges // to preserve the hypothesis about JSR block successors // order (see {@link #visitJumpInsn}) b.next = l.successors.next.next; l.successors.next.next = b; } // goes to the next label l = l.successor; } handler = handler.next; } if (subroutines > 0) { // completes the control flow graph with the RET successors /* * first step: finds the subroutines. This step determines, for * each basic block, to which subroutine(s) it belongs. */ // finds the basic blocks that belong to the "main" subroutine int id = 0; labels.visitSubroutine(null, 1, subroutines); // finds the basic blocks that belong to the real subroutines Label l = labels; while (l != null) { if ((l.status & Label.JSR) != 0) { // the subroutine is defined by l's TARGET, not by l Label subroutine = l.successors.next.successor; // if this subroutine has not been visited yet... if ((subroutine.status & Label.VISITED) == 0) { // ...assigns it a new id and finds its basic blocks id += 1; subroutine.visitSubroutine(null, (id / 32L) << 32 | (1L << (id % 32)), subroutines); } } l = l.successor; } // second step: finds the successors of RET blocks l = labels; while (l != null) { if ((l.status & Label.JSR) != 0) { Label L = labels; while (L != null) { L.status &= ~Label.VISITED2; L = L.successor; } // the subroutine is defined by l's TARGET, not by l Label subroutine = l.successors.next.successor; subroutine.visitSubroutine(l, 0, subroutines); } l = l.successor; } } /* * control flow analysis algorithm: while the block stack is not * empty, pop a block from this stack, update the max stack size, * compute the true (non relative) begin stack size of the * successors of this block, and push these successors onto the * stack (unless they have already been pushed onto the stack). * Note: by hypothesis, the {@link Label#inputStackTop} of the * blocks in the block stack are the true (non relative) beginning * stack sizes of these blocks. */ int max = 0; Label stack = labels; while (stack != null) { // pops a block from the stack Label l = stack; stack = stack.next; // computes the true (non relative) max stack size of this block int start = l.inputStackTop; int blockMax = start + l.outputStackMax; // updates the global max stack size if (blockMax > max) { max = blockMax; } // analyzes the successors of the block Edge b = l.successors; if ((l.status & Label.JSR) != 0) { // ignores the first edge of JSR blocks (virtual successor) b = b.next; } while (b != null) { l = b.successor; // if this successor has not already been pushed... if ((l.status & Label.PUSHED) == 0) { // computes its true beginning stack size... l.inputStackTop = b.info == Edge.EXCEPTION ? 1 : start + b.info; // ...and pushes it onto the stack l.status |= Label.PUSHED; l.next = stack; stack = l; } b = b.next; } } this.maxStack = Math.max(maxStack, max); } else { this.maxStack = maxStack; this.maxLocals = maxLocals; } } @Override public void visitEnd() { } // ------------------------------------------------------------------------ // Utility methods: control flow analysis algorithm // ------------------------------------------------------------------------ /** * Adds a successor to the {@link #currentBlock currentBlock} block. * * @param info * information about the control flow edge to be added. * @param successor * the successor block to be added to the current block. */ private void addSuccessor(final int info, final Label successor) { // creates and initializes an Edge object... Edge b = new Edge(); b.info = info; b.successor = successor; // ...and adds it to the successor list of the currentBlock block b.next = currentBlock.successors; currentBlock.successors = b; } /** * Ends the current basic block. This method must be used in the case where * the current basic block does not have any successor. */ private void noSuccessor() { if (compute == FRAMES) { Label l = new Label(); l.frame = new Frame(); l.frame.owner = l; l.resolve(this, code.length, code.data); previousBlock.successor = l; previousBlock = l; } else { currentBlock.outputStackMax = maxStackSize; } currentBlock = null; } // ------------------------------------------------------------------------ // Utility methods: stack map frames // ------------------------------------------------------------------------ /** * Visits a frame that has been computed from scratch. * * @param f * the frame that must be visited. */ private void visitFrame(final Frame f) { int i, t; int nTop = 0; int nLocal = 0; int nStack = 0; int[] locals = f.inputLocals; int[] stacks = f.inputStack; // computes the number of locals (ignores TOP types that are just after // a LONG or a DOUBLE, and all trailing TOP types) for (i = 0; i < locals.length; ++i) { t = locals[i]; if (t == Frame.TOP) { ++nTop; } else { nLocal += nTop + 1; nTop = 0; } if (t == Frame.LONG || t == Frame.DOUBLE) { ++i; } } // computes the stack size (ignores TOP types that are just after // a LONG or a DOUBLE) for (i = 0; i < stacks.length; ++i) { t = stacks[i]; ++nStack; if (t == Frame.LONG || t == Frame.DOUBLE) { ++i; } } // visits the frame and its content int frameIndex = startFrame(f.owner.position, nLocal, nStack); for (i = 0; nLocal > 0; ++i, --nLocal) { t = locals[i]; frame[frameIndex++] = t; if (t == Frame.LONG || t == Frame.DOUBLE) { ++i; } } for (i = 0; i < stacks.length; ++i) { t = stacks[i]; frame[frameIndex++] = t; if (t == Frame.LONG || t == Frame.DOUBLE) { ++i; } } endFrame(); } /** * Visit the implicit first frame of this method. */ private void visitImplicitFirstFrame() { // There can be at most descriptor.length() + 1 locals int frameIndex = startFrame(0, descriptor.length() + 1, 0); if ((access & Opcodes.ACC_STATIC) == 0) { if ((access & ACC_CONSTRUCTOR) == 0) { frame[frameIndex++] = Frame.OBJECT | cw.addType(cw.thisName); } else { frame[frameIndex++] = 6; // Opcodes.UNINITIALIZED_THIS; } } int i = 1; loop: while (true) { int j = i; switch (descriptor.charAt(i++)) { case 'Z': case 'C': case 'B': case 'S': case 'I': frame[frameIndex++] = 1; // Opcodes.INTEGER; break; case 'F': frame[frameIndex++] = 2; // Opcodes.FLOAT; break; case 'J': frame[frameIndex++] = 4; // Opcodes.LONG; break; case 'D': frame[frameIndex++] = 3; // Opcodes.DOUBLE; break; case '[': while (descriptor.charAt(i) == '[') { ++i; } if (descriptor.charAt(i) == 'L') { ++i; while (descriptor.charAt(i) != ';') { ++i; } } frame[frameIndex++] = Frame.OBJECT | cw.addType(descriptor.substring(j, ++i)); break; case 'L': while (descriptor.charAt(i) != ';') { ++i; } frame[frameIndex++] = Frame.OBJECT | cw.addType(descriptor.substring(j + 1, i++)); break; default: break loop; } } frame[1] = frameIndex - 3; endFrame(); } /** * Starts the visit of a stack map frame. * * @param offset * the offset of the instruction to which the frame corresponds. * @param nLocal * the number of local variables in the frame. * @param nStack * the number of stack elements in the frame. * @return the index of the next element to be written in this frame. */ private int startFrame(final int offset, final int nLocal, final int nStack) { int n = 3 + nLocal + nStack; if (frame == null || frame.length < n) { frame = new int[n]; } frame[0] = offset; frame[1] = nLocal; frame[2] = nStack; return 3; } /** * Checks if the visit of the current frame {@link #frame} is finished, and * if yes, write it in the StackMapTable attribute. */ private void endFrame() { if (previousFrame != null) { // do not write the first frame if (stackMap == null) { stackMap = new ByteVector(); } writeFrame(); ++frameCount; } previousFrame = frame; frame = null; } /** * Compress and writes the current frame {@link #frame} in the StackMapTable * attribute. */ private void writeFrame() { int clocalsSize = frame[1]; int cstackSize = frame[2]; if ((cw.version & 0xFFFF) < Opcodes.V1_6) { stackMap.putShort(frame[0]).putShort(clocalsSize); writeFrameTypes(3, 3 + clocalsSize); stackMap.putShort(cstackSize); writeFrameTypes(3 + clocalsSize, 3 + clocalsSize + cstackSize); return; } int localsSize = previousFrame[1]; int type = FULL_FRAME; int k = 0; int delta; if (frameCount == 0) { delta = frame[0]; } else { delta = frame[0] - previousFrame[0] - 1; } if (cstackSize == 0) { k = clocalsSize - localsSize; switch (k) { case -3: case -2: case -1: type = CHOP_FRAME; localsSize = clocalsSize; break; case 0: type = delta < 64 ? SAME_FRAME : SAME_FRAME_EXTENDED; break; case 1: case 2: case 3: type = APPEND_FRAME; break; } } else if (clocalsSize == localsSize && cstackSize == 1) { type = delta < 63 ? SAME_LOCALS_1_STACK_ITEM_FRAME : SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED; } if (type != FULL_FRAME) { // verify if locals are the same int l = 3; for (int j = 0; j < localsSize; j++) { if (frame[l] != previousFrame[l]) { type = FULL_FRAME; break; } l++; } } switch (type) { case SAME_FRAME: stackMap.putByte(delta); break; case SAME_LOCALS_1_STACK_ITEM_FRAME: stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME + delta); writeFrameTypes(3 + clocalsSize, 4 + clocalsSize); break; case SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED: stackMap.putByte(SAME_LOCALS_1_STACK_ITEM_FRAME_EXTENDED).putShort( delta); writeFrameTypes(3 + clocalsSize, 4 + clocalsSize); break; case SAME_FRAME_EXTENDED: stackMap.putByte(SAME_FRAME_EXTENDED).putShort(delta); break; case CHOP_FRAME: stackMap.putByte(SAME_FRAME_EXTENDED + k).putShort(delta); break; case APPEND_FRAME: stackMap.putByte(SAME_FRAME_EXTENDED + k).putShort(delta); writeFrameTypes(3 + localsSize, 3 + clocalsSize); break; // case FULL_FRAME: default: stackMap.putByte(FULL_FRAME).putShort(delta).putShort(clocalsSize); writeFrameTypes(3, 3 + clocalsSize); stackMap.putShort(cstackSize); writeFrameTypes(3 + clocalsSize, 3 + clocalsSize + cstackSize); } } /** * Writes some types of the current frame {@link #frame} into the * StackMapTableAttribute. This method converts types from the format used * in {@link Label} to the format used in StackMapTable attributes. In * particular, it converts type table indexes to constant pool indexes. * * @param start * index of the first type in {@link #frame} to write. * @param end * index of last type in {@link #frame} to write (exclusive). */ private void writeFrameTypes(final int start, final int end) { for (int i = start; i < end; ++i) { int t = frame[i]; int d = t & Frame.DIM; if (d == 0) { int v = t & Frame.BASE_VALUE; switch (t & Frame.BASE_KIND) { case Frame.OBJECT: stackMap.putByte(7).putShort( cw.newClass(cw.typeTable[v].strVal1)); break; case Frame.UNINITIALIZED: stackMap.putByte(8).putShort(cw.typeTable[v].intVal); break; default: stackMap.putByte(v); } } else { StringBuffer buf = new StringBuffer(); d >>= 28; while (d-- > 0) { buf.append('['); } if ((t & Frame.BASE_KIND) == Frame.OBJECT) { buf.append('L'); buf.append(cw.typeTable[t & Frame.BASE_VALUE].strVal1); buf.append(';'); } else { switch (t & 0xF) { case 1: buf.append('I'); break; case 2: buf.append('F'); break; case 3: buf.append('D'); break; case 9: buf.append('Z'); break; case 10: buf.append('B'); break; case 11: buf.append('C'); break; case 12: buf.append('S'); break; default: buf.append('J'); } } stackMap.putByte(7).putShort(cw.newClass(buf.toString())); } } } private void writeFrameType(final Object type) { if (type instanceof String) { stackMap.putByte(7).putShort(cw.newClass((String) type)); } else if (type instanceof Integer) { stackMap.putByte(((Integer) type).intValue()); } else { stackMap.putByte(8).putShort(((Label) type).position); } } // ------------------------------------------------------------------------ // Utility methods: dump bytecode array // ------------------------------------------------------------------------ /** * Returns the size of the bytecode of this method. * * @return the size of the bytecode of this method. */ final int getSize() { if (classReaderOffset != 0) { return 6 + classReaderLength; } if (resize) { // replaces the temporary jump opcodes introduced by Label.resolve. if (ClassReader.RESIZE) { resizeInstructions(); } else { throw new RuntimeException("Method code too large!"); } } int size = 8; if (code.length > 0) { if (code.length > 65536) { throw new RuntimeException("Method code too large!"); } cw.newUTF8("Code"); size += 18 + code.length + 8 * handlerCount; if (localVar != null) { cw.newUTF8("LocalVariableTable"); size += 8 + localVar.length; } if (localVarType != null) { cw.newUTF8("LocalVariableTypeTable"); size += 8 + localVarType.length; } if (lineNumber != null) { cw.newUTF8("LineNumberTable"); size += 8 + lineNumber.length; } if (stackMap != null) { boolean zip = (cw.version & 0xFFFF) >= Opcodes.V1_6; cw.newUTF8(zip ? "StackMapTable" : "StackMap"); size += 8 + stackMap.length; } if (cattrs != null) { size += cattrs.getSize(cw, code.data, code.length, maxStack, maxLocals); } } if (exceptionCount > 0) { cw.newUTF8("Exceptions"); size += 8 + 2 * exceptionCount; } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((cw.version & 0xFFFF) < Opcodes.V1_5 || (access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) != 0) { cw.newUTF8("Synthetic"); size += 6; } } if ((access & Opcodes.ACC_DEPRECATED) != 0) { cw.newUTF8("Deprecated"); size += 6; } if (ClassReader.SIGNATURES && signature != null) { cw.newUTF8("Signature"); cw.newUTF8(signature); size += 8; } if (ClassReader.ANNOTATIONS && annd != null) { cw.newUTF8("AnnotationDefault"); size += 6 + annd.length; } if (ClassReader.ANNOTATIONS && anns != null) { cw.newUTF8("RuntimeVisibleAnnotations"); size += 8 + anns.getSize(); } if (ClassReader.ANNOTATIONS && ianns != null) { cw.newUTF8("RuntimeInvisibleAnnotations"); size += 8 + ianns.getSize(); } if (ClassReader.ANNOTATIONS && panns != null) { cw.newUTF8("RuntimeVisibleParameterAnnotations"); size += 7 + 2 * (panns.length - synthetics); for (int i = panns.length - 1; i >= synthetics; --i) { size += panns[i] == null ? 0 : panns[i].getSize(); } } if (ClassReader.ANNOTATIONS && ipanns != null) { cw.newUTF8("RuntimeInvisibleParameterAnnotations"); size += 7 + 2 * (ipanns.length - synthetics); for (int i = ipanns.length - 1; i >= synthetics; --i) { size += ipanns[i] == null ? 0 : ipanns[i].getSize(); } } if (attrs != null) { size += attrs.getSize(cw, null, 0, -1, -1); } return size; } /** * Puts the bytecode of this method in the given byte vector. * * @param out * the byte vector into which the bytecode of this method must be * copied. */ final void put(final ByteVector out) { final int FACTOR = ClassWriter.TO_ACC_SYNTHETIC; int mask = ACC_CONSTRUCTOR | Opcodes.ACC_DEPRECATED | ClassWriter.ACC_SYNTHETIC_ATTRIBUTE | ((access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) / FACTOR); out.putShort(access & ~mask).putShort(name).putShort(desc); if (classReaderOffset != 0) { out.putByteArray(cw.cr.b, classReaderOffset, classReaderLength); return; } int attributeCount = 0; if (code.length > 0) { ++attributeCount; } if (exceptionCount > 0) { ++attributeCount; } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((cw.version & 0xFFFF) < Opcodes.V1_5 || (access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) != 0) { ++attributeCount; } } if ((access & Opcodes.ACC_DEPRECATED) != 0) { ++attributeCount; } if (ClassReader.SIGNATURES && signature != null) { ++attributeCount; } if (ClassReader.ANNOTATIONS && annd != null) { ++attributeCount; } if (ClassReader.ANNOTATIONS && anns != null) { ++attributeCount; } if (ClassReader.ANNOTATIONS && ianns != null) { ++attributeCount; } if (ClassReader.ANNOTATIONS && panns != null) { ++attributeCount; } if (ClassReader.ANNOTATIONS && ipanns != null) { ++attributeCount; } if (attrs != null) { attributeCount += attrs.getCount(); } out.putShort(attributeCount); if (code.length > 0) { int size = 12 + code.length + 8 * handlerCount; if (localVar != null) { size += 8 + localVar.length; } if (localVarType != null) { size += 8 + localVarType.length; } if (lineNumber != null) { size += 8 + lineNumber.length; } if (stackMap != null) { size += 8 + stackMap.length; } if (cattrs != null) { size += cattrs.getSize(cw, code.data, code.length, maxStack, maxLocals); } out.putShort(cw.newUTF8("Code")).putInt(size); out.putShort(maxStack).putShort(maxLocals); out.putInt(code.length).putByteArray(code.data, 0, code.length); out.putShort(handlerCount); if (handlerCount > 0) { Handler h = firstHandler; while (h != null) { out.putShort(h.start.position).putShort(h.end.position) .putShort(h.handler.position).putShort(h.type); h = h.next; } } attributeCount = 0; if (localVar != null) { ++attributeCount; } if (localVarType != null) { ++attributeCount; } if (lineNumber != null) { ++attributeCount; } if (stackMap != null) { ++attributeCount; } if (cattrs != null) { attributeCount += cattrs.getCount(); } out.putShort(attributeCount); if (localVar != null) { out.putShort(cw.newUTF8("LocalVariableTable")); out.putInt(localVar.length + 2).putShort(localVarCount); out.putByteArray(localVar.data, 0, localVar.length); } if (localVarType != null) { out.putShort(cw.newUTF8("LocalVariableTypeTable")); out.putInt(localVarType.length + 2).putShort(localVarTypeCount); out.putByteArray(localVarType.data, 0, localVarType.length); } if (lineNumber != null) { out.putShort(cw.newUTF8("LineNumberTable")); out.putInt(lineNumber.length + 2).putShort(lineNumberCount); out.putByteArray(lineNumber.data, 0, lineNumber.length); } if (stackMap != null) { boolean zip = (cw.version & 0xFFFF) >= Opcodes.V1_6; out.putShort(cw.newUTF8(zip ? "StackMapTable" : "StackMap")); out.putInt(stackMap.length + 2).putShort(frameCount); out.putByteArray(stackMap.data, 0, stackMap.length); } if (cattrs != null) { cattrs.put(cw, code.data, code.length, maxLocals, maxStack, out); } } if (exceptionCount > 0) { out.putShort(cw.newUTF8("Exceptions")).putInt( 2 * exceptionCount + 2); out.putShort(exceptionCount); for (int i = 0; i < exceptionCount; ++i) { out.putShort(exceptions[i]); } } if ((access & Opcodes.ACC_SYNTHETIC) != 0) { if ((cw.version & 0xFFFF) < Opcodes.V1_5 || (access & ClassWriter.ACC_SYNTHETIC_ATTRIBUTE) != 0) { out.putShort(cw.newUTF8("Synthetic")).putInt(0); } } if ((access & Opcodes.ACC_DEPRECATED) != 0) { out.putShort(cw.newUTF8("Deprecated")).putInt(0); } if (ClassReader.SIGNATURES && signature != null) { out.putShort(cw.newUTF8("Signature")).putInt(2) .putShort(cw.newUTF8(signature)); } if (ClassReader.ANNOTATIONS && annd != null) { out.putShort(cw.newUTF8("AnnotationDefault")); out.putInt(annd.length); out.putByteArray(annd.data, 0, annd.length); } if (ClassReader.ANNOTATIONS && anns != null) { out.putShort(cw.newUTF8("RuntimeVisibleAnnotations")); anns.put(out); } if (ClassReader.ANNOTATIONS && ianns != null) { out.putShort(cw.newUTF8("RuntimeInvisibleAnnotations")); ianns.put(out); } if (ClassReader.ANNOTATIONS && panns != null) { out.putShort(cw.newUTF8("RuntimeVisibleParameterAnnotations")); AnnotationWriter.put(panns, synthetics, out); } if (ClassReader.ANNOTATIONS && ipanns != null) { out.putShort(cw.newUTF8("RuntimeInvisibleParameterAnnotations")); AnnotationWriter.put(ipanns, synthetics, out); } if (attrs != null) { attrs.put(cw, null, 0, -1, -1, out); } } // ------------------------------------------------------------------------ // Utility methods: instruction resizing (used to handle GOTO_W and JSR_W) // ------------------------------------------------------------------------ /** * Resizes and replaces the temporary instructions inserted by * {@link Label#resolve} for wide forward jumps, while keeping jump offsets * and instruction addresses consistent. This may require to resize other * existing instructions, or even to introduce new instructions: for * example, increasing the size of an instruction by 2 at the middle of a * method can increases the offset of an IFEQ instruction from 32766 to * 32768, in which case IFEQ 32766 must be replaced with IFNEQ 8 GOTO_W * 32765. This, in turn, may require to increase the size of another jump * instruction, and so on... All these operations are handled automatically * by this method. *

* This method must be called after all the method that is being built * has been visited. In particular, the {@link Label Label} objects used * to construct the method are no longer valid after this method has been * called. */ private void resizeInstructions() { byte[] b = code.data; // bytecode of the method int u, v, label; // indexes in b int i, j; // loop indexes /* * 1st step: As explained above, resizing an instruction may require to * resize another one, which may require to resize yet another one, and * so on. The first step of the algorithm consists in finding all the * instructions that need to be resized, without modifying the code. * This is done by the following "fix point" algorithm: * * Parse the code to find the jump instructions whose offset will need * more than 2 bytes to be stored (the future offset is computed from * the current offset and from the number of bytes that will be inserted * or removed between the source and target instructions). For each such * instruction, adds an entry in (a copy of) the indexes and sizes * arrays (if this has not already been done in a previous iteration!). * * If at least one entry has been added during the previous step, go * back to the beginning, otherwise stop. * * In fact the real algorithm is complicated by the fact that the size * of TABLESWITCH and LOOKUPSWITCH instructions depends on their * position in the bytecode (because of padding). In order to ensure the * convergence of the algorithm, the number of bytes to be added or * removed from these instructions is over estimated during the previous * loop, and computed exactly only after the loop is finished (this * requires another pass to parse the bytecode of the method). */ int[] allIndexes = new int[0]; // copy of indexes int[] allSizes = new int[0]; // copy of sizes boolean[] resize; // instructions to be resized int newOffset; // future offset of a jump instruction resize = new boolean[code.length]; // 3 = loop again, 2 = loop ended, 1 = last pass, 0 = done int state = 3; do { if (state == 3) { state = 2; } u = 0; while (u < b.length) { int opcode = b[u] & 0xFF; // opcode of current instruction int insert = 0; // bytes to be added after this instruction switch (ClassWriter.TYPE[opcode]) { case ClassWriter.NOARG_INSN: case ClassWriter.IMPLVAR_INSN: u += 1; break; case ClassWriter.LABEL_INSN: if (opcode > 201) { // converts temporary opcodes 202 to 217, 218 and // 219 to IFEQ ... JSR (inclusive), IFNULL and // IFNONNULL opcode = opcode < 218 ? opcode - 49 : opcode - 20; label = u + readUnsignedShort(b, u + 1); } else { label = u + readShort(b, u + 1); } newOffset = getNewOffset(allIndexes, allSizes, u, label); if (newOffset < Short.MIN_VALUE || newOffset > Short.MAX_VALUE) { if (!resize[u]) { if (opcode == Opcodes.GOTO || opcode == Opcodes.JSR) { // two additional bytes will be required to // replace this GOTO or JSR instruction with // a GOTO_W or a JSR_W insert = 2; } else { // five additional bytes will be required to // replace this IFxxx instruction with // IFNOTxxx GOTO_W , where IFNOTxxx // is the "opposite" opcode of IFxxx (i.e., // IFNE for IFEQ) and where designates // the instruction just after the GOTO_W. insert = 5; } resize[u] = true; } } u += 3; break; case ClassWriter.LABELW_INSN: u += 5; break; case ClassWriter.TABL_INSN: if (state == 1) { // true number of bytes to be added (or removed) // from this instruction = (future number of padding // bytes - current number of padding byte) - // previously over estimated variation = // = ((3 - newOffset%4) - (3 - u%4)) - u%4 // = (-newOffset%4 + u%4) - u%4 // = -(newOffset & 3) newOffset = getNewOffset(allIndexes, allSizes, 0, u); insert = -(newOffset & 3); } else if (!resize[u]) { // over estimation of the number of bytes to be // added to this instruction = 3 - current number // of padding bytes = 3 - (3 - u%4) = u%4 = u & 3 insert = u & 3; resize[u] = true; } // skips instruction u = u + 4 - (u & 3); u += 4 * (readInt(b, u + 8) - readInt(b, u + 4) + 1) + 12; break; case ClassWriter.LOOK_INSN: if (state == 1) { // like TABL_INSN newOffset = getNewOffset(allIndexes, allSizes, 0, u); insert = -(newOffset & 3); } else if (!resize[u]) { // like TABL_INSN insert = u & 3; resize[u] = true; } // skips instruction u = u + 4 - (u & 3); u += 8 * readInt(b, u + 4) + 8; break; case ClassWriter.WIDE_INSN: opcode = b[u + 1] & 0xFF; if (opcode == Opcodes.IINC) { u += 6; } else { u += 4; } break; case ClassWriter.VAR_INSN: case ClassWriter.SBYTE_INSN: case ClassWriter.LDC_INSN: u += 2; break; case ClassWriter.SHORT_INSN: case ClassWriter.LDCW_INSN: case ClassWriter.FIELDORMETH_INSN: case ClassWriter.TYPE_INSN: case ClassWriter.IINC_INSN: u += 3; break; case ClassWriter.ITFMETH_INSN: case ClassWriter.INDYMETH_INSN: u += 5; break; // case ClassWriter.MANA_INSN: default: u += 4; break; } if (insert != 0) { // adds a new (u, insert) entry in the allIndexes and // allSizes arrays int[] newIndexes = new int[allIndexes.length + 1]; int[] newSizes = new int[allSizes.length + 1]; System.arraycopy(allIndexes, 0, newIndexes, 0, allIndexes.length); System.arraycopy(allSizes, 0, newSizes, 0, allSizes.length); newIndexes[allIndexes.length] = u; newSizes[allSizes.length] = insert; allIndexes = newIndexes; allSizes = newSizes; if (insert > 0) { state = 3; } } } if (state < 3) { --state; } } while (state != 0); // 2nd step: // copies the bytecode of the method into a new bytevector, updates the // offsets, and inserts (or removes) bytes as requested. ByteVector newCode = new ByteVector(code.length); u = 0; while (u < code.length) { int opcode = b[u] & 0xFF; switch (ClassWriter.TYPE[opcode]) { case ClassWriter.NOARG_INSN: case ClassWriter.IMPLVAR_INSN: newCode.putByte(opcode); u += 1; break; case ClassWriter.LABEL_INSN: if (opcode > 201) { // changes temporary opcodes 202 to 217 (inclusive), 218 // and 219 to IFEQ ... JSR (inclusive), IFNULL and // IFNONNULL opcode = opcode < 218 ? opcode - 49 : opcode - 20; label = u + readUnsignedShort(b, u + 1); } else { label = u + readShort(b, u + 1); } newOffset = getNewOffset(allIndexes, allSizes, u, label); if (resize[u]) { // replaces GOTO with GOTO_W, JSR with JSR_W and IFxxx // with IFNOTxxx GOTO_W , where IFNOTxxx is // the "opposite" opcode of IFxxx (i.e., IFNE for IFEQ) // and where designates the instruction just after // the GOTO_W. if (opcode == Opcodes.GOTO) { newCode.putByte(200); // GOTO_W } else if (opcode == Opcodes.JSR) { newCode.putByte(201); // JSR_W } else { newCode.putByte(opcode <= 166 ? ((opcode + 1) ^ 1) - 1 : opcode ^ 1); newCode.putShort(8); // jump offset newCode.putByte(200); // GOTO_W // newOffset now computed from start of GOTO_W newOffset -= 3; } newCode.putInt(newOffset); } else { newCode.putByte(opcode); newCode.putShort(newOffset); } u += 3; break; case ClassWriter.LABELW_INSN: label = u + readInt(b, u + 1); newOffset = getNewOffset(allIndexes, allSizes, u, label); newCode.putByte(opcode); newCode.putInt(newOffset); u += 5; break; case ClassWriter.TABL_INSN: // skips 0 to 3 padding bytes v = u; u = u + 4 - (v & 3); // reads and copies instruction newCode.putByte(Opcodes.TABLESWITCH); newCode.putByteArray(null, 0, (4 - newCode.length % 4) % 4); label = v + readInt(b, u); u += 4; newOffset = getNewOffset(allIndexes, allSizes, v, label); newCode.putInt(newOffset); j = readInt(b, u); u += 4; newCode.putInt(j); j = readInt(b, u) - j + 1; u += 4; newCode.putInt(readInt(b, u - 4)); for (; j > 0; --j) { label = v + readInt(b, u); u += 4; newOffset = getNewOffset(allIndexes, allSizes, v, label); newCode.putInt(newOffset); } break; case ClassWriter.LOOK_INSN: // skips 0 to 3 padding bytes v = u; u = u + 4 - (v & 3); // reads and copies instruction newCode.putByte(Opcodes.LOOKUPSWITCH); newCode.putByteArray(null, 0, (4 - newCode.length % 4) % 4); label = v + readInt(b, u); u += 4; newOffset = getNewOffset(allIndexes, allSizes, v, label); newCode.putInt(newOffset); j = readInt(b, u); u += 4; newCode.putInt(j); for (; j > 0; --j) { newCode.putInt(readInt(b, u)); u += 4; label = v + readInt(b, u); u += 4; newOffset = getNewOffset(allIndexes, allSizes, v, label); newCode.putInt(newOffset); } break; case ClassWriter.WIDE_INSN: opcode = b[u + 1] & 0xFF; if (opcode == Opcodes.IINC) { newCode.putByteArray(b, u, 6); u += 6; } else { newCode.putByteArray(b, u, 4); u += 4; } break; case ClassWriter.VAR_INSN: case ClassWriter.SBYTE_INSN: case ClassWriter.LDC_INSN: newCode.putByteArray(b, u, 2); u += 2; break; case ClassWriter.SHORT_INSN: case ClassWriter.LDCW_INSN: case ClassWriter.FIELDORMETH_INSN: case ClassWriter.TYPE_INSN: case ClassWriter.IINC_INSN: newCode.putByteArray(b, u, 3); u += 3; break; case ClassWriter.ITFMETH_INSN: case ClassWriter.INDYMETH_INSN: newCode.putByteArray(b, u, 5); u += 5; break; // case MANA_INSN: default: newCode.putByteArray(b, u, 4); u += 4; break; } } // recomputes the stack map frames if (frameCount > 0) { if (compute == FRAMES) { frameCount = 0; stackMap = null; previousFrame = null; frame = null; Frame f = new Frame(); f.owner = labels; Type[] args = Type.getArgumentTypes(descriptor); f.initInputFrame(cw, access, args, maxLocals); visitFrame(f); Label l = labels; while (l != null) { /* * here we need the original label position. getNewOffset * must therefore never have been called for this label. */ u = l.position - 3; if ((l.status & Label.STORE) != 0 || (u >= 0 && resize[u])) { getNewOffset(allIndexes, allSizes, l); // TODO update offsets in UNINITIALIZED values visitFrame(l.frame); } l = l.successor; } } else { /* * Resizing an existing stack map frame table is really hard. * Not only the table must be parsed to update the offets, but * new frames may be needed for jump instructions that were * inserted by this method. And updating the offsets or * inserting frames can change the format of the following * frames, in case of packed frames. In practice the whole table * must be recomputed. For this the frames are marked as * potentially invalid. This will cause the whole class to be * reread and rewritten with the COMPUTE_FRAMES option (see the * ClassWriter.toByteArray method). This is not very efficient * but is much easier and requires much less code than any other * method I can think of. */ cw.invalidFrames = true; } } // updates the exception handler block labels Handler h = firstHandler; while (h != null) { getNewOffset(allIndexes, allSizes, h.start); getNewOffset(allIndexes, allSizes, h.end); getNewOffset(allIndexes, allSizes, h.handler); h = h.next; } // updates the instructions addresses in the // local var and line number tables for (i = 0; i < 2; ++i) { ByteVector bv = i == 0 ? localVar : localVarType; if (bv != null) { b = bv.data; u = 0; while (u < bv.length) { label = readUnsignedShort(b, u); newOffset = getNewOffset(allIndexes, allSizes, 0, label); writeShort(b, u, newOffset); label += readUnsignedShort(b, u + 2); newOffset = getNewOffset(allIndexes, allSizes, 0, label) - newOffset; writeShort(b, u + 2, newOffset); u += 10; } } } if (lineNumber != null) { b = lineNumber.data; u = 0; while (u < lineNumber.length) { writeShort( b, u, getNewOffset(allIndexes, allSizes, 0, readUnsignedShort(b, u))); u += 4; } } // updates the labels of the other attributes Attribute attr = cattrs; while (attr != null) { Label[] labels = attr.getLabels(); if (labels != null) { for (i = labels.length - 1; i >= 0; --i) { getNewOffset(allIndexes, allSizes, labels[i]); } } attr = attr.next; } // replaces old bytecodes with new ones code = newCode; } /** * Reads an unsigned short value in the given byte array. * * @param b * a byte array. * @param index * the start index of the value to be read. * @return the read value. */ static int readUnsignedShort(final byte[] b, final int index) { return ((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF); } /** * Reads a signed short value in the given byte array. * * @param b * a byte array. * @param index * the start index of the value to be read. * @return the read value. */ static short readShort(final byte[] b, final int index) { return (short) (((b[index] & 0xFF) << 8) | (b[index + 1] & 0xFF)); } /** * Reads a signed int value in the given byte array. * * @param b * a byte array. * @param index * the start index of the value to be read. * @return the read value. */ static int readInt(final byte[] b, final int index) { return ((b[index] & 0xFF) << 24) | ((b[index + 1] & 0xFF) << 16) | ((b[index + 2] & 0xFF) << 8) | (b[index + 3] & 0xFF); } /** * Writes a short value in the given byte array. * * @param b * a byte array. * @param index * where the first byte of the short value must be written. * @param s * the value to be written in the given byte array. */ static void writeShort(final byte[] b, final int index, final int s) { b[index] = (byte) (s >>> 8); b[index + 1] = (byte) s; } /** * Computes the future value of a bytecode offset. *

* Note: it is possible to have several entries for the same instruction in * the indexes and sizes: two entries (index=a,size=b) and * (index=a,size=b') are equivalent to a single entry (index=a,size=b+b'). * * @param indexes * current positions of the instructions to be resized. Each * instruction must be designated by the index of its last * byte, plus one (or, in other words, by the index of the * first byte of the next instruction). * @param sizes * the number of bytes to be added to the above * instructions. More precisely, for each i < len, * sizes[i] bytes will be added at the end of the * instruction designated by indexes[i] or, if * sizes[i] is negative, the last | * sizes[i]| bytes of the instruction will be removed * (the instruction size must not become negative or * null). * @param begin * index of the first byte of the source instruction. * @param end * index of the first byte of the target instruction. * @return the future value of the given bytecode offset. */ static int getNewOffset(final int[] indexes, final int[] sizes, final int begin, final int end) { int offset = end - begin; for (int i = 0; i < indexes.length; ++i) { if (begin < indexes[i] && indexes[i] <= end) { // forward jump offset += sizes[i]; } else if (end < indexes[i] && indexes[i] <= begin) { // backward jump offset -= sizes[i]; } } return offset; } /** * Updates the offset of the given label. * * @param indexes * current positions of the instructions to be resized. Each * instruction must be designated by the index of its last * byte, plus one (or, in other words, by the index of the * first byte of the next instruction). * @param sizes * the number of bytes to be added to the above * instructions. More precisely, for each i < len, * sizes[i] bytes will be added at the end of the * instruction designated by indexes[i] or, if * sizes[i] is negative, the last | * sizes[i]| bytes of the instruction will be removed * (the instruction size must not become negative or * null). * @param label * the label whose offset must be updated. */ static void getNewOffset(final int[] indexes, final int[] sizes, final Label label) { if ((label.status & Label.RESIZED) == 0) { label.position = getNewOffset(indexes, sizes, 0, label.position); label.status |= Label.RESIZED; } } } ================================================ FILE: src/jvm/clojure/asm/Opcodes.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; /** * Defines the JVM opcodes, access flags and array type codes. This interface * does not define all the JVM opcodes because some opcodes are automatically * handled. For example, the xLOAD and xSTORE opcodes are automatically replaced * by xLOAD_n and xSTORE_n opcodes when possible. The xLOAD_n and xSTORE_n * opcodes are therefore not defined in this interface. Likewise for LDC, * automatically replaced by LDC_W or LDC2_W when necessary, WIDE, GOTO_W and * JSR_W. * * @author Eric Bruneton * @author Eugene Kuleshov */ public interface Opcodes { // ASM API versions int ASM4 = 4 << 16 | 0 << 8 | 0; // versions int V1_1 = 3 << 16 | 45; int V1_2 = 0 << 16 | 46; int V1_3 = 0 << 16 | 47; int V1_4 = 0 << 16 | 48; int V1_5 = 0 << 16 | 49; int V1_6 = 0 << 16 | 50; int V1_7 = 0 << 16 | 51; // access flags int ACC_PUBLIC = 0x0001; // class, field, method int ACC_PRIVATE = 0x0002; // class, field, method int ACC_PROTECTED = 0x0004; // class, field, method int ACC_STATIC = 0x0008; // field, method int ACC_FINAL = 0x0010; // class, field, method int ACC_SUPER = 0x0020; // class int ACC_SYNCHRONIZED = 0x0020; // method int ACC_VOLATILE = 0x0040; // field int ACC_BRIDGE = 0x0040; // method int ACC_VARARGS = 0x0080; // method int ACC_TRANSIENT = 0x0080; // field int ACC_NATIVE = 0x0100; // method int ACC_INTERFACE = 0x0200; // class int ACC_ABSTRACT = 0x0400; // class, method int ACC_STRICT = 0x0800; // method int ACC_SYNTHETIC = 0x1000; // class, field, method int ACC_ANNOTATION = 0x2000; // class int ACC_ENUM = 0x4000; // class(?) field inner // ASM specific pseudo access flags int ACC_DEPRECATED = 0x20000; // class, field, method // types for NEWARRAY int T_BOOLEAN = 4; int T_CHAR = 5; int T_FLOAT = 6; int T_DOUBLE = 7; int T_BYTE = 8; int T_SHORT = 9; int T_INT = 10; int T_LONG = 11; // tags for Handle int H_GETFIELD = 1; int H_GETSTATIC = 2; int H_PUTFIELD = 3; int H_PUTSTATIC = 4; int H_INVOKEVIRTUAL = 5; int H_INVOKESTATIC = 6; int H_INVOKESPECIAL = 7; int H_NEWINVOKESPECIAL = 8; int H_INVOKEINTERFACE = 9; // stack map frame types /** * Represents an expanded frame. See {@link ClassReader#EXPAND_FRAMES}. */ int F_NEW = -1; /** * Represents a compressed frame with complete frame data. */ int F_FULL = 0; /** * Represents a compressed frame where locals are the same as the locals in * the previous frame, except that additional 1-3 locals are defined, and * with an empty stack. */ int F_APPEND = 1; /** * Represents a compressed frame where locals are the same as the locals in * the previous frame, except that the last 1-3 locals are absent and with * an empty stack. */ int F_CHOP = 2; /** * Represents a compressed frame with exactly the same locals as the * previous frame and with an empty stack. */ int F_SAME = 3; /** * Represents a compressed frame with exactly the same locals as the * previous frame and with a single value on the stack. */ int F_SAME1 = 4; Integer TOP = new Integer(0); Integer INTEGER = new Integer(1); Integer FLOAT = new Integer(2); Integer DOUBLE = new Integer(3); Integer LONG = new Integer(4); Integer NULL = new Integer(5); Integer UNINITIALIZED_THIS = new Integer(6); // opcodes // visit method (- = idem) int NOP = 0; // visitInsn int ACONST_NULL = 1; // - int ICONST_M1 = 2; // - int ICONST_0 = 3; // - int ICONST_1 = 4; // - int ICONST_2 = 5; // - int ICONST_3 = 6; // - int ICONST_4 = 7; // - int ICONST_5 = 8; // - int LCONST_0 = 9; // - int LCONST_1 = 10; // - int FCONST_0 = 11; // - int FCONST_1 = 12; // - int FCONST_2 = 13; // - int DCONST_0 = 14; // - int DCONST_1 = 15; // - int BIPUSH = 16; // visitIntInsn int SIPUSH = 17; // - int LDC = 18; // visitLdcInsn // int LDC_W = 19; // - // int LDC2_W = 20; // - int ILOAD = 21; // visitVarInsn int LLOAD = 22; // - int FLOAD = 23; // - int DLOAD = 24; // - int ALOAD = 25; // - // int ILOAD_0 = 26; // - // int ILOAD_1 = 27; // - // int ILOAD_2 = 28; // - // int ILOAD_3 = 29; // - // int LLOAD_0 = 30; // - // int LLOAD_1 = 31; // - // int LLOAD_2 = 32; // - // int LLOAD_3 = 33; // - // int FLOAD_0 = 34; // - // int FLOAD_1 = 35; // - // int FLOAD_2 = 36; // - // int FLOAD_3 = 37; // - // int DLOAD_0 = 38; // - // int DLOAD_1 = 39; // - // int DLOAD_2 = 40; // - // int DLOAD_3 = 41; // - // int ALOAD_0 = 42; // - // int ALOAD_1 = 43; // - // int ALOAD_2 = 44; // - // int ALOAD_3 = 45; // - int IALOAD = 46; // visitInsn int LALOAD = 47; // - int FALOAD = 48; // - int DALOAD = 49; // - int AALOAD = 50; // - int BALOAD = 51; // - int CALOAD = 52; // - int SALOAD = 53; // - int ISTORE = 54; // visitVarInsn int LSTORE = 55; // - int FSTORE = 56; // - int DSTORE = 57; // - int ASTORE = 58; // - // int ISTORE_0 = 59; // - // int ISTORE_1 = 60; // - // int ISTORE_2 = 61; // - // int ISTORE_3 = 62; // - // int LSTORE_0 = 63; // - // int LSTORE_1 = 64; // - // int LSTORE_2 = 65; // - // int LSTORE_3 = 66; // - // int FSTORE_0 = 67; // - // int FSTORE_1 = 68; // - // int FSTORE_2 = 69; // - // int FSTORE_3 = 70; // - // int DSTORE_0 = 71; // - // int DSTORE_1 = 72; // - // int DSTORE_2 = 73; // - // int DSTORE_3 = 74; // - // int ASTORE_0 = 75; // - // int ASTORE_1 = 76; // - // int ASTORE_2 = 77; // - // int ASTORE_3 = 78; // - int IASTORE = 79; // visitInsn int LASTORE = 80; // - int FASTORE = 81; // - int DASTORE = 82; // - int AASTORE = 83; // - int BASTORE = 84; // - int CASTORE = 85; // - int SASTORE = 86; // - int POP = 87; // - int POP2 = 88; // - int DUP = 89; // - int DUP_X1 = 90; // - int DUP_X2 = 91; // - int DUP2 = 92; // - int DUP2_X1 = 93; // - int DUP2_X2 = 94; // - int SWAP = 95; // - int IADD = 96; // - int LADD = 97; // - int FADD = 98; // - int DADD = 99; // - int ISUB = 100; // - int LSUB = 101; // - int FSUB = 102; // - int DSUB = 103; // - int IMUL = 104; // - int LMUL = 105; // - int FMUL = 106; // - int DMUL = 107; // - int IDIV = 108; // - int LDIV = 109; // - int FDIV = 110; // - int DDIV = 111; // - int IREM = 112; // - int LREM = 113; // - int FREM = 114; // - int DREM = 115; // - int INEG = 116; // - int LNEG = 117; // - int FNEG = 118; // - int DNEG = 119; // - int ISHL = 120; // - int LSHL = 121; // - int ISHR = 122; // - int LSHR = 123; // - int IUSHR = 124; // - int LUSHR = 125; // - int IAND = 126; // - int LAND = 127; // - int IOR = 128; // - int LOR = 129; // - int IXOR = 130; // - int LXOR = 131; // - int IINC = 132; // visitIincInsn int I2L = 133; // visitInsn int I2F = 134; // - int I2D = 135; // - int L2I = 136; // - int L2F = 137; // - int L2D = 138; // - int F2I = 139; // - int F2L = 140; // - int F2D = 141; // - int D2I = 142; // - int D2L = 143; // - int D2F = 144; // - int I2B = 145; // - int I2C = 146; // - int I2S = 147; // - int LCMP = 148; // - int FCMPL = 149; // - int FCMPG = 150; // - int DCMPL = 151; // - int DCMPG = 152; // - int IFEQ = 153; // visitJumpInsn int IFNE = 154; // - int IFLT = 155; // - int IFGE = 156; // - int IFGT = 157; // - int IFLE = 158; // - int IF_ICMPEQ = 159; // - int IF_ICMPNE = 160; // - int IF_ICMPLT = 161; // - int IF_ICMPGE = 162; // - int IF_ICMPGT = 163; // - int IF_ICMPLE = 164; // - int IF_ACMPEQ = 165; // - int IF_ACMPNE = 166; // - int GOTO = 167; // - int JSR = 168; // - int RET = 169; // visitVarInsn int TABLESWITCH = 170; // visiTableSwitchInsn int LOOKUPSWITCH = 171; // visitLookupSwitch int IRETURN = 172; // visitInsn int LRETURN = 173; // - int FRETURN = 174; // - int DRETURN = 175; // - int ARETURN = 176; // - int RETURN = 177; // - int GETSTATIC = 178; // visitFieldInsn int PUTSTATIC = 179; // - int GETFIELD = 180; // - int PUTFIELD = 181; // - int INVOKEVIRTUAL = 182; // visitMethodInsn int INVOKESPECIAL = 183; // - int INVOKESTATIC = 184; // - int INVOKEINTERFACE = 185; // - int INVOKEDYNAMIC = 186; // visitInvokeDynamicInsn int NEW = 187; // visitTypeInsn int NEWARRAY = 188; // visitIntInsn int ANEWARRAY = 189; // visitTypeInsn int ARRAYLENGTH = 190; // visitInsn int ATHROW = 191; // - int CHECKCAST = 192; // visitTypeInsn int INSTANCEOF = 193; // - int MONITORENTER = 194; // visitInsn int MONITOREXIT = 195; // - // int WIDE = 196; // NOT VISITED int MULTIANEWARRAY = 197; // visitMultiANewArrayInsn int IFNULL = 198; // visitJumpInsn int IFNONNULL = 199; // - // int GOTO_W = 200; // - // int JSR_W = 201; // - } ================================================ FILE: src/jvm/clojure/asm/Type.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm; import java.lang.reflect.Constructor; import java.lang.reflect.Method; /** * A Java field or method type. This class can be used to make it easier to * manipulate type and method descriptors. * * @author Eric Bruneton * @author Chris Nokleberg */ public class Type { /** * The sort of the void type. See {@link #getSort getSort}. */ public static final int VOID = 0; /** * The sort of the boolean type. See {@link #getSort getSort}. */ public static final int BOOLEAN = 1; /** * The sort of the char type. See {@link #getSort getSort}. */ public static final int CHAR = 2; /** * The sort of the byte type. See {@link #getSort getSort}. */ public static final int BYTE = 3; /** * The sort of the short type. See {@link #getSort getSort}. */ public static final int SHORT = 4; /** * The sort of the int type. See {@link #getSort getSort}. */ public static final int INT = 5; /** * The sort of the float type. See {@link #getSort getSort}. */ public static final int FLOAT = 6; /** * The sort of the long type. See {@link #getSort getSort}. */ public static final int LONG = 7; /** * The sort of the double type. See {@link #getSort getSort}. */ public static final int DOUBLE = 8; /** * The sort of array reference types. See {@link #getSort getSort}. */ public static final int ARRAY = 9; /** * The sort of object reference types. See {@link #getSort getSort}. */ public static final int OBJECT = 10; /** * The sort of method types. See {@link #getSort getSort}. */ public static final int METHOD = 11; /** * The void type. */ public static final Type VOID_TYPE = new Type(VOID, null, ('V' << 24) | (5 << 16) | (0 << 8) | 0, 1); /** * The boolean type. */ public static final Type BOOLEAN_TYPE = new Type(BOOLEAN, null, ('Z' << 24) | (0 << 16) | (5 << 8) | 1, 1); /** * The char type. */ public static final Type CHAR_TYPE = new Type(CHAR, null, ('C' << 24) | (0 << 16) | (6 << 8) | 1, 1); /** * The byte type. */ public static final Type BYTE_TYPE = new Type(BYTE, null, ('B' << 24) | (0 << 16) | (5 << 8) | 1, 1); /** * The short type. */ public static final Type SHORT_TYPE = new Type(SHORT, null, ('S' << 24) | (0 << 16) | (7 << 8) | 1, 1); /** * The int type. */ public static final Type INT_TYPE = new Type(INT, null, ('I' << 24) | (0 << 16) | (0 << 8) | 1, 1); /** * The float type. */ public static final Type FLOAT_TYPE = new Type(FLOAT, null, ('F' << 24) | (2 << 16) | (2 << 8) | 1, 1); /** * The long type. */ public static final Type LONG_TYPE = new Type(LONG, null, ('J' << 24) | (1 << 16) | (1 << 8) | 2, 1); /** * The double type. */ public static final Type DOUBLE_TYPE = new Type(DOUBLE, null, ('D' << 24) | (3 << 16) | (3 << 8) | 2, 1); // ------------------------------------------------------------------------ // Fields // ------------------------------------------------------------------------ /** * The sort of this Java type. */ private final int sort; /** * A buffer containing the internal name of this Java type. This field is * only used for reference types. */ private final char[] buf; /** * The offset of the internal name of this Java type in {@link #buf buf} or, * for primitive types, the size, descriptor and getOpcode offsets for this * type (byte 0 contains the size, byte 1 the descriptor, byte 2 the offset * for IALOAD or IASTORE, byte 3 the offset for all other instructions). */ private final int off; /** * The length of the internal name of this Java type. */ private final int len; // ------------------------------------------------------------------------ // Constructors // ------------------------------------------------------------------------ /** * Constructs a reference type. * * @param sort * the sort of the reference type to be constructed. * @param buf * a buffer containing the descriptor of the previous type. * @param off * the offset of this descriptor in the previous buffer. * @param len * the length of this descriptor. */ private Type(final int sort, final char[] buf, final int off, final int len) { this.sort = sort; this.buf = buf; this.off = off; this.len = len; } /** * Returns the Java type corresponding to the given type descriptor. * * @param typeDescriptor * a field or method type descriptor. * @return the Java type corresponding to the given type descriptor. */ public static Type getType(final String typeDescriptor) { return getType(typeDescriptor.toCharArray(), 0); } /** * Returns the Java type corresponding to the given internal name. * * @param internalName * an internal name. * @return the Java type corresponding to the given internal name. */ public static Type getObjectType(final String internalName) { char[] buf = internalName.toCharArray(); return new Type(buf[0] == '[' ? ARRAY : OBJECT, buf, 0, buf.length); } /** * Returns the Java type corresponding to the given method descriptor. * Equivalent to Type.getType(methodDescriptor). * * @param methodDescriptor * a method descriptor. * @return the Java type corresponding to the given method descriptor. */ public static Type getMethodType(final String methodDescriptor) { return getType(methodDescriptor.toCharArray(), 0); } /** * Returns the Java method type corresponding to the given argument and * return types. * * @param returnType * the return type of the method. * @param argumentTypes * the argument types of the method. * @return the Java type corresponding to the given argument and return * types. */ public static Type getMethodType(final Type returnType, final Type... argumentTypes) { return getType(getMethodDescriptor(returnType, argumentTypes)); } /** * Returns the Java type corresponding to the given class. * * @param c * a class. * @return the Java type corresponding to the given class. */ public static Type getType(final Class c) { if (c.isPrimitive()) { if (c == Integer.TYPE) { return INT_TYPE; } else if (c == Void.TYPE) { return VOID_TYPE; } else if (c == Boolean.TYPE) { return BOOLEAN_TYPE; } else if (c == Byte.TYPE) { return BYTE_TYPE; } else if (c == Character.TYPE) { return CHAR_TYPE; } else if (c == Short.TYPE) { return SHORT_TYPE; } else if (c == Double.TYPE) { return DOUBLE_TYPE; } else if (c == Float.TYPE) { return FLOAT_TYPE; } else /* if (c == Long.TYPE) */{ return LONG_TYPE; } } else { return getType(getDescriptor(c)); } } /** * Returns the Java method type corresponding to the given constructor. * * @param c * a {@link Constructor Constructor} object. * @return the Java method type corresponding to the given constructor. */ public static Type getType(final Constructor c) { return getType(getConstructorDescriptor(c)); } /** * Returns the Java method type corresponding to the given method. * * @param m * a {@link Method Method} object. * @return the Java method type corresponding to the given method. */ public static Type getType(final Method m) { return getType(getMethodDescriptor(m)); } /** * Returns the Java types corresponding to the argument types of the given * method descriptor. * * @param methodDescriptor * a method descriptor. * @return the Java types corresponding to the argument types of the given * method descriptor. */ public static Type[] getArgumentTypes(final String methodDescriptor) { char[] buf = methodDescriptor.toCharArray(); int off = 1; int size = 0; while (true) { char car = buf[off++]; if (car == ')') { break; } else if (car == 'L') { while (buf[off++] != ';') { } ++size; } else if (car != '[') { ++size; } } Type[] args = new Type[size]; off = 1; size = 0; while (buf[off] != ')') { args[size] = getType(buf, off); off += args[size].len + (args[size].sort == OBJECT ? 2 : 0); size += 1; } return args; } /** * Returns the Java types corresponding to the argument types of the given * method. * * @param method * a method. * @return the Java types corresponding to the argument types of the given * method. */ public static Type[] getArgumentTypes(final Method method) { Class[] classes = method.getParameterTypes(); Type[] types = new Type[classes.length]; for (int i = classes.length - 1; i >= 0; --i) { types[i] = getType(classes[i]); } return types; } /** * Returns the Java type corresponding to the return type of the given * method descriptor. * * @param methodDescriptor * a method descriptor. * @return the Java type corresponding to the return type of the given * method descriptor. */ public static Type getReturnType(final String methodDescriptor) { char[] buf = methodDescriptor.toCharArray(); return getType(buf, methodDescriptor.indexOf(')') + 1); } /** * Returns the Java type corresponding to the return type of the given * method. * * @param method * a method. * @return the Java type corresponding to the return type of the given * method. */ public static Type getReturnType(final Method method) { return getType(method.getReturnType()); } /** * Computes the size of the arguments and of the return value of a method. * * @param desc * the descriptor of a method. * @return the size of the arguments of the method (plus one for the * implicit this argument), argSize, and the size of its return * value, retSize, packed into a single int i = * (argSize << 2) | retSize (argSize is therefore equal to * i >> 2, and retSize to i & 0x03). */ public static int getArgumentsAndReturnSizes(final String desc) { int n = 1; int c = 1; while (true) { char car = desc.charAt(c++); if (car == ')') { car = desc.charAt(c); return n << 2 | (car == 'V' ? 0 : (car == 'D' || car == 'J' ? 2 : 1)); } else if (car == 'L') { while (desc.charAt(c++) != ';') { } n += 1; } else if (car == '[') { while ((car = desc.charAt(c)) == '[') { ++c; } if (car == 'D' || car == 'J') { n -= 1; } } else if (car == 'D' || car == 'J') { n += 2; } else { n += 1; } } } /** * Returns the Java type corresponding to the given type descriptor. For * method descriptors, buf is supposed to contain nothing more than the * descriptor itself. * * @param buf * a buffer containing a type descriptor. * @param off * the offset of this descriptor in the previous buffer. * @return the Java type corresponding to the given type descriptor. */ private static Type getType(final char[] buf, final int off) { int len; switch (buf[off]) { case 'V': return VOID_TYPE; case 'Z': return BOOLEAN_TYPE; case 'C': return CHAR_TYPE; case 'B': return BYTE_TYPE; case 'S': return SHORT_TYPE; case 'I': return INT_TYPE; case 'F': return FLOAT_TYPE; case 'J': return LONG_TYPE; case 'D': return DOUBLE_TYPE; case '[': len = 1; while (buf[off + len] == '[') { ++len; } if (buf[off + len] == 'L') { ++len; while (buf[off + len] != ';') { ++len; } } return new Type(ARRAY, buf, off, len + 1); case 'L': len = 1; while (buf[off + len] != ';') { ++len; } return new Type(OBJECT, buf, off + 1, len - 1); // case '(': default: return new Type(METHOD, buf, off, buf.length - off); } } // ------------------------------------------------------------------------ // Accessors // ------------------------------------------------------------------------ /** * Returns the sort of this Java type. * * @return {@link #VOID VOID}, {@link #BOOLEAN BOOLEAN}, {@link #CHAR CHAR}, * {@link #BYTE BYTE}, {@link #SHORT SHORT}, {@link #INT INT}, * {@link #FLOAT FLOAT}, {@link #LONG LONG}, {@link #DOUBLE DOUBLE}, * {@link #ARRAY ARRAY}, {@link #OBJECT OBJECT} or {@link #METHOD * METHOD}. */ public int getSort() { return sort; } /** * Returns the number of dimensions of this array type. This method should * only be used for an array type. * * @return the number of dimensions of this array type. */ public int getDimensions() { int i = 1; while (buf[off + i] == '[') { ++i; } return i; } /** * Returns the type of the elements of this array type. This method should * only be used for an array type. * * @return Returns the type of the elements of this array type. */ public Type getElementType() { return getType(buf, off + getDimensions()); } /** * Returns the binary name of the class corresponding to this type. This * method must not be used on method types. * * @return the binary name of the class corresponding to this type. */ public String getClassName() { switch (sort) { case VOID: return "void"; case BOOLEAN: return "boolean"; case CHAR: return "char"; case BYTE: return "byte"; case SHORT: return "short"; case INT: return "int"; case FLOAT: return "float"; case LONG: return "long"; case DOUBLE: return "double"; case ARRAY: StringBuffer b = new StringBuffer(getElementType().getClassName()); for (int i = getDimensions(); i > 0; --i) { b.append("[]"); } return b.toString(); case OBJECT: return new String(buf, off, len).replace('/', '.'); default: return null; } } /** * Returns the internal name of the class corresponding to this object or * array type. The internal name of a class is its fully qualified name (as * returned by Class.getName(), where '.' are replaced by '/'. This method * should only be used for an object or array type. * * @return the internal name of the class corresponding to this object type. */ public String getInternalName() { return new String(buf, off, len); } /** * Returns the argument types of methods of this type. This method should * only be used for method types. * * @return the argument types of methods of this type. */ public Type[] getArgumentTypes() { return getArgumentTypes(getDescriptor()); } /** * Returns the return type of methods of this type. This method should only * be used for method types. * * @return the return type of methods of this type. */ public Type getReturnType() { return getReturnType(getDescriptor()); } /** * Returns the size of the arguments and of the return value of methods of * this type. This method should only be used for method types. * * @return the size of the arguments (plus one for the implicit this * argument), argSize, and the size of the return value, retSize, * packed into a single int i = (argSize << 2) | retSize * (argSize is therefore equal to i >> 2, and retSize to * i & 0x03). */ public int getArgumentsAndReturnSizes() { return getArgumentsAndReturnSizes(getDescriptor()); } // ------------------------------------------------------------------------ // Conversion to type descriptors // ------------------------------------------------------------------------ /** * Returns the descriptor corresponding to this Java type. * * @return the descriptor corresponding to this Java type. */ public String getDescriptor() { StringBuffer buf = new StringBuffer(); getDescriptor(buf); return buf.toString(); } /** * Returns the descriptor corresponding to the given argument and return * types. * * @param returnType * the return type of the method. * @param argumentTypes * the argument types of the method. * @return the descriptor corresponding to the given argument and return * types. */ public static String getMethodDescriptor(final Type returnType, final Type... argumentTypes) { StringBuffer buf = new StringBuffer(); buf.append('('); for (int i = 0; i < argumentTypes.length; ++i) { argumentTypes[i].getDescriptor(buf); } buf.append(')'); returnType.getDescriptor(buf); return buf.toString(); } /** * Appends the descriptor corresponding to this Java type to the given * string buffer. * * @param buf * the string buffer to which the descriptor must be appended. */ private void getDescriptor(final StringBuffer buf) { if (this.buf == null) { // descriptor is in byte 3 of 'off' for primitive types (buf == // null) buf.append((char) ((off & 0xFF000000) >>> 24)); } else if (sort == OBJECT) { buf.append('L'); buf.append(this.buf, off, len); buf.append(';'); } else { // sort == ARRAY || sort == METHOD buf.append(this.buf, off, len); } } // ------------------------------------------------------------------------ // Direct conversion from classes to type descriptors, // without intermediate Type objects // ------------------------------------------------------------------------ /** * Returns the internal name of the given class. The internal name of a * class is its fully qualified name, as returned by Class.getName(), where * '.' are replaced by '/'. * * @param c * an object or array class. * @return the internal name of the given class. */ public static String getInternalName(final Class c) { return c.getName().replace('.', '/'); } /** * Returns the descriptor corresponding to the given Java type. * * @param c * an object class, a primitive class or an array class. * @return the descriptor corresponding to the given class. */ public static String getDescriptor(final Class c) { StringBuffer buf = new StringBuffer(); getDescriptor(buf, c); return buf.toString(); } /** * Returns the descriptor corresponding to the given constructor. * * @param c * a {@link Constructor Constructor} object. * @return the descriptor of the given constructor. */ public static String getConstructorDescriptor(final Constructor c) { Class[] parameters = c.getParameterTypes(); StringBuffer buf = new StringBuffer(); buf.append('('); for (int i = 0; i < parameters.length; ++i) { getDescriptor(buf, parameters[i]); } return buf.append(")V").toString(); } /** * Returns the descriptor corresponding to the given method. * * @param m * a {@link Method Method} object. * @return the descriptor of the given method. */ public static String getMethodDescriptor(final Method m) { Class[] parameters = m.getParameterTypes(); StringBuffer buf = new StringBuffer(); buf.append('('); for (int i = 0; i < parameters.length; ++i) { getDescriptor(buf, parameters[i]); } buf.append(')'); getDescriptor(buf, m.getReturnType()); return buf.toString(); } /** * Appends the descriptor of the given class to the given string buffer. * * @param buf * the string buffer to which the descriptor must be appended. * @param c * the class whose descriptor must be computed. */ private static void getDescriptor(final StringBuffer buf, final Class c) { Class d = c; while (true) { if (d.isPrimitive()) { char car; if (d == Integer.TYPE) { car = 'I'; } else if (d == Void.TYPE) { car = 'V'; } else if (d == Boolean.TYPE) { car = 'Z'; } else if (d == Byte.TYPE) { car = 'B'; } else if (d == Character.TYPE) { car = 'C'; } else if (d == Short.TYPE) { car = 'S'; } else if (d == Double.TYPE) { car = 'D'; } else if (d == Float.TYPE) { car = 'F'; } else /* if (d == Long.TYPE) */{ car = 'J'; } buf.append(car); return; } else if (d.isArray()) { buf.append('['); d = d.getComponentType(); } else { buf.append('L'); String name = d.getName(); int len = name.length(); for (int i = 0; i < len; ++i) { char car = name.charAt(i); buf.append(car == '.' ? '/' : car); } buf.append(';'); return; } } } // ------------------------------------------------------------------------ // Corresponding size and opcodes // ------------------------------------------------------------------------ /** * Returns the size of values of this type. This method must not be used for * method types. * * @return the size of values of this type, i.e., 2 for long and * double, 0 for void and 1 otherwise. */ public int getSize() { // the size is in byte 0 of 'off' for primitive types (buf == null) return buf == null ? (off & 0xFF) : 1; } /** * Returns a JVM instruction opcode adapted to this Java type. This method * must not be used for method types. * * @param opcode * a JVM instruction opcode. This opcode must be one of ILOAD, * ISTORE, IALOAD, IASTORE, IADD, ISUB, IMUL, IDIV, IREM, INEG, * ISHL, ISHR, IUSHR, IAND, IOR, IXOR and IRETURN. * @return an opcode that is similar to the given opcode, but adapted to * this Java type. For example, if this type is float and * opcode is IRETURN, this method returns FRETURN. */ public int getOpcode(final int opcode) { if (opcode == Opcodes.IALOAD || opcode == Opcodes.IASTORE) { // the offset for IALOAD or IASTORE is in byte 1 of 'off' for // primitive types (buf == null) return opcode + (buf == null ? (off & 0xFF00) >> 8 : 4); } else { // the offset for other instructions is in byte 2 of 'off' for // primitive types (buf == null) return opcode + (buf == null ? (off & 0xFF0000) >> 16 : 4); } } // ------------------------------------------------------------------------ // Equals, hashCode and toString // ------------------------------------------------------------------------ /** * Tests if the given object is equal to this type. * * @param o * the object to be compared to this type. * @return true if the given object is equal to this type. */ @Override public boolean equals(final Object o) { if (this == o) { return true; } if (!(o instanceof Type)) { return false; } Type t = (Type) o; if (sort != t.sort) { return false; } if (sort >= ARRAY) { if (len != t.len) { return false; } for (int i = off, j = t.off, end = i + len; i < end; i++, j++) { if (buf[i] != t.buf[j]) { return false; } } } return true; } /** * Returns a hash code value for this type. * * @return a hash code value for this type. */ @Override public int hashCode() { int hc = 13 * sort; if (sort >= ARRAY) { for (int i = off, end = i + len; i < end; i++) { hc = 17 * (hc + buf[i]); } } return hc; } /** * Returns a string representation of this type. * * @return the descriptor of this type. */ @Override public String toString() { return getDescriptor(); } } ================================================ FILE: src/jvm/clojure/asm/commons/AdviceAdapter.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm.commons; import java.util.ArrayList; import java.util.HashMap; import java.util.List; import java.util.Map; import clojure.asm.Handle; import clojure.asm.Label; import clojure.asm.MethodVisitor; import clojure.asm.Opcodes; import clojure.asm.Type; /** * A {@link clojure.asm.MethodVisitor} to insert before, after and around * advices in methods and constructors. *

* The behavior for constructors is like this: *

    * *
  1. as long as the INVOKESPECIAL for the object initialization has not been * reached, every bytecode instruction is dispatched in the ctor code visitor
    2. * *
  2. when this one is reached, it is only added in the ctor code visitor and a * JP invoke is added
    3. * *
  3. after that, only the other code visitor receives the instructions
    4. * *
* * @author Eugene Kuleshov * @author Eric Bruneton */ public abstract class AdviceAdapter extends GeneratorAdapter implements Opcodes { private static final Object THIS = new Object(); private static final Object OTHER = new Object(); protected int methodAccess; protected String methodDesc; private boolean constructor; private boolean superInitialized; private List stackFrame; private Map> branches; /** * Creates a new {@link AdviceAdapter}. * * @param api * the ASM API version implemented by this visitor. Must be one * of {@link Opcodes#ASM4}. * @param mv * the method visitor to which this adapter delegates calls. * @param access * the method's access flags (see {@link Opcodes}). * @param name * the method's name. * @param desc * the method's descriptor (see {@link Type Type}). */ protected AdviceAdapter(final int api, final MethodVisitor mv, final int access, final String name, final String desc) { super(api, mv, access, name, desc); methodAccess = access; methodDesc = desc; constructor = "".equals(name); } @Override public void visitCode() { mv.visitCode(); if (constructor) { stackFrame = new ArrayList(); branches = new HashMap>(); } else { superInitialized = true; onMethodEnter(); } } @Override public void visitLabel(final Label label) { mv.visitLabel(label); if (constructor && branches != null) { List frame = branches.get(label); if (frame != null) { stackFrame = frame; branches.remove(label); } } } @Override public void visitInsn(final int opcode) { if (constructor) { int s; switch (opcode) { case RETURN: // empty stack onMethodExit(opcode); break; case IRETURN: // 1 before n/a after case FRETURN: // 1 before n/a after case ARETURN: // 1 before n/a after case ATHROW: // 1 before n/a after popValue(); onMethodExit(opcode); break; case LRETURN: // 2 before n/a after case DRETURN: // 2 before n/a after popValue(); popValue(); onMethodExit(opcode); break; case NOP: case LALOAD: // remove 2 add 2 case DALOAD: // remove 2 add 2 case LNEG: case DNEG: case FNEG: case INEG: case L2D: case D2L: case F2I: case I2B: case I2C: case I2S: case I2F: case ARRAYLENGTH: break; case ACONST_NULL: case ICONST_M1: case ICONST_0: case ICONST_1: case ICONST_2: case ICONST_3: case ICONST_4: case ICONST_5: case FCONST_0: case FCONST_1: case FCONST_2: case F2L: // 1 before 2 after case F2D: case I2L: case I2D: pushValue(OTHER); break; case LCONST_0: case LCONST_1: case DCONST_0: case DCONST_1: pushValue(OTHER); pushValue(OTHER); break; case IALOAD: // remove 2 add 1 case FALOAD: // remove 2 add 1 case AALOAD: // remove 2 add 1 case BALOAD: // remove 2 add 1 case CALOAD: // remove 2 add 1 case SALOAD: // remove 2 add 1 case POP: case IADD: case FADD: case ISUB: case LSHL: // 3 before 2 after case LSHR: // 3 before 2 after case LUSHR: // 3 before 2 after case L2I: // 2 before 1 after case L2F: // 2 before 1 after case D2I: // 2 before 1 after case D2F: // 2 before 1 after case FSUB: case FMUL: case FDIV: case FREM: case FCMPL: // 2 before 1 after case FCMPG: // 2 before 1 after case IMUL: case IDIV: case IREM: case ISHL: case ISHR: case IUSHR: case IAND: case IOR: case IXOR: case MONITORENTER: case MONITOREXIT: popValue(); break; case POP2: case LSUB: case LMUL: case LDIV: case LREM: case LADD: case LAND: case LOR: case LXOR: case DADD: case DMUL: case DSUB: case DDIV: case DREM: popValue(); popValue(); break; case IASTORE: case FASTORE: case AASTORE: case BASTORE: case CASTORE: case SASTORE: case LCMP: // 4 before 1 after case DCMPL: case DCMPG: popValue(); popValue(); popValue(); break; case LASTORE: case DASTORE: popValue(); popValue(); popValue(); popValue(); break; case DUP: pushValue(peekValue()); break; case DUP_X1: s = stackFrame.size(); stackFrame.add(s - 2, stackFrame.get(s - 1)); break; case DUP_X2: s = stackFrame.size(); stackFrame.add(s - 3, stackFrame.get(s - 1)); break; case DUP2: s = stackFrame.size(); stackFrame.add(s - 2, stackFrame.get(s - 1)); stackFrame.add(s - 2, stackFrame.get(s - 1)); break; case DUP2_X1: s = stackFrame.size(); stackFrame.add(s - 3, stackFrame.get(s - 1)); stackFrame.add(s - 3, stackFrame.get(s - 1)); break; case DUP2_X2: s = stackFrame.size(); stackFrame.add(s - 4, stackFrame.get(s - 1)); stackFrame.add(s - 4, stackFrame.get(s - 1)); break; case SWAP: s = stackFrame.size(); stackFrame.add(s - 2, stackFrame.get(s - 1)); stackFrame.remove(s); break; } } else { switch (opcode) { case RETURN: case IRETURN: case FRETURN: case ARETURN: case LRETURN: case DRETURN: case ATHROW: onMethodExit(opcode); break; } } mv.visitInsn(opcode); } @Override public void visitVarInsn(final int opcode, final int var) { super.visitVarInsn(opcode, var); if (constructor) { switch (opcode) { case ILOAD: case FLOAD: pushValue(OTHER); break; case LLOAD: case DLOAD: pushValue(OTHER); pushValue(OTHER); break; case ALOAD: pushValue(var == 0 ? THIS : OTHER); break; case ASTORE: case ISTORE: case FSTORE: popValue(); break; case LSTORE: case DSTORE: popValue(); popValue(); break; } } } @Override public void visitFieldInsn(final int opcode, final String owner, final String name, final String desc) { mv.visitFieldInsn(opcode, owner, name, desc); if (constructor) { char c = desc.charAt(0); boolean longOrDouble = c == 'J' || c == 'D'; switch (opcode) { case GETSTATIC: pushValue(OTHER); if (longOrDouble) { pushValue(OTHER); } break; case PUTSTATIC: popValue(); if (longOrDouble) { popValue(); } break; case PUTFIELD: popValue(); if (longOrDouble) { popValue(); popValue(); } break; // case GETFIELD: default: if (longOrDouble) { pushValue(OTHER); } } } } @Override public void visitIntInsn(final int opcode, final int operand) { mv.visitIntInsn(opcode, operand); if (constructor && opcode != NEWARRAY) { pushValue(OTHER); } } @Override public void visitLdcInsn(final Object cst) { mv.visitLdcInsn(cst); if (constructor) { pushValue(OTHER); if (cst instanceof Double || cst instanceof Long) { pushValue(OTHER); } } } @Override public void visitMultiANewArrayInsn(final String desc, final int dims) { mv.visitMultiANewArrayInsn(desc, dims); if (constructor) { for (int i = 0; i < dims; i++) { popValue(); } pushValue(OTHER); } } @Override public void visitTypeInsn(final int opcode, final String type) { mv.visitTypeInsn(opcode, type); // ANEWARRAY, CHECKCAST or INSTANCEOF don't change stack if (constructor && opcode == NEW) { pushValue(OTHER); } } @Override public void visitMethodInsn(final int opcode, final String owner, final String name, final String desc) { mv.visitMethodInsn(opcode, owner, name, desc); if (constructor) { Type[] types = Type.getArgumentTypes(desc); for (int i = 0; i < types.length; i++) { popValue(); if (types[i].getSize() == 2) { popValue(); } } switch (opcode) { // case INVOKESTATIC: // break; case INVOKEINTERFACE: case INVOKEVIRTUAL: popValue(); // objectref break; case INVOKESPECIAL: Object type = popValue(); // objectref if (type == THIS && !superInitialized) { onMethodEnter(); superInitialized = true; // once super has been initialized it is no longer // necessary to keep track of stack state constructor = false; } break; } Type returnType = Type.getReturnType(desc); if (returnType != Type.VOID_TYPE) { pushValue(OTHER); if (returnType.getSize() == 2) { pushValue(OTHER); } } } } @Override public void visitInvokeDynamicInsn(String name, String desc, Handle bsm, Object... bsmArgs) { mv.visitInvokeDynamicInsn(name, desc, bsm, bsmArgs); if (constructor) { Type[] types = Type.getArgumentTypes(desc); for (int i = 0; i < types.length; i++) { popValue(); if (types[i].getSize() == 2) { popValue(); } } Type returnType = Type.getReturnType(desc); if (returnType != Type.VOID_TYPE) { pushValue(OTHER); if (returnType.getSize() == 2) { pushValue(OTHER); } } } } @Override public void visitJumpInsn(final int opcode, final Label label) { mv.visitJumpInsn(opcode, label); if (constructor) { switch (opcode) { case IFEQ: case IFNE: case IFLT: case IFGE: case IFGT: case IFLE: case IFNULL: case IFNONNULL: popValue(); break; case IF_ICMPEQ: case IF_ICMPNE: case IF_ICMPLT: case IF_ICMPGE: case IF_ICMPGT: case IF_ICMPLE: case IF_ACMPEQ: case IF_ACMPNE: popValue(); popValue(); break; case JSR: pushValue(OTHER); break; } addBranch(label); } } @Override public void visitLookupSwitchInsn(final Label dflt, final int[] keys, final Label[] labels) { mv.visitLookupSwitchInsn(dflt, keys, labels); if (constructor) { popValue(); addBranches(dflt, labels); } } @Override public void visitTableSwitchInsn(final int min, final int max, final Label dflt, final Label... labels) { mv.visitTableSwitchInsn(min, max, dflt, labels); if (constructor) { popValue(); addBranches(dflt, labels); } } @Override public void visitTryCatchBlock(Label start, Label end, Label handler, String type) { super.visitTryCatchBlock(start, end, handler, type); if (constructor && !branches.containsKey(handler)) { List stackFrame = new ArrayList(); stackFrame.add(OTHER); branches.put(handler, stackFrame); } } private void addBranches(final Label dflt, final Label[] labels) { addBranch(dflt); for (int i = 0; i < labels.length; i++) { addBranch(labels[i]); } } private void addBranch(final Label label) { if (branches.containsKey(label)) { return; } branches.put(label, new ArrayList(stackFrame)); } private Object popValue() { return stackFrame.remove(stackFrame.size() - 1); } private Object peekValue() { return stackFrame.get(stackFrame.size() - 1); } private void pushValue(final Object o) { stackFrame.add(o); } /** * Called at the beginning of the method or after super class class call in * the constructor.
*
* * Custom code can use or change all the local variables, but should not * change state of the stack. */ protected void onMethodEnter() { } /** * Called before explicit exit from the method using either return or throw. * Top element on the stack contains the return value or exception instance. * For example: * * 
     *   public void onMethodExit(int opcode) {
     *     if(opcode==RETURN) {
     *         visitInsn(ACONST_NULL);
     *     } else if(opcode==ARETURN || opcode==ATHROW) {
     *         dup();
     *     } else {
     *         if(opcode==LRETURN || opcode==DRETURN) {
     *             dup2();
     *         } else {
     *             dup();
     *         }
     *         box(Type.getReturnType(this.methodDesc));
     *     }
     *     visitIntInsn(SIPUSH, opcode);
     *     visitMethodInsn(INVOKESTATIC, owner, "onExit", "(Ljava/lang/Object;I)V");
     *   }
     *
     *   // an actual call back method
     *   public static void onExit(Object param, int opcode) {
     *     ...
     *
* *
*
* * Custom code can use or change all the local variables, but should not * change state of the stack. * * @param opcode * one of the RETURN, IRETURN, FRETURN, ARETURN, LRETURN, DRETURN * or ATHROW * */ protected void onMethodExit(int opcode) { } // TODO onException, onMethodCall } ================================================ FILE: src/jvm/clojure/asm/commons/AnalyzerAdapter.java ================================================ /*** * ASM: a very small and fast Java bytecode manipulation framework * Copyright (c) 2000-2011 INRIA, France Telecom * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the copyright holders nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF * THE POSSIBILITY OF SUCH DAMAGE. */ package clojure.asm.commons; import java.util.ArrayList; import java.util.HashMap; import java.util.List; import java.util.Map; import clojure.asm.Handle; import clojure.asm.Label; import clojure.asm.MethodVisitor; import clojure.asm.Opcodes; import clojure.asm.Type; /** * A {@link MethodVisitor} that keeps track of stack map frame changes between * {@link #visitFrame(int, int, Object[], int, Object[]) visitFrame} calls. This * adapter must be used with the * {@link clojure.asm.ClassReader#EXPAND_FRAMES} option. Each * visitX instruction delegates to the next visitor in the chain, if any, * and then simulates the effect of this instruction on the stack map frame, * represented by {@link #locals} and {@link #stack}. The next visitor in the * chain can get the state of the stack map frame before each instruction * by reading the value of these fields in its visitX methods (this * requires a reference to the AnalyzerAdapter that is before it in the chain). * If this adapter is used with a class that does not contain stack map table * attributes (i.e., pre Java 6 classes) then this adapter may not be able to * compute the stack map frame for each instruction. In this case no exception * is thrown but the {@link #locals} and {@link #stack} fields will be null for * these instructions. * * @author Eric Bruneton */ public class AnalyzerAdapter extends MethodVisitor { /** * List of the local variable slots for current execution * frame. Primitive types are represented by {@link Opcodes#TOP}, * {@link Opcodes#INTEGER}, {@link Opcodes#FLOAT}, {@link Opcodes#LONG}, * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or * {@link Opcodes#UNINITIALIZED_THIS} (long and double are represented by * two elements, the second one being TOP). Reference types are represented * by String objects (representing internal names), and uninitialized types * by Label objects (this label designates the NEW instruction that created * this uninitialized value). This field is null for unreachable * instructions. */ public List locals; /** * List of the operand stack slots for current execution frame. * Primitive types are represented by {@link Opcodes#TOP}, * {@link Opcodes#INTEGER}, {@link Opcodes#FLOAT}, {@link Opcodes#LONG}, * {@link Opcodes#DOUBLE},{@link Opcodes#NULL} or * {@link Opcodes#UNINITIALIZED_THIS} (long and double are represented by * two elements, the second one being TOP). Reference types are represented * by String objects (representing internal names), and uninitialized types * by Label objects (this label designates the NEW instruction that created * this uninitialized value). This field is null for unreachable * instructions. */ public List stack; /** * The labels that designate the next instruction to be visited. May be * null. */ private List