diff --git a/src/sci/impl/multimethods.cljc b/src/sci/impl/multimethods.cljc index 6e5b1a7f..40f7824a 100644 --- a/src/sci/impl/multimethods.cljc +++ b/src/sci/impl/multimethods.cljc @@ -1,7 +1,8 @@ (ns sci.impl.multimethods {:no-doc true} (:refer-clojure :exclude [defmulti defmethod]) - (:require [sci.impl.hierarchies :refer [global-hierarchy]])) + (:require [sci.impl.hierarchies :refer [global-hierarchy]] + [clojure.string :as str])) #?(:clj (set! *warn-on-reflection* true)) @@ -103,13 +104,22 @@ "Creates and installs a new method of multimethod associated with dispatch-value. " [_x _y multifn dispatch-val & fn-tail] #?(:clj - ;; TODO, we could do a better job resolving print-method if it - ;; was :excluded or full qualified - (if (= 'print-method multifn) - `(let [v# ~dispatch-val - m# (meta v#)] - (if (:sci.impl/record m#) - (alter-var-root (:sci.impl/record-var m#) vary-meta assoc :sci.impl/print-method (fn ~@fn-tail)) - (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) - `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail))) + (let [multifn-str (str multifn)] + (if (or (str/ends-with? multifn-str "print-method") + (str/ends-with? multifn-str "simple-dispatch")) + `(let [v# ~dispatch-val + m# (meta v#) + mf# (resolve '~multifn)] + (if (:sci.impl/record m#) + (cond + (= (resolve 'clojure.pprint/simple-dispatch) mf#) + (do + (alter-var-root (:sci.impl/record-var m#) + vary-meta assoc :sci.impl/pprint-simple-dispatch (fn ~@fn-tail))) + (= (resolve 'clojure.core/print-method) mf#) + (alter-var-root (:sci.impl/record-var m#) + vary-meta assoc :sci.impl/print-method (fn ~@fn-tail)) + :else (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail))) + (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) + `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) :cljs `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) diff --git a/src/sci/pprint.cljc b/src/sci/pprint.cljc new file mode 100644 index 00000000..821de994 --- /dev/null +++ b/src/sci/pprint.cljc @@ -0,0 +1,22 @@ +(ns sci.pprint + "Extensible pprinting for built-in SCI types." + (:require [clojure.pprint :as pprint] + [sci.impl.records])) + +(defprotocol SciPrettyPrint + (-sci-pprint-simple-dispatch [obj])) + +(extend-protocol SciPrettyPrint + sci.impl.records.SciRecord + (-sci-pprint-simple-dispatch [obj] + (let [m (meta obj) + var (:sci.impl/record-var m)] + (if-let [rv var] + (let [m (meta @rv)] + (if-let [pm (:sci.impl/pprint-simple-dispatch m)] + (pm obj) + (pprint/simple-dispatch obj))) + (pprint/simple-dispatch obj))))) + +(defmethod pprint/simple-dispatch sci.impl.records.SciRecord [obj] + (-sci-pprint-simple-dispatch obj)) diff --git a/test/sci/pprint_test.clj b/test/sci/pprint_test.clj new file mode 100644 index 00000000..d980c858 --- /dev/null +++ b/test/sci/pprint_test.clj @@ -0,0 +1,29 @@ +(ns sci.pprint-test + (:require + [clojure.pprint :as pp] + [clojure.string :as str] + [clojure.test :as test :refer [deftest is]] + [sci.core :as sci] + [sci.pprint])) + +(defn pprint [o] + (binding [*out* @sci/out] + (pp/pprint o))) + +(deftest pprint-simple-dispatch-test + (is (= "<6>" + (str/trim + (sci/with-out-str + (sci/eval-string " +(require '[clojure.pprint :as pprint]) + +(defrecord Foo [x]) + +(defmethod pprint/simple-dispatch Foo [o] + (print (format \"<%s>\" (:x o)))) + +(pprint/pprint (->Foo 6)) +" + {:namespaces + {'clojure.pprint {'pprint pprint + 'simple-dispatch pp/simple-dispatch}}}))))))