diff --git a/process b/process index bd203b79..2055e047 160000 --- a/process +++ b/process @@ -1 +1 @@ -Subproject commit bd203b79a21b6155b61b4b4efda5a497dec2567d +Subproject commit 2055e0470a0ae6faedd15d5a3c8da4d82a6f4641 diff --git a/src/babashka/impl/clojure/spec/alpha.clj b/src/babashka/impl/clojure/spec/alpha.clj index 2df93012..ac36421f 100644 --- a/src/babashka/impl/clojure/spec/alpha.clj +++ b/src/babashka/impl/clojure/spec/alpha.clj @@ -901,7 +901,7 @@ rgen (fn [k s] [k (gensub s overrides (conj path k) rmap k)]) ogen (fn [k s] (when-not (recur-limit? rmap id path k) - [k (gen/delay (gensub s overrides (conj path k) rmap k))])) + [k (gen/delay-internal (gensub s overrides (conj path k) rmap k))])) reqs (map rgen req-keys req-specs) opts (remove nil? (map ogen opt-keys opt-specs))] (when (every? identity (concat (map second reqs) (map second opts))) @@ -1004,7 +1004,7 @@ (let [p (f nil)] (let [rmap (inck rmap id)] (when-not (recur-limit? rmap id path k) - (gen/delay + (gen/delay-internal (gen/fmap #(tag % k) (gensub p overrides (conj path k) rmap (list 'method form k)))))))) @@ -1141,7 +1141,7 @@ (let [gen (fn [k p f] (let [rmap (inck rmap id)] (when-not (recur-limit? rmap id path k) - (gen/delay + (gen/delay-internal (gensub p overrides (conj path k) rmap f))))) gs (remove nil? (map gen keys preds forms))] (when-not (empty? gs) @@ -1648,7 +1648,7 @@ ;;(prn {:k k :path path :rmap rmap :op op :id id}) (when-not (c/and rmap id k (recur-limit? rmap id path k)) (if id - (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) + (gen/delay-internal (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] (c/or (when-let [gfn (c/or (get overrides (spec-name origp)) @@ -1878,8 +1878,8 @@ (if gfn (gfn) (gen/frequency - [[1 (gen/delay (gen/return nil))] - [9 (gen/delay (gensub pred overrides (conj path :clojure.spec.alpha/pred) rmap form))]]))) + [[1 (gen/delay-internal (gen/return nil))] + [9 (gen/delay-internal (gensub pred overrides (conj path :clojure.spec.alpha/pred) rmap form))]]))) (with-gen* [_ gfn] (nilable-impl form pred gfn)) (describe* [_] `(clojure.spec.alpha/nilable ~(res form)))))) diff --git a/src/babashka/impl/clojure/spec/gen/alpha.clj b/src/babashka/impl/clojure/spec/gen/alpha.clj index 19d868f3..70cc7220 100755 --- a/src/babashka/impl/clojure/spec/gen/alpha.clj +++ b/src/babashka/impl/clojure/spec/gen/alpha.clj @@ -23,12 +23,10 @@ [& args] (apply @quick-check-ref args)) -(def ^:private for-all*-ref - (c/delay clojure.test.check.properties/for-all*)) (defn for-all* "Dynamically loaded clojure.test.check.properties/for-all*." [& args] - (apply @for-all*-ref args)) + (apply clojure.test.check.properties/for-all* args)) (let [g? clojure.test.check.generators/generator? g clojure.test.check.generators/generate @@ -57,6 +55,13 @@ [& body] `(clojure.spec.gen.alpha/delay-impl (c/delay ~@body))) +(defmacro delay-internal + "given body that returns a generator, returns a + generator that delegates to that, but delays + creation until used." + [& body] + `(babashka.impl.clojure.spec.gen.alpha/delay-impl (c/delay ~@body))) + (defmacro ^:skip-wiki lazy-combinator "Implementation macro, do not call directly." [s] diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 6b19dc77..58e40903 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -61,7 +61,8 @@ [sci.impl.namespaces :as sci-namespaces] [sci.impl.types :as sci-types] [sci.impl.unrestrict :refer [*unrestricted*]] - [sci.impl.vars :as vars]) + [sci.impl.vars :as vars] + [clojure.stacktrace :as stacktrace]) (:gen-class)) (def windows? @@ -1127,4 +1128,26 @@ Use bb run --help to show this help output. ;;;; Scratch +(defn where-am-i [depth] + (let [ks [:fileName :lineNumber :className]] + (clojure.pprint/print-table + ks + (map (comp #(select-keys % ks) bean) + (take depth (.getStackTrace (Thread/currentThread))))))) + +(alter-var-root #'require + (fn [old-req] + (fn [& args] + (prn :require-args args) + (where-am-i 100) + #_(System/exit 0) + #_(apply old-req args)))) + +(alter-var-root #'requiring-resolve + (fn [old-req] + (fn [& args] + (prn :requiring-resolve-args args) + (stacktrace/print-stack-trace (-> (Thread/currentThread) #_(.getStackTrace))) + (apply old-req args)))) + (comment)