├── ORIGINATOR ├── .github ├── CODEOWNERS └── workflows │ └── clojure.yml ├── examples └── simple │ ├── deps.edn │ └── src │ └── foo.clj ├── doc ├── serial1.png ├── parallel2.png ├── over-parallel2.png └── BLOG.md ├── NOTICE ├── .gitignore ├── test └── com │ └── climate │ ├── claypoole │ ├── test_helpers.clj │ ├── impl_test.clj │ └── lazy_test.clj │ └── claypoole_test.clj ├── deps.edn ├── src ├── java │ └── com │ │ └── climate │ │ └── claypoole │ │ └── impl │ │ ├── Prioritized.java │ │ ├── PriorityFutureTask.java │ │ └── PriorityThreadpoolImpl.java └── clj │ └── com │ └── climate │ ├── claypoole │ ├── lazy.clj │ └── impl.clj │ └── claypoole.clj ├── resources └── clj-kondo.exports │ └── clj-kondo │ └── claypoole │ ├── clj_kondo │ └── claypoole.clj │ └── config.edn ├── CHANGES.txt ├── project.clj ├── .circleci └── config.yml ├── LICENSE └── README.md /ORIGINATOR: -------------------------------------------------------------------------------- 1 | @leon-barrett 2 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @ieugen 2 | -------------------------------------------------------------------------------- /examples/simple/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clj-commons/claypoole {:mvn/version "1.2.2"}}} -------------------------------------------------------------------------------- /doc/serial1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/claypoole/HEAD/doc/serial1.png -------------------------------------------------------------------------------- /doc/parallel2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/claypoole/HEAD/doc/parallel2.png -------------------------------------------------------------------------------- /doc/over-parallel2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/claypoole/HEAD/doc/over-parallel2.png -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | Claypoole 2 | Copyright 2014 The Climate Corporation 3 | 4 | This product includes software developed at 5 | The Climate Corporation (http://climate.com/). 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | *.jar 3 | .*.swp 4 | .lein-failures 5 | .lein-plugins 6 | .lein-repl-history 7 | .nrepl-port 8 | /classes/ 9 | /lib/ 10 | /target/ 11 | .lein-deps-sum 12 | .clj-kondo/.cache 13 | .lsp/.cache 14 | .portal/vs-code.edn 15 | .cache 16 | .cpcache 17 | **/.calva/output-window 18 | -------------------------------------------------------------------------------- /.github/workflows/clojure.yml: -------------------------------------------------------------------------------- 1 | name: Clojure CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build: 7 | runs-on: Ubuntu-20.04 8 | steps: 9 | - uses: actions/checkout@v2 10 | - uses: actions/setup-java@v1 11 | with: 12 | java-version: '1.8' # The JDK version to make available on the path. 13 | java-package: jdk # (jre, jdk, or jdk+fx) - defaults to jdk 14 | architecture: x64 # (x64 or x86) - defaults to x64 15 | - uses: DeLaGuardo/setup-clojure@3.1 16 | with: 17 | tools-deps: '1.10.1.469' 18 | # leiningen and boot-cli can be installed as well 19 | lein: 2.9.4 20 | - name: Run tests 21 | run: lein test 22 | -------------------------------------------------------------------------------- /test/com/climate/claypoole/test_helpers.clj: -------------------------------------------------------------------------------- 1 | (ns com.climate.claypoole.test-helpers) 2 | 3 | (defn eval+ex-unwrap 4 | "Test helper. 5 | Clojure 1.10 throws CompilerException from eval. 6 | We unwrap that exception to get the original." 7 | [code] 8 | (try 9 | (eval code) 10 | (catch clojure.lang.Compiler$CompilerException e 11 | (let [cause (.getCause e)] 12 | ;; Update the stack trace to include e 13 | (.setStackTrace cause (into-array StackTraceElement 14 | (concat 15 | (.getStackTrace cause) 16 | (.getStackTrace e)))) 17 | (throw cause))))) 18 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["resources" "src/clj" "target/classes"] 2 | :deps {} 3 | :deps/prep-lib {:alias :build 4 | :fn compile 5 | :ensure "target/classes"} 6 | :aliases 7 | {:clojure-1.9 {:extra-deps {org.clojure/clojure {:mvn/version "1.9.0"}}} 8 | :clojure-1.10 {:extra-deps {org.clojure/clojure {:mvn/version "1.10.3"}}} 9 | :clojure-1.11 {:extra-deps {org.clojure/clojure {:mvn/version "1.11.0-beta1"}}} 10 | :test {:extra-paths ["test"] 11 | :extra-deps {io.github.cognitect-labs/test-runner 12 | {:git/url "https://github.com/cognitect-labs/test-runner.git" 13 | :sha "9e35c979860c75555adaff7600070c60004a0f44"}} 14 | :main-opts ["-m" "cognitect.test-runner"] 15 | :exec-fn cognitect.test-runner.api/test} 16 | :build {:deps {io.github.clojure/tools.build {:git/tag "v0.7.5" :git/sha "34727f7"}} 17 | :ns-default build}}} 18 | -------------------------------------------------------------------------------- /src/java/com/climate/claypoole/impl/Prioritized.java: -------------------------------------------------------------------------------- 1 | // The Climate Corporation licenses this file to you under under the Apache 2 | // License, Version 2.0 (the "License"); you may not use this file except in 3 | // compliance with the License. You may obtain a copy of the License at 4 | // 5 | // http://www.apache.org/licenses/LICENSE-2.0 6 | // 7 | // See the NOTICE file distributed with this work for additional information 8 | // regarding copyright ownership. Unless required by applicable law or agreed 9 | // to in writing, software distributed under the License is distributed on an 10 | // "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | // or implied. See the License for the specific language governing permissions 12 | // and limitations under the License. 13 | 14 | package com.climate.claypoole.impl; 15 | 16 | /** An object with a priority. */ 17 | public interface Prioritized { 18 | public long getPriority(); 19 | } 20 | -------------------------------------------------------------------------------- /examples/simple/src/foo.clj: -------------------------------------------------------------------------------- 1 | (ns foo 2 | (:require [com.climate.claypoole :as cp] 3 | [com.climate.claypoole.lazy :as lazy])) 4 | 5 | (let [slow (fn [x] (Thread/sleep 100) x) ; we slow the work so the buffer fills 6 | prn+1 (comp prn inc slow) 7 | data (cons 1 (take 10 (iterate inc 0)))] ; we use iterate inc to avoid chunking 8 | ;; Core map does no work after an exception, so no numbers will be printed. 9 | (dorun (map prn+1 data)) 10 | ;; Core pmap does ncpus + 2 work after an exception, so on a quad-core 11 | ;; computer, 6 numbers will be printed. 12 | (doall (pmap prn+1 data)) 13 | ;; Claypoole eager pmap does pool size * 2 - 1 work after an exception, since 14 | ;; the exceptional task is part of the buffer, so 5 numbers will be printed. 15 | (doall (cp/pmap 3 prn+1 data)) 16 | ;; Claypoole lazy pmap does pool size work after an exception, so 3 numbers 17 | ;; will be printed. 18 | (doall (lazy/pmap 3 prn+1 data))) 19 | 20 | 21 | (comment 22 | 23 | (println "x") 24 | 25 | 0) -------------------------------------------------------------------------------- /resources/clj-kondo.exports/clj-kondo/claypoole/clj_kondo/claypoole.clj: -------------------------------------------------------------------------------- 1 | (ns clj-kondo.claypoole 2 | (:refer-clojure :exclude [future pmap pvalues]) 3 | (:require [clj-kondo.hooks-api :as api])) 4 | 5 | (defn pool-and-body 6 | [token] 7 | (fn [{:keys [:node]}] 8 | (let [[pool & body] (rest (:children node)) 9 | new-node (api/list-node 10 | (list* 11 | (api/token-node token) 12 | (api/list-node 13 | (list* (api/token-node 'do) 14 | pool 15 | body))))] 16 | {:node (with-meta new-node 17 | (meta node))}))) 18 | 19 | (defn pool-with-binding-vec-or-exprs-and-body 20 | [token] 21 | (fn [{:keys [:node]}] 22 | (let [[pool binding-vec-or-exprs & body] (rest (:children node)) 23 | new-node (api/list-node 24 | [(api/token-node token) 25 | binding-vec-or-exprs 26 | (api/list-node 27 | (list* (api/token-node 'do) 28 | pool 29 | body))])] 30 | {:node (with-meta new-node 31 | (meta node))}))) 32 | 33 | (def future (pool-and-body 'future)) 34 | (def completable-future (pool-and-body 'future)) 35 | (def pdoseq (pool-with-binding-vec-or-exprs-and-body 'doseq)) 36 | (def pmap (pool-and-body 'map)) 37 | (def upmap (pool-and-body 'map)) 38 | (def pvalues (pool-and-body 'pvalues)) 39 | (def upvalues (pool-and-body 'pvalues)) 40 | (def pfor (pool-with-binding-vec-or-exprs-and-body 'for)) 41 | (def upfor (pool-with-binding-vec-or-exprs-and-body 'for)) 42 | -------------------------------------------------------------------------------- /CHANGES.txt: -------------------------------------------------------------------------------- 1 | CHANGES 2 | 3 | 1.2.2 4 | 5 | - Change group-id to org.clj-commons 6 | - Build using openjdk-8 and switched to 1.8 compile version. 7 | - Added deps.edn - support for tools-deps 8 | - Fix CLJ-2619 equivalent bug in claypoole (thanks Mike Kaplinskiy - mikekap) 9 | - CI tests use clojure versions 1.9.x, 1.10.x and 1.11.x https://github.com/clj-commons/claypoole/issues/57 10 | 11 | 1.1.3 12 | 13 | - Updated documentation 14 | - Upgraded lein-ancient plugin 15 | 16 | 1.1.2 17 | 18 | - Built with Java 1.6 again 19 | 20 | 1.1.1 21 | 22 | - Added prun! 23 | 24 | 1.1.0 25 | 26 | - Added pdoseq 27 | 28 | 1.0.0 29 | 30 | - No changes 31 | 32 | 0.4.0 33 | 34 | - Added lazy functions in com.climate.claypoole.lazy 35 | - Changed pmap functions to throw the original exception, not a 36 | java.util.concurrent.ExecutionException 37 | - Changed how pmaps deal with exceptions; they no longer kill running tasks if 38 | one task fails 39 | 40 | 0.3.3 41 | 42 | - Fixed memory leak / overeager pushing of tasks into the queue 43 | 44 | 0.3.2 45 | 46 | - Fixed memory leak / holding of head of lazy sequences 47 | 48 | 0.3.1 49 | 50 | - Fixed handling of non-Exception Throwables 51 | 52 | 0.3 53 | 54 | - Changed threadpools to be daemon by default 55 | 56 | 0.2.2 57 | 58 | - Made pmap behave like map does when a function throws an exception 59 | 60 | 0.2.1 61 | 62 | - Made code work with java 1.6 63 | 64 | 0.2.0 65 | 66 | - Added priority threadpools 67 | - Made with-shutdown! option take multiple threadpools 68 | - Fixed exception handling in upmap 69 | 70 | 0.1.1 71 | 72 | - Fixed major bug where pmap etc. blocked on reading the entire input stream 73 | 74 | 0.1.0 75 | 76 | - Initial version 77 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/clj-kondo/claypoole/config.edn: -------------------------------------------------------------------------------- 1 | {:linters {:claypoole {:level :warning}} 2 | :lint-as {com.climate.claypoole/with-shutdown! clojure.core/let} 3 | :hooks {:analyze-call {com.climate.claypoole/future clj-kondo.claypoole/future 4 | com.climate.claypoole/completable-future clj-kondo.claypoole/completable-future 5 | com.climate.claypoole/pdoseq clj-kondo.claypoole/pdoseq 6 | com.climate.claypoole/pmap clj-kondo.claypoole/pmap 7 | com.climate.claypoole/upmap clj-kondo.claypoole/upmap 8 | com.climate.claypoole/pvalues clj-kondo.claypoole/pvalues 9 | com.climate.claypoole/upvalues clj-kondo.claypoole/upvalues 10 | com.climate.claypoole/pfor clj-kondo.claypoole/pfor 11 | com.climate.claypoole/upfor clj-kondo.claypoole/upfor 12 | com.climate.claypoole.lazy/pdoseq clj-kondo.claypoole/pdoseq 13 | com.climate.claypoole.lazy/pmap clj-kondo.claypoole/pmap 14 | com.climate.claypoole.lazy/upmap clj-kondo.claypoole/upmap 15 | com.climate.claypoole.lazy/pvalues clj-kondo.claypoole/pvalues 16 | com.climate.claypoole.lazy/upvalues clj-kondo.claypoole/upvalues 17 | com.climate.claypoole.lazy/pfor clj-kondo.claypoole/pfor 18 | com.climate.claypoole.lazy/upfor clj-kondo.claypoole/upfor}}} 19 | -------------------------------------------------------------------------------- /src/java/com/climate/claypoole/impl/PriorityFutureTask.java: -------------------------------------------------------------------------------- 1 | // The Climate Corporation licenses this file to you under under the Apache 2 | // License, Version 2.0 (the "License"); you may not use this file except in 3 | // compliance with the License. You may obtain a copy of the License at 4 | // 5 | // http://www.apache.org/licenses/LICENSE-2.0 6 | // 7 | // See the NOTICE file distributed with this work for additional information 8 | // regarding copyright ownership. Unless required by applicable law or agreed 9 | // to in writing, software distributed under the License is distributed on an 10 | // "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | // or implied. See the License for the specific language governing permissions 12 | // and limitations under the License. 13 | 14 | package com.climate.claypoole.impl; 15 | 16 | import java.util.concurrent.Callable; 17 | import java.util.concurrent.FutureTask; 18 | 19 | /** A prioritized, sortable FutureTask. */ 20 | public class PriorityFutureTask 21 | extends FutureTask 22 | implements Prioritized, Comparable { 23 | private long priority; 24 | 25 | public PriorityFutureTask(Runnable runnable, V value, long priority) { 26 | super(runnable, value); 27 | this.priority = priority; 28 | } 29 | 30 | public PriorityFutureTask(Callable callable, long priority) { 31 | super(callable); 32 | this.priority = priority; 33 | } 34 | 35 | @Override 36 | public int compareTo(Prioritized other) { 37 | // Sort for descending order. 38 | return (int)Math.max(-1l, Math.min(1l, (other.getPriority() - this.getPriority()))); 39 | } 40 | 41 | @Override 42 | public long getPriority() { 43 | return this.priority; 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (defproject org.clj-commons/claypoole 15 | (or (System/getenv "PROJECT_VERSION") "1.2.0") 16 | :description "Claypoole: Threadpool tools for Clojure." 17 | :url "https://github.com/clj-commons/claypoole" 18 | :license {:name "Apache License Version 2.0" 19 | :url "http://www.apache.org/licenses/LICENSE-2.0" 20 | :distribution :repo} 21 | :deploy-repositories [["clojars" {:url "https://repo.clojars.org" 22 | :username :env/clojars_username 23 | :password :env/clojars_password 24 | :sign-releases true}]] 25 | 26 | :min-lein-version "2.0.0" 27 | :source-paths ["src/clj"] 28 | :resource-paths ["resources"] 29 | :java-source-paths ["src/java"] 30 | :pedantic? :warn 31 | :profiles {:dev {:dependencies [[org.clojure/clojure "1.10.3"]]} 32 | :clojure-1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} 33 | :clojure-1.10 {:dependencies [[org.clojure/clojure "1.10.3"]]} 34 | :clojure-1.11 {:dependencies [[org.clojure/clojure "1.11.0-rc1"]]}} 35 | :plugins [[jonase/eastwood "0.2.3"] 36 | [lein-ancient "0.7.0"]] 37 | ;; Make sure we build for Java 1.6 for improved backwards compatibility. 38 | :javac-options ["-target" "1.8" "-source" "1.8"]) 39 | -------------------------------------------------------------------------------- /test/com/climate/claypoole/impl_test.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (ns com.climate.claypoole.impl-test 15 | (:require [clojure.test :refer :all] 16 | [com.climate.claypoole.impl :as impl])) 17 | 18 | 19 | (deftest test-queue-seq 20 | (let [[q qs] (impl/queue-seq)] 21 | (doseq [i (range 10)] 22 | (impl/queue-seq-add! q i)) 23 | (impl/queue-seq-end! q) 24 | (is (= (range 10) qs)))) 25 | 26 | (deftest test-lazy-co-read 27 | (let [s1 (range 10) 28 | s2 (concat (range 10) (lazy-seq (deref (promise))))] 29 | (is (= (map #(list % %) (range 10)) 30 | (impl/lazy-co-read s1 s2))))) 31 | 32 | (deftest test-seq-open 33 | (testing "seq-open doesn't call f early" 34 | (let [a (atom false)] 35 | (->> (range 10) 36 | (impl/seq-open #(reset! a true)) 37 | (take 5) 38 | dorun) 39 | (is (false? @a)))) 40 | (testing "seq-open calls f when s is complete" 41 | (let [a (atom false)] 42 | (->> (range 10) 43 | (impl/seq-open #(reset! a true)) 44 | dorun) 45 | (is (true? @a)))) 46 | (testing "seq-open calls f when there's an exception" 47 | (let [a (atom false)] 48 | (is (thrown? ClassCastException 49 | (->> [1 :x 2] 50 | impl/unchunk 51 | (map inc) 52 | (impl/seq-open #(reset! a true)) 53 | dorun))) 54 | (is (true? @a))))) 55 | -------------------------------------------------------------------------------- /src/java/com/climate/claypoole/impl/PriorityThreadpoolImpl.java: -------------------------------------------------------------------------------- 1 | // The Climate Corporation licenses this file to you under under the Apache 2 | // License, Version 2.0 (the "License"); you may not use this file except in 3 | // compliance with the License. You may obtain a copy of the License at 4 | // 5 | // http://www.apache.org/licenses/LICENSE-2.0 6 | // 7 | // See the NOTICE file distributed with this work for additional information 8 | // regarding copyright ownership. Unless required by applicable law or agreed 9 | // to in writing, software distributed under the License is distributed on an 10 | // "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | // or implied. See the License for the specific language governing permissions 12 | // and limitations under the License. 13 | 14 | package com.climate.claypoole.impl; 15 | 16 | import java.util.concurrent.Callable; 17 | import java.util.concurrent.PriorityBlockingQueue; 18 | import java.util.concurrent.RunnableFuture; 19 | import java.util.concurrent.ThreadPoolExecutor; 20 | import java.util.concurrent.ThreadFactory; 21 | import java.util.concurrent.TimeUnit; 22 | 23 | /** A fixed-size threadpool that does tasks in priority order. 24 | * 25 | * Submitted tasks have their own priority if they implement Prioritized; 26 | * otherwise, they are assigned the pool's default priority. 27 | */ 28 | public class PriorityThreadpoolImpl extends ThreadPoolExecutor { 29 | public PriorityThreadpoolImpl(int poolSize) { 30 | this(poolSize, 0); 31 | } 32 | 33 | public PriorityThreadpoolImpl(int poolSize, long defaultPriority) { 34 | super(poolSize, poolSize, 0, TimeUnit.MILLISECONDS, 35 | new PriorityBlockingQueue(poolSize)); 36 | this.defaultPriority = defaultPriority; 37 | } 38 | 39 | public PriorityThreadpoolImpl(int poolSize, ThreadFactory threadFactory, 40 | long defaultPriority) { 41 | this(poolSize, poolSize, 0, TimeUnit.MILLISECONDS, threadFactory, 42 | defaultPriority); 43 | } 44 | 45 | public PriorityThreadpoolImpl(int corePoolSize, int maximumPoolSize, 46 | long keepAliveTime, TimeUnit unit, 47 | ThreadFactory threadFactory, long defaultPriority) { 48 | super(corePoolSize, maximumPoolSize, keepAliveTime, unit, 49 | new PriorityBlockingQueue(corePoolSize), threadFactory); 50 | this.defaultPriority = defaultPriority; 51 | } 52 | 53 | /** Get the priority of an object, using our defaultPriority as a backup. 54 | */ 55 | protected long getPriority(Object o) { 56 | if (o instanceof Prioritized) { 57 | return ((Prioritized) o).getPriority(); 58 | } 59 | return defaultPriority; 60 | } 61 | 62 | @Override 63 | protected RunnableFuture newTaskFor(Runnable runnable, T value) { 64 | return new PriorityFutureTask(runnable, value, getPriority(runnable)); 65 | } 66 | 67 | @Override 68 | protected RunnableFuture newTaskFor(Callable callable) { 69 | return new PriorityFutureTask(callable, getPriority(callable)); 70 | } 71 | 72 | public long getDefaultPriority() { 73 | return defaultPriority; 74 | } 75 | 76 | protected long defaultPriority; 77 | } 78 | -------------------------------------------------------------------------------- /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2.1 2 | 3 | workflows: 4 | build-deploy: 5 | jobs: 6 | - build: 7 | filters: 8 | tags: 9 | only: /.*/ 10 | 11 | - deploy: 12 | requires: 13 | - build 14 | filters: 15 | tags: 16 | only: /Release-.*/ 17 | context: 18 | - CLOJARS_DEPLOY 19 | 20 | jobs: 21 | build: 22 | docker: 23 | # specify the version you desire here 24 | - image: clojure:openjdk-8-lein-2.9.8-bullseye 25 | 26 | # Specify service dependencies here if necessary 27 | # CircleCI maintains a library of pre-built images 28 | # documented at https://circleci.com/docs/2.0/circleci-images/ 29 | # - image: circleci/postgres:9.4 30 | 31 | working_directory: ~/repo 32 | 33 | environment: 34 | LEIN_ROOT: "true" 35 | # Customize the JVM maximum heap limit 36 | JVM_OPTS: -Xmx3200m 37 | 38 | steps: 39 | - checkout 40 | 41 | # Download and cache dependencies 42 | - restore_cache: 43 | keys: 44 | - v1-dependencies-{{ checksum "project.clj" }} 45 | # fallback to using the latest cache if no exact match is found 46 | - v1-dependencies- 47 | 48 | - run: lein deps 49 | 50 | - save_cache: 51 | paths: 52 | - ~/.m2 53 | key: v1-dependencies-{{ checksum "project.clj" }} 54 | 55 | - run: 56 | name: Ensure No Reflection Warnings 57 | command: "! lein check 2>&1 | grep 'Reflection warning'" 58 | 59 | - run: 60 | name: Run tests with clojure 1.9 61 | command: lein with-profile clojure-1.9 do clean, test 62 | - run: 63 | name: Run tests with clojure 1.10 64 | command: lein with-profile clojure-1.10 do clean, test 65 | - run: 66 | name: Run tests with clojure 1.11 67 | command: lein with-profile clojure-1.11 do clean, test 68 | 69 | deploy: 70 | docker: 71 | # specify the version you desire here 72 | - image: clojure:openjdk-8-lein-2.9.8-bullseye 73 | # Specify service dependencies here if necessary 74 | # CircleCI maintains a library of pre-built images 75 | # documented at https://circleci.com/docs/2.0/circleci-images/ 76 | # - image: circleci/postgres:9.4 77 | 78 | working_directory: ~/repo 79 | 80 | environment: 81 | LEIN_ROOT: "true" 82 | # Customize the JVM maximum heap limit 83 | JVM_OPTS: -Xmx3200m 84 | 85 | steps: 86 | - checkout 87 | 88 | # Download and cache dependencies 89 | - restore_cache: 90 | keys: 91 | - v1-dependencies-{{ checksum "project.clj" }} 92 | # fallback to using the latest cache if no exact match is found 93 | - v1-dependencies- 94 | 95 | # Download and cache dependencies 96 | - restore_cache: 97 | keys: 98 | - v1-dependencies-{{ checksum "project.clj" }} 99 | # fallback to using the latest cache if no exact match is found 100 | - v1-dependencies- 101 | 102 | - run: 103 | name: Install babashka 104 | command: | 105 | curl -s https://raw.githubusercontent.com/borkdude/babashka/master/install -o install.sh 106 | bash install.sh 107 | rm install.sh 108 | - run: 109 | name: Install deployment-script 110 | command: | 111 | curl -s https://raw.githubusercontent.com/clj-commons/infra/main/deployment/circle-maybe-deploy.bb -o circle-maybe-deploy.bb 112 | chmod a+x circle-maybe-deploy.bb 113 | 114 | - run: lein deps 115 | 116 | - run: 117 | name: Setup GPG signing key 118 | command: | 119 | apt-get update 120 | apt-get install -y make gnupg 121 | GNUPGHOME="$HOME/.gnupg" 122 | export GNUPGHOME 123 | mkdir -p "$GNUPGHOME" 124 | chmod 0700 "$GNUPGHOME" 125 | 126 | echo "$GPG_KEY" \ 127 | | base64 --decode --ignore-garbage \ 128 | | gpg --batch --allow-secret-key-import --import 129 | 130 | gpg --keyid-format LONG --list-secret-keys 131 | 132 | - save_cache: 133 | paths: 134 | - ~/.m2 135 | key: v1-dependencies-{{ checksum "project.clj" }} 136 | - run: 137 | name: Deploy 138 | command: | 139 | GPG_TTY=$(tty) 140 | export GPG_TTY 141 | echo $GPG_TTY 142 | ./circle-maybe-deploy.bb lein deploy clojars 143 | -------------------------------------------------------------------------------- /doc/BLOG.md: -------------------------------------------------------------------------------- 1 | # Claypoole: Threadpool tools for Clojure 2 | 3 | _Posted on February 25, 2014 by Leon Barrett_ 4 | 5 | At The Climate Corporation, we have “sprintbaticals”, two-week projects where we can work on something a bit different. This post is about work done by Leon Barrett during his recent sprintbatical. 6 | 7 | At the Climate Corporation, we do a lot of resource-intensive scientific modeling, especially of weather and plant growth. We use parallelism, such as pmap, to speed that up whenever possible. We recently released a library, [claypoole](https://github.com/TheClimateCorporation/claypoole), that makes it easy to use and manage threadpools for such parallelism. 8 | 9 | To use claypoole, add the Leiningen dependency `[com.climate/claypoole "0.2.1"]`. 10 | 11 | # Why? 12 | 13 | Basically, we just wanted a better pmap. Clojure’s pmap is pretty awesome, but we wanted to be able to control the number of threads we were using, and it was nice to get a few other bonus features. (Frankly, we were surprised that we couldn’t find such a library when we searched.) 14 | 15 | Although the parallelism we need is simple, the structure of our computations is often relatively complex. We first compute some things, then make requests to a service, then process some other stuff, then … you get the picture. We want to be able to control our number of threads across multiple stages of work and multiple simultaneous requests. 16 | 17 | Nevertheless, we don’t really need [core.async’s asynchronous programming](https://github.com/clojure/core.async). Coroutines and channels are nice, but our parallelism needs don’t require their complexity, and we’d still have to manage the amount of concurrency we were using. 18 | 19 | Similarly, [reducers](http://clojure.org/reducers) are great, but they’re really just oriented at CPU-bound tasks. We needed more flexibility than that. 20 | 21 | # Aside: So why do you need so many threads? 22 | 23 | Like many of you, we’re consuming resources that have some ideal amount of parallelism: they have some maximum throughput, and trying to use more or less than that is ineffective. For instance, we want to use our CPU cores but not have too many context switches, and we want to amortize our network latency but not overload our backend services. 24 | 25 | Consider using parallelism to amortize network latency. Each request we make has a delay (latency) before the server begins responding, plus a span of network transfer. If we just run serial network requests, we’ll see a timeline like this: 26 | 27 | ![serial](serial1.png) 28 | 29 | That means that we’re not actually making good use of our network bandwidth. In fact, the network is sitting idle for most of the time. Instead, with optimal parallelism, we’ll get much fuller usage of our bandwidth by having the latency period of the requests overlap. 30 | 31 | ![parallel](parallel2.png) 32 | 33 | The transfers may be individually somewhat slower because we’re sharing bandwidth, but on average we finish sooner. On the other hand, with too much parallelism, we’ll use our bandwidth well, but we’ll see our average total latency go up: 34 | 35 | ![over-parallel](over-parallel2.png) 36 | 37 | That’s why we want to be able to control how much parallelism we use. 38 | 39 | # How do I use it? 40 | 41 | Just make a threadpool and use it in claypoole’s version of a parallel function like future, pmap, pcalls, and so on. We even made a parallel for. 42 | 43 | ```clojure 44 | (require '[com.climate.claypoole :as cp]) 45 | (cp/with-shutdown! [pool (cp/threadpool 4)] 46 | (cp/future pool (+ 1 2)) 47 | (cp/pmap pool inc (range 10)) 48 | (cp/pvalues pool (str "si" "mul") (str "ta" "neous")) 49 | (cp/pfor pool [i (range 10)] 50 | (* i (- i 2)))) 51 | ``` 52 | 53 | They stream their results eagerly, so you don’t have to force them to be realized with something like doall as you would for .core.pmap. And, because they produce sequential streams of output and take sequential streams of input, you can chain them easily. 54 | 55 | ```clojure 56 | (->> (range 3) 57 | (cp/pmap pool inc) 58 | (cp/pmap pool #(* 2 %)) 59 | (cp/pmap other-pool #(doto % log/info))) 60 | ``` 61 | 62 | # Got anything cooler than that? 63 | 64 | You don’t have to manage the threadpool at all, really. If you just need a temporary pool (and don’t care about the overhead of spawning new threads), you can just let the parallel function do it for you. 65 | 66 | ```clojure 67 | ;; Instead of a threadpool, we just pass a number of threads (4). 68 | (cp/pmap 4 inc (range 4)) 69 | ``` 70 | 71 | To reduce latency, you can use unordered versions of these functions that return results in the order they’re completed. 72 | 73 | ```clojure 74 | ;; This will probably return '(0 1 2), depending on how 75 | ;; the OS schedules our threads. 76 | (cp/upfor 3 [i (reverse (range 3))] 77 | (do 78 | (Thread/sleep (* i 1000)) 79 | (inc i))) 80 | ``` 81 | 82 | For instance, if we’re fetching and resizing images from the network, some images might be smaller and download faster, so we can start resizing them first. 83 | 84 | ```clojure 85 | (->> image-urls 86 | ;; Put the URL in a map. 87 | (map (fn [url] {:url url})) 88 | ;; Add the image data to the map. 89 | (cp/upmap network-pool 90 | #(assoc % :data 91 | (-> % :url clj-http.client/get :body))) 92 | ;; Add the resized image to the map. 93 | (cp/upmap cpu-pool 94 | #(assoc % :resized (resize (:data %))))) 95 | ``` 96 | 97 | You can also have your tasks run in priority order. Tasks are chosen as threads become available, so the highest-priority task at any moment is chosen. (So, for instance, the first task submitted to a pool will run first, regardless of priority.) 98 | 99 | ```clojure 100 | (require '[com.climate.claypoole.priority :as cpp]) 101 | (cp/with-shutdown! [pool (cpp/priority-threadpool 4)] 102 | (let [;; These will mostly run last. 103 | xs (cp/pmap (cpp/with-priority pool 0) inc (range 10)) 104 | ;; These will mostly run first. 105 | ys (cp/pmap (cpp/with-priority pool 10) dec (range 10))] 106 | ...)) 107 | ``` 108 | 109 | # What’s next? 110 | 111 | We don’t have particularly specific plans at this time. There are a number of interesting tricks to play with threadpools and parallelism. For instance, tools for [ForkJoinPools](http://docs.oracle.com/javase/7/docs/api/java/util/concurrent/ForkJoinPool.html) could combine this work with [reducers](http://clojure.org/reducers), support for web workers in Clojurescript would be nice, and there are many other such opportunities. 112 | 113 | Send us your requests (and pull requests) on [Github](https://github.com/TheClimateCorporation/claypoole)! 114 | 115 | # Where can I learn more? 116 | 117 | A detailed README can be seen on the [claypoole Github project](https://github.com/TheClimateCorporation/claypoole). 118 | 119 | # Thanks! 120 | 121 | Thanks to Sebastian Galkin of Climate Corp. and to Jason Wolfe of [Prismatic](http://getprismatic.com/), who helped with advice on API design decisions. 122 | -------------------------------------------------------------------------------- /test/com/climate/claypoole/lazy_test.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (ns com.climate.claypoole.lazy-test 15 | (:require [clojure.test :refer :all] 16 | [com.climate.claypoole-test :as cptest] 17 | [com.climate.claypoole.impl :as impl] 18 | [com.climate.claypoole.lazy :as lazy] 19 | [com.climate.claypoole.test-helpers :as th])) 20 | 21 | 22 | (defn check-input-laziness 23 | "Check that a function is actually lazy in reading its input." 24 | [pmap-like] 25 | (let [started (atom #{}) 26 | readahead 10 27 | input (->> (* 3 readahead) 28 | range 29 | impl/unchunk 30 | (map #(do (swap! started conj %) %)))] 31 | (dorun (take 2 (pmap-like readahead inc input))) 32 | (Thread/sleep 10) 33 | ;; Exactly what we asked for, plus readahead, is realized. 34 | (is (= (+ 2 readahead) (count @started))))) 35 | 36 | (defn check-output-laziness 37 | "Check that a function is actually lazy in computing its output." 38 | [pmap-like] 39 | (let [started (atom #{}) 40 | readahead 10 41 | input (range (* 3 readahead))] 42 | (dorun (take 2 (pmap-like readahead #(do (swap! started conj %) %) input))) 43 | (Thread/sleep 10) 44 | ;; Exactly what we asked for, plus readahead, is realized. 45 | (is (= (+ 2 readahead) (count @started))))) 46 | 47 | (defn check-all 48 | [fn-name pmap-like ordered? streaming?] 49 | ;; Apply all the standard tests 50 | (cptest/check-all fn-name pmap-like ordered? streaming? true) 51 | (when streaming? 52 | (testing (format "%s is lazy in its input" fn-name) 53 | (check-input-laziness pmap-like))) 54 | (testing (format "%s is lazy in its output" fn-name) 55 | (check-output-laziness pmap-like))) 56 | 57 | (defn check-input-controllable-readahead 58 | "Check that the manual pmap function's readahead for the input obeys the 59 | parameter." 60 | [manual-pmap-like] 61 | (let [started (atom #{}) 62 | readahead 10 63 | input (->> (* 3 readahead) 64 | range 65 | impl/unchunk 66 | (map #(do (swap! started conj %) %)))] 67 | (dorun (take 2 (manual-pmap-like 3 readahead inc input))) 68 | (Thread/sleep 10) 69 | ;; Exactly what we asked for, plus readahead, is realized. 70 | (is (= (+ 2 readahead) (count @started))))) 71 | 72 | (defn check-output-controllable-readahead 73 | "Check that the manual pmap function's readahead for the output obeys the 74 | parameter." 75 | [manual-pmap-like] 76 | (let [started (atom #{}) 77 | readahead 10 78 | input (range (* 3 readahead))] 79 | (dorun (take 2 (manual-pmap-like 3 readahead #(do (swap! started conj %) %) input))) 80 | (Thread/sleep 10) 81 | ;; Exactly what we asked for, plus readahead, is realized. 82 | (is (= (+ 2 readahead) (count @started))))) 83 | 84 | (defn check-all-buffer 85 | [fn-name manual-pmap-like ordered? streaming?] 86 | (check-all fn-name (fn [p f i] (manual-pmap-like p 10 f i)) 87 | ordered? streaming?) 88 | (when streaming? 89 | (testing (format "%s is lazy in its input" fn-name) 90 | (check-input-controllable-readahead manual-pmap-like))) 91 | (testing (format "%s is lazy in its output" fn-name) 92 | (check-output-controllable-readahead manual-pmap-like))) 93 | 94 | (deftest test-pmap 95 | (check-all "pmap" lazy/pmap true true)) 96 | 97 | (deftest test-pmap-buffer 98 | (check-all-buffer "pmap-buffer" lazy/pmap-buffer true true)) 99 | 100 | (deftest test-upmap 101 | (check-all "upmap" lazy/upmap false true)) 102 | 103 | (deftest test-upmap-buffer 104 | (check-all-buffer "upmap-buffer" lazy/upmap-buffer false true)) 105 | 106 | (deftest test-pcalls 107 | (testing "basic pcalls test" 108 | (is (= [1 2 3 4] 109 | (lazy/pcalls 3 #(inc 0) #(inc 1) #(inc 2) #(inc 3))))) 110 | (letfn [(pmap-like [pool work input] 111 | (apply 112 | lazy/pcalls 113 | pool 114 | (for [i input] 115 | #(work i))))] 116 | (check-all "pcalls" pmap-like true true))) 117 | 118 | (deftest test-pcalls-buffer 119 | (letfn [(pmap-like [pool buffer work input] 120 | (apply 121 | lazy/pcalls-buffer 122 | pool buffer 123 | (for [i input] 124 | #(work i))))] 125 | (check-all-buffer "pcalls-buffer" pmap-like true true))) 126 | 127 | (deftest test-upcalls 128 | (testing "basic pcalls test" 129 | (is (= [1 2 3 4] 130 | (sort (lazy/upcalls 3 #(inc 0) #(inc 1) #(inc 2) #(inc 3)))))) 131 | (letfn [(pmap-like [pool work input] 132 | (apply 133 | lazy/upcalls 134 | pool 135 | (for [i input] 136 | #(work i))))] 137 | (check-all "upcalls" pmap-like false true))) 138 | 139 | (deftest test-upcalls-buffer 140 | (letfn [(pmap-like [pool buffer work input] 141 | (apply 142 | lazy/upcalls-buffer 143 | pool buffer 144 | (for [i input] 145 | #(work i))))] 146 | (check-all-buffer "upcalls-buffer" pmap-like false true))) 147 | 148 | (deftest test-pvalues 149 | (testing "basic pvalues test" 150 | (is (= [1 2 3 4] 151 | (lazy/pvalues 3 (inc 0) (inc 1) (inc 2) (inc 3))))) 152 | (letfn [(pmap-like [pool work input] 153 | (let [worksym (gensym "work")] 154 | ((th/eval+ex-unwrap 155 | `(fn [pool# ~worksym] 156 | (lazy/pvalues 157 | pool# 158 | ~@(for [i input] 159 | (list worksym i))))) 160 | pool work)))] 161 | (check-all "pvalues" pmap-like true false))) 162 | 163 | (deftest test-pvalues-buffer 164 | (letfn [(pmap-like [pool buffer work input] 165 | (let [worksym (gensym "work")] 166 | ((th/eval+ex-unwrap 167 | `(fn [pool# buffer# ~worksym] 168 | (lazy/pvalues-buffer 169 | pool# buffer# 170 | ~@(for [i input] 171 | (list worksym i))))) 172 | pool buffer work)))] 173 | (check-all-buffer "pvalues-buffer" pmap-like true false))) 174 | 175 | (deftest test-upvalues 176 | (testing "basic upvalues test" 177 | (is (= [1 2 3 4] 178 | (sort (lazy/upvalues 3 (inc 0) (inc 1) (inc 2) (inc 3)))))) 179 | (letfn [(pmap-like [pool work input] 180 | (let [worksym (gensym "work")] 181 | ((th/eval+ex-unwrap `(fn [pool# ~worksym] 182 | (lazy/upvalues 183 | pool# 184 | ~@(for [i input] 185 | (list worksym i))))) 186 | pool work)))] 187 | (check-all "upvalues" pmap-like false false))) 188 | 189 | (deftest test-upvalues-buffer 190 | (letfn [(pmap-like [pool buffer work input] 191 | (let [worksym (gensym "work")] 192 | ((th/eval+ex-unwrap 193 | `(fn [pool# buffer# ~worksym] 194 | (lazy/upvalues-buffer 195 | pool# buffer# 196 | ~@(for [i input] 197 | (list worksym i))))) 198 | pool buffer work)))] 199 | (check-all-buffer "upvalues-buffer" pmap-like false false))) 200 | 201 | (deftest test-pfor 202 | (testing "basic pfor test" 203 | (is (= (range 1 11) 204 | (lazy/pfor 3 [i (range 10)] (inc i))))) 205 | (letfn [(pmap-like [pool work input] 206 | (lazy/pfor 207 | pool 208 | [i input] 209 | (work i)))] 210 | (check-all "pfor" pmap-like true true))) 211 | 212 | (deftest test-pfor-buffer 213 | (letfn [(pmap-like [pool buffer work input] 214 | (lazy/pfor-buffer 215 | pool buffer 216 | [i input] 217 | (work i)))] 218 | (check-all-buffer "pfor-buffer" pmap-like true true))) 219 | 220 | (deftest test-upfor 221 | (testing "basic upfor test" 222 | (is (= (range 1 11) 223 | (sort (lazy/pfor 3 [i (range 10)] (inc i)))))) 224 | (letfn [(pmap-like [pool work input] 225 | (lazy/upfor 226 | pool 227 | [i input] 228 | (work i)))] 229 | (check-all "upfor" pmap-like false true))) 230 | 231 | (deftest test-upfor-buffer 232 | (letfn [(pmap-like [pool buffer work input] 233 | (lazy/upfor-buffer 234 | pool buffer 235 | [i input] 236 | (work i)))] 237 | (check-all-buffer "upfor-buffer" pmap-like false true))) 238 | 239 | (deftest test-pdoseq 240 | (cptest/test-parallel-do 241 | "pdoseq" 242 | (fn [pool f s] 243 | (lazy/pdoseq pool [i s] (f i))))) 244 | 245 | (deftest test-prun! 246 | (cptest/test-parallel-do 247 | "prun!" 248 | (fn [pool f s] (lazy/prun! pool f s)))) 249 | -------------------------------------------------------------------------------- /src/clj/com/climate/claypoole/lazy.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (ns com.climate.claypoole.lazy 15 | "Lazy threadpool tools for Clojure. 16 | 17 | This namespace provides lazy versions of the parallel functions from 18 | com.climate.claypoole. They will only run the outputs you realize, plus a few 19 | more (a buffer), just like core pmap. The buffer is used to help keep the 20 | threadpool busy. 21 | 22 | Each parallel function also comes with a -buffer variant that allows you to 23 | specify the buffer size. The non -buffer forms use the threadpool size as 24 | their buffer size. 25 | 26 | To use the threadpool most efficiently with these lazy functions, prefer the 27 | unordered versions (e.g. upmap), since the ordered ones may starve the 28 | threadpool of work. For instance, this pmap will take 6 milliseconds to run: 29 | (lazy/pmap 2 #(Thread/sleep %) [4 3 2 1]) 30 | That's because it will not realize the 2 task until the 4 task is complete, 31 | so one thread in the pool will sit idle for 1 millisecond." 32 | (:refer-clojure :exclude [future future-call pcalls pmap pvalues]) 33 | (:require [com.climate.claypoole :as cp] 34 | [com.climate.claypoole.impl :as impl]) 35 | (:import [java.util.concurrent LinkedBlockingQueue])) 36 | 37 | 38 | (defn- forceahead 39 | "A sequence of s with the next buffer-size elements of it forced." 40 | [buffer-size s] 41 | (map (fn [x _] x) 42 | s 43 | (concat (drop buffer-size s) (repeat nil)))) 44 | 45 | (defn pmap-buffer 46 | "A lazy pmap where the work happens in a threadpool, just like core pmap, but 47 | using Claypoole futures. 48 | 49 | Unlike core pmap, it doesn't assume the buffer size is nprocessors + 2; 50 | instead, you must specify how many tasks ahead will be run in the 51 | background. 52 | 53 | If you 54 | (doall (take 2 (pmap-buffer pool 10 inc (range 1000)))) 55 | then 12 inputs and outputs will be realized--the 2 you asked for, plus the 10 56 | that are run in the buffer to keep the threadpool busy." 57 | [pool buffer-size f & colls] 58 | (if (cp/serial? pool) 59 | (apply map f colls) 60 | (let [[shutdown? pool] (impl/->threadpool pool)] 61 | (->> colls 62 | ;; make sure we're not chunking 63 | (map impl/unchunk) 64 | ;; use map to take care of argument alignment 65 | (apply map vector) 66 | ;; make futures 67 | (map (fn [a] (cp/future-call pool 68 | ;; Use with-meta for priority 69 | ;; threadpools 70 | (with-meta #(apply f a) 71 | {:args a})))) 72 | ;; force buffer-size futures to start work in the pool 73 | (forceahead (or buffer-size (impl/get-pool-size pool) 0)) 74 | ;; read the results from the futures 75 | (map impl/deref-fixing-exceptions) 76 | (impl/seq-open #(when shutdown? (cp/shutdown pool))))))) 77 | 78 | (defn pmap 79 | "A lazy pmap where the work happens in a threadpool, just like core pmap, but 80 | using Claypoole futures in the given threadpool. 81 | 82 | Unlike core pmap, it doesn't assume the buffer size is nprocessors + 2; 83 | instead, it tries to fill the pool. 84 | 85 | If you 86 | (doall (take 2 (pmap 10 inc (range 1000)))) 87 | then 12 inputs and outputs will be realized--the 2 you asked for, plus the 10 88 | that are run in the buffer to keep the threadpool busy." 89 | [pool f & colls] 90 | (apply pmap-buffer pool nil f colls)) 91 | 92 | (defn upmap-buffer 93 | "Like pmap-buffer, but with results returned in the order they completed. 94 | 95 | Note that unlike core pmap, it doesn't assume the buffer size is nprocessors 96 | + 2; instead, you must specify how many tasks ahead will be run in the 97 | background." 98 | [pool buffer-size f & colls] 99 | (if (cp/serial? pool) 100 | (apply map f colls) 101 | (let [[shutdown? pool] (impl/->threadpool pool) 102 | buffer-size (or buffer-size (impl/get-pool-size pool) 10) 103 | result-q (LinkedBlockingQueue. (int buffer-size)) 104 | run-one (fn [a] 105 | (let [p (promise)] 106 | @(deliver p 107 | (cp/future-call 108 | pool 109 | ;; Use with-meta for priority threadpools 110 | (with-meta #(try (apply f a) 111 | (finally (.put result-q @p))) 112 | {:args a})))))] 113 | (->> colls 114 | ;; make sure we're not chunking 115 | (map impl/unchunk) 116 | ;; use map to take care of argument alignment 117 | (apply map vector) 118 | ;; make futures 119 | (map run-one) 120 | ;; force buffer-size futures to start work in the pool 121 | (forceahead buffer-size) 122 | ;; read the results from the futures in the queue 123 | (map (fn [_] (impl/deref-fixing-exceptions (.take result-q)))) 124 | (impl/seq-open #(when shutdown? (cp/shutdown pool))))))) 125 | 126 | (defn upmap 127 | "Like pmap, but with results returned in the order they completed. 128 | 129 | Note that unlike core pmap, it doesn't assume the buffer size is nprocessors 130 | + 2; instead, it tries to fill the pool." 131 | [pool f & colls] 132 | (apply upmap-buffer pool (impl/get-pool-size pool) f colls)) 133 | 134 | (defn pcalls 135 | "Like clojure.core.pcalls, except it's lazy and it takes a threadpool. For 136 | more detail on its parallelism and on its threadpool argument, see pmap." 137 | [pool & fs] 138 | (pmap pool #(%) fs)) 139 | 140 | (defn pcalls-buffer 141 | "Like clojure.core.pcalls, except it's lazy and it takes a threadpool and a 142 | buffer size. For more detail on these arguments, see pmap-buffer." 143 | [pool buffer & fs] 144 | (pmap-buffer pool buffer #(%) fs)) 145 | 146 | (defn upcalls 147 | "Like clojure.core.pcalls, except it's lazy, it takes a threadpool, and it 148 | returns results ordered by completion time. For more detail on its 149 | parallelism and on its threadpool argument, see upmap." 150 | [pool & fs] 151 | (upmap pool #(%) fs)) 152 | 153 | (defn upcalls-buffer 154 | "Like clojure.core.pcalls, except it's lazy, it takes a threadpool and a 155 | buffer size, and it returns results ordered by completion time. For more 156 | detail on its parallelism and on its arguments, see upmap-buffer." 157 | [pool buffer & fs] 158 | (upmap-buffer pool buffer #(%) fs)) 159 | 160 | (defmacro pvalues 161 | "Like clojure.core.pvalues, except it's lazy and it takes a threadpool. For 162 | more detail on its parallelism and on its threadpool argument, see pmap." 163 | [pool & exprs] 164 | `(pcalls ~pool ~@(for [e exprs] `(fn [] ~e)))) 165 | 166 | (defmacro pvalues-buffer 167 | "Like clojure.core.pvalues, except it's lazy and it takes a threadpool and a 168 | buffer size. For more detail on its parallelism and on its arguments, see 169 | pmap-buffer." 170 | [pool buffer & exprs] 171 | `(pcalls-buffer ~pool ~buffer ~@(for [e exprs] `(fn [] ~e)))) 172 | 173 | (defmacro upvalues 174 | "Like clojure.core.pvalues, except it's lazy, it takes a threadpool, and it 175 | returns results ordered by completion time. For more detail on its 176 | parallelism and on its threadpool argument, see upmap." 177 | [pool & exprs] 178 | `(upcalls ~pool ~@(for [e exprs] `(fn [] ~e)))) 179 | 180 | (defmacro upvalues-buffer 181 | "Like clojure.core.pvalues, except it's lazy, it takes a threadpool and a 182 | buffer size, and it returns results ordered by completion time. For more 183 | detail on its parallelism and on its arguments, see upmap-buffer." 184 | [pool buffer & exprs] 185 | `(upcalls-buffer ~pool ~buffer ~@(for [e exprs] `(fn [] ~e)))) 186 | 187 | (defmacro pfor 188 | "A parallel version of for. It is like for, except it takes a threadpool and 189 | is parallel. For more detail on its parallelism and on its threadpool 190 | argument, see pmap. 191 | 192 | Note that while the body is executed in parallel, the bindings are executed 193 | in serial, so while this will call complex-computation in parallel: 194 | (pfor pool [i (range 1000)] (complex-computation i)) 195 | this will not have useful parallelism: 196 | (pfor pool [i (range 1000) :let [result (complex-computation i)]] result) 197 | 198 | You can use the special binding :priority (which must be the last binding) to 199 | set the priorities of the tasks. 200 | (upfor (priority-threadpool 10) [i (range 1000) 201 | :priority (inc i)] 202 | (complex-computation i)) 203 | " 204 | [pool bindings & body] 205 | (impl/pfor-internal pool bindings body `pmap)) 206 | 207 | (defmacro pfor-buffer 208 | "Like pfor, but it takes a buffer size; see pmap-buffer for information about 209 | this argument." 210 | [pool buffer bindings & body] 211 | ;; Instead of pmap, we'll use an inline function with the buffer thrown in 212 | ;; there. It's hacky, because it relies on exactly how pfor-internal expands, 213 | ;; but it works. 214 | (let [pm `(fn [p# f# & cs#] (apply pmap-buffer p# ~buffer f# cs#))] 215 | (impl/pfor-internal pool bindings body pm))) 216 | 217 | (defmacro upfor 218 | "Like pfor, except the return value is a sequence of results ordered by 219 | *completion time*, not by input order." 220 | [pool bindings & body] 221 | (impl/pfor-internal pool bindings body `upmap)) 222 | 223 | (defmacro upfor-buffer 224 | "Like upfor, but it takes a buffer size; see pmap-buffer for information 225 | about this argument." 226 | [pool buffer bindings & body] 227 | ;; Instead of pmap, we'll use an inline function with the buffer thrown in 228 | ;; there. It's hacky, because it relies on exactly how pfor-internal expands, 229 | ;; but it works. 230 | (let [upm `(fn [p# f# & cs#] (apply upmap-buffer p# ~buffer f# cs#))] 231 | (impl/pfor-internal pool bindings body upm))) 232 | 233 | (defmacro pdoseq 234 | "Like doseq, but in parallel. Unlike the streaming sequence functions (e.g. 235 | pmap), pdoseq blocks until all the work is done. 236 | 237 | Similar to pfor, only the body is done in parallel. For more details, see 238 | pfor." 239 | [pool bindings & body] 240 | ;; There's no sensible lazy version of this, so just use base Claypoole's 241 | ;; implementation. 242 | `(cp/pdoseq ~pool ~bindings ~@body)) 243 | 244 | (defn prun! 245 | "Like run!, but in parallel. Unlike the streaming sequence functions (e.g. 246 | pmap), prun! blocks until all the work is done." 247 | [pool proc coll] 248 | ;; There's no sensible lazy version of this, so just use base Claypoole's 249 | ;; implementation. 250 | (cp/prun! pool proc coll)) 251 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright 2014 The Climate Corporation 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /src/clj/com/climate/claypoole/impl.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (ns com.climate.claypoole.impl 15 | "Implementation helper functions for Claypoole." 16 | (:require [clojure.core :as core]) 17 | (:import [clojure.lang IFn] 18 | [com.climate.claypoole.impl Prioritized PriorityThreadpoolImpl] 19 | [java.util Collection List] 20 | [java.util.concurrent 21 | ExecutionException 22 | Executors 23 | ExecutorService 24 | Future 25 | LinkedBlockingQueue 26 | ThreadFactory 27 | TimeoutException 28 | TimeUnit])) 29 | 30 | 31 | (defn binding-conveyor-fn 32 | "Like clojure.core/binding-conveyor-fn for resetting bindings to run a 33 | function in another thread." 34 | [f] 35 | (let [frame (clojure.lang.Var/cloneThreadBindingFrame)] 36 | (with-meta 37 | (fn [] 38 | (let [frame-before (clojure.lang.Var/getThreadBindingFrame)] 39 | (clojure.lang.Var/resetThreadBindingFrame frame) 40 | (try 41 | (f) 42 | (finally 43 | ;; This does not matter for correctness, but prevents leaking 44 | ;; data in binding frames in thread locals. 45 | (clojure.lang.Var/resetThreadBindingFrame frame-before))))) 46 | (meta f)))) 47 | 48 | (defn deref-future 49 | "Like clojure.core/deref-future." 50 | ([^Future fut] 51 | (.get fut)) 52 | ([^Future fut timeout-ms timeout-val] 53 | (try (.get fut timeout-ms TimeUnit/MILLISECONDS) 54 | (catch TimeoutException _e 55 | timeout-val)))) 56 | 57 | (defn deref-fixing-exceptions 58 | "If a future experiences an exception and you dereference the future, you 59 | will see not the original exception but a 60 | java.util.concurrent.ExecutionException. That's sometimes not the result you 61 | want. This catches those exceptions and re-throws the future's exception, 62 | which can be much less surprising to downstream code." 63 | [fut] 64 | (try (deref fut) 65 | (catch java.util.concurrent.ExecutionException e 66 | (let [cause (.getCause e)] 67 | ;; Update the stack trace to include e 68 | (.setStackTrace cause (into-array StackTraceElement 69 | (concat 70 | (.getStackTrace cause) 71 | (.getStackTrace e)))) 72 | (throw cause))))) 73 | 74 | (defn dummy-future-call 75 | "A dummy future-call that runs in serial and returns a future containing the 76 | result." 77 | [f] 78 | (let [result (f)] 79 | (reify 80 | clojure.lang.IDeref 81 | (deref [_] result) 82 | clojure.lang.IBlockingDeref 83 | (deref [_ _timeout-ms _timeout-val] result) 84 | clojure.lang.IPending 85 | (isRealized [_] true) 86 | Future 87 | (get [_] result) 88 | (get [_ _timeout _unit] result) 89 | (isCancelled [_] false) 90 | (isDone [_] true) 91 | (cancel [_ _interrupt?] false)))) 92 | 93 | (defn validate-future-pool 94 | "Verify that a threadpool is a valid pool for a future." 95 | [pool] 96 | (when-not (or (= :serial pool) 97 | (= :builtin pool) 98 | (instance? ExecutorService pool)) 99 | (throw (IllegalArgumentException. 100 | (format 101 | (str "Threadpool futures require a threadpool, :builtin, or " 102 | ":serial, not %s.") pool))))) 103 | 104 | (defonce ^{:doc "The previously-used threadpool ID."} 105 | threadpool-id 106 | ;; Start at -1 so we can just use the return value of (swap! inc). 107 | (atom -1)) 108 | 109 | (defn default-threadpool-name 110 | "The default name for threads in a threadpool. Gives each threadpool a 111 | unique ID via threadpool-id." 112 | [] 113 | (format "claypoole-%d" (swap! threadpool-id inc))) 114 | 115 | (defn apply-map 116 | "Apply a function that takes keyword arguments to a map of arguments." 117 | [f & args] 118 | (let [args* (drop-last args) 119 | arg-map (last args)] 120 | (apply f (concat args* (mapcat identity arg-map))))) 121 | 122 | (defn thread-factory 123 | "Create a ThreadFactory with keyword options including thread daemon status 124 | :daemon, the thread name format :name (a string for format with one integer), 125 | and a thread priority :thread-priority." 126 | ^java.util.concurrent.ThreadFactory 127 | [& {:keys [daemon thread-priority] pool-name :name 128 | :or {daemon true}}] 129 | (let [daemon* (boolean daemon) 130 | pool-name* (or pool-name (default-threadpool-name)) 131 | thread-priority* (or thread-priority 132 | (.getPriority (Thread/currentThread))) 133 | default-factory (Executors/defaultThreadFactory) 134 | ;; The previously-used thread ID. Start at -1 so we can just use the 135 | ;; return value of (swap! inc). 136 | thread-id (atom -1)] 137 | (reify ThreadFactory 138 | (^Thread newThread [_ ^Runnable r] 139 | (doto (.newThread default-factory r) 140 | (.setDaemon daemon*) 141 | (.setName (str pool-name* "-" (swap! thread-id inc))) 142 | (.setPriority thread-priority*)))))) 143 | 144 | (defn unchunk 145 | "Takes a seqable and returns a lazy sequence that is maximally lazy. 146 | 147 | Based on http://stackoverflow.com/questions/3407876/how-do-i-avoid-clojures-chunking-behavior-for-lazy-seqs-that-i-want-to-short-ci" 148 | [s] 149 | (lazy-seq 150 | (when-let [s (seq s)] 151 | (cons (first s) 152 | (unchunk (rest s)))))) 153 | 154 | (defn threadpool 155 | "Make a threadpool. It should be shutdown when no longer needed. 156 | 157 | See docs in com.climate.claypoole/threadpool." 158 | ^java.util.concurrent.ScheduledExecutorService [n & args] 159 | ;; Return a ScheduledThreadPool rather than a FixedThreadPool because it's 160 | ;; the same thing with some bonus features. 161 | (Executors/newScheduledThreadPool n (apply thread-factory args))) 162 | 163 | (defn- prioritize 164 | "Apply a priority function to a task. 165 | 166 | Note that this re-throws all priority-fn exceptions as ExecutionExceptions. 167 | That shouldn't mess anything up because the caller re-throws it as an 168 | ExecutionException anyway. 169 | 170 | For simplicity, prioritize reifies both Callable and Runnable, rather than 171 | having one prioritize function for each of those types. That means, for 172 | example, that if you prioritize a Runnable that is not also a Callable, you 173 | might want to cast the result to Runnable or otherwise use it carefully." 174 | [task, ^IFn priority-fn] 175 | (let [priority (try 176 | (long (apply priority-fn (-> task meta :args))) 177 | (catch Exception e 178 | (throw (ExecutionException. 179 | "Priority function exception" e))))] 180 | (reify 181 | Callable 182 | (call [_] (.call ^Callable task)) 183 | Runnable 184 | (run [_] (.run ^Runnable task)) 185 | Prioritized 186 | (getPriority [_] priority)))) 187 | 188 | ;; A Threadpool that applies a priority function to tasks and uses a 189 | ;; PriorityThreadpoolImpl to run them. 190 | (deftype PriorityThreadpool [^PriorityThreadpoolImpl pool, ^IFn priority-fn] 191 | ExecutorService 192 | (^boolean awaitTermination [_, ^long timeout, ^TimeUnit unit] 193 | (.awaitTermination pool timeout unit)) 194 | (^List invokeAll [_, ^Collection tasks] 195 | (.invokeAll pool (map #(prioritize % priority-fn) tasks))) 196 | (^List invokeAll [_, ^Collection tasks, ^long timeout, ^TimeUnit unit] 197 | (.invokeAll pool (map #(prioritize % priority-fn) tasks) timeout unit)) 198 | (^Object invokeAny [_, ^Collection tasks] 199 | (.invokeAny pool (map #(prioritize % priority-fn) tasks))) 200 | (^Object invokeAny [_, ^Collection tasks, ^long timeout, ^TimeUnit unit] 201 | (.invokeAny pool (map #(prioritize % priority-fn) tasks) timeout unit)) 202 | (^boolean isShutdown [_] 203 | (.isShutdown pool)) 204 | (^boolean isTerminated [_] 205 | (.isTerminated pool)) 206 | (shutdown [_] 207 | (.shutdown pool)) 208 | (^List shutdownNow [_] 209 | (.shutdownNow pool)) 210 | (^Future submit [_, ^Runnable task] 211 | (.submit pool ^Runnable (prioritize task priority-fn))) 212 | (^Future submit [_, ^Runnable task, ^Object result] 213 | (.submit pool ^Runnable (prioritize task priority-fn) result)) 214 | (^Future submit [_ ^Callable task] 215 | (.submit pool ^Callable (prioritize task priority-fn)))) 216 | 217 | (defn ->threadpool 218 | "Convert the argument into a threadpool, leaving the special keyword :serial 219 | alone. 220 | 221 | Returns [created? threadpool], where created? indicates whether a new 222 | threadpool was instantiated." 223 | [arg] 224 | (cond 225 | (instance? ExecutorService arg) [false arg] 226 | (integer? arg) [true (threadpool arg)] 227 | (= :builtin arg) [false clojure.lang.Agent/soloExecutor] 228 | (= :serial arg) [false :serial] 229 | :else (throw (IllegalArgumentException. 230 | (format 231 | (str "Claypoole functions require a threadpool, a " 232 | "number, :builtin, or :serial, not %s.") arg))))) 233 | 234 | (defn get-pool-size 235 | "If the pool has a max size, get that; else, return nil." 236 | [pool] 237 | (cond 238 | (instance? java.util.concurrent.ScheduledThreadPoolExecutor pool) 239 | (.getCorePoolSize ^java.util.concurrent.ScheduledThreadPoolExecutor pool) 240 | 241 | (instance? java.util.concurrent.ThreadPoolExecutor pool) 242 | (.getMaximumPoolSize ^java.util.concurrent.ThreadPoolExecutor pool) 243 | 244 | :else 245 | nil)) 246 | 247 | ;; Queue-seq needs a unique item that, when seen in a queue, indicates that the 248 | ;; sequence has ended. It uses the private object end-marker, and uses 249 | ;; identical? to check against this object's (unique) memory address. 250 | (let [end-marker (Object.)] 251 | 252 | (defn- queue-reader 253 | "Make a lazy sequence from a queue, stopping upon reading the unique 254 | end-marker object." 255 | [^LinkedBlockingQueue q] 256 | (lazy-seq 257 | (let [x (.take q)] 258 | (when-not (identical? x end-marker) 259 | (cons x (queue-reader q)))))) 260 | 261 | (defn queue-seq 262 | "Create a queue and a lazy sequence that reads from that queue." 263 | [] 264 | (let [q (LinkedBlockingQueue.)] 265 | [q (queue-reader q)])) 266 | 267 | (defn queue-seq-add! 268 | "Add an item to a queue (and its lazy sequence)." 269 | [^LinkedBlockingQueue q x] 270 | (.put q x)) 271 | 272 | (defn queue-seq-end! 273 | "End a lazy sequence reading from a queue." 274 | [q] 275 | (queue-seq-add! q end-marker))) 276 | 277 | (defn lazy-co-read 278 | "Zip s1 and s2, stopping when s1 stops. This helps avoid potential blocking 279 | when trying to read queue sequences. 280 | 281 | In particular, this will block: 282 | (map vector 283 | (range 10) 284 | (concat (range 10) (lazy-seq (deref (promise))))) 285 | even though we only can read 10 things. Lazy-co-read fixes that case by 286 | checking the first sequence first, so this will not block: 287 | (lazy-co-read 288 | (range 10) 289 | (concat (range 10) (lazy-seq (deref (promise)))))" 290 | [s1 s2] 291 | (lazy-seq (when-not (empty? s1) 292 | (cons [(first s1) (first s2)] 293 | (lazy-co-read (rest s1) (rest s2)))))) 294 | 295 | (defn with-priority-fn 296 | "Make a priority-threadpool wrapper that uses a given priority function. 297 | 298 | The priority function is applied to a pmap'd function's arguments. e.g. 299 | 300 | (upmap (with-priority-fn p (fn [x _] x)) + [6 5 4] [1 2 3]) 301 | 302 | will use pool p to run tasks [(+ 6 1) (+ 5 2) (+ 4 3)] 303 | with priorities [6 5 4]." 304 | ^com.climate.claypoole.impl.PriorityThreadpool 305 | [^PriorityThreadpool pool priority-fn] 306 | (let [^PriorityThreadpoolImpl pool* (.pool pool)] 307 | (PriorityThreadpool. pool* priority-fn))) 308 | 309 | (defn pfor-internal 310 | "Do the messy parsing of the :priority from the for bindings." 311 | [pool bindings body pmap-fn-sym] 312 | (when (vector? pool) 313 | (throw (IllegalArgumentException. 314 | (str "Got a vector instead of a pool--" 315 | "did you forget to use a threadpool?")))) 316 | (if-not (= :priority (first (take-last 2 bindings))) 317 | ;; If there's no priority, everything is simple. 318 | `(~pmap-fn-sym ~pool #(%) (for ~bindings (fn [] ~@body))) 319 | ;; If there's a priority, God help us--let's pull that thing out. 320 | (let [bindings* (vec (drop-last 2 bindings)) 321 | priority-value (last bindings)] 322 | `(let [pool# (with-priority-fn ~pool (fn [_# p#] p#)) 323 | ;; We can't just make functions; we have to have the priority as 324 | ;; an argument to work with the priority-fn. 325 | [fns# priorities#] (apply map vector 326 | (for ~bindings* 327 | [(fn [priority#] ~@body) 328 | ~priority-value]))] 329 | (~pmap-fn-sym pool# #(%1 %2) fns# priorities#))))) 330 | 331 | (defn seq-open 332 | "Converts a seq s into a lazy seq that calls a function f when the seq is 333 | fully realized or when an exception is thrown. Sort of like with-open, but 334 | not a macro, not necessarily calling .close, and for a lazy seq." 335 | [f s] 336 | (lazy-seq 337 | (let [sprime (try 338 | ;; force one element of s to make exceptions happen here 339 | (when-let [s (seq s)] 340 | (cons (first s) (rest s))) 341 | (catch Throwable t 342 | (f) 343 | (throw t)))] 344 | (if (seq sprime) 345 | (cons (first sprime) (seq-open f (rest sprime))) 346 | (do (f) nil))))) 347 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Clojars Project](https://img.shields.io/clojars/v/org.clj-commons/claypoole.svg)](https://clojars.org/org.clj-commons/claypoole) 2 | [![cljdoc badge](https://cljdoc.org/badge/org.clj-commons/claypoole)](https://cljdoc.org/d/org.clj-commons/claypoole) 3 | [![CircleCI](https://circleci.com/gh/clj-commons/claypoole.svg?style=svg)](https://circleci.com/gh/clj-commons/claypoole) 4 | 5 | # Claypoole: Threadpool tools for Clojure 6 | 7 | The claypoole library provides threadpool-based parallel versions of Clojure 8 | functions such as `pmap`, `future`, and `for`. 9 | 10 | ## Why do you use claypoole? 11 | 12 | Claypoole gives us tools to deal with common parallelism issues by letting us 13 | use and manage our own threadpools (a.k.a. thread pools). Our [blog 14 | post](doc/BLOG.md) 15 | gives a nice overview of the project and its motivations. 16 | 17 | Also, if you like learning via video, Leon gave [a talk at Clojure West 18 | 2015](https://www.youtube.com/watch?v=BzKjIk0vgzE). It gives an intro to how 19 | Clojure parallelism works, including describing some of the motivations for 20 | Claypoole. It describes what advantages Claypoole gives and also talks about 21 | some of the other useful tools for Clojure parallelism (e.g. 22 | [core.async](https://github.com/clojure/core.async), 23 | [reducers](http://clojure.org/reducers), and 24 | [Tesser](https://github.com/aphyr/tesser)). 25 | 26 | Clojure has some nice tools for simple parallelism, but they're not a complete 27 | solution for doing complex things (such as controlling the level of 28 | parallelism). Instead, people tend to fall back on Java. For instance, on 29 | [http://clojure.org/concurrent_programming](http://clojure.org/concurrent_programming), 30 | the recommendation is to create an `ExecutorService` and call its `invokeAll` 31 | method. 32 | 33 | On the other hand, we do not need the flexible building blocks that are 34 | [`core.async`](https://github.com/clojure/core.async); 35 | we just want to run some simple tasks in parallel. Similarly, 36 | [`reducers`](http://clojure.org/reducers) is elegant, but we can't control its 37 | level of parallelism. 38 | 39 | Essentially, we wanted a `pmap` function that improves on the original in 40 | several ways: 41 | 42 | * We should be able to set the size of the threadpool `pmap` uses, so it would 43 | be tunable for non-CPU-bound tasks like network requests. 44 | * We should be able to share a threadpool between multiple `pmap`s to control 45 | the amount of simultaneous work we're doing. 46 | * We would like it to be eagerly streaming rather than lazy, so we can start it 47 | going and expect it to work in the background without explicitly consuming 48 | the results. *As of Claypoole 0.4.0, there are lazy maps in 49 | `com.climate.claypoole.lazy`. See the section [Lazy](#lazy) below.* 50 | * We would like to be able to do an unordered `pmap`, so that we can start 51 | handling the first response as fast as possible. 52 | 53 | ## How do I use claypoole? 54 | 55 | To use claypoole, make a threadpool via `threadpool` and use it with 56 | claypoole's version of one of these standard Clojure functions: 57 | 58 | * `future` 59 | * `pmap` 60 | * `pcalls` 61 | * `pvalues` 62 | * `for` 63 | * `doseq` 64 | * `run!` 65 | 66 | Instead of lazy sequences, our functions will return eagerly streaming 67 | sequences. Such a sequence basically looks like `(map deref futures)` with a 68 | thread in the background running `doall` on it, so all the requested work is 69 | being done behind the scenes. Reading the sequence will only block on 70 | uncompleted work. 71 | 72 | Note that these functions are eager! That's on purpose--we like to be able to 73 | start work going and know it'll get done. But if you try to `pmap` over 74 | `(range)`, you're going to have a bad time. 75 | 76 | *As of Claypoole 0.4.0, there are lazy functions in 77 | `com.climate.claypoole.lazy`. See the section [Lazy](#lazy) below.* 78 | 79 | ```clojure 80 | (require '[com.climate.claypoole :as cp]) 81 | ;; A threadpool with 2 threads. 82 | (def pool (cp/threadpool 2)) 83 | ;; Future 84 | (def fut (cp/future pool (myfn myinput))) 85 | ;; Completable Future 86 | (def cfut (cp/completable-future pool (myfn myinput))) 87 | ;; Ordered pmap 88 | (def intermediates (cp/pmap pool myfn1 myinput-a myinput-b)) 89 | ;; We can feed the streaming sequence right into another parallel function. 90 | (def output (cp/pmap pool myfn2 intermediates)) 91 | ;; We can read the output from the stream as it is available. 92 | (doseq [o output] (prn o)) 93 | ;; NOTE: The JVM doesn't automatically clean up threads for us. 94 | (cp/shutdown pool) 95 | ``` 96 | 97 | Claypoole also contains functions for unordered parallelism. We found that for 98 | minimizing latency, we often wanted to deal with results as soon as they became 99 | available. This works well with our eager streaming, so we can chain together 100 | streams using the same or different threadpools to get work done as quickly as 101 | possible. 102 | 103 | 104 | The unordered versions of core functions are: 105 | * `upmap` 106 | * `upcalls` 107 | * `upvalues` 108 | 109 | Here is an example of them in use. 110 | 111 | ```clojure 112 | (require '[com.climate.claypoole :as cp]) 113 | ;; We'll use the with-shutdown! form to guarantee that pools are cleaned up. 114 | (cp/with-shutdown! [net-pool (cp/threadpool 100) 115 | cpu-pool (cp/threadpool (cp/ncpus))] 116 | ;; Unordered pmap doesn't return output in the same order as the input(!), 117 | ;; but that means we can start using service2 as soon as possible. 118 | (def service1-resps (cp/upmap net-pool service1-request myinputs)) 119 | (def service2-resps (cp/upmap net-pool service2-request service1-resps)) 120 | (def results (cp/upmap cpu-pool handle-response service2-resps)) 121 | ;; ...eventually... 122 | ;; Make sure sure the computation is complete before we shutdown the pools. 123 | (doall results)) 124 | ``` 125 | 126 | Claypoole also provides ordered and unordered parallel `for` macros. Note that only 127 | the bodies of the for loops will be run in parallel; everything in the for 128 | binding will be done in the calling thread. 129 | 130 | ```clojure 131 | (def ordered (cp/pfor pool [x xs 132 | y ys] 133 | (myfn x y))) 134 | (def unordered (cp/upfor pool [x xs 135 | ;; This let is done in the calling thread. 136 | :let [ys (range x)] 137 | y ys] 138 | (myfn x y))) 139 | ``` 140 | 141 | Claypoole also lets you prioritize your backlog of tasks. Higher-priority tasks 142 | will be assigned to threads first. Here's an example; there is a more detailed 143 | description below. 144 | 145 | ```clojure 146 | (def pool (cp/priority-threadpool 10)) 147 | (def task1 (cp/future (cp/with-priority pool 1000) (myfn 1))) 148 | (def task2 (cp/future (cp/with-priority pool 0) (myfn 2))) 149 | (def moretasks (cp/pmap (cp/with-priority pool 10) myfn (range 3 10))) 150 | ``` 151 | 152 | ### Unlike the other functions, pdoseq and prun! block 153 | 154 | It's worth mentioning that both `pdoseq` and `prun!` block. Since they don't 155 | create a streaming sequence, their work doesn't happen in the "background". 156 | Instead, the calling thread will wait for all the tasks to complete. If you 157 | want to do work without blocking, use something that makes a sequence, like 158 | `upfor`. 159 | 160 | ## Do I really need to manage all those threadpools? 161 | 162 | You don't need to specifically declare a threadpool. Instead, you can just give 163 | a parallel function a number. Then, it will create its own private threadpool 164 | and shut it down safely when all its tasks are complete. 165 | 166 | ```clojure 167 | ;; Use a temporary threadpool with 4 threads. 168 | (cp/pmap 4 myfunction myinput) 169 | ;; Use a temporary threadpool with ncpus + 2 threads. 170 | (cp/pmap (+ 2 (cp/ncpus)) myfunction myinput) 171 | ``` 172 | 173 | You can also pass the keyword `:builtin` as a threadpool. In that case, the 174 | function will be run using Clojure's built-in, dynamically-scaling threadpool. 175 | This is equivalent to running each task in its own `clojure.core/future`. 176 | 177 | ```clojure 178 | ;; Use built-in parallelism. 179 | (def f (cp/future :builtin (myfn myinput))) 180 | (def results (cp/pfor :builtin [x xs] (myfn x))) 181 | ``` 182 | 183 | You can also pass the keyword `:serial` as a threadpool. In that case, the 184 | function will be run eagerly in series in the calling thread, not in parallel, 185 | so the parallel function will not return until all the work is done. We find 186 | this is helpful for testing and benchmarking. (See also about `*parallel*` 187 | below.) 188 | 189 | ```clojure 190 | ;; Use no parallelism at all; blocks until all work is complete. 191 | (cp/pmap :serial myfunction myinput) 192 | ``` 193 | 194 | ## How do I dispose of my threadpools? 195 | 196 | *As of Claypoole version 0.3, by default all threadpools are daemon 197 | threadpools, so they should shut down when your main thread exits. But it's 198 | still good practice to clean up these resources. Neither the OS nor the JVM 199 | will take care of them for you!* 200 | 201 | The JVM does not automatically garbage collect threads for you. Instead, when 202 | you're done with your threadpool, you should use `shutdown` to gently shut down 203 | the pool, or `shutdown!` to kill the threads forcibly. 204 | 205 | Of course, we have provided a convenience macro `with-shutdown!` that will 206 | `let` a threadpool and clean it up automatically: 207 | 208 | ```clojure 209 | (cp/with-shutdown! [pool (cp/threadpool 3)] 210 | ;; Use the pool, confident it will be shut down when you're done. But be 211 | ;; careful--if work is still going on in the pool when you reach the end of 212 | ;; the body of with-shutdown!, it will be forcibly killed! 213 | ...) 214 | ``` 215 | 216 | Alternately, daemon threads will be automatically killed when the JVM process 217 | exits. *By default all threadpools are daemon threadpools and will exit when 218 | the main thread exits!* You can create a non-daemon threadpool via: 219 | 220 | ```clojure 221 | (def pool (cp/threadpool 10 :daemon false)) 222 | ``` 223 | 224 | ## How do I set threadpool options? 225 | 226 | To construct a threadpool, use the `threadpool` function. It takes optional 227 | keyword arguments allowing you to change the thread names, their daemon status, 228 | and their priority. (NOTE: Thread priority is [a system-level property that 229 | depends on the 230 | OS](http://oreilly.com/catalog/expjava/excerpt/#EXJ-CH-6-SECT-4); it is not the 231 | same as the task priority, described below.) 232 | 233 | ```clojure 234 | (def pool (cp/threadpool (cp/ncpus) 235 | :daemon false 236 | :thread-priority 3 237 | :name "my-pool")) 238 | ``` 239 | 240 | ## How can I disable threading? 241 | 242 | We have found that benchmarking and some other tests are most easily done in 243 | series. You can do that in one of two ways. 244 | 245 | First, you can just pass the keyword `:serial` to a parallel function. 246 | 247 | ```clojure 248 | (def results (cp/pmap :serial myfn inputs)) 249 | ``` 250 | 251 | Second, you can bind or `with-redefs` the variable `cp/*parallel*` to false, 252 | like so: 253 | 254 | ```clojure 255 | (binding [cp/*parallel* false] 256 | (with-shutdown! [pool (cp/threadpool 2)] 257 | ;; This is in series; we block until all work is complete! 258 | (cp/pmap pool myfn inputs))) 259 | ``` 260 | 261 | ## Lazy 262 | 263 | As of Claypoole 0.4.0, there is a namespace `com.climate.claypoole.lazy` that 264 | contains lazy versions of all the parallel functions. These lazy versions do 265 | not compute work until forced by something like `(doall)`, just like core `map` 266 | and `pmap`. 267 | 268 | Like core `pmap`, they will only run the outputs you realize, plus a few more 269 | (a buffer). The buffer is used to help keep the threadpool busy. Unlike core 270 | `pmap`, the buffer size is not fixed at `ncpus + 2`; instead, it defaults to 271 | the size of the threadpool to keep the pool full. Each parallel function also 272 | comes with a -buffer variant that has an extra argument, allowing you to 273 | specify the buffer size. 274 | 275 | For instance, these will both cause 10 items to be realized: 276 | 277 | ```clojure 278 | (require '[com.climate.claypoole :as cp]) 279 | (require '[com.climate.claypoole.lazy :as lazy]) 280 | (cp/with-shutdown! [pool 2] 281 | (doall (take 8 (lazy/pmap pool inc (range)))) 282 | (doall (take 4 (lazy/pmap-buffer pool 6 inc (range))))) 283 | ``` 284 | 285 | ### Lazy Advantages 286 | 287 | The lazy functions work well with sequences too large to fit in memory. 288 | Furthermore, the lazy functions work well with chained maps that operate at 289 | different speeds over large amounts of data. If an eager map that runs quickly 290 | feeds into an eager map that runs slowly, the buffer between them will tend to 291 | grow, possibly running the system out of memory. Lazy functions will avoid this 292 | by only performing work as needed. 293 | 294 | As a rule of thumb, if you are working with data too large to fit into memory, 295 | you probably want a lazy operation. 296 | 297 | ### Lazy Disadvantages 298 | 299 | The disadvantage of the lazy functions is that they may not keep the threadpool 300 | fully busy. For instance, this pmap will take 6 seconds to run: 301 | 302 | ```clojure 303 | (doall (lazy/pmap 2 #(Thread/sleep (* % 1000)) [4 3 2 1])) 304 | ``` 305 | 306 | That's because it will not realize the 2 task until the 4 task is complete, so 307 | one thread in the pool will sit idle for 1 second. On the other hand, an eager 308 | function would only take 5 seconds, since the two threads would be assigned 309 | tasks as follows: 310 | 311 | * 4: Thread 0 312 | * 3: Thread 1 313 | * 2: Thread 1 314 | * 1: Thread 0 315 | 316 | Note also that an unordered map (`upmap`) would also take 5 seconds here, since 317 | as soon as 3 is complete, it would be returned and the next item would be 318 | forced. In general, to use the threadpool most efficiently with these lazy 319 | functions, prefer the unordered versions. 320 | 321 | ## How are exceptions handled? 322 | 323 | Exceptions are a little tricky in a `pmap` for two reasons. 324 | 325 | First, exceptions in `pmaps` are tricky because the task was run in a future, 326 | so Java "helpfully" rethrows the exception as a 327 | `java.util.concurrent.ExecutionException`. Claypoole unwraps that 328 | `ExecutionException` so your code only sees the original exception (as of 329 | Claypoole version 0.4.0). For instance: 330 | 331 | ```clojure 332 | ;; Core map throws the expected NullPointerException. 333 | (try 334 | (first (map inc [nil])) 335 | (catch NullPointerException e)) 336 | ;; Core pmap throws a java.util.concurrent.ExecutionException. 337 | (try 338 | (first (pmap inc [nil])) 339 | (catch java.util.concurrent.ExecutionException e)) 340 | ;; Claypoole pmap throws the expected NullPointerException. 341 | (try 342 | (first (cp/pmap 2 inc [nil])) 343 | (catch NullPointerException e)) 344 | ``` 345 | 346 | Second, exceptions in `pmaps` are tricky because there are other tasks running, 347 | and it's not quite clear what to do with those. Should they be aborted? Should 348 | they be allowed to continue? How many should be allowed to continue? 349 | 350 | Claypoole (as of 0.4.0) works just like core `pmap`: it will not kill queued 351 | tasks, but it will stop adding tasks to the queue. Like core `pmap`, Claypoole's 352 | functions have a buffer of tasks enqueued to keep the thread pool busy. Whereas 353 | core `pmap` has a buffer of ncpus + 2, Claypoole's eager functions use a 354 | buffer size of twice the pool size (to keep the pool busy), and its lazy 355 | functions use a buffer size equal to the pool size (so that they minimize 356 | unneeded work). 357 | 358 | ```clojure 359 | (let [slow (fn [x] (Thread/sleep 100) x) ; we slow the work so the buffer fills 360 | prn+1 (comp prn inc slow) 361 | data (cons nil (iterate inc 0))] ; we use iterate inc to avoid chunking 362 | ;; Core map does no work after an exception, so no numbers will be printed. 363 | (dorun (map prn+1 data)) 364 | ;; Core pmap does ncpus + 2 work after an exception, so on a quad-core 365 | ;; computer, 6 numbers will be printed. 366 | (doall (pmap prn+1 data)) 367 | ;; Claypoole eager pmap does pool size * 2 - 1 work after an exception, since 368 | ;; the exceptional task is part of the buffer, so 5 numbers will be printed. 369 | (doall (cp/pmap 3 prn+1 data)) 370 | ;; Claypoole lazy pmap does pool size work after an exception, so 3 numbers 371 | ;; will be printed. 372 | (doall (lazy/pmap 3 prn+1 data))) 373 | ``` 374 | 375 | Note that if tasks are still running when the pool is force-shutdown with 376 | `shutdown!`, those tasks will be aborted. 377 | 378 | ```clojure 379 | (cp/with-shutdown! [pool 2] 380 | (doall (cp/pmap pool inc (cons nil (range 100))))) 381 | ;; Some of those inc tasks will have been aborted because the sequence was 382 | ;; truncated by the exception, so the doall finished, and then the pool was 383 | ;; immediately shutdown! while a few tasks were still running. 384 | ``` 385 | 386 | (Note: Before Claypoole 0.4.0, its behavior was to kill later tasks if one task 387 | failed. In addition to possibly surprising users, that required more code 388 | complexity than was wise.) 389 | 390 | ## How can I prioritize my tasks? 391 | 392 | You can create a threadpool that respects task priorities by creating a 393 | `priority-threadpool`: 394 | 395 | ```clojure 396 | (def p1 (cp/priority-threadpool 5)) 397 | (def p2 (cp/priority-threadpool 5 :default-priority -10)) 398 | ``` 399 | 400 | Then, use functions `with-priority` and `with-priority-fn` to set the priority 401 | of your tasks, or just set the `:priority` in your `for` loop: 402 | 403 | ```clojure 404 | (cp/future (cp/with-priority p1 100) (myfn)) 405 | ;; Nothing bad happens if you nest with-priority. The outermost one "wins"; 406 | ;; this task runs at priority 2. 407 | (cp/future (cp/with-priority (cp-with-priority p1 1) 2) (myfn)) 408 | ;; For pmaps, you can use a priority function, which is called with your 409 | ;; arguments. This will run 3 tasks at priorities 6, 5, and 4, respectively. 410 | (cp/upmap (cp/with-priority-fn p1 (fn [x _] x)) + [6 5 4] [1 2 3]) 411 | ;; For for loops, you can use the special :priority binding, which must be the 412 | ;; last for binding. 413 | (cp/upfor p1 [i (range 10) 414 | :priority (- i)] 415 | (myfn i)) 416 | ``` 417 | 418 | ## What about Java interoperability? 419 | 420 | Under the hood, threadpools are just instances of 421 | `java.util.concurrent.ExecutorService`. You can use any `ExecutorService` in 422 | place of a threadpool, and you can use a threadpool just as you would an 423 | `ExecutorService`. This means you can create custom threadpools and use them 424 | easily. 425 | 426 | You might also like using [dirigiste](https://github.com/ztellman/dirigiste) 427 | threadpools with Claypoole. Dirigiste provides a fast, instrumented 428 | ExecutorService that scales in a controllable way. Note that dirigiste by 429 | default creates thread pools that throw exceptions when full, which makes it 430 | hard for Claypoole to enqueue tasks. Instead, you can use the Executor 431 | constructor directly, though it's a bit ugly: 432 | 433 | ```clojure 434 | (def pool 435 | (io.aleph.dirigiste.Executor. 436 | (java.util.concurrent.Executors/defaultThreadFactory) 437 | ;; Here's where we insert our non-error queue 438 | (java.util.concurrent.LinkedBlockingQueue.) 439 | (io.aleph.dirigiste.Executors/fixedController n-threads) 440 | n-threads 441 | ;; Metrics to capture 442 | (java.util.EnumSet/noneOf io.aleph.dirigiste.Stats$Metric) 443 | ;; Dirigiste default sample period 444 | 25 445 | ;; Dirigiste default control period 446 | 10000 447 | java.util.concurrent.TimeUnit/MILLISECONDS)) 448 | ``` 449 | 450 | ## OMG My program isn't exiting! 451 | 452 | There are a few cases where threadpools will stop your program from exiting 453 | that can surprise users. We have endeavored to minimize them, but they can 454 | still be problems. 455 | 456 | ### My program doesn't exit until 60 seconds after main exits. 457 | 458 | Claypoole actually uses some `clojure.core/future`s. Unfortunately, those 459 | threads are from the agent threadpool, and they are not daemon threads. Those 460 | threads will automatically die 60 seconds after they're used. So if your main 461 | thread doesn't call either `shutdown-agents` or `System/exit`, those threads 462 | will keep going for a while! 463 | 464 | You'll [experience the same 465 | thing](http://tech.puredanger.com/2010/06/08/clojure-agent-thread-pools/) if 466 | you start a `future` or `pmap`--those extra threads have to be explicitly shut 467 | down, or they'll naturally die after 60 seconds. 468 | 469 | The answer is basically to call `(shutdown-agents)` before your main thread 470 | exits. 471 | 472 | _In a future version of Claypoole, we may switch to using a separate daemon 473 | threadpool for those futures. However, that could have other complications, so 474 | we are deferring that decision._ 475 | 476 | ### My program doesn't exit ever! 477 | 478 | Claypoole now (as of version 0.3) defaults to daemon threadpools, but before 479 | that threadpools were not daemons. If you have any non-daemon threadpools 480 | running and your main process exits, those threadpools will never die, and your 481 | program will hang indefinitely! 482 | 483 | The answer is: either use daemon threadpools (which is now the default) or be 484 | very careful to shut down your threadpools when you're done with them. See the 485 | above section on disposing of threadpools. 486 | 487 | ## Why the name "Claypoole"? 488 | 489 | The claypoole library is named after [John Claypoole (Betsy Ross's third 490 | husband)](http://en.wikipedia.org/wiki/Betsy_Ross) for reasons that are at 491 | best obscure. 492 | 493 | ## API Documentation 494 | Documentation is available at [![cljdoc badge](https://cljdoc.org/badge/com.climate/claypoole)](https://cljdoc.org/d/com.climate/claypoole/CURRENT) 495 | 496 | ## License 497 | 498 | Copyright (C) 2014 The Climate Corporation. Distributed under the Apache 499 | License, Version 2.0. You may not use this library except in compliance with 500 | the License. You may obtain a copy of the License at 501 | 502 | http://www.apache.org/licenses/LICENSE-2.0 503 | 504 | See the NOTICE file distributed with this work for additional information 505 | regarding copyright ownership. Unless required by applicable law or agreed 506 | to in writing, software distributed under the License is distributed on an 507 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 508 | or implied. See the License for the specific language governing permissions 509 | and limitations under the License. 510 | -------------------------------------------------------------------------------- /src/clj/com/climate/claypoole.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (ns com.climate.claypoole 15 | "Threadpool tools for Clojure. Claypoole provides parallel functions and 16 | macros that use threads from a pool and otherwise act like key builtins like 17 | future, pmap, for, and so on. See the file README.md for an introduction. 18 | 19 | A threadpool is just an ExecutorService with a fixed number of threads. In 20 | general, you can use your own ExecutorService in place of any threadpool, and 21 | you can treat a threadpool as you would any other ExecutorService." 22 | (:refer-clojure :exclude [future future-call pcalls pmap pvalues]) 23 | (:require [clojure.core :as core] 24 | [com.climate.claypoole.impl :as impl]) 25 | (:import [com.climate.claypoole.impl PriorityThreadpool PriorityThreadpoolImpl] 26 | [java.util.concurrent 27 | Callable 28 | ExecutorService 29 | Future 30 | CompletableFuture] 31 | [java.util.function Supplier])) 32 | 33 | 34 | (def ^:dynamic *parallel* 35 | "A dynamic binding to disable parallelism. If you do 36 | (binding [*parallel* false] 37 | body) 38 | then the body will have no parallelism. Disabling parallelism this way is 39 | handy for testing." 40 | true) 41 | 42 | (def ^:dynamic *default-pmap-buffer* 43 | "This is an advanced configuration option. You probably don't need to set 44 | this! 45 | 46 | When doing a pmap, Claypoole pushes input tasks into the threadpool. It 47 | normally tries to keep the threadpool full, plus it adds a buffer of size 48 | nthreads. If it can't find out the number of threads in the threadpool, it 49 | just tries to keep *default-pmap-buffer* tasks in the pool." 50 | 200) 51 | 52 | (defn ncpus 53 | "Get the number of available CPUs." 54 | [] 55 | (.. Runtime getRuntime availableProcessors)) 56 | 57 | #_{:clj-kondo/ignore [:unused-binding]} 58 | (defn thread-factory 59 | "Create a ThreadFactory with keyword options including thread daemon status 60 | :daemon, the thread name format :name (a string for format with one integer), 61 | and a thread priority :thread-priority. 62 | 63 | This is exposed as a public function because it's handy if you're 64 | instantiating your own ExecutorServices." 65 | [& {:keys [daemon thread-priority] pool-name :name 66 | :as args}] 67 | (->> args 68 | (apply concat) 69 | (apply impl/thread-factory))) 70 | 71 | (defn threadpool 72 | "Make a threadpool. It should be shutdown when no longer needed. 73 | 74 | A threadpool is just an ExecutorService with a fixed number of threads. In 75 | general, you can use your own ExecutorService in place of any threadpool, and 76 | you can treat a threadpool as you would any other ExecutorService. 77 | 78 | This takes optional keyword arguments: 79 | :daemon, a boolean indicating whether the threads are daemon threads, 80 | which will automatically die when the JVM exits, defaults to 81 | true) 82 | :name, a string giving the pool name, which will be the prefix of each 83 | thread name, resulting in threads named \"name-0\", 84 | \"name-1\", etc. Defaults to \"claypoole-[pool-number]\". 85 | :thread-priority, an integer in [Thread/MIN_PRIORITY, Thread/MAX_PRIORITY]. 86 | The effects of thread priority are system-dependent and should not 87 | be confused with Claypoole's priority threadpools that choose 88 | tasks based on a priority. For more info about Java thread 89 | priority see 90 | http://www.javamex.com/tutorials/threads/priority_what.shtml 91 | 92 | Note: Returns a ScheduledExecutorService rather than just an ExecutorService 93 | because it's the same thing with a few bonus features." 94 | ;; NOTE: The Clojure compiler doesn't seem to like the tests if we don't 95 | ;; fully expand this typename. 96 | ^java.util.concurrent.ScheduledExecutorService 97 | ;; NOTE: Although I'm repeating myself, I list all the threadpool-factory 98 | ;; arguments explicitly for API clarity. 99 | [n & {:keys [daemon thread-priority] pool-name :name 100 | :or {daemon true}}] 101 | (impl/threadpool n 102 | :daemon daemon 103 | :name pool-name 104 | :thread-priority thread-priority)) 105 | 106 | (defn priority-threadpool 107 | "Make a threadpool that chooses tasks based on their priorities. 108 | 109 | Assign priorities to tasks by wrapping the pool with with-priority or 110 | with-priority-fn. You can also set a default priority with keyword argument 111 | :default-priority. 112 | 113 | Otherwise, this uses the same keyword arguments as threadpool, and functions 114 | just like any other ExecutorService." 115 | ^com.climate.claypoole.impl.PriorityThreadpool 116 | [n & {:keys [default-priority] :as args 117 | :or {default-priority 0}}] 118 | (PriorityThreadpool. 119 | (PriorityThreadpoolImpl. n 120 | ;; Use our thread factory options. 121 | (impl/apply-map impl/thread-factory args) 122 | default-priority) 123 | (constantly default-priority))) 124 | 125 | (defn with-priority-fn 126 | "Make a priority-threadpool wrapper that uses a given priority function. 127 | 128 | The priority function is applied to a pmap'd function's arguments. e.g. 129 | 130 | (upmap (with-priority-fn pool (fn [x _] x)) 131 | + [6 5 4] [1 2 3]) 132 | 133 | will use pool to run tasks [(+ 6 1) (+ 5 2) (+ 4 3)] 134 | with priorities [6 5 4]." 135 | ^com.climate.claypoole.impl.PriorityThreadpool 136 | [^com.climate.claypoole.impl.PriorityThreadpool pool priority-fn] 137 | (impl/with-priority-fn pool priority-fn)) 138 | 139 | (defn with-priority 140 | "Make a priority-threadpool wrapper with a given fixed priority. 141 | 142 | All tasks run with this pool wrapper will have the given priority. e.g. 143 | 144 | (def t1 (future (with-priority p 1) 1)) 145 | (def t2 (future (with-priority p 2) 2)) 146 | (def t3 (future (with-priority p 3) 3)) 147 | 148 | will use pool p to run these tasks with priorities 1, 2, and 3 respectively. 149 | 150 | If you nest priorities, the outermost one \"wins\", so this task will be run 151 | at priority 3: 152 | 153 | (def wp (with-priority p 1)) 154 | (def t1 (future (with-priority (with-priority wp 2) 3) :result)) 155 | " 156 | ^java.util.concurrent.ExecutorService [^ExecutorService pool priority] 157 | (with-priority-fn pool (constantly priority))) 158 | 159 | (defn threadpool? 160 | "Returns true iff the argument is a threadpool." 161 | [pool] 162 | (instance? ExecutorService pool)) 163 | 164 | (defn priority-threadpool? 165 | "Returns true iff the argument is a priority-threadpool." 166 | [pool] 167 | (instance? PriorityThreadpool pool)) 168 | 169 | (defn shutdown 170 | "Syntactic sugar to stop a pool cleanly. This will stop the pool from 171 | accepting any new requests." 172 | [^ExecutorService pool] 173 | (when (not (= pool clojure.lang.Agent/soloExecutor)) 174 | (.shutdown pool))) 175 | 176 | (defn shutdown! 177 | "Syntactic sugar to forcibly shutdown a pool. This will kill any running 178 | threads in the pool!" 179 | [^ExecutorService pool] 180 | (when (not (= pool clojure.lang.Agent/soloExecutor)) 181 | (.shutdownNow pool))) 182 | 183 | (defn shutdown? 184 | "Syntactic sugar to test if a pool is shutdown." 185 | [^ExecutorService pool] 186 | (.isShutdown pool)) 187 | 188 | (defmacro with-shutdown! 189 | "Lets a threadpool from an initializer, then evaluates body in a try 190 | expression, calling shutdown! on the threadpool to forcibly shut it down at 191 | the end. 192 | 193 | The threadpool initializer may be a threadpool. Alternately, it can be any 194 | threadpool argument accepted by pmap, e.g. a number, :builtin, or :serial, in 195 | which case it will create a threadpool just as pmap would. 196 | 197 | Be aware that any unfinished jobs at the end of the body will be killed! 198 | 199 | Examples: 200 | 201 | (with-shutdown! [pool (threadpool 6)] 202 | (doall (pmap pool identity (range 1000)))) 203 | (with-shutdown! [pool1 6 204 | pool2 :serial] 205 | (doall (pmap pool1 identity (range 1000)))) 206 | 207 | Bad example: 208 | 209 | (with-shutdown! [pool 6] 210 | ;; Some of these tasks may be killed! 211 | (pmap pool identity (range 1000))) 212 | " 213 | [pool-syms-and-inits & body] 214 | (when-not (even? (count pool-syms-and-inits)) 215 | (throw (IllegalArgumentException. 216 | "with-shutdown! requires an even number of binding forms"))) 217 | (if (empty? pool-syms-and-inits) 218 | `(do ~@body) 219 | (let [[pool-sym pool-init & more] pool-syms-and-inits] 220 | `(let [pool-init# ~pool-init 221 | [_# ~pool-sym] (impl/->threadpool pool-init#)] 222 | (try 223 | (with-shutdown! ~more ~@body) 224 | (finally 225 | (when (threadpool? ~pool-sym) 226 | (shutdown! ~pool-sym)))))))) 227 | 228 | (defn serial? 229 | "Check if we should run computations on this threadpool in serial." 230 | [pool] 231 | (or (not *parallel*) (= pool :serial))) 232 | 233 | (defn future-call 234 | "Like clojure.core/future-call, but using a threadpool. 235 | 236 | The threadpool may be one of 3 things: 237 | 1. An ExecutorService, e.g. one created by threadpool. 238 | 2. The keyword :builtin. In this case, the future will use the built-in 239 | agent threadpool, the same threadpool used by an ordinary 240 | clojure.core/future. 241 | 3. The keyword :serial. In this case, the computation will be performed in 242 | serial. This may be helpful during profiling, for example. 243 | " 244 | [pool f] 245 | (impl/validate-future-pool pool) 246 | (cond 247 | ;; If requested, run the future in serial. 248 | (serial? pool) (impl/dummy-future-call f) 249 | ;; If requested, use the default threadpool. 250 | (= :builtin pool) (future-call clojure.lang.Agent/soloExecutor f) 251 | :else (let [;; We have to get the casts right, or the compiler will choose 252 | ;; the (.submit ^Runnable) call, which returns nil. We don't 253 | ;; want that! 254 | ^ExecutorService pool* pool 255 | ^Callable f* (impl/binding-conveyor-fn f) 256 | fut (.submit pool* f*)] 257 | ;; Make an object just like Clojure futures. 258 | (reify 259 | clojure.lang.IDeref 260 | (deref [_] (impl/deref-future fut)) 261 | clojure.lang.IBlockingDeref 262 | (deref 263 | [_ timeout-ms timeout-val] 264 | (impl/deref-future fut timeout-ms timeout-val)) 265 | clojure.lang.IPending 266 | (isRealized [_] (.isDone fut)) 267 | Future 268 | (get [_] (.get fut)) 269 | (get [_ timeout unit] (.get fut timeout unit)) 270 | (isCancelled [_] (.isCancelled fut)) 271 | (isDone [_] (.isDone fut)) 272 | (cancel [_ interrupt?] (.cancel fut interrupt?)))))) 273 | 274 | (defmacro future 275 | "Like clojure.core/future, but using a threadpool. 276 | 277 | The threadpool may be one of 3 things: 278 | 1. An ExecutorService, e.g. one created by threadpool. 279 | 2. The keyword :builtin. In this case, the future will use the built-in 280 | agent threadpool, the same threadpool used by an ordinary 281 | clojure.core/future. 282 | 3. The keyword :serial. In this case, the computation will be performed in 283 | serial. This may be helpful during profiling, for example. 284 | " 285 | [pool & body] 286 | `(future-call ~pool (^{:once true} fn ~'future-body [] ~@body))) 287 | 288 | (defn completable-future-call 289 | "Like clojure.core/future-call, but using a threadpool, and returns a CompletableFuture. 290 | 291 | The threadpool may be one of 3 things: 292 | 1. An ExecutorService, e.g. one created by threadpool. 293 | 2. The keyword :builtin. In this case, the future will use the built-in 294 | agent threadpool, the same threadpool used by an ordinary 295 | clojure.core/future. 296 | 3. The keyword :serial. In this case, the computation will be performed in 297 | serial. This may be helpful during profiling, for example. 298 | " 299 | [pool f] 300 | (impl/validate-future-pool pool) 301 | (cond 302 | ;; If requested, run the future in serial. 303 | (serial? pool) (CompletableFuture/completedFuture (f)) 304 | ;; If requested, use the default threadpool. 305 | (= :builtin pool) (completable-future-call clojure.lang.Agent/soloExecutor f) 306 | :else 307 | (let [f* (impl/binding-conveyor-fn f)] 308 | (CompletableFuture/supplyAsync 309 | (reify Supplier 310 | (get [_] 311 | (f*))) pool)))) 312 | 313 | (defmacro completable-future 314 | "Like clojure.core/future, but using a threadpool and returns a CompletableFuture. 315 | 316 | The threadpool may be one of 3 things: 317 | 1. An ExecutorService, e.g. one created by threadpool. 318 | 2. The keyword :builtin. In this case, the future will use the built-in 319 | agent threadpool, the same threadpool used by an ordinary 320 | clojure.core/future. 321 | 3. The keyword :serial. In this case, the computation will be performed in 322 | serial. This may be helpful during profiling, for example. 323 | " 324 | [pool & body] 325 | `(completable-future-call ~pool (^{:once true} fn ~'completable-future-body [] ~@body))) 326 | 327 | (defn- buffer-blocking-seq 328 | "Make a lazy sequence that blocks when the map's (imaginary) buffer is full." 329 | [pool unordered-results] 330 | (let [buffer-size (if-let [pool-size (impl/get-pool-size pool)] 331 | (* 2 pool-size) 332 | *default-pmap-buffer*)] 333 | (concat (repeat buffer-size nil) 334 | unordered-results))) 335 | 336 | (defn- pmap-core 337 | "Given functions to customize for pmap or upmap, do the hard work of pmap." 338 | [pool ordered? f arg-seqs] 339 | (let [[shutdown? pool] (impl/->threadpool pool) 340 | ;; Use map to handle the argument sequences. 341 | args (apply map vector (map impl/unchunk arg-seqs)) 342 | ;; We set this to true to stop realizing more tasks. 343 | abort (atom false) 344 | ;; Set up queues of tasks and results 345 | [task-q tasks] (impl/queue-seq) 346 | [unordered-results-q unordered-results] (impl/queue-seq) 347 | ;; This is how we'll actually make things go. 348 | start-task (fn [_i a] 349 | ;; We can't directly make a future add itself to a 350 | ;; queue. Instead, we use a promise for indirection. 351 | (let [p (promise)] 352 | (deliver p (future-call 353 | pool 354 | (with-meta 355 | ;; Try to run the task, but definitely 356 | ;; add the future to the queue. 357 | #(try 358 | (apply f a) 359 | (catch Throwable t 360 | ;; If we've had an exception, stop 361 | ;; making new tasks. 362 | (reset! abort true) 363 | ;; Re-throw that throwable! 364 | (throw t)) 365 | (finally 366 | (impl/queue-seq-add! 367 | unordered-results-q @p))) 368 | ;; Add the args to the function's 369 | ;; metadata for prioritization. 370 | {:args a}))) 371 | @p)) 372 | ;; Start all the tasks in a real future, so we don't block. 373 | driver (core/future 374 | (try 375 | (doseq [[i a _] 376 | (map vector (range) args 377 | ;; The driver thread reads from this sequence 378 | ;; and ignores the result, just to get the side 379 | ;; effect of blocking when the map's 380 | ;; (imaginary) buffer is full. 381 | (buffer-blocking-seq pool unordered-results)) 382 | :while (not @abort)] 383 | (impl/queue-seq-add! task-q (start-task i a))) 384 | (finally 385 | (impl/queue-seq-end! task-q) 386 | (when shutdown? (shutdown pool))))) 387 | result-seq (if ordered? 388 | tasks 389 | (map second (impl/lazy-co-read tasks unordered-results)))] 390 | ;; Read results as available. 391 | (concat 392 | (map impl/deref-fixing-exceptions result-seq) 393 | ;; Deref the read-future to get its exceptions, if it has any. 394 | (lazy-seq @driver)))) 395 | 396 | (defn- pmap-boilerplate 397 | "Do boilerplate pmap checks, then call the real pmap function." 398 | [pool ordered? f arg-seqs] 399 | (when (empty? arg-seqs) 400 | (throw (IllegalArgumentException. 401 | "pmap requires at least one sequence to map over"))) 402 | (if (serial? pool) 403 | (doall (apply map f arg-seqs)) 404 | (pmap-core pool ordered? f arg-seqs))) 405 | 406 | (defn pmap 407 | "Like clojure.core.pmap, except: 408 | 1. It is eager, returning an ordered sequence of completed results as they 409 | are available. 410 | 2. It uses a threadpool to control the desired level of parallelism. 411 | 412 | A word of caution: pmap will consume the entire input sequence and produce as 413 | much output as possible--if you pmap over (range) you'll get an Out of Memory 414 | Exception! Use this when you definitely want the work to be done. 415 | 416 | The threadpool may be one of 4 things: 417 | 1. An ExecutorService, e.g. one created by threadpool. 418 | 2. An integer. In this case, a threadpool will be created, and it will be 419 | destroyed when all the pmap tasks are complete. 420 | 3. The keyword :builtin. In this case, pmap will use the Clojure built-in 421 | agent threadpool. For pmap, that's probably not what you want, as you'll 422 | likely create a thread per task. 423 | 4. The keyword :serial. In this case, the computations will be performed in 424 | serial via (doall map). This may be helpful during profiling, for example. 425 | " 426 | [pool f & arg-seqs] 427 | (pmap-boilerplate pool true f arg-seqs)) 428 | 429 | (defn upmap 430 | "Like pmap, except that the return value is a sequence of results ordered by 431 | *completion time*, not by input order." 432 | [pool f & arg-seqs] 433 | (pmap-boilerplate pool false f arg-seqs)) 434 | 435 | (defn pcalls 436 | "Like clojure.core.pcalls, except it takes a threadpool. For more detail on 437 | its parallelism and on its threadpool argument, see pmap." 438 | [pool & fs] 439 | (pmap pool #(%) fs)) 440 | 441 | (defn upcalls 442 | "Like clojure.core.pcalls, except it takes a threadpool and returns results 443 | ordered by completion time. For more detail on its parallelism and on its 444 | threadpool argument, see upmap." 445 | [pool & fs] 446 | (upmap pool #(%) fs)) 447 | 448 | (defmacro pvalues 449 | "Like clojure.core.pvalues, except it takes a threadpool. For more detail on 450 | its parallelism and on its threadpool argument, see pmap." 451 | [pool & exprs] 452 | `(pcalls ~pool ~@(for [e exprs] `(fn [] ~e)))) 453 | 454 | (defmacro upvalues 455 | "Like clojure.core.pvalues, except it takes a threadpool and returns results 456 | ordered by completion time. For more detail on its parallelism and on its 457 | threadpool argument, see upmap." 458 | [pool & exprs] 459 | `(upcalls ~pool ~@(for [e exprs] `(fn [] ~e)))) 460 | 461 | (defmacro pfor 462 | "A parallel version of for. It is like for, except it takes a threadpool and 463 | is parallel. For more detail on its parallelism and on its threadpool 464 | argument, see pmap. 465 | 466 | Note that while the body is executed in parallel, the bindings are executed 467 | in serial, so while this will call complex-computation in parallel: 468 | (pfor pool [i (range 1000)] (complex-computation i)) 469 | this will not have useful parallelism: 470 | (pfor pool [i (range 1000) :let [result (complex-computation i)]] result) 471 | 472 | You can use the special binding :priority (which must be the last binding) to 473 | set the priorities of the tasks. 474 | (upfor (priority-threadpool 10) [i (range 1000) 475 | :priority (inc i)] 476 | (complex-computation i)) 477 | " 478 | [pool bindings & body] 479 | (impl/pfor-internal pool bindings body `pmap)) 480 | 481 | (defmacro upfor 482 | "Like pfor, except the return value is a sequence of results ordered by 483 | *completion time*, not by input order." 484 | [pool bindings & body] 485 | (impl/pfor-internal pool bindings body `upmap)) 486 | 487 | (defmacro pdoseq 488 | "Like doseq, but in parallel. Unlike the streaming sequence functions (e.g. 489 | pmap), pdoseq blocks until all the work is done. 490 | 491 | Similar to pfor, only the body is done in parallel. For more details, see 492 | pfor." 493 | [pool bindings & body] 494 | `(dorun (upfor ~pool ~bindings (do ~@body)))) 495 | 496 | (defn prun! 497 | "Like run!, but in parallel. Unlike the streaming sequence functions (e.g. 498 | pmap), prun! blocks until all the work is done." 499 | [pool proc coll] 500 | (dorun (upmap pool proc coll))) 501 | -------------------------------------------------------------------------------- /test/com/climate/claypoole_test.clj: -------------------------------------------------------------------------------- 1 | ;; The Climate Corporation licenses this file to you under under the Apache 2 | ;; License, Version 2.0 (the "License"); you may not use this file except in 3 | ;; compliance with the License. You may obtain a copy of the License at 4 | ;; 5 | ;; http://www.apache.org/licenses/LICENSE-2.0 6 | ;; 7 | ;; See the NOTICE file distributed with this work for additional information 8 | ;; regarding copyright ownership. Unless required by applicable law or agreed 9 | ;; to in writing, software distributed under the License is distributed on an 10 | ;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express 11 | ;; or implied. See the License for the specific language governing permissions 12 | ;; and limitations under the License. 13 | 14 | (ns com.climate.claypoole-test 15 | (:require [clojure.test :refer :all] 16 | [com.climate.claypoole :as cp] 17 | [com.climate.claypoole.impl :as impl] 18 | [com.climate.claypoole.test-helpers :as th]) 19 | (:import [java.util.concurrent ExecutionException ExecutorService])) 20 | 21 | (def ^:dynamic *test-context* nil) 22 | 23 | (defn callable 24 | "Just a cast." 25 | ^Callable [^clojure.lang.IFn f] 26 | f) 27 | 28 | (defn check-threadpool-options 29 | [pool-constructor] 30 | (let [default-priority (.getPriority (Thread/currentThread))] 31 | (cp/with-shutdown! [pool (pool-constructor 4)] 32 | @(cp/future 33 | pool 34 | (let [thread (Thread/currentThread)] 35 | (is (true? (.isDaemon thread))) 36 | (is (re-matches #"claypoole-[0-9]*-[0-4]" (.getName thread))) 37 | (is (= default-priority (.getPriority thread)))))) 38 | (cp/with-shutdown! [pool (pool-constructor 4 39 | :daemon false 40 | :name "fiberpond" 41 | :thread-priority 4)] 42 | @(cp/future 43 | pool 44 | (let [thread (Thread/currentThread)] 45 | (is (false? (.isDaemon thread))) 46 | (is (re-matches #"fiberpond-[0-4]" (.getName thread))) 47 | (is (= 4 (.getPriority thread)))))))) 48 | 49 | (deftest test-threadpool 50 | (testing "Basic threadpool creation" 51 | (cp/with-shutdown! [pool (cp/threadpool 4)] 52 | (is (instance? ExecutorService pool)) 53 | (dotimes [_ 8] (.submit pool #(inc 1))) 54 | (is (= 4 (.getPoolSize pool))))) 55 | (testing "Threadpool options" 56 | (check-threadpool-options cp/threadpool))) 57 | 58 | (defn- sorted*? 59 | "Is a sequence sorted?" 60 | [x] 61 | (= x (sort x))) 62 | 63 | (deftest test-priority-threadpool 64 | (testing "Priority threadpool ordering is mostly in order" 65 | (cp/with-shutdown! [pool (cp/priority-threadpool 1)] 66 | (let [start (promise) 67 | completed (atom []) 68 | tasks (doall 69 | (for [i (range 10)] 70 | (cp/future (cp/with-priority pool i) 71 | (deref start) 72 | (swap! completed conj i))))] 73 | ;; start tasks 74 | (Thread/sleep 100) 75 | (deliver start true) 76 | ;; Wait for tasks to complete 77 | (doseq [f tasks] (deref f)) 78 | (is (= [0 9 8 7 6 5 4 3 2 1] 79 | @completed))))) 80 | (testing "Priority threadpool ordering is ordered with unordered inputs." 81 | (cp/with-shutdown! [pool (cp/priority-threadpool 1)] 82 | (let [start (promise) 83 | completed (atom []) 84 | tasks (doall 85 | (for [i (shuffle (range 100))] 86 | (cp/future (cp/with-priority pool i) 87 | (deref start) 88 | (swap! completed conj i))))] 89 | ;; start tasks 90 | (deliver start true) 91 | ;; Wait for tasks to complete 92 | (doseq [f tasks] (deref f)) 93 | (is (sorted*? 94 | (-> completed 95 | deref 96 | ;; The first task will be one at random, so drop it 97 | rest 98 | reverse)))))) 99 | (testing "Priority threadpool default priority." 100 | (cp/with-shutdown! [pool (cp/priority-threadpool 1 :default-priority 50)] 101 | (let [start (promise) 102 | completed (atom []) 103 | run (fn [result] (deref start) (swap! completed conj result)) 104 | first-task (cp/future pool (run :first)) 105 | tasks (doall 106 | (for [i [1 100]] 107 | (cp/future (cp/with-priority pool i) (run i)))) 108 | default-task (cp/future pool (run :default))] 109 | ;; start tasks 110 | (deliver start true) 111 | ;; Wait for tasks to complete 112 | (doseq [f tasks] (deref f)) 113 | (deref default-task) 114 | (is (= [:first 100 :default 1] @completed))))) 115 | (testing "Priority threadpool options" 116 | (check-threadpool-options cp/priority-threadpool))) 117 | 118 | (deftest test-with-priority-fn 119 | (testing "with-priority-fn works for simple upmap" 120 | (cp/with-shutdown! [pool (cp/priority-threadpool 1)] 121 | (let [start (promise) 122 | results (cp/upmap (cp/with-priority-fn 123 | pool (fn [& args] (first args))) 124 | (fn [i] 125 | (deref start) 126 | i) 127 | (range 10))] 128 | ;; start tasks 129 | (Thread/sleep 100) 130 | (deliver start true) 131 | (is (= [0 9 8 7 6 5 4 3 2 1] 132 | results))))) 133 | (testing "with-priority-fn throws sensible exceptions" 134 | (cp/with-shutdown! [pool (cp/priority-threadpool 2)] 135 | (is (thrown-with-msg? 136 | Exception #"Priority function exception" 137 | ;; Arity exception. 138 | (dorun 139 | (cp/pmap (cp/with-priority-fn pool (fn [] 0)) 140 | (fn [x y] (+ x y)) 141 | (range 10) (range 10))))) 142 | (is (thrown-with-msg? 143 | ;; No arguments passed to priority function. 144 | Exception #"Priority function exception" 145 | (deref (cp/future (cp/with-priority-fn 146 | pool (fn [& args] (first args))) 147 | 1))))))) 148 | 149 | (deftest test-for-priority 150 | (testing "pfor uses priority" 151 | (cp/with-shutdown! [pool (cp/priority-threadpool 1)] 152 | (let [start (promise) 153 | completed (atom []) 154 | tasks (cp/pfor pool 155 | [i (range 100) 156 | :priority (inc i)] 157 | (deref start) 158 | (swap! completed conj i) 159 | i)] 160 | (Thread/sleep 100) 161 | (deliver start true) 162 | (dorun tasks) 163 | ;; Just worry about the rest of the tasks; the first one may be out of 164 | ;; order. 165 | (is (sorted*? (reverse (rest @completed)))) 166 | (is (= (range 100) tasks))))) 167 | (testing "upfor uses priority" 168 | (cp/with-shutdown! [pool (cp/priority-threadpool 1)] 169 | (let [start (promise) 170 | completed (atom []) 171 | tasks (cp/upfor pool 172 | [i (range 100) 173 | :priority (inc i)] 174 | (deref start) 175 | (swap! completed conj i) 176 | i)] 177 | (Thread/sleep 100) 178 | (deliver start true) 179 | (dorun tasks) 180 | ;; Just worry about the rest of the tasks; the first one may be out of 181 | ;; order. 182 | (is (sorted*? (reverse (rest @completed)))) 183 | (is (= @completed tasks)))))) 184 | 185 | (deftest test-priority-nonIObj 186 | (testing "A priority pool should work on any sort of Callable." 187 | (cp/with-shutdown! [pool (cp/priority-threadpool 1)] 188 | (let [start (promise) 189 | results (atom []) 190 | run (fn [x] (deref start) (swap! results conj x))] 191 | ;; Dummy task, always runs first. 192 | (cp/future (cp/with-priority pool 100) 193 | (run 100)) 194 | ;; Runnables. 195 | (.submit (cp/with-priority pool 1) 196 | (reify Runnable (run [_] (run 1)))) 197 | (.submit (cp/with-priority pool 10) 198 | (reify Runnable (run [_] (run 10)))) 199 | ;; Runnables with return value. 200 | (.submit (cp/with-priority pool 2) 201 | (reify Runnable (run [_] (run 2))) 202 | :return-value) 203 | (.submit (cp/with-priority pool 9) 204 | (reify Runnable (run [_] (run 9))) 205 | :return-value) 206 | (cp/future (cp/with-priority pool 6) 207 | (run 6)) 208 | (cp/future (cp/with-priority pool 11) 209 | (run 11)) 210 | ;; Callables 211 | (.submit (cp/with-priority pool 3) 212 | (reify Callable (call [_] (run 3)))) 213 | (.submit (cp/with-priority pool 8) 214 | (reify Callable (call [_] (run 8)))) 215 | ;; And another couple IFns for good measure 216 | (cp/future (cp/with-priority pool 5) 217 | (run 5)) 218 | (cp/future (cp/with-priority pool 7) 219 | (run 7)) 220 | ;; Make them go. 221 | (Thread/sleep 100) 222 | (deliver start true) 223 | ;; Check the results 224 | (Thread/sleep 100) 225 | (is (sorted*? (reverse @results))))))) 226 | 227 | (deftest test-threadpool? 228 | (testing "Basic threadpool?" 229 | (cp/with-shutdown! [pool 4 230 | priority-pool (cp/priority-threadpool 4)] 231 | (is (true? (cp/threadpool? pool))) 232 | (is (true? (cp/threadpool? priority-pool))) 233 | (is (false? (cp/threadpool? :serial))) 234 | (is (false? (cp/threadpool? nil))) 235 | (is (false? (cp/threadpool? 1)))))) 236 | 237 | (deftest test-shutdown 238 | (testing "Basic shutdown" 239 | (let [pool (cp/threadpool 4) 240 | start (promise) 241 | result (promise) 242 | f (.submit pool (callable #(deliver result (deref start))))] 243 | (is (false? (cp/shutdown? pool))) 244 | (Thread/sleep 100) 245 | ;; Make sure the threadpool starts shutting down but doesn't complete 246 | ;; until the threads finish. 247 | (cp/shutdown pool) 248 | (is (true? (cp/shutdown? pool))) 249 | (is (false? (.isTerminated pool))) 250 | (Thread/sleep 100) 251 | (deliver start true) 252 | (Thread/sleep 100) 253 | (is (true? (.isTerminated pool))) 254 | (is (true? @result)))) 255 | (testing "Shutdown does not affect builtin threadpool" 256 | (cp/shutdown clojure.lang.Agent/soloExecutor) 257 | (is (not (cp/shutdown? clojure.lang.Agent/soloExecutor))))) 258 | 259 | (deftest test-shutdown! 260 | (testing "Basic shutdown!" 261 | (let [pool (cp/threadpool 4) 262 | start (promise) 263 | f (.submit pool (callable #(deref start)))] 264 | (is (false? (cp/shutdown? pool))) 265 | (Thread/sleep 100) 266 | ;; Make sure the threadpool completes shutting down immediately. 267 | (cp/shutdown! pool) 268 | (is (true? (cp/shutdown? pool))) 269 | ;; It can take some time for the threadpool to kill the threads. 270 | (Thread/sleep 100) 271 | (is (true? (.isTerminated pool))) 272 | (is (.isDone f)) 273 | (is (thrown? ExecutionException (deref f))))) 274 | (testing "Shutdown! does not affect builtin threadpool" 275 | (cp/shutdown! clojure.lang.Agent/soloExecutor) 276 | (is (not (cp/shutdown? clojure.lang.Agent/soloExecutor))))) 277 | 278 | (deftest test-with-shutdown! 279 | (testing "With-shutdown! arguments" 280 | (doseq [arg [4 (cp/threadpool 4) :builtin :serial]] 281 | (let [outside-pool (promise) 282 | start (promise) 283 | fp (promise)] 284 | (cp/with-shutdown! [pool arg] 285 | (deliver outside-pool pool) 286 | ;; Use a future to avoid blocking on the :serial case. 287 | (deliver fp (future (.submit pool #(deref start)))) 288 | (Thread/sleep 100)) 289 | ;; Make sure outside of the with-shutdown block the pool is properly 290 | ;; killed. 291 | (when-not (keyword? arg) (is (true? (cp/shutdown? @outside-pool))) 292 | (Thread/sleep 100) 293 | (is (true? (.isTerminated @outside-pool))) 294 | (deliver start true) 295 | (Thread/sleep 100) 296 | (is (.isDone @@fp)) 297 | (is (thrown? ExecutionException (deref @@fp))))))) 298 | (testing "With-shutdown! works with any number of threadpools" 299 | (let [input (range 100)] 300 | (is (= input 301 | (cp/with-shutdown! [] 302 | (map identity input)))) 303 | (is (= input 304 | (cp/with-shutdown! [p1 4] 305 | (->> input 306 | (cp/pmap p1 identity) 307 | doall)))) 308 | (is (= input 309 | (cp/with-shutdown! [p1 4 310 | p2 3] 311 | (->> input 312 | (cp/pmap p1 identity) 313 | (cp/pmap p2 identity) 314 | doall)))) 315 | (is (= input 316 | (cp/with-shutdown! [p1 4 317 | p2 3 318 | p3 5] 319 | (->> input 320 | (cp/pmap p1 identity) 321 | (cp/pmap p2 identity) 322 | (cp/pmap p3 identity) 323 | doall)))))) 324 | (testing "Invalid with-shutdown! arguments" 325 | (is (thrown? IllegalArgumentException 326 | (cp/with-shutdown! [pool 1.5] nil))) 327 | (is (thrown? IllegalArgumentException 328 | (cp/with-shutdown! [pool :parallel] nil))))) 329 | 330 | (defn check-parallel 331 | "Check that a pmap function actually runs in parallel." 332 | [pmap-like ordered? & [lazy?]] 333 | (let [n 10] 334 | (cp/with-shutdown! [pool n] 335 | (let [pool (cp/threadpool n) 336 | ;; Input is just a sequence of numbers. It's not in order so we can 337 | ;; check the streaming properties of the parallel function. 338 | input (vec (reverse (range n))) 339 | ;; We'll record what tasks have been started so we can make sure 340 | ;; all of them are started. 341 | started (atom []) 342 | ;; We'll check that our responses are streamed as available. We'll 343 | ;; control the order they're available with a sequence of promises. 344 | promise-chain (vec (repeatedly n promise)) 345 | results (pmap-like pool 346 | ;; Use a fancy identity function that waits on 347 | ;; the ith element in the chain of promises to 348 | ;; start. 349 | (fn [i] 350 | ;; Log that this task has been started. 351 | (swap! started conj i) 352 | ;; Wait for our promise to be ready. 353 | (deref (promise-chain i)) 354 | ;; Sleep a little to make sure that this task 355 | ;; returns noticeably later than the previous 356 | ;; one. 357 | (Thread/sleep 1) 358 | ;; Tell the next task it can run. 359 | (when (< (inc i) n) 360 | (deliver (promise-chain (inc i)) i)) 361 | i) 362 | input)] 363 | ;; If it's a truly lazy function, we have to force the sequence to make 364 | ;; the futures start. 365 | (when lazy? (future (doall results))) 366 | ;; All tasks should have started after 100ms. 367 | (Thread/sleep 100) 368 | (is (= (set @started) (set input))) 369 | ;; Each task should be started only once. 370 | (is (= @started (distinct @started))) 371 | ;; Start the first task. 372 | (deliver (first promise-chain) nil) 373 | (is (= results (if ordered? 374 | ;; If we're doing an ordered operation, we expect to 375 | ;; see them in the order we submitted them. 376 | input 377 | ;; If we're doing an -unordered operation, we expect 378 | ;; to see them return as available, so in sorted 379 | ;; order. 380 | (sort input)))))))) 381 | 382 | (defn check-lazy-read 383 | "Check that a pmap function reads lazily" 384 | [pmap-like & [lazy?]] 385 | (let [n 10] 386 | (cp/with-shutdown! [pool n] 387 | (let [pool (cp/threadpool n) 388 | first-inputs (range n) 389 | second-inputs (range n (* n 2)) 390 | ;; The input will have a pause after n items. 391 | pause (promise) 392 | input (concat first-inputs (lazy-seq (list @pause)) second-inputs) 393 | ;; We'll record what tasks have been started so we can make sure 394 | ;; all of them are started. 395 | started (atom #{}) 396 | results (pmap-like pool 397 | (fn [i] (swap! started conj i) i) 398 | input)] 399 | ;; When genuinely lazy, we must force the sequence to start tasks. 400 | (when lazy? (future (doall results))) 401 | ;; All of the first set of tasks should have started after 100ms. 402 | (Thread/sleep 100) 403 | (is (= @started (set first-inputs))) 404 | (deliver pause :pause) 405 | (Thread/sleep 100) 406 | (is (= @started (set results) (set input))))))) 407 | 408 | (defn check-chaining 409 | "Check that we can chain pmaps." 410 | [pmap-like] 411 | (cp/with-shutdown! [p1 (cp/threadpool 2) 412 | p2 (cp/threadpool 4)] 413 | (is (= (range 1 11) 414 | (->> (range 10) 415 | (pmap-like p1 inc) 416 | sort))) 417 | (is (= (range 2 12) 418 | (->> (range 10) 419 | (pmap-like p1 inc) 420 | (pmap-like p1 inc) 421 | sort))) 422 | (is (= (range 3 13) 423 | (->> (range 10) 424 | (pmap-like p1 inc) 425 | (pmap-like p1 inc) 426 | (pmap-like p2 inc) 427 | sort))))) 428 | 429 | (defn check-shutdown-exceptions 430 | "Check that exceptions are thrown when tasks go to a shutdown pool." 431 | [pmap-like] 432 | (cp/with-shutdown! [pool 2] 433 | (let [input (range 4) 434 | start (promise) 435 | delayed-input (map (fn [i] (deref start) i) input) 436 | results (future (pmap-like pool identity 437 | (concat input delayed-input)))] 438 | (Thread/sleep 100) 439 | (cp/shutdown pool) 440 | (deliver start true) 441 | (is (thrown? Exception (dorun @results)))))) 442 | 443 | (defn check-fn-exception 444 | "Check that a pmap function correctly passes exceptions caused by the 445 | function." 446 | [pmap-like] 447 | (let [n 10 448 | pool (cp/threadpool n) 449 | inputs [0 1 2 3 :4 5 6 7 8 9]] 450 | (is (thrown-with-msg? 451 | NullPointerException #"keyword found" 452 | (dorun (pmap-like pool 453 | (fn [i] 454 | (if (keyword? i) 455 | (throw (NullPointerException. "keyword found")) 456 | i)) 457 | inputs)))) 458 | (.shutdown pool))) 459 | 460 | (defn check-fn-throwable 461 | "Check that a pmap function correctly passes non-Exception throwables caused 462 | by the function." 463 | [pmap-like] 464 | (let [n 10 465 | pool (cp/threadpool n) 466 | inputs [0 1 2 3 :4 5 6 7 8 9]] 467 | (is (thrown-with-msg? 468 | AssertionError #"keyword found" 469 | (dorun (pmap-like pool 470 | (fn [i] 471 | (if (keyword? i) 472 | (throw (AssertionError. "keyword found")) 473 | i)) 474 | inputs)))) 475 | (.shutdown pool))) 476 | 477 | (defn check-input-exception 478 | "Check that a pmap function correctly passes exceptions caused by lazy 479 | inputs." 480 | [pmap-like] 481 | (let [n 10 482 | pool (cp/threadpool n) 483 | inputs (map #(if (< % 100) 484 | % 485 | (throw (Exception. 486 | "deliberate exception"))) 487 | (range 200))] 488 | (is (thrown-with-msg? 489 | Exception #"deliberate" 490 | (dorun (pmap-like pool inc inputs)))) 491 | (.shutdown pool))) 492 | 493 | (defn check-maximum-parallelism-one-case 494 | "Check that a pmap function doesn't exhibit excessive parallelism." 495 | [pmap-like n pool] 496 | (let [ni (min 100 (* n 10)) ;; Don't test too many cases. 497 | inputs (range ni) 498 | ;; Keep track of what threads are active. 499 | n-active (atom 0) 500 | n-seen-active (atom []) 501 | results (pmap-like pool 502 | (fn [i] 503 | (swap! n-active inc) 504 | (Thread/sleep 1) 505 | ;; Make sure not too many threads are going. 506 | (swap! n-seen-active conj @n-active) 507 | (swap! n-active dec) 508 | i) 509 | inputs)] 510 | (is (= (sort results) inputs)) 511 | (is (every? #(<= % n) @n-seen-active)))) 512 | 513 | (defn check-maximum-parallelism 514 | "Check that a pmap function doesn't exhibit excessive parallelism." 515 | [pmap-like] 516 | (doseq [[pool n shutdown?] 517 | [[(cp/threadpool 10) 10 true] 518 | [10 10 false] 519 | [:builtin Integer/MAX_VALUE false] 520 | [:serial 1 false]]] 521 | (try (check-maximum-parallelism-one-case 522 | pmap-like n pool) 523 | (finally (when shutdown? (.shutdown pool)))))) 524 | 525 | (defn check-*parallel*-disables 526 | "Check that binding cp/*parallel* can disable parallelism." 527 | [pmap-like] 528 | (binding [cp/*parallel* false] 529 | (cp/with-shutdown! [pool 10] 530 | (check-maximum-parallelism-one-case pmap-like 1 pool)))) 531 | 532 | (defn check-->threadpool 533 | "Check that a pmap function uses ->threadpool correctly, shutting down the 534 | threadpool and everything." 535 | [pmap-like lazy?] 536 | (is (thrown? IllegalArgumentException (pmap-like 1.5 identity [1]))) 537 | (is (thrown? IllegalArgumentException (pmap-like :parallel identity [1]))) 538 | (let [real->threadpool impl/->threadpool 539 | apool (atom nil) 540 | n 4] 541 | (with-redefs [impl/->threadpool (fn [arg] 542 | (let [[s? p] (real->threadpool arg)] 543 | (reset! apool p) 544 | [s? p]))] 545 | (doseq [[is-pool? should-be-shutdown? arg inputs should-we-shutdown?] 546 | [[true false (cp/threadpool n) (range (* 2 n)) true] 547 | [true true n (range (* 2 n)) false] 548 | [true false :builtin (range (* 2 n)) false] 549 | [false false :serial (range (* 2 n)) false]]] 550 | (let [inputs (range (* n 2)) 551 | ;; Use a real future to avoid blocking on :serial. 552 | results (future (pmap-like arg inc inputs))] 553 | ;; Check the results 554 | (is (= (map inc inputs) (sort @results))) 555 | (when should-be-shutdown? 556 | (is (true? (cp/shutdown? @apool)))) 557 | (when should-we-shutdown? 558 | (cp/shutdown! @apool)))) 559 | (testing "to shut down pool if exception thrown" 560 | (is (thrown? Exception 561 | (dorun (pmap-like 4 inc [1 2 nil])))) 562 | ;; Wait for the pool to shut down. 563 | (doseq [i (range 100) 564 | :while (not (cp/shutdown? @apool))] 565 | (Thread/sleep 1)) 566 | (is (true? (cp/shutdown? @apool)))) 567 | (testing "to shut down pool even without dorun" 568 | (when-not lazy? 569 | (let [p (promise)] 570 | (pmap-like 4 #(when (= % 9) (deliver p %)) (range 10)) 571 | (deref p) 572 | (Thread/sleep 1) 573 | (is (true? (cp/shutdown? @apool))))))))) 574 | 575 | ;; A simple object to call a function at finalize. 576 | (deftype Finalizer [f] 577 | Object 578 | (finalize [_] (f))) 579 | 580 | (defn check-holding-thread 581 | "Verify that this pmap function does not hold onto the head of the sequence, 582 | so if no one else uses the results, they're garbage collected. 583 | 584 | Note: This test assumes that calling (System/gc) will cause un-referenced 585 | objects to be finalized. So far, that seems to be true, though the JVM does 586 | not guarantee that as a contract." 587 | [pmap-fn] 588 | (let [a (atom nil) 589 | started (promise) 590 | finish (promise) 591 | task-runner (future 592 | (dorun 593 | (pmap-fn 1 deref 594 | (list 595 | ;; Have one task make a note when GC'd 596 | (delay 597 | (Finalizer. 598 | #(reset! a :finalized))) 599 | (delay 1) 600 | (delay 2) 601 | (delay (deliver started :started)) 602 | finish))))] 603 | ;; Let the tasks run 604 | @started 605 | ;; Trigger GC 606 | (System/gc) 607 | ;; Wait for GC to run 608 | (doseq [i (range 200) 609 | :while (not @a)] 610 | (Thread/sleep 1)) 611 | (dotimes [_ 2] 612 | ;; This test can be flaky because GC is so funky. Try GC'ing several 613 | ;; times. 614 | (System/gc) 615 | (Thread/sleep 10)) 616 | ;; Verify that the task was GC'd 617 | (is (= @a :finalized)) 618 | ;; Complete the map 619 | (deliver finish :done) 620 | @task-runner)) 621 | 622 | (defn check-read-ahead 623 | "Verify that this pmap function does not read too far ahead in the input 624 | sequence, as that can cause unnecessary use of RAM." 625 | [pmap-fn & [lazy?]] 626 | (let [a (atom nil) 627 | indicator #(do (reset! a %) a) 628 | finish (promise) 629 | started (promise) 630 | results (pmap-fn 4 deref 631 | (concat ;; indicate we've started 632 | (repeatedly 1 #(do (deliver started true) 633 | started)) 634 | ;; block the map 635 | (repeat 10 finish) 636 | ;; a long runway 637 | (map atom (range 100)) 638 | ;; an indicator for whether we've realized 639 | ;; past the runway 640 | (map indicator [:started])))] 641 | ;; When genuinely lazy, we must force the sequence to start tasks. 642 | (when lazy? (future (doall results))) 643 | ;; Let the tasks run 644 | @started 645 | ;; Let the threadpool run unchecked for a minute 646 | (Thread/sleep 100) 647 | ;; Verify that the indicator wasn't triggered 648 | (is (= nil @a)) 649 | ;; Complete the map 650 | (deliver finish :done) 651 | (dorun results))) 652 | 653 | (defn check-shuts-off 654 | [pmap-like] 655 | (cp/with-shutdown! [pool 2] 656 | (let [;; A lazy blocking trap 657 | blocker (map deref [(promise)]) 658 | started (atom []) 659 | f (fn [x] 660 | (Thread/sleep 1) 661 | (swap! started conj x) 662 | (when (= x 10) 663 | (throw (Exception. (str x)))) 664 | x) 665 | results (pmap-like pool f (concat (impl/unchunk (range 200)) blocker))] 666 | (Thread/sleep 300) 667 | ;; Surely we hit the exception. 668 | (is (thrown? Exception (dorun results))) 669 | ;; Surely we didn't start every task. 670 | (is (< 1 (count @started) 100)) 671 | ;; Surely something, but not everything, is returned, and we do not 672 | ;; block. 673 | (is (< 1 (count results) 100))))) 674 | 675 | (defn check-all 676 | "Run all checks on a pmap function. 677 | 678 | Arguments: 679 | fn-name - the function's name for better logging/output 680 | pmap-like - a function that works like pmap 681 | ordered? - true iff the pmap function returns results in the same order 682 | streaming? - true iff the pmap function works on streaming sequences 683 | lazy? - true iff the pmap function needs to be \"pumped\" by doall" 684 | [fn-name pmap-like ordered? streaming? lazy?] 685 | (testing (format "%s maps" fn-name) 686 | (is (= (range 1 11) ((if ordered? identity sort) 687 | (pmap-like 3 inc (range 10)))))) 688 | (testing (format "%s runs n things at once" fn-name) 689 | (check-parallel pmap-like ordered? lazy?)) 690 | (testing (format "%s emits exceptions correctly" fn-name) 691 | (check-fn-exception pmap-like)) 692 | (testing (format "%s emits non-Exception Throwables correctly" fn-name) 693 | (check-fn-throwable pmap-like)) 694 | (testing (format "%s handles input exceptions correctly" fn-name) 695 | (check-input-exception pmap-like)) 696 | (testing (format "%s runs n things at once" fn-name) 697 | (check-maximum-parallelism pmap-like)) 698 | (testing (format "%s uses ->threadpool correctly" fn-name) 699 | (check-->threadpool pmap-like lazy?)) 700 | (testing (format "%s is made serial by binding cp/*parallel* to false" 701 | fn-name) 702 | (check-*parallel*-disables pmap-like)) 703 | (testing (format "%s throws exceptions when tasks are sent to a shutdown pool" 704 | fn-name) 705 | (check-shutdown-exceptions pmap-like)) 706 | (when streaming? 707 | (testing (format "%s doesn't hold the head of streaming sequences" fn-name) 708 | (check-holding-thread pmap-like)) 709 | (testing (format "%s doesn't read ahead in the input sequence" fn-name) 710 | (check-read-ahead pmap-like lazy?)) 711 | (testing (format "%s can be chained in various threadpools" fn-name) 712 | (check-chaining pmap-like)) 713 | (testing (format "%s stops processing when an exception occurs" fn-name) 714 | (check-shuts-off pmap-like)) 715 | (testing (format "%s reads lazily" fn-name) 716 | (check-lazy-read pmap-like lazy?)))) 717 | 718 | 719 | (deftest test-daemon 720 | (let [daemon? (fn [& args] (.isDaemon (Thread/currentThread)))] 721 | (testing "threadpools are daemon by default" 722 | (cp/with-shutdown! [pool 3] 723 | (is (every? boolean 724 | (cp/pmap pool daemon? (range 100)))))) 725 | (testing "threadpools are daemon by default" 726 | (cp/with-shutdown! [pool (cp/threadpool 3)] 727 | (is (every? boolean 728 | (cp/pmap pool daemon? (range 100)))))) 729 | (testing "we can make non-daemon threadpools" 730 | (cp/with-shutdown! [pool (cp/threadpool 3 :daemon false)] 731 | (is (not-any? boolean 732 | (cp/pmap pool daemon? (range 100)))))))) 733 | 734 | (deftest test-future 735 | (testing "basic future test" 736 | (cp/with-shutdown! [pool 3] 737 | (let [a (atom false) 738 | f (cp/future 739 | pool 740 | ;; Body can contain multiple elements. 741 | (reset! a true) 742 | (range 10))] 743 | (is (= @f (range 10))) 744 | (is (true? @a))))) 745 | (testing "future threadpool args" 746 | (is (thrown? IllegalArgumentException (cp/future 3 (inc 1)))) 747 | (is (thrown? IllegalArgumentException (cp/future nil (inc 1)))) 748 | (is (= 2 @(cp/future :builtin (inc 1)))) 749 | (is (= 2 @(cp/future :serial (inc 1))))) 750 | (letfn [(pmap-like [pool work input] 751 | (map impl/deref-fixing-exceptions 752 | (doall 753 | (for [i input] 754 | (cp/future pool (work i))))))] 755 | (testing "future runs simultaneously" 756 | (check-parallel pmap-like true)) 757 | (testing "future throws exceptions okay" 758 | (check-fn-exception pmap-like)) 759 | (testing "future throws exceptions okay" 760 | (check-fn-throwable pmap-like)) 761 | (testing "future doesn't do too much parallelism" 762 | ;; We don't check the number or nil cases because future doesn't accept 763 | ;; those. 764 | (doseq [[pool n shutdown?] 765 | [[(cp/threadpool 10) 10 true] 766 | [:serial 1 false]]] 767 | (check-maximum-parallelism-one-case 768 | pmap-like n pool) 769 | (when shutdown? (.shutdown pool)))) 770 | (testing "Binding cp/*parallel* can disable parallelism in future" 771 | (check-*parallel*-disables pmap-like)) 772 | (testing "Future throws exceptions when tasks are sent to a shutdown pool" 773 | (check-shutdown-exceptions pmap-like)) 774 | (testing "Futures can be chained in various threadpools." 775 | (check-chaining pmap-like)))) 776 | 777 | (deftest test-completable-future 778 | (testing "basic completable-future test" 779 | (cp/with-shutdown! [pool 3] 780 | (let [a (atom false) 781 | f (cp/completable-future 782 | pool 783 | ;; Body can contain multiple elements. 784 | (reset! a true) 785 | (range 10))] 786 | (is (= @f (range 10))) 787 | (is (true? @a))))) 788 | (testing "bindings completable-future test" 789 | (cp/with-shutdown! [pool 3] 790 | (binding [*test-context* ::bound-value] 791 | (let [f (cp/completable-future 792 | pool 793 | ;; Body can contain multiple elements. 794 | *test-context*)] 795 | (is (= @f ::bound-value)))))) 796 | (testing "completable-future threadpool args" 797 | (is (thrown? IllegalArgumentException (cp/completable-future 3 (inc 1)))) 798 | (is (thrown? IllegalArgumentException (cp/completable-future nil (inc 1)))) 799 | (is (= 2 @(cp/completable-future :builtin (inc 1)))) 800 | (is (= 2 @(cp/completable-future :serial (inc 1))))) 801 | (letfn [(pmap-like [pool work input] 802 | (map impl/deref-fixing-exceptions 803 | (doall 804 | (for [i input] 805 | (cp/completable-future pool (work i))))))] 806 | (testing "completable-future runs simultaneously" 807 | (check-parallel pmap-like true)) 808 | (testing "completable-future throws exceptions okay" 809 | (check-fn-exception pmap-like)) 810 | (testing "completable-future throws exceptions okay" 811 | (check-fn-throwable pmap-like)) 812 | (testing "completable-future doesn't do too much parallelism" 813 | ;; We don't check the number or nil cases because future doesn't accept 814 | ;; those. 815 | (doseq [[pool n shutdown?] 816 | [[(cp/threadpool 10) 10 true] 817 | [:serial 1 false]]] 818 | (check-maximum-parallelism-one-case 819 | pmap-like n pool) 820 | (when shutdown? (.shutdown pool)))) 821 | (testing "Binding cp/*parallel* can disable parallelism in completable-future" 822 | (check-*parallel*-disables pmap-like)) 823 | (testing "completable-future throws exceptions when tasks are sent to a shutdown pool" 824 | (check-shutdown-exceptions pmap-like)) 825 | (testing "completable-future can be chained in various threadpools." 826 | (check-chaining pmap-like)))) 827 | 828 | (deftest test-pmap 829 | (check-all "pmap" cp/pmap true true false)) 830 | 831 | (deftest test-upmap 832 | (check-all "upmap" cp/upmap false true false)) 833 | 834 | (deftest test-pcalls 835 | (testing "basic pcalls test" 836 | (cp/with-shutdown! [pool 3] 837 | (is (= [1 2 3 4] 838 | (cp/pcalls pool #(inc 0) #(inc 1) #(inc 2) #(inc 3)))))) 839 | (letfn [(pmap-like [pool work input] 840 | (apply 841 | cp/pcalls 842 | pool 843 | (for [i input] 844 | #(work i))))] 845 | (check-all "pcalls" pmap-like true true false))) 846 | 847 | (deftest test-upcalls 848 | (testing "basic pcalls test" 849 | (cp/with-shutdown! [pool 3] 850 | (is (= [1 2 3 4] 851 | (sort (cp/upcalls pool #(inc 0) #(inc 1) #(inc 2) #(inc 3))))))) 852 | (letfn [(pmap-like [pool work input] 853 | (apply 854 | cp/upcalls 855 | pool 856 | (for [i input] 857 | #(work i))))] 858 | (check-all "upcalls" pmap-like false true false))) 859 | 860 | (deftest test-pvalues 861 | (testing "basic pvalues test" 862 | (cp/with-shutdown! [pool 3] 863 | (is (= [1 2 3 4] 864 | (cp/pvalues pool (inc 0) (inc 1) (inc 2) (inc 3)))))) 865 | (letfn [(pmap-like [pool work input] 866 | (let [worksym (gensym "work")] 867 | ((th/eval+ex-unwrap 868 | `(fn [pool# ~worksym] 869 | (cp/pvalues 870 | pool# 871 | ~@(for [i input] 872 | (list worksym i))))) 873 | pool work)))] 874 | (check-all "pvalues" pmap-like true false false))) 875 | 876 | (deftest test-upvalues 877 | (testing "basic upvalues test" 878 | (cp/with-shutdown! [pool 3] 879 | (is (= [1 2 3 4] 880 | (sort (cp/upvalues pool (inc 0) (inc 1) (inc 2) (inc 3))))))) 881 | (letfn [(pmap-like [pool work input] 882 | (let [worksym (gensym "work")] 883 | ((th/eval+ex-unwrap 884 | `(fn [pool# ~worksym] 885 | (cp/upvalues 886 | pool# 887 | ~@(for [i input] 888 | (list worksym i))))) 889 | pool work)))] 890 | (check-all "upvalues" pmap-like false false false))) 891 | 892 | (deftest test-pfor 893 | (testing "basic pfor test" 894 | (cp/with-shutdown! [pool 3] 895 | (is (= (range 1 11) 896 | (cp/pfor pool [i (range 10)] (inc i)))))) 897 | (letfn [(pmap-like [pool work input] 898 | (cp/pfor 899 | pool 900 | [i input] 901 | (work i)))] 902 | (check-all "pfor" pmap-like true true false))) 903 | 904 | (deftest test-upfor 905 | (testing "basic upfor test" 906 | (cp/with-shutdown! [pool 3] 907 | (is (= (range 1 11) 908 | (sort (cp/pfor pool [i (range 10)] (inc i))))))) 909 | (letfn [(pmap-like [pool work input] 910 | (cp/upfor 911 | pool 912 | [i input] 913 | (work i)))] 914 | (check-all "upfor" pmap-like false true false))) 915 | 916 | (defn test-parallel-do 917 | [name- do-fn] 918 | (testing (format "basic %s test" name-) 919 | (cp/with-shutdown! [pool 3] 920 | (let [processed (atom [])] 921 | (do-fn pool #(swap! processed conj %) (range 10)) 922 | (is (= (range 10) (sort @processed)))))) 923 | (testing (format "%s is parallel" name-) 924 | (let [started (atom []) 925 | processed (atom []) 926 | blocker (promise) 927 | complete (promise)] 928 | (future 929 | (do-fn 3 930 | (fn [i] (swap! started conj i) 931 | @blocker 932 | (swap! processed conj i)) 933 | (range 10)) 934 | (deliver complete true)) 935 | (Thread/sleep 10) 936 | ;; Now all threads should have been started 937 | (is (= (range 3) (sort @started))) 938 | (is (= [] @processed)) 939 | ;; pdsoeq blocked, right? 940 | (is (not (realized? complete))) 941 | ;; Ok, tell those threads to go. 942 | (deliver blocker true) 943 | (is @complete) 944 | (is (= (range 10) (sort @processed))))) 945 | ;; We don't run the whole battery of tests because (1) it's hard to make a 946 | ;; pmap-like function out of pdoseq, and (2) pdoseq is just (comp dorun 947 | ;; upmap). 948 | ) 949 | 950 | (deftest test-pdoseq 951 | (test-parallel-do 952 | "pdoseq" 953 | (fn [pool f s] 954 | (cp/pdoseq pool [i s] (f i))))) 955 | 956 | (deftest test-prun! 957 | (test-parallel-do 958 | "prun!" 959 | (fn [pool f s] (cp/prun! pool f s)))) 960 | 961 | (deftest test-default-pmap-buffer 962 | (testing "binding *default-pmap-buffer* has the desired effect" 963 | ;; *default-pmap-buffer* is only used if we can't get the pool size for 964 | ;; some reason. 965 | (with-redefs [impl/get-pool-size (constantly nil)] 966 | (let [start (promise) 967 | started (atom []) 968 | tasks (binding [cp/*default-pmap-buffer* 3] 969 | (cp/pmap 10 970 | (fn [i] 971 | (swap! started conj i) 972 | (deref start)) 973 | (range 10)))] 974 | (Thread/sleep 100) 975 | ;; As requested, only 3 items have been started 976 | (is (= (set @started) (set (range 3)))) 977 | (deliver start true) 978 | (dorun tasks))))) 979 | --------------------------------------------------------------------------------