diff --git a/src/rules_clojure/compile.clj b/src/rules_clojure/compile.clj index 3095599..22643bb 100644 --- a/src/rules_clojure/compile.clj +++ b/src/rules_clojure/compile.clj @@ -1,12 +1,12 @@ (ns rules-clojure.compile - (:refer-clojure :exclude [agent send await]) + (:refer-clojure :exclude [future]) (:require [clojure.java.io :as io] [clojure.string :as str] [rules-clojure.java.classpath :as cp] [rules-clojure.namespace.parse :as parse] [rules-clojure.fs :as fs] - [rules-clojure.util :refer [shasum]]) - (:import [java.util.concurrent CompletableFuture])) + [rules-clojure.util :refer [shasum debug]]) + (:import [java.util.concurrent CompletableFuture Executors])) (set! *warn-on-reflection* true) @@ -15,9 +15,6 @@ ;; dependencies. If we require a new clojure version, that requires ;; all users to upgrade so try to do that sparingly as well. -(defn debug [& args] - #_ (println (locking true (apply print-str args)))) - (defn deref! "throw `ex` if *f does not complete within timeout" [*f timeout ex] @@ -30,23 +27,25 @@ (defn src-resource-name [ns] (.substring ^String (#'clojure.core/root-resource ns) 1)) +(defn resource + [path] + (assert (instance? ClassLoader (.getContextClassLoader (Thread/currentThread)))) + (assert (= (.getContextClassLoader (Thread/currentThread)) + (.getClassLoader (class resource))) + (print-str "context classloader:" (.getContextClassLoader (Thread/currentThread)) + "#'resource loader:" (.getClassLoader (class resource)))) + (io/resource path)) + (defn src-resource "given a namespace symbol, return a tuple of [filename URL] where the backing .clj is located, or nil if it couldn't be found" [ns] {:pre [(symbol? ns)]} (->> [".clj" ".cljc"] - (map (fn [ext] + (some (fn [ext] (let [src-path (str (src-resource-name ns) ext) - src-resource (io/resource src-path)] - (when src-resource - [src-path src-resource])))) - (filter identity) - ;; ((fn [srcs] - ;; (when (> (count srcs) 1) - ;; (println "WARNING multiple copies of" ns "found:" srcs)) - ;; srcs)) - (first))) + src-resource (resource src-path)] + src-resource))))) (defn loaded? [ns] {:pre [(symbol? ns)]} @@ -62,6 +61,13 @@ (contains? (loaded-libs) ns)) +(defn loaded?-str [ns] + {:pre [(string? ns)] + :post [(boolean? %)]} + ;; called from the worker's class loader, so we can't pass a + ;; `symbol` through + (loaded? (symbol ns))) + ;; we can be asked to AOT a namespace after it is already loaded. If ;; the namespace contains protocols AND it's already loaded, that ;; would break all downstream users of the protocol. Also, we want to @@ -84,11 +90,8 @@ ;; the class files from temp directory. We fingerprint namespaces ;; using the SHA of the file contents - - -(defn ns->resource-name - "given a namespace symbol, return the name of the resource where it can -be found" +(defn ns->class-resource-name + "given a namespace symbol, return the name of classfile that will load it" [ns] (-> ns (munge) @@ -96,9 +99,15 @@ be found" (str "__init.class"))) (defn compiled? - "truthy if the namespace has AOT .class files on the classpath" [ns] - (io/resource (ns->resource-name ns))) + ;; We could use Class/forName, but that would attempt to load the + ;; class. Use resource instead to avoid the side effect + (resource (ns->class-resource-name ns))) + +(defn add-classpath! [dir] + (let [dir-f (fs/path->file dir)] + (assert (.exists dir-f) (print-str dir-f "not found")) + (.addURL (.getClassLoader (class add-classpath!)) (.toURL dir-f)))) ;; root directory for all compiles. Each compile will be a subdir of ;; this @@ -111,10 +120,10 @@ be found" "return the hash of the ns file contents" [ns] {:pre [(symbol? ns)]} - (assert (src-resource ns) (print-str "couldn't find src resource for" ns)) + (let [cl (.getContextClassLoader (Thread/currentThread))] + (assert (src-resource ns) (print-str "couldn't find src resource" (src-resource ns) " for" ns "with context classloader" cl (cp/classpath cl)))) (-> ns (src-resource) - second (io/input-stream) (.readAllBytes) (shasum))) @@ -193,14 +202,12 @@ be found" java.io.PushbackReader.)) (defn ns-deps- [ns] - (assert (src-resource ns) (print-str "couldn't find resource for" ns)) - (-> ns - src-resource - second - reader - parse/read-ns-decl - parse/deps-from-ns-decl - (disj ns))) + (some-> ns + src-resource + reader + parse/read-ns-decl + parse/deps-from-ns-decl + (disj ns))) (def ns-deps (memoize ns-deps-)) @@ -217,6 +224,7 @@ be found" :bound-require? (bound? #'clojure.core/require) :sha sha)) (assert (not (loaded? ns)) (print-str ns :compiled? (compiled? ns) :loaded? (loaded? ns) :sha sha)) + (add-classpath! classes-dir) (binding [*compile-path* (str classes-dir)] (compile ns) (assert (seq (fs/ls-r classes-dir)) (print-str "compile-: no .class files found in" classes-dir))))))) @@ -251,17 +259,17 @@ be found" (defn context-classloader-conveyor-fn [f] ;; context classloaders are not conveyed by default in futures, but we set it in rules-clojure.jar/compile! (let [cl (.getContextClassLoader (Thread/currentThread))] - (fn - ([] - (.setContextClassLoader (Thread/currentThread) cl) - (f))))) + (fn [] + (.setContextClassLoader (Thread/currentThread) cl) + (f)))) (defn binding-conveyor-fn [f] - ;; don't use clojure.core/binding-conveyor-fn, because that usees - ;; clone/reset ThreadBindings, rather than push/pop. We use push and - ;; pop because clone shares TBoxes, which store the threadId they - ;; came from, which breaks clojure.lang.Compiler when an in-progress - ;; compile attempts to Var/set! from a new thread + ;; don't use clojure.core/binding-conveyor-fn, because that uses + ;; clone/reset ThreadBindings; It allows the conveyed thread to read + ;; bindings, but not set! them (because it clones TBoxes and the + ;; cloned tbox stores the thread.id), which breaks + ;; clojure.lang.Compiler. Instead, use push/pop ThreadBindings + ;; which creates new tboxes and allows set! to work. (let [bindings (clojure.lang.Var/getThreadBindings)] (fn [] (try @@ -270,29 +278,41 @@ be found" (finally (clojure.lang.Var/popThreadBindings)))))) +(def ^:dynamic *executor* nil) + +;; The clojure RT won't be garbage collected if we use regular agents +;; or futures, because the thread's context classloader points at +;; clojure. Use our own pool that is not cached across compile jobs to +;; reduce strong references. + +(defn future- [exec f] + {:pre [exec]} + (.submit exec (context-classloader-conveyor-fn + (binding-conveyor-fn f)))) + +(defmacro future [& body] + `(future- *executor* (fn [] + ~@body))) + (defn ns-send [ns f] {:pre [(symbol? ns)] :post [(future? %)]} - - (let [f (context-classloader-conveyor-fn - (binding-conveyor-fn f))] - (-> ns-futures - (swap! update ns (fn [**f] - (or **f - (delay (future - (try - (f) - (catch Throwable t - (throw (ex-info (print-str "in ns-send" ns :parallel? *parallel*) {} t))))))))) - (get ns) - (deref)))) + (-> ns-futures + (swap! update ns (fn [**f] + (or **f + (delay (future + (try + (f) + (catch Throwable t + (throw (ex-info (print-str "in ns-send" ns :parallel? *parallel*) {} t))))))))) + (get ns) + (deref))) (defn ns-send-sync [ns f] {:pre [(symbol? ns)] :post [(future? %)]} - (debug "ns-send-sync" ns) (-> ns-futures (swap! update ns (fn [**f] (or **f @@ -357,6 +377,11 @@ be found" (debug "compile parent cycle" parent :-> ns) (CompletableFuture/completedFuture true))))) +(defn cached? + "True if this namespace has been compiled by this process, and the class files are cached" + [ns] + (boolean (get-cache-dir (ns-sha ns)))) + (defn pcopy [dest-dir ns] (deref! (pcompile nil ns) 120000 (ex-info (print-str "pcopy timeout waiting for" ns) {:dest-dir dest-dir :ns ns})) @@ -364,8 +389,9 @@ be found" (let [sha (ns-sha ns) cache-dir (get-cache-dir sha)] (assert cache-dir (print-str ns "no cache dir" - :loaded? (loaded? ns) :compiled? (compiled? ns) + :loaded? (loaded? ns) + :cached? (cached? ns) :dest dest-dir :actual-classpath (cp/classpath))) (assert (seq (fs/ls-r cache-dir)) (print-str "pcopy: no .class files found in" cache-dir)) @@ -412,7 +438,7 @@ be found" (debug "WARNING no ns found for" p)) true)]} (->> [".clj" ".cljc"] (keep (fn [ext] - (io/resource (load-path (str p ext))))) + (resource (load-path (str p ext))))) (keep (fn [r] (with-open [rdr (java.io.PushbackReader. (io/reader r))] (let [ns (parse/name-from-ns-decl (parse/read-ns-decl rdr))] @@ -421,13 +447,11 @@ be found" (defn spy-load [& paths] (let [ns-sym (symbol (str *ns*))] - (debug "spy-load" paths) (->> paths (mapv (fn [p] (if-let [dep-ns (load->ns p)] @(pcompile ns-sym dep-ns) - (real-load p))))) - (debug "spy-load" ns-sym paths "done"))) + (real-load p))))))) (defn spy-require [& args] ;; the ns block will add `ns` to clojure.core/*loaded-libs*, so it won't be eval'd twice. @@ -441,7 +465,6 @@ be found" (defn spy-load-one [lib need-ns require] - (debug "spy-load-one" lib) (spy-load (root-resource lib)) (throw-if (and need-ns (not (find-ns lib))) "namespace '%s' not found after loading '%s'" @@ -453,7 +476,6 @@ be found" ;; we need this because dtype-next calls load-lib directly rather than `load` or `require` ಠ_ಠ (defn spy-load-lib [prefix lib & options] - (debug "spy-load-lib" lib) (throw-if (and prefix (pos? (.indexOf (name lib) (int \.)))) "Found lib name '%s' containing period with prefix '%s'. lib names inside prefix lists must not contain periods" (name lib) prefix) @@ -474,10 +496,8 @@ be found" (binding [clojure.core/*loading-verbosely* (or @#'clojure.core/*loading-verbosely* verbose)] (if load (try - (debug "spy-load-lib actually loading" load lib) (load lib need-ns require) (catch Exception e - (debug "spy-load-lib while loading" lib e) (when undefined-on-entry (remove-ns lib)) (throw e))) @@ -528,13 +548,15 @@ be found" (defn compile! [classes-dir aot-nses out] {:pre [(string? classes-dir) (every? string? aot-nses)]} - (binding [*out* out] - (when (seq aot-nses) - (debug "compile!" (seq aot-nses))) - (with-spy - (let [aot-nses (map symbol aot-nses)] - (doseq [n aot-nses] - (add-ns n) - (pcompile nil n)) - (doseq [n aot-nses] - (pcopy (str classes-dir "/") n)))))) + (with-open [executor (Executors/newCachedThreadPool)] + (binding [*out* out + *executor* executor] + ;; make sure this is loaded before any compile so it doesn't end up in user jars + @(pcompile nil 'clojure.core.specs.alpha) + (with-spy + (let [aot-nses (map symbol aot-nses)] + (doseq [n aot-nses] + (add-ns n) + (pcompile nil n)) + (doseq [n aot-nses] + (pcopy (str classes-dir "/") n))))))) diff --git a/src/rules_clojure/gen_build.clj b/src/rules_clojure/gen_build.clj index 49a3aaa..431a965 100644 --- a/src/rules_clojure/gen_build.clj +++ b/src/rules_clojure/gen_build.clj @@ -258,7 +258,7 @@ class-file (str (.substring ^String root-resource 1) "__init.class")] (some #(= class-file %) (classpath-files path)))) -(def special-namespaces '#{clojure.core.specs.alpha}) +(def special-namespaces '#{}) (defn should-compile-namespace? [deps-bazel path ns] (and (not (contains? special-namespaces ns)) diff --git a/src/rules_clojure/jar.clj b/src/rules_clojure/jar.clj index d35914b..cd44b28 100644 --- a/src/rules_clojure/jar.clj +++ b/src/rules_clojure/jar.clj @@ -62,12 +62,14 @@ (s/def ::compile (s/keys :req-un [::aot-nses ::classes-dir ::output-jar] :opt-un [::resources ::src-dir])) (defn compile! [cl {:keys [aot-nses classes-dir] :as args}] - (util/shim-eval cl `(require 'rules-clojure.compile)) + (util/shim-require cl 'rules-clojure.compile) + (let [aot-arr (into-array String (map str aot-nses))] (try (util/shim-invoke cl "rules-clojure.compile" "compile!" classes-dir aot-arr *out*) (catch Throwable t - (throw (ex-info "while compiling" {:args args} t)))))) + (throw (ex-info "while compiling" {:args args + :classloader cl} t)))))) (defn create-jar [{:keys [src-dir classes-dir output-jar resources aot-nses] :as args}] (s/assert ::compile args) diff --git a/src/rules_clojure/namespace/find.clj b/src/rules_clojure/namespace/find.clj index 26b7155..6dc43f2 100644 --- a/src/rules_clojure/namespace/find.clj +++ b/src/rules_clojure/namespace/find.clj @@ -99,9 +99,7 @@ both defined in clojure.tools.namespace.find." {:added "0.3.0"} [^JarFile jar-file platform] - {:pre [(do (when-not (jarfile? jar-file) - (println "filenames-in-jar:" jar-file (class jar-file))) true) - (jarfile? jar-file) platform]} + {:pre [(jarfile? jar-file) platform]} (let [{:keys [extensions]} platform] (->> jar-file (.entries) diff --git a/src/rules_clojure/persistentClassLoader.clj b/src/rules_clojure/persistentClassLoader.clj index f3b9e0b..7ab9a97 100644 --- a/src/rules_clojure/persistentClassLoader.clj +++ b/src/rules_clojure/persistentClassLoader.clj @@ -6,9 +6,8 @@ ["[Ljava.net.URL;"] ["[Ljava.net.URL;"]} :extends java.net.URLClassLoader :exposes-methods {findClass parentFindClass - getResource parentGetResource}) - (:import [java.net URL URLClassLoader] - [java.lang ClassLoader])) + findLoadedClass parentFindLoadedClass + getResource parentGetResource})) ;; Context @@ -57,7 +56,6 @@ (set! *warn-on-reflection* true) (defn clojure-find-class [this name] - {:post [(do (util/print-err "found class in-mem" %) true)]} (when-let [rt-class ^Class (.parentFindClass this "clojure.lang.RT")] (let [baseloader-method (.getDeclaredMethod rt-class "baseLoader" (into-array Class [])) loader (.invoke baseloader-method rt-class (into-array Object []))] @@ -68,5 +66,8 @@ [this name] (locking this (or - (.parentFindClass this name) - (clojure-find-class this name)))) + (.parentFindClass this name) + (clojure-find-class this name)))) + +(defn -findLoadedClass [this name] + (.parentFindLoadedClass this name)) diff --git a/src/rules_clojure/persistent_classloader.clj b/src/rules_clojure/persistent_classloader.clj index 299da96..d7dc608 100644 --- a/src/rules_clojure/persistent_classloader.clj +++ b/src/rules_clojure/persistent_classloader.clj @@ -8,7 +8,7 @@ [rules-clojure.fs :as fs] [rules-clojure.namespace.find :as find] [rules-clojure.namespace.parse :as parse] - [rules-clojure.util :as util]) + [rules-clojure.util :as util :refer [debug]]) (:import java.net.URL rules_clojure.persistentClassLoader [java.util.jar JarFile JarEntry] @@ -29,32 +29,41 @@ ;; builds to be self-contained and reproducible. ;; To avoid jarhell, a classpath should have at most one path (a jar -;; or directory), containing any given namespace. Two classpaths are -;; _compatible_ if for every namespace in A, it is either present in B -;; with the same path and same shasum/bazelsum, or not present. +;; or directory), containing any given namespace or .class. Two +;; classpaths are _compatible_ if for every namespace/class in A, the +;; file is either present in B with the same path and same +;; shasum/bazelsum, or not present. ;; If we have a cached classloader `A` and a request arrives with ;; classpath B, aot-ns of `bar` and an input file of `src/bar.clj`. We ;; can reuse `A` to process `B` IIF: -;; - every namespace in B is located at the same path in A with the -;; - same bazelsum, or not present +;; - the two classloaders are compatible +;; - `bar` is not AOT'd in `A` ;; To keep the cache warm, we pick the largest compatible classpath -;; (largest defined as the one with the most namespaces). We use -;; SoftReferences to allow unused classloaders to GC +;; (largest defined as the one containing the most +;; namespaces/classes). We use SoftReferences to allow unused +;; classloaders to GC ;; Also note that directories (and files within) are mutable over time ;; as requests arrive. To avoid mutation problems, only check for ;; compatibility when appending to a classpath. +(defn soft-ref? [x] + (instance? SoftReference x)) + +(defn classloader? [x] + (instance? ClassLoader x)) + (defn new-classloader- ([cp] (new-classloader- cp (.getParent (ClassLoader/getSystemClassLoader)))) ([cp parent] {:pre [(every? string? cp) - (instance? ClassLoader parent)]} + (classloader? parent)]} + (debug "new classloader" cp) (persistentClassLoader. (into-array URL (map #(.toURL (io/file %)) cp)) parent))) @@ -95,34 +104,34 @@ long as all jar sets are compatible with each other" (s/def ::input-map (s/map-of string? string?)) -(defn compatible-maps? - "Do all intersecting keys have the same values in both m1 and m2?" - [m1 m2] - (not-any? - (fn [[k v]] (and (contains? m1 k) (not= (m1 k) v))) m2)) +(defn shas? [m] + (and (map? m) + (every? (fn [[k v]] + (and (or (string? k) (symbol? k)) + (string? v) + (= 88 (count v)))) m))) -(defn incompatible-maps - "When `compatible-maps?` returns true, return the conflicting values" +(defn conflicting-keys + "given two maps, return a seq of conflicts (same key in both maps with different values)" [m1 m2] - (reduce (fn [conflicting [k v2]] - (let [v1 (get m1 k)] - (if (and v1 (not= v2 v1)) - (assoc conflicting k [v1 v2]) - conflicting))) {} m2)) + (let [[smaller larger] (if (< (count m1) (count m2)) + [m1 m2] + [m2 m1])] + (->> smaller + (keep (fn [[k1 v1]] + (when-let [[_k2 v2] (find larger k1)] + (when (not= v1 v2) + [k1 [v1 v2]]))))))) -(s/def ::input-map (s/map-of string? string?)) +(defn compatible-maps? + "Do all intersecting keys have the same values in both m1 and m2?" + [m1 m2] + (not (seq (conflicting-keys m1 m2)))) (def bazelsum (memoize fs/bazelsum)) (def clj-extensions #{"cljc" "clj"}) -(defn shas? [m] - (and (map? m) - (every? (fn [[k v]] - (and (symbol? k) - (string? v) - (= 88 (count v)))) m))) - (defn dir-shas- [dir] {:pre [(string? dir)] :post [(shas? %)]} @@ -141,142 +150,212 @@ long as all jar sets are compatible with each other" (def dir-shas (memoize dir-shas-)) (defn jar-shas- - [jar] - {:pre [(string? jar)] + ;; take bazel-hash for cache-busting + [jar hash] + {:pre [(string? jar) + (string? hash)] :post [(shas? %)]} - (let [jarfile (JarFile. jar)] - (-> jarfile - (find/sources-in-jar find/clj) - (->> (pmap (fn [^JarEntry entry] - (when-let [name (parse/name-from-ns-decl (find/read-ns-decl-from-jarfile-entry jarfile entry find/clj))] - [name - (-> (.getInputStream jarfile entry) - InputStream/.readAllBytes - fs/bazel-hash)]))) - (into {}))))) + (when (.exists (io/file jar)) + (let [jarfile (JarFile. jar)] + (->> jarfile + (.entries) + (enumeration-seq) + (filter (fn [entry] + (let [name (.getRealName entry)] + (and (not (.isDirectory ^JarEntry entry)) + ;; many unrelated jars have conflicting META-INF + (not (re-find #"^META-INF" name)) + ;; ignore single-segment files such as project.clj, deps.edn, data_readers.clj + (re-find #"/" name) + ;; ignore clj anonymous expressions + (not (re-find #"\$" name)) + (re-find #"(.clj|.cljc|.class)$" name))))) + (pmap (fn [^JarEntry entry] + [(.getRealName entry) + (-> (.getInputStream jarfile entry) + InputStream/.readAllBytes + fs/bazel-hash)])) + (into {}))))) (def jar-shas (memoize jar-shas-)) (defn shas "Given a single classpath entry (jar or directory), return (map-of ns hash)" - [path] + [path hash] {:pre [(do (when-not (string? path) - (println "pcl/shas:" path)) true) - (string? path)]} + (debug "pcl/shas:" path)) true) + (string? path)] + :post [(shas? %)]} (if (.endsWith ^String path ".jar") - (jar-shas path) + (jar-shas path hash) (dir-shas path))) -(defn classpath-shas - "Given a vector of classpath jars and dirs, return a map of `{container -{file sha}}`, where container is a jar or directory, and file is a -clojure source file in the container" - [classpath] - (doseq [p classpath] - (assert (string? p) p)) - (->> classpath - (map shas) - (apply merge))) - (s/def ::classpath (s/coll-of string? :kind sequential?)) -(defn ns->resource-name - "given a namespace symbol, return the name of the resource where it can -be found" +(defn ns->class-resource-name + "given a namespace symbol, return the name of classfile that will load it" [ns] (-> ns (munge) (str/replace #"\." "/") (str "__init.class"))) -(defn aot? [^ClassLoader cl ns] - {:pre [(string? ns)]} - (.getResource cl (ns->resource-name ns))) - -(defn compatible-shas? - [a b] - (let [new-paths (set/difference (set b) (set a)) - a-shas (classpath-shas a)] - (assert (seq a-shas)) - (every? (fn [path] - (let [b-shas (shas path) - compatible (compatible-maps? a-shas b-shas)] - compatible)) new-paths))) +(defn compiled? + "Is ns compiled in classloader?" + [ns cl] + ;; We could use Class/forName, but that would attempt to load the + ;; class. Use resource instead to avoid the side effect + (io/resource (ns->class-resource-name ns) cl)) + +(defn in-jar? + "given a resource, return true if it loads from a jar" + [^URL r] + (= "jar" (.getProtocol r))) + +(defn compiled-in-jar? + "is the ns compiled, and the class is loaded from a jar" + [ns cl] + {:pre [(symbol? ns)]} + (if-let [r (compiled? ns cl)] + (in-jar? r) + false)) + +(def println-memo (memoize (fn [& args] + (apply println args)))) + +(defn explode-inputs + "Given an input-map containing .clj files and .jar files, list the contents of jars and `merge` in .jar clj and class files" + [input-map] + {:post [(if (some (fn [[k v]] + (.endsWith k ".jar")) input-map) + (> (count %) (count input-map)) + (= % input-map))]} + (->> input-map + (mapcat (fn [[path hash]] + (if (.endsWith ^String path ".jar") + (concat [[path hash]] (jar-shas path hash)) + [[path hash]]))) + (into {}))) (s/def ::classpaths (s/coll-of ::classpath :kind sequential?)) +(defn ns-loaded? [cl ns] + (util/shim-require cl 'rules-clojure.compile) + (util/shim-invoke cl "rules-clojure.compile" "loaded?-str" (str ns))) + (defn get-best-classpath "Given a seq of existing cached classloaders, return the best match, or nil if none are compatible" - [cached desired aot-nses] - (->> cached - (filter (fn [[cp _cl]] - (compatible-shas? cp desired))) - (filter (fn [[_cp cl]] - (every? (fn [ns] - (not (aot? cl ns))) aot-nses))) - ((fn [cps] - (sort-by (fn [[cp _cl]] - (count (classpath-shas cp))) cps))) - (last))) + [cached input-map aot-nses] + (let [desired-in (explode-inputs input-map) + cache (->> cached + (filter (fn [[in cache]] + (compatible-maps? in desired-in))) + (remove (fn [[in cache]] + ;; compiled in a directory is a temp dir + ;; that the rules-clojure.compile/cache + ;; can reuse. Compiled in a jar is an + ;; artifact that is incompatible or bazel + ;; wouldn't have asked us to compile + (some (fn [ns] + {:post [(do (when % + (println-memo "not reusing classloader because" ns "already compiled")) true)]} + (compiled-in-jar? (symbol ns) (:classloader cache))) aot-nses))) + (sort-by (comp count first)) + (last))] + (when (not cache) + (->> cached + (mapv (fn [[in _cl]] + (println-memo "conflict" (first (conflicting-keys in desired-in))))))) + cache)) (defn deref-cache [caches] {:pre [(map? caches) - (every? (fn [[k v]] - (instance? SoftReference v)) caches)] + (every? (fn [[_k v]] + (soft-ref? (:classloader v))) caches)] :post [(map? %) - (every? (fn [[k v]] - (instance? ClassLoader v)) %) + (every? (fn [[_k v]] + (classloader? (:classloader v))) %) (do (when (< (count %) (count caches)) - (util/print-err "pcl:deref-cache GC'd" (- (count caches) (count %)))) true)]} + (debug "pcl:deref-cache GC'd" (- (count caches) (count %)))) true)]} (->> caches - (map (fn [[cp ref]] - [cp (.get ref)])) + (map (fn [[cp cache]] + [cp (update cache :classloader SoftReference/.get)])) (filter (fn [[_cp cl]] - cl)) + (:classloader cl))) (into {}))) (defn soft-ref-cache [caches] {:pre [(map? caches) - (every? (fn [[k v]] - (instance? ClassLoader v)) caches)] + (every? (fn [[_k v]] + (classloader? (:classloader v))) caches)] :post [(map? %) - (every? (fn [[k v]] - (instance? SoftReference v)) %)]} + (every? (fn [[_k v]] + (soft-ref? (:classloader v))) %)]} (->> caches - (map (fn [[cp cl]] - [cp (SoftReference. cl)])) + (map (fn [[cp cache]] + [cp (update cache :classloader SoftReference/new)])) (into {}))) +(defn keep-n + "Keep at most N caches" + [caches n] + (let [caches (sort-by (fn [[k _]] (count k)) caches) + [expire keep] (split-at (- (count caches) n) caches)] + (doseq [[_cp cache] expire] + (util/shim-invoke (:classloader cache) "clojure.core" "shutdown-agents")) + (into {} keep))) -(defn ensure-classloader [*caches desired-cp aot-nses] +(defn ensure-classloader [*caches desired-cp input-map aot-nses] (let [*cl (promise)] (locking *caches (swap! *caches (fn [caches] ;; sanity check to prevent unbounded caching ;; {:post [(< (count %) 5)]} (let [caches (deref-cache caches) - _ (assert (map? caches)) - [best-cp best-cl] (get-best-classpath caches desired-cp aot-nses)] + [in cache] (get-best-classpath caches input-map aot-nses)] (soft-ref-cache - (if best-cl - (let [new-paths (set/difference (set desired-cp) (set best-cp)) - new-cp (concat best-cp new-paths)] + (if cache + (let [desired-cp (set desired-cp) + cache-cp (:classpath cache) + new-paths (set/difference desired-cp cache-cp) + new-in (merge in (explode-inputs input-map)) + cl (:classloader cache)] (doseq [p new-paths] - (add-url best-cl p)) - (deliver *cl best-cl) + (add-url cl p)) + (deliver *cl cl) (-> caches - (dissoc best-cp) - (assoc new-cp best-cl))) - (let [cl (new-classloader- desired-cp)] + (dissoc in) + (assoc new-in cache) + (keep-n 5))) + (let [cl (new-classloader- desired-cp) + in (explode-inputs input-map)] + ;; imagine + ;; (shim-require 'rules-clojure.compile) + ;; (shim-eval 'compile/compile!) + + ;; require loads forms sequentially, but updates + ;; clojure.core/*loaded-libs* at the end of the ns block (not the end of the file!). + + ;; If two compile requests in two + ;; threads come in at the same time, one + ;; starts the require and evaluating, + ;; the second one will see *loaded-libs* + ;; does contain rules-clojure.compile, + ;; but the + ;; `rules-clojure.compile/compile!` var + ;; hasn't been loaded yet. Load it here + ;; so we don't have to lock later. + (util/shim-require cl 'rules-clojure.compile) (deliver *cl cl) - (assoc caches desired-cp cl)))))))) + (assoc caches in {:classpath desired-cp + :classloader cl})))))))) @*cl)) (defn caching "Cache and reuse the classloader, IIF if the inputs are compatible" [] - ;; (atom-of (map-of classpath (soft-ref classloader))). + ;; (atom-of (map-of input-map (soft-ref classloader))). (let [*caches (atom {})] (reify ClassLoaderFactory - (build [_ {:keys [classpath aot-nses]}] - (ensure-classloader *caches classpath aot-nses))))) + (build [_ {:keys [classpath input-map aot-nses]}] + (ensure-classloader *caches classpath input-map aot-nses))))) diff --git a/src/rules_clojure/util.clj b/src/rules_clojure/util.clj index 598cd5d..a188acf 100644 --- a/src/rules_clojure/util.clj +++ b/src/rules_clojure/util.clj @@ -17,6 +17,10 @@ (locking true (println str))))) +(defn debug [& args] + (println (locking true (apply print-str args))) + true) + (defmacro with-context-classloader [cl & body] `(let [old-cl# (.getContextClassLoader (Thread/currentThread))] (try @@ -53,9 +57,6 @@ v (shim-var cl ns name)] (.invoke m v (into-array Object []))))) -(defn shim-require [cl ns] - (shim-invoke cl "clojure.core" "require" ns)) - (defn shim-eval [^ClassLoader cl s] (with-context-classloader cl (let [script (try @@ -67,26 +68,8 @@ (catch Exception e (throw (ex-info "while evaling" {:script s} e))))))) -(defn invoker-1 - "given a classloader and a function name, return a function that -invokes f in the classloader, efficiently" - [^ClassLoader classloader ns name] - (shim-eval classloader (str `(require (symbol ~ns)))) - (let [loaded-var (shim-var classloader ns name) - ifn (.loadClass classloader "clojure.lang.IFn") - invoke-method (.getDeclaredMethod ifn "invoke" (into-array Class [Object]))] - (assert invoke-method) - (fn [arg] - (.invoke invoke-method loaded-var (into-array Object [arg]))))) - -(defn bind-compiler-loader [^ClassLoader cl] - (with-context-classloader cl - (let [compiler (.loadClass cl "clojure.lang.Compiler") - var (.loadClass cl "clojure.lang.Var") - loader-f (.getDeclaredField compiler "LOADER") - loader (.get loader-f compiler) - bind-root-m (.getDeclaredMethod var "bindRoot" (into-array Class [Object]))] - (.invoke bind-root-m loader (into-array Object [cl]))))) +(defn shim-require [cl ns] + (shim-eval cl `(require (quote ~ns)))) (defn system-classpath "Returns a sequence of File paths from the 'java.class.path' system diff --git a/src/rules_clojure/worker.clj b/src/rules_clojure/worker.clj index 30dc826..79c5e25 100644 --- a/src/rules_clojure/worker.clj +++ b/src/rules_clojure/worker.clj @@ -141,14 +141,14 @@ (print-err "no request, exiting") (shutdown-agents) (when @*error - (println @*error)) + (util/print-err @*error)) :exit))))) (defn set-uncaught-exception-handler! [] (Thread/setDefaultUncaughtExceptionHandler (reify Thread$UncaughtExceptionHandler (uncaughtException [_ _ ex] - (println ex "uncaught exception"))))) + (util/print-err ex "uncaught exception"))))) (defn -main [& args] (set-uncaught-exception-handler!) diff --git a/test/rules_clojure/persistent_classloader_test.clj b/test/rules_clojure/persistent_classloader_test.clj index b0d9886..833f64d 100644 --- a/test/rules_clojure/persistent_classloader_test.clj +++ b/test/rules_clojure/persistent_classloader_test.clj @@ -46,7 +46,9 @@ (deftest jar-shas (let [shas (pcl/jar-shas (first (test-utils/runfiles-jars "CLOJURE_JARS")))] (is (seq shas)) - (is (pcl/shas? shas)))) + (is (pcl/shas? shas)) + (is (some (fn [[k _hash]] + (re-find #".class$" (str k))) shas)))) (deftest compatibility (let [cp-new (test-utils/runfiles-jars "CLOJURE_JARS")