diff options
239 files changed, 1628 insertions, 9127 deletions
diff --git a/modules/accumulators/pom.xml b/modules/accumulators/pom.xml new file mode 100644 index 00000000..9e21dc2d --- /dev/null +++ b/modules/accumulators/pom.xml @@ -0,0 +1,31 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>accumulators</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>generic</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>types</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/accumulators.clj b/modules/accumulators/src/main/clojure/clojure/contrib/accumulators.clj index 55073e33..55073e33 100644 --- a/src/main/clojure/clojure/contrib/accumulators.clj +++ b/modules/accumulators/src/main/clojure/clojure/contrib/accumulators.clj diff --git a/modules/agent-utils/pom.xml b/modules/agent-utils/pom.xml new file mode 100644 index 00000000..2ad2d471 --- /dev/null +++ b/modules/agent-utils/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>agent-utils</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/agent_utils.clj b/modules/agent-utils/src/main/clojure/clojure/contrib/agent_utils.clj index 1b7b2107..1b7b2107 100644 --- a/src/main/clojure/clojure/contrib/agent_utils.clj +++ b/modules/agent-utils/src/main/clojure/clojure/contrib/agent_utils.clj diff --git a/modules/apply-macro/pom.xml b/modules/apply-macro/pom.xml new file mode 100644 index 00000000..23048791 --- /dev/null +++ b/modules/apply-macro/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>apply-macro</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/apply_macro.clj b/modules/apply-macro/src/main/clojure/clojure/contrib/apply_macro.clj index 9df85407..9df85407 100644 --- a/src/main/clojure/clojure/contrib/apply_macro.clj +++ b/modules/apply-macro/src/main/clojure/clojure/contrib/apply_macro.clj diff --git a/modules/base64/pom.xml b/modules/base64/pom.xml new file mode 100644 index 00000000..5efe8793 --- /dev/null +++ b/modules/base64/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>base64</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/base64.clj b/modules/base64/src/main/clojure/clojure/contrib/base64.clj index 2556487c..2556487c 100644 --- a/src/main/clojure/clojure/contrib/base64.clj +++ b/modules/base64/src/main/clojure/clojure/contrib/base64.clj diff --git a/modules/classpath/pom.xml b/modules/classpath/pom.xml new file mode 100644 index 00000000..cc1c6ce9 --- /dev/null +++ b/modules/classpath/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>classpath</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>jar</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/classpath.clj b/modules/classpath/src/main/clojure/clojure/contrib/classpath.clj index 232860f0..232860f0 100644 --- a/src/main/clojure/clojure/contrib/classpath.clj +++ b/modules/classpath/src/main/clojure/clojure/contrib/classpath.clj diff --git a/modules/combinatorics/pom.xml b/modules/combinatorics/pom.xml new file mode 100644 index 00000000..176ea6db --- /dev/null +++ b/modules/combinatorics/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>combinatorics</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/combinatorics.clj b/modules/combinatorics/src/main/clojure/clojure/contrib/combinatorics.clj index 1be12aa4..1be12aa4 100644 --- a/src/main/clojure/clojure/contrib/combinatorics.clj +++ b/modules/combinatorics/src/main/clojure/clojure/contrib/combinatorics.clj diff --git a/modules/command-line/pom.xml b/modules/command-line/pom.xml new file mode 100644 index 00000000..8e2e01c9 --- /dev/null +++ b/modules/command-line/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>command-line</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/command_line.clj b/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj index 47ee7849..47ee7849 100644 --- a/src/main/clojure/clojure/contrib/command_line.clj +++ b/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj diff --git a/modules/complex-numbers/pom.xml b/modules/complex-numbers/pom.xml new file mode 100644 index 00000000..7e213208 --- /dev/null +++ b/modules/complex-numbers/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>complex-numbers</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>generic</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>types</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/complex_numbers.clj b/modules/complex-numbers/src/main/clojure/clojure/contrib/complex_numbers.clj index cf9aafd9..cf9aafd9 100644 --- a/src/main/clojure/clojure/contrib/complex_numbers.clj +++ b/modules/complex-numbers/src/main/clojure/clojure/contrib/complex_numbers.clj diff --git a/modules/cond/pom.xml b/modules/cond/pom.xml new file mode 100644 index 00000000..c36e6b4b --- /dev/null +++ b/modules/cond/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>cond</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/cond.clj b/modules/cond/src/main/clojure/clojure/contrib/cond.clj index d3a5338e..d3a5338e 100644 --- a/src/main/clojure/clojure/contrib/cond.clj +++ b/modules/cond/src/main/clojure/clojure/contrib/cond.clj diff --git a/modules/condition/pom.xml b/modules/condition/pom.xml new file mode 100644 index 00000000..53113fc7 --- /dev/null +++ b/modules/condition/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>condition</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/condition.clj b/modules/condition/src/main/clojure/clojure/contrib/condition.clj index 57525bfe..57525bfe 100644 --- a/src/main/clojure/clojure/contrib/condition.clj +++ b/modules/condition/src/main/clojure/clojure/contrib/condition.clj diff --git a/src/main/clojure/clojure/contrib/condition/Condition.clj b/modules/condition/src/main/clojure/clojure/contrib/condition/Condition.clj index 18449653..18449653 100644 --- a/src/main/clojure/clojure/contrib/condition/Condition.clj +++ b/modules/condition/src/main/clojure/clojure/contrib/condition/Condition.clj diff --git a/modules/core/pom.xml b/modules/core/pom.xml new file mode 100644 index 00000000..a4ee6af7 --- /dev/null +++ b/modules/core/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>core</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/core.clj b/modules/core/src/main/clojure/clojure/contrib/core.clj index e7239717..e7239717 100644 --- a/src/main/clojure/clojure/contrib/core.clj +++ b/modules/core/src/main/clojure/clojure/contrib/core.clj diff --git a/modules/dataflow/pom.xml b/modules/dataflow/pom.xml new file mode 100644 index 00000000..8d4ec295 --- /dev/null +++ b/modules/dataflow/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>dataflow</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>graph</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>except</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/dataflow.clj b/modules/dataflow/src/main/clojure/clojure/contrib/dataflow.clj index d326d0d6..d326d0d6 100644 --- a/src/main/clojure/clojure/contrib/dataflow.clj +++ b/modules/dataflow/src/main/clojure/clojure/contrib/dataflow.clj diff --git a/modules/datalog/pom.xml b/modules/datalog/pom.xml new file mode 100644 index 00000000..4a1bdf3b --- /dev/null +++ b/modules/datalog/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>datalog</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>except</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/datalog.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog.clj index 77d9d3a9..77d9d3a9 100644 --- a/src/main/clojure/clojure/contrib/datalog.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog.clj diff --git a/src/main/clojure/clojure/contrib/datalog/database.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/database.clj index 27f84484..27f84484 100644 --- a/src/main/clojure/clojure/contrib/datalog/database.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/database.clj diff --git a/src/main/clojure/clojure/contrib/datalog/literals.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/literals.clj index 37e5d8c9..37e5d8c9 100644 --- a/src/main/clojure/clojure/contrib/datalog/literals.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/literals.clj diff --git a/src/main/clojure/clojure/contrib/datalog/magic.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/magic.clj index ff6891a4..ff6891a4 100644 --- a/src/main/clojure/clojure/contrib/datalog/magic.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/magic.clj diff --git a/src/main/clojure/clojure/contrib/datalog/rules.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/rules.clj index 9cb667e5..9cb667e5 100644 --- a/src/main/clojure/clojure/contrib/datalog/rules.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/rules.clj diff --git a/src/main/clojure/clojure/contrib/datalog/softstrat.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/softstrat.clj index e193fbb9..e193fbb9 100644 --- a/src/main/clojure/clojure/contrib/datalog/softstrat.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/softstrat.clj diff --git a/src/main/clojure/clojure/contrib/datalog/util.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/util.clj index c17b77da..c17b77da 100644 --- a/src/main/clojure/clojure/contrib/datalog/util.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/util.clj diff --git a/modules/def/pom.xml b/modules/def/pom.xml new file mode 100644 index 00000000..be980ac8 --- /dev/null +++ b/modules/def/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>def</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/def.clj b/modules/def/src/main/clojure/clojure/contrib/def.clj index c3cd2c42..c3cd2c42 100644 --- a/src/main/clojure/clojure/contrib/def.clj +++ b/modules/def/src/main/clojure/clojure/contrib/def.clj diff --git a/modules/duck-streams/pom.xml b/modules/duck-streams/pom.xml new file mode 100644 index 00000000..4449a8a1 --- /dev/null +++ b/modules/duck-streams/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>duck-streams</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/duck_streams.clj b/modules/duck-streams/src/main/clojure/clojure/contrib/duck_streams.clj index 8164ffb2..8164ffb2 100644 --- a/src/main/clojure/clojure/contrib/duck_streams.clj +++ b/modules/duck-streams/src/main/clojure/clojure/contrib/duck_streams.clj diff --git a/modules/error-kit/pom.xml b/modules/error-kit/pom.xml new file mode 100644 index 00000000..fed9997b --- /dev/null +++ b/modules/error-kit/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>error-kit</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/error_kit.clj b/modules/error-kit/src/main/clojure/clojure/contrib/error_kit.clj index 6cffd859..6cffd859 100644 --- a/src/main/clojure/clojure/contrib/error_kit.clj +++ b/modules/error-kit/src/main/clojure/clojure/contrib/error_kit.clj diff --git a/modules/except/pom.xml b/modules/except/pom.xml new file mode 100644 index 00000000..53ff771e --- /dev/null +++ b/modules/except/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>except</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/except.clj b/modules/except/src/main/clojure/clojure/contrib/except.clj index 720fcaf7..720fcaf7 100644 --- a/src/main/clojure/clojure/contrib/except.clj +++ b/modules/except/src/main/clojure/clojure/contrib/except.clj diff --git a/modules/fcase/pom.xml b/modules/fcase/pom.xml new file mode 100644 index 00000000..1fb6f9a8 --- /dev/null +++ b/modules/fcase/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>fcase</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/fcase.clj b/modules/fcase/src/main/clojure/clojure/contrib/fcase.clj index 4d0fc184..4d0fc184 100644 --- a/src/main/clojure/clojure/contrib/fcase.clj +++ b/modules/fcase/src/main/clojure/clojure/contrib/fcase.clj diff --git a/modules/find-namespaces/pom.xml b/modules/find-namespaces/pom.xml new file mode 100644 index 00000000..bca2b58b --- /dev/null +++ b/modules/find-namespaces/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>find-namespaces</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>classpath</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>jar</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/find_namespaces.clj b/modules/find-namespaces/src/main/clojure/clojure/contrib/find_namespaces.clj index 928499c7..928499c7 100644 --- a/src/main/clojure/clojure/contrib/find_namespaces.clj +++ b/modules/find-namespaces/src/main/clojure/clojure/contrib/find_namespaces.clj diff --git a/modules/fnmap/pom.xml b/modules/fnmap/pom.xml new file mode 100644 index 00000000..7785e3e5 --- /dev/null +++ b/modules/fnmap/pom.xml @@ -0,0 +1,14 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>fnmap</artifactId> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/fnmap.clj b/modules/fnmap/src/main/clojure/clojure/contrib/fnmap.clj index cc9824c5..cc9824c5 100644 --- a/src/main/clojure/clojure/contrib/fnmap.clj +++ b/modules/fnmap/src/main/clojure/clojure/contrib/fnmap.clj diff --git a/src/main/clojure/clojure/contrib/fnmap/PersistentFnMap.clj b/modules/fnmap/src/main/clojure/clojure/contrib/fnmap/PersistentFnMap.clj index dfa3af64..dfa3af64 100644 --- a/src/main/clojure/clojure/contrib/fnmap/PersistentFnMap.clj +++ b/modules/fnmap/src/main/clojure/clojure/contrib/fnmap/PersistentFnMap.clj diff --git a/modules/gen-html-docs/pom.xml b/modules/gen-html-docs/pom.xml new file mode 100644 index 00000000..587c7e60 --- /dev/null +++ b/modules/gen-html-docs/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>gen-html-docs</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>io</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/gen_html_docs.clj b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj index 73166510..73166510 100644 --- a/src/main/clojure/clojure/contrib/gen_html_docs.clj +++ b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj diff --git a/modules/generic/pom.xml b/modules/generic/pom.xml new file mode 100644 index 00000000..e9f66405 --- /dev/null +++ b/modules/generic/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>generic</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>types</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/generic.clj b/modules/generic/src/main/clojure/clojure/contrib/generic.clj index 44cc6db7..44cc6db7 100644 --- a/src/main/clojure/clojure/contrib/generic.clj +++ b/modules/generic/src/main/clojure/clojure/contrib/generic.clj diff --git a/src/main/clojure/clojure/contrib/generic/arithmetic.clj b/modules/generic/src/main/clojure/clojure/contrib/generic/arithmetic.clj index 04f2c318..04f2c318 100644 --- a/src/main/clojure/clojure/contrib/generic/arithmetic.clj +++ b/modules/generic/src/main/clojure/clojure/contrib/generic/arithmetic.clj diff --git a/src/main/clojure/clojure/contrib/generic/collection.clj b/modules/generic/src/main/clojure/clojure/contrib/generic/collection.clj index cdca97fb..cdca97fb 100644 --- a/src/main/clojure/clojure/contrib/generic/collection.clj +++ b/modules/generic/src/main/clojure/clojure/contrib/generic/collection.clj diff --git a/src/main/clojure/clojure/contrib/generic/comparison.clj b/modules/generic/src/main/clojure/clojure/contrib/generic/comparison.clj index e41b0792..e41b0792 100644 --- a/src/main/clojure/clojure/contrib/generic/comparison.clj +++ b/modules/generic/src/main/clojure/clojure/contrib/generic/comparison.clj diff --git a/src/main/clojure/clojure/contrib/generic/functor.clj b/modules/generic/src/main/clojure/clojure/contrib/generic/functor.clj index 4728eaab..4728eaab 100644 --- a/src/main/clojure/clojure/contrib/generic/functor.clj +++ b/modules/generic/src/main/clojure/clojure/contrib/generic/functor.clj diff --git a/src/main/clojure/clojure/contrib/generic/math_functions.clj b/modules/generic/src/main/clojure/clojure/contrib/generic/math_functions.clj index c0918840..c0918840 100644 --- a/src/main/clojure/clojure/contrib/generic/math_functions.clj +++ b/modules/generic/src/main/clojure/clojure/contrib/generic/math_functions.clj diff --git a/modules/graph/pom.xml b/modules/graph/pom.xml new file mode 100644 index 00000000..9a32dfd6 --- /dev/null +++ b/modules/graph/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>graph</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/graph.clj b/modules/graph/src/main/clojure/clojure/contrib/graph.clj index 226908fc..226908fc 100644 --- a/src/main/clojure/clojure/contrib/graph.clj +++ b/modules/graph/src/main/clojure/clojure/contrib/graph.clj diff --git a/modules/greatest-least/pom.xml b/modules/greatest-least/pom.xml new file mode 100644 index 00000000..b98dea4d --- /dev/null +++ b/modules/greatest-least/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>greatest-least</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/greatest_least.clj b/modules/greatest-least/src/main/clojure/clojure/contrib/greatest_least.clj index 6fce1c0c..6fce1c0c 100644 --- a/src/main/clojure/clojure/contrib/greatest_least.clj +++ b/modules/greatest-least/src/main/clojure/clojure/contrib/greatest_least.clj diff --git a/modules/http-agent/pom.xml b/modules/http-agent/pom.xml new file mode 100644 index 00000000..4de1a63c --- /dev/null +++ b/modules/http-agent/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>http-agent</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>http-connection</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>io</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/http/agent.clj b/modules/http-agent/src/main/clojure/clojure/contrib/http/agent.clj index a42431f6..a42431f6 100644 --- a/src/main/clojure/clojure/contrib/http/agent.clj +++ b/modules/http-agent/src/main/clojure/clojure/contrib/http/agent.clj diff --git a/modules/http-connection/pom.xml b/modules/http-connection/pom.xml new file mode 100644 index 00000000..74aaa0b0 --- /dev/null +++ b/modules/http-connection/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>http-connection</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>io</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/http/connection.clj b/modules/http-connection/src/main/clojure/clojure/contrib/http/connection.clj index c6cf162a..c6cf162a 100644 --- a/src/main/clojure/clojure/contrib/http/connection.clj +++ b/modules/http-connection/src/main/clojure/clojure/contrib/http/connection.clj diff --git a/modules/import-static/pom.xml b/modules/import-static/pom.xml new file mode 100644 index 00000000..a5730130 --- /dev/null +++ b/modules/import-static/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>import-static</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/import_static.clj b/modules/import-static/src/main/clojure/clojure/contrib/import_static.clj index c15bac52..c15bac52 100644 --- a/src/main/clojure/clojure/contrib/import_static.clj +++ b/modules/import-static/src/main/clojure/clojure/contrib/import_static.clj diff --git a/modules/io/pom.xml b/modules/io/pom.xml new file mode 100644 index 00000000..f22d4494 --- /dev/null +++ b/modules/io/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>io</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/io.clj b/modules/io/src/main/clojure/clojure/contrib/io.clj index 4d793180..4d793180 100644 --- a/src/main/clojure/clojure/contrib/io.clj +++ b/modules/io/src/main/clojure/clojure/contrib/io.clj diff --git a/modules/jar/pom.xml b/modules/jar/pom.xml new file mode 100644 index 00000000..6e7154d5 --- /dev/null +++ b/modules/jar/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>jar</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/jar.clj b/modules/jar/src/main/clojure/clojure/contrib/jar.clj index df471f27..df471f27 100644 --- a/src/main/clojure/clojure/contrib/jar.clj +++ b/modules/jar/src/main/clojure/clojure/contrib/jar.clj diff --git a/modules/java-utils/pom.xml b/modules/java-utils/pom.xml new file mode 100644 index 00000000..7c276109 --- /dev/null +++ b/modules/java-utils/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>java-utils</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/java_utils.clj b/modules/java-utils/src/main/clojure/clojure/contrib/java_utils.clj index 65e84eda..65e84eda 100644 --- a/src/main/clojure/clojure/contrib/java_utils.clj +++ b/modules/java-utils/src/main/clojure/clojure/contrib/java_utils.clj diff --git a/modules/javadoc/pom.xml b/modules/javadoc/pom.xml new file mode 100644 index 00000000..33f5aa0d --- /dev/null +++ b/modules/javadoc/pom.xml @@ -0,0 +1,14 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>javadoc</artifactId> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/javadoc.clj b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc.clj index 7ac30a4e..7ac30a4e 100644 --- a/src/main/clojure/clojure/contrib/javadoc.clj +++ b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc.clj diff --git a/src/main/clojure/clojure/contrib/javadoc/browse.clj b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse.clj index a47fc0cd..a47fc0cd 100644 --- a/src/main/clojure/clojure/contrib/javadoc/browse.clj +++ b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse.clj diff --git a/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj index 388c76d5..388c76d5 100644 --- a/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj +++ b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj diff --git a/modules/jmx/pom.xml b/modules/jmx/pom.xml new file mode 100644 index 00000000..70d24b3f --- /dev/null +++ b/modules/jmx/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>jmx</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/jmx.clj b/modules/jmx/src/main/clojure/clojure/contrib/jmx.clj index ca0232ed..ca0232ed 100644 --- a/src/main/clojure/clojure/contrib/jmx.clj +++ b/modules/jmx/src/main/clojure/clojure/contrib/jmx.clj diff --git a/src/main/clojure/clojure/contrib/jmx/Bean.clj b/modules/jmx/src/main/clojure/clojure/contrib/jmx/Bean.clj index cae67d21..cae67d21 100644 --- a/src/main/clojure/clojure/contrib/jmx/Bean.clj +++ b/modules/jmx/src/main/clojure/clojure/contrib/jmx/Bean.clj diff --git a/modules/json/pom.xml b/modules/json/pom.xml new file mode 100644 index 00000000..95f611ca --- /dev/null +++ b/modules/json/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>json</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>pprint</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/json.clj b/modules/json/src/main/clojure/clojure/contrib/json.clj index 69f6cc9d..69f6cc9d 100644 --- a/src/main/clojure/clojure/contrib/json.clj +++ b/modules/json/src/main/clojure/clojure/contrib/json.clj diff --git a/modules/lazy-seqs/pom.xml b/modules/lazy-seqs/pom.xml new file mode 100644 index 00000000..3c8ce102 --- /dev/null +++ b/modules/lazy-seqs/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>lazy-seqs</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/lazy_seqs.clj b/modules/lazy-seqs/src/main/clojure/clojure/contrib/lazy_seqs.clj index 2a0c0a6c..2a0c0a6c 100644 --- a/src/main/clojure/clojure/contrib/lazy_seqs.clj +++ b/modules/lazy-seqs/src/main/clojure/clojure/contrib/lazy_seqs.clj diff --git a/modules/lazy-xml/pom.xml b/modules/lazy-xml/pom.xml new file mode 100644 index 00000000..7fa50d12 --- /dev/null +++ b/modules/lazy-xml/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>lazy-xml</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/lazy_xml.clj b/modules/lazy-xml/src/main/clojure/clojure/contrib/lazy_xml.clj index 5b4ce124..5b4ce124 100644 --- a/src/main/clojure/clojure/contrib/lazy_xml.clj +++ b/modules/lazy-xml/src/main/clojure/clojure/contrib/lazy_xml.clj diff --git a/modules/logging/pom.xml b/modules/logging/pom.xml new file mode 100644 index 00000000..0467492f --- /dev/null +++ b/modules/logging/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>logging</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/logging.clj b/modules/logging/src/main/clojure/clojure/contrib/logging.clj index 30141e7b..30141e7b 100644 --- a/src/main/clojure/clojure/contrib/logging.clj +++ b/modules/logging/src/main/clojure/clojure/contrib/logging.clj diff --git a/modules/macro-utils/pom.xml b/modules/macro-utils/pom.xml new file mode 100644 index 00000000..65b09edc --- /dev/null +++ b/modules/macro-utils/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>macro-utils</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/macro_utils.clj b/modules/macro-utils/src/main/clojure/clojure/contrib/macro_utils.clj index e101f712..e101f712 100644 --- a/src/main/clojure/clojure/contrib/macro_utils.clj +++ b/modules/macro-utils/src/main/clojure/clojure/contrib/macro_utils.clj diff --git a/modules/macros/pom.xml b/modules/macros/pom.xml new file mode 100644 index 00000000..dcd6d78d --- /dev/null +++ b/modules/macros/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>macros</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/macros.clj b/modules/macros/src/main/clojure/clojure/contrib/macros.clj index ce6b3237..ce6b3237 100644 --- a/src/main/clojure/clojure/contrib/macros.clj +++ b/modules/macros/src/main/clojure/clojure/contrib/macros.clj diff --git a/modules/map-utils/pom.xml b/modules/map-utils/pom.xml new file mode 100644 index 00000000..5a058d00 --- /dev/null +++ b/modules/map-utils/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>map-utils</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/map_utils.clj b/modules/map-utils/src/main/clojure/clojure/contrib/map_utils.clj index 886c2529..886c2529 100644 --- a/src/main/clojure/clojure/contrib/map_utils.clj +++ b/modules/map-utils/src/main/clojure/clojure/contrib/map_utils.clj diff --git a/modules/math/pom.xml b/modules/math/pom.xml new file mode 100644 index 00000000..f4142297 --- /dev/null +++ b/modules/math/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>math</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/math.clj b/modules/math/src/main/clojure/clojure/contrib/math.clj index d4519de9..d4519de9 100644 --- a/src/main/clojure/clojure/contrib/math.clj +++ b/modules/math/src/main/clojure/clojure/contrib/math.clj diff --git a/modules/miglayout/pom.xml b/modules/miglayout/pom.xml new file mode 100644 index 00000000..c94b6726 --- /dev/null +++ b/modules/miglayout/pom.xml @@ -0,0 +1,14 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>miglayout</artifactId> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/miglayout.clj b/modules/miglayout/src/main/clojure/clojure/contrib/miglayout.clj index f9c03a13..f9c03a13 100644 --- a/src/main/clojure/clojure/contrib/miglayout.clj +++ b/modules/miglayout/src/main/clojure/clojure/contrib/miglayout.clj diff --git a/src/main/clojure/clojure/contrib/miglayout/internal.clj b/modules/miglayout/src/main/clojure/clojure/contrib/miglayout/internal.clj index f6e6431f..f6e6431f 100644 --- a/src/main/clojure/clojure/contrib/miglayout/internal.clj +++ b/modules/miglayout/src/main/clojure/clojure/contrib/miglayout/internal.clj diff --git a/modules/mmap/pom.xml b/modules/mmap/pom.xml new file mode 100644 index 00000000..f64a04cd --- /dev/null +++ b/modules/mmap/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>mmap</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/mmap.clj b/modules/mmap/src/main/clojure/clojure/contrib/mmap.clj index 0adbf38f..0adbf38f 100644 --- a/src/main/clojure/clojure/contrib/mmap.clj +++ b/modules/mmap/src/main/clojure/clojure/contrib/mmap.clj diff --git a/modules/mock-test-adapter/pom.xml b/modules/mock-test-adapter/pom.xml new file mode 100644 index 00000000..3acd6504 --- /dev/null +++ b/modules/mock-test-adapter/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>mock-test-adapter</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>ns-utils</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>mock</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/mock/test_adapter.clj b/modules/mock-test-adapter/src/main/clojure/clojure/contrib/mock/test_adapter.clj index 466cb537..466cb537 100644 --- a/src/main/clojure/clojure/contrib/mock/test_adapter.clj +++ b/modules/mock-test-adapter/src/main/clojure/clojure/contrib/mock/test_adapter.clj diff --git a/modules/mock/pom.xml b/modules/mock/pom.xml new file mode 100644 index 00000000..e6eedcf1 --- /dev/null +++ b/modules/mock/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>mock</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/mock.clj b/modules/mock/src/main/clojure/clojure/contrib/mock.clj index aaa36a8c..aaa36a8c 100644 --- a/src/main/clojure/clojure/contrib/mock.clj +++ b/modules/mock/src/main/clojure/clojure/contrib/mock.clj diff --git a/modules/monadic-io-streams/pom.xml b/modules/monadic-io-streams/pom.xml new file mode 100644 index 00000000..a2ce4eb6 --- /dev/null +++ b/modules/monadic-io-streams/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>monadic-io-streams</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>monads</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>generic</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/monadic_io_streams.clj b/modules/monadic-io-streams/src/main/clojure/clojure/contrib/monadic_io_streams.clj index 31ad0ac4..31ad0ac4 100644 --- a/src/main/clojure/clojure/contrib/monadic_io_streams.clj +++ b/modules/monadic-io-streams/src/main/clojure/clojure/contrib/monadic_io_streams.clj diff --git a/modules/monads/pom.xml b/modules/monads/pom.xml new file mode 100644 index 00000000..cc39a3d1 --- /dev/null +++ b/modules/monads/pom.xml @@ -0,0 +1,31 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>monads</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>accumulators</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>macro-utils</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/monads.clj b/modules/monads/src/main/clojure/clojure/contrib/monads.clj index 3cb1bd16..3cb1bd16 100644 --- a/src/main/clojure/clojure/contrib/monads.clj +++ b/modules/monads/src/main/clojure/clojure/contrib/monads.clj diff --git a/modules/ns-utils/pom.xml b/modules/ns-utils/pom.xml new file mode 100644 index 00000000..bbb86402 --- /dev/null +++ b/modules/ns-utils/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>ns-utils</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>except</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/ns_utils.clj b/modules/ns-utils/src/main/clojure/clojure/contrib/ns_utils.clj index ba8c43ce..ba8c43ce 100644 --- a/src/main/clojure/clojure/contrib/ns_utils.clj +++ b/modules/ns-utils/src/main/clojure/clojure/contrib/ns_utils.clj diff --git a/modules/parent/pom.xml b/modules/parent/pom.xml new file mode 100644 index 00000000..4ec4a560 --- /dev/null +++ b/modules/parent/pom.xml @@ -0,0 +1,65 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <properties> + <clojure.version>1.2.0-RC1</clojure.version> + <project.build.sourceEncoding>UTF-8</project.build.sourceEncoding> + </properties> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <packaging>pom</packaging> + <name>Clojure Contrib parent module</name> + <dependencies> + <dependency> + <groupId>org.clojure</groupId> + <artifactId>clojure</artifactId> + <version>${clojure.version}</version> + </dependency> + </dependencies> + <build> + <resources> + <resource> + <directory>src/main/clojure</directory> + </resource> + <resource> + <directory>src/examples/clojure</directory> + </resource> + </resources> + <testResources> + <testResource> + <directory>src/test/clojure</directory> + </testResource> + </testResources> + <plugins> + <plugin> + <groupId>com.theoryinpractise</groupId> + <artifactId>clojure-maven-plugin</artifactId> + <version>1.3.3</version> + <configuration> + <compileDeclaredNamespaceOnly>true</compileDeclaredNamespaceOnly> + </configuration> + <!-- <executions> + <execution> + <id>compile-clojure</id> + <phase>compile</phase> + <goals> + <goal>compile</goal> + </goals> + </execution> + <execution> + <id>test-clojure</id> + <phase>test</phase> + <goals> + <goal>test</goal> + </goals> + </execution> + </executions> --> + </plugin> + </plugins> + </build> +</project> diff --git a/modules/pprint/pom.xml b/modules/pprint/pom.xml new file mode 100644 index 00000000..fd5e7526 --- /dev/null +++ b/modules/pprint/pom.xml @@ -0,0 +1,14 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>pprint</artifactId> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/pprint.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint.clj index 27c1be73..27c1be73 100644 --- a/src/main/clojure/clojure/contrib/pprint.clj +++ b/modules/pprint/src/main/clojure/clojure/contrib/pprint.clj diff --git a/src/main/clojure/clojure/contrib/pprint/column_writer.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/column_writer.clj index 32e62931..32e62931 100644 --- a/src/main/clojure/clojure/contrib/pprint/column_writer.clj +++ b/modules/pprint/src/main/clojure/clojure/contrib/pprint/column_writer.clj diff --git a/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj index dfea976a..dfea976a 100644 --- a/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj +++ b/modules/pprint/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj diff --git a/src/main/clojure/clojure/contrib/pprint/utilities.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/utilities.clj index 128c66e5..128c66e5 100644 --- a/src/main/clojure/clojure/contrib/pprint/utilities.clj +++ b/modules/pprint/src/main/clojure/clojure/contrib/pprint/utilities.clj diff --git a/modules/priority-map/pom.xml b/modules/priority-map/pom.xml new file mode 100644 index 00000000..f6851444 --- /dev/null +++ b/modules/priority-map/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>priority-map</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/priority_map.clj b/modules/priority-map/src/main/clojure/clojure/contrib/priority_map.clj index 5f01e5d2..5f01e5d2 100644 --- a/src/main/clojure/clojure/contrib/priority_map.clj +++ b/modules/priority-map/src/main/clojure/clojure/contrib/priority_map.clj diff --git a/modules/probabilities/pom.xml b/modules/probabilities/pom.xml new file mode 100644 index 00000000..5f478a18 --- /dev/null +++ b/modules/probabilities/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>probabilities-finite-distributions</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>monads</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/probabilities/finite_distributions.clj b/modules/probabilities/src/main/clojure/clojure/contrib/probabilities/finite_distributions.clj index 86e5aec0..86e5aec0 100644 --- a/src/main/clojure/clojure/contrib/probabilities/finite_distributions.clj +++ b/modules/probabilities/src/main/clojure/clojure/contrib/probabilities/finite_distributions.clj diff --git a/src/main/clojure/clojure/contrib/probabilities/monte_carlo.clj b/modules/probabilities/src/main/clojure/clojure/contrib/probabilities/monte_carlo.clj index 73c89de8..73c89de8 100644 --- a/src/main/clojure/clojure/contrib/probabilities/monte_carlo.clj +++ b/modules/probabilities/src/main/clojure/clojure/contrib/probabilities/monte_carlo.clj diff --git a/src/main/clojure/clojure/contrib/probabilities/random_numbers.clj b/modules/probabilities/src/main/clojure/clojure/contrib/probabilities/random_numbers.clj index 8f7b358c..8f7b358c 100644 --- a/src/main/clojure/clojure/contrib/probabilities/random_numbers.clj +++ b/modules/probabilities/src/main/clojure/clojure/contrib/probabilities/random_numbers.clj diff --git a/modules/profile/pom.xml b/modules/profile/pom.xml new file mode 100644 index 00000000..9882c99a --- /dev/null +++ b/modules/profile/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>profile</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/profile.clj b/modules/profile/src/main/clojure/clojure/contrib/profile.clj index 19b61a47..19b61a47 100644 --- a/src/main/clojure/clojure/contrib/profile.clj +++ b/modules/profile/src/main/clojure/clojure/contrib/profile.clj diff --git a/modules/properties/pom.xml b/modules/properties/pom.xml new file mode 100644 index 00000000..c0cbca7a --- /dev/null +++ b/modules/properties/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>properties</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>io</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/properties.clj b/modules/properties/src/main/clojure/clojure/contrib/properties.clj index 0e210206..0e210206 100644 --- a/src/main/clojure/clojure/contrib/properties.clj +++ b/modules/properties/src/main/clojure/clojure/contrib/properties.clj diff --git a/modules/prxml/pom.xml b/modules/prxml/pom.xml new file mode 100644 index 00000000..c3132665 --- /dev/null +++ b/modules/prxml/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>prxml</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/prxml.clj b/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj index 2c2ec761..2c2ec761 100755..100644 --- a/src/main/clojure/clojure/contrib/prxml.clj +++ b/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj diff --git a/modules/reflect/pom.xml b/modules/reflect/pom.xml new file mode 100644 index 00000000..a936806a --- /dev/null +++ b/modules/reflect/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>reflect</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/reflect.clj b/modules/reflect/src/main/clojure/clojure/contrib/reflect.clj index 8d254c31..8d254c31 100644 --- a/src/main/clojure/clojure/contrib/reflect.clj +++ b/modules/reflect/src/main/clojure/clojure/contrib/reflect.clj diff --git a/modules/repl-ln/pom.xml b/modules/repl-ln/pom.xml new file mode 100644 index 00000000..7fb0aad3 --- /dev/null +++ b/modules/repl-ln/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>repl-ln</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/repl_ln.clj b/modules/repl-ln/src/main/clojure/clojure/contrib/repl_ln.clj index 9bef1c62..9bef1c62 100644 --- a/src/main/clojure/clojure/contrib/repl_ln.clj +++ b/modules/repl-ln/src/main/clojure/clojure/contrib/repl_ln.clj diff --git a/modules/repl-utils/pom.xml b/modules/repl-utils/pom.xml new file mode 100644 index 00000000..449d7677 --- /dev/null +++ b/modules/repl-utils/pom.xml @@ -0,0 +1,31 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>repl-utils</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>javadoc</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/repl_utils.clj b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj index fdb321a5..fdb321a5 100644 --- a/src/main/clojure/clojure/contrib/repl_utils.clj +++ b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj diff --git a/modules/seq-utils/pom.xml b/modules/seq-utils/pom.xml new file mode 100644 index 00000000..5c796881 --- /dev/null +++ b/modules/seq-utils/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>seq-utils</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/seq_utils.clj b/modules/seq-utils/src/main/clojure/clojure/contrib/seq_utils.clj index 399a2ca2..399a2ca2 100644 --- a/src/main/clojure/clojure/contrib/seq_utils.clj +++ b/modules/seq-utils/src/main/clojure/clojure/contrib/seq_utils.clj diff --git a/modules/seq/pom.xml b/modules/seq/pom.xml new file mode 100644 index 00000000..a6f01262 --- /dev/null +++ b/modules/seq/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>seq</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/seq.clj b/modules/seq/src/main/clojure/clojure/contrib/seq.clj index 1bbd2110..1bbd2110 100644 --- a/src/main/clojure/clojure/contrib/seq.clj +++ b/modules/seq/src/main/clojure/clojure/contrib/seq.clj diff --git a/modules/server-socket/pom.xml b/modules/server-socket/pom.xml new file mode 100644 index 00000000..bb3039e8 --- /dev/null +++ b/modules/server-socket/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>server-socket</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/server_socket.clj b/modules/server-socket/src/main/clojure/clojure/contrib/server_socket.clj index edfe461c..edfe461c 100644 --- a/src/main/clojure/clojure/contrib/server_socket.clj +++ b/modules/server-socket/src/main/clojure/clojure/contrib/server_socket.clj diff --git a/modules/set/pom.xml b/modules/set/pom.xml new file mode 100644 index 00000000..55232e5f --- /dev/null +++ b/modules/set/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>set</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/set.clj b/modules/set/src/main/clojure/clojure/contrib/set.clj index 4c831a6c..4c831a6c 100644 --- a/src/main/clojure/clojure/contrib/set.clj +++ b/modules/set/src/main/clojure/clojure/contrib/set.clj diff --git a/modules/shell-out/pom.xml b/modules/shell-out/pom.xml new file mode 100644 index 00000000..219bb2b7 --- /dev/null +++ b/modules/shell-out/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>shell-out</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/shell_out.clj b/modules/shell-out/src/main/clojure/clojure/contrib/shell_out.clj index 8fcd3680..8fcd3680 100644 --- a/src/main/clojure/clojure/contrib/shell_out.clj +++ b/modules/shell-out/src/main/clojure/clojure/contrib/shell_out.clj diff --git a/modules/shell/pom.xml b/modules/shell/pom.xml new file mode 100644 index 00000000..a74b677f --- /dev/null +++ b/modules/shell/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>shell</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/shell.clj b/modules/shell/src/main/clojure/clojure/contrib/shell.clj index 63467664..63467664 100644 --- a/src/main/clojure/clojure/contrib/shell.clj +++ b/modules/shell/src/main/clojure/clojure/contrib/shell.clj diff --git a/modules/singleton/pom.xml b/modules/singleton/pom.xml new file mode 100644 index 00000000..47b8975d --- /dev/null +++ b/modules/singleton/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>singleton</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/singleton.clj b/modules/singleton/src/main/clojure/clojure/contrib/singleton.clj index 2545d9c7..2545d9c7 100644 --- a/src/main/clojure/clojure/contrib/singleton.clj +++ b/modules/singleton/src/main/clojure/clojure/contrib/singleton.clj diff --git a/modules/sql/pom.xml b/modules/sql/pom.xml new file mode 100644 index 00000000..de94c477 --- /dev/null +++ b/modules/sql/pom.xml @@ -0,0 +1,26 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>sql</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>string</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/sql.clj b/modules/sql/src/main/clojure/clojure/contrib/sql.clj index c6946078..c6946078 100644 --- a/src/main/clojure/clojure/contrib/sql.clj +++ b/modules/sql/src/main/clojure/clojure/contrib/sql.clj diff --git a/src/main/clojure/clojure/contrib/sql/internal.clj b/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj index 59a05205..59a05205 100644 --- a/src/main/clojure/clojure/contrib/sql/internal.clj +++ b/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj diff --git a/modules/str-utils/pom.xml b/modules/str-utils/pom.xml new file mode 100644 index 00000000..63ea53e5 --- /dev/null +++ b/modules/str-utils/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>str-utils</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/str_utils.clj b/modules/str-utils/src/main/clojure/clojure/contrib/str_utils.clj index 2aee325a..2aee325a 100644 --- a/src/main/clojure/clojure/contrib/str_utils.clj +++ b/modules/str-utils/src/main/clojure/clojure/contrib/str_utils.clj diff --git a/modules/str-utils2/pom.xml b/modules/str-utils2/pom.xml new file mode 100644 index 00000000..83bfd85c --- /dev/null +++ b/modules/str-utils2/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>str-utils2</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/str_utils2.clj b/modules/str-utils2/src/main/clojure/clojure/contrib/str_utils2.clj index 344666c0..344666c0 100644 --- a/src/main/clojure/clojure/contrib/str_utils2.clj +++ b/modules/str-utils2/src/main/clojure/clojure/contrib/str_utils2.clj diff --git a/modules/stream-utils/pom.xml b/modules/stream-utils/pom.xml new file mode 100644 index 00000000..f303b1cf --- /dev/null +++ b/modules/stream-utils/pom.xml @@ -0,0 +1,41 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>stream-utils</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>monads</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>types</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>generic</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/stream_utils.clj b/modules/stream-utils/src/main/clojure/clojure/contrib/stream_utils.clj index 5e1738dd..5e1738dd 100644 --- a/src/main/clojure/clojure/contrib/stream_utils.clj +++ b/modules/stream-utils/src/main/clojure/clojure/contrib/stream_utils.clj diff --git a/modules/string/pom.xml b/modules/string/pom.xml new file mode 100644 index 00000000..8978a33f --- /dev/null +++ b/modules/string/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>string</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/string.clj b/modules/string/src/main/clojure/clojure/contrib/string.clj index 0042f710..0042f710 100644 --- a/src/main/clojure/clojure/contrib/string.clj +++ b/modules/string/src/main/clojure/clojure/contrib/string.clj diff --git a/modules/strint/pom.xml b/modules/strint/pom.xml new file mode 100644 index 00000000..87a0a49f --- /dev/null +++ b/modules/strint/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>strint</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/strint.clj b/modules/strint/src/main/clojure/clojure/contrib/strint.clj index 53ddd639..53ddd639 100644 --- a/src/main/clojure/clojure/contrib/strint.clj +++ b/modules/strint/src/main/clojure/clojure/contrib/strint.clj diff --git a/modules/swing-utils/pom.xml b/modules/swing-utils/pom.xml new file mode 100644 index 00000000..53106cde --- /dev/null +++ b/modules/swing-utils/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>swing-utils</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/swing_utils.clj b/modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj index 013d7d29..013d7d29 100644 --- a/src/main/clojure/clojure/contrib/swing_utils.clj +++ b/modules/swing-utils/src/main/clojure/clojure/contrib/swing_utils.clj diff --git a/modules/test-is/pom.xml b/modules/test-is/pom.xml new file mode 100644 index 00000000..c0fb8a47 --- /dev/null +++ b/modules/test-is/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>test-is</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/test_is.clj b/modules/test-is/src/main/clojure/clojure/contrib/test_is.clj index a1b0d8f9..a1b0d8f9 100644 --- a/src/main/clojure/clojure/contrib/test_is.clj +++ b/modules/test-is/src/main/clojure/clojure/contrib/test_is.clj diff --git a/modules/trace/pom.xml b/modules/trace/pom.xml new file mode 100644 index 00000000..3ff95092 --- /dev/null +++ b/modules/trace/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>trace</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/trace.clj b/modules/trace/src/main/clojure/clojure/contrib/trace.clj index 0e53b4b3..0e53b4b3 100644 --- a/src/main/clojure/clojure/contrib/trace.clj +++ b/modules/trace/src/main/clojure/clojure/contrib/trace.clj diff --git a/modules/types/pom.xml b/modules/types/pom.xml new file mode 100644 index 00000000..760d2499 --- /dev/null +++ b/modules/types/pom.xml @@ -0,0 +1,21 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>types</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/types.clj b/modules/types/src/main/clojure/clojure/contrib/types.clj index 88595e77..88595e77 100644 --- a/src/main/clojure/clojure/contrib/types.clj +++ b/modules/types/src/main/clojure/clojure/contrib/types.clj diff --git a/modules/with-ns/pom.xml b/modules/with-ns/pom.xml new file mode 100644 index 00000000..b3309566 --- /dev/null +++ b/modules/with-ns/pom.xml @@ -0,0 +1,16 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>with-ns</artifactId> + <dependencies> + </dependencies> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/with_ns.clj b/modules/with-ns/src/main/clojure/clojure/contrib/with_ns.clj index b5dd3b3e..b5dd3b3e 100644 --- a/src/main/clojure/clojure/contrib/with_ns.clj +++ b/modules/with-ns/src/main/clojure/clojure/contrib/with_ns.clj diff --git a/modules/zip-filter/pom.xml b/modules/zip-filter/pom.xml new file mode 100644 index 00000000..c6d97c3a --- /dev/null +++ b/modules/zip-filter/pom.xml @@ -0,0 +1,14 @@ +<?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/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>zip-filter</artifactId> +</project>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/zip_filter.clj b/modules/zip-filter/src/main/clojure/clojure/contrib/zip_filter.clj index 14f60030..14f60030 100644 --- a/src/main/clojure/clojure/contrib/zip_filter.clj +++ b/modules/zip-filter/src/main/clojure/clojure/contrib/zip_filter.clj diff --git a/src/main/clojure/clojure/contrib/zip_filter/xml.clj b/modules/zip-filter/src/main/clojure/clojure/contrib/zip_filter/xml.clj index 7459b3fe..7459b3fe 100644 --- a/src/main/clojure/clojure/contrib/zip_filter/xml.clj +++ b/modules/zip-filter/src/main/clojure/clojure/contrib/zip_filter/xml.clj @@ -3,131 +3,96 @@ xmlns:xsi="http//www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/maven-v4_0_0.xsd"> - <properties> - <clojure.version>1.2.0-master-SNAPSHOT</clojure.version> - <project.build.sourceEncoding>UTF-8</project.build.sourceEncoding> - </properties> <modelVersion>4.0.0</modelVersion> - <groupId>org.clojure</groupId> + <groupId>org.clojure.contrib</groupId> <artifactId>clojure-contrib</artifactId> - <version>1.2.0-SNAPSHOT</version> + <version>1.3.0-SNAPSHOT</version> <url>http://clojure.org/</url> <description>Clojure user contributions library.</description> - <name>${artifactId}</name> - <licenses> - <license> - <name>Eclipse Public License 1.0</name> - <url>http://opensource.org/licenses/eclipse-1.0.php</url> - <distribution>repo</distribution> - </license> - </licenses> - <dependencies> - <dependency> - <groupId>org.clojure</groupId> - <artifactId>clojure</artifactId> - <version>${clojure.version}</version> - </dependency> - </dependencies> - <repositories> - <repository> - <id>clojure-snapshots</id> - <url>http://build.clojure.org/snapshots</url> - <releases> - <enabled>false</enabled> - </releases> - <snapshots> - <enabled>true</enabled> - </snapshots> - </repository> - <repository> - <id>clojure-releases</id> - <url>http://build.clojure.org/snapshots</url> - <releases> - <enabled>true</enabled> - </releases> - <snapshots> - <enabled>false</enabled> - </snapshots> - </repository> - </repositories> - <profiles> - <profile> - <id>local</id> - <activation> - <property> - <name>clojure.jar</name> - </property> - </activation> - <dependencies> - <dependency> - <groupId>org.clojure</groupId> - <artifactId>clojure</artifactId> - <version>${clojure.version}</version> - <scope>system</scope> - <systemPath>${clojure.jar}</systemPath> - </dependency> - </dependencies> - </profile> - </profiles> - <build> - <resources> - <resource> - <directory>src/main/clojure</directory> - </resource> - <resource> - <directory>src/examples/clojure</directory> - </resource> - </resources> - <testResources> - <testResource> - <directory>src/test/clojure</directory> - </testResource> - </testResources> - <plugins> - <plugin> - <groupId>com.theoryinpractise</groupId> - <artifactId>clojure-maven-plugin</artifactId> - <version>1.3.2</version> - <configuration> - <compileDeclaredNamespaceOnly>true</compileDeclaredNamespaceOnly> - <namespaces> - <namespace>clojure\.contrib\.jmx\.Bean</namespace> - <namespace>clojure\.contrib\.fnmap\.PersistentFnMap</namespace> - <namespace>clojure\.contrib\.condition\.Condition</namespace> - <namespace>clojure\.contrib\.repl-ln</namespace> - </namespaces> - </configuration> - <executions> - <execution> - <id>compile-clojure</id> - <phase>compile</phase> - <goals> - <goal>compile</goal> - </goals> - </execution> - <execution> - <id>test-clojure</id> - <phase>test</phase> - <goals> - <goal>test</goal> - </goals> - </execution> - </executions> - </plugin> - <plugin> - <artifactId>maven-assembly-plugin</artifactId> - <configuration> - <descriptors> - <descriptor>src/main/assembly/dist.xml</descriptor> - </descriptors> - </configuration> - </plugin> - </plugins> - </build> - <distributionManagement> - <repository> - <id>clojure-releases</id> - <url>scp://build.clojure.org/srv/www/releases</url> - </repository> - </distributionManagement> + <name>Clojure Contrib</name> + <packaging>pom</packaging> + <scm> + <connection>scm:git:git://github.com/clojure/clojure-contrib.git</connection> + <url>http://github.com/clojure/clojure-contrib/</url> + </scm> + <modules> + <!-- The parent module defines common configuration for all modules. --> + <module>modules/parent</module> + + <module>modules/accumulators</module> + <module>modules/agent-utils</module> + <module>modules/apply-macro</module> + <module>modules/base64</module> + <module>modules/classpath</module> + <module>modules/combinatorics</module> + <module>modules/command-line</module> + <module>modules/complex-numbers</module> + <module>modules/cond</module> + <module>modules/condition</module> + <module>modules/core</module> + <module>modules/dataflow</module> + <module>modules/datalog</module> + <module>modules/def</module> + <module>modules/duck-streams</module> + <module>modules/error-kit</module> + <module>modules/except</module> + <module>modules/fcase</module> + <module>modules/find-namespaces</module> + <module>modules/fnmap</module> + <module>modules/gen-html-docs</module> + <module>modules/generic</module> + <module>modules/graph</module> + <module>modules/greatest-least</module> + <module>modules/http-agent</module> + <module>modules/http-connection</module> + <module>modules/import-static</module> + <module>modules/io</module> + <module>modules/jar</module> + <module>modules/java-utils</module> + <module>modules/javadoc</module> + <module>modules/jmx</module> + <module>modules/json</module> + <module>modules/lazy-seqs</module> + <module>modules/lazy-xml</module> + <module>modules/logging</module> + <module>modules/macro-utils</module> + <module>modules/macros</module> + <module>modules/map-utils</module> + <module>modules/math</module> + <module>modules/miglayout</module> + <module>modules/mmap</module> + <module>modules/mock</module> + <module>modules/mock-test-adapter</module> + <module>modules/monadic-io-streams</module> + <module>modules/monads</module> + <module>modules/ns-utils</module> + <module>modules/pprint</module> + <module>modules/priority-map</module> + <module>modules/probabilities</module> + <module>modules/profile</module> + <module>modules/properties</module> + <module>modules/prxml</module> + <module>modules/reflect</module> + <module>modules/repl-ln</module> + <module>modules/repl-utils</module> + <module>modules/seq</module> + <module>modules/seq-utils</module> + <module>modules/server-socket</module> + <module>modules/set</module> + <module>modules/shell</module> + <module>modules/shell-out</module> + <module>modules/singleton</module> + <module>modules/sql</module> + <module>modules/str-utils</module> + <module>modules/str-utils2</module> + <module>modules/stream-utils</module> + <module>modules/string</module> + <module>modules/strint</module> + <module>modules/swing-utils</module> + <module>modules/test-is</module> + <module>modules/trace</module> + <module>modules/types</module> + <module>modules/with-ns</module> + <module>modules/zip-filter</module> + </modules> </project> diff --git a/src/examples/clojure/clojure/contrib/accumulators/examples.clj b/src/examples/clojure/clojure/contrib/accumulators/examples.clj deleted file mode 100644 index b9dcbee5..00000000 --- a/src/examples/clojure/clojure/contrib/accumulators/examples.clj +++ /dev/null @@ -1,93 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Accumulator application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for using accumulators"} - clojure.contrib.accumulators.examples - (:use [clojure.contrib.accumulators - :only (combine add add-items - empty-vector empty-list empty-queue empty-set empty-map - empty-counter empty-counter-with-total - empty-sum empty-product empty-maximum empty-minimum - empty-min-max empty-mean-variance empty-string empty-tuple)])) - -; Vector accumulator: combine is concat, add is conj -(combine [:a :b] [:c :d] [:x :y]) -(add [:a :b] :c) -(add-items empty-vector [:a :b :a]) - -; List accumulator: combine is concat, add is conj -(combine '(:a :b) '(:c :d) '(:x :y)) -(add '(:a :b) :c) -(add-items empty-list [:a :b :a]) - -; Queue accumulator -(let [q1 (add-items empty-queue [:a :b :a]) - q2 (add-items empty-queue [:x :y])] - (combine q1 q2)) - -; Set accumulator: combine is union, add is conj -(combine #{:a :b} #{:c :d} #{:a :d}) -(add #{:a :b} :c) -(add-items empty-set [:a :b :a]) - -; Map accumulator: combine is merge, add is conj -(combine {:a 1} {:b 2 :c 3} {}) -(add {:a 1} [:b 2]) -(add-items empty-map [[:a 1] [:b 2] [:a 0]]) - -; Counter accumulator -(let [c1 (add-items empty-counter [:a :b :a]) - c2 (add-items empty-counter [:x :y])] - (combine c1 c2)) - -; Counter-with-total accumulator -(let [c1 (add-items empty-counter-with-total [:a :b :a]) - c2 (add-items empty-counter-with-total [:x :y])] - (combine c1 c2)) - -; Sum accumulator: combine is addition -(let [s1 (add-items empty-sum [1 2 3]) - s2 (add-items empty-sum [-1 -2 -3])] - (combine s1 s2)) - -; Product accumulator: combine is multiplication -(let [p1 (add-items empty-product [2 3]) - p2 (add-items empty-product [(/ 1 2)])] - (combine p1 p2)) - -; Maximum accumulator: combine is max -(let [m1 (add-items empty-maximum [2 3]) - m2 (add-items empty-maximum [(/ 1 2)])] - (combine m1 m2)) - -; Minimum accumulator: combine is min -(let [m1 (add-items empty-minimum [2 3]) - m2 (add-items empty-minimum [(/ 1 2)])] - (combine m1 m2)) - -; Min-max accumulator: combination of minimum and maximum -(let [m1 (add-items empty-min-max [2 3]) - m2 (add-items empty-min-max [(/ 1 2)])] - (combine m1 m2)) - -; Mean-variance accumulator: sample mean and sample variance -(let [m1 (add-items empty-mean-variance [2 4]) - m2 (add-items empty-mean-variance [6])] - (combine m1 m2)) - -; String accumulator: combine is concatenation -(combine "a" "b" "c" "def") -(add "a" (char 44)) -(add-items empty-string [(char 55) (char 56) (char 57)]) - -; Accumulator tuples permit to update several accumulators in parallel -(let [pair (empty-tuple [empty-vector empty-string])] - (add-items pair [[1 "a"] [2 "b"]])) diff --git a/src/examples/clojure/clojure/contrib/condition/example.clj b/src/examples/clojure/clojure/contrib/condition/example.clj deleted file mode 100644 index 5a7d72ef..00000000 --- a/src/examples/clojure/clojure/contrib/condition/example.clj +++ /dev/null @@ -1,66 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.condition.example.clj -;; -;; scgilardi (gmail) -;; Created 09 June 2009 - -(ns clojure.contrib.condition.example - (:use (clojure.contrib - [condition - :only (handler-case print-stack-trace raise *condition*)]))) - -(defn func [x y] - "Raises an exception if x is negative" - (when (neg? x) - (raise :type :illegal-argument :arg 'x :value x)) - (+ x y)) - -(defn main - [] - - ;; simple handler - - (handler-case :type - (println (func 3 4)) - (println (func -5 10)) - (handle :illegal-argument - (print-stack-trace *condition*)) - (println 3)) - - ;; multiple handlers - - (handler-case :type - (println (func 4 1)) - (println (func -3 22)) - (handle :overflow - (print-stack-trace *condition*)) - (handle :illegal-argument - (print-stack-trace *condition*))) - - ;; nested handlers - - (handler-case :type - (handler-case :type - nil - nil - (println 1) - (println 2) - (println 3) - (println (func 8 2)) - (println (func -6 17)) - ;; no handler for :illegal-argument - (handle :overflow - (println "nested") - (print-stack-trace *condition*))) - (println (func 3 4)) - (println (func -5 10)) - (handle :illegal-argument - (println "outer") - (print-stack-trace *condition*)))) diff --git a/src/examples/clojure/clojure/contrib/datalog/example.clj b/src/examples/clojure/clojure/contrib/datalog/example.clj deleted file mode 100644 index 88fcf961..00000000 --- a/src/examples/clojure/clojure/contrib/datalog/example.clj +++ /dev/null @@ -1,116 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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. -;; -;; example.clj -;; -;; A Clojure implementation of Datalog - Example -;; -;; straszheimjeffrey (gmail) -;; Created 2 March 2009 - - -(ns clojure.contrib.datalog.example - (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)] - [clojure.contrib.datalog.rules :only (<- ?- rules-set)] - [clojure.contrib.datalog.database :only (make-database add-tuples)] - [clojure.contrib.datalog.util :only (*trace-datalog*)])) - - - - -(def db-base - (make-database - (relation :employee [:id :name :position]) - (index :employee :name) - - (relation :boss [:employee-id :boss-id]) - (index :boss :employee-id) - - (relation :can-do-job [:position :job]) - (index :can-do-job :position) - - (relation :job-replacement [:job :can-be-done-by]) - ;(index :job-replacement :can-be-done-by) - - (relation :job-exceptions [:id :job]))) - -(def db - (add-tuples db-base - [:employee :id 1 :name "Bob" :position :boss] - [:employee :id 2 :name "Mary" :position :chief-accountant] - [:employee :id 3 :name "John" :position :accountant] - [:employee :id 4 :name "Sameer" :position :chief-programmer] - [:employee :id 5 :name "Lilian" :position :programmer] - [:employee :id 6 :name "Li" :position :technician] - [:employee :id 7 :name "Fred" :position :sales] - [:employee :id 8 :name "Brenda" :position :sales] - [:employee :id 9 :name "Miki" :position :project-management] - [:employee :id 10 :name "Albert" :position :technician] - - [:boss :employee-id 2 :boss-id 1] - [:boss :employee-id 3 :boss-id 2] - [:boss :employee-id 4 :boss-id 1] - [:boss :employee-id 5 :boss-id 4] - [:boss :employee-id 6 :boss-id 4] - [:boss :employee-id 7 :boss-id 1] - [:boss :employee-id 8 :boss-id 7] - [:boss :employee-id 9 :boss-id 1] - [:boss :employee-id 10 :boss-id 6] - - [:can-do-job :position :boss :job :management] - [:can-do-job :position :accountant :job :accounting] - [:can-do-job :position :chief-accountant :job :accounting] - [:can-do-job :position :programmer :job :programming] - [:can-do-job :position :chief-programmer :job :programming] - [:can-do-job :position :technician :job :server-support] - [:can-do-job :position :sales :job :sales] - [:can-do-job :position :project-management :job :project-management] - - [:job-replacement :job :pc-support :can-be-done-by :server-support] - [:job-replacement :job :pc-support :can-be-done-by :programming] - [:job-replacement :job :payroll :can-be-done-by :accounting] - - [:job-exceptions :id 4 :job :pc-support])) - -(def rules - (rules-set - (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) - (:employee :id ?e-id :name ?x) - (:employee :id ?b-id :name ?y)) - (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) - (:works-for :employee ?z :boss ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) - (:can-do-job :position ?pos :job ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) - (:employee-job* :employee ?x :job ?z)) - (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) - (:employee :name ?x :position ?z) - (if = ?z :boss)) - (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) - (:employee :id ?id :name ?x) - (not! :job-exceptions :id ?id :job ?y)) - (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) - (not! :employee-job :employee ?y :job :pc-support)))) - - - -(def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x))) -(run-work-plan wp-1 db {'??name "Albert"}) - -(def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x))) -(binding [*trace-datalog* true] - (run-work-plan wp-2 db {'??name "Li"})) - -(def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x))) -(run-work-plan wp-3 db {'??name "Albert"}) - -(def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y))) -(run-work-plan wp-4 db {}) - - -;; End of file diff --git a/src/examples/clojure/clojure/contrib/miglayout/example.clj b/src/examples/clojure/clojure/contrib/miglayout/example.clj deleted file mode 100644 index c688e9fe..00000000 --- a/src/examples/clojure/clojure/contrib/miglayout/example.clj +++ /dev/null @@ -1,60 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.miglayout.example -;; -;; A temperature converter using miglayout. Demonstrates accessing -;; components by their id constraint. -;; -;; scgilardi (gmail) -;; Created 31 May 2009 - -(ns clojure.contrib.miglayout.example - (:import (javax.swing JButton JFrame JLabel JPanel JTextField - SwingUtilities)) - (:use (clojure.contrib - [miglayout :only (miglayout components)] - [swing-utils :only (add-key-typed-listener)]))) - -(defn fahrenheit - "Converts a Celsius temperature to Fahrenheit. Input and output are - strings. Returns \"input?\" if the input can't be parsed as a Double." - [celsius] - (try - (format "%.2f" (+ 32 (* 1.8 (Double/parseDouble celsius)))) - (catch NumberFormatException _ "input?"))) - -(defn- handle-key - "Clears output on most keys, shows conversion on \"Enter\"" - [event out] - (.setText out - (if (= (.getKeyChar event) \newline) - (fahrenheit (-> event .getComponent .getText)) - ""))) - -(defn converter-ui - "Lays out and shows a Temperature Converter UI" - [] - (let [panel - (miglayout (JPanel.) - (JTextField. 6) {:id :input} - (JLabel. "\u00b0Celsius") :wrap - (JLabel.) {:id :output} - (JLabel. "\u00b0Fahrenheit")) - {:keys [input output]} (components panel)] - (add-key-typed-listener input handle-key output) - (doto (JFrame. "Temperature Converter") - (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE) - (.add panel) - (.pack) - (.setVisible true)))) - -(defn main - "Invokes converter-ui in the AWT Event thread" - [] - (SwingUtilities/invokeLater converter-ui)) diff --git a/src/examples/clojure/clojure/contrib/monads/examples.clj b/src/examples/clojure/clojure/contrib/monads/examples.clj deleted file mode 100644 index 00e5dfaf..00000000 --- a/src/examples/clojure/clojure/contrib/monads/examples.clj +++ /dev/null @@ -1,425 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Monad application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for using monads"} - clojure.contrib.monads.examples - (:use [clojure.contrib.monads - :only (domonad with-monad m-lift m-seq m-reduce m-when - sequence-m - maybe-m - state-m fetch-state set-state - writer-m write - cont-m run-cont call-cc - maybe-t)]) - (:require (clojure.contrib [accumulators :as accu]))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Sequence manipulations with the sequence monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; Note: in the Haskell world, this monad is called the list monad. -; The Clojure equivalent to Haskell's lists are (possibly lazy) -; sequences. This is why I call this monad "sequence". All sequences -; created by sequence monad operations are lazy. - -; Monad comprehensions in the sequence monad work exactly the same -; as Clojure's 'for' construct, except that :while clauses are not -; available. -(domonad sequence-m - [x (range 5) - y (range 3)] - (+ x y)) - -; Inside a with-monad block, domonad is used without the monad name. -(with-monad sequence-m - (domonad - [x (range 5) - y (range 3)] - (+ x y))) - -; Conditions are written with :when, as in Clojure's for form: -(domonad sequence-m - [x (range 5) - y (range (+ 1 x)) - :when (= (+ x y) 2)] - (list x y)) - -; :let is also supported like in for: -(domonad sequence-m - [x (range 5) - y (range (+ 1 x)) - :let [sum (+ x y) - diff (- x y)] - :when (= sum 2)] - (list diff)) - -; An example of a sequence function defined in terms of a lift operation. -(with-monad sequence-m - (defn pairs [xs] - ((m-lift 2 #(list %1 %2)) xs xs))) - -(pairs (range 5)) - -; Another way to define pairs is through the m-seq operation. It takes -; a sequence of monadic values and returns a monadic value containing -; the sequence of the underlying values, obtained from chaining together -; from left to right the monadic values in the sequence. -(with-monad sequence-m - (defn pairs [xs] - (m-seq (list xs xs)))) - -(pairs (range 5)) - -; This definition suggests a generalization: -(with-monad sequence-m - (defn ntuples [n xs] - (m-seq (replicate n xs)))) - -(ntuples 2 (range 5)) -(ntuples 3 (range 5)) - -; Lift operations can also be used inside a monad comprehension: -(domonad sequence-m - [x ((m-lift 1 (partial * 2)) (range 5)) - y (range 2)] - [x y]) - -; The m-plus operation does concatenation in the sequence monad. -(domonad sequence-m - [x ((m-lift 2 +) (range 5) (range 3)) - y (m-plus (range 2) '(10 11))] - [x y]) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Handling failures with the maybe monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; Maybe monad versions of basic arithmetic -(with-monad maybe-m - (def m+ (m-lift 2 +)) - (def m- (m-lift 2 -)) - (def m* (m-lift 2 *))) - -; Division is special for two reasons: we can't call it m/ because that's -; not a legal Clojure symbol, and we want it to fail if a division by zero -; is attempted. It is best defined by a monad comprehension with a -; :when clause: -(defn safe-div [x y] - (domonad maybe-m - [a x - b y - :when (not (zero? b))] - (/ a b))) - -; Now do some non-trivial computation with division -; It fails for (1) x = 0, (2) y = 0 or (3) y = -x. -(with-monad maybe-m - (defn some-function [x y] - (let [one (m-result 1)] - (safe-div one (m+ (safe-div one (m-result x)) - (safe-div one (m-result y))))))) - -; An example that doesn't fail: -(some-function 2 3) -; And two that do fail, at different places: -(some-function 2 0) -(some-function 2 -2) - -; In the maybe monad, m-plus selects the first monadic value that -; holds a valid value. -(with-monad maybe-m - (m-plus (some-function 2 0) (some-function 2 -2) (some-function 2 3))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Random numbers with the state monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A state monad item represents a computation that changes a state and -; returns a value. Its structure is a function that takes a state argument -; and returns a two-item list containing the value and the updated state. -; It is important to realize that everything you put into a state monad -; expression is a state monad item (thus a function), and everything you -; get out as well. A state monad does not perform a calculation, it -; constructs a function that does the computation when called. - -; First, we define a simple random number generator with explicit state. -; rng is a function of its state (an integer) that returns the -; pseudo-random value derived from this state and the updated state -; for the next iteration. This is exactly the structure of a state -; monad item. -(defn rng [seed] - (let [m 259200 - value (/ (float seed) (float m)) - next (rem (+ 54773 (* 7141 seed)) m)] - [value next])) - -; We define a convenience function that creates an infinite lazy seq -; of values obtained from iteratively applying a state monad value. -(defn value-seq [f seed] - (lazy-seq - (let [[value next] (f seed)] - (cons value (value-seq f next))))) - -; Next, we define basic statistics functions to check our random numbers -(defn sum [xs] (apply + xs)) -(defn mean [xs] (/ (sum xs) (count xs))) -(defn variance [xs] - (let [m (mean xs) - sq #(* % %)] - (mean (for [x xs] (sq (- x m)))))) - -; rng implements a uniform distribution in the interval [0., 1.), so -; ideally, the mean would be 1/2 (0.5) and the variance 1/12 (0.8333). -(mean (take 1000 (value-seq rng 1))) -(variance (take 1000 (value-seq rng 1))) - -; We make use of the state monad to implement a simple (but often sufficient) -; approximation to a Gaussian distribution: the sum of 12 random numbers -; from rng's distribution, shifted by -6, has a distribution that is -; approximately Gaussian with 0 mean and variance 1, by virtue of the central -; limit theorem. -; In the first version, we call rng 12 times explicitly and calculate the -; shifted sum in a monad comprehension: -(def gaussian1 - (domonad state-m - [x1 rng - x2 rng - x3 rng - x4 rng - x5 rng - x6 rng - x7 rng - x8 rng - x9 rng - x10 rng - x11 rng - x12 rng] - (- (+ x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12) 6.))) - -; Let's test it: -(mean (take 1000 (value-seq gaussian1 1))) -(variance (take 1000 (value-seq gaussian1 1))) - -; Of course, we'd rather have a loop construct for creating the 12 -; random numbers. This would be easy if we could define a summation -; operation on random-number generators, which would then be used in -; combination with reduce. The lift operation gives us exactly that. -; More precisely, we need (m-lift 2 +), because we want both arguments -; of + to be lifted to the state monad: -(def gaussian2 - (domonad state-m - [sum12 (reduce (m-lift 2 +) (replicate 12 rng))] - (- sum12 6.))) - -; Such a reduction is often quite useful, so there's m-reduce predefined -; to simplify it: -(def gaussian2 - (domonad state-m - [sum12 (m-reduce + (replicate 12 rng))] - (- sum12 6.))) - -; The statistics should be strictly the same as above, as long as -; we use the same seed: -(mean (take 1000 (value-seq gaussian2 1))) -(variance (take 1000 (value-seq gaussian2 1))) - -; We can also do the subtraction of 6 in a lifted function, and get rid -; of the monad comprehension altogether: -(with-monad state-m - (def gaussian3 - ((m-lift 1 #(- % 6.)) - (m-reduce + (replicate 12 rng))))) - -; Again, the statistics are the same: -(mean (take 1000 (value-seq gaussian3 1))) -(variance (take 1000 (value-seq gaussian3 1))) - -; For a random point in two dimensions, we'd like a random number generator -; that yields a list of two random numbers. The m-seq operation can easily -; provide it: -(with-monad state-m - (def rng2 (m-seq (list rng rng)))) - -; Let's test it: -(rng2 1) - -; fetch-state and get-state can be used to save the seed of the random -; number generator and go back to that saved seed later on: -(def identical-random-seqs - (domonad state-m - [seed (fetch-state) - x1 rng - x2 rng - _ (set-state seed) - y1 rng - y2 rng] - (list [x1 x2] [y1 y2]))) - -(identical-random-seqs 1) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Logging with the writer monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A basic logging example -(domonad (writer-m accu/empty-string) - [x (m-result 1) - _ (write "first step\n") - y (m-result 2) - _ (write "second step\n")] - (+ x y)) - -; For a more elaborate application, let's trace the recursive calls of -; a naive implementation of a Fibonacci function. The starting point is: -(defn fib [n] - (if (< n 2) - n - (let [n1 (dec n) - n2 (dec n1)] - (+ (fib n1) (fib n2))))) - -; First we rewrite it to make every computational step explicit -; in a let expression: -(defn fib [n] - (if (< n 2) - n - (let [n1 (dec n) - n2 (dec n1) - f1 (fib n1) - f2 (fib n2)] - (+ f1 f2)))) - -; Next, we replace the let by a domonad in a writer monad that uses a -; vector accumulator. We can then place calls to write in between the -; steps, and obtain as a result both the return value of the function -; and the accumulated trace values. -(with-monad (writer-m accu/empty-vector) - - (defn fib-trace [n] - (if (< n 2) - (m-result n) - (domonad - [n1 (m-result (dec n)) - n2 (m-result (dec n1)) - f1 (fib-trace n1) - _ (write [n1 f1]) - f2 (fib-trace n2) - _ (write [n2 f2]) - ] - (+ f1 f2)))) - -) - -(fib-trace 5) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Sequences with undefined value: the maybe-t monad transformer -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A monad transformer is a function that takes a monad argument and -; returns a monad as its result. The resulting monad adds some -; specific behaviour aspect to the input monad. - -; The simplest monad transformer is maybe-t. It adds the functionality -; of the maybe monad (handling failures or undefined values) to any other -; monad. We illustrate this by applying maybe-t to the sequence monad. -; The result is an enhanced sequence monad in which undefined values -; (represented by nil) are not subjected to any transformation, but -; lead immediately to a nil result in the output. - -; First we define the combined monad: -(def seq-maybe-m (maybe-t sequence-m)) - -; As a first illustration, we create a range of integers and replace -; all even values by nil, using a simple when expression. We use this -; sequence in a monad comprehension that yields (inc x). The result -; is a sequence in which inc has been applied to all non-nil values, -; whereas the nil values appear unmodified in the output: -(domonad seq-maybe-m - [x (for [n (range 10)] (when (odd? n) n))] - (inc x)) - -; Next we repeat the definition of the function pairs (see above), but -; using the seq-maybe monad: -(with-monad seq-maybe-m - (defn pairs-maybe [xs] - (m-seq (list xs xs)))) - -; Applying this to a sequence containing nils yields the pairs of all -; non-nil values interspersed with nils that result from any combination -; in which one or both of the values is nil: -(pairs-maybe (for [n (range 5)] (when (odd? n) n))) - -; It is important to realize that undefined values (nil) are not eliminated -; from the iterations. They are simply not passed on to any operations. -; The outcome of any function applied to arguments of which at least one -; is nil is supposed to be nil as well, and the function is never called. - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Continuation-passing style in the cont monad -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -; A simple computation performed in continuation-passing style. -; (m-result 1) returns a function that, when called with a single -; argument f, calls (f 1). The result of the domonad-computation is -; a function that behaves in the same way, passing 3 to its function -; argument. run-cont executes a continuation by calling it on identity. -(run-cont - (domonad cont-m - [x (m-result 1) - y (m-result 2)] - (+ x y))) - -; Let's capture a continuation using call-cc. We store it in a global -; variable so that we can do with it whatever we want. The computation -; is the same one as in the first example, but it has the side effect -; of storing the continuation at (m-result 2). -(def continuation nil) - -(run-cont - (domonad cont-m - [x (m-result 1) - y (call-cc (fn [c] (def continuation c) (c 2)))] - (+ x y))) - -; Now we can call the continuation with whatever argument we want. The -; supplied argument takes the place of 2 in the above computation: -(run-cont (continuation 5)) -(run-cont (continuation 42)) -(run-cont (continuation -1)) - -; Next, a function that illustrates how a captured continuation can be -; used as an "emergency exit" out of a computation: -(defn sqrt-as-str [x] - (call-cc - (fn [k] - (domonad cont-m - [_ (m-when (< x 0) (k (str "negative argument " x)))] - (str (. Math sqrt x)))))) - -(run-cont (sqrt-as-str 2)) -(run-cont (sqrt-as-str -2)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/examples/clojure/clojure/contrib/pprint/examples/hexdump.clj b/src/examples/clojure/clojure/contrib/pprint/examples/hexdump.clj deleted file mode 100644 index fa5316ec..00000000 --- a/src/examples/clojure/clojure/contrib/pprint/examples/hexdump.clj +++ /dev/null @@ -1,63 +0,0 @@ -;;; hexdump.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; This example is a classic hexdump program written using cl-format. - -;; For some local color, it was written in Dulles Airport while waiting for a flight -;; home to San Francisco. - -(ns clojure.contrib.pprint.examples.hexdump - (:use clojure.contrib.pprint - clojure.contrib.pprint.utilities) - (:gen-class (:main true))) - -(def *buffer-length* 1024) - -(defn zip-array [base-offset arr] - (let [grouped (partition 16 arr)] - (first (map-passing-context - (fn [line offset] - [[offset - (map #(if (neg? %) (+ % 256) %) line) - (- 16 (count line)) - (map #(if (<= 32 % 126) (char %) \.) line)] - (+ 16 offset)]) - base-offset grouped)))) - - -(defn hexdump - ([in-stream] (hexdump in-stream true 0)) - ([in-stream out-stream] (hexdump [in-stream out-stream 0])) - ([in-stream out-stream offset] - (let [buf (make-array Byte/TYPE *buffer-length*)] - (loop [offset offset - count (.read in-stream buf)] - (if (neg? count) - nil - (let [bytes (take count buf) - zipped (zip-array offset bytes)] - (cl-format out-stream - "~:{~8,'0X: ~2{~8@{~#[ ~:;~2,'0X ~]~} ~}~v@{ ~}~2{~8@{~A~} ~}~%~}" - zipped) - (recur (+ offset *buffer-length*) (.read in-stream buf)))))))) - -(defn hexdump-file - ([file-name] (hexdump-file file-name true)) - ([file-name stream] - (with-open [s (java.io.FileInputStream. file-name)] - (hexdump s)))) - -;; I don't quite understand how to invoke main funcs w/o AOT yet -(defn -main [& args] - (hexdump-file (first args))) - diff --git a/src/examples/clojure/clojure/contrib/pprint/examples/json.clj b/src/examples/clojure/clojure/contrib/pprint/examples/json.clj deleted file mode 100644 index afe1a2c2..00000000 --- a/src/examples/clojure/clojure/contrib/pprint/examples/json.clj +++ /dev/null @@ -1,142 +0,0 @@ -;;; json.clj: A pretty printing version of the JavaScript Object Notation (JSON) generator - -;; by Tom Faulhaber, based on the version by Stuart Sierra (clojure.contrib.json.write) -;; May 9, 2009 - -;; Copyright (c) Tom Faulhaber/Stuart Sierra, 2009. 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 "Tom Faulhaber (based on the version by Stuart Sierra)", - :doc "Pretty printing JavaScript Object Notation (JSON) generator. - -This is an example of using a pretty printer dispatch function to generate JSON output", - :see-also [["http://json.org/", "JSON Home Page"]]} - clojure.contrib.pprint.examples.json - (:use [clojure.test :only (deftest- is)] - [clojure.contrib.string :only (as-str)] - [clojure.contrib.pprint :only (write formatter-out)])) - - - -(defmulti dispatch-json - "The dispatch function for printing objects as JSON" - {:arglists '[[x]]} - (fn [x] (cond - (nil? x) nil ;; prevent NullPointerException on next line - (.isArray (class x)) ::array - :else (type x)))) - -;; Primitive types can be printed with Clojure's pr function. -(derive java.lang.Boolean ::pr) -(derive java.lang.Byte ::pr) -(derive java.lang.Short ::pr) -(derive java.lang.Integer ::pr) -(derive java.lang.Long ::pr) -(derive java.lang.Float ::pr) -(derive java.lang.Double ::pr) - -;; Collection types can be printed as JSON objects or arrays. -(derive java.util.Map ::object) -(derive java.util.Collection ::array) - -;; Symbols and keywords are converted to strings. -(derive clojure.lang.Symbol ::symbol) -(derive clojure.lang.Keyword ::symbol) - - -(defmethod dispatch-json ::pr [x] (pr x)) - -(defmethod dispatch-json nil [x] (print "null")) - -(defmethod dispatch-json ::symbol [x] (pr (name x))) - -(defmethod dispatch-json ::array [s] - ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) - -(defmethod dispatch-json ::object [m] - ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") - (for [[k v] m] [(as-str k) v]))) - -(defmethod dispatch-json java.lang.CharSequence [s] - (print \") - (dotimes [i (count s)] - (let [cp (Character/codePointAt s i)] - (cond - ;; Handle printable JSON escapes before ASCII - (= cp 34) (print "\\\"") - (= cp 92) (print "\\\\") - ;; Print simple ASCII characters - (< 31 cp 127) (print (.charAt s i)) - ;; Handle non-printable JSON escapes - (= cp 8) (print "\\b") - (= cp 12) (print "\\f") - (= cp 10) (print "\\n") - (= cp 13) (print "\\r") - (= cp 9) (print "\\t") - ;; Any other character is printed as Hexadecimal escape - :else (printf "\\u%04x" cp)))) - (print \")) - -(defn print-json - "Prints x as JSON. Nil becomes JSON null. Keywords become - strings, without the leading colon. Maps become JSON objects, all - other collection types become JSON arrays. Java arrays become JSON - arrays. Unicode characters in strings are escaped as \\uXXXX. - Numbers print as with pr." - [x] - (write x :dispatch dispatch-json)) - -(defn json-str - "Converts x to a JSON-formatted string." - [x] - (with-out-str (print-json x))) - - - -;;; TESTS - -;; Run these tests with -;; (clojure.test/run-tests 'clojure.contrib.print-json) - -;; Bind clojure.test/*load-tests* to false to omit these -;; tests from production code. - -(deftest- can-print-json-strings - (is (= "\"Hello, World!\"" (json-str "Hello, World!"))) - (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes")))) - -(deftest- can-print-unicode - (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567")))) - -(deftest- can-print-json-null - (is (= "null" (json-str nil)))) - -(deftest- can-print-json-arrays - (is (= "[1, 2, 3]" (json-str [1 2 3]))) - (is (= "[1, 2, 3]" (json-str (list 1 2 3)))) - (is (= "[1, 2, 3]" (json-str (sorted-set 1 2 3)))) - (is (= "[1, 2, 3]" (json-str (seq [1 2 3]))))) - -(deftest- can-print-java-arrays - (is (= "[1, 2, 3]" (json-str (into-array [1 2 3]))))) - -(deftest- can-print-empty-arrays - (is (= "[]" (json-str []))) - (is (= "[]" (json-str (list)))) - (is (= "[]" (json-str #{})))) - -(deftest- can-print-json-objects - (is (= "{\"a\":1, \"b\":2}" (json-str (sorted-map :a 1 :b 2))))) - -(deftest- object-keys-must-be-strings - (is (= "{\"1\":1, \"2\":2}" (json-str (sorted-map 1 1 2 2))))) - -(deftest- can-print-empty-objects - (is (= "{}" (json-str {})))) diff --git a/src/examples/clojure/clojure/contrib/pprint/examples/multiply.clj b/src/examples/clojure/clojure/contrib/pprint/examples/multiply.clj deleted file mode 100644 index c7e33035..00000000 --- a/src/examples/clojure/clojure/contrib/pprint/examples/multiply.clj +++ /dev/null @@ -1,23 +0,0 @@ -;;; multiply.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; This example prints a multiplication table using cl-format. - -(ns clojure.contrib.pprint.examples.multiply - (:use clojure.contrib.pprint)) - -(defn multiplication-table [limit] - (let [nums (range 1 (inc limit))] - (cl-format true "~{~{~4d~}~%~}" - (map #(map % nums) - (map #(partial * %) nums))))) diff --git a/src/examples/clojure/clojure/contrib/pprint/examples/props.clj b/src/examples/clojure/clojure/contrib/pprint/examples/props.clj deleted file mode 100644 index 4edb9149..00000000 --- a/src/examples/clojure/clojure/contrib/pprint/examples/props.clj +++ /dev/null @@ -1,25 +0,0 @@ -;;; props.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; This example displays a nicely formatted table of the java properties using -;; cl-format - -(ns clojure.contrib.pprint.examples.props - (:use clojure.contrib.pprint)) - -(defn show-props [stream] - (let [p (mapcat - #(vector (key %) (val %)) - (sort-by key (System/getProperties)))] - (cl-format true "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}" - "Property" "Value" ["" "" "" ""] p))) diff --git a/src/examples/clojure/clojure/contrib/pprint/examples/show_doc.clj b/src/examples/clojure/clojure/contrib/pprint/examples/show_doc.clj deleted file mode 100644 index 6bf61585..00000000 --- a/src/examples/clojure/clojure/contrib/pprint/examples/show_doc.clj +++ /dev/null @@ -1,50 +0,0 @@ -;;; show_doc.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; This example uses cl-format as part of a routine to display all the doc -;; strings and function arguments from one or more namespaces. - -(ns clojure.contrib.pprint.examples.show-doc - (:use clojure.contrib.pprint)) - -(defn ns-list - ([] (ns-list nil)) - ([pattern] - (filter - (if pattern - (comp (partial re-find pattern) name ns-name) - (constantly true)) - (sort-by ns-name (all-ns))))) - -(defn show-doc - ([] (show-doc nil)) - ([pattern] - (cl-format - true - "~:{~A: ===============================================~ - ~%~{~{~a: ~{~a~^, ~}~%~a~%~}~^~%~}~2%~}" - (map - #(vector (ns-name %) - (map - (fn [f] - (let [f-meta (meta (find-var (symbol (str (ns-name %)) (str f))))] - [f (:arglists f-meta) (:doc f-meta)])) - (filter - (fn [a] (instance? clojure.lang.IFn a)) - (sort (map key (ns-publics %)))))) - (ns-list pattern))))) - -(defn create-api-file [pattern out-file] - (with-open [f (java.io.FileWriter. out-file)] - (binding [*out* f] - (show-doc pattern)))) diff --git a/src/examples/clojure/clojure/contrib/pprint/examples/xml.clj b/src/examples/clojure/clojure/contrib/pprint/examples/xml.clj deleted file mode 100644 index 18c3cfec..00000000 --- a/src/examples/clojure/clojure/contrib/pprint/examples/xml.clj +++ /dev/null @@ -1,121 +0,0 @@ -;;; xml.clj -- a pretty print dispatch version of prxml.clj -- a compact syntax for generating XML - -;; by Tom Faulhaber, based on the original by Stuart Sierra, http://stuartsierra.com/ -;; May 13, 2009 - -;; Copyright (c) 2009 Tom Faulhaber/Stuart Sierra. 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. - - -;; See function "prxml" at the bottom of this file for documentation. - - -(ns - #^{:author "Tom Faulhaber, based on the original by Stuart Sierra", - :doc "A version of prxml that uses a pretty print dispatch function."} - clojure.contrib.pprint.examples.xml - (:use [clojure.contrib.string :only (as-str escape)] - [clojure.contrib.pprint :only (formatter-out write)] - [clojure.contrib.pprint.utilities :only (prlabel)])) - -(def - #^{:doc "If true, empty tags will have a space before the closing />"} - *html-compatible* false) - -(def - #^{:doc "The number of spaces to indent sub-tags."} - *prxml-indent* 2) - -(defmulti #^{:private true} print-xml-tag (fn [tag attrs content] tag)) - -(defmethod print-xml-tag :raw! [tag attrs contents] - (doseq [c contents] (print c))) - -(defmethod print-xml-tag :comment! [tag attrs contents] - (print "<!-- ") - (doseq [c contents] (print c)) - (print " -->")) - -(defmethod print-xml-tag :decl! [tag attrs contents] - (let [attrs (merge {:version "1.0" :encoding "UTF-8"} - attrs)] - ;; Must enforce ordering of pseudo-attributes: - ((formatter-out "<?xml version=\"~a\" encoding=\"~a\"~@[ standalone=\"~a\"~]?>") - (:version attrs) (:encoding attrs) (:standalone attrs)))) - -(defmethod print-xml-tag :cdata! [tag attrs contents] - ((formatter-out "<[!CDATA[~{~a~}]]>") contents)) - -(defmethod print-xml-tag :doctype! [tag attrs contents] - ((formatter-out "<[!DOCTYPE [~{~a~}]]>") contents)) - -(defmethod print-xml-tag :default [tag attrs contents] - (let [tag-name (as-str tag) - xlated-attrs (map #(vector (as-str (key %)) (as-str (val %))) attrs)] - (if (seq contents) - ((formatter-out "~<~<<~a~1:i~{ ~:_~{~a=\"~a\"~}~}>~:>~vi~{~_~w~}~0i~_</~a>~:>") - [[tag-name xlated-attrs] *prxml-indent* contents tag-name]) - ((formatter-out "~<<~a~1:i~{~:_ ~{~a=\"~a\"~}~}/>~:>") [tag-name xlated-attrs])))) - - -(defmulti xml-dispatch class) - -(defmethod xml-dispatch clojure.lang.IPersistentVector [x] - (let [[tag & contents] x - [attrs content] (if (map? (first contents)) - [(first contents) (rest contents)] - [{} contents])] - (print-xml-tag tag attrs content))) - -(defmethod xml-dispatch clojure.lang.ISeq [x] - ;; Recurse into sequences, so we can use (map ...) inside prxml. - (doseq [c x] (xml-dispatch c))) - -(defmethod xml-dispatch clojure.lang.Keyword [x] - (print-xml-tag x {} nil)) - - -(defmethod xml-dispatch String [x] - (print (escape {\< "<" - \> ">" - \& "&" - \' "'" - \" """} x))) - -(defmethod xml-dispatch nil [x]) - -(defmethod xml-dispatch :default [x] - (print x)) - - -(defn prxml - "Print XML to *out*. Vectors become XML tags: the first item is the - tag name; optional second item is a map of attributes. - - Sequences are processed recursively, so you can use map and other - sequence functions inside prxml. - - (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]]) - ; => <p class=\"greet\"><i>Ladies & gentlemen</i></p> - - PSEUDO-TAGS: some keywords have special meaning: - - :raw! do not XML-escape contents - :comment! create an XML comment - :decl! create an XML declaration, with attributes - :cdata! create a CDATA section - :doctype! create a DOCTYPE! - - (prxml [:p [:raw! \"<i>here & gone</i>\"]]) - ; => <p><i>here & gone</i></p> - - (prxml [:decl! {:version \"1.1\"}]) - ; => <?xml version=\"1.1\" encoding=\"UTF-8\"?>" - [& args] - (doseq [arg args] (write arg :dispatch xml-dispatch)) - (when (pos? (count args)) (newline))) diff --git a/src/examples/clojure/clojure/contrib/probabilities/examples_finite_distributions.clj b/src/examples/clojure/clojure/contrib/probabilities/examples_finite_distributions.clj deleted file mode 100644 index 56f25bad..00000000 --- a/src/examples/clojure/clojure/contrib/probabilities/examples_finite_distributions.clj +++ /dev/null @@ -1,209 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Probability distribution application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for finite probability distribution"} - clojure.contrib.probabilities.examples-finite-distributions - (:use [clojure.contrib.probabilities.finite-distributions - :only (uniform prob cond-prob join-with dist-m choose - normalize certainly cond-dist-m normalize-cond)]) - (:use [clojure.contrib.monads - :only (domonad with-monad m-seq m-chain m-lift)]) - (:require clojure.contrib.accumulators)) - -;; Simple examples using dice - -; A single die is represented by a uniform distribution over the -; six possible outcomes. -(def die (uniform #{1 2 3 4 5 6})) - -; The probability that the result is odd... -(prob odd? die) -; ... or greater than four. -(prob #(> % 4) die) - -; The sum of two dice -(def two-dice (join-with + die die)) -(prob #(> % 6) two-dice) - -; The sum of two dice using a monad comprehension -(assert (= two-dice - (domonad dist-m - [d1 die - d2 die] - (+ d1 d2)))) - -; The two values separately, but as an ordered pair -(domonad dist-m - [d1 die - d2 die] - (if (< d1 d2) (list d1 d2) (list d2 d1))) - -; The conditional probability for two dice yielding X if X is odd: -(cond-prob odd? two-dice) - -; A two-step experiment: throw a die, and then add 1 with probability 1/2 -(domonad dist-m - [d die - x (choose (/ 1 2) d - :else (inc d))] - x) - -; The sum of n dice -(defn dice [n] - (domonad dist-m - [ds (m-seq (replicate n die))] - (apply + ds))) - -(assert (= two-dice (dice 2))) - -(dice 3) - - -;; Construct an empirical distribution from counters - -; Using an ordinary counter: -(def dist1 - (normalize - (clojure.contrib.accumulators/add-items - clojure.contrib.accumulators/empty-counter - (for [_ (range 1000)] (rand-int 5))))) - -; Or, more efficiently, using a counter that already keeps track of its total: -(def dist2 - (normalize - (clojure.contrib.accumulators/add-items - clojure.contrib.accumulators/empty-counter-with-total - (for [_ (range 1000)] (rand-int 5))))) - - -;; The Monty Hall game -;; (see http://en.wikipedia.org/wiki/Monty_Hall_problem for a description) - -; The set of doors. In the classical variant, there are three doors, -; but the code can also work with more than three doors. -(def doors #{:A :B :C}) - -; A simulation of the game, step by step: -(domonad dist-m - [; The prize is hidden behind one of the doors. - prize (uniform doors) - ; The player make his initial choice. - choice (uniform doors) - ; The host opens a door which is neither the prize door nor the - ; one chosen by the player. - opened (uniform (disj doors prize choice)) - ; If the player stays with his initial choice, the game ends and the - ; following line should be commented out. It describes the switch from - ; the initial choice to a door that is neither the opened one nor - ; his original choice. - choice (uniform (disj doors opened choice)) - ] - ; If the chosen door has the prize behind it, the player wins. - (if (= choice prize) :win :loose)) - - -;; Tree growth simulation -;; Adapted from the code in: -;; Martin Erwig and Steve Kollmansberger, -;; "Probabilistic Functional Programming in Haskell", -;; Journal of Functional Programming, Vol. 16, No. 1, 21-34, 2006 -;; http://web.engr.oregonstate.edu/~erwig/papers/abstracts.html#JFP06a - -; A tree is represented by two attributes: its state (alive, hit, fallen), -; and its height (an integer). A new tree starts out alive and with zero height. -(def new-tree {:state :alive, :height 0}) - -; An evolution step in the simulation modifies alive trees only. They can -; either grow by one (90% probability), be hit by lightning and then stop -; growing (4% probability), or fall down (6% probability). -(defn evolve-1 [tree] - (let [{s :state h :height} tree] - (if (= s :alive) - (choose 0.9 (assoc tree :height (inc (:height tree))) - 0.04 (assoc tree :state :hit) - :else {:state :fallen, :height 0}) - (certainly tree)))) - -; Multiple evolution steps can be chained together with m-chain, -; since each step's input is the output of the previous step. -(with-monad dist-m - (defn evolve [n tree] - ((m-chain (replicate n evolve-1)) tree))) - -; Try it for zero, one, or two steps. -(evolve 0 new-tree) -(evolve 1 new-tree) -(evolve 2 new-tree) - -; We can also get a distribution of the height only: -(with-monad dist-m - ((m-lift 1 :height) (evolve 2 new-tree))) - - - -;; Bayesian inference -;; -;; Suppose someone has three dice, one with six faces, one with eight, and -;; one with twelve. This person throws one die and gives us the number, -;; but doesn't tell us which die it was. What are the Bayesian probabilities -;; for each of the three dice, given the observation we have? - -; A function that returns the distribution of a dice with n faces. -(defn die-n [n] (uniform (range 1 (inc n)))) - -; The three dice in the game with their distributions. With this map, we -; can easily calculate the probability for an observation under the -; condition that a particular die was used. -(def dice {:six (die-n 6) - :eight (die-n 8) - :twelve (die-n 12)}) - -; The only prior knowledge is that one of the three dice is used, so we -; have no better than a uniform distribution to start with. -(def prior (uniform (keys dice))) - -; Add a single observation to the information contained in the -; distribution. Adding an observation consists of -; 1) Draw a die from the prior distribution. -; 2) Draw an observation from the distribution of that die. -; 3) Eliminate (replace by nil) the trials that do not match the observation. -; 4) Normalize the distribution for the non-nil values. -(defn add-observation [prior observation] - (normalize-cond - (domonad cond-dist-m - [die prior - number (get dice die) - :when (= number observation) ] - die))) - -; Add one observation. -(add-observation prior 1) - -; Add three consecutive observations. -(-> prior (add-observation 1) - (add-observation 3) - (add-observation 7)) - -; We can also add multiple observations in a single trial, but this -; is slower because more combinations have to be taken into account. -; With Bayesian inference, it is most efficient to eliminate choices -; as early as possible. -(defn add-observations [prior observations] - (with-monad cond-dist-m - (let [n-nums #(m-seq (replicate (count observations) (get dice %)))] - (normalize-cond - (domonad - [die prior - nums (n-nums die) - :when (= nums observations)] - die))))) - -(add-observations prior [1 3 7]) diff --git a/src/examples/clojure/clojure/contrib/probabilities/examples_monte_carlo.clj b/src/examples/clojure/clojure/contrib/probabilities/examples_monte_carlo.clj deleted file mode 100644 index 44c6a7e2..00000000 --- a/src/examples/clojure/clojure/contrib/probabilities/examples_monte_carlo.clj +++ /dev/null @@ -1,73 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Monte-Carlo application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for monte carlo methods"} - clojure.contrib.probabilities.random.examples-monte-carlo - (:require [clojure.contrib.generic.collection :as gc]) - (:use [clojure.contrib.probabilities.random-numbers - :only (lcg rand-stream)]) - (:use [clojure.contrib.probabilities.finite-distributions - :only (uniform)]) - (:use [clojure.contrib.probabilities.monte-carlo - :only (random-stream discrete interval normal lognormal exponential - n-sphere - sample sample-sum sample-mean sample-mean-variance)] - :reload) - (:use [clojure.contrib.monads - :only (domonad state-m)])) - -; Create a linear congruential generator -(def urng (lcg 259200 7141 54773 1)) - -;; Use Clojure's built-in random number generator -;(def urng rand-stream) - -; Sample transformed distributions -(defn sample-distribution - [n rt] - (take n (gc/seq (random-stream rt urng)))) - -; Interval [-2, 2) -(sample-distribution 10 (interval -2 2)) -; Compare with a direct transformation -(= (sample-distribution 10 (interval -2 2)) - (map (fn [x] (- (* 4 x) 2)) (take 10 (gc/seq urng)))) - -; Normal distribution -(sample-distribution 10 (normal 0 1)) - -; Log-Normal distribution -(sample-distribution 10 (lognormal 0 1)) - -; Exponential distribution -(sample-distribution 10 (exponential 1)) - -; n-sphere distribution -(sample-distribution 10 (n-sphere 2 1)) - -; Discrete distribution -(sample-distribution 10 (discrete (uniform (range 1 7)))) - -; Compose distributions in the state monad -(def sum-two-dists - (domonad state-m - [r1 (interval -2 2) - r2 (normal 0 1)] - (+ r1 r2))) - -(sample-distribution 10 sum-two-dists) - -; Distribution transformations -(sample-distribution 5 (sample 2 (interval -2 2))) -(sample-distribution 10 (sample-sum 10 (interval -2 2))) -(sample-distribution 10 (sample-mean 10 (interval -2 2))) -(sample-distribution 10 (sample-mean-variance 10 (interval -2 2))) - diff --git a/src/examples/clojure/clojure/contrib/stream_utils/examples.clj b/src/examples/clojure/clojure/contrib/stream_utils/examples.clj deleted file mode 100644 index 524423bb..00000000 --- a/src/examples/clojure/clojure/contrib/stream_utils/examples.clj +++ /dev/null @@ -1,117 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Stream application examples -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for data streams"} - clojure.contrib.stream-utils.examples - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.stream-utils - :only (defst stream-next - pick pick-all - stream-type defstream - stream-drop stream-map stream-filter stream-flatten)]) - (:use [clojure.contrib.monads :only (domonad)]) - (:use [clojure.contrib.types :only (deftype)]) - (:require [clojure.contrib.generic.collection :as gc])) - -; -; Define a stream of Fibonacci numbers -; -(deftype ::fib-stream last-two-fib) - -(defstream ::fib-stream - [fs] - (let [[n1 n2] fs] - [n1 (last-two-fib [n2 (+ n1 n2)])])) - -(def fib-stream (last-two-fib [0 1])) - -(take 10 (gc/seq fib-stream)) - -; -; A simple random number generator, implemented as a stream -; -(deftype ::random-seed rng-seed vector seq) - -(defstream ::random-seed - [seed] - (let [[seed] seed - m 259200 - value (/ (float seed) (float m)) - next (rem (+ 54773 (* 7141 seed)) m)] - [value (rng-seed next)])) - -(take 10 (gc/seq (rng-seed 1))) - -; -; Various stream utilities -; -(take 10 (gc/seq (stream-drop 10 (rng-seed 1)))) -(gc/seq (stream-map inc (range 5))) -(gc/seq (stream-filter odd? (range 10))) -(gc/seq (stream-flatten (partition 3 (range 9)))) - -; -; Stream transformers -; - -; Transform a stream of numbers into a stream of sums of two -; consecutive numbers. -(defst sum-two [] [xs] - (domonad - [x1 (pick xs) - x2 (pick xs)] - (+ x1 x2))) - -(def s (sum-two '(1 2 3 4 5 6 7 8))) - -(let [[v1 s] (stream-next s)] - (let [[v2 s] (stream-next s)] - (let [[v3 s] (stream-next s)] - (let [[v4 s] (stream-next s)] - (let [[v5 s] (stream-next s)] - [v1 v2 v3 v4 v5]))))) - -(gc/seq s) - -; Map (for a single stream) written as a stream transformer -(defst my-map-1 [f] [xs] - (domonad - [x (pick xs)] - (f x))) - -(gc/seq (my-map-1 inc [1 2 3])) - -; Map for two stream arguments -(defst my-map-2 [f] [xs ys] - (domonad - [x (pick xs) - y (pick ys)] - (f x y))) - -(gc/seq (my-map-2 + '(1 2 3 4) '(10 20 30 40))) - -; Map for any number of stream arguments -(defst my-map [f] [& streams] - (domonad - [vs pick-all] - (apply f vs))) - -(gc/seq (my-map inc [1 2 3])) -(gc/seq (my-map + '(1 2 3 4) '(10 20 30 40))) - -; Filter written as a stream transformer -(defst my-filter [p] [xs] - (domonad - [x (pick xs) :when (p x)] - x)) - -(gc/seq (my-filter odd? [1 2 3])) - diff --git a/src/examples/clojure/clojure/contrib/types/examples.clj b/src/examples/clojure/clojure/contrib/types/examples.clj deleted file mode 100644 index 486f8ce6..00000000 --- a/src/examples/clojure/clojure/contrib/types/examples.clj +++ /dev/null @@ -1,152 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Application examples for data types -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(ns - #^{:author "Konrad Hinsen" - :skip-wiki true - :doc "Examples for data type definitions"} - clojure.contrib.types.examples - (:refer-clojure :exclude (deftype)) - (:use [clojure.contrib.types - :only (deftype defadt match)]) - (:require [clojure.contrib.generic.collection :as gc]) - (:require [clojure.contrib.generic.functor :as gf])) - -; -; Multisets implemented as maps to integers -; - -; The most basic type definition. A more elaborate version could add -; a constructor that verifies that its argument is a map with integer values. -(deftype ::multiset multiset - "Multiset (demo implementation)") - -; Some set operations generalized to multisets -; Note that the multiset constructor is nowhere called explicitly, as the -; map operations all preserve the metadata. -(defmethod gc/conj ::multiset - ([ms x] - (assoc ms x (inc (get ms x 0)))) - ([ms x & xs] - (reduce gc/conj (gc/conj ms x) xs))) - -(defmulti union (fn [& sets] (type (first sets)))) - -(defmethod union clojure.lang.IPersistentSet - [& sets] - (apply clojure.set/union sets)) - -; Note: a production-quality implementation should accept standard sets -; and perhaps other collections for its second argument. -(defmethod union ::multiset - ([ms] ms) - ([ms1 ms2] - (letfn [(add-item [ms [item n]] - (assoc ms item (+ n (get ms item 0))))] - (reduce add-item ms1 ms2))) - ([ms1 ms2 & mss] - (reduce union (union ms1 ms2) mss))) - -; Let's use it: -(gc/conj #{} :a :a :b :c) -(gc/conj (multiset {}) :a :a :b :c) - -(union #{:a :b} #{:b :c}) -(union (multiset {:a 1 :b 1}) (multiset {:b 1 :c 2})) - -; -; A simple tree structure defined as an algebraic data type -; -(defadt ::tree - empty-tree - (leaf value) - (node left-tree right-tree)) - -(def a-tree (node (leaf :a) - (node (leaf :b) - (leaf :c)))) - -(defn depth - [t] - (match t - empty-tree 0 - (leaf _) 1 - (node l r) (inc (max (depth l) (depth r))))) - -(depth empty-tree) -(depth (leaf 42)) -(depth a-tree) - -; Algebraic data types with multimethods: fmap on a tree -(defmethod gf/fmap ::tree - [f t] - (match t - empty-tree empty-tree - (leaf v) (leaf (f v)) - (node l r) (node (gf/fmap f l) (gf/fmap f r)))) - -(gf/fmap str a-tree) - -; -; Nonsense examples to illustrate all the features of match -; for type constructors. -; -(defadt ::foo - (bar a b c)) - -(defn foo-to-int - [a-foo] - (match a-foo - (bar x x x) x - (bar 0 x y) (+ x y) - (bar 1 2 3) -1 - (bar a b 1) (* a b) - :else 42)) - -(foo-to-int (bar 0 0 0)) ; 0 -(foo-to-int (bar 0 5 6)) ; 11 -(foo-to-int (bar 1 2 3)) ; -1 -(foo-to-int (bar 3 3 1)) ; 9 -(foo-to-int (bar 0 3 1)) ; 4 -(foo-to-int (bar 10 20 30)) ; 42 - -; -; Match can also be used for lists, vectors, and maps. Note that since -; algebraic data types are represented as maps, they can be matched -; either with their type constructor and positional arguments, or -; with a map template. -; - -; Tree depth once again with map templates -(defn depth - [t] - (match t - empty-tree 0 - {:value _} 1 - {:left-tree l :right-tree r} (inc (max (depth l) (depth r))))) - -(depth empty-tree) -(depth (leaf 42)) -(depth a-tree) - -; Match for lists, vectors, and maps: - -(for [x ['(1 2 3) - [1 2 3] - {:x 1 :y 2 :z 3} - '(1 1 1) - [2 1 2] - {:x 1 :y 1 :z 2}]] - (match x - '(a a a) 'list-of-three-equal-values - '(a b c) 'list - [a a a] 'vector-of-three-equal-values - [a b a] 'vector-of-three-with-first-and-last-equal - [a b c] 'vector - {:x a :y z} 'map-with-x-equal-y - {} 'any-map)) diff --git a/src/main/assembly/dist.xml b/src/main/assembly/dist.xml deleted file mode 100644 index 54fdec91..00000000 --- a/src/main/assembly/dist.xml +++ /dev/null @@ -1,28 +0,0 @@ -<assembly xmlns="http://maven.apache.org/plugins/maven-assembly-plugin/assembly/1.1.0" - xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" - xsi:schemaLocation="http://maven.apache.org/plugins/maven-assembly-plugin/assembly/1.1.0 http://maven.apache.org/xsd/assembly-1.1.0.xsd"> - <id>dist</id> - <formats> - <format>zip</format> - <format>tar.gz</format> - <format>tar.bz2</format> - </formats> - <fileSets> - <fileSet> - <directory>${project.basedir}</directory> - <outputDirectory>/</outputDirectory> - <useDefaultExcludes>true</useDefaultExcludes> - <includes> - <include>README.*</include> - <include>epl-v10.*</include> - <include>NOTICE.*</include> - <include>Revisions</include> - <include>pom.xml</include> - <include>src/**</include> - <include>target/*.jar</include> - <include>launchers/**</include> - <include>clojurescript/**</include> - </includes> - </fileSet> - </fileSets> -</assembly>
\ No newline at end of file diff --git a/src/main/clojure/clojure/contrib/jmx/client.clj b/src/main/clojure/clojure/contrib/jmx/client.clj deleted file mode 100644 index e8616296..00000000 --- a/src/main/clojure/clojure/contrib/jmx/client.clj +++ /dev/null @@ -1,87 +0,0 @@ -;; JMX client APIs for Clojure -;; docs in clojure/contrib/jmx.clj!! - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. 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.contrib.jmx) - -(defmacro with-connection - "Execute body with JMX connection specified by opts. opts can also - include an optional :environment key which is passed as the - environment arg to JMXConnectorFactory/connect." - [opts & body] - `(let [opts# ~opts - env# (get opts# :environment {}) - opts# (dissoc opts# :environment)] - (with-open [connector# (javax.management.remote.JMXConnectorFactory/connect - (JMXServiceURL. (jmx-url opts#)) env#)] - (binding [*connection* (.getMBeanServerConnection connector#)] - ~@body)))) - -(defn mbean-info [n] - (.getMBeanInfo *connection* (as-object-name n))) - -(defn raw-read - "Read an mbean property. Returns low-level Java object model for - composites, tabulars, etc. Most callers should use read." - [n attr] - (.getAttribute *connection* (as-object-name n) (as-str attr))) - -(defvar read - (comp jmx->clj raw-read) - "Read an mbean property.") - -(defn read-supported - "Calls read to read an mbean property, *returning* unsupported - operation exceptions instead of throwing them. Used to keep mbean - from blowing up. Note: There is no good exception that aggregates - unsupported operations, hence the overly-general catch block." - [n attr] - (try - (read n attr) - (catch Exception e - e))) - -(defn write! [n attr value] - (.setAttribute - *connection* - (as-object-name n) - (Attribute. (as-str attr) value))) - -(defn attribute-info - "Get the MBeanAttributeInfo for an attribute." - [object-name attr-name] - (filter #(= (as-str attr-name) (.getName %)) - (.getAttributes (mbean-info object-name)))) - -(defn readable? - "Is attribute readable?" - [n attr] - (.isReadable () (mbean-info n))) - -(defn operations - "All oeprations available on an MBean." - [n] - (.getOperations (mbean-info n))) - -(defn operation - "The MBeanOperationInfo for operation op on mbean n. Used by invoke." - [n op] - (first (filter #(= (-> % .getName keyword) op) (operations n)))) - -(defn op-param-types - "The parameter types (as class name strings) for operation op on n. - Used for invoke." - [n op] - (map #(-> % .getType) (.getSignature (operation n op)))) - - diff --git a/src/main/clojure/clojure/contrib/jmx/data.clj b/src/main/clojure/clojure/contrib/jmx/data.clj deleted file mode 100644 index 8a914270..00000000 --- a/src/main/clojure/clojure/contrib/jmx/data.clj +++ /dev/null @@ -1,104 +0,0 @@ -;; Conversions between JMX data structures and idiomatic Clojure -;; docs in clojure/contrib/jmx.clj!! - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. 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.contrib.jmx) - -(declare jmx->clj) - -(defn jmx-url - "Build a JMX URL from options." - ([] (jmx-url {})) - ([overrides] - (let [opts (merge {:host "localhost", :port "3000", :jndi-path "jmxrmi"} overrides)] - (format "service:jmx:rmi:///jndi/rmi://%s:%s/%s" (opts :host) (opts :port) (opts :jndi-path))))) - -(defmulti as-object-name - "Interpret an object as a JMX ObjectName." - { :arglists '([string-or-name]) } - class) -(defmethod as-object-name String [n] (ObjectName. n)) -(defmethod as-object-name ObjectName [n] n) - -(defn composite-data->map [cd] - (into {} - (map (fn [attr] [(keyword attr) (jmx->clj (.get cd attr))]) - (.. cd getCompositeType keySet)))) - -(defn maybe-keywordize - "Convert a string key to a keyword, leaving other types alone. Used to - simplify keys in the tabular data API." - [s] - (if (string? s) (keyword s) s)) - -(defn maybe-atomize - "Convert a list of length 1 into its contents, leaving other things alone. - Used to simplify keys in the tabular data API." - [k] - (if (and (instance? java.util.List k) - (= 1 (count k))) - (first k) - k)) - -(defvar simplify-tabular-data-key - (comp maybe-keywordize maybe-atomize)) - -(defn tabular-data->map [td] - (into {} - ; the need for into-array here was a surprise, and may not - ; work for all examples. Are keys always arrays? - (map (fn [k] - [(simplify-tabular-data-key k) (jmx->clj (.get td (into-array k)))]) - (.keySet td)))) - -(defmulti jmx->clj - "Coerce JMX data structures into Clojure data. - Handles CompositeData, TabularData, maps, and atoms." - { :argslists '([jmx-data-structure]) } - (fn [x] - (cond - (instance? javax.management.openmbean.CompositeData x) :composite - (instance? javax.management.openmbean.TabularData x) :tabular - (instance? clojure.lang.Associative x) :map - :default :default))) -(defmethod jmx->clj :composite [c] (composite-data->map c)) -(defmethod jmx->clj :tabular [t] (tabular-data->map t)) -(defmethod jmx->clj :map [m] (into {} (zipmap (keys m) (map jmx->clj (vals m))))) -(defmethod jmx->clj :default [obj] obj) - -(def guess-attribute-map - {"java.lang.Integer" "int" - "java.lang.Boolean" "boolean" - "java.lang.Long" "long" - }) - -(defn guess-attribute-typename - "Guess the attribute typename for MBeanAttributeInfo based on the attribute value." - [value] - (let [classname (.getName (class value))] - (get guess-attribute-map classname classname))) - -(defn build-attribute-info - "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map." - ([attr-name attr-value] - (build-attribute-info - (as-str attr-name) - (guess-attribute-typename attr-value) - (as-str attr-name) true false false)) - ([name type desc readable? writable? is?] (MBeanAttributeInfo. name type desc readable? writable? is? ))) - -(defn map->attribute-infos - "Construct an MBeanAttributeInfo[] from a Clojure associative." - [attr-map] - (into-array (map (fn [[attr-name value]] (build-attribute-info attr-name value)) - attr-map))) diff --git a/src/main/clojure/clojure/contrib/jmx/server.clj b/src/main/clojure/clojure/contrib/jmx/server.clj deleted file mode 100644 index c92fcf81..00000000 --- a/src/main/clojure/clojure/contrib/jmx/server.clj +++ /dev/null @@ -1,18 +0,0 @@ -;; JMX server APIs for Clojure -;; docs in clojure/contrib/jmx.clj!! - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. 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.contrib.jmx) - -(defn register-mbean [mbean mbean-name] - (.registerMBean *connection* mbean (as-object-name mbean-name))) - diff --git a/src/main/clojure/clojure/contrib/lazy_xml/with_pull.clj b/src/main/clojure/clojure/contrib/lazy_xml/with_pull.clj deleted file mode 100644 index 761456e1..00000000 --- a/src/main/clojure/clojure/contrib/lazy_xml/with_pull.clj +++ /dev/null @@ -1,58 +0,0 @@ -; Copyright (c) Chris Houser, Dec 2008. 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. - -; optional module to allow lazy-xml to use pull parser instead of sax - -(in-ns 'clojure.contrib.lazy-xml) -(import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory)) - -(defn- attrs [xpp] - (for [i (range (.getAttributeCount xpp))] - [(keyword (.getAttributeName xpp i)) - (.getAttributeValue xpp i)])) - -(defn- ns-decs [xpp] - (let [d (.getDepth xpp)] - (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))] - (let [prefix (.getNamespacePrefix xpp i)] - [(keyword (str "xmlns" (when prefix (str ":" prefix)))) - (.getNamespaceUri xpp i)])))) - -(defn- attr-hash [xpp] - (into {} (concat (ns-decs xpp) (attrs xpp)))) - -(defn- pull-step [xpp] - (let [step (fn [xpp] - (condp = (.next xpp) - XmlPullParser/START_TAG - (cons (struct node :start-element - (keyword (.getName xpp)) - (attr-hash xpp)) - (pull-step xpp)) - XmlPullParser/END_TAG - (cons (struct node :end-element - (keyword (.getName xpp))) - (pull-step xpp)) - XmlPullParser/TEXT - (let [text (.trim (.getText xpp))] - (if (empty? text) - (recur xpp) - (cons (struct node :characters nil nil text) - (pull-step xpp))))))] - (lazy-seq (step xpp)))) - -(def ^{:private true} factory - (doto (XmlPullParserFactory/newInstance) - (.setNamespaceAware true))) - -(defn- parse-seq-pull [s] - (let [xpp (.newPullParser factory)] - (.setInput xpp s) - (pull-step xpp))) - -(def has-pull true) diff --git a/src/main/clojure/clojure/contrib/pprint/cl_format.clj b/src/main/clojure/clojure/contrib/pprint/cl_format.clj deleted file mode 100644 index 85f29b13..00000000 --- a/src/main/clojure/clojure/contrib/pprint/cl_format.clj +++ /dev/null @@ -1,1844 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; 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.contrib.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 -" - {:see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" - "Common Lisp the Language"] - ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" - "Common Lisp HyperSpec"]]} - [writer format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format writer compiled-format navigator))) - -(def ^{:private true} *format-str* nil) - -(defn- format-error [message offset] - (let [full-message (str message \newline *format-str* \newline - (apply str (repeat offset \space)) "^" \newline)] - (throw (RuntimeException. full-message)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Argument navigators manage the argument list -;;; as the format statement moves through the list -;;; (possibly going forwards and backwards as it does so) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} - arg-navigator :seq :rest :pos ) - -(defn init-navigator - "Create a new arg-navigator from the sequence with the position set to 0" - {:skip-wiki true} - [s] - (let [s (seq s)] - (struct arg-navigator s s 0))) - -;; TODO call format-error with offset -(defn- next-arg [ navigator ] - (let [ rst (:rest navigator) ] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - (throw (new Exception "Not enough arguments for format definition"))))) - -(defn- next-arg-or-nil [navigator] - (let [rst (:rest navigator)] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - [nil navigator]))) - -;; Get an argument off the arg list and compile it if it's not already compiled -(defn- get-format-arg [navigator] - (let [[raw-format navigator] (next-arg navigator) - compiled-format (if (instance? String raw-format) - (compile-format raw-format) - raw-format)] - [compiled-format navigator])) - -(declare relative-reposition) - -(defn- absolute-reposition [navigator position] - (if (>= position (:pos navigator)) - (relative-reposition navigator (- (:pos navigator) position)) - (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position))) - -(defn- relative-reposition [navigator position] - (let [newpos (+ (:pos navigator) position)] - (if (neg? position) - (absolute-reposition navigator newpos) - (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos)))) - -(defstruct ^{:private true} - compiled-directive :func :def :params :offset) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; When looking at the parameter list, we may need to manipulate -;;; the argument list as well (for 'V' and '#' parameter types). -;;; We hide all of this behind a function, but clients need to -;;; manage changing arg navigator -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: validate parameters when they come from arg list -(defn- realize-parameter [[param [raw-val offset]] navigator] - (let [[real-param new-navigator] - (cond - (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary - [raw-val navigator] - - (= raw-val :parameter-from-args) - (next-arg navigator) - - (= raw-val :remaining-arg-count) - [(count (:rest navigator)) navigator] - - true - [raw-val navigator])] - [[param [real-param offset]] new-navigator])) - -(defn- realize-parameter-list [parameter-map navigator] - (let [[pairs new-navigator] - (map-passing-context realize-parameter navigator parameter-map)] - [(into {} pairs) new-navigator])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions that support individual directives -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Common handling code for ~A and ~S -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare opt-base-str) - -(def ^{:private true} - special-radix-markers {2 "#b" 8 "#o", 16 "#x"}) - -(defn- format-simple-number [n] - (cond - (integer? n) (if (= *print-base* 10) - (str n (if *print-radix* ".")) - (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* n))) - (ratio? n) (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* (.numerator n)) - "/" - (opt-base-str *print-base* (.denominator n))) - :else nil)) - -(defn- format-ascii [print-func params arg-navigator offsets] - (let [ [arg arg-navigator] (next-arg arg-navigator) - ^String base-output (or (format-simple-number arg) (print-func arg)) - base-width (.length base-output) - min-width (+ base-width (:minpad params)) - width (if (>= min-width (:mincol params)) - min-width - (+ min-width - (* (+ (quot (- (:mincol params) min-width 1) - (:colinc params) ) - 1) - (:colinc params)))) - chars (apply str (repeat (- width base-width) (:padchar params)))] - (if (:at params) - (print (str chars base-output)) - (print (str base-output chars))) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the integer directives ~D, ~X, ~O, ~B and some -;;; of ~R -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- integral? - "returns true if a number is actually an integer (that is, has no fractional part)" - [x] - (cond - (integer? x) true - (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part - (float? x) (= x (Math/floor x)) - (ratio? x) (let [^clojure.lang.Ratio r x] - (= 0 (rem (.numerator r) (.denominator r)))) - :else false)) - -(defn- remainders - "Return the list of remainders (essentially the 'digits') of val in the given base" - [base val] - (reverse - (first - (consume #(if (pos? %) - [(rem % base) (quot % base)] - [nil nil]) - val)))) - -;;; TODO: xlated-val does not seem to be used here. -(defn- base-str - "Return val as a string in the given base" - [base val] - (if (zero? val) - "0" - (let [xlated-val (cond - (float? val) (bigdec val) - (ratio? val) (let [^clojure.lang.Ratio r val] - (/ (.numerator r) (.denominator r))) - :else val)] - (apply str - (map - #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) - (remainders base val)))))) - -(def ^{:private true} - java-base-formats {8 "%o", 10 "%d", 16 "%x"}) - -(defn- opt-base-str - "Return val as a string in the given base, using clojure.core/format if supported -for improved performance" - [base val] - (let [format-str (get java-base-formats base)] - (if (and format-str (integer? val) (-> val class .getName (.startsWith "java."))) - (clojure.core/format format-str val) - (base-str base val)))) - -(defn- group-by* [unit lis] - (reverse - (first - (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis))))) - -(defn- format-integer [base params arg-navigator offsets] - (let [[arg arg-navigator] (next-arg arg-navigator)] - (if (integral? arg) - (let [neg (neg? arg) - pos-arg (if neg (- arg) arg) - raw-str (opt-base-str base pos-arg) - group-str (if (:colon params) - (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str)) - commas (repeat (count groups) (:commachar params))] - (apply str (next (interleave commas groups)))) - raw-str) - ^String signed-str (cond - neg (str "-" group-str) - (:at params) (str "+" group-str) - true group-str) - padded-str (if (< (.length signed-str) (:mincol params)) - (str (apply str (repeat (- (:mincol params) (.length signed-str)) - (:padchar params))) - signed-str) - signed-str)] - (print padded-str)) - (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 - :padchar (:padchar params) :at true} - (init-navigator [arg]) nil)) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for english formats (~R and ~:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - english-cardinal-units - ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" - "ten" "eleven" "twelve" "thirteen" "fourteen" - "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"]) - -(def ^{:private true} - english-ordinal-units - ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" - "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth" - "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"]) - -(def ^{:private true} - english-cardinal-tens - ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"]) - -(def ^{:private true} - english-ordinal-tens - ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth" - "sixtieth" "seventieth" "eightieth" "ninetieth"]) - -;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales) -;; Number names from http://www.jimloy.com/math/billion.htm -;; We follow the rules for writing numbers from the Blue Book -;; (http://www.grammarbook.com/numbers/numbers.asp) -(def ^{:private true} - english-scale-numbers - ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" - "sextillion" "septillion" "octillion" "nonillion" "decillion" - "undecillion" "duodecillion" "tredecillion" "quattuordecillion" - "quindecillion" "sexdecillion" "septendecillion" - "octodecillion" "novemdecillion" "vigintillion"]) - -(defn- format-simple-cardinal - "Convert a number less than 1000 to a cardinal english string" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-cardinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-cardinal-units unit-digit))))))))) - -(defn- add-english-scales - "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string -offset is a factor of 10^3 to multiply by" - [parts offset] - (let [cnt (count parts)] - (loop [acc [] - pos (dec cnt) - this (first parts) - remainder (next parts)] - (if (nil? remainder) - (str (apply str (interpose ", " acc)) - (if (and (not (empty? this)) (not (empty? acc))) ", ") - this - (if (and (not (empty? this)) (pos? (+ pos offset))) - (str " " (nth english-scale-numbers (+ pos offset))))) - (recur - (if (empty? this) - acc - (conj acc (str this " " (nth english-scale-numbers (+ pos offset))))) - (dec pos) - (first remainder) - (next remainder)))))) - -(defn- format-cardinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zero") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal parts) - full-str (add-english-scales parts-strs 0)] - (print (str (if (neg? arg) "minus ") full-str))) - (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})))) - navigator)) - -(defn- format-simple-ordinal - "Convert a number less than 1000 to a ordinal english string -Note this should only be used for the last one in the sequence" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-ordinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (if (and (pos? ten-digit) (not (pos? unit-digit))) - (nth english-ordinal-tens ten-digit) - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-ordinal-units unit-digit)))))) - (if (pos? hundreds) "th"))))) - -(defn- format-ordinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zeroth") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal (drop-last parts)) - head-str (add-english-scales parts-strs 1) - tail-str (format-simple-ordinal (last parts))] - (print (str (if (neg? arg) "minus ") - (cond - (and (not (empty? head-str)) (not (empty? tail-str))) - (str head-str ", " tail-str) - - (not (empty? head-str)) (str head-str "th") - :else tail-str)))) - (do (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}) - (let [low-two-digits (rem arg 100) - not-teens (or (< 11 low-two-digits) (> 19 low-two-digits)) - low-digit (rem low-two-digits 10)] - (print (cond - (and (== low-digit 1) not-teens) "st" - (and (== low-digit 2) not-teens) "nd" - (and (== low-digit 3) not-teens) "rd" - :else "th"))))))) - navigator)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for roman numeral formats (~@R and ~@:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - old-roman-table - [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"] - [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"] - [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"] - [ "M" "MM" "MMM"]]) - -(def ^{:private true} - new-roman-table - [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"] - [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"] - [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"] - [ "M" "MM" "MMM"]]) - -(defn- format-roman - "Format a roman numeral using the specified look-up table" - [table params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (and (number? arg) (> arg 0) (< arg 4000)) - (let [digits (remainders 10 arg)] - (loop [acc [] - pos (dec (count digits)) - digits digits] - (if (empty? digits) - (print (apply str acc)) - (let [digit (first digits)] - (recur (if (= 0 digit) - acc - (conj acc (nth (nth table pos) (dec digit)))) - (dec pos) - (next digits)))))) - (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})) - navigator)) - -(defn- format-old-roman [params navigator offsets] - (format-roman old-roman-table params navigator offsets)) - -(defn- format-new-roman [params navigator offsets] - (format-roman new-roman-table params navigator offsets)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for character formats (~C) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - special-chars { 8 "Backspace", 9 "Tab", 10 "Newline", 13 "Return", 32 "Space"}) - -(defn- pretty-character [params navigator offsets] - (let [[c navigator] (next-arg navigator) - as-int (int c) - base-char (bit-and as-int 127) - meta (bit-and as-int 128) - special (get special-chars base-char)] - (if (> meta 0) (print "Meta-")) - (print (cond - special special - (< base-char 32) (str "Control-" (char (+ base-char 64))) - (= base-char 127) "Control-?" - :else (char base-char))) - navigator)) - -(defn- readable-character [params navigator offsets] - (let [[c navigator] (next-arg navigator)] - (condp = (:char-format params) - \o (cl-format true "\\o~3,'0o" (int c)) - \u (cl-format true "\\u~4,'0x" (int c)) - nil (pr c)) - navigator)) - -(defn- plain-character [params navigator offsets] - (let [[char navigator] (next-arg navigator)] - (print char) - navigator)) - -;; Check to see if a result is an abort (~^) construct -;; TODO: move these funcs somewhere more appropriate -(defn- abort? [context] - (let [token (first context)] - (or (= :up-arrow token) (= :colon-up-arrow token)))) - -;; Handle the execution of "sub-clauses" in bracket constructions -(defn- execute-sub-format [format args base-args] - (second - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] ; just keep passing it along - (let [[params args] (realize-parameter-list (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args base-args)] - [nil (apply (:func element) [params args offsets])]))) - args - format))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for real number formats -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO - return exponent as int to eliminate double conversion -(defn- float-parts-base - "Produce string parts for the mantissa (normalized 1-9) and exponent" - [^Object f] - (let [^String s (.toLowerCase (.toString f)) - exploc (.indexOf s (int \e))] - (if (neg? exploc) - (let [dotloc (.indexOf s (int \.))] - (if (neg? dotloc) - [s (str (dec (count s)))] - [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))])) - [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))]))) - - -(defn- float-parts - "Take care of leading and trailing zeros in decomposed floats" - [f] - (let [[m ^String e] (float-parts-base f) - m1 (rtrim m \0) - m2 (ltrim m1 \0) - delta (- (count m1) (count m2)) - ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)] - (if (empty? m2) - ["0" 0] - [m2 (- (Integer/valueOf e) delta)]))) - -(defn- round-str [m e d w] - (if (or d w) - (let [len (count m) - round-pos (if d (+ e d 1)) - round-pos (if (and w (< (inc e) (dec w)) - (or (nil? round-pos) (< (dec w) round-pos))) - (dec w) - round-pos) - [m1 e1 round-pos len] (if (= round-pos 0) - [(str "0" m) (inc e) 1 (inc len)] - [m e round-pos len])] - (if round-pos - (if (neg? round-pos) - ["0" 0 false] - (if (> len round-pos) - (let [round-char (nth m1 round-pos) - ^String result (subs m1 0 round-pos)] - (if (>= (int round-char) (int \5)) - (let [result-val (Integer/valueOf result) - leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1))) - round-up-result (str leading-zeros - (String/valueOf (+ result-val - (if (neg? result-val) -1 1)))) - expanded (> (count round-up-result) (count result))] - [round-up-result e1 expanded]) - [result e1 false])) - [m e false])) - [m e false])) - [m e false])) - -(defn- expand-fixed [m e d] - (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m) - len (count m1) - target-len (if d (+ e d 1) (inc e))] - (if (< len target-len) - (str m1 (apply str (repeat (- target-len len) \0))) - m1))) - -(defn- insert-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m e] - (if (neg? e) - (str "." m) - (let [loc (inc e)] - (str (subs m 0 loc) "." (subs m loc))))) - -(defn- get-fixed [m e d] - (insert-decimal (expand-fixed m e d) e)) - -(defn- insert-scaled-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m k] - (if (neg? k) - (str "." m) - (str (subs m 0 k) "." (subs m k)))) - -;; the function to render ~F directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- fixed-float [params navigator offsets] - (let [w (:w params) - d (:d params) - [arg navigator] (next-arg navigator) - [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg]) - [mantissa exp] (float-parts abs) - scaled-exp (+ exp (:k params)) - add-sign (or (:at params) (neg? arg)) - append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp - d (if w (- w (if add-sign 1 0)))) - fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - prepend-zero (= (first fixed-repr) \.)] - (if w - (let [len (count fixed-repr) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (>= signed-len w))) - append-zero (and append-zero (not (>= signed-len w))) - full-len (if (or prepend-zero append-zero) - (inc signed-len) - signed-len)] - (if (and (> full-len w) (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str (repeat (- w full-len) (:padchar params))) - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0"))))) - (print (str - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0")))) - navigator)) - - -;; the function to render ~E directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: define ~E representation for Infinity -(defn- exponential-float [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))] - (let [w (:w params) - d (:d params) - e (:e params) - k (:k params) - expchar (or (:exponentchar params) \E) - add-sign (or (:at params) (neg? arg)) - prepend-zero (<= k 0) - ^Integer scaled-exp (- exp (dec k)) - scaled-exp-str (str (Math/abs scaled-exp)) - scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) - (if e (apply str - (repeat - (- e - (count scaled-exp-str)) - \0))) - scaled-exp-str) - exp-width (count scaled-exp-str) - base-mantissa-width (count mantissa) - scaled-mantissa (str (apply str (repeat (- k) \0)) - mantissa - (if d - (apply str - (repeat - (- d (dec base-mantissa-width) - (if (neg? k) (- k) 0)) \0)))) - w-mantissa (if w (- w exp-width)) - [rounded-mantissa _ incr-exp] (round-str - scaled-mantissa 0 - (cond - (= k 0) (dec d) - (pos? k) d - (neg? k) (dec d)) - (if w-mantissa - (- w-mantissa (if add-sign 1 0)))) - full-mantissa (insert-scaled-decimal rounded-mantissa k) - append-zero (and (= k (count rounded-mantissa)) (nil? d))] - (if (not incr-exp) - (if w - (let [len (+ (count full-mantissa) exp-width) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (= signed-len w))) - full-len (if prepend-zero (inc signed-len) signed-len) - append-zero (and append-zero (< full-len w))] - (if (and (or (> full-len w) (and e (> (- exp-width 2) e))) - (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str - (repeat - (- w full-len (if append-zero 1 0) ) - (:padchar params))) - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str)))) - (print (str - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str))) - (recur [rounded-mantissa (inc exp)])))) - navigator)) - -;; the function to render ~G directives -;; This just figures out whether to pass the request off to ~F or ~E based -;; on the algorithm in CLtL. -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: refactor so that float-parts isn't called twice -(defn- general-float [params navigator offsets] - (let [[arg _] (next-arg navigator) - [mantissa exp] (float-parts (if (neg? arg) (- arg) arg)) - w (:w params) - d (:d params) - e (:e params) - n (if (= arg 0.0) 0 (inc exp)) - ee (if e (+ e 2) 4) - ww (if w (- w ee)) - d (if d d (max (count mantissa) (min n 7))) - dd (- d n)] - (if (<= 0 dd d) - (let [navigator (fixed-float {:w ww, :d dd, :k 0, - :overflowchar (:overflowchar params), - :padchar (:padchar params), :at (:at params)} - navigator offsets)] - (print (apply str (repeat ee \space))) - navigator) - (exponential-float params navigator offsets)))) - -;; the function to render ~$ directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- dollar-float [params navigator offsets] - (let [[^Double arg navigator] (next-arg navigator) - [mantissa exp] (float-parts (Math/abs arg)) - d (:d params) ; digits after the decimal - n (:n params) ; minimum digits before the decimal - w (:w params) ; minimum field width - add-sign (or (:at params) (neg? arg)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil) - ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr) - full-len (+ (count full-repr) (if add-sign 1 0))] - (print (str - (if (and (:colon params) add-sign) (if (neg? arg) \- \+)) - (apply str (repeat (- w full-len) (:padchar params))) - (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+)) - full-repr)) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~[...~]' conditional construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; ~[...~] without any modifiers chooses one of the clauses based on the param or -;; next argument -;; TODO check arg is positive int -(defn- choice-conditional [params arg-navigator offsets] - (let [arg (:selector params) - [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator)) - clauses (:clauses params) - clause (if (or (neg? arg) (>= arg (count clauses))) - (first (:else params)) - (nth clauses arg))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~:[...~] with the colon reads the next argument treating it as a truth value -(defn- boolean-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg - (second clauses) - (first clauses))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~@[...~] with the at sign executes the conditional if the next arg is not -;; nil/false without consuming the arg -(defn- check-arg-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg (first clauses))] - (if arg - (if clause - (execute-sub-format clause arg-navigator (:base-args params)) - arg-navigator) - navigator))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~{...~}' iteration construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; ~{...~} without any modifiers uses the next argument as an argument list that -;; is consumed by all the iterations -(defn- iterate-sublist [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator) - args (init-navigator arg-list)] - (loop [count 0 - args args - last-pos (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, captializing all words" - [^java.io.Writer writer] - (let [last-was-whitespace? (ref true)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write - ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer - ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?)) - (dosync - (ref-set last-was-whitespace? - (Character/isWhitespace - ^Character (nth s (dec (count s))))))) - - Integer - (let [c (char x)] - (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] - (.write writer (int mod-c)) - (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x)))))))))))) - -(defn- init-cap-writer - "Returns a proxy that wraps writer, capitalizing the first word" - [^java.io.Writer writer] - (let [capped (ref false)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s (.toLowerCase ^String x)] - (if (not @capped) - (let [m (re-matcher #"\S" s) - match (re-find m) - offset (and match (.start m))] - (if offset - (do (.write writer - (str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset)) - (.toLowerCase ^String (subs s (inc offset))))) - (dosync (ref-set capped true))) - (.write writer s))) - (.write writer (.toLowerCase s)))) - - Integer - (let [c ^Character (char x)] - (if (and (not @capped) (Character/isLetter c)) - (do - (dosync (ref-set capped true)) - (.write writer (int (Character/toUpperCase c)))) - (.write writer (int (Character/toLowerCase c))))))))))) - -(defn- modify-case [make-writer params navigator offsets] - (let [clause (first (:clauses params))] - (binding [*out* (make-writer *out*)] - (execute-sub-format clause navigator (:base-args params))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; If necessary, wrap the writer in a PrettyWriter object -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn get-pretty-writer [writer] - (if (pretty-writer? writer) - writer - (pretty-writer writer *print-right-margin* *print-miser-width*))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for column-aware operations ~&, ~T -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: make an automatic newline for non-ColumnWriters -(defn fresh-line - "Make a newline if the Writer is not already at the beginning of the line. -N.B. Only works on ColumnWriters right now." - [] - (if (not (= 0 (get-column (:base @@*out*)))) - (prn))) - -(defn- absolute-tabulation [params navigator offsets] - (let [colnum (:colnum params) - colinc (:colinc params) - current (get-column (:base @@*out*)) - space-count (cond - (< current colnum) (- colnum current) - (= colinc 0) 0 - :else (- colinc (rem (- current colnum) colinc)))] - (print (apply str (repeat space-count \space)))) - navigator) - -(defn- relative-tabulation [params navigator offsets] - (let [colrel (:colnum params) - colinc (:colinc params) - start-col (+ colrel (get-column (:base @@*out*))) - offset (if (pos? colinc) (rem start-col colinc) 0) - space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))] - (print (apply str (repeat space-count \space)))) - navigator) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for accessing the pretty printer from a format -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: support ~@; per-line-prefix separator -;; TODO: get the whole format wrapped so we can start the lb at any column -(defn- format-logical-block [params navigator offsets] - (let [clauses (:clauses params) - clause-count (count clauses) - prefix (cond - (> clause-count 1) (:string (:params (first (first clauses)))) - (:colon params) "(") - body (nth clauses (if (> clause-count 1) 1 0)) - suffix (cond - (> clause-count 2) (:string (:params (first (nth clauses 2)))) - (:colon params) ")") - [arg navigator] (next-arg navigator)] - (pprint-logical-block :prefix prefix :suffix suffix - (execute-sub-format - body - (init-navigator arg) - (:base-args params))) - navigator)) - -(defn- set-indent [params navigator offsets] - (let [relative-to (if (:colon params) :current :block)] - (pprint-indent relative-to (:n params)) - navigator)) - -;;; TODO: support ~:T section options for ~T - -(defn- conditional-newline [params navigator offsets] - (let [kind (if (:colon params) - (if (:at params) :mandatory :fill) - (if (:at params) :miser :linear))] - (pprint-newline kind) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The table of directives we support, each with its params, -;;; properties, and the compilation function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; We start with a couple of helpers -(defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ] - [char, - {:directive char, - :params `(array-map ~@params), - :flags flags, - :bracket-info bracket-info, - :generator-fn (concat '(fn [ params offset]) generator-fn) }]) - -(defmacro ^{:private true} - defdirectives - [ & directives ] - `(def ^{:private true} - directive-table (hash-map ~@(mapcat process-directive-table-element directives)))) - -(defdirectives - (\A - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii print-str %1 %2 %3)) - - (\S - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii pr-str %1 %2 %3)) - - (\D - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 10 %1 %2 %3)) - - (\B - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 2 %1 %2 %3)) - - (\O - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 8 %1 %2 %3)) - - (\X - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 16 %1 %2 %3)) - - (\R - [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - (do - (cond ; ~R is overloaded with bizareness - (first (:base params)) #(format-integer (:base %1) %1 %2 %3) - (and (:at params) (:colon params)) #(format-old-roman %1 %2 %3) - (:at params) #(format-new-roman %1 %2 %3) - (:colon params) #(format-ordinal-english %1 %2 %3) - true #(format-cardinal-english %1 %2 %3)))) - - (\P - [ ] - #{ :at :colon :both } {} - (fn [params navigator offsets] - (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator) - strs (if (:at params) ["y" "ies"] ["" "s"]) - [arg navigator] (next-arg navigator)] - (print (if (= arg 1) (first strs) (second strs))) - navigator))) - - (\C - [:char-format [nil Character]] - #{ :at :colon :both } {} - (cond - (:colon params) pretty-character - (:at params) readable-character - :else plain-character)) - - (\F - [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] - :padchar [\space Character] ] - #{ :at } {} - fixed-float) - - (\E - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - exponential-float) - - (\G - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - general-float) - - (\$ - [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]] - #{ :at :colon :both} {} - dollar-float) - - (\% - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (prn)) - arg-navigator)) - - (\& - [ :count [1 Integer] ] - #{ :pretty } {} - (fn [params arg-navigator offsets] - (let [cnt (:count params)] - (if (pos? cnt) (fresh-line)) - (dotimes [i (dec cnt)] - (prn))) - arg-navigator)) - - (\| - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (print \formfeed)) - arg-navigator)) - - (\~ - [ :n [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (let [n (:n params)] - (print (apply str (repeat n \~))) - arg-navigator))) - - (\newline ;; Whitespace supression is handled in the compilation loop - [ ] - #{:colon :at} {} - (fn [params arg-navigator offsets] - (if (:at params) - (prn)) - arg-navigator)) - - (\T - [ :colnum [1 Integer] :colinc [1 Integer] ] - #{ :at :pretty } {} - (if (:at params) - #(relative-tabulation %1 %2 %3) - #(absolute-tabulation %1 %2 %3))) - - (\* - [ :n [1 Integer] ] - #{ :colon :at } {} - (fn [params navigator offsets] - (let [n (:n params)] - (if (:at params) - (absolute-reposition navigator n) - (relative-reposition navigator (if (:colon params) (- n) n))) - ))) - - (\? - [ ] - #{ :at } {} - (if (:at params) - (fn [params navigator offsets] ; args from main arg list - (let [[subformat navigator] (get-format-arg navigator)] - (execute-sub-format subformat navigator (:base-args params)))) - (fn [params navigator offsets] ; args from sub-list - (let [[subformat navigator] (get-format-arg navigator) - [subargs navigator] (next-arg navigator) - sub-navigator (init-navigator subargs)] - (execute-sub-format subformat sub-navigator (:base-args params)) - navigator)))) - - - (\( - [ ] - #{ :colon :at :both} { :right \), :allows-separator nil, :else nil } - (let [mod-case-writer (cond - (and (:at params) (:colon params)) - upcase-writer - - (:colon params) - capitalize-word-writer - - (:at params) - init-cap-writer - - :else - downcase-writer)] - #(modify-case mod-case-writer %1 %2 %3))) - - (\) [] #{} {} nil) - - (\[ - [ :selector [nil Integer] ] - #{ :colon :at } { :right \], :allows-separator true, :else :last } - (cond - (:colon params) - boolean-conditional - - (:at params) - check-arg-conditional - - true - choice-conditional)) - - (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] - #{ :colon } { :separator true } nil) - - (\] [] #{} {} nil) - - (\{ - [ :max-iterations [nil Integer] ] - #{ :colon :at :both} { :right \}, :allows-separator false } - (cond - (and (:at params) (:colon params)) - iterate-main-sublists - - (:colon params) - iterate-list-of-sublists - - (:at params) - iterate-main-list - - true - iterate-sublist)) - - - (\} [] #{:colon} {} nil) - - (\< - [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]] - #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first } - logical-block-or-justify) - - (\> [] #{:colon} {} nil) - - ;; TODO: detect errors in cases where colon not allowed - (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] - #{:colon} {} - (fn [params navigator offsets] - (let [arg1 (:arg1 params) - arg2 (:arg2 params) - arg3 (:arg3 params) - exit (if (:colon params) :colon-up-arrow :up-arrow)] - (cond - (and arg1 arg2 arg3) - (if (<= arg1 arg2 arg3) [exit navigator] navigator) - - (and arg1 arg2) - (if (= arg1 arg2) [exit navigator] navigator) - - arg1 - (if (= arg1 0) [exit navigator] navigator) - - true ; TODO: handle looking up the arglist stack for info - (if (if (:colon params) - (empty? (:rest (:base-args params))) - (empty? (:rest navigator))) - [exit navigator] navigator))))) - - (\W - [] - #{:at :colon :both} {} - (if (or (:at params) (:colon params)) - (let [bindings (concat - (if (:at params) [:level nil :length nil] []) - (if (:colon params) [:pretty true] []))] - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (apply write arg bindings) - [:up-arrow navigator] - navigator)))) - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (write-out arg) - [:up-arrow navigator] - navigator))))) - - (\_ - [] - #{:at :colon :both} {} - conditional-newline) - - (\I - [:n [0 Integer]] - #{:colon} {} - set-indent) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Code to manage the parameters and flags associated with each -;;; directive in the format string. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))") -(def ^{:private true} - special-params #{ :parameter-from-args :remaining-arg-count }) - -(defn- extract-param [[s offset saw-comma]] - (let [m (re-matcher param-pattern s) - param (re-find m)] - (if param - (let [token-str (first (re-groups m)) - remainder (subs s (.end m)) - new-offset (+ offset (.end m))] - (if (not (= \, (nth remainder 0))) - [ [token-str offset] [remainder new-offset false]] - [ [token-str offset] [(subs remainder 1) (inc new-offset) true]])) - (if saw-comma - (format-error "Badly formed parameters in format directive" offset) - [ nil [s offset]])))) - - -(defn- extract-params [s offset] - (consume extract-param [s offset false])) - -(defn- translate-param - "Translate the string representation of a param to the internalized - representation" - [[^String p offset]] - [(cond - (= (.length p) 0) nil - (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args - (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count - (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1) - true (new Integer p)) - offset]) - -(def ^{:private true} - flag-defs { \: :colon, \@ :at }) - -(defn- extract-flags [s offset] - (consume - (fn [[s offset flags]] - (if (empty? s) - [nil [s offset flags]] - (let [flag (get flag-defs (first s))] - (if flag - (if (contains? flags flag) - (format-error - (str "Flag \"" (first s) "\" appears more than once in a directive") - offset) - [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]]) - [nil [s offset flags]])))) - [s offset {}])) - -(defn- check-flags [def flags] - (let [allowed (:flags def)] - (if (and (not (:at allowed)) (:at flags)) - (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:at flags) 1))) - (if (and (not (:colon allowed)) (:colon flags)) - (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:colon flags) 1))) - (if (and (not (:both allowed)) (:at flags) (:colon flags)) - (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" - (:directive def) "\"") - (min (nth (:colon flags) 1) (nth (:at flags) 1)))))) - -(defn- map-params - "Takes a directive definition and the list of actual parameters and -a map of flags and returns a map of the parameters and flags with defaults -filled in. We check to make sure that there are the right types and number -of parameters as well." - [def params flags offset] - (check-flags def flags) - (if (> (count params) (count (:params def))) - (format-error - (cl-format - nil - "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed" - (:directive def) (count params) (count (:params def))) - (second (first params)))) - (doall - (map #(let [val (first %1)] - (if (not (or (nil? val) (contains? special-params val) - (instance? (second (second %2)) val))) - (format-error (str "Parameter " (name (first %2)) - " has bad type in directive \"" (:directive def) "\": " - (class val)) - (second %1))) ) - params (:params def))) - - (merge ; create the result map - (into (array-map) ; start with the default values, make sure the order is right - (reverse (for [[name [default]] (:params def)] [name [default offset]]))) - (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils - flags)) ; and finally add the flags - -(defn- compile-directive [s offset] - (let [[raw-params [rest offset]] (extract-params s offset) - [_ [rest offset flags]] (extract-flags rest offset) - directive (first rest) - def (get directive-table (Character/toUpperCase ^Character directive)) - params (if def (map-params def (map translate-param raw-params) flags offset))] - (if (not directive) - (format-error "Format string ended in the middle of a directive" offset)) - (if (not def) - (format-error (str "Directive \"" directive "\" is undefined") offset)) - [(struct compiled-directive ((:generator-fn def) params offset) def params offset) - (let [remainder (subs rest 1) - offset (inc offset) - trim? (and (= \newline (:directive def)) - (not (:colon params))) - trim-count (if trim? (prefix-count remainder [\space \tab]) 0) - remainder (subs remainder trim-count) - offset (+ offset trim-count)] - [remainder offset])])) - -(defn- compile-raw-string [s offset] - (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset)) - -(defn- right-bracket [this] (:right (:bracket-info (:def this)))) -(defn- separator? [this] (:separator (:bracket-info (:def this)))) -(defn- else-separator? [this] - (and (:separator (:bracket-info (:def this))) - (:colon (:params this)))) - - -(declare collect-clauses) - -(defn- process-bracket [this remainder] - (let [[subex remainder] (collect-clauses (:bracket-info (:def this)) - (:offset this) remainder)] - [(struct compiled-directive - (:func this) (:def this) - (merge (:params this) (tuple-map subex (:offset this))) - (:offset this)) - remainder])) - -(defn- process-clause [bracket-info offset remainder] - (consume - (fn [remainder] - (if (empty? remainder) - (format-error "No closing bracket found." offset) - (let [this (first remainder) - remainder (next remainder)] - (cond - (right-bracket this) - (process-bracket this remainder) - - (= (:right bracket-info) (:directive (:def this))) - [ nil [:right-bracket (:params this) nil remainder]] - - (else-separator? this) - [nil [:else nil (:params this) remainder]] - - (separator? this) - [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~; - - true - [this remainder])))) - remainder)) - -(defn- collect-clauses [bracket-info offset remainder] - (second - (consume - (fn [[clause-map saw-else remainder]] - (let [[clause [type right-params else-params remainder]] - (process-clause bracket-info offset remainder)] - (cond - (= type :right-bracket) - [nil [(merge-with concat clause-map - {(if saw-else :else :clauses) [clause] - :right-params right-params}) - remainder]] - - (= type :else) - (cond - (:else clause-map) - (format-error "Two else clauses (\"~:;\") inside bracket construction." offset) - - (not (:else bracket-info)) - (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." - offset) - - (and (= :first (:else bracket-info)) (seq (:clauses clause-map))) - (format-error - "The else clause (\"~:;\") is only allowed in the first position for this directive." - offset) - - true ; if the ~:; is in the last position, the else clause - ; is next, this was a regular clause - (if (= :first (:else bracket-info)) - [true [(merge-with concat clause-map { :else [clause] :else-params else-params}) - false remainder]] - [true [(merge-with concat clause-map { :clauses [clause] }) - true remainder]])) - - (= type :separator) - (cond - saw-else - (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset) - - (not (:allows-separator bracket-info)) - (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." - offset) - - true - [true [(merge-with concat clause-map { :clauses [clause] }) - false remainder]])))) - [{ :clauses [] } false remainder]))) - -(defn- process-nesting - "Take a linearly compiled format and process the bracket directives to give it - the appropriate tree structure" - [format] - (first - (consume - (fn [remainder] - (let [this (first remainder) - remainder (next remainder) - bracket (:bracket-info (:def this))] - (if (:right bracket) - (process-bracket this remainder) - [this remainder]))) - format))) - -(defn compile-format - "Compiles format-str into a compiled format which can be used as an argument -to cl-format just like a plain format string. Use this function for improved -performance when you're using the same format string repeatedly" - [ format-str ] -; (prlabel compiling format-str) - (binding [*format-str* format-str] - (process-nesting - (first - (consume - (fn [[^String s offset]] - (if (empty? s) - [nil s] - (let [tilde (.indexOf s (int \~))] - (cond - (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]] - (zero? tilde) (compile-directive (subs s 1) (inc offset)) - true - [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]])))) - [format-str 0]))))) - -(defn- needs-pretty - "determine whether a given compiled format has any directives that depend on the -column number or pretty printing" - [format] - (loop [format format] - (if (empty? format) - false - (if (or (:pretty (:flags (:def (first format)))) - (some needs-pretty (first (:clauses (:params (first format))))) - (some needs-pretty (first (:else (:params (first format)))))) - true - (recur (next format)))))) - -(defn execute-format - "Executes the format with the arguments. This should never be used directly, but is public -because the formatter macro uses it." - {: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))) - - -(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." - [format-in] - (let [cf (gensym "compiled-format")] - `(let [format-in# ~format-in] - (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#)) - (fn [stream# & args#] - (let [navigator# (init-navigator args#)] - (execute-format 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." - [format-in] - (let [cf (gensym "compiled-format")] - `(let [format-in# ~format-in] - (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#)) - (fn [& args#] - (let [navigator# (init-navigator args#)] - (execute-format ~cf navigator#))))))) diff --git a/src/main/clojure/clojure/contrib/pprint/dispatch.clj b/src/main/clojure/clojure/contrib/pprint/dispatch.clj deleted file mode 100644 index 2d742964..00000000 --- a/src/main/clojure/clojure/contrib/pprint/dispatch.clj +++ /dev/null @@ -1,447 +0,0 @@ -;; dispatch.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. 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. - -;; This module implements the default dispatch tables for pretty printing code and -;; data. - -(in-ns 'clojure.contrib.pprint) - -(defn use-method - "Installs a function as a new method of multimethod associated with dispatch-value. " - [multifn dispatch-val func] - (. multifn addMethod dispatch-val func)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Implementations of specific dispatch table entries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Handle forms that can be "back-translated" to reader macros -;;; Not all reader macros can be dealt with this way or at all. -;;; Macros that we can't deal with at all are: -;;; ; - The comment character is aborbed by the reader and never is part of the form -;;; ` - Is fully processed at read time into a lisp expression (which will contain concats -;;; and regular quotes). -;;; ~@ - Also fully eaten by the processing of ` and can't be used outside. -;;; , - is whitespace and is lost (like all other whitespace). Formats can generate commas -;;; where they deem them useful to help readability. -;;; ^ - Adding metadata completely disappears at read time and the data appears to be -;;; completely lost. -;;; -;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{}) -;;; or directly by printing the objects using Clojure's built-in print functions (like -;;; :keyword, \char, or ""). The notable exception is #() which is special-cased. - -(def reader-macros - {'quote "'", 'clojure.core/deref "@", - 'var "#'", 'clojure.core/unquote "~"}) - -(defn pprint-reader-macro [alis] - (let [^String macro-char (reader-macros (first alis))] - (when (and macro-char (= 2 (count alis))) - (.write ^java.io.Writer *out* macro-char) - (write-out (second alis)) - true))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dispatch for the basic data types when interpreted -;; as data (as opposed to code). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; TODO: inline these formatter statements into funcs so that we -;;; are a little easier on the stack. (Or, do "real" compilation, a -;;; la Common Lisp) - -;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>")) -(defn pprint-simple-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -(defn pprint-list [alis] - (if-not (pprint-reader-macro alis) - (pprint-simple-list alis))) - -;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>")) -(defn pprint-vector [avec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [aseq (seq avec)] - (when aseq - (write-out (first aseq)) - (when (next aseq) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) - -;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) -(defn pprint-map [amap] - (pprint-logical-block :prefix "{" :suffix "}" - (loop [aseq (seq amap)] - (when aseq - (pprint-logical-block - (write-out (ffirst aseq)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (write-out (fnext (first aseq)))) - (when (next aseq) - (.write ^java.io.Writer *out* ", ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) -(defn pprint-ref [ref] - (pprint-logical-block :prefix "#<Ref " :suffix ">" - (write-out @ref))) -(defn pprint-atom [ref] - (pprint-logical-block :prefix "#<Atom " :suffix ">" - (write-out @ref))) -(defn pprint-agent [ref] - (pprint-logical-block :prefix "#<Agent " :suffix ">" - (write-out @ref))) - -(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." - {: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.Ref pprint-ref) -(use-method *simple-dispatch* clojure.lang.Atom pprint-atom) -(use-method *simple-dispatch* clojure.lang.Agent pprint-agent) -(use-method *simple-dispatch* nil pr) -(use-method *simple-dispatch* :default pprint-simple-default) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Dispatch for the code table -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare pprint-simple-code-list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a simple def (sans metadata, since the reader -;;; won't give it to us now). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a defn or defmacro -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Format the params and body of a defn with a single arity -(defn- single-defn [alis has-doc-str?] - (if (seq alis) - (do - (if has-doc-str? - ((formatter-out " ~_")) - ((formatter-out " ~@_"))) - ((formatter-out "~{~w~^ ~_~}") alis)))) - -;;; Format the param and body sublists of a defn with multiple arities -(defn- multi-defn [alis has-doc-str?] - (if (seq alis) - ((formatter-out " ~_~{~w~^ ~_~}") alis))) - -;;; TODO: figure out how to support capturing metadata in defns (we might need a -;;; special reader) -(defn pprint-defn [alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block :prefix "(" :suffix ")" - ((formatter-out "~w ~1I~@_~w") defn-sym defn-name) - (if doc-str - ((formatter-out " ~_~w") doc-str)) - (if attr-map - ((formatter-out " ~_~w") attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list alis))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something with a binding form -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn pprint-binding-form [binding-vec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [binding binding-vec] - (when (seq binding) - (pprint-logical-block binding - (write-out (first binding)) - (when (next binding) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second binding)))) - (when (next (rest binding)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest binding)))))))) - -(defn pprint-let [alis] - (let [base-sym (first alis)] - (pprint-logical-block :prefix "(" :suffix ")" - (if (and (next alis) (vector? (second alis))) - (do - ((formatter-out "~w ~1I~@_") base-sym) - (pprint-binding-form (second alis)) - ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis)))) - (pprint-simple-code-list alis))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like "if" -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>")) - -(defn pprint-cond [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (loop [alis (next alis)] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))))) - -(defn pprint-condp [alis] - (if (> (count alis) 3) - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis) - (loop [alis (seq (drop 3 alis))] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))) - (pprint-simple-code-list alis))) - -;;; The map of symbols that are defined in an enclosing #() anonymous function -(def *symbol-map* {}) - -(defn pprint-anon-func [alis] - (let [args (second alis) - nlis (first (rest (rest alis)))] - (if (vector? args) - (binding [*symbol-map* (if (= 1 (count args)) - {(first args) "%"} - (into {} - (map - #(vector %1 (str \% %2)) - args - (range 1 (inc (count args))))))] - ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis)) - (pprint-simple-code-list alis)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The master definitions for formatting lists in code (that is, (fn args...) or -;;; special forms). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is -;;; easier on the stack. - -(defn pprint-simple-code-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -;;; Take a map with symbols as keys and add versions with no namespace. -;;; That is, if ns/sym->val is in the map, add sym->val to the result. -(defn two-forms [amap] - (into {} - (mapcat - identity - (for [x amap] - [x [(symbol (name (first x))) (second x)]])))) - -(defn add-core-ns [amap] - (let [core "clojure.core"] - (into {} - (map #(let [[s f] %] - (if (not (or (namespace s) (special-symbol? s))) - [(symbol core (name s)) f] - %)) - amap)))) - -(def *code-table* - (two-forms - (add-core-ns - {'def pprint-hold-first, 'defonce pprint-hold-first, - 'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn, - 'let pprint-let, 'loop pprint-let, 'binding pprint-let, - 'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let, - 'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let, - 'when-first pprint-let, - 'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if, - 'cond pprint-cond, 'condp pprint-condp, - 'fn* pprint-anon-func, - '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first, - 'locking pprint-hold-first, 'struct pprint-hold-first, - 'struct-map pprint-hold-first, - }))) - -(defn pprint-code-list [alis] - (if-not (pprint-reader-macro alis) - (if-let [special-form (*code-table* (first alis))] - (special-form alis) - (pprint-simple-code-list alis)))) - -(defn pprint-code-symbol [sym] - (if-let [arg-num (sym *symbol-map*)] - (print arg-num) - (if *print-suppress-namespaces* - (print (name sym)) - (pr sym)))) - -(defmulti - *code-dispatch* - "The pretty print dispatch function for pretty printing Clojure code." - {: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.Ref pprint-ref) -(use-method *code-dispatch* clojure.lang.Atom pprint-atom) -(use-method *code-dispatch* clojure.lang.Agent pprint-agent) -(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 - diff --git a/src/main/clojure/clojure/contrib/pprint/pprint_base.clj b/src/main/clojure/clojure/contrib/pprint/pprint_base.clj deleted file mode 100644 index 05d05390..00000000 --- a/src/main/clojure/clojure/contrib/pprint/pprint_base.clj +++ /dev/null @@ -1,342 +0,0 @@ -;;; pprint_base.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Jan 2009. 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. - -;; This module implements the generic pretty print functions and special variables - -(in-ns 'clojure.contrib.pprint) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables that control the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; -;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core -;;; TODO: use *print-dup* here (or is it supplanted by other variables?) -;;; TODO: make dispatch items like "(let..." get counted in *print-length* -;;; constructs - - -(def - ^{ :doc "Bind to true if you want write to use pretty printing"} - *print-pretty* true) - -(defonce ; If folks have added stuff here, don't overwrite - ^{ :doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch -to modify."} - *print-pprint-dispatch* nil) - -(def - ^{ :doc "Pretty printing will try to avoid anything going beyond this column. -Set it to nil to have pprint let the line be arbitrarily long. This will ignore all -non-mandatory newlines."} - *print-right-margin* 72) - -(def - ^{ :doc "The column at which to enter miser style. Depending on the dispatch table, -miser style add newlines in more places to try to keep lines short allowing for further -levels of nesting."} - *print-miser-width* 40) - -;;; TODO implement output limiting -(def - ^{ :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 - ^{ :doc "Mark circular structures (N.B. This is not yet used)"} - *print-circle* nil) - -;;; TODO: should we just use *print-dup* here? -(def - ^{ :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"} - *print-shared* nil) - -(def - ^{ :doc "Don't print namespaces with symbols. This is particularly useful when -pretty printing the results of macro expansions"} - *print-suppress-namespaces* nil) - -;;; TODO: support print-base and print-radix in cl-format -;;; TODO: support print-base and print-radix in rationals -(def - ^{ :doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, -or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the -radix specifier is in the form #XXr where XX is the decimal value of *print-base* "} - *print-radix* nil) - -(def - ^{ :doc "The base to use for printing integers and rationals."} - *print-base* 10) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal variables that keep track of where we are in the -;; structure -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{ :private true } *current-level* 0) - -(def ^{ :private true } *current-length* nil) - -;; TODO: add variables for length, lines. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the write function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-simple-number) - -(def ^{:private true} orig-pr pr) - -(defn- pr-with-base [x] - (if-let [s (format-simple-number x)] - (print s) - (orig-pr x))) - -(def ^{:private true} write-option-table - {;:array *print-array* - :base 'clojure.contrib.pprint/*print-base*, - ;;:case *print-case*, - :circle 'clojure.contrib.pprint/*print-circle*, - ;;:escape *print-escape*, - ;;:gensym *print-gensym*, - :length 'clojure.core/*print-length*, - :level 'clojure.core/*print-level*, - :lines 'clojure.contrib.pprint/*print-lines*, - :miser-width 'clojure.contrib.pprint/*print-miser-width*, - :dispatch 'clojure.contrib.pprint/*print-pprint-dispatch*, - :pretty 'clojure.contrib.pprint/*print-pretty*, - :radix 'clojure.contrib.pprint/*print-radix*, - :readably 'clojure.core/*print-readably*, - :right-margin 'clojure.contrib.pprint/*print-right-margin*, - :suppress-namespaces 'clojure.contrib.pprint/*print-suppress-namespaces*}) - - -(defmacro ^{:private true} binding-map [amap & body] - (let [] - `(do - (. clojure.lang.Var (pushThreadBindings ~amap)) - (try - ~@body - (finally - (. clojure.lang.Var (popThreadBindings))))))) - -(defn- table-ize [t m] - (apply hash-map (mapcat - #(when-let [v (get t (key %))] [(find-var v) (val %)]) - m))) - -(defn- pretty-writer? - "Return true iff x is a PrettyWriter" - [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x))) - -(defn- make-pretty-writer - "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width" - [base-writer right-margin miser-width] - (pretty-writer base-writer right-margin miser-width)) - -(defmacro ^{:private true} with-pretty-writer [base-writer & body] - `(let [base-writer# ~base-writer - new-writer# (not (pretty-writer? base-writer#))] - (binding [*out* (if new-writer# - (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*) - base-writer#)] - ~@body - (.flush *out*)))) - - -;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc. -(defn write-out - "Write an object to *out* subject to the current bindings of the printer control -variables. Use the kw-args argument to override individual variables for this call (and -any recursive calls). - -*out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility -of the caller. - -This method is primarily intended for use by pretty print dispatch functions that -already know that the pretty printer will have set up their environment appropriately. -Normal library clients should use the standard \"write\" interface. " - [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 -" - [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*." - ([object] (pprint object *out*)) - ([object writer] - (with-pretty-writer writer - (binding [*print-pretty* true] - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (write-out object))) - (if (not (= 0 (get-column *out*))) - (.write *out* (int \newline)))))) - -(defmacro pp - "A convenience macro that pretty prints the last thing output. This is -exactly equivalent to (pprint *1)." - [] `(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.contrib.pprint.dispatch.clj." - [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." - [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. - -Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, -and :suffix." - {:arglists '[[options* body]]} - [& args] - (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] - `(do (if (level-exceeded) - (.write ^java.io.Writer *out* "#") - (binding [*current-level* (inc *current-level*) - *current-length* 0] - (start-block *out* - ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) - ~@body - (end-block *out*))) - nil))) - -(defn pprint-newline - "Print a conditional newline to a pretty printing stream. kind specifies if the -newline is :linear, :miser, :fill, or :mandatory. - -Output is sent to *out* which must be a pretty printing writer." - [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. - -Output is sent to *out* which must be a pretty printing writer." - [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. - -Output is sent to *out* which must be a pretty printing writer. - -THIS FUNCTION IS NOT YET IMPLEMENTED." - [kind colnum colinc] - (check-enumerated-arg kind #{:line :section :line-relative :section-relative}) - (throw (UnsupportedOperationException. "pprint-tab is not yet implemented"))) - - -nil diff --git a/src/main/clojure/clojure/contrib/repl_utils/javadoc.clj b/src/main/clojure/clojure/contrib/repl_utils/javadoc.clj deleted file mode 100644 index 2b148066..00000000 --- a/src/main/clojure/clojure/contrib/repl_utils/javadoc.clj +++ /dev/null @@ -1,83 +0,0 @@ -; Copyright (c) Christophe Grand, November 2008. 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. - -; thanks to Stuart Sierra - -; a repl helper to quickly open javadocs. - -(def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:") -(def *feeling-lucky* true) - -(def - ^{:doc "Ref to a list of local paths for Javadoc-generated HTML - files."} - *local-javadocs* (ref (list))) - -(def *core-java-api* - (if (= "1.5" (System/getProperty "java.specification.version")) - "http://java.sun.com/j2se/1.5.0/docs/api/" - "http://java.sun.com/javase/6/docs/api/")) - -(def - ^{:doc "Ref to a map from package name prefixes to URLs for remote - Javadocs."} - *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." - [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." - [package-prefix url] - (dosync (commute *remote-javadocs* assoc package-prefix url))) - -(defn find-javadoc-url - "Searches for a URL for the given class name. Tries - *local-javadocs* first, then *remote-javadocs*. Returns a string." - {:tag String} - [^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*." - [class-or-object] - (let [^Class c (if (instance? Class class-or-object) - class-or-object - (class class-or-object))] - (if-let [url (find-javadoc-url (.getName c))] - (browse-url url) - (println "Could not find Javadoc for" c)))) diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test.clj b/src/test/clojure/clojure/contrib/datalog/tests/test.clj deleted file mode 100644 index 121d264e..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test.clj +++ /dev/null @@ -1,45 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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 -;; -;; A Clojure implementation of Datalog -- Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test - (:use [clojure.test :only (run-tests)]) - (:gen-class)) - -(def test-names [:test-util - :test-database - :test-literals - :test-rules - :test-magic - :test-softstrat]) - -(def test-namespaces - (map #(symbol (str "clojure.contrib.datalog.tests." (name %))) - test-names)) - -(defn run - "Runs all defined tests" - [] - (println "Loading tests...") - (apply require :reload-all test-namespaces) - (apply run-tests test-namespaces)) - -(defn -main - "Run all defined tests from the command line" - [& args] - (run) - (System/exit 0)) - - -;; End of file diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj deleted file mode 100644 index 77719008..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj +++ /dev/null @@ -1,153 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-database.clj -;; -;; A Clojure implementation of Datalog -- Database -;; -;; straszheimjeffrey (gmail) -;; Created 12 Feburary 2009 - - -(ns clojure.contrib.datalog.tests.test-database - (:use clojure.test - clojure.contrib.datalog.database)) - - -(def test-db - (make-database - (relation :fred [:mary :sue]) - (index :fred :mary) - (relation :sally [:jen :becky :joan]) - (index :sally :jen) - (index :sally :becky))) - -(deftest test-make-database - (is (= test-db - (datalog-database - {:sally (datalog-relation - #{:jen :joan :becky} - #{} - {:becky {} - :jen {}}) - :fred (datalog-relation - #{:sue :mary} - #{} - {:mary {}})})))) - - -(deftest test-ensure-relation - (is (contains? (ensure-relation test-db :bob [:sam :george] [:sam]) :bob)) - (is (contains? (ensure-relation test-db :fred [:mary :sue] [:mary]) :fred)) - (is (thrown? AssertionError (ensure-relation test-db :fred [:bob :joe] [])))) - -(deftest test-add-tuple - (let [new-db (add-tuple test-db :fred {:mary 1 :sue 2})] - (is (= (select new-db :fred {:mary 1}) [{:mary 1 :sue 2}]))) - (is (thrown? AssertionError (add-tuple test-db :fred {:mary 1})))) - -(def test-db-1 - (add-tuples test-db - [:fred :mary 1 :sue 2] - [:fred :mary 2 :sue 3] - [:sally :jen 1 :becky 2 :joan 0] - [:sally :jen 1 :becky 4 :joan 3] - [:sally :jen 1 :becky 3 :joan 0] - [:sally :jen 1 :becky 2 :joan 3] - [:fred :mary 1 :sue 1] - [:fred :mary 3 :sue 1])) - -(deftest test-add-tuples - (is (= test-db-1 - (datalog-database - {:sally (datalog-relation - #{:jen :joan :becky} - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 0, :becky 2} - {:jen 1, :joan 3, :becky 2} - {:jen 1, :joan 3, :becky 4}} - {:becky {3 - #{{:jen 1, :joan 0, :becky 3}} - 4 - #{{:jen 1, :joan 3, :becky 4}} - 2 - #{{:jen 1, :joan 0, :becky 2} - {:jen 1, :joan 3, :becky 2}}} - :jen {1 - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 0, :becky 2} - {:jen 1, :joan 3, :becky 2} - {:jen 1, :joan 3, :becky 4}}}}) - :fred (datalog-relation - #{:sue :mary} - #{{:sue 2, :mary 1} - {:sue 1, :mary 1} - {:sue 3, :mary 2} - {:sue 1, :mary 3}} - {:mary {3 - #{{:sue 1, :mary 3}} - 2 - #{{:sue 3, :mary 2}} - 1 - #{{:sue 2, :mary 1} - {:sue 1, :mary 1}}}})})))) - -(deftest test-remove-tuples - (let [db (reduce #(apply remove-tuple %1 (first %2) (next %2)) - test-db-1 - [[:fred {:mary 1 :sue 1}] - [:fred {:mary 3 :sue 1}] - [:sally {:jen 1 :becky 2 :joan 0}] - [:sally {:jen 1 :becky 4 :joan 3}]])] - (is (= db - (datalog-database - {:sally (datalog-relation - #{:jen :joan :becky} - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 3, :becky 2}} - {:becky - {3 - #{{:jen 1, :joan 0, :becky 3}} - 2 - #{{:jen 1, :joan 3, :becky 2}}} - :jen - {1 - #{{:jen 1, :joan 0, :becky 3} - {:jen 1, :joan 3, :becky 2}}}}) - :fred (datalog-relation - #{:sue :mary} - #{{:sue 2, :mary 1} - {:sue 3, :mary 2}} - {:mary - {2 - #{{:sue 3, :mary 2}} - 1 - #{{:sue 2, :mary 1}}}})}))))) - - - -(deftest test-select - (is (= (set (select test-db-1 :sally {:jen 1 :becky 2})) - #{{:jen 1 :joan 0 :becky 2} {:jen 1 :joan 3 :becky 2}})) - (is (= (set (select test-db-1 :fred {:sue 1}))) - #{{:mary 3 :sue 1} {:mary 1 :sue 1}}) - (is (empty? (select test-db-1 :sally {:joan 5 :jen 1})))) - -(deftest test-any-match? - (is (any-match? test-db-1 :fred {:mary 3})) - (is (any-match? test-db-1 :sally {:jen 1 :becky 2 :joan 3})) - (is (not (any-match? test-db-1 :sally {:jen 5}))) - (is (not (any-match? test-db-1 :fred {:mary 1 :sue 5})))) - - -(comment - (run-tests) -) - -;; End of file - diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj deleted file mode 100644 index 36ee5147..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj +++ /dev/null @@ -1,187 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-literals.clj -;; -;; A Clojure implementation of Datalog -- Literals tests -;; -;; straszheimjeffrey (gmail) -;; Created 25 Feburary 2009 - - -(ns clojure.contrib.datalog.tests.test-literals - (:use clojure.test) - (:use clojure.contrib.datalog.literals - clojure.contrib.datalog.database)) - - -(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3)))) -(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3)))) -(def cl (eval (build-literal '(if > ?x 3)))) - -(def bl (eval (build-literal '(:fred)))) - -(def bns {:x '?x :y '?y :z 3}) - -(deftest test-build-literal - (is (= (:predicate pl) :fred)) - (is (= (:term-bindings pl) bns)) - (is (= (:predicate nl) :fred)) - (is (= (:term-bindings nl) bns)) - (is (= (:symbol cl) '>)) - (is (= (:terms cl) '(?x 3))) - (is ((:fun cl) [4 3])) - (is (not ((:fun cl) [2 4]))) - (is (= (:predicate bl) :fred))) - -(deftest test-literal-predicate - (is (= (literal-predicate pl) :fred)) - (is (= (literal-predicate nl) :fred)) - (is (nil? (literal-predicate cl))) - (is (= (literal-predicate bl) :fred))) - -(deftest test-literal-columns - (is (= (literal-columns pl) #{:x :y :z})) - (is (= (literal-columns nl) #{:x :y :z})) - (is (nil? (literal-columns cl))) - (is (empty? (literal-columns bl)))) - -(deftest test-literal-vars - (is (= (literal-vars pl) #{'?x '?y})) - (is (= (literal-vars nl) #{'?x '?y})) - (is (= (literal-vars cl) #{'?x})) - (is (empty? (literal-vars bl)))) - -(deftest test-positive-vars - (is (= (positive-vars pl) (literal-vars pl))) - (is (nil? (positive-vars nl))) - (is (nil? (positive-vars cl))) - (is (empty? (positive-vars bl)))) - -(deftest test-negative-vars - (is (nil? (negative-vars pl))) - (is (= (negative-vars nl) (literal-vars nl))) - (is (= (negative-vars cl) (literal-vars cl))) - (is (empty? (negative-vars bl)))) - -(deftest test-negated? - (is (not (negated? pl))) - (is (negated? nl)) - (is (not (negated? cl)))) - -(deftest test-vs-from-cs - (is (= (get-vs-from-cs pl #{:x}) #{'?x})) - (is (empty? (get-vs-from-cs pl #{:z}))) - (is (= (get-vs-from-cs pl #{:x :r}) #{'?x})) - (is (empty? (get-vs-from-cs pl #{})))) - -(deftest test-cs-from-vs - (is (= (get-cs-from-vs pl #{'?x}) #{:x})) - (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x})) - (is (empty? (get-cs-from-vs pl #{})))) - -(deftest test-literal-appropriate? - (is (not (literal-appropriate? #{} pl))) - (is (literal-appropriate? #{'?x} pl)) - (is (not (literal-appropriate? #{'?x} nl))) - (is (literal-appropriate? #{'?x '?y} nl)) - (is (not (literal-appropriate? #{'?z} cl))) - (is (literal-appropriate? #{'?x} cl))) - -(deftest test-adorned-literal - (is (= (literal-predicate (adorned-literal pl #{:x})) - {:pred :fred :bound #{:x}})) - (is (= (literal-predicate (adorned-literal nl #{:x :y :q})) - {:pred :fred :bound #{:x :y}})) - (is (= (:term-bindings (adorned-literal nl #{:x})) - {:x '?x :y '?y :z 3})) - (is (= (adorned-literal cl #{}) - cl))) - -(deftest test-get-adorned-bindings - (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x}))) - #{:x})) - (is (= (get-adorned-bindings (literal-predicate pl)) - nil))) - -(deftest test-get-base-predicate - (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x}))) - :fred)) - (is (= (get-base-predicate (literal-predicate pl)) - :fred))) - -(deftest test-magic-literal - (is (= (magic-literal pl) - {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal})) - (is (= (magic-literal (adorned-literal pl #{:x})) - {:predicate {:pred :fred :magic true :bound #{:x}}, - :term-bindings {:x '?x}, - :literal-type :clojure.contrib.datalog.literals/literal}))) - -(comment - (use 'clojure.contrib.stacktrace) (e) - (use :reload 'clojure.contrib.datalog.literals) -) - - -(def db1 (make-database - (relation :fred [:x :y]) - (index :fred :x) - (relation :sally [:x]))) - -(def db2 (add-tuples db1 - [:fred :x 1 :y :mary] - [:fred :x 1 :y :becky] - [:fred :x 3 :y :sally] - [:fred :x 4 :y :joe] - [:sally :x 1] - [:sally :x 2])) - -(def lit1 (eval (build-literal '(:fred :x ?x :y ?y)))) -(def lit2 (eval (build-literal '(not! :fred :x ?x)))) -(def lit3 (eval (build-literal '(if > ?x ?y)))) -(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x})) - -(deftest test-join-literal - (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}])) - #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}})) - (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}]) - [{'?x 2}])) - (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}]) - [{'?x 3 '?y 1}]))) - -(deftest test-project-literal - (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}}) - (datalog-relation - ;; Schema - #{:y :x} - - ;; Data - #{ - {:x 1, :y 3} - {:x 4, :y 2} - } - - ;; Indexes - { - :x - { - 4 - #{{:x 4, :y 2}} - 1 - #{{:x 1, :y 3}} - } - })))) - - - -(comment - (run-tests) -) - -;; End of file diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj deleted file mode 100644 index 7eabae78..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj +++ /dev/null @@ -1,72 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-magic.clj -;; -;; A Clojure implementation of Datalog -- Magic Tests -;; -;; straszheimjeffrey (gmail) -;; Created 18 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test-magic - (:use clojure.test) - (:use clojure.contrib.datalog.magic - clojure.contrib.datalog.rules)) - - - -(def rs (rules-set - (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y)) - (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y)) - (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y)) - (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y)))) - -(def q (adorn-query (?- :p :x 1 :y ?y))) - -(def ars (adorn-rules-set rs q)) - -(deftest test-adorn-rules-set - (is (= ars - (rules-set - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x)) - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x) - ({:pred :p :bound #{:x}} :y ?y :x ?z)) - (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x)) - (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x)))))) - - -(def m (magic-transform ars)) - -(deftest test-magic-transform - (is (= m - (rules-set - (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x)) - - (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x)) - - (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) - ({:pred :e :bound #{:x}} :y ?z :x ?x)) - - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - ({:pred :e :bound #{:x}} :y ?z :x ?x) - ({:pred :p :bound #{:x}} :y ?y :x ?z)) - - (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)) - - (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - ({:pred :e :bound #{:x}} :y ?y :x ?x)))))) - - - - -(comment - (run-tests) -) - -;; End of file - diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj deleted file mode 100644 index 8b80b770..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj +++ /dev/null @@ -1,130 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-rules.clj -;; -;; A Clojure implementation of Datalog -- Rule Tests -;; -;; straszheimjeffrey (gmail) -;; Created 12 Feburary 2009 - - -(ns clojure.contrib.datalog.tests.test-rules - (:use clojure.test - clojure.contrib.datalog.rules - clojure.contrib.datalog.literals - clojure.contrib.datalog.database)) - - -(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y))) -(def tr-2 (<- (:fred) (not! :mary :x 3))) -(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y))) - - - -(deftest test-rule-safety - (is (thrown-with-msg? Exception #".*Head vars.*not bound.*" - (<- (:fred :x ?x) (:sally :y ?y)))) - (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" - (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y)))) - (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" - (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y))))) - - -(deftest test-sip - (is (= (compute-sip #{:x} #{:mary :sally} tr-1) - (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) - ({:pred :mary :bound #{:x}} :z ?z :x ?x) - ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) - - (is (= (compute-sip #{} #{:mary :sally} tr-1) - (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) - - (is (= (compute-sip #{} #{:mary} tr-2) - (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3)))) - - (is (= (compute-sip #{} #{} tr-2) - tr-2)) - - (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3)) - (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) - ({:pred :mary :bound #{:x}} :x ?x) - (:sally :y ?y) - (if > ?x ?y)))))) - ; Display rule is used because = does not work on - ; (if > ?x ?y) because it contains a closure - - -(def rs - (rules-set - (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) - (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)) - (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y)))) - -(deftest test-rules-set - (is (= (count rs) 3)) - (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))))) - -(deftest test-predicate-map - (let [pm (predicate-map rs)] - (is (= (pm :path) - #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) - (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))})) - (is (= (-> :edge pm count) 1)))) - - -(def db1 (make-database - (relation :fred [:x :y]) - (index :fred :x) - (relation :sally [:x]) - (relation :ben [:y]))) - -(def db2 (add-tuples db1 - [:fred :x 1 :y :mary] - [:fred :x 1 :y :becky] - [:fred :x 3 :y :sally] - [:fred :x 4 :y :joe] - [:fred :x 4 :y :bob] - [:sally :x 1] - [:sally :x 2] - [:sally :x 3] - [:sally :x 4] - [:ben :y :bob])) - - -(deftest test-apply-rule - (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x) - (:fred :x ?x :y ?y) - (not! :ben :y ?y) - (if not= ?x 3))) - (datalog-database - { - :becky - (datalog-relation - ;; Schema - #{:y} - ;; Data - #{ - {:y :joe} - {:y :mary} - {:y :becky} - } - ;; Indexes - { - }) - })))) - - - - -(comment - (run-tests) -) - -;; End of file - diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj deleted file mode 100644 index a33d8c96..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj +++ /dev/null @@ -1,233 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-softstrat.clj -;; -;; A Clojure implementation of Datalog -- Soft Stratification Tests -;; -;; straszheimjeffrey (gmail) -;; Created 28 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test-softstrat - (:use clojure.test) - (:use clojure.contrib.datalog.softstrat - clojure.contrib.datalog.magic - clojure.contrib.datalog.rules - clojure.contrib.datalog.database) - (:use [clojure.contrib.set :only (subset?)])) - - - -(def rs1 (rules-set - (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z)) - (<- (:q :x ?x) (:d :x ?x)))) - -(def q1 (?- :p :x 1)) - -(def ws (build-soft-strat-work-plan rs1 q1)) - -(deftest test-soft-stratification - (let [soft (:stratification ws) - q (:query ws)] - (is (= q (?- {:pred :p :bound #{:x}} :x 1))) - (is (= (count soft) 4)) - (is (subset? (rules-set - (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x) - (:d :x ?x)) - - (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x))) - (nth soft 0))) - (is (= (nth soft 1) - (rules-set - (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x) - (not! {:pred :q :bound #{:x}} :x ?x))))) - (is (= (nth soft 2) - (rules-set - (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x) - (not! {:pred :q :bound #{:x}} :x ?x) - (not! {:pred :q :bound #{:x}} :x ?y))))) - (is (= (nth soft 3) - (rules-set - (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) - (:b :z ?z :y ?y :x ?x) - (not! {:pred :q :bound #{:x}} :x ?x) - (not! {:pred :q :bound #{:x}} :x ?y) - (not! {:pred :q :bound #{:x}} :x ?z))))))) - - -(def tdb-1 - (make-database - (relation :b [:x :y :z]) - (relation :d [:x]))) - -(def tdb-2 - (add-tuples tdb-1 - [:b :x 1 :y 2 :z 3])) - -(deftest test-tdb-2 - (is (= (evaluate-soft-work-set ws tdb-2 {}) - [{:x 1}]))) - - - -(def tdb-3 - (add-tuples tdb-2 - [:d :x 2] - [:d :x 3])) - -(deftest test-tdb-3 - (is (empty? (evaluate-soft-work-set ws tdb-3 {})))) - - - -;;;;;;;;;;; - - - -(def db-base - (make-database - (relation :employee [:id :name :position]) - (index :employee :name) - - (relation :boss [:employee-id :boss-id]) - (index :boss :employee-id) - - (relation :can-do-job [:position :job]) - (index :can-do-job :position) - - (relation :job-replacement [:job :can-be-done-by]) - - (relation :job-exceptions [:id :job]))) - -(def db - (add-tuples db-base - [:employee :id 1 :name "Bob" :position :boss] - [:employee :id 2 :name "Mary" :position :chief-accountant] - [:employee :id 3 :name "John" :position :accountant] - [:employee :id 4 :name "Sameer" :position :chief-programmer] - [:employee :id 5 :name "Lilian" :position :programmer] - [:employee :id 6 :name "Li" :position :technician] - [:employee :id 7 :name "Fred" :position :sales] - [:employee :id 8 :name "Brenda" :position :sales] - [:employee :id 9 :name "Miki" :position :project-management] - [:employee :id 10 :name "Albert" :position :technician] - - [:boss :employee-id 2 :boss-id 1] - [:boss :employee-id 3 :boss-id 2] - [:boss :employee-id 4 :boss-id 1] - [:boss :employee-id 5 :boss-id 4] - [:boss :employee-id 6 :boss-id 4] - [:boss :employee-id 7 :boss-id 1] - [:boss :employee-id 8 :boss-id 7] - [:boss :employee-id 9 :boss-id 1] - [:boss :employee-id 10 :boss-id 6] - - [:can-do-job :position :boss :job :management] - [:can-do-job :position :accountant :job :accounting] - [:can-do-job :position :chief-accountant :job :accounting] - [:can-do-job :position :programmer :job :programming] - [:can-do-job :position :chief-programmer :job :programming] - [:can-do-job :position :technician :job :server-support] - [:can-do-job :position :sales :job :sales] - [:can-do-job :position :project-management :job :project-management] - - [:job-replacement :job :pc-support :can-be-done-by :server-support] - [:job-replacement :job :pc-support :can-be-done-by :programming] - [:job-replacement :job :payroll :can-be-done-by :accounting] - - [:job-exceptions :id 4 :job :pc-support])) - -(def rules - (rules-set - (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) - (:employee :id ?e-id :name ?x) - (:employee :id ?b-id :name ?y)) - (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) - (:works-for :employee ?z :boss ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) - (:can-do-job :position ?pos :job ?y)) - (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) - (:employee-job* :employee ?x :job ?z)) - (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) - (:employee :name ?x :position ?z) - (if = ?z :boss)) - (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) - (:employee :id ?id :name ?x) - (not! :job-exceptions :id ?id :job ?y)) - (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) - (not! :employee-job :employee ?y :job :pc-support)))) - - -(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x))) -(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name}))) - -(deftest test-ws-1 - (is (= (evaluate-1 "Albert") - #{{:employee "Albert", :boss "Li"} - {:employee "Albert", :boss "Sameer"} - {:employee "Albert", :boss "Bob"}})) - (is (empty? (evaluate-1 "Bob"))) - (is (= (evaluate-1 "John") - #{{:employee "John", :boss "Bob"} - {:employee "John", :boss "Mary"}}))) - - -(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x))) -(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name}))) - -(deftest test-ws-2 - (is (= (evaluate-2 "Albert") - #{{:employee "Albert", :job :pc-support} - {:employee "Albert", :job :server-support}})) - (is (= (evaluate-2 "Sameer") - #{{:employee "Sameer", :job :programming}})) - (is (= (evaluate-2 "Bob") - #{{:employee "Bob", :job :accounting} - {:employee "Bob", :job :management} - {:employee "Bob", :job :payroll} - {:employee "Bob", :job :pc-support} - {:employee "Bob", :job :project-management} - {:employee "Bob", :job :programming} - {:employee "Bob", :job :server-support} - {:employee "Bob", :job :sales}}))) - -(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x))) -(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name}))) - -(deftest test-ws-3 - (is (= (evaluate-3 "Albert") - #{{:name "Albert", :boss "Sameer"}}))) - -(def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x))) - -(deftest test-ws-4 - (is (= (set (evaluate-soft-work-set ws-4 db {})) - #{{:employee "Miki", :boss "Bob"} - {:employee "Albert", :boss "Li"} - {:employee "Lilian", :boss "Sameer"} - {:employee "Li", :boss "Bob"} - {:employee "Lilian", :boss "Bob"} - {:employee "Brenda", :boss "Fred"} - {:employee "Fred", :boss "Bob"} - {:employee "John", :boss "Bob"} - {:employee "John", :boss "Mary"} - {:employee "Albert", :boss "Sameer"} - {:employee "Sameer", :boss "Bob"} - {:employee "Albert", :boss "Bob"} - {:employee "Brenda", :boss "Bob"} - {:employee "Mary", :boss "Bob"} - {:employee "Li", :boss "Sameer"}}))) - -(comment - (run-tests) -) - -;; End of file diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj deleted file mode 100644 index 9a5d0460..00000000 --- a/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj +++ /dev/null @@ -1,69 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-util.clj -;; -;; A Clojure implementation of Datalog -- Utilities Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 Feburary 2009 - -(ns clojure.contrib.datalog.tests.test-util - (:use clojure.test - clojure.contrib.datalog.util) - (:use [clojure.contrib.except :only (throwf)])) - -(deftest test-is-var? - (is (is-var? '?x)) - (is (is-var? '?)) - (is (not (is-var? '??x))) - (is (not (is-var? '??))) - (is (not (is-var? 'x))) - (is (not (is-var? "fred"))) - (is (not (is-var? :q)))) - -(deftest test-map-values - (let [map {:fred 1 :sally 2}] - (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4})) - (is (= (map-values identity {}) {})))) - -(deftest test-keys-to-vals - (let [map {:fred 1 :sally 2 :joey 3}] - (is (= (set (keys-to-vals map [:fred :sally])) #{1 2})) - (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2})) - (is (empty? (keys-to-vals map []))) - (is (empty? (keys-to-vals {} [:fred]))))) - -(deftest test-reverse-map - (let [map {:fred 1 :sally 2 :joey 3} - map-1 (assoc map :mary 3)] - (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey})) - (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey}) - (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary}))))) - -(def some-maps - [ - { :a 1 :b 2 } - { :c 3 :b 3 } - { :d 4 :a 1 } - { :g 4 :b 4 } - { :a 2 :b 1 } - { :e 1 :f 1 } - ]) - -(def reduced (preduce + some-maps)) -(def merged (apply merge-with + some-maps)) - -(deftest test-preduce - (is (= reduced merged))) - -(comment - (run-tests) -) - -; End of file diff --git a/src/test/clojure/clojure/contrib/mock/test_adapter.clj b/src/test/clojure/clojure/contrib/mock/test_adapter.clj deleted file mode 100644 index 5f21ce11..00000000 --- a/src/test/clojure/clojure/contrib/mock/test_adapter.clj +++ /dev/null @@ -1,18 +0,0 @@ -(ns clojure.contrib.test-contrib.mock-test.test-adapter-test - (:use clojure.contrib.mock.test-adapter - [clojure.contrib.test-contrib.mock-test :only (assert-called)] - clojure.test)) - -(deftest test-report-problem-called - (def #^{:private true :dynamic true} fn1 (fn [x] "dummy code")) - (def #^{:private true :dynamic true} fn2 (fn [x y] "dummy code2")) - (let [under-test (fn [x] (fn1 x))] - (assert-called clojure.contrib.mock.test-adapter/report-problem - true (expect [fn1 (times 5)] (under-test "hi"))))) - -(deftest test-is-report-called - (assert-called clojure.test/report true - (clojure.contrib.mock.test-adapter/report-problem - 'fn-name 5 6 "fake problem"))) - - diff --git a/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj b/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj deleted file mode 100644 index 4022e5e3..00000000 --- a/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj +++ /dev/null @@ -1,691 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; This test set tests the basic cl-format functionality - -(ns clojure.contrib.pprint.test-cl-format - (:refer-clojure :exclude [format]) - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.pprint.test-helper - clojure.contrib.pprint)) - -(def format cl-format) - -;; TODO tests for ~A, ~D, etc. -;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding - -(simple-tests d-tests - (cl-format nil "~D" 0) "0" - (cl-format nil "~D" 2e6) "2000000" - (cl-format nil "~D" 2000000) "2000000" - (cl-format nil "~:D" 2000000) "2,000,000" - (cl-format nil "~D" 1/2) "1/2" - (cl-format nil "~D" 'fred) "fred" -) - -(simple-tests base-tests - (cl-format nil "~{~2r~^ ~}~%" (range 10)) - "0 1 10 11 100 101 110 111 1000 1001\n" - (with-out-str - (dotimes [i 35] - (binding [*print-base* (+ i 2)] ;print the decimal number 40 - (write 40) ;in each base from 2 to 36 - (if (zero? (mod i 10)) (prn) (cl-format true " "))))) - "101000 -1111 220 130 104 55 50 44 40 37 34 -31 2c 2a 28 26 24 22 20 1j 1i -1h 1g 1f 1e 1d 1c 1b 1a 19 18 -17 16 15 14 " - (with-out-str - (doseq [pb [2 3 8 10 16]] - (binding [*print-radix* true ;print the integer 10 and - *print-base* pb] ;the ratio 1/10 in bases 2, - (cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16 - "#b1010 #b1/1010 -#3r101 #3r1/101 -#o12 #o1/12 -10. #10r1/10 -#xa #x1/a -") - - - -(simple-tests cardinal-tests - (cl-format nil "~R" 0) "zero" - (cl-format nil "~R" 4) "four" - (cl-format nil "~R" 15) "fifteen" - (cl-format nil "~R" -15) "minus fifteen" - (cl-format nil "~R" 25) "twenty-five" - (cl-format nil "~R" 20) "twenty" - (cl-format nil "~R" 200) "two hundred" - (cl-format nil "~R" 203) "two hundred three" - - (cl-format nil "~R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R = ~:*~:D" 44000032) - "forty-four million, thirty-two = 44,000,032" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - - (cl-format nil "~R = ~:*~:D" 2e6) - "two million = 2,000,000" - - (cl-format nil "~R = ~:*~:D" 200000200000) - "two hundred billion, two hundred thousand = 200,000,200,000") - -(simple-tests ordinal-tests - (cl-format nil "~:R" 0) "zeroth" - (cl-format nil "~:R" 4) "fourth" - (cl-format nil "~:R" 15) "fifteenth" - (cl-format nil "~:R" -15) "minus fifteenth" - (cl-format nil "~:R" 25) "twenty-fifth" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 203) "two hundred third" - - (cl-format nil "~:R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R = ~:*~:D" 44000032) - "forty-four million, thirty-second = 44,000,032" - - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471" - (cl-format nil "~:R = ~:*~:D" 2e6) - "two millionth = 2,000,000") - -(simple-tests ordinal1-tests - (cl-format nil "~:R" 1) "first" - (cl-format nil "~:R" 11) "eleventh" - (cl-format nil "~:R" 21) "twenty-first" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 220) "two hundred twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 999) "nine hundred ninety-ninth" - ) - -(simple-tests roman-tests - (cl-format nil "~@R" 3) "III" - (cl-format nil "~@R" 4) "IV" - (cl-format nil "~@R" 9) "IX" - (cl-format nil "~@R" 29) "XXIX" - (cl-format nil "~@R" 429) "CDXXIX" - (cl-format nil "~@:R" 429) "CCCCXXVIIII" - (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII" - (cl-format nil "~@R" 3429) "MMMCDXXIX" - (cl-format nil "~@R" 3479) "MMMCDLXXIX" - (cl-format nil "~@R" 3409) "MMMCDIX" - (cl-format nil "~@R" 300) "CCC" - (cl-format nil "~@R ~D" 300 20) "CCC 20" - (cl-format nil "~@R" 5000) "5,000" - (cl-format nil "~@R ~D" 5000 20) "5,000 20" - (cl-format nil "~@R" "the quick") "the quick") - -(simple-tests c-tests - (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~@C~%" \m) "\\m\n" - (cl-format nil "~@C~%" (char 222)) "\\Þ\n" - (cl-format nil "~@C~%" (char 8)) "\\backspace\n" - (cl-format nil "~@C~%" (char 3)) "\\\n") - -(simple-tests e-tests - (cl-format nil "*~E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*" - (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*" - (cl-format nil "*~5E*" 0.0) "*0.E+0*" - (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*" - (cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*" - (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*" - ) - -(simple-tests $-tests - (cl-format nil "~$" 22.3) "22.30" - (cl-format nil "~$" 22.375) "22.38" - (cl-format nil "~3,5$" 22.375) "00022.375" - (cl-format nil "~3,5,8$" 22.375) "00022.375" - (cl-format nil "~3,5,10$" 22.375) " 00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375" - (cl-format nil "~3,,14@:$" 0.375) "+ 0.375" - (cl-format nil "~1,1$" -12.0) "-12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1@$" 12.0) "+12.0" - (cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0" - (cl-format nil "~1,1,8,' @$" 12.0) " +12.0" - (cl-format nil "~1,1,8,' :$" 12.0) " 12.0" - (cl-format nil "~1,1,8,' $" 12.0) " 12.0" - (cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' @$" -12.0) " -12.0" - (cl-format nil "~1,1,8,' :$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' $" -12.0) " -12.0" - (cl-format nil "~1,1$" 0.001) "0.0" - (cl-format nil "~2,1$" 0.001) "0.00" - (cl-format nil "~1,1,6$" 0.001) " 0.0" - (cl-format nil "~1,1,6$" 0.0015) " 0.0" - (cl-format nil "~2,1,6$" 0.005) " 0.01" - (cl-format nil "~2,1,6$" 0.01) " 0.01" - (cl-format nil "~$" 0.099) "0.10" - (cl-format nil "~1$" 0.099) "0.1" - (cl-format nil "~1$" 0.1) "0.1" - (cl-format nil "~1$" 0.99) "1.0" - (cl-format nil "~1$" -0.99) "-1.0") - -(simple-tests f-tests - (cl-format nil "~,1f" -12.0) "-12.0" - (cl-format nil "~,0f" 9.4) "9." - (cl-format nil "~,0f" 9.5) "10." - (cl-format nil "~,0f" -0.99) "-1." - (cl-format nil "~,1f" -0.99) "-1.0" - (cl-format nil "~,2f" -0.99) "-0.99" - (cl-format nil "~,3f" -0.99) "-0.990" - (cl-format nil "~,0f" 0.99) "1." - (cl-format nil "~,1f" 0.99) "1.0" - (cl-format nil "~,2f" 0.99) "0.99" - (cl-format nil "~,3f" 0.99) "0.990" - (cl-format nil "~f" -1) "-1.0" - (cl-format nil "~2f" -1) "-1." - (cl-format nil "~3f" -1) "-1." - (cl-format nil "~4f" -1) "-1.0" - (cl-format nil "~8f" -1) " -1.0" - (cl-format nil "~1,1f" 0.1) ".1") - -(simple-tests ampersand-tests - (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown elephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10) - "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n") - -(simple-tests t-tests - (cl-format nil "~@{~&~A~8,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" -) - -(simple-tests paren-tests - (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here" - (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here" - (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT" - (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!" - ;; Test cases from CLtL 18.3 - string-upcase, et al. - (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" - (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" - (cl-format nil "~:(~A~)" " hello ") " Hello " - (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") - "Occluded Casements Forestall Inadvertent Defenestration" - (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" - (cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!" - (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c" -) - -(simple-tests square-bracket-tests - ;; Tests for format without modifiers - (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n" - - ;; Tests for format with a colon - (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n" - - ;; Tests for format with an at sign - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n" - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17) - "We had 15 wins (out of 17 tries).\n" - - ;; Format tests with directives - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7) - "Max 15: Blue team 7.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12) - "Max 15: Red team 12.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" - 15, -1, "(system failure)") - "Max 15: No team (system failure).\n" - - ;; Nested format tests - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, true) - "Max 15: Blue team 7 (complete success).\n" - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, false) - "Max 15: Blue team 7.\n" - - ;; Test the selector as part of the argument - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].") - "The answer is nothing." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4) - "The answer is 4." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22) - "The answer is 7 out of 22." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4) - "The answer is something crazy." -) - -(simple-tests curly-brace-plain-tests - ;; Iteration from sublist - (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - - -(simple-tests curly-brace-colon-tests - ;; Iteration from list of sublists - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - -(simple-tests curly-brace-at-tests - ;; Iteration from main list - (cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -(simple-tests curly-brace-colon-at-tests - ;; Iteration from sublists on the main arg list - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -;; TODO tests for ~^ in ~[ constructs and other brackets -;; TODO test ~:^ generates an error when used improperly -;; TODO test ~:^ works in ~@:{...~} -(let [aseq '(a quick brown fox jumped over the lazy dog) - lseq (mapcat identity (for [x aseq] [x (.length (name x))]))] - (simple-tests up-tests - (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog" - (cl-format nil "~{~a~0^, ~}" aseq) "a" - (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over" - (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox" - (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox" -)) - -(simple-tests angle-bracket-tests - (cl-format nil "~<foo~;bar~;baz~>") "foobarbaz" - (cl-format nil "~20<foo~;bar~;baz~>") "foo bar baz" - (cl-format nil "~,,2<foo~;bar~;baz~>") "foo bar baz" - (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz" - (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz " - (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz " - (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar" - (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo " - (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo" -) - -(simple-tests angle-bracket-max-column-tests - (cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s"))) - "\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n" -(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s")))) - -(defn list-to-table [aseq column-width] - (let [stream (get-pretty-writer (java.io.StringWriter.))] - (binding [*out* stream] - (doseq [row aseq] - (doseq [col row] - (cl-format true "~4D~7,vT" col column-width)) - (prn))) - (.flush stream) - (.toString (:base @@(:base @@stream))))) - -(simple-tests column-writer-test - (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8) - " 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following tests are the various examples from the format -;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn expt [base pow] (reduce * (repeat pow base))) - -(let [x 5, y "elephant", n 3] - (simple-tests cltl-intro-tests - (format nil "foo") "foo" - (format nil "The answer is ~D." x) "The answer is 5." - (format nil "The answer is ~3D." x) "The answer is 5." - (format nil "The answer is ~3,'0D." x) "The answer is 005." - (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007." - (format nil "Look at the ~A!" y) "Look at the elephant!" - (format nil "Type ~:C to ~A." (char 4) "delete all your files") - "Type Control-D to delete all your files." - (format nil "~D item~:P found." n) "3 items found." - (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here." - (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here." - (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies.")) - -(simple-tests cltl-B-tests - ;; CLtL didn't have the colons here, but the spec requires them - (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" - (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - ;; This one was a nice idea, but nothing in the spec supports it working this way - ;; (and SBCL doesn't work this way either) - ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110") - ) - -(simple-tests cltl-P-tests - (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" - (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" - (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins") - -(defn foo [x] - (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" - x x x x x x)) - -(simple-tests cltl-F-tests - (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" - (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" - (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0" - (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0" - (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006") - -(defn foo-e [x] - (format nil - "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-E-tests - (foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one - (foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" - (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" - (foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" -; In Clojure, this is identical to the above -; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" - (foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13" - (foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120" -; Clojure doesn't support real numbers this large -; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200" -) - -(simple-tests cltl-E-scale-tests - (map - (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" - (- k 5) 3.14159)) ;Prints 13 lines - (range 13)) - '("Scale factor -5: | 0.000003E+06|" - "Scale factor -4: | 0.000031E+05|" - "Scale factor -3: | 0.000314E+04|" - "Scale factor -2: | 0.003142E+03|" - "Scale factor -1: | 0.031416E+02|" - "Scale factor 0: | 0.314159E+01|" - "Scale factor 1: | 3.141590E+00|" - "Scale factor 2: | 31.41590E-01|" - "Scale factor 3: | 314.1590E-02|" - "Scale factor 4: | 3141.590E-03|" - "Scale factor 5: | 31415.90E-04|" - "Scale factor 6: | 314159.0E-05|" - "Scale factor 7: | 3141590.E-06|")) - -(defn foo-g [x] - (format nil - "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-G-tests - (foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" - (foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 " - (foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 " - (foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. " - (foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2" - (foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" -; In Clojure, this is identical to the above -; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" - (foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12" - (foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120" -; Clojure doesn't support real numbers this large -; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200" -) - -(defn type-clash-error [fun nargs argnum right-type wrong-type] - (format nil ;; CLtL has this format string slightly wrong - "~&Function ~S requires its ~:[~:R ~;~*~]~ - argument to be of type ~S,~%but it was called ~ - with an argument of type ~S.~%" - fun (= nargs 1) argnum right-type wrong-type)) - -(simple-tests cltl-Newline-tests - (type-clash-error 'aref nil 2 'integer 'vector) -"Function aref requires its second argument to be of type integer, -but it was called with an argument of type vector.\n" - (type-clash-error 'car 1 1 'list 'short-float) -"Function car requires its argument to be of type list, -but it was called with an argument of type short-float.\n") - -(simple-tests cltl-?-tests - (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) "<Foo 5> 7" - (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) "<Foo 5> 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) "<Foo 5> 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) "<Foo 5> 14") - -(defn f [n] (format nil "~@(~R~) error~:P detected." n)) - -(simple-tests cltl-paren-tests - (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" - (f 0) "Zero errors detected." - (f 1) "One error detected." - (f 23) "Twenty-three errors detected.") - -(let [*print-level* nil *print-length* 5] - (simple-tests cltl-bracket-tests - (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" - *print-level* *print-length*) - " print length = 5")) - -(let [foo "Items:~#[ none~; ~S~; ~S and ~S~ - ~:;~@{~#[~; and~] ~ - ~S~^,~}~]."] - (simple-tests cltl-bracket1-tests - (format nil foo) "Items: none." - (format nil foo 'foo) "Items: foo." - (format nil foo 'foo 'bar) "Items: foo and bar." - (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." - (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")) - -(simple-tests cltl-curly-bracket-tests - (format nil - "The winners are:~{ ~S~}." - '(fred harry jill)) - "The winners are: fred harry jill." - - (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) - "Pairs: <a,1> <b,2> <c,3>." - - (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) - "Pairs: <a,1> <b,2> <c,3>." - - (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) - "Pairs: <a,1> <b,2> <c,3>." - - (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) - "Pairs: <a,1> <b,2> <c,3>.") - -(simple-tests cltl-angle-bracket-tests - (format nil "~10<foo~;bar~>") "foo bar" - (format nil "~10:<foo~;bar~>") " foo bar" - (format nil "~10:@<foo~;bar~>") " foo bar " - (format nil "~10<foobar~>") " foobar" - (format nil "~10:<foobar~>") " foobar" - (format nil "~10@<foobar~>") "foobar " - (format nil "~10:@<foobar~>") " foobar ") - -(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P." - tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here - - (simple-tests cltl-up-tests - (format nil donestr) "Done." - (format nil donestr 3) "Done. 3 warnings." - (format nil donestr 1 5) "Done. 1 warning. 5 errors." - (format nil tellstr 23) "Twenty-three." - (format nil tellstr nil "losers") "Losers." - (format nil tellstr 23 "losers") "Twenty-three losers." - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) - " foo" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) - "foo bar" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) - "foo bar baz")) - -(simple-tests cltl-up-x3j13-tests - (format nil - "~:{/~S~^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger/ice .../french ..." - (format nil - "~:{/~S~:^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger .../ice .../french" - - (format nil - "~:{/~S~#:^ ...~}" ;; This is wrong in CLtL - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger") - diff --git a/src/test/clojure/clojure/contrib/pprint/test_helper.clj b/src/test/clojure/clojure/contrib/pprint/test_helper.clj deleted file mode 100644 index 9a36bbbe..00000000 --- a/src/test/clojure/clojure/contrib/pprint/test_helper.clj +++ /dev/null @@ -1,21 +0,0 @@ -;;; helper.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, April 2009. 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. - -;; This is just a macro to make my tests a little cleaner - -(ns clojure.contrib.pprint.test-helper - (:use [clojure.test :only (deftest are run-tests)])) - -(defmacro simple-tests [name & test-pairs] - `(deftest ~name (are [x y] (= x y) ~@test-pairs))) - diff --git a/src/test/clojure/clojure/contrib/pprint/test_pretty.clj b/src/test/clojure/clojure/contrib/pprint/test_pretty.clj deleted file mode 100644 index f5de6f1e..00000000 --- a/src/test/clojure/clojure/contrib/pprint/test_pretty.clj +++ /dev/null @@ -1,127 +0,0 @@ -;;; pretty.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. 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.contrib.pprint.test-pretty - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.pprint.test-helper - clojure.contrib.pprint)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Unit tests for the pretty printer -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(simple-tests xp-fill-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 38 - *print-miser-width* nil] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 22] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n") - -(simple-tests xp-miser-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 9] - (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third))) - "(LIST\n first\n second\n third)" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 8] - (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third))) - "(LIST first second third)") - -(simple-tests mandatory-fill-test - (cl-format nil - "<pre>~%~<Usage: ~:I~@{*~a*~^~:@_~}~:>~%</pre>~%" - [ "hello" "gooodbye" ]) - "<pre> -Usage: *hello* - *gooodbye* -</pre> -") - -(simple-tests prefix-suffix-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 10] - (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third))) - "{LIST\n first\n second\n third}") - -(simple-tests pprint-test - (binding [*print-pprint-dispatch* *simple-dispatch*] - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn - foo - [x y] - (let - [result (* x y)] - (if - (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (with-pprint-dispatch *code-dispatch* - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 15] - (write '(fn (cons (car x) (cdr y))) :stream nil)) - "(fn\n (cons\n (car x)\n (cdr y)))" - - (with-pprint-dispatch *code-dispatch* - (binding [*print-right-margin* 52] - (write - '(add-to-buffer this (make-buffer-blob (str (char c)) nil)) - :stream nil))) - "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))" - ) - - - -(simple-tests pprint-reader-macro-test - (with-pprint-dispatch *code-dispatch* - (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])") - :stream nil)) - "(map #(first %) [[1 2 3] [4 5 6] [7]])" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "@@(ref (ref 1))") - :stream nil)) - "@@(ref (ref 1))" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "'foo") - :stream nil)) - "'foo" -) diff --git a/src/test/clojure/clojure/contrib/test_complex_numbers.clj b/src/test/clojure/clojure/contrib/test_complex_numbers.clj deleted file mode 100644 index 008e6ec7..00000000 --- a/src/test/clojure/clojure/contrib/test_complex_numbers.clj +++ /dev/null @@ -1,313 +0,0 @@ -;; Test routines for complex-numbers.clj - -;; by Konrad Hinsen -;; last updated April 2, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. 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.contrib.test-complex-numbers - (:refer-clojure :exclude [+ - * / = < > <= >=]) - (:use [clojure.test - :only (deftest is are run-tests)] - [clojure.contrib.generic.arithmetic - :only (+ - * /)] - [clojure.contrib.generic.comparison - :only (= < > <= >=)] - [clojure.contrib.generic.math-functions - :only (abs approx= conjugate exp sqr sqrt)] - [clojure.contrib.complex-numbers - :only (complex imaginary real imag)])) - -(deftest complex-addition - (is (= (+ (complex 1 2) (complex 1 2)) (complex 2 4))) - (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5))) - (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5))) - (is (= (+ (complex 1 2) 3) (complex 4 2))) - (is (= (+ 3 (complex 1 2)) (complex 4 2))) - (is (= (+ (complex 1 2) -1) (imaginary 2))) - (is (= (+ -1 (complex 1 2)) (imaginary 2))) - (is (= (+ (complex 1 2) (imaginary -2)) 1)) - (is (= (+ (imaginary -2) (complex 1 2)) 1)) - (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7))) - (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7))) - (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5))) - (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5))) - (is (= (+ (complex -3 -7) (complex -3 -7)) (complex -6 -14))) - (is (= (+ (complex -3 -7) 3) (imaginary -7))) - (is (= (+ 3 (complex -3 -7)) (imaginary -7))) - (is (= (+ (complex -3 -7) -1) (complex -4 -7))) - (is (= (+ -1 (complex -3 -7)) (complex -4 -7))) - (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9))) - (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9))) - (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2))) - (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2))) - (is (= (+ 3 (complex 1 2)) (complex 4 2))) - (is (= (+ (complex 1 2) 3) (complex 4 2))) - (is (= (+ 3 (complex -3 -7)) (imaginary -7))) - (is (= (+ (complex -3 -7) 3) (imaginary -7))) - (is (= (+ 3 (imaginary -2)) (complex 3 -2))) - (is (= (+ (imaginary -2) 3) (complex 3 -2))) - (is (= (+ 3 (imaginary 5)) (complex 3 5))) - (is (= (+ (imaginary 5) 3) (complex 3 5))) - (is (= (+ -1 (complex 1 2)) (imaginary 2))) - (is (= (+ (complex 1 2) -1) (imaginary 2))) - (is (= (+ -1 (complex -3 -7)) (complex -4 -7))) - (is (= (+ (complex -3 -7) -1) (complex -4 -7))) - (is (= (+ -1 (imaginary -2)) (complex -1 -2))) - (is (= (+ (imaginary -2) -1) (complex -1 -2))) - (is (= (+ -1 (imaginary 5)) (complex -1 5))) - (is (= (+ (imaginary 5) -1) (complex -1 5))) - (is (= (+ (imaginary -2) (complex 1 2)) 1)) - (is (= (+ (complex 1 2) (imaginary -2)) 1)) - (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9))) - (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9))) - (is (= (+ (imaginary -2) 3) (complex 3 -2))) - (is (= (+ 3 (imaginary -2)) (complex 3 -2))) - (is (= (+ (imaginary -2) -1) (complex -1 -2))) - (is (= (+ -1 (imaginary -2)) (complex -1 -2))) - (is (= (+ (imaginary -2) (imaginary -2)) (imaginary -4))) - (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3))) - (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3))) - (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7))) - (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7))) - (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2))) - (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2))) - (is (= (+ (imaginary 5) 3) (complex 3 5))) - (is (= (+ 3 (imaginary 5)) (complex 3 5))) - (is (= (+ (imaginary 5) -1) (complex -1 5))) - (is (= (+ -1 (imaginary 5)) (complex -1 5))) - (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3))) - (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3))) - (is (= (+ (imaginary 5) (imaginary 5)) (imaginary 10)))) - -(deftest complex-subtraction - (is (= (- (complex 1 2) (complex 1 2)) 0)) - (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9))) - (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9))) - (is (= (- (complex 1 2) 3) (complex -2 2))) - (is (= (- 3 (complex 1 2)) (complex 2 -2))) - (is (= (- (complex 1 2) -1) (complex 2 2))) - (is (= (- -1 (complex 1 2)) (complex -2 -2))) - (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4))) - (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4))) - (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3))) - (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3))) - (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9))) - (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9))) - (is (= (- (complex -3 -7) (complex -3 -7)) 0)) - (is (= (- (complex -3 -7) 3) (complex -6 -7))) - (is (= (- 3 (complex -3 -7)) (complex 6 7))) - (is (= (- (complex -3 -7) -1) (complex -2 -7))) - (is (= (- -1 (complex -3 -7)) (complex 2 7))) - (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5))) - (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5))) - (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12))) - (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12))) - (is (= (- 3 (complex 1 2)) (complex 2 -2))) - (is (= (- (complex 1 2) 3) (complex -2 2))) - (is (= (- 3 (complex -3 -7)) (complex 6 7))) - (is (= (- (complex -3 -7) 3) (complex -6 -7))) - (is (= (- 3 (imaginary -2)) (complex 3 2))) - (is (= (- (imaginary -2) 3) (complex -3 -2))) - (is (= (- 3 (imaginary 5)) (complex 3 -5))) - (is (= (- (imaginary 5) 3) (complex -3 5))) - (is (= (- -1 (complex 1 2)) (complex -2 -2))) - (is (= (- (complex 1 2) -1) (complex 2 2))) - (is (= (- -1 (complex -3 -7)) (complex 2 7))) - (is (= (- (complex -3 -7) -1) (complex -2 -7))) - (is (= (- -1 (imaginary -2)) (complex -1 2))) - (is (= (- (imaginary -2) -1) (complex 1 -2))) - (is (= (- -1 (imaginary 5)) (complex -1 -5))) - (is (= (- (imaginary 5) -1) (complex 1 5))) - (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4))) - (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4))) - (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5))) - (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5))) - (is (= (- (imaginary -2) 3) (complex -3 -2))) - (is (= (- 3 (imaginary -2)) (complex 3 2))) - (is (= (- (imaginary -2) -1) (complex 1 -2))) - (is (= (- -1 (imaginary -2)) (complex -1 2))) - (is (= (- (imaginary -2) (imaginary -2)) 0)) - (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7))) - (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7))) - (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3))) - (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3))) - (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12))) - (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12))) - (is (= (- (imaginary 5) 3) (complex -3 5))) - (is (= (- 3 (imaginary 5)) (complex 3 -5))) - (is (= (- (imaginary 5) -1) (complex 1 5))) - (is (= (- -1 (imaginary 5)) (complex -1 -5))) - (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7))) - (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7))) - (is (= (- (imaginary 5) (imaginary 5)) 0))) - -(deftest complex-multiplication - (is (= (* (complex 1 2) (complex 1 2)) (complex -3 4))) - (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13))) - (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13))) - (is (= (* (complex 1 2) 3) (complex 3 6))) - (is (= (* 3 (complex 1 2)) (complex 3 6))) - (is (= (* (complex 1 2) -1) (complex -1 -2))) - (is (= (* -1 (complex 1 2)) (complex -1 -2))) - (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2))) - (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2))) - (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5))) - (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5))) - (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13))) - (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13))) - (is (= (* (complex -3 -7) (complex -3 -7)) (complex -40 42))) - (is (= (* (complex -3 -7) 3) (complex -9 -21))) - (is (= (* 3 (complex -3 -7)) (complex -9 -21))) - (is (= (* (complex -3 -7) -1) (complex 3 7))) - (is (= (* -1 (complex -3 -7)) (complex 3 7))) - (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6))) - (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6))) - (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15))) - (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15))) - (is (= (* 3 (complex 1 2)) (complex 3 6))) - (is (= (* (complex 1 2) 3) (complex 3 6))) - (is (= (* 3 (complex -3 -7)) (complex -9 -21))) - (is (= (* (complex -3 -7) 3) (complex -9 -21))) - (is (= (* 3 (imaginary -2)) (imaginary -6))) - (is (= (* (imaginary -2) 3) (imaginary -6))) - (is (= (* 3 (imaginary 5)) (imaginary 15))) - (is (= (* (imaginary 5) 3) (imaginary 15))) - (is (= (* -1 (complex 1 2)) (complex -1 -2))) - (is (= (* (complex 1 2) -1) (complex -1 -2))) - (is (= (* -1 (complex -3 -7)) (complex 3 7))) - (is (= (* (complex -3 -7) -1) (complex 3 7))) - (is (= (* -1 (imaginary -2)) (imaginary 2))) - (is (= (* (imaginary -2) -1) (imaginary 2))) - (is (= (* -1 (imaginary 5)) (imaginary -5))) - (is (= (* (imaginary 5) -1) (imaginary -5))) - (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2))) - (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2))) - (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6))) - (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6))) - (is (= (* (imaginary -2) 3) (imaginary -6))) - (is (= (* 3 (imaginary -2)) (imaginary -6))) - (is (= (* (imaginary -2) -1) (imaginary 2))) - (is (= (* -1 (imaginary -2)) (imaginary 2))) - (is (= (* (imaginary -2) (imaginary -2)) -4)) - (is (= (* (imaginary -2) (imaginary 5)) 10)) - (is (= (* (imaginary 5) (imaginary -2)) 10)) - (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5))) - (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5))) - (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15))) - (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15))) - (is (= (* (imaginary 5) 3) (imaginary 15))) - (is (= (* 3 (imaginary 5)) (imaginary 15))) - (is (= (* (imaginary 5) -1) (imaginary -5))) - (is (= (* -1 (imaginary 5)) (imaginary -5))) - (is (= (* (imaginary 5) (imaginary -2)) 10)) - (is (= (* (imaginary -2) (imaginary 5)) 10)) - (is (= (* (imaginary 5) (imaginary 5)) -25))) - -(deftest complex-division - (is (= (/ (complex 1 2) (complex 1 2)) 1)) - (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58))) - (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5))) - (is (= (/ (complex 1 2) 3) (complex 1/3 2/3))) - (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5))) - (is (= (/ (complex 1 2) -1) (complex -1 -2))) - (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5))) - (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2))) - (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5))) - (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5))) - (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1))) - (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5))) - (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58))) - (is (= (/ (complex -3 -7) (complex -3 -7)) 1)) - (is (= (/ (complex -3 -7) 3) (complex -1 -7/3))) - (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58))) - (is (= (/ (complex -3 -7) -1) (complex 3 7))) - (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58))) - (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2))) - (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29))) - (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5))) - (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58))) - (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5))) - (is (= (/ (complex 1 2) 3) (complex 1/3 2/3))) - (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58))) - (is (= (/ (complex -3 -7) 3) (complex -1 -7/3))) - #_(is (= (/ 3 (imaginary -2)) (imaginary 1.5))) - (is (= (/ (imaginary -2) 3) (imaginary -2/3))) - (is (= (/ 3 (imaginary 5)) (imaginary -3/5))) - (is (= (/ (imaginary 5) 3) (imaginary 5/3))) - (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5))) - (is (= (/ (complex 1 2) -1) (complex -1 -2))) - (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58))) - (is (= (/ (complex -3 -7) -1) (complex 3 7))) - (is (= (/ -1 (imaginary -2)) (imaginary -1/2))) - (is (= (/ (imaginary -2) -1) (imaginary 2))) - (is (= (/ -1 (imaginary 5)) (imaginary 1/5))) - (is (= (/ (imaginary 5) -1) (imaginary -5))) - (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5))) - (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2))) - (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29))) - (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2))) - (is (= (/ (imaginary -2) 3) (imaginary -2/3))) - (is (= (/ 3 (imaginary -2)) (imaginary 3/2))) - (is (= (/ (imaginary -2) -1) (imaginary 2))) - (is (= (/ -1 (imaginary -2)) (imaginary -1/2))) - (is (= (/ (imaginary -2) (imaginary -2)) 1)) - (is (= (/ (imaginary -2) (imaginary 5)) -2/5)) - (is (= (/ (imaginary 5) (imaginary -2)) -5/2)) - (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1))) - (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5))) - (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58))) - (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5))) - (is (= (/ (imaginary 5) 3) (imaginary 5/3))) - (is (= (/ 3 (imaginary 5)) (imaginary -3/5))) - (is (= (/ (imaginary 5) -1) (imaginary -5))) - (is (= (/ -1 (imaginary 5)) (imaginary 1/5))) - (is (= (/ (imaginary 5) (imaginary -2)) -5/2)) - (is (= (/ (imaginary -2) (imaginary 5)) -2/5)) - (is (= (/ (imaginary 5) (imaginary 5)) 1))) - -(deftest complex-conjugate - (is (= (conjugate (complex 1 2)) (complex 1 -2))) - (is (= (conjugate (complex -3 -7)) (complex -3 7))) - (is (= (conjugate (imaginary -2)) (imaginary 2))) - (is (= (conjugate (imaginary 5)) (imaginary -5)))) - -(deftest complex-abs - (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2) - (complex -3 -7) (imaginary -2) (imaginary 5)]] - (is (approx= (* c (conjugate c)) - (sqr (abs c)) - 1e-14)))) - -(deftest complex-sqrt - (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2) - (complex -3 -7) (imaginary -2) (imaginary 5)]] - (let [r (sqrt c)] - (is (approx= c (sqr r) 1e-14)) - (is (>= (real r) 0))))) - -(deftest complex-exp - (is (approx= (exp (complex 1 2)) - (complex -1.1312043837568135 2.4717266720048188) - 1e-14)) - (is (approx= (exp (complex 2 3)) - (complex -7.3151100949011028 1.0427436562359045) - 1e-14)) - (is (approx= (exp (complex 4 -2)) - (complex -22.720847417619233 -49.645957334580565) - 1e-14)) - (is (approx= (exp (complex 3 -7)) - (complex 15.142531566086868 -13.195928586605717) - 1e-14)) - (is (approx= (exp (imaginary -2)) - (complex -0.41614683654714241 -0.90929742682568171) - 1e-14)) - (is (approx= (exp (imaginary 5)) - (complex 0.2836621854632263 -0.95892427466313845) - 1e-14))) diff --git a/src/test/clojure/clojure/contrib/test_core.clj b/src/test/clojure/clojure/contrib/test_core.clj deleted file mode 100644 index 3048778c..00000000 --- a/src/test/clojure/clojure/contrib/test_core.clj +++ /dev/null @@ -1,42 +0,0 @@ -; Copyright (c) Laurent Petit, March 2009. 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 namespace for clojure.contrib.core - -;; note to other contrib members: feel free to add to this lib - -(ns clojure.contrib.test-core - (:use clojure.test) - (:use clojure.contrib.core)) - -(deftest test-classic-versions - (testing "Classic -> throws NPE if passed nil" - (is (thrown? NullPointerException (-> nil .toString))) - (is (thrown? NullPointerException (-> "foo" seq next next next .toString)))) - (testing "Classic .. throws NPE if one of the intermediate threaded values is nil" - (is (thrown? NullPointerException (.. nil toString))) - (is (thrown? NullPointerException (.. [nil] (get 0) toString))))) - -(deftest test-new-versions - (testing "Version -?>> falls out on nil" - (is (nil? (-?>> nil .toString))) - (is (nil? (-?>> [] seq (map inc)))) - (is (= [] (->> [] seq (map inc))))) - (testing "Version -?>> completes for non-nil" - (is (= [3 4] (-?>> [1 2] (map inc) (map inc))))) - (testing "Version -?> falls out on nil" - (is (nil? (-?> nil .toString))) - (is (nil? (-?> "foo" seq next next next .toString)))) - (testing "Version -?> completes for non-nil" - (is (= [\O \O] (-?> "foo" .toUpperCase rest)))) - (testing "Version .?. returns nil if one of the intermediate threaded values is nil" - (is (nil? (.?. nil toString))) - (is (nil? (.?. [nil] (get 0) toString))))) - diff --git a/src/test/clojure/clojure/contrib/test_dataflow.clj b/src/test/clojure/clojure/contrib/test_dataflow.clj deleted file mode 100644 index 55e9592b..00000000 --- a/src/test/clojure/clojure/contrib/test_dataflow.clj +++ /dev/null @@ -1,90 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-dataflow -;; -;; A Library to Support a Dataflow Model of State - Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 March 2009 - - -(ns clojure.contrib.test-dataflow - (:use clojure.test) - (:use clojure.contrib.dataflow)) - -(def df-1 - (build-dataflow - [(cell :source base 0) - (cell :source items ()) - (cell product (* ?base (apply + ?items))) - (cell :validator (when (number? ?-product) - (assert (>= ?product ?-product))))])) - -(deftest test-df-1 - (is (= (get-value df-1 'product) 0)) - (is (do (update-values df-1 {'items [4 5]}) - (= (get-value df-1 'product) 0))) - (is (do (update-values df-1 {'base 2}) - (= (get-value df-1 'product) 18))) - (is (thrown? AssertionError (update-values df-1 {'base 0}))) - (is (= (get-value df-1 'product) 18))) - -(def df-2 - (build-dataflow - [(cell :source strength 10) - (cell :source agility 10) - (cell :source magic 10) - - (cell total-cost (apply + ?*cost)) - - (cell cost (- ?strength 10)) - (cell cost (- ?agility 10)) - (cell cost (- ?magic 10)) - - (cell combat (+ ?strength ?agility ?combat-mod)) - (cell speed (+ ?agility (/ ?strength 10.0) ?speed-mod)) - (cell casting (+ ?agility ?magic ?magic-mod)) - - (cell combat-mod (apply + ?*combat-mods)) - (cell speed-mod (apply + ?*speed-mods)) - (cell magic-mod (apply + ?*magic-mods))])) - -(def magic-skill - [(cell cost 5) - (cell speed-mods 1) - (cell magic-mods 2)]) - -(defn gv [n] (get-value df-2 n)) - -(deftest test-df-2 - (is (and (= (gv 'total-cost) 0) - (= (gv 'strength) 10) - (= (gv 'casting) 20))) - (is (do (update-values df-2 {'magic 12}) - (and (= (gv 'total-cost) 2) - (= (gv 'casting) 22)))) - (is (do (add-cells df-2 magic-skill) - (and (= (gv 'total-cost) 7) - (= (gv 'casting) 24)))) - (is (do (remove-cells df-2 magic-skill) - (and (= (gv 'total-cost) 2) - (= (gv 'casting) 22))))) - - -(comment - (run-tests) - - (use :reload 'clojure.contrib.dataflow) - (use 'clojure.contrib.stacktrace) (e) - (use 'clojure.contrib.trace) - -) - - -;; End of file diff --git a/src/test/clojure/clojure/contrib/test_def.clj b/src/test/clojure/clojure/contrib/test_def.clj deleted file mode 100644 index 2e8af137..00000000 --- a/src/test/clojure/clojure/contrib/test_def.clj +++ /dev/null @@ -1,27 +0,0 @@ -;; Tests for def.clj - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. 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.contrib.test-def - (:use clojure.test) - (:require [clojure.contrib.def :as d])) - -(defn sample-fn "sample-fn docstring" []) -(d/defalias aliased-fn sample-fn) -(defmacro sample-macro "sample-macro-docstring" []) -(d/defalias aliased-macro sample-macro) - -(deftest defalias-preserves-metadata - (let [preserved-meta #(-> % (meta) (select-keys [:doc :arglists :ns :file :macro]))] - (are [x y] (= (preserved-meta (var x)) (preserved-meta (var y))) - aliased-fn sample-fn - aliased-macro sample-macro))) - diff --git a/src/test/clojure/clojure/contrib/test_fnmap.clj b/src/test/clojure/clojure/contrib/test_fnmap.clj deleted file mode 100644 index 04edc1e7..00000000 --- a/src/test/clojure/clojure/contrib/test_fnmap.clj +++ /dev/null @@ -1,39 +0,0 @@ -(ns clojure.contrib.test-fnmap - (:use clojure.contrib.fnmap - clojure.test)) - -(deftest acts-like-map - (let [m1 (fnmap get assoc :key1 1 :key2 2)] - (are [k v] (= v (get m1 k)) - :key1 1 - :key2 2 - :nonexistent-key nil) - (are [k v] (= v (k m1)) - :key1 1 - :key2 2 - :nonexistent-key nil) - (let [m2 (assoc m1 :key3 3 :key4 4)] - (are [k v] (= v (get m2 k)) - :key1 1 - :key2 2 - :key3 3 - :key4 4 - :nonexistent-key nil)))) - -(defn assoc-validate [m key value] - (if (integer? value) - (assoc m key value) - (throw (Exception. "Only integers allowed in this map!")))) - -(deftest validators - (let [m (fnmap get assoc-validate)] - (is (= 2 (:key2 (assoc m :key2 2)))) - (is (thrown? Exception (assoc m :key3 3.14))))) - -(defn get-transform [m key] - (when-let [value (m key)] - (- value))) - -(deftest transforms - (let [m (fnmap get-transform assoc)] - (is (= -2 (:key2 (assoc m :key2 2)))))) diff --git a/src/test/clojure/clojure/contrib/test_graph.clj b/src/test/clojure/clojure/contrib/test_graph.clj deleted file mode 100644 index c27df8bf..00000000 --- a/src/test/clojure/clojure/contrib/test_graph.clj +++ /dev/null @@ -1,187 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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-graph -;; -;; Basic Graph Theory Algorithms Tests -;; -;; straszheimjeffrey (gmail) -;; Created 23 June 2009 - -(ns clojure.contrib.test-graph - (use clojure.test - clojure.contrib.graph)) - - -(def empty-graph (struct directed-graph #{} {})) - -(def test-graph-1 - (struct directed-graph - #{:a :b :c :d :e} - {:a #{:b :c} - :b #{:a :c} - :c #{:d :e} - :d #{:a :b} - :e #{:d}})) - -(deftest test-reverse-graph - (is (= (reverse-graph test-graph-1) - (struct directed-graph - #{:a :b :c :d :e} - {:c #{:b :a} - :e #{:c} - :d #{:c :e} - :b #{:d :a} - :a #{:d :b}}))) - (is (= (reverse-graph (reverse-graph test-graph-1)) - test-graph-1)) - (is (= (reverse-graph empty-graph) empty-graph))) - -(deftest test-add-loops - (let [tg1 (add-loops test-graph-1)] - (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) - (is (= (add-loops empty-graph) empty-graph))) - -(deftest test-remove-loops - (let [tg1 (remove-loops (add-loops test-graph-1))] - (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) - (is (= (remove-loops empty-graph) empty-graph))) - - -(def test-graph-2 - (struct directed-graph - #{:a :b :c :d :e :f :g :h :i :j} - {:a #{:b :c} - :b #{:a :c} - :c #{:d :e} - :d #{:a :b} - :e #{:d} - :f #{:f} - :g #{:a :f} - :h #{} - :i #{:j} - :j #{:i}})) - - -(deftest test-lazy-walk - (is (= (lazy-walk test-graph-2 :h) [:h])) - (is (= (lazy-walk test-graph-2 :j) [:j :i]))) - -(deftest test-transitive-closure - (let [tc-1 (transitive-closure test-graph-1) - tc-2 (transitive-closure test-graph-2) - get (fn [n] (set (get-neighbors tc-2 n)))] - (is (every? #(= #{:a :b :c :d :e} (set %)) - (map (partial get-neighbors tc-1) (:nodes tc-1)))) - (is (= (get :a) #{:a :b :c :d :e})) - (is (= (get :h) #{})) - (is (= (get :j) #{:i :j})) - (is (= (get :g) #{:a :b :c :d :e :f})))) - - -(deftest test-post-ordered-nodes - (is (= (set (post-ordered-nodes test-graph-2)) - #{:a :b :c :d :e :f :g :h :i :j})) - (is (empty? (post-ordered-nodes empty-graph)))) - - -(deftest test-scc - (is (= (set (scc test-graph-2)) - #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}})) - (is (empty? (scc empty-graph)))) - -(deftest test-component-graph - (let [cg (component-graph test-graph-2) - ecg (component-graph empty-graph)] - (is (= (:nodes cg) (set (scc test-graph-2)))) - (is (= (get-neighbors cg #{:a :b :c :d :e}) - #{#{:a :b :c :d :e}})) - (is (= (get-neighbors cg #{:g}) - #{#{:a :b :c :d :e} #{:f}})) - (is (= (get-neighbors cg #{:i :j}) - #{#{:i :j}})) - (is (= (get-neighbors cg #{:h}) - #{})) - (is (= (apply max (map count (self-recursive-sets cg))) 1)) - (is (= ecg empty-graph)))) - - -(deftest test-recursive-component? - (let [sccs (scc test-graph-2)] - (is (= (set (filter (partial recursive-component? test-graph-2) sccs)) - #{#{:i :j} #{:b :c :a :d :e} #{:f}})))) - - -(deftest test-self-recursive-sets - (is (= (set (self-recursive-sets test-graph-2)) - (set (filter - (partial recursive-component? test-graph-2) - (scc test-graph-2))))) - (is (empty? (self-recursive-sets empty-graph)))) - - -(def test-graph-3 - (struct directed-graph - #{:a :b :c :d :e :f} - {:a #{:b} - :b #{:c} - :c #{:d} - :d #{:e} - :e #{:f} - :f #{}})) - -(def test-graph-4 - (struct directed-graph - #{:a :b :c :d :e :f :g :h} - {:a #{} - :b #{:a} - :c #{:a} - :d #{:a :b} - :e #{:d :c} - :f #{:e} - :g #{:d} - :h #{:f}})) - -(def test-graph-5 - (struct directed-graph - #{:a :b :c :d :e :f :g :h} - {:a #{} - :b #{} - :c #{:b} - :d #{} - :e #{} - :f #{} - :g #{:f} - :h #{}})) - -(deftest test-dependency-list - (is (thrown-with-msg? Exception #".*Fixed point overflow.*" - (dependency-list test-graph-2))) - (is (= (dependency-list test-graph-3) - [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}])) - (is (= (dependency-list test-graph-4) - [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}])) - (is (= (dependency-list test-graph-5) - [#{:f :b :a :d :h :e} #{:g :c}])) - (is (= (dependency-list empty-graph) - [#{}]))) - -(deftest test-stratification-list - (is (thrown-with-msg? Exception #".*Fixed point overflow.*" - (stratification-list test-graph-2 test-graph-2))) - (is (= (stratification-list test-graph-4 test-graph-5) - [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}])) - (is (= (stratification-list empty-graph empty-graph) - [#{}]))) - -(comment - (run-tests) -) - - -;; End of file diff --git a/src/test/clojure/clojure/contrib/test_greatest_least.clj b/src/test/clojure/clojure/contrib/test_greatest_least.clj deleted file mode 100644 index 20cda34d..00000000 --- a/src/test/clojure/clojure/contrib/test_greatest_least.clj +++ /dev/null @@ -1,65 +0,0 @@ -(ns clojure.contrib.test-greatest-least - (:use clojure.contrib.greatest-least - [clojure.test :only (is deftest run-tests)])) - -(deftest test-greatest - (is (nil? (greatest)) "greatest with no arguments is nil") - (is (= 1 (greatest 1))) - (is (= 2 (greatest 1 2))) - (is (= 2 (greatest 2 1))) - (is (= "b" (greatest "aa" "b")))) - -(deftest test-greatest-by - (is (nil? (greatest-by identity)) "greatest-by with no arguments is nil") - (is (= "" (greatest-by count ""))) - (is (= "a" (greatest-by count "a" ""))) - (is (= "a" (greatest-by count "" "a"))) - (is (= "aa" (greatest-by count "aa" "b")))) - -(deftest test-least - (is (nil? (least)) "least with no arguments is nil") - (is (= 1 (least 1))) - (is (= 1 (least 1 2))) - (is (= 1 (least 2 1))) - (is (= "aa" (least "aa" "b")))) - -(deftest test-least-by - (is (nil? (least-by identity)) "least-by with no arguments is nil") - (is (= "" (least-by count ""))) - (is (= "" (least-by count "a" ""))) - (is (= "" (least-by count "" "a"))) - (is (= "b" (least-by count "aa" "b")))) - -(deftest test-all-greatest - (is (nil? (all-greatest)) "all-greatest with no arguments is nil") - (is (= (list 1) (all-greatest 1))) - (is (= (list 1 1) (all-greatest 1 1))) - (is (= (list 2) (all-greatest 2 1 1))) - (is (= (list 2) (all-greatest 1 2 1))) - (is (= (list 2) (all-greatest 1 1 2))) - (is (= (list :c) (all-greatest :b :c :a)))) - -(deftest test-all-greatest-by - (is (nil? (all-greatest-by identity)) "all-greatest-by with no arguments is nil") - (is (= (list "a")) (all-greatest-by count "a")) - (is (= (list "a" "a")) (all-greatest-by count "a" "a")) - (is (= (list "aa")) (all-greatest-by count "aa" "b")) - (is (= (list "aa")) (all-greatest-by count "b" "aa" "c")) - (is (= (list "cc" "aa")) (all-greatest-by count "aa" "b" "cc"))) - -(deftest test-all-least - (is (nil? (all-least)) "all-least with no arguments is nil") - (is (= (list 1) (all-least 1))) - (is (= (list 1 1) (all-least 1 1))) - (is (= (list 1 1) (all-least 2 1 1))) - (is (= (list 1 1) (all-least 1 2 1))) - (is (= (list 1 1) (all-least 1 1 2))) - (is (= (list :a) (all-least :b :c :a)))) - -(deftest test-all-least-by - (is (nil? (all-least-by identity)) "all-least-by with no arguments is nil") - (is (= (list "a")) (all-least-by count "a")) - (is (= (list "a" "a")) (all-least-by count "a" "a")) - (is (= (list "b")) (all-least-by count "aa" "b")) - (is (= (list "c" "b")) (all-least-by count "b" "aa" "c")) - (is (= (list "b")) (all-least-by count "aa" "b" "cc"))) diff --git a/src/test/clojure/clojure/contrib/test_io.clj b/src/test/clojure/clojure/contrib/test_io.clj deleted file mode 100644 index 807fc394..00000000 --- a/src/test/clojure/clojure/contrib/test_io.clj +++ /dev/null @@ -1,96 +0,0 @@ -(ns clojure.contrib.test-io - (:refer-clojure :exclude (spit)) - (:use clojure.test clojure.contrib.io) - (:import (java.io File FileInputStream BufferedInputStream) - (java.net URL URI))) - -(deftest file-str-backslash - (is (= (java.io.File. - (str "C:" java.io.File/separator - "Documents" java.io.File/separator - "file.txt")) - (file-str "C:\\Documents\\file.txt")))) - -(deftest test-as-file - (testing "strings" - (is (= (File. "foo") (as-file "foo")))) - (testing "Files" - (is (= (File. "bar") (as-file (File. "bar")))))) - -(deftest test-as-url - (are [result expr] (= result expr) - (URL. "http://foo") (as-url (URL. "http://foo")) - (URL. "http://foo") (as-url "http://foo") - (URL. "http://foo") (as-url (URI. "http://foo")) - (URL. "file:/foo") (as-url (File. "/foo")))) - -(deftest test-delete-file - (let [file (File/createTempFile "test" "deletion") - not-file (File. (str (java.util.UUID/randomUUID)))] - (delete-file (.getAbsolutePath file)) - (is (not (.exists file))) - (is (thrown? ArithmeticException (/ 1 0))) - (is (thrown? java.io.IOException (delete-file not-file))) - (is (delete-file not-file :silently)))) - -(deftest test-relative-path-string - (testing "strings" - (is (= "foo" (relative-path-string "foo")))) - (testing "absolute path strings are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (str File/separator "baz"))))) - (testing "relative File paths" - (is (= "bar" (relative-path-string (File. "bar"))))) - (testing "absolute File paths are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (File. (str File/separator "quux"))))))) - -(defn stream-should-have [stream expected-bytes msg] - (let [actual-bytes (byte-array (alength expected-bytes))] - (.read stream actual-bytes) - (is (= -1 (.read stream)) (str msg " : should be end of stream")) - (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) - -(deftest test-input-stream - (let [file (File/createTempFile "test-input-stream" "txt") - bytes (.getBytes "foobar")] - (spit file "foobar") - (doseq [[expr msg] - [[file File] - [(FileInputStream. file) FileInputStream] - [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] - [(.. file toURI) URI] - [(.. file toURI toURL) URL] - [(.. file toURI toURL toString) "URL as String"] - [(.. file toString) "File as String"]]] - (with-open [s (input-stream expr)] - (stream-should-have s bytes msg))))) - -(deftest test-streams-buffering - (let [data (.getBytes "")] - (is (instance? java.io.BufferedReader (reader data))) - (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) - (is (instance? java.io.BufferedInputStream (input-stream data))) - (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) - -(deftest test-streams-defaults - (let [f (File/createTempFile "clojure.contrib" "test-reader-writer") - content "test\u2099ing"] - (try - (is (thrown? Exception (reader (Object.)))) - (is (thrown? Exception (writer (Object.)))) - - (are [write-to read-from] (= content (do - (spit write-to content) - (slurp* (or read-from write-to)))) - f nil - (.getAbsolutePath f) nil - (.toURL f) nil - (.toURI f) nil - (java.io.FileOutputStream. f) f - (java.io.OutputStreamWriter. (java.io.FileOutputStream. f) "UTF-8") f - f (java.io.FileInputStream. f) - f (java.io.InputStreamReader. (java.io.FileInputStream. f) "UTF-8")) - - (is (= content (slurp* (.getBytes content "UTF-8")))) - (is (= content (slurp* (.toCharArray content)))) - (finally - (.delete f))))) diff --git a/src/test/clojure/clojure/contrib/test_jmx.clj b/src/test/clojure/clojure/contrib/test_jmx.clj deleted file mode 100644 index 7420316a..00000000 --- a/src/test/clojure/clojure/contrib/test_jmx.clj +++ /dev/null @@ -1,178 +0,0 @@ -;; Tests for JMX support for Clojure (see also clojure/contrib/jmx.clj) - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. 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.contrib.test-jmx - (:import javax.management.openmbean.CompositeDataSupport - [javax.management MBeanAttributeInfo AttributeList] - [java.util.logging LogManager Logger] - clojure.contrib.jmx.Bean) - (:use clojure.test) - (:require [clojure.contrib [jmx :as jmx]])) - - -(defn =set [a b] - (= (set a) (set b))) - -(defn seq-contains-all? - "Does container contain every item in containee? - Not fast. Testing use only" - [container containee] - (let [container (set container)] - (every? #(contains? container %) containee))) - -(deftest finding-mbeans - (testing "as-object-name" - (are [cname object-name] - (= cname (.getCanonicalName object-name)) - "java.lang:type=Memory" (jmx/as-object-name "java.lang:type=Memory"))) - (testing "mbean-names" - (are [cnames object-name] - (= cnames (map #(.getCanonicalName %) object-name)) - ["java.lang:type=Memory"] (jmx/mbean-names "java.lang:type=Memory")))) - -; These actual beans may differ on different JVM platforms. -; Tested April 2010 to work on Sun and IBM JDKs. -(deftest testing-actual-beans - (testing "reflecting on capabilities" - (are [attr-list mbean-name] - (seq-contains-all? (jmx/attribute-names mbean-name) attr-list) - [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory") - (are [op-list mbean-name] - (seq-contains-all? (jmx/operation-names mbean-name) op-list) - [:gc] "java.lang:type=Memory")) - (testing "mbean-from-oname" - (are [key-names oname] - (seq-contains-all? (keys (jmx/mbean oname)) key-names) - [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory"))) - -(deftest raw-reading-attributes - (let [mem "java.lang:type=Memory" - log "java.util.logging:type=Logging"] - (testing "simple scalar attributes" - (are [a b] (= a b) - false (jmx/raw-read mem :Verbose)) - (are [type attr] (instance? type attr) - Number (jmx/raw-read mem :ObjectPendingFinalizationCount))))) - -(deftest reading-attributes - (testing "simple scalar attributes" - (are [type attr] (instance? type attr) - Number (jmx/read "java.lang:type=Memory" :ObjectPendingFinalizationCount))) - (testing "composite attributes" - (are [ks attr] (=set ks (keys attr)) - [:used :max :init :committed] (jmx/read "java.lang:type=Memory" :HeapMemoryUsage))) - (testing "tabular attributes" - (is (map? (jmx/read "java.lang:type=Runtime" :SystemProperties))))) - -(deftest writing-attributes - (let [mem "java.lang:type=Memory"] - (jmx/write! mem :Verbose true) - (is (true? (jmx/raw-read mem :Verbose))) - (jmx/write! mem :Verbose false))) - -(deftest test-invoke-operations - (testing "without arguments" - (jmx/invoke "java.lang:type=Memory" :gc)) - (testing "with arguments" - (.addLogger (LogManager/getLogManager) (Logger/getLogger "clojure.contrib.test_contrib.test_jmx")) - (jmx/invoke "java.util.logging:type=Logging" :setLoggerLevel "clojure.contrib.test_contrib.test_jmx" "WARNING"))) - -(deftest test-jmx->clj - (testing "it works recursively on maps" - (let [some-map {:foo (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage)}] - (is (map? (:foo (jmx/jmx->clj some-map)))))) - (testing "it leaves everything else untouched" - (is (= "foo" (jmx/jmx->clj "foo"))))) - - -(deftest test-composite-data->map - (let [data (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage) - prox (jmx/composite-data->map data)] - (testing "returns a map with keyword keys" - (is (= (set [:committed :init :max :used]) (set (keys prox))))))) - -(deftest test-tabular-data->map - (let [raw-props (jmx/raw-read "java.lang:type=Runtime" :SystemProperties) - props (jmx/tabular-data->map raw-props)] - (are [k] (contains? props k) - :java.class.path - :path.separator))) - -(deftest test-creating-attribute-infos - (let [infos (jmx/map->attribute-infos [[:a 1] [:b 2]]) - info (first infos)] - (testing "generates the right class" - (is (= (class (into-array MBeanAttributeInfo [])) (class infos)))) - (testing "generates the right instance data" - (are [result expr] (= result expr) - "a" (.getName info) - "a" (.getDescription info))))) - -(deftest various-beans-are-readable - (testing "that all java.lang beans can be read without error" - (doseq [mb (jmx/mbean-names "*:*")] - (is (map? (jmx/mbean mb)) mb)))) - -(deftest test-jmx-url - (testing "creates default url" - (is (= "service:jmx:rmi:///jndi/rmi://localhost:3000/jmxrmi" - (jmx/jmx-url)))) - (testing "creates custom url" - (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxrmi" - (jmx/jmx-url {:host "example.com" :port 4000})))) - (testing "creates custom jndi path" - (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxconnector" - (jmx/jmx-url {:host "example.com" :port 4000 :jndi-path "jmxconnector"}))))) - -;; ---------------------------------------------------------------------- -;; tests for clojure.contrib.jmx.Bean. - -(deftest dynamic-mbean-from-compiled-class - (let [mbean-name "clojure.contrib.test_contrib.test_jmx:name=Foo"] - (jmx/register-mbean - (Bean. - (ref {:string-attribute "a-string"})) - mbean-name) - (are [result expr] (= result expr) - "a-string" (jmx/read mbean-name :string-attribute) - {:string-attribute "a-string"} (jmx/mbean mbean-name) - ))) - -(deftest test-getAttribute - (doseq [reftype [ref atom agent]] - (let [state (reftype {:a 1 :b 2}) - bean (Bean. state)] - (testing (str "accessing values from a " (class state)) - (are [result expr] (= result expr) - 1 (.getAttribute bean "a")))))) - -(deftest test-bean-info - (let [state (ref {:a 1 :b 2}) - bean (Bean. state) - info (.getMBeanInfo bean)] - (testing "accessing info" - (are [result expr] (= result expr) - "clojure.contrib.jmx.Bean" (.getClassName info))))) - -(deftest test-getAttributes - (let [bean (Bean. (ref {:r 5 :d 4})) - atts (.getAttributes bean (into-array ["r" "d"]))] - (are [x y] (= x y) - AttributeList (class atts) - [5 4] (seq atts)))) - -(deftest test-guess-attribute-typename - (are [x y] (= x (jmx/guess-attribute-typename y)) -; "long" 10 - "boolean" false - "java.lang.String" "foo" - "long" (Long/valueOf (long 10)))) diff --git a/src/test/clojure/clojure/contrib/test_json.clj b/src/test/clojure/clojure/contrib/test_json.clj deleted file mode 100644 index e62df3a8..00000000 --- a/src/test/clojure/clojure/contrib/test_json.clj +++ /dev/null @@ -1,186 +0,0 @@ -(ns clojure.contrib.test-json - (:use clojure.test clojure.contrib.json)) - -(deftest can-read-from-pushback-reader - (let [s (java.io.PushbackReader. (java.io.StringReader. "42"))] - (is (= 42 (read-json s))))) - -(deftest can-read-from-reader - (let [s (java.io.StringReader. "42")] - (is (= 42 (read-json s))))) - -(deftest can-read-numbers - (is (= 42 (read-json "42"))) - (is (= -3 (read-json "-3"))) - (is (= 3.14159 (read-json "3.14159"))) - (is (= 6.022e23 (read-json "6.022e23")))) - -(deftest can-read-null - (is (= nil (read-json "null")))) - -(deftest can-read-strings - (is (= "Hello, World!" (read-json "\"Hello, World!\"")))) - -(deftest handles-escaped-slashes-in-strings - (is (= "/foo/bar" (read-json "\"\\/foo\\/bar\"")))) - -(deftest handles-unicode-escapes - (is (= " \u0beb " (read-json "\" \\u0bEb \"")))) - -(deftest handles-escaped-whitespace - (is (= "foo\nbar" (read-json "\"foo\\nbar\""))) - (is (= "foo\rbar" (read-json "\"foo\\rbar\""))) - (is (= "foo\tbar" (read-json "\"foo\\tbar\"")))) - -(deftest can-read-booleans - (is (= true (read-json "true"))) - (is (= false (read-json "false")))) - -(deftest can-ignore-whitespace - (is (= nil (read-json "\r\n null")))) - -(deftest can-read-arrays - (is (= [1 2 3] (read-json "[1,2,3]"))) - (is (= ["Ole" "Lena"] (read-json "[\"Ole\", \r\n \"Lena\"]")))) - -(deftest can-read-objects - (is (= {:a 1, :b 2} (read-json "{\"a\": 1, \"b\": 2}")))) - -(deftest can-read-nested-structures - (is (= {:a [1 2 {:b [3 "four"]} 5.5]} - (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}")))) - -(deftest disallows-non-string-keys - (is (thrown? Exception (read-json "{26:\"z\"")))) - -(deftest disallows-barewords - (is (thrown? Exception (read-json " foo ")))) - -(deftest disallows-unclosed-arrays - (is (thrown? Exception (read-json "[1, 2, ")))) - -(deftest disallows-unclosed-objects - (is (thrown? Exception (read-json "{\"a\":1, ")))) - -(deftest can-get-string-keys - (is (= {"a" [1 2 {"b" [3 "four"]} 5.5]} - (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}" false true nil)))) - -(declare *pass1-string*) - -(deftest pass1-test - (let [input (read-json *pass1-string* false true nil)] - (is (= "JSON Test Pattern pass1" (first input))) - (is (= "array with 1 element" (get-in input [1 "object with 1 member" 0]))) - (is (= 1234567890 (get-in input [8 "integer"]))) - (is (= "rosebud" (last input))))) - -; from http://www.json.org/JSON_checker/test/pass1.json -(def *pass1-string* - "[ - \"JSON Test Pattern pass1\", - {\"object with 1 member\":[\"array with 1 element\"]}, - {}, - [], - -42, - true, - false, - null, - { - \"integer\": 1234567890, - \"real\": -9876.543210, - \"e\": 0.123456789e-12, - \"E\": 1.234567890E+34, - \"\": 23456789012E66, - \"zero\": 0, - \"one\": 1, - \"space\": \" \", - \"quote\": \"\\\"\", - \"backslash\": \"\\\\\", - \"controls\": \"\\b\\f\\n\\r\\t\", - \"slash\": \"/ & \\/\", - \"alpha\": \"abcdefghijklmnopqrstuvwyz\", - \"ALPHA\": \"ABCDEFGHIJKLMNOPQRSTUVWYZ\", - \"digit\": \"0123456789\", - \"0123456789\": \"digit\", - \"special\": \"`1~!@#$%^&*()_+-={':[,]}|;.</>?\", - \"hex\": \"\\u0123\\u4567\\u89AB\\uCDEF\\uabcd\\uef4A\", - \"true\": true, - \"false\": false, - \"null\": null, - \"array\":[ ], - \"object\":{ }, - \"address\": \"50 St. James Street\", - \"url\": \"http://www.JSON.org/\", - \"comment\": \"// /* <!-- --\", - \"# -- --> */\": \" \", - \" s p a c e d \" :[1,2 , 3 - -, - -4 , 5 , 6 ,7 ],\"compact\":[1,2,3,4,5,6,7], - \"jsontext\": \"{\\\"object with 1 member\\\":[\\\"array with 1 element\\\"]}\", - \"quotes\": \"" \\u0022 %22 0x22 034 "\", - \"\\/\\\\\\\"\\uCAFE\\uBABE\\uAB98\\uFCDE\\ubcda\\uef4A\\b\\f\\n\\r\\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?\" -: \"A key can be any string\" - }, - 0.5 ,98.6 -, -99.44 -, - -1066, -1e1, -0.1e1, -1e-1, -1e00,2e+00,2e-00 -,\"rosebud\"]") - - -(deftest can-print-json-strings - (is (= "\"Hello, World!\"" (json-str "Hello, World!"))) - (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes")))) - -(deftest can-print-unicode - (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567")))) - -(deftest can-print-json-null - (is (= "null" (json-str nil)))) - -(deftest can-print-json-arrays - (is (= "[1,2,3]" (json-str [1 2 3]))) - (is (= "[1,2,3]" (json-str (list 1 2 3)))) - (is (= "[1,2,3]" (json-str (sorted-set 1 2 3)))) - (is (= "[1,2,3]" (json-str (seq [1 2 3]))))) - -(deftest can-print-java-arrays - (is (= "[1,2,3]" (json-str (into-array [1 2 3]))))) - -(deftest can-print-empty-arrays - (is (= "[]" (json-str []))) - (is (= "[]" (json-str (list)))) - (is (= "[]" (json-str #{})))) - -(deftest can-print-json-objects - (is (= "{\"a\":1,\"b\":2}" (json-str (sorted-map :a 1 :b 2))))) - -(deftest object-keys-must-be-strings - (is (= "{\"1\":1,\"2\":2") (json-str (sorted-map 1 1 2 2)))) - -(deftest can-print-empty-objects - (is (= "{}" (json-str {})))) - -(deftest accept-sequence-of-nils - (is (= "[null,null,null]" (json-str [nil nil nil])))) - -(deftest error-on-nil-keys - (is (thrown? Exception (json-str {nil 1})))) - -(deftest characters-in-symbols-are-escaped - (is (= "\"foo\\u1b1b\"" (json-str (symbol "foo\u1b1b"))))) - -;;; Pretty-printer - -(deftest pretty-printing - (let [x (read-json *pass1-string* false)] - (is (= x (read-json (with-out-str (pprint-json x)) false))))) diff --git a/src/test/clojure/clojure/contrib/test_lazy_seqs.clj b/src/test/clojure/clojure/contrib/test_lazy_seqs.clj deleted file mode 100644 index ecbe46ae..00000000 --- a/src/test/clojure/clojure/contrib/test_lazy_seqs.clj +++ /dev/null @@ -1,21 +0,0 @@ -(ns clojure.contrib.test-lazy-seqs - (:use clojure.test - clojure.contrib.lazy-seqs)) - -(deftest test-fibs - (is (= [0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 - 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 - 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 - 165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 - 4807526976 7778742049] - (take 50 (fibs))))) - -(deftest test-powers-of-2 - (is (= [1 2 4 8 16 32 64 128 256 512] - (take 10 (powers-of-2))))) - -(deftest test-primes - (is (= [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 - 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 - 199 211 223 227 229] - (take 50 primes)))) diff --git a/src/test/clojure/clojure/contrib/test_load_all.clj b/src/test/clojure/clojure/contrib/test_load_all.clj deleted file mode 100644 index 15bcc4f1..00000000 --- a/src/test/clojure/clojure/contrib/test_load_all.clj +++ /dev/null @@ -1,53 +0,0 @@ -;;; test_load_all.clj - loads all contrib libraries for testing purposes - -;; by Stuart Halloway, http://blog.thinkrelevance.com - -;; Copyright (c) Stuart Halloway, 2009. 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. - -;; This is only intended to check that the libraries will load without -;; errors, not that they work correctly. - -;; The code includes several design choices I don't love, but find -;; tolerable in a test-only lib: -;; -;; * namespaces that blow up to document deprecation -;; * using directory paths to find contrib -;; * using a macro to reflectively write tests -;; -;; I *am* happy that code that won't even load now breaks the build. - -(ns clojure.contrib.test-load-all - (:use clojure.test clojure.contrib.find-namespaces)) - -(def deprecated-contrib-namespaces - '[clojure.contrib.javadoc]) - -(defn loadable-contrib-namespaces - "Contrib namespaces that can be loaded (everything except - deprecated nses that throw on load.)" - [] - (apply disj - (into #{} (find-namespaces-in-dir (java.io.File. "src/main"))) - deprecated-contrib-namespaces)) - -(defn emit-test-load - [] - `(do - ~@(map - (fn [ns] - `(deftest ~(symbol (str "test-loading-" (.replace (str ns) "." "-"))) - (require :reload '~ns))) - (loadable-contrib-namespaces)))) - -(defmacro test-load - [] - (emit-test-load)) - -(test-load) - diff --git a/src/test/clojure/clojure/contrib/test_macro_utils.clj b/src/test/clojure/clojure/contrib/test_macro_utils.clj deleted file mode 100644 index 8b603a67..00000000 --- a/src/test/clojure/clojure/contrib/test_macro_utils.clj +++ /dev/null @@ -1,67 +0,0 @@ -;; Test routines for macro_utils.clj - -;; by Konrad Hinsen -;; last updated May 6, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. 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.contrib.test-macro-utils - (:use [clojure.test :only (deftest is are run-tests use-fixtures)] - [clojure.contrib.macro-utils - :only (macrolet symbol-macrolet defsymbolmacro with-symbol-macros - mexpand-1 mexpand mexpand-all)] - [clojure.contrib.monads - :only (with-monad domonad)])) - -(use-fixtures :each - (fn [f] (binding [*ns* (the-ns 'clojure.contrib.test-macro-utils)] - (f)))) - -(deftest macrolet-test - (is (= (macroexpand-1 - '(macrolet [(foo [form] `(~form ~form))] (foo x))) - '(do (x x))))) - -(deftest symbol-macrolet-test - (is (= (macroexpand-1 - '(symbol-macrolet [x xx y yy] - (exp [a y] (x y)))) - '(do (exp [a yy] (xx yy))))) - (is (= (macroexpand-1 - '(symbol-macrolet [def foo] - (def def def))) - '(do (def def foo)))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (let [a x b y x b] [a b x z]))) - '(do (let* [a foo b y x b] [a b x bar])))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (fn ([x y] [x y z]) ([x y z] [x y z])))) - '(do (fn* ([x y] [x y bar]) ([x y z] [x y z]))))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (fn f ([x y] [x y z]) ([x y z] [x y z])))) - '(do (fn* f ([x y] [x y bar]) ([x y z] [x y z]))))) - (is (= (nth (second (macroexpand-1 - '(symbol-macrolet [x xx y yy z zz] - (domonad m [a x b y x z] [a b x z])))) 2) - '(do (m-bind xx (fn* ([a] - (m-bind yy (fn* ([b] - (m-bind zz (fn* ([x] - (m-result [a b x zz])))))))))))))) - -(deftest symbol-test - (defsymbolmacro sum-2-3 (plus 2 3)) - (is (= (macroexpand '(with-symbol-macros (+ 1 sum-2-3))) - '(do (+ 1 (plus 2 3))))) - (is (= (macroexpand '(macrolet [(plus [a b] `(+ ~a ~b))] (+ 1 sum-2-3))) - '(do (+ 1 (clojure.core/+ 2 3))))) - (ns-unmap *ns* 'sum-2-3)) - diff --git a/src/test/clojure/clojure/contrib/test_math.clj b/src/test/clojure/clojure/contrib/test_math.clj deleted file mode 100644 index 4b58d807..00000000 --- a/src/test/clojure/clojure/contrib/test_math.clj +++ /dev/null @@ -1,118 +0,0 @@ -(ns clojure.contrib.test-math
- (:use clojure.test
- clojure.contrib.math))
-
-(deftest test-expt
- (are [x y] (= x y) - (expt 2 3) 8
- (expt (expt 2 16) 2) (expt 2 32)
- (expt 4/3 2) 16/9
- (expt 2 -10) 1/1024
- (expt 0.5M 2) 0.25M
- (expt 5 4.2) (Math/pow 5 4.2)
- (expt 5.3 4) (Math/pow 5.3 4)))
-
-(deftest test-abs
- (are [x y] (= x y) - (abs -2) 2
- (abs 0) 0
- (abs 5) 5
- (abs 123456789123456789) 123456789123456789
- (abs -123456789123456789) 123456789123456789
- (abs 5/3) 5/3
- (abs -4/3) 4/3
- (abs 4.3M) 4.3M
- (abs -4.3M) 4.3M
- (abs 2.8) 2.8
- (abs -2.8) 2.8))
-
-(deftest test-gcd
- (are [x y] (= x y) - (gcd 4 3) 1
- (gcd 24 12) 12
- (gcd 24 27) 3
- (gcd 1 0) 1
- (gcd 0 1) 1
- (gcd 0 0) 0)
- (is (thrown? IllegalArgumentException (gcd nil 0)))
- (is (thrown? IllegalArgumentException (gcd 0 nil)))
- (is (thrown? IllegalArgumentException (gcd 7.0 0))))
-
-(deftest test-lcm
- (are [x y] (= x y) - (lcm 2 3) 6
- (lcm 3 2) 6
- (lcm -2 3) 6
- (lcm 2 -3) 6
- (lcm -2 -3) 6
- (lcm 4 10) 20
- (lcm 1 0) 0
- (lcm 0 1) 0
- (lcm 0 0))
- (is (thrown? IllegalArgumentException (lcm nil 0)))
- (is (thrown? IllegalArgumentException (lcm 0 nil)))
- (is (thrown? IllegalArgumentException (lcm 7.0 0))))
-
-(deftest test-floor
- (are [x y] (== x y) - (floor 6) 6
- (floor -6) -6
- (floor 123456789123456789) 123456789123456789
- (floor -123456789123456789) -123456789123456789
- (floor 4/3) 1
- (floor -4/3) -2
- (floor 4.3M) 4
- (floor -4.3M) -5
- (floor 4.3) 4.0
- (floor -4.3) -5.0))
-
-(deftest test-ceil
- (are [x y] (== x y) - (ceil 6) 6
- (ceil -6) -6
- (ceil 123456789123456789) 123456789123456789
- (ceil -123456789123456789) -123456789123456789
- (ceil 4/3) 2
- (ceil -4/3) -1
- (ceil 4.3M) 5
- (ceil -4.3M) -4
- (ceil 4.3) 5.0
- (ceil -4.3) -4.0))
-
-(deftest test-round
- (are [x y] (== x y) - (round 6) 6
- (round -6) -6
- (round 123456789123456789) 123456789123456789
- (round -123456789123456789) -123456789123456789
- (round 4/3) 1
- (round 5/3) 2
- (round 5/2) 3
- (round -4/3) -1
- (round -5/3) -2
- (round -5/2) -2
- (round 4.3M) 4
- (round 4.7M) 5
- (round -4.3M) -4
- (round -4.7M) -5
- (round 4.5M) 5
- (round -4.5M) -4
- (round 4.3) 4
- (round 4.7) 5
- (round -4.3) -4
- (round -4.7) -5
- (round 4.5) 5
- (round -4.5) -4))
-
-(deftest test-sqrt
- (are [x y] (= x y) - (sqrt 9) 3
- (sqrt 16/9) 4/3
- (sqrt 0.25M) 0.5M
- (sqrt 2) (Math/sqrt 2)))
-
-(deftest test-exact-integer-sqrt
- (are [x y] (= x y) - (exact-integer-sqrt 15) [3 6]
- (exact-integer-sqrt (inc (expt 2 32))) [(expt 2 16) 1]
- (exact-integer-sqrt 1000000000000) [1000000 0]))
diff --git a/src/test/clojure/clojure/contrib/test_miglayout.clj b/src/test/clojure/clojure/contrib/test_miglayout.clj deleted file mode 100644 index 0ec32167..00000000 --- a/src/test/clojure/clojure/contrib/test_miglayout.clj +++ /dev/null @@ -1,145 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and -;; distribution terms for this software are covered by the Eclipse Public -;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can -;; be found in the file epl-v10.html at the root of this distribution. By -;; using this software in any fashion, you are agreeing to be bound by the -;; terms of this license. You must not remove this notice, or any other, -;; from this software. -;; -;; clojure.contrib.miglayout.test -;; -;; Test/example for clojure.contrib.miglayout -;; -;; scgilardi (gmail) -;; Created 5 October 2008 - -(ns clojure.contrib.test-miglayout - (:import (javax.swing JButton JFrame JLabel JList JPanel - JScrollPane JTabbedPane JTextField JSeparator)) - (:use clojure.contrib.miglayout)) - -(def tests) - -(defn run-test - [index] - (let [panel ((tests index) (JPanel.))] - (println index (components panel)) - (doto (JFrame. (format "MigLayout Test %d" index)) - (.add panel) - (.pack) - (.setVisible true)))) - -(defn label - "Returns a swing label" - [text] - (JLabel. text)) - -(defn text-field - "Returns a swing text field" - ([] (text-field 10)) - ([width] - (JTextField. width))) - -(defn sep - "Returns a swing separator" - [] - (JSeparator.)) - -(def tests [ - - (fn test0 - [panel] - (miglayout panel - (label "Hello") - (label "World") {:gap :unrelated} - (text-field) :wrap - (label "Bonus!") - (JButton. "Bang it") {:wmin :button :grow :x :span 2} :center)) - - ;; test1 and test2 are based on code from - ;; http://www.devx.com/java/Article/38017/1954 - - ;; constraints as strings exclusively - (fn test1 - [panel] - (miglayout panel - :column "[right]" - (label "General") "split, span" - (sep) "growx, wrap" - (label "Company") "gap 10" - (text-field "") "span, growx" - (label "Contact") "gap 10" - (text-field "") "span, growx, wrap" - (label "Propeller") "split, span, gaptop 10" - (sep) "growx, wrap, gaptop 10" - (label "PTI/kW") "gapx 10, gapy 15" - (text-field) - (label "Power/kW") "gap 10" - (text-field) "wrap" - (label "R/mm") "gap 10" - (text-field) - (label "D/mm") "gap 10" - (text-field))) - - ;; the same constraints as strings, keywords, vectors, and maps - (fn test2 - [panel] - (miglayout panel - :column "[right]" - (label "General") "split, span" - (sep) :growx :wrap - (label "Company") [:gap 10] - (text-field "") :span :growx - (label "Contact") [:gap 10] - (text-field "") :span :growx :wrap - (label "Propeller") :split :span [:gaptop 10] - (sep) :growx :wrap [:gaptop 10] - (label "PTI/kW") {:gapx 10 :gapy 15} - (text-field) - (label "Power/kW") [:gap 10] - (text-field) :wrap - (label "R/mm") [:gap 10] - (text-field) - (label "D/mm") [:gap 10] - (text-field))) - - ;; the same constraints using symbols to name groups of constraints - (fn test3 - [panel] - (let [g [:gap 10] - gt [:gaptop 10] - gxs #{:growx :span} - gxw #{:growx :wrap} - gxy {:gapx 10 :gapy 15} - right "[right]" - ss #{:split :span} - w :wrap] - (miglayout panel - :column right - (label "General") ss - (sep) gxw - (label "Company") g - (text-field "") gxs - (label "Contact") g - (text-field "") gxs - (label "Propeller") ss gt - (sep) gxw g - (label "PTI/kW") gxy - (text-field) - (label "Power/kW") g - (text-field) w - (label "R/mm") g - (text-field) - (label "D/mm") g - (text-field)))) - - (fn test4 - [panel] - (miglayout panel - (label "First Name") - (text-field) {:id :firstname} - (label "Surname") [:gap :unrelated] - (text-field) {:id :surname} :wrap - (label "Address") - (text-field) {:id :address} :span :grow)) -]) diff --git a/src/test/clojure/clojure/contrib/test_mock.clj b/src/test/clojure/clojure/contrib/test_mock.clj deleted file mode 100644 index 961de931..00000000 --- a/src/test/clojure/clojure/contrib/test_mock.clj +++ /dev/null @@ -1,131 +0,0 @@ -(ns clojure.contrib.test-mock - (:use clojure.test) - (:require [clojure.contrib.mock :as mock])) - -; Used as dummy dependency functions -(defn fn1 {:dynamic true} [x] :ignore) -(defn fn2 {:dynamic true} [x y] :ignore) -(defn fn3 {:dynamic true} ([x] :ignore) - ([x y z] :ignore)) -(defn fn4 {:dynamic true} [x y & r] :ignore) - -;functions created using fn directly lack the argslist meta data -(def #^{:dynamic true} deffed-differently (fn [x] :ignore)) - -(defmacro assert-called [fn-name called? & body] - `(let [called-status?# (atom false)] - (binding [~fn-name (fn [& args#] (reset! called-status?# true))] ~@body) - (is (= ~called? @called-status?#)))) - -(deftest test-convenience - (testing "once" - (is (false? (mock/once 0))) - (is (false? (mock/once 123))) - (is (true? (mock/once 1)))) - - (testing "never" - (is (false? (mock/never 4))) - (is (true? (mock/never 0)))) - - (testing "more-than" - (is (false? ((mock/more-than 5) 3))) - (is (true? ((mock/more-than 5) 9)))) - - (testing "less-than" - (is (true? ((mock/less-than 5) 3))) - (is (false? ((mock/less-than 5) 9)))) - - (testing "between" - (is (true? ((mock/between 5 8) 6))) - (is (false? ((mock/between 5 8) 5))))) - - -(deftest test-returns - (is (= {:returns 5} (mock/returns 5))) - (is (= {:other-key "test" :returns nil} (mock/returns nil {:other-key "test"})))) - - -(deftest test-has-args - (let [ex (:has-args (mock/has-args [1]))] - (is (fn? ex)) - (is (ex 'fn1 1)) - (is (ex 'fn1 1 5 6)) - (assert-called mock/unexpected-args true (ex 'fn1 5))) - (is (contains? (mock/has-args [] {:pre-existing-key "test"}) :pre-existing-key)) - (is (true? (((mock/has-args [5]) :has-args)'fn1 5)))) - - -(deftest test-has-matching-signature - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn2 [1])) - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3 5])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3 5 7 9])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3])) - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-mock/deffed-differently [1]))) - - -(deftest test-times - (is (fn? ((mock/times #(= 1 %)) :times))) - (is (contains? (mock/times #(= 1 %) {:existing-key "test"}) :existing-key))) - -(deftest test-make-mock - (testing "invalid arguments" - (is (thrown? IllegalArgumentException (mock/make-mock [5])))) - - (testing "valid counter and unevaluated returns" - (let [[mock counter count-checker] (mock/make-mock 'fn1 (mock/returns 5 (mock/times 1)))] - (is (fn? mock)) - (is (= 0 @counter)) - (is (= 5 (mock :ignore-me))) - (is (= 1 @counter)))) - - (testing "returns as expected" - (let [[mock] (mock/make-mock 'fn1 (mock/returns 5))] - (is (= 5 (mock :ignore)))) - (let [[mock] (mock/make-mock 'fn1 (mock/returns #(* 2 %)))] - (is (= 10 ((mock :ignore) 5)) ":returns a function should not automatically - evaluate it."))) - - (testing "calls replacement-fn and returns the result" - (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 3 %)))] - (is (= 15 (mock 5)))) - (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 2 %) (mock/returns 3)))] - (is (= 10 (mock 5))))) - - (testing "argument validation" - (let [[mock] (mock/make-mock 'fn1 (mock/has-args [#(= 5 %)]))] - (assert-called mock/unexpected-args true (mock "test")) - (is (nil? (mock 5)))))) - - -(deftest test-make-count-checker - (let [checker (mock/make-count-checker 5 5)] - (assert-called mock/incorrect-invocation-count false (checker 'fn1 5)) - (assert-called mock/incorrect-invocation-count true (checker 'fn1 3)))) - - -(deftest test-validate-counts - (assert-called mock/incorrect-invocation-count false - (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker #(< % 6) '#(< % 6)) 'fn1]))) - (assert-called mock/incorrect-invocation-count true - (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker 4 4) 'fn1])))) - - -(deftest test-expect-macro - (let [under-test (fn [x] (fn1 x))] - (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 3 %)]))] - (under-test 3)))) - (assert-called mock/unexpected-args true (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 4 %)]))] - (under-test 3)))) - (let [under-test (fn [] (fn2 (fn1 1) 3))] - (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 1 %)] (mock/returns 2))) - fn2 (mock/times 1 (mock/has-args [#(= 2 %) #(= 3 %)] (mock/returns 5)))] - (under-test))))))
\ No newline at end of file diff --git a/src/test/clojure/clojure/contrib/test_monads.clj b/src/test/clojure/clojure/contrib/test_monads.clj deleted file mode 100644 index 2ec9c3e9..00000000 --- a/src/test/clojure/clojure/contrib/test_monads.clj +++ /dev/null @@ -1,78 +0,0 @@ -;; Test routines for monads.clj - -;; by Konrad Hinsen -;; last updated March 28, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. 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.contrib.test-monads - (:use [clojure.test :only (deftest is are run-tests)] - [clojure.contrib.monads - :only (with-monad domonad m-lift m-seq m-chain - sequence-m maybe-m state-m maybe-t sequence-t)])) - -(deftest sequence-monad - (with-monad sequence-m - (are [a b] (= a b) - (domonad [x (range 3) y (range 2)] (+ x y)) - '(0 1 1 2 2 3) - (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y)) - '((1 1) (2 0)) - ((m-lift 2 #(list %1 %2)) (range 3) (range 2)) - '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1)) - (m-seq (replicate 3 (range 2))) - '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1)) - ((m-chain (replicate 3 range)) 5) - '(0 0 0 1 0 0 1 0 1 2) - (m-plus (range 3) (range 2)) - '(0 1 2 0 1)))) - -(deftest maybe-monad - (with-monad maybe-m - (let [m+ (m-lift 2 +) - mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))] - (are [a b] (= a b) - (m+ (m-result 1) (m-result 3)) - (m-result 4) - (mdiv (m-result 1) (m-result 3)) - (m-result (/ 1 3)) - (m+ 1 (mdiv (m-result 1) (m-result 0))) - m-zero - (m-plus m-zero (m-result 1) m-zero (m-result 2)) - (m-result 1))))) - -(deftest seq-maybe-monad - (with-monad (maybe-t sequence-m) - (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))] - (are [a b] (= a b) - ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n))) - '(nil 2 nil 4 nil 6 nil 8 nil 10) - (pairs (for [n (range 5)] (when (odd? n) n))) - '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil))))) - -(deftest state-maybe-monad - (with-monad (maybe-t state-m) - (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4] - [nil nil 3 4] [1 2 nil nil])] - (let [f (domonad - [x (m-plus (m-result a) (m-result b)) - y (m-plus (m-result c) (m-result d))] - (+ x y))] - (f :state))) - (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state]))))) - -(deftest state-seq-monad - (with-monad (sequence-t state-m) - (is (= (let [[a b c d] [1 2 10 20] - f (domonad - [x (m-plus (m-result a) (m-result b)) - y (m-plus (m-result c) (m-result d))] - (+ x y))] - (f :state))) - (list [(list 11 21 12 22) :state])))) diff --git a/src/test/clojure/clojure/contrib/test_profile.clj b/src/test/clojure/clojure/contrib/test_profile.clj deleted file mode 100644 index 560b58db..00000000 --- a/src/test/clojure/clojure/contrib/test_profile.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns clojure.contrib.test-profile - (:use clojure.test - clojure.contrib.profile)) - -(deftest test-print-summary - (testing "doesn't blow up with no data (assembla #31)" - (is (= "Name mean min max count sum\n" - (with-out-str (print-summary {})))))) diff --git a/src/test/clojure/clojure/contrib/test_properties.clj b/src/test/clojure/clojure/contrib/test_properties.clj deleted file mode 100644 index 65b1371f..00000000 --- a/src/test/clojure/clojure/contrib/test_properties.clj +++ /dev/null @@ -1,63 +0,0 @@ -(ns clojure.contrib.test-properties - (:refer-clojure :exclude (spit)) - (:use clojure.test clojure.contrib.properties - [clojure.contrib.io :only (spit)]) - (:import (java.util Properties) - (java.io File))) - -(deftest test-get-system-property - (testing "works the same with keywords, symbols, and strings" - (is (= (get-system-property "java.home") (get-system-property 'java.home))) - (is (= (get-system-property "java.home") (get-system-property :java.home)))) - (testing "treats second arg as default" - (is (= "default" (get-system-property "testing.test-system-property" "default")))) - (testing "returns nil for missing properties" - (is (nil? (get-system-property "testing.test-system-property"))))) - -(deftest test-set-system-properties - (testing "set and then unset a property using keywords" - (let [propname :clojure.contrib.java.test-set-system-properties] - (is (nil? (get-system-property propname))) - (set-system-properties {propname :foo}) - (is (= "foo") (get-system-property propname)) - (set-system-properties {propname nil}) - (is (nil? (get-system-property propname)))))) - -(deftest test-with-system-properties - (let [propname :clojure.contrib.java.test-with-system-properties] - (testing "sets a property only for the duration of a block" - (is (= "foo" - (with-system-properties {propname "foo"} - (get-system-property propname)))) - (is (nil? (get-system-property propname))))) - (testing "leaves other properties alone" - ; TODO: write this test better, using a properties -> map function - (let [propname :clojure.contrib.java.test-with-system-properties - propcount (count (System/getProperties))] - (with-system-properties {propname "foo"} - (is (= (inc propcount) (count (System/getProperties))))) - (is (= propcount (count (System/getProperties))))))) - -(deftest test-as-properties - (let [expected (doto (Properties.) - (.setProperty "a" "b") - (.setProperty "c" "d"))] - (testing "with a map" - (is (= expected - (as-properties {:a "b" :c "d"})))) - (testing "with a sequence of pairs" - (is (= expected - (as-properties [[:a :b] [:c :d]])))))) - -(deftest test-read-properties - (let [f (File/createTempFile "test" "properties")] - (spit f "a=b\nc=d") - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - -(deftest test-write-properties - (let [f (File/createTempFile "test" "properties")] - (write-properties [['a 'b] ['c 'd]] f) - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - diff --git a/src/test/clojure/clojure/contrib/test_prxml.clj b/src/test/clojure/clojure/contrib/test_prxml.clj deleted file mode 100644 index 53b2b388..00000000 --- a/src/test/clojure/clojure/contrib/test_prxml.clj +++ /dev/null @@ -1,10 +0,0 @@ -(ns clojure.contrib.test-prxml - (:use clojure.test clojure.contrib.prxml)) - -(deftest prxml-basic - (is (= "<p>Hello, World!</p>" - (with-out-str (prxml [:p "Hello, World!"]))))) - -(deftest prxml-escaping - (is (= "<a href=\"foo&bar\">foo<bar</a>" - (with-out-str (prxml [:a {:href "foo&bar"} "foo<bar"]))))) diff --git a/src/test/clojure/clojure/contrib/test_repl_utils.clj b/src/test/clojure/clojure/contrib/test_repl_utils.clj deleted file mode 100644 index 6fa12ed7..00000000 --- a/src/test/clojure/clojure/contrib/test_repl_utils.clj +++ /dev/null @@ -1,20 +0,0 @@ -(ns clojure.contrib.test-repl-utils - (:use clojure.test - clojure.contrib.repl-utils)) - -(deftest test-apropos - (testing "with a regular expression" - (is (= '[defmacro] (apropos #"^defmacro$"))) - (is (some '#{defmacro} (apropos #"def.acr."))) - (is (= [] (apropos #"nothing-has-this-name")))) - - - (testing "with a string" - (is (some '#{defmacro} (apropos "defmacro"))) - (is (some '#{defmacro} (apropos "efmac"))) - (is (= [] (apropos "nothing-has-this-name")))) - - (testing "with a symbol" - (is (some '#{defmacro} (apropos 'defmacro))) - (is (some '#{defmacro} (apropos 'efmac))) - (is (= [] (apropos 'nothing-has-this-name))))) diff --git a/src/test/clojure/clojure/contrib/test_seq.clj b/src/test/clojure/clojure/contrib/test_seq.clj deleted file mode 100644 index eacd9b73..00000000 --- a/src/test/clojure/clojure/contrib/test_seq.clj +++ /dev/null @@ -1,128 +0,0 @@ -(ns clojure.contrib.test-seq - (:use clojure.test) - (:require [clojure.contrib.seq :as seq])) - - -(deftest test-positions - (are [expected pred coll] (= expected (seq/positions pred coll)) - [2] string? [:a :b "c"] - () :d [:a :b :c] - [0 2] #{:d} [:d :a :d :a])) - -;Upon further inspection, flatten behaves... wierd. -;These tests are what passes on August 7, 2009 -(deftest test-flatten-present - (are [expected nested-val] (= (seq/flatten nested-val) expected) - ;simple literals - [] nil - [] 1 - [] 'test - [] :keyword - [] 1/2 - [] #"[\r\n]" - [] true - [] false - ;vectors - [1 2 3 4 5] [[1 2] [3 4 [5]]] - [1 2 3 4 5] [1 2 3 4 5] - [#{1 2} 3 4 5] [#{1 2} 3 4 5] - ;sets - [] #{} - [] #{#{1 2} 3 4 5} - [] #{1 2 3 4 5} - [] #{#{1 2} 3 4 5} - ;lists - [] '() - [1 2 3 4 5] `(1 2 3 4 5) - ;maps - [] {:a 1 :b 2} - [:a 1 :b 2] (seq {:a 1 :b 2}) - [] {[:a :b] 1 :c 2} - [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2}) - [:a 1 2 :b 3] (seq {:a [1 2] :b 3}) - ;Strings - [] "12345" - [\1 \2 \3 \4 \5] (seq "12345") - ;fns - [] count - [count even? odd?] [count even? odd?])) - -(deftest test-separate - (are [test-seq] (= (seq/separate even? test-seq) [[2 4] [1 3 5]]) - [1 2 3 4 5] - #{1 2 3 4 5} - '(1 2 3 4 5))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-indexed - (are [expected test-seq] (= (seq/indexed test-seq) expected) - [[0 :a] [1 :b] [2 :c] [3 :d]] [:a :b :c :d] - [[0 :a] [1 :b] [2 :c] [3 :d]] '(:a :b :c :d) - [[0 \1] [1 \2] [2 \3] [3 \4]] "1234")) - -(deftest test-group-by - (is (= (seq/group-by even? [1 2 3 4 5]) - {false [1 3 5], true [2 4]}))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-partition-by - (are [test-seq] (= (seq/partition-by (comp even? count) test-seq) - [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]]) - ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"] - '("a" "bb" "cccc" "dd" "eee" "f" "" "hh")) - (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm") - [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]]))) - -(deftest test-frequencies - (are [expected test-seq] (= (seq/frequencies test-seq) expected) - {\p 2, \s 4, \i 4, \m 1} "mississippi" - {1 4 2 2 3 1} [1 1 1 1 2 2 3] - {1 4 2 2 3 1} '(1 1 1 1 2 2 3))) - -;Note - this does not make sense for maps and sets, because order is expected -;This is a key differnce between reductions and reduce. -(deftest test-reductions - (is (= (seq/reductions + [1 2 3 4 5]) - [1 3 6 10 15])) - (is (= (reductions + 10 [1 2 3 4 5]) - [10 11 13 16 20 25]))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-rotations - (is (= (seq/rotations [1 2 3 4]) - [[1 2 3 4] - [2 3 4 1] - [3 4 1 2] - [4 1 2 3]]))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-partition-all - (is (= (seq/partition-all 4 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [5 6 7 8] [9]])) - (is (= (seq/partition-all 4 2 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]]))) - -;Thanks to Andy Fingerhut for the idea of testing invariants -(deftest test-shuffle-invariants - (is (= (count (seq/shuffle [1 2 3 4])) 4)) - (let [shuffled-seq (seq/shuffle [1 2 3 4])] - (is (every? #{1 2 3 4} shuffled-seq)))) - -;Thanks to Andy Fingerhut for the idea of testing invariants -(deftest test-rand-elt-invariants - (let [elt (seq/rand-elt [:a :b :c :d])] - (is (#{:a :b :c :d} elt)))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-find-first - (is (= (seq/find-first even? [1 2 3 4 5]) 2)) - (is (= (seq/find-first even? '(1 2 3 4 5)) 2))) - -(deftest test-includes - (are [coll k] (false? (seq/includes? coll k)) - [1 2 3] 0 - [] nil - [:a :b] :c) - (are [coll k] (true? (seq/includes? coll k)) - [1 2 3] 1 - [:a :b] :b)) diff --git a/src/test/clojure/clojure/contrib/test_shell.clj b/src/test/clojure/clojure/contrib/test_shell.clj deleted file mode 100644 index 120093e7..00000000 --- a/src/test/clojure/clojure/contrib/test_shell.clj +++ /dev/null @@ -1,41 +0,0 @@ -(ns clojure.contrib.test-shell - (:use clojure.test - clojure.contrib.shell) - (:import (java.io File))) - -; workaroung to access private parse-args. Better way? -(def parse-args ((ns-interns 'clojure.contrib.shell) 'parse-args)) -(def as-file ((ns-interns 'clojure.contrib.shell) 'as-file)) -(def as-env-string ((ns-interns 'clojure.contrib.shell) 'as-env-string)) - -(deftest test-parse-args - (are [x y] (= x y) - {:cmd [nil] :out "UTF-8" :dir nil :env nil} (parse-args []) - {:cmd ["ls"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls"]) - {:cmd ["ls" "-l"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls" "-l"]) - {:cmd ["ls"] :out "ISO-8859-1" :dir nil :env nil} (parse-args ["ls" :out "ISO-8859-1"]) -)) - -(deftest test-with-sh-dir - (are [x y] (= x y) - nil *sh-dir* - "foo" (with-sh-dir "foo" *sh-dir*))) - -(deftest test-with-sh-env - (are [x y] (= x y) - nil *sh-env* - {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*))) - -(deftest test-as-env-string - (are [x y] (= x y) - nil (as-env-string nil) - ["FOO=BAR"] (seq (as-env-string {"FOO" "BAR"})) - ["FOO_SYMBOL=BAR"] (seq (as-env-string {'FOO_SYMBOL "BAR"})) - ["FOO_KEYWORD=BAR"] (seq (as-env-string {:FOO_KEYWORD "BAR"})))) - - -(deftest test-as-file - (are [x y] (= x y) - (File. "foo") (as-file "foo") - nil (as-file nil) - (File. "bar") (as-file (File. "bar"))))
\ No newline at end of file diff --git a/src/test/clojure/clojure/contrib/test_sql.clj b/src/test/clojure/clojure/contrib/test_sql.clj deleted file mode 100644 index 62c91ef0..00000000 --- a/src/test/clojure/clojure/contrib/test_sql.clj +++ /dev/null @@ -1,207 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. 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/example for clojure.contrib.sql -;; -;; scgilardi (gmail) -;; Created 13 September 2008 - -(ns clojure.contrib.test-sql - (:use [clojure.contrib.sql :as sql :only ()])) - -(def db {:classname "org.apache.derby.jdbc.EmbeddedDriver" - :subprotocol "derby" - :subname "/tmp/clojure.contrib.sql.test.db" - :create true}) - -(defn create-fruit - "Create a table" - [] - (sql/create-table - :fruit - [:name "varchar(32)" "PRIMARY KEY"] - [:appearance "varchar(32)"] - [:cost :int] - [:grade :real])) - -(defn drop-fruit - "Drop a table" - [] - (try - (sql/drop-table :fruit) - (catch Exception _))) - -(defn insert-rows-fruit - "Insert complete rows" - [] - (sql/insert-rows - :fruit - ["Apple" "red" 59 87] - ["Banana" "yellow" 29 92.2] - ["Peach" "fuzzy" 139 90.0] - ["Orange" "juicy" 89 88.6])) - -(defn insert-values-fruit - "Insert rows with values for only specific columns" - [] - (sql/insert-values - :fruit - [:name :cost] - ["Mango" 722] - ["Feijoa" 441])) - -(defn insert-records-fruit - "Insert records, maps from keys specifying columns to values" - [] - (sql/insert-records - :fruit - {:name "Pomegranate" :appearance "fresh" :cost 585} - {:name "Kiwifruit" :grade 93})) - -(defn db-write - "Write initial values to the database as a transaction" - [] - (sql/with-connection db - (sql/transaction - (drop-fruit) - (create-fruit) - (insert-rows-fruit) - (insert-values-fruit) - (insert-records-fruit))) - nil) - -(defn db-read - "Read the entire fruit table" - [] - (sql/with-connection db - (sql/with-query-results res - ["SELECT * FROM fruit"] - (doseq [rec res] - (println rec))))) - -(defn db-update-appearance-cost - "Update the appearance and cost of the named fruit" - [name appearance cost] - (sql/update-values - :fruit - ["name=?" name] - {:appearance appearance :cost cost})) - -(defn db-update - "Update two fruits as a transaction" - [] - (sql/with-connection db - (sql/transaction - (db-update-appearance-cost "Banana" "bruised" 14) - (db-update-appearance-cost "Feijoa" "green" 400))) - nil) - -(defn db-update-or-insert - "Updates or inserts a fruit" - [record] - (sql/with-connection db - (sql/update-or-insert-values - :fruit - ["name=?" (:name record)] - record))) - -(defn db-read-all - "Return all the rows of the fruit table as a vector" - [] - (sql/with-connection db - (sql/with-query-results res - ["SELECT * FROM fruit"] - (into [] res)))) - -(defn db-grade-range - "Print rows describing fruit that are within a grade range" - [min max] - (sql/with-connection db - (sql/with-query-results res - [(str "SELECT name, cost, grade " - "FROM fruit " - "WHERE grade >= ? AND grade <= ?") - min max] - (doseq [rec res] - (println rec))))) - -(defn db-grade-a - "Print rows describing all grade a fruit (grade between 90 and 100)" - [] - (db-grade-range 90 100)) - -(defn db-get-tables - "Demonstrate getting table info" - [] - (sql/with-connection db - (into [] - (resultset-seq - (-> (sql/connection) - (.getMetaData) - (.getTables nil nil nil (into-array ["TABLE" "VIEW"]))))))) - -(defn db-exception - "Demonstrate rolling back a partially completed transaction on exception" - [] - (sql/with-connection db - (sql/transaction - (sql/insert-values - :fruit - [:name :appearance] - ["Grape" "yummy"] - ["Pear" "bruised"]) - ;; at this point the insert-values call is complete, but the transaction - ;; is not. the exception will cause it to roll back leaving the database - ;; untouched. - (throw (Exception. "sql/test exception"))))) - -(defn db-sql-exception - "Demonstrate an sql exception" - [] - (sql/with-connection db - (sql/transaction - (sql/insert-values - :fruit - [:name :appearance] - ["Grape" "yummy"] - ["Pear" "bruised"] - ["Apple" "strange" "whoops"])))) - -(defn db-batchupdate-exception - "Demonstrate a batch update exception" - [] - (sql/with-connection db - (sql/transaction - (sql/do-commands - "DROP TABLE fruit" - "DROP TABLE fruit")))) - -(defn db-rollback - "Demonstrate a rollback-only trasaction" - [] - (sql/with-connection db - (sql/transaction - (prn "is-rollback-only" (sql/is-rollback-only)) - (sql/set-rollback-only) - (sql/insert-values - :fruit - [:name :appearance] - ["Grape" "yummy"] - ["Pear" "bruised"]) - (prn "is-rollback-only" (sql/is-rollback-only)) - (sql/with-query-results res - ["SELECT * FROM fruit"] - (doseq [rec res] - (println rec)))) - (prn) - (sql/with-query-results res - ["SELECT * FROM fruit"] - (doseq [rec res] - (println rec))))) diff --git a/src/test/clojure/clojure/contrib/test_string.clj b/src/test/clojure/clojure/contrib/test_string.clj deleted file mode 100644 index 98f03a78..00000000 --- a/src/test/clojure/clojure/contrib/test_string.clj +++ /dev/null @@ -1,124 +0,0 @@ -(ns clojure.contrib.test-string - (:require [clojure.contrib.string :as s]) - (:use clojure.test)) - -(deftest t-codepoints - (is (= (list 102 111 111 65536 98 97 114) - (s/codepoints "foo\uD800\uDC00bar")) - "Handles Unicode supplementary characters")) - -(deftest t-escape - (is (= "<foo&bar>" - (s/escape {\& "&" \< "<" \> ">"} "<foo&bar>"))) - (is (= " \\\"foo\\\" " - (s/escape {\" "\\\""} " \"foo\" " ))) - (is (= "faabor" (s/escape {\a \o, \o \a} "foobar")))) - -(deftest t-blank - (is (s/blank? nil)) - (is (s/blank? "")) - (is (s/blank? " ")) - (is (s/blank? " \t \n \r ")) - (is (not (s/blank? " foo ")))) - -(deftest t-take - (is (= "foo" (s/take 3 "foobar"))) - (is (= "foobar" (s/take 7 "foobar"))) - (is (= "" (s/take 0 "foo")))) - -(deftest t-drop - (is (= "bar" (s/drop 3 "foobar"))) - (is (= "" (s/drop 9 "foobar"))) - (is (= "foobar" (s/drop 0 "foobar")))) - -(deftest t-butlast - (is (= "foob" (s/butlast 2 "foobar"))) - (is (= "" (s/butlast 9 "foobar"))) - (is (= "foobar" (s/butlast 0 "foobar")))) - -(deftest t-tail - (is (= "ar" (s/tail 2 "foobar"))) - (is (= "foobar" (s/tail 9 "foobar"))) - (is (= "" (s/tail 0 "foobar")))) - -(deftest t-repeat - (is (= "foofoofoo" (s/repeat 3 "foo")))) - -(deftest t-reverse - (is (= "tab" (s/reverse "bat")))) - -(deftest t-replace - (is (= "faabar" (s/replace-char \o \a "foobar"))) - (is (= "barbarbar" (s/replace-str "foo" "bar" "foobarfoo"))) - (is (= "FOObarFOO" (s/replace-by #"foo" s/upper-case "foobarfoo")))) - -(deftest t-replace-first - (is (= "barbarfoo" (s/replace-first-re #"foo" "bar" "foobarfoo"))) - (is (= "FOObarfoo" (s/replace-first-by #"foo" s/upper-case "foobarfoo")))) - -(deftest t-partition - (is (= (list "" "abc" "123" "def") - (s/partition #"[a-z]+" "abc123def")))) - -(deftest t-join - (is (= "1,2,3" (s/join \, [1 2 3]))) - (is (= "" (s/join \, []))) - (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3])))) - -(deftest t-chop - (is (= "fo" (s/chop "foo"))) - (is (= "") (s/chop "f")) - (is (= "") (s/chop ""))) - -(deftest t-chomp - (is (= "foo" (s/chomp "foo\n"))) - (is (= "foo" (s/chomp "foo\r\n"))) - (is (= "foo" (s/chomp "foo"))) - (is (= "" (s/chomp "")))) - -(deftest t-swap-case - (is (= "fOO!bAR" (s/swap-case "Foo!Bar"))) - (is (= "" (s/swap-case "")))) - -(deftest t-capitalize - (is (= "Foobar" (s/capitalize "foobar"))) - (is (= "Foobar" (s/capitalize "FOOBAR")))) - -(deftest t-ltrim - (is (= "foo " (s/ltrim " foo "))) - (is (= "" (s/ltrim " ")))) - -(deftest t-rtrim - (is (= " foo" (s/rtrim " foo "))) - (is (= "" (s/rtrim " ")))) - -(deftest t-split-lines - (is (= (list "one" "two" "three") - (s/split-lines "one\ntwo\r\nthree"))) - (is (= (list "foo") (s/split-lines "foo")))) - -(deftest t-upper-case - (is (= "FOOBAR" (s/upper-case "Foobar")))) - -(deftest t-lower-case - (is (= "foobar" (s/lower-case "FooBar")))) - -(deftest t-trim - (is (= "foo" (s/trim " foo \r\n")))) - -(deftest t-substring - (is (s/substring? "foo" "foobar")) - (is (not (s/substring? "baz" "foobar")))) - -(deftest t-get - (is (= \o (s/get "foo" 1)))) - -(deftest t-as-str - (testing "keyword to string" - (is (= "foo") (s/as-str :foo))) - (testing "symbol to string" - (is (= "foo") (s/as-str 'foo))) - (testing "string to string" - (is (= "foo") (s/as-str "foo"))) - (testing "stringifying non-namish things" - (is (= "42") (s/as-str 42)))) diff --git a/src/test/clojure/clojure/contrib/test_strint.clj b/src/test/clojure/clojure/contrib/test_strint.clj deleted file mode 100644 index 83ff1f86..00000000 --- a/src/test/clojure/clojure/contrib/test_strint.clj +++ /dev/null @@ -1,41 +0,0 @@ -; Copyright (c) Stuart Halloway, 2010-. 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.contrib.test-strint - (:use clojure.test) - (:use [clojure.contrib strint with-ns])) - -(def silent-read (with-ns 'clojure.contrib.strint silent-read)) -(def interpolate (with-ns 'clojure.contrib.strint interpolate)) - -(deftest test-silent-read - (testing "reading a valid form returns [read form, rest of string]" - (is (= [[1] "[2]"] (silent-read "[1][2]")))) - (testing "reading an invalid form returns nil" - (is (= nil (silent-read "["))))) - -(deftest test-interpolate - (testing "a plain old string" - (is (= ["a plain old string"] (interpolate "a plain old string")))) - (testing "some value replacement forms" - (is (= '["" foo " and " bar ""] (interpolate "~{foo} and ~{bar}")))) - (testing "some fn-calling forms" - (is (= '["" (+ 1 2) " and " (vector 3) ""] (interpolate "~(+ 1 2) and ~(vector 3)"))))) - -(deftest test-<< - (testing "docstring examples" - (let [v 30.5 - m {:a [1 2 3]}] - (is (= "This trial required 30.5ml of solution." - (<< "This trial required ~{v}ml of solution."))) - (is (= "There are 30 days in November." - (<< "There are ~(int v) days in November."))) - (is (= "The total for your order is $6." - (<< "The total for your order is $~(->> m :a (apply +)).")))))) diff --git a/src/test/clojure/clojure/contrib/test_trace.clj b/src/test/clojure/clojure/contrib/test_trace.clj deleted file mode 100644 index 015fff65..00000000 --- a/src/test/clojure/clojure/contrib/test_trace.clj +++ /dev/null @@ -1,16 +0,0 @@ -(ns clojure.contrib.test-trace - (:use clojure.test - clojure.contrib.trace)) - -(deftrace call-myself [n] - (when-not (< n 1) - (call-myself (dec n)))) - -(deftest test-tracing-a-function-that-calls-itself - (let [output (with-out-str (call-myself 1))] - (is (re-find #"^TRACE t\d+: (call-myself 1)\nTRACE t\d+: | (call-myself 0)\nTRACE t\d+: | => nil\nTRACE t\d+: => nil$" - output)))) - -;(deftest dotrace-on-core -; (let [output (with-out-str (dotrace [mod] (mod 11 5)))] -; (is (re-find #"\(mod 11 5\)" output)))) diff --git a/src/test/clojure/clojure/contrib/test_with_ns.clj b/src/test/clojure/clojure/contrib/test_with_ns.clj deleted file mode 100644 index 8d3ca3c1..00000000 --- a/src/test/clojure/clojure/contrib/test_with_ns.clj +++ /dev/null @@ -1,18 +0,0 @@ -(ns clojure.contrib.test-with-ns - (:use clojure.test - clojure.contrib.with-ns)) - -(deftest test-namespace-gets-removed - (let [all-ns-names (fn [] (map #(.name %) (all-ns)))] - (testing "unexceptional return" - (let [ns-name (with-temp-ns (ns-name *ns*))] - (is (not (some #{ns-name} (all-ns-names)))))) - (testing "when an exception is thrown" - (let [ns-name-str - (try - (with-temp-ns - (throw (RuntimeException. (str (ns-name *ns*))))) - (catch clojure.lang.Compiler$CompilerException e - (-> e .getCause .getMessage)))] - (is (re-find #"^sym.*$" ns-name-str)) - (is (not (some #{(symbol ns-name-str)} (all-ns-names)))))))) |