luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Narrow scope of reify

Browse source
This commit is contained in:
Michiel Borkent 2021-03-13 12:44:12 +01:00
parent f58748ebbe
commit 8551817724
2 changed files with 133 additions and 116 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

227
src/babashka/impl/reify.clj
View file

@ -4,129 +4,152 @@
(set! *warn-on-reflection* false) (set! *warn-on-reflection* false)
;; Notes
;; We abandoned the 'one reify object that implements all interfaces' approach
;; due to false positives. E.g. when you would print a reified object, you would
;; get: 'Not implemented: seq', because print-method thought this object was
;; seqable, while in fact, it wasn't.
(defn method-or-bust [methods k]
(or (get methods k)
(throw (UnsupportedOperationException. "Method not implemented: " k))))
(defmacro gen-reify-combos (defmacro gen-reify-combos
"Generates pre-compiled reify combinations" "Generates pre-compiled reify combinations"
[methods] [methods]
(let [prelude ['reify (let [prelude '(reify
'sci.impl.types.IReified sci.impl.types.IReified
'(getInterfaces [this] (getInterfaces [this]
interfaces) interfaces)
'(getMethods [this] (getMethods [this]
methods) methods)
'(getProtocols [this] (getProtocols [this]
protocols) protocols))]
'java.lang.Object
'(toString [this]
(if-let [m (get methods 'toString)]
(m this)
(str (.. this getClass getName)
"@" (Integer/toHexString (.hashCode this)))))]]
(list 'fn [{:keys '[interfaces methods protocols]}] (list 'fn [{:keys '[interfaces methods protocols]}]
(concat prelude `(cond ~'(empty? interfaces) ~prelude
(mapcat (fn [[clazz methods]] ~'(> (count interfaces)
(cons 1)
clazz (throw (new Exception "Babashka currently does not support reifying more than one interface."))
(mapcat :else
(fn [[meth arities]] (case (.getName ~(with-meta '(first interfaces)
(map {:tag 'Class}))
(fn [arity] ~@(mapcat
(list meth arity (fn [[clazz methods]]
(list* (list
(list 'or (list 'get 'methods (list 'quote meth)) (str clazz)
`(throw (new Exception (str "Not implemented: " (concat prelude
~(str meth))))) (cons clazz
arity))) (mapcat
arities)) (fn [[meth arities]]
methods))) (map
methods))))) (fn [arity]
(list meth arity
(list*
(list 'or (list 'get 'methods (list 'quote meth))
`(throw (new Exception (str "Not implemented: "
~(str meth)))))
arity)))
arities))
methods)))))
methods)))))
#_:clj-kondo/ignore ;; (require 'clojure.pprint)
;; (clojure.pprint/pprint
;; (macroexpand '(gen-reify-combos {java.nio.file.FileVisitor
;; {preVisitDirectory [[this p attrs]]
;; postVisitDirectory [[this p attrs]]
;; visitFile [[this p attrs]]}})))
#_:clj-kondo/ignore)
(def reify-fn (def reify-fn
(gen-reify-combos (gen-reify-combos
{java.nio.file.FileVisitor {java.lang.Object
{preVisitDirectory [[this p attrs]] {toString [[this]]}
postVisitDirectory [[this p attrs]] java.nio.file.FileVisitor
visitFile [[this p attrs]]} {preVisitDirectory [[this p attrs]]
postVisitDirectory [[this p attrs]]
visitFile [[this p attrs]]}
java.io.FileFilter java.io.FileFilter
{accept [[this f]]} {accept [[this f]]}
java.io.FilenameFilter java.io.FilenameFilter
{accept [[this f s]]} {accept [[this f s]]}
clojure.lang.Associative clojure.lang.Associative
{containsKey [[this k]] {containsKey [[this k]]
entryAt [[this k]] entryAt [[this k]]
assoc [[this k v]]} assoc [[this k v]]}
clojure.lang.ILookup clojure.lang.ILookup
{valAt [[this k] [this k default]]} {valAt [[this k] [this k default]]}
java.util.Map$Entry java.util.Map$Entry
{getKey [[this]] {getKey [[this]]
getValue [[this]]} getValue [[this]]}
clojure.lang.IFn clojure.lang.IFn
{applyTo [[this arglist]] {applyTo [[this arglist]]
invoke [[this] invoke [[this]
[this a1] [this a1]
[this a1 a2] [this a1 a2]
[this a1 a2 a3] [this a1 a2 a3]
[this a1 a2 a3 a4] [this a1 a2 a3 a4]
[this a1 a2 a3 a4 a5] [this a1 a2 a3 a4 a5]
[this a1 a2 a3 a4 a5 a6] [this a1 a2 a3 a4 a5 a6]
[this a1 a2 a3 a4 a5 a6 a7] [this a1 a2 a3 a4 a5 a6 a7]
[this a1 a2 a3 a4 a5 a6 a7 a8] [this a1 a2 a3 a4 a5 a6 a7 a8]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9] [this a1 a2 a3 a4 a5 a6 a7 a8 a9]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20] [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20]
[this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 varargs]]} [this a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 varargs]]}
clojure.lang.IPersistentCollection clojure.lang.IPersistentCollection
{count [[this]] {count [[this]]
cons [[this x]] cons [[this x]]
empty [[this]] empty [[this]]
equiv [[this x]]} equiv [[this x]]}
clojure.lang.IReduce clojure.lang.IReduce
{reduce [[this f]]} {reduce [[this f]]}
clojure.lang.IReduceInit clojure.lang.IReduceInit
{reduce [[this f initial]]} {reduce [[this f initial]]}
clojure.lang.IKVReduce clojure.lang.IKVReduce
{kvreduce [[this f initial]]} {kvreduce [[this f initial]]}
clojure.lang.Indexed clojure.lang.Indexed
{nth [[this n] [this n not-found]]} {nth [[this n] [this n not-found]]}
clojure.lang.IPersistentMap clojure.lang.IPersistentMap
{assocEx [[this k v]] {assocEx [[this k v]]
without [[this k]]} without [[this k]]}
clojure.lang.IPersistentStack clojure.lang.IPersistentStack
{peek [[this]] {peek [[this]]
pop [[this]]} pop [[this]]}
clojure.lang.Reversible clojure.lang.Reversible
{rseq [[this]]} {rseq [[this]]}
clojure.lang.Seqable clojure.lang.Seqable
{seq [[this]]} {seq [[this]]}
java.lang.Iterable java.lang.Iterable
{iterator [[this]] {iterator [[this]]
forEach [[this action]]} forEach [[this action]]}
java.util.Iterator java.util.Iterator
{hasNext [[this]] {hasNext [[this]]
next [[this]]}})) next [[this]]}}))

22
test/babashka/reify_test.clj
View file

@ -2,8 +2,7 @@
(:require (:require
[babashka.test-utils :as test-utils] [babashka.test-utils :as test-utils]
[clojure.edn :as edn] [clojure.edn :as edn]
[clojure.test :as test :refer [deftest is testing]] [clojure.test :as test :refer [deftest is testing]]))
[clojure.string :as str]))
(defn bb [input & args] (defn bb [input & args]
(edn/read-string (edn/read-string
@ -12,15 +11,15 @@
(apply test-utils/bb (when (some? input) (str input)) (map str args)))) (apply test-utils/bb (when (some? input) (str input)) (map str args))))
(deftest file-filter-test (deftest file-filter-test
(testing "reify can handle multiple classes at once" (is (true? (bb nil "
(is (true? (bb nil "
(def filter-obj (reify java.io.FileFilter (def filter-obj (reify java.io.FileFilter
(accept [this f] (prn (.getPath f)) true) (accept [this f] (prn (.getPath f)) true)))
java.io.FilenameFilter (def filename-filter-obj
(reify java.io.FilenameFilter
(accept [this f name] (prn name) true))) (accept [this f name] (prn name) true)))
(def s1 (with-out-str (.listFiles (clojure.java.io/file \".\") filter-obj))) (def s1 (with-out-str (.listFiles (clojure.java.io/file \".\") filter-obj)))
(def s2 (with-out-str (.list (clojure.java.io/file \".\") filter-obj))) (def s2 (with-out-str (.listFiles (clojure.java.io/file \".\") filename-filter-obj)))
(and (pos? (count s1)) (pos? (count s2)))"))))) (and (pos? (count s1)) (pos? (count s2)))"))))
(deftest reify-multiple-arities-test (deftest reify-multiple-arities-test
(testing "ILookup" (testing "ILookup"
@ -65,9 +64,4 @@
(def m (reify Object (def m (reify Object
(toString [_] (str :foo)))) (toString [_] (str :foo))))
(hash m) (hash m)
")))) ")))))
(testing "toString still works when not overriding it"
(is (bb nil "
(def m (reify Object))
(str m)
"))))