292 changes: 160 additions & 132 deletions build.xml
View file
Original file line number Diff line number Diff line change
@@ -1,187 +1,215 @@
<project name="clojure" default="all" xmlns:mvn="urn:maven-artifact-ant">
<project name="clojure" default="all">

<description>
Build with "ant jar" and then start the
Build with "ant" and then start the
REPL with: "java -cp clojure.jar clojure.main".
You will need to install the Maven Ant
Tasks to ${ant.home}/lib in order to execute
the nightly-build or stable-build targets.
</description>

<property name="src" location="src"/>
<property name="test" location="test"/>
<property name="jsrc" location="${src}/jvm"/>
<property name="jtestsrc" location="${test}/java"/>
<property name="cljsrc" location="${src}/clj"/>
<property name="build" location="classes"/>

<!-- version related properties -->
<property file="${cljsrc}/clojure/version.properties"/>
<!-- ensures all version properties are present -->
<fail unless="clojure.version.major"/>
<fail unless="clojure.version.minor"/>
<fail unless="clojure.version.interim"/>

<condition property="clojure.version.incremental.label"
value=".${clojure.version.incremental}"
else="">
<length string="${clojure.version.incremental}" when="greater" length="0" />
</condition>
<condition property="clojure.version.qualifier.label"
value="-${clojure.version.qualifier}"
else="">
<length string="${clojure.version.qualifier}" when="greater" length="0" />
</condition>
<condition property="clojure.version.interim.label"
value="-SNAPSHOT"
else="">
<!-- We place -SNAPSHOT whenever interim is not set to false, not only
if interim is set to true (this is less typo prone in the worst case -->
<not><equals arg1="${clojure.version.interim}" arg2="false" trim="true"/></not>
</condition>

<property name="clojure.version.label"
value="${clojure.version.major}.${clojure.version.minor}${clojure.version.incremental.label}${clojure.version.qualifier.label}${clojure.version.interim.label}"/>

<!-- general filterset for use when clojure version must be copied -->
<filterset id="clojure-version-filterset">
<filter token="clojure-version" value="${clojure.version.label}"/>
</filterset>

<property name="clojure_noversion_jar" location="clojure.jar"/>
<property name="slim_noversion_jar" location="clojure-slim.jar"/>
<property name="src_noversion_jar" location="clojure-sources.jar"/>
<property name="clojure_jar" location="clojure-${clojure.version.label}.jar"/>
<property name="slim_jar" location="clojure-slim-${clojure.version.label}.jar"/>
<property name="src_jar" location="clojure-sources-${clojure.version.label}.jar"/>

<property name="cljscript" location="${src}/script"/>
<property name="test-script" location="${cljscript}/run_test.clj"/>
<property name="test-generative-script" location="${cljscript}/run_test_generative.clj"/>
<property name="compile-script" location="${cljscript}/bootstrap_compile.clj"/>
<property name="target" location="target"/>
<property name="build" location="${target}/classes"/>
<property name="test-classes" location="${target}/test-classes"/>
<property name="dist" location="dist"/>
<property file="maven-classpath.properties"/>

<!-- Get the version string out of the POM -->
<xmlproperty file="pom.xml" prefix="pom"/>
<property name="clojure.version.label" value="${pom.project.version}"/>
<property name="version.properties" value="${build}/clojure/version.properties"/>

<!-- These make sense for building on tapestry.formos.com -->
<property name="clojure_jar" location="clojure-${clojure.version.label}.jar"/>
<property name="clojure_noversion_jar" location="clojure.jar"/>

<property name="snapshot.repo.dir" location="/var/www/maven-snapshot-repository"/>
<property name="stable.repo.dir" location="/var/www/maven-repository"/>
<property name="directlinking" value="true"/>

<target name="init" depends="clean">
<tstamp/>
<mkdir dir="${build}"/>
<antcall target="init-version"/>
</target>

<target name="init-version">
<copy file="pom-template.xml"
tofile="pom.xml">
<filterset refid="clojure-version-filterset"/>
</copy>
<!--prevents users from modifying accidentally the generated pom.xml
works only on linux.-->
<chmod file="pom.xml" perm="ugo-w"/>
<mkdir dir="${build}/clojure"/>
<echo file="${version.properties}">version=${clojure.version.label}</echo>
</target>

<target name="compile-java" depends="init"
description="Compile Java sources.">
<javac srcdir="${jsrc}" destdir="${build}" includeJavaRuntime="yes"
debug="true" target="1.5"/>
includeAntRuntime="false"
debug="true" source="1.8" target="1.8"/>
</target>

<target name="compile-clojure" depends="compile-java"
<target name="compile-clojure"
description="Compile Clojure sources.">
<java classname="clojure.lang.Compile"
classpath="${build}:${cljsrc}">
classpath="${maven.compile.classpath}:${build}:${cljsrc}"
failonerror="true"
fork="true">
<sysproperty key="clojure.compile.path" value="${build}"/>
<!--<sysproperty key="clojure.compiler.elide-meta" value="[:doc :file :line :added]"/>-->
<!--<sysproperty key="clojure.compiler.disable-locals-clearing" value="true"/>-->
<!--<sysproperty key="clojure.compile.warn-on-reflection" value="true"/>-->
<sysproperty key="clojure.compiler.direct-linking" value="true"/>
<sysproperty key="java.awt.headless" value="true"/>
<arg value="clojure.core"/>
<arg value="clojure.core.protocols"/>
<arg value="clojure.core.server"/>
<arg value="clojure.main"/>
<arg value="clojure.set"/>
<arg value="clojure.edn"/>
<arg value="clojure.xml"/>
<arg value="clojure.zip"/>
<arg value="clojure.inspector"/>
<arg value="clojure.walk"/>
<arg value="clojure.stacktrace"/>
<arg value="clojure.template"/>
<arg value="clojure.test"/>
<arg value="clojure.test.tap"/>
<arg value="clojure.test.junit"/>
<arg value="clojure.pprint"/>
<arg value="clojure.java.io"/>
<arg value="clojure.repl"/>
<arg value="clojure.java.browse"/>
<arg value="clojure.java.javadoc"/>
<arg value="clojure.java.shell"/>
<arg value="clojure.java.process"/>
<arg value="clojure.java.browse-ui"/>
<arg value="clojure.java.basis.impl"/>
<arg value="clojure.java.basis"/>
<arg value="clojure.string"/>
<arg value="clojure.data"/>
<arg value="clojure.reflect"/>
<arg value="clojure.datafy"/>
<arg value="clojure.instant"/>
<arg value="clojure.uuid"/>
<arg value="clojure.core.reducers"/>
<arg value="clojure.math"/>
<arg value="clojure.tools.deps.interop"/>
<arg value="clojure.repl.deps"/>
</java>
</target>

<target name="compile-tests"
description="Compile the subset of tests that require compilation."
unless="maven.test.skip">
<mkdir dir="${test-classes}"/>
<javac srcdir="${jtestsrc}" destdir="${test-classes}" includeJavaRuntime="yes"
debug="true" source="1.8" target="1.8" includeantruntime="no"/>
<echo>Direct linking = ${directlinking}</echo>
<java classname="clojure.lang.Compile"
classpath="${test-classes}:${test}:${build}:${cljsrc}:${maven.test.classpath}"
failonerror="true"
fork="true">
<sysproperty key="clojure.compile.path" value="${test-classes}"/>
<!--<sysproperty key="clojure.compiler.elide-meta" value="[:doc]"/>-->
<!--<sysproperty key="clojure.compiler.disable-locals-clearing" value="true"/>-->
<sysproperty key="clojure.compiler.direct-linking" value="${directlinking}"/>
<arg value="clojure.test-clojure.protocols.examples"/>
<arg value="clojure.test-clojure.proxy.examples"/>
<arg value="clojure.test-clojure.genclass.examples"/>
<arg value="clojure.test-clojure.compilation.load-ns"/>
<arg value="clojure.test-clojure.annotations"/>
</java>
</target>

<target name="test-example"
description="Run clojure tests without recompiling clojure."
depends="compile-tests"
unless="maven.test.skip">
<java classname="clojure.main" failonerror="true" fork="true">
<sysproperty key="clojure.test-clojure.exclude-namespaces"
value="#{clojure.test-clojure.compilation.load-ns clojure.test-clojure.ns-libs-load-later}"/>
<sysproperty key="clojure.compiler.direct-linking" value="${directlinking}"/>
<classpath>
<pathelement path="${maven.test.classpath}"/>
<path location="${test-classes}"/>
<path location="${test}"/>
<path location="${build}"/>
<path location="${cljsrc}"/>
</classpath>
<arg value="${test-script}"/>
</java>
</target>

<target name="test-generative"
description="Run test generative tests without recompiling clojure."
depends="compile-tests"
unless="maven.test.skip">
<java classname="clojure.main" failonerror="true" fork="true">
<sysproperty key="clojure.compiler.direct-linking" value="${directlinking}"/>
<classpath>
<pathelement path="${maven.test.classpath}"/>
<path location="${test-classes}"/>
<path location="${test}"/>
<path location="${build}"/>
<path location="${cljsrc}"/>
</classpath>
<arg value="${test-generative-script}"/>
</java>
</target>

<target name="clojure" depends="compile-clojure"
<target name="test"
description="Run all the tests"
depends="test-example,test-generative"/>

<target name="build"
description="Build Clojure (compilation only, no tests)."
depends="compile-java, compile-clojure"/>

<target name="jar" depends="build"
description="Create clojure jar file.">
<jar jarfile="${clojure_jar}" basedir="${build}">
<fileset dir="${cljsrc}">
<include name="**/*.clj"/>
<include name="clojure/version.properties"/>
</fileset>
<manifest>
<attribute name="Main-Class" value="clojure.main"/>
<attribute name="Class-Path" value="."/>
</manifest>
</jar>
<copy file="${clojure_jar}" tofile="${clojure_noversion_jar}" />
<copy file="${clojure_jar}" tofile="${clojure_noversion_jar}"/>
</target>

<target name="clojure-slim" depends="compile-java"
description="Create clojure-slim jar file (omits compiled Clojure code)">
<jar jarfile="${slim_jar}">
<fileset dir="${build}" includes="clojure/asm/**"/>
<fileset dir="${build}" includes="clojure/lang/**"/>
<fileset dir="${build}" includes="clojure/main.class"/>
<fileset dir="${cljsrc}">
<include name="**/*.clj"/>
<include name="clojure/version.properties"/>
<target name="javadoc"
description="Creates javadoc for Clojure API.">
<copy file="src/jvm/clojure/lang/IFn.java" tofile="target/tmpjd/IFn.java"/>
<copy file="src/jvm/clojure/lang/package.html" tofile="target/tmpjd/package.html"/>
<replaceregexp file="target/tmpjd/IFn.java" match="(static public interface .*})" replace="" byline="true"/>
<javadoc destdir="target/javadoc"
nodeprecatedlist="true" nohelp="true" nonavbar="true" notree="true"
link="http://docs.oracle.com/javase/7/docs/api/"
windowtitle="Clojure API">
<classpath>
<path location="${build}"/>
</classpath>
<fileset dir="${basedir}">
<include name="src/jvm/clojure/java/api/Clojure.java"/>
<include name="target/tmpjd/IFn.java"/>
</fileset>
<manifest>
<attribute name="Main-Class" value="clojure.main"/>
<attribute name="Class-Path" value="."/>
</manifest>
</jar>
<copy file="${slim_jar}" tofile="${slim_noversion_jar}" />
</javadoc>
</target>

<target name="clojure-sources" depends="init"
description="Create a JAR of Java sources.">
<jar jarfile="${src_jar}" basedir="${jsrc}" includes="**/*">
<fileset dir="${cljsrc}"
includes="clojure/version.properties"/>
</jar>
<copy file="${src_jar}" tofile="${src_noversion_jar}" />
</target>

<target name="jar" depends="clojure"/>

<target name="all" depends="clojure,clojure-slim,clojure-sources"/>
<target name="all" depends="build,test,jar"/>

<target name="clean"
description="Remove autogenerated files and directories.">
<delete dir="${build}"/>
<delete file="pom.xml"/>
<delete dir="${target}"/>
<delete verbose="true">
<fileset dir="${basedir}" includes="*.jar"/>
<fileset dir="${basedir}" includes="*.zip"/>
</delete>
</target>

<target name="-setup-maven">
<typedef resource="org/apache/maven/artifact/ant/antlib.xml" uri="urn:maven-artifact-ant"/>
<target name="local">
<exec executable="mvn">
<arg value="-Plocal"/>
<arg value="-Dmaven.test.skip=true"/>
<arg value="package"/>
</exec>
</target>

<macrodef name="deploy">
<attribute name="target-dir" description="Root of Maven repository"/>
<sequential>
<typedef resource="org/apache/maven/artifact/ant/antlib.xml" uri="urn:maven-artifact-ant"/>
<mvn:deploy file="${clojure_jar}">
<pom file="pom.xml"/>
<attach file="${src_jar}" classifier="sources"/>
<attach file="${slim_jar}" classifier="slim"/>
<remoteRepository url="file:@{target-dir}"/>
</mvn:deploy>
</sequential>
</macrodef>

<target name="ci-build" depends="clean,all,-setup-maven"
description="Continous integration build, installed to local repository.">
<mvn:install file="${clojure_jar}">
<pom file="pom.xml"/>
<attach file="${src_jar}" classifier="sources"/>
<attach file="${slim_jar}" classifier="slim"/>
</mvn:install>
</target>

<target name="nightly-build" depends="ci-build"
description="Build and deploy to nightly (snapshot) repository.">
<deploy target-dir="${snapshot.repo.dir}"/>
</target>


<target name="stable-build" depends="ci-build" description="Build and deploy to stable repository.">
<deploy target-dir="${stable.repo.dir}"/>
</target>


</project>
3,161 changes: 3,161 additions & 0 deletions changes.md
View file

Large diffs are not rendered by default.

39 changes: 0 additions & 39 deletions clojure.iml
View file

This file was deleted.

177 changes: 177 additions & 0 deletions codegen/gen_fn_adapter_tests.clj
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,177 @@
;; This code was used to generate:
;; generated_all_fi_adapters_in_let.clj
;; generated_functional_adapters_in_def_requiring_reflection.clj
;; generated_functional_adapters_in_def.clj
;; AdapterExerciser.java
;; This code is not intended to be reused but might be
;; useful in the future as a template for other code gen.

(ns gen-fn-adapter-tests
(:require
[clojure.string :as str])
(:import
[java.io StringWriter Writer]))

(defn let-test-header [imported-methods]
(format "
(ns clojure.test-clojure.generated-all-fi-adapters-in-let
(:use clojure.test)
(:require [clojure.string :as str])
(:import (clojure.test AdapterExerciser %s)))
(deftest test-all-fi-adapters-in-let
(let [^AdapterExerciser exerciser (AdapterExerciser.)" imported-methods))

(defn def-test-header [filename]
(format "
(ns clojure.test-clojure.%s
(:use clojure.test)
(:require [clojure.string :as str])
(:import (clojure.test AdapterExerciser)))
(deftest functional-adapters-in-def
(def exerciser (AdapterExerciser.))" filename))

(def adapter-exerciser-header "
package clojure.test;
public class AdapterExerciser {")

(defn sigs [args return-types]
(let [fun-sig-reducer (fn [res ret]
(mapcat seq [res (map (fn [params]
(str params ret)) args)]))]
(reduce fun-sig-reducer [] return-types)))

(defn gen-sigs []
(let [small-rets ["L" "I" "S" "B" "D" "F" "O"]
zero-arity (sigs [""] small-rets)
single-arity (sigs ["L" "D" "O"] small-rets)
two-arity (sigs ["LL" "LO" "OL" "DD" "LD" "DL" "OO" "OD" "DO"] small-rets)
big-rets ["O"]
three-arity (sigs ["OOO"] big-rets)
four-arity (sigs ["OOOO"] big-rets)
five-arity (sigs ["OOOOO"] big-rets)
six-arity (sigs ["OOOOOO"] big-rets)
seven-arity (sigs ["OOOOOOO"] big-rets)
eight-arity (sigs ["OOOOOOOO"] big-rets)
nine-arity (sigs ["OOOOOOOOO"] big-rets)
ten-arity (sigs ["OOOOOOOOOO"] big-rets)]
(mapcat seq [zero-arity single-arity two-arity three-arity four-arity five-arity six-arity seven-arity eight-arity nine-arity ten-arity])))

(def alphabet (map char (range 97 122)))
(def type-hints {:D "^double "
:O "^AdapterExerciser "
:L "^long "
:I "^int "
:F "^float "
:Z "^boolean "
:S "^short "
:B "^byte "})
(def types {:D "double"
:O "AdapterExerciser"
:L "long"
:I "int"
:F "float"
:Z "boolean"
:S "short"
:B "byte"})
(def method-args {:D "(double 1)"
:O "exerciser"
:L "(long 1)"
:I "1"
:F "(float 1)"
:Z "false"
:S "(short 1)"
:B "(byte 1)"})

(defn format-parts [sig]
(let [return-type-initial (str (last sig))
return-type (get types (keyword return-type-initial))
input-types (map str (butlast sig))
arg-type-hints (map #(get type-hints (keyword %)) input-types)
java-types (map #(get types (keyword %)) input-types)
fn-vars (str/join " " (map #(str %1 %2) arg-type-hints (take (count input-types) alphabet)))
fn-args (str/join " " (map #(get method-args (keyword %)) input-types))
java-vars (str/join ", " (map #(str %1 " " %2) java-types (take (count input-types) alphabet)))
fn-body (get method-args (keyword return-type-initial))
expected-val (get method-args (keyword return-type-initial))]
{:return-type return-type :fn-args fn-args :return-type-initial return-type-initial :fn-vars fn-vars :fn-body fn-body :input-types input-types :java-vars java-vars :expected-val expected-val}))

(defn gen-imported-methods [sigs]
(let [sb (StringBuilder. " ")]
(doseq [sig sigs]
(.append sb (format "AdapterExerciser$%s" sig))
(.append sb "\n"))
(.toString sb)))

(defn gen-test-all-fi-adapters-in-let []
(let [adapter-signatures (gen-sigs)
imported-methods (gen-imported-methods adapter-signatures)
sb (StringBuilder. ^String (let-test-header imported-methods))]
;; Assemble let
(doseq [sig adapter-signatures]
(let [{:keys [fn-vars fn-body]} (format-parts sig)]
(.append sb "\n")
(.append sb (format " ^AdapterExerciser$%s %sadapter (fn [%s] %s)" sig sig fn-vars fn-body))))
(.append sb "]")
;; Assemble test cases
(doseq [sig adapter-signatures]
(let [{:keys [return-type-initial fn-args expected-val]} (format-parts sig)]
(.append sb "\n")
(.append sb (format " (is (= (.takes%sRet%s %sadapter %s) %s))" (str/join "" (butlast sig)) return-type-initial sig fn-args expected-val))))
(.append sb "))")
(spit "generated_all_fi_adapters_in_let.clj" (.toString sb))))

(defn gen-test-functional-adapters-in-def []
(let [sb (StringBuilder. ^String (def-test-header "generated-functional-adapters-in-def"))
adapter-signatures (gen-sigs)]
(doseq [sig adapter-signatures]
(let [{:keys [fn-vars fn-body]} (format-parts sig)]
(.append sb "\n")
(.append sb (format " (def %sadapter (fn [%s] %s))" sig fn-vars fn-body))
(.append sb "\n")
(.append sb (format " (is (= (.method%s ^AdapterExerciser exerciser %sadapter) %s))" sig sig (str "\"" sig "\"")))))
(.append sb ")")
(spit "generated_functional_adapters_in_def.clj" (.toString sb))))

(defn gen-test-functional-adapters-in-def-requiring-reflection []
(let [sb (StringBuilder. ^String (def-test-header "generated-functional-adapters-in-def-requiring-reflection"))
adapter-signatures (gen-sigs)]
(doseq [sig adapter-signatures]
(let [{:keys [fn-vars fn-body]} (format-parts sig)]
(.append sb "\n")
(.append sb (format " (def %sadapter (fn [%s] %s))" sig fn-vars fn-body))
(.append sb "\n")
(.append sb (format " (is (= (.method%s exerciser %sadapter) %s))" sig sig (str "\"" sig "\"")))))
(.append sb ")")
(spit "generated_functional_adapters_in_def_requiring_reflection.clj" (.toString sb))))

(defn gen-adapter-exerciser-class []
(let [sb (StringBuilder. ^String adapter-exerciser-header)
adapter-signatures (gen-sigs)]
(doseq [sig adapter-signatures]
(let [{:keys [return-type return-type-initial input-types java-vars]} (format-parts sig)]
(.append sb "\n")
(.append sb " @FunctionalInterface\n")
(.append sb (format " public interface %s {\n" sig))
(.append sb (format " public %s takes%sRet%s(%s);\n" return-type (str/join "" input-types) return-type-initial java-vars))
(.append sb " }")))
(doseq [sig adapter-signatures]
(.append sb "\n")
(.append sb (format " public String method%s(%s a) { return %s; }" sig sig (str "\"" sig "\""))))
(.append sb "}")
(spit "AdapterExerciser.java" (.toString sb))))

(defn gen-all []
(gen-test-all-fi-adapters-in-let)
(gen-test-functional-adapters-in-def)
(gen-test-functional-adapters-in-def-requiring-reflection)
(gen-adapter-exerciser-class))

(comment
(gen-all)
(gen-test-all-fi-adapters-in-let)
(gen-test-functional-adapters-in-def)
(gen-test-functional-adapters-in-def-requiring-reflection)
(gen-adapter-exerciser-class))
173 changes: 173 additions & 0 deletions codegen/gen_fn_invokers.clj
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,173 @@
;; This code was used to generate the clojure.lang.FnInvokers class in
;; Clojure 1.12. This code is not intended to be reused but might be
;; useful in the future as a template for other code gen.

(ns gen-fn-invokers
(:require
[clojure.string :as str]))

(def header
"/**
* Copyright (c) Rich Hickey. All rights reserved.
* The use and distribution terms for this software are covered by the
* Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0)
* which can be found in the file epl-v10.html at the root of this distribution.
* By using this software in any fashion, you are agreeing to be bound by
* the terms of this license.
* You must not remove this notice, or any other, from this software.
**/
package clojure.lang;
public class FnInvokers {
// Encode invoker param/return class to code for method name
static char encodeInvokerType(Class c) {
if(Long.TYPE.equals(c)) {
return 'L';
} else if(Double.TYPE.equals(c)) {
return 'D';
} else if(Integer.TYPE.equals(c)) {
return 'I';
} else if(Short.TYPE.equals(c)) {
return 'S';
} else if(Byte.TYPE.equals(c)) {
return 'B';
} else if(Float.TYPE.equals(c)) {
return 'F';
} else {
return 'O';
}
}
")

(def footer
"}")

(def invokeO-format
" public static Object invoke%sO(IFn f0%s) {
return f0.invoke(%s);
}")

(def invokeO-with-l-or-d-arg-format
" public static Object invoke%sO(IFn f0%s) {
if(f0 instanceof IFn.%sO) {
return ((IFn.%sO)f0).invokePrim(%s);
} else {
return f0.invoke(%s);
}
}")

(def invokeD-format
" public static double invoke%sD(IFn f0%s) {
if(f0 instanceof IFn.%sD) {
return ((IFn.%sD)f0).invokePrim(%s);
} else {
return RT.doubleCast(f0.invoke(%s));
}
}")

(def invokeF-format
" public static float invoke%sF(IFn f0%s) {
if(f0 instanceof IFn.%sD) {
return RT.floatCast(((IFn.%sD)f0).invokePrim(%s));
} else {
return RT.floatCast(f0.invoke(%s));
}
}")

(def invokeL-format
" public static long invoke%sL(IFn f0%s) {
if(f0 instanceof IFn.%sL) {
return ((IFn.%sL)f0).invokePrim(%s);
} else {
return RT.longCast(f0.invoke(%s));
}
}")

(def invokeI-format
" public static int invoke%sI(IFn f0%s) {
if(f0 instanceof IFn.%sL) {
return RT.intCast(((IFn.%sL)f0).invokePrim(%s));
} else {
return RT.intCast(f0.invoke(%s));
}
}")

(def invokeS-format
" public static short invoke%sS(IFn f0%s) {
if(f0 instanceof IFn.%sL) {
return RT.shortCast(((IFn.%sL)f0).invokePrim(%s));
} else {
return RT.shortCast(f0.invoke(%s));
}
}")

(def invokeB-format
" public static byte invoke%sB(IFn f0%s) {
if(f0 instanceof IFn.%sL) {
return RT.byteCast(((IFn.%sL)f0).invokePrim(%s));
} else {
return RT.byteCast(f0.invoke(%s));
}
}")

(def alphabet (map char (range 97 122)))

(def arg-types {:D ", double "
:L ", long "
:O ", Object "})

(defn gen-invoke [sig]
(let [formatter (str (last sig))
args (map str (butlast sig))
arg-types (map #(get arg-types (keyword %)) args)
fn-vars (str/join "" (map #(str %1 %2) arg-types (take (count args) alphabet)))
fn-vars-sans-type (str/join ", " (take (count args) alphabet))
arg-str (str/join args)]
(case formatter
"O" (if (some #{"D" "L"} args)
(format invokeO-with-l-or-d-arg-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
(format invokeO-format arg-str fn-vars fn-vars-sans-type))
"L" (format invokeL-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
"I" (format invokeI-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
"S" (format invokeS-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
"B" (format invokeB-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
"D" (format invokeD-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
"F" (format invokeF-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type))))

(defn sigs [args return-types]
(let [fun-sig-reducer (fn [res ret]
(mapcat seq [res (map (fn [params]
(str params ret)) args)]))]
(reduce fun-sig-reducer [] return-types)))

(defn gen-sigs []
(let [small-rets ["L" "I" "S" "B" "D" "F" "O"]
zero-arity (sigs [""] small-rets)
single-arity (sigs ["L" "D" "O"] small-rets)
two-arity (sigs ["LL" "LO" "OL" "DD" "LD" "DL" "OO" "OD" "DO"] small-rets)
big-rets ["O"]
three-arity (sigs ["OOO"] big-rets)
four-arity (sigs ["OOOO"] big-rets)
five-arity (sigs ["OOOOO"] big-rets)
six-arity (sigs ["OOOOOO"] big-rets)
seven-arity (sigs ["OOOOOOO"] big-rets)
eight-arity (sigs ["OOOOOOOO"] big-rets)
nine-arity (sigs ["OOOOOOOOO"] big-rets)
ten-arity (sigs ["OOOOOOOOOO"] big-rets)]
(mapcat seq [zero-arity single-arity two-arity three-arity four-arity five-arity six-arity seven-arity eight-arity nine-arity ten-arity])))

(defn gen-invokers []
(let [sb (StringBuilder. ^String header)
invoker-signatures (gen-sigs)]
(doseq [sig invoker-signatures]
(.append sb (gen-invoke sig))
(.append sb "\n\n"))
(.append sb footer)
(spit "src/jvm/clojure/lang/FnInvokers.java" (.toString sb))))

(comment
(gen-invokers)
)
263 changes: 263 additions & 0 deletions codegen/gen_math.clj
View file

Large diffs are not rendered by default.

202 changes: 202 additions & 0 deletions doc/clojure/pprint/CommonLispFormat.markdown
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,202 @@
# 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.
270 changes: 270 additions & 0 deletions doc/clojure/pprint/PrettyPrinting.markdown
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,270 @@
# 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 (<functions you wish to use>)])`.

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.

22 changes: 0 additions & 22 deletions pom-template.xml
View file

This file was deleted.

348 changes: 348 additions & 0 deletions pom.xml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,348 @@
<?xml version="1.0" encoding="UTF-8"?>
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
<name>clojure</name>
<packaging>jar</packaging>
<version>1.12.0-master-SNAPSHOT</version>

<url>http://clojure.org/</url>
<description>Clojure core environment and runtime library.</description>

<developers>
<developer>
<name>Rich Hickey</name>
<email>richhickey@gmail.com</email>
<timezone>-5</timezone>
</developer>
</developers>

<licenses>
<license>
<name>Eclipse Public License 1.0</name>
<url>http://opensource.org/licenses/eclipse-1.0.php</url>
<distribution>repo</distribution>
</license>
</licenses>

<scm>
<connection>scm:git:git@github.com:clojure/clojure.git</connection>
<developerConnection>scm:git:git@github.com:clojure/clojure.git</developerConnection>
<url>git@github.com:clojure/clojure.git</url>
<tag>HEAD</tag>
</scm>

<properties>
<directlinking>true</directlinking>
</properties>

<dependencies>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>spec.alpha</artifactId>
<version>0.5.238</version>
</dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>core.specs.alpha</artifactId>
<version>0.4.74</version>
</dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>test.generative</artifactId>
<version>1.1.0</version>
<scope>test</scope>
<exclusions>
<exclusion>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
</exclusion>
</exclusions>
</dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>test.check</artifactId>
<version>1.1.1</version>
<scope>test</scope>
<exclusions>
<exclusion>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
</exclusion>
</exclusions>
</dependency>
<dependency>
<groupId>javax.xml.ws</groupId>
<artifactId>jaxws-api</artifactId>
<version>2.3.1</version>
<scope>test</scope>
</dependency>
</dependencies>

<distributionManagement>
<snapshotRepository>
<!-- This id is linked to the key setup on the CI server -->
<id>sonatype-nexus-staging</id>
<url>https://oss.sonatype.org/content/repositories/snapshots</url>
</snapshotRepository>
</distributionManagement>

<build>
<resources>
<resource>
<directory>src/resources</directory>
<filtering>true</filtering>
</resource>
<resource>
<directory>src/clj</directory>
</resource>
</resources>
<testSourceDirectory>test/java</testSourceDirectory>
<plugins>
<plugin>
<groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-compiler-plugin</artifactId>
<version>3.13.0</version>
<configuration>
<source>1.8</source>
<target>1.8</target>
<encoding>UTF-8</encoding>
</configuration>
</plugin>
<plugin>
<artifactId>maven-antrun-plugin</artifactId>
<version>3.1.0</version>
<executions>
<execution>
<id>clojure-compile</id>
<phase>compile</phase>
<goals>
<goal>run</goal>
</goals>
<configuration>
<target>
<property name="maven.compile.classpath" refid="maven.compile.classpath" />
<ant target="compile-clojure" />
</target>
</configuration>
</execution>
<execution>
<id>clojure-test</id>
<phase>test</phase>
<goals>
<goal>run</goal>
</goals>
<configuration>
<target>
<property name="maven.test.classpath" refid="maven.test.classpath" />
<ant target="test" />
</target>
</configuration>
</execution>
</executions>
</plugin>
<plugin>
<groupId>org.codehaus.mojo</groupId>
<artifactId>build-helper-maven-plugin</artifactId>
<version>3.5.0</version>
<executions>
<execution>
<id>add-clojure-source-dirs</id>
<phase>generate-sources</phase>
<goals>
<goal>add-source</goal>
</goals>
<configuration>
<sources>
<source>src/jvm</source>
</sources>
</configuration>
</execution>
</executions>
</plugin>
<plugin>
<artifactId>maven-assembly-plugin</artifactId>
<version>3.7.1</version>
<executions>
<execution>
<id>clojure-slim-jar</id>
<phase>package</phase>
<goals>
<goal>single</goal>
</goals>
<configuration>
<descriptors>
<descriptor>src/assembly/slim.xml</descriptor>
</descriptors>
</configuration>
</execution>
</executions>
</plugin>
<plugin>
<artifactId>maven-jar-plugin</artifactId>
<version>3.4.1</version>
</plugin>
<plugin>
<artifactId>maven-source-plugin</artifactId>
<version>3.3.1</version>
<executions>
<execution>
<id>attach-sources</id>
<phase>package</phase>
<goals>
<goal>jar</goal>
</goals>
<configuration>
<excludes>
<exclude>clojure/version.properties</exclude>
</excludes>
</configuration>
</execution>
</executions>
</plugin>
<plugin>
<!-- do not push SCM changes to upstream repository;
prevents pushing tags/commits for failed releases;
instead, push SCM changes in Hudson configuration -->
<groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-release-plugin</artifactId>
<version>3.0.1</version>
<configuration>
<pushChanges>false</pushChanges>
<localCheckout>true</localCheckout>
</configuration>
</plugin>
<plugin>
<!-- disable the Surefire testing plugin -->
<groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-surefire-plugin</artifactId>
<version>3.2.5</version>
<configuration>
<skip>true</skip>
</configuration>
</plugin>

<!-- deploy artifacts to sonatype -->
<plugin>
<groupId>org.sonatype.plugins</groupId>
<artifactId>nexus-staging-maven-plugin</artifactId>
<version>1.6.13</version>
<extensions>true</extensions>
<configuration>
<!-- The server "id" element from settings to use authentication from -->
<serverId>sonatype-nexus-staging</serverId>
<nexusUrl>https://oss.sonatype.org/</nexusUrl>
<autoReleaseAfterClose>true</autoReleaseAfterClose>
</configuration>
</plugin>

</plugins>
</build>

<profiles>
<!-- Use "mvn -Ptest-direct" or "mvn -Ptest-no-direct" to choose testing with direct linking -->
<profile>
<id>test-direct</id>
<properties>
<directlinking>true</directlinking>
</properties>
</profile>
<profile>
<id>test-no-direct</id>
<properties>
<directlinking>false</directlinking>
</properties>
</profile>
<profile>
<!-- "mvn -Pdistribution package" builds a .zip file -->
<id>distribution</id>
<build>
<plugins>
<plugin>
<artifactId>maven-assembly-plugin</artifactId>
<version>3.7.1</version>
<executions>
<execution>
<id>clojure-distribution</id>
<phase>package</phase>
<goals>
<goal>single</goal>
</goals>
<configuration>
<appendAssemblyId>false</appendAssemblyId>
<descriptors>
<descriptor>src/assembly/distribution.xml</descriptor>
</descriptors>
</configuration>
</execution>
</executions>
</plugin>
</plugins>
</build>
</profile>
<profile>
<!-- sign artifacts for deployment -->
<id>sign</id>
<build>
<plugins>
<plugin>
<groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-gpg-plugin</artifactId>
<version>3.2.4</version>
<executions>
<execution>
<id>sign-artifacts</id>
<phase>verify</phase>
<goals>
<goal>sign</goal>
</goals>
</execution>
</executions>
</plugin>
</plugins>
</build>
</profile>
<profile>
<id>local</id>
<dependencies>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>test.check</artifactId>
<version>1.1.1</version>
<exclusions>
<exclusion>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
</exclusion>
</exclusions>
</dependency>
</dependencies>
<build>
<plugins>
<plugin>
<groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-shade-plugin</artifactId>
<version>3.5.3</version>
<executions>
<execution>
<phase>package</phase>
<goals>
<goal>shade</goal>
</goals>
<configuration>
<transformers>
<transformer implementation="org.apache.maven.plugins.shade.resource.ManifestResourceTransformer">
<mainClass>clojure.main</mainClass>
</transformer>
</transformers>
<outputFile>clojure.jar</outputFile>
</configuration>
</execution>
</executions>
</plugin>
</plugins>
</build>
</profile>
</profiles>
</project>
272 changes: 238 additions & 34 deletions readme.txt
View file
Original file line number Diff line number Diff line change
@@ -1,48 +1,252 @@
* 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)
* Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0/)
* which can be found in the file epl-v10.html at the root of this distribution.
* By using this software in any fashion, you are agreeing to be bound by
* the terms of this license.
* You must not remove this notice, or any other, from this software.

Docs: http://clojure.org
Feedback: http://groups.google.com/group/clojure
Docs: https://clojure.org
Feedback: https://ask.clojure.org
Getting Started: https://clojure.org/guides/getting_started

To Run java -cp clojure.jar clojure.lang.Repl
To Build: ant
To build and run locally with Ant:

One-time setup: ./antsetup.sh
To build: ant local
To run: java -jar clojure.jar

To build locally with Maven:

To build (output JARs in target/):
mvn package

To build without testing:
mvn package -Dmaven.test.skip=true

To build and install in local Maven repository:
mvn install

To build a standalone jar with dependencies included:
mvn -Plocal -Dmaven.test.skip=true package

To run with the standalone jar:
java -jar clojure.jar

--------------------------------------------------------------------------
This program uses the ASM bytecode engineering library which is distributed
with the following notice:

Copyright (c) 2000-2005 INRIA, France Telecom
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

3. Neither the name of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
THE POSSIBILITY OF SUCH DAMAGE.
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.




-------------------------------------------------------------------------
This program uses the Guava Murmur3 hash implementation which is distributed
under the Apache License:


Apache License
Version 2.0, January 2004
https://www.apache.org/licenses/

TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION

1. Definitions.

"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.

"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.

"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.

"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.

"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.

"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.

"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).

"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.

"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."

"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.

2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.

3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.

4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:

(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and

(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and

(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and

(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.

You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.

5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.

6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.

7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) 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. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.

8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.

9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.

END OF TERMS AND CONDITIONS
49 changes: 49 additions & 0 deletions src/assembly/distribution.xml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,49 @@
<assembly>
<id>distribution</id>
<formats>
<format>zip</format>
</formats>
<fileSets>
<fileSet>
<directory>src</directory>
<outputDirectory>src</outputDirectory>
</fileSet>
<fileSet>
<directory>doc</directory>
<outputDirectory>doc</outputDirectory>
</fileSet>
<fileSet>
<directory>test</directory>
<outputDirectory>test</outputDirectory>
</fileSet>
<fileSet>
<directory>target</directory>
<outputDirectory>/</outputDirectory>
<filtered>false</filtered>
<includes>
<include>*.jar</include>
</includes>
</fileSet>
</fileSets>
<files>
<file>
<source>pom.xml</source>
</file>
<file>
<source>build.xml</source>
</file>
<file>
<source>readme.txt</source>
<filtered>true</filtered>
</file>
<file>
<source>changes.md</source>
</file>
<file>
<source>clojure.iml</source>
</file>
<file>
<source>epl-v10.html</source>
</file>
</files>
</assembly>
32 changes: 32 additions & 0 deletions src/assembly/slim.xml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
<assembly>
<id>slim</id>
<formats>
<format>jar</format>
</formats>
<includeBaseDirectory>false</includeBaseDirectory>
<fileSets>
<fileSet>
<directory>src/clj</directory>
<outputDirectory>/</outputDirectory>
</fileSet>
<fileSet>
<directory>src/resources</directory>
<outputDirectory>/</outputDirectory>
<filtered>true</filtered>
</fileSet>
<fileSet>
<directory>target/classes/clojure/asm</directory>
<outputDirectory>clojure/asm</outputDirectory>
</fileSet>
<fileSet>
<directory>target/classes/clojure/lang</directory>
<outputDirectory>clojure/lang</outputDirectory>
</fileSet>
</fileSets>
<files>
<file>
<source>target/classes/clojure/main.class</source>
<outputDirectory>clojure</outputDirectory>
</file>
</files>
</assembly>
6,720 changes: 5,414 additions & 1,306 deletions src/clj/clojure/core.clj
View file

Large diffs are not rendered by default.

201 changes: 201 additions & 0 deletions src/clj/clojure/core/protocols.clj
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,201 @@
; 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))))

;; mutates the iterator, respects reduced
(defn iterator-reduce!
([^java.util.Iterator iter f]
(if (.hasNext iter)
(iterator-reduce! iter f (.next iter))
(f)))
([^java.util.Iterator iter f val]
(loop [ret val]
(if (.hasNext iter)
(let [ret (f ret (.next iter))]
(if (reduced? ret)
@ret
(recur ret)))
ret))))

(defn- iter-reduce
([^Iterable coll f]
(iterator-reduce! (.iterator coll) f))
([^Iterable coll f val]
(iterator-reduce! (.iterator coll) f val)))

(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)
len (.length s)]
(loop [i (.i str-seq)
val val]
(if (< i len)
(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]))

(defprotocol Datafiable
:extend-via-metadata true

(datafy [o] "return a representation of o as data (default identity)"))

(extend-protocol Datafiable
nil
(datafy [_] nil)

Object
(datafy [x] x))

(defprotocol Navigable
:extend-via-metadata true

(nav [coll k v] "return (possibly transformed) v in the context of coll and k (a key/index or nil),
defaults to returning v."))

(extend-protocol Navigable
Object
(nav [_ _ x] x))
334 changes: 334 additions & 0 deletions src/clj/clojure/core/reducers.clj
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,334 @@
; 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."
: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 ;;;;;;;;;;

(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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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)))
Loading