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

fix #1231: missing methods in reify should fall back to default interface methods (#1240)

Browse source
This commit is contained in:
Michiel Borkent 2022-04-14 18:14:31 +02:00 committed by GitHub
parent 52448f7597
commit d8db9eee63
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
15 changed files with 405 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
.gitignore vendored
View file

@ -33,3 +33,6 @@ org_babashka*.h
.envrc
.lsp
bb.build_artifacts.txt
target
.nrepl-port
.DS_Store

7
deps.edn
View file

@ -17,7 +17,9 @@
"deps.clj/src" "deps.clj/resources"
"resources" "sci/resources"],
:deps {org.clojure/clojure {:mvn/version "1.11.0"},
borkdude/sci {:local/root "sci"}
org.babashka/sci {:local/root "sci"}
org.babashka/babashka.impl.reify {:mvn/version "0.1.0"}
org.babashka/sci.impl.types {:mvn/version "0.0.2"}
babashka/babashka.curl {:local/root "babashka.curl"}
babashka/fs {:local/root "fs"}
babashka/babashka.core {:local/root "babashka.core"}
@ -43,7 +45,8 @@
selmer/selmer {:mvn/version "1.12.50"}
com.taoensso/timbre {:mvn/version "5.2.1"}
org.clojure/tools.logging {:mvn/version "1.1.0"}
org.clojure/data.priority-map {:mvn/version "1.1.0"}}
org.clojure/data.priority-map {:mvn/version "1.1.0"}
insn/insn {:mvn/version "0.5.2"}}
:aliases {:babashka/dev
{:main-opts ["-m" "babashka.main"]}
:profile

8
project.clj
View file

@ -10,7 +10,8 @@
:source-paths ["src" "sci/src" "babashka.curl/src" "fs/src" "pods/src"
"babashka.core/src"
"babashka.nrepl/src" "depstar/src" "process/src"
"deps.clj/src" "deps.clj/resources"]
"deps.clj/src" "deps.clj/resources"
"reify/src"]
;; for debugging Reflector.java code:
;; :java-source-paths ["sci/reflector/src-java"]
:java-source-paths ["src-java"]
@ -24,10 +25,13 @@
[cheshire "5.10.2"]
[nrepl/bencode "1.1.0"]
[borkdude/sci.impl.reflector "0.0.1"]
[org.babashka/sci.impl.types "0.0.2"]
[org.babashka/babashka.impl.reify "0.1.0"]
[org.clojure/core.async "1.5.648"]
[org.clojure/test.check "1.1.1"]
[com.github.clj-easy/graal-build-time "0.1.0"]
[rewrite-clj/rewrite-clj "1.0.699-alpha"]]
[rewrite-clj/rewrite-clj "1.0.699-alpha"]
[insn/insn "0.5.2"]]
:plugins [[org.kipz/lein-meta-bom "0.1.1"]]
:metabom {:jar-name "metabom.jar"}
:profiles {:feature/xml {:source-paths ["feature-xml"]

2
reify/.dir-locals.el Normal file
View file

@ -0,0 +1,2 @@
((nil
(cider-clojure-cli-global-options . "-A:test:build")))

50
reify/build.clj Normal file
View file

@ -0,0 +1,50 @@
(ns build
(:require [build.reify2 :as reify2]
[clojure.tools.build.api :as b]))
(def lib 'org.babashka/babashka.impl.reify)
(def version "0.1.0")
(def class-dir "target/classes")
(def basis (b/create-basis {:project "deps.edn"}))
(def jar-file (format "target/%s-%s.jar" (name lib) version))
(defn clean [_]
(b/delete {:path "target"}))
(defn gen-classes [_]
(reify2/gen-classes nil))
(defn jar [_]
(gen-classes nil)
(b/write-pom {:class-dir class-dir
:lib lib
:version version
:basis basis
:src-dirs ["src"]})
(b/copy-dir {:src-dirs ["src"]
:target-dir class-dir})
(b/jar {:class-dir class-dir
:jar-file jar-file}))
(defn install [_]
(jar nil)
(b/install {:basis basis
:lib lib
:version version
:jar-file jar-file
:class-dir class-dir}))
(defn deploy [opts]
(jar opts)
((requiring-resolve 'deps-deploy.deps-deploy/deploy)
(merge {:installer :remote
:artifact jar-file
:pom-file (b/pom-path {:lib lib :class-dir class-dir})}
opts))
opts)
;;;; Scratch
(comment
(gen-classes nil)
)

188
reify/build/reify2.clj Normal file
View file

@ -0,0 +1,188 @@
(ns build.reify2
{:no-doc true}
(:require [babashka.impl.reify2.interfaces :refer [interfaces]]
[insn.core :as insn]))
(set! *warn-on-reflection* false)
(defn set-symbol! [s]
[[:aconst-null]
[:ldc s]
[:invokestatic clojure.lang.Symbol "intern" [String String clojure.lang.Symbol]]
[:putstatic :this (str "_sym_" s) clojure.lang.Symbol]])
(defn return [desc]
(case (last desc)
:void [:return]
(:boolean :int) [:ireturn]
[:areturn]))
(defn loads [desc cast?]
(let [desc (butlast desc)]
(vec
(mapcat (fn [i e]
(case e
:boolean [[:iload i]
(when cast? [:invokestatic Boolean "valueOf" [:boolean Boolean]])]
:int [[:iload i]
(when cast? [:invokestatic Integer "valueOf" [:int Integer]])]
[[:aload i]]))
(range 1 (inc (count desc)))
desc))))
(defn emit-method [class meth desc default]
(let [args (dec (count desc))]
[[[:aload 0]
[:getfield :this "_methods" java.util.Map]
[:getstatic :this (str "_sym_" meth) clojure.lang.Symbol]
[:invokeinterface java.util.Map "get" [Object Object]]
[:checkcast clojure.lang.IFn]
[:astore (inc args)]
[:aload (inc args)]
[:ifnull :fallback]
[:aload (inc args)]
;; load this, always the first argument of IFn
[:aload 0]]
;; load remaining args
(loads desc true)
[[:invokeinterface clojure.lang.IFn "invoke" (vec (repeat (inc (count desc)) Object))]
(let [ret-type* (last desc)
ret-type (if (class? ret-type*)
(.getName ^Class ret-type*)
ret-type*)]
(case ret-type
:void [:pop]
:boolean [[:checkcast Boolean]
[:invokevirtual Boolean "booleanValue"]]
:int [[:checkcast Integer]
[:invokevirtual Integer "intValue"]]
"java.lang.Object" nil
(when (class? ret-type*)
[[:checkcast ret-type*]])))
(return desc)
[:mark :fallback]]
(if default
[[[:aload 0]]
(loads desc false)
[[:invokespecial class meth desc true]
(return desc)]]
[[:new java.lang.UnsupportedOperationException]
[:dup]
[:ldc (format "No implementation of method found: %s %s" meth desc)]
[:invokespecial java.lang.UnsupportedOperationException :init [String :void]]
[:athrow]])]))
(defn interface-data [^Class interface methods]
(let [class-sym (symbol (.getName interface))
method-names (distinct (map :name methods))]
{:name (symbol (str "babashka.impl." (.getName interface)))
:version 1.8
:interfaces [class-sym
'sci.impl.types.IReified
'clojure.lang.IMeta
'clojure.lang.IObj]
:flags [:super :public]
:fields (into [{:flags #{:private},
:name "_methods" :type java.util.Map}
{:flags #{:private},
:name "_interfaces" :type Object}
{:flags #{:private},
:name "_protocols" :type Object}
{:flags #{:private},
:name "_meta" :type clojure.lang.IPersistentMap}]
(for [name method-names]
{:flags #{:private :static},
:name (str "_sym_" name) :type clojure.lang.Symbol}))
:methods (into [{:name :clinit
:emit (reduce into
[]
(conj
(mapv set-symbol! method-names)
[[:return]]))}
{:name :init
:desc [:void]
:emit [[:aload 0]
[:invokespecial :super :init [:void]]
[:return]]}
{:name :init
:desc [java.util.Map Object Object :void]
:emit [[:aload 0]
[:invokespecial :super :init [:void]]
[:aload 0]
[:aload 1]
[:putfield :this "_methods" java.util.Map]
[:aload 0]
[:aload 2]
[:putfield :this "_interfaces" Object]
[:aload 0]
[:aload 3]
[:putfield :this "_protocols" Object]
[:return]]}
{:name :meta
:desc [clojure.lang.IPersistentMap]
:emit [[:aload 0]
[:getfield :this "_meta" clojure.lang.IPersistentMap]
[:areturn]]}
{:name :withMeta
:desc [clojure.lang.IPersistentMap clojure.lang.IObj]
:emit [[:aload 0]
[:aload 1]
[:putfield :this "_meta" clojure.lang.IPersistentMap]
[:aload 0]
[:areturn]]}
{:name :getInterfaces
:desc [Object]
:emit [[:aload 0]
[:getfield :this "_interfaces" Object]
[:areturn]]}
{:name :getMethods
:desc [Object]
:emit [[:aload 0]
[:getfield :this "_methods" java.util.Map]
[:areturn]]}
{:name :getProtocols
:desc [Object]
:emit [[:aload 0]
[:getfield :this "_protocols" Object]
[:areturn]]}]
(for [{:keys [name desc default]} methods]
{:flags #{:public}, :name name
:desc desc
:emit (emit-method interface name desc default)}
))}))
(set! *warn-on-reflection* true)
(defn type->kw [type]
(condp = type
Void/TYPE :void
Boolean/TYPE :boolean
Integer/TYPE :int
type))
(defn class->methods [^Class clazz]
(let [meths (.getMethods clazz)
meths (mapv bean meths)
;; TODO: fix problems with clojure.lang.IFn, special cased for now
;; The problem is that the 20-arity (highest one) could not be reified
;; meths (filter #(<= (:parameterCount %) 19) meths)
meths (mapv (fn [{:keys [name
parameterTypes
returnType
default]}]
(let [ret-type (type->kw returnType)]
{:name name
:desc (conj (mapv type->kw parameterTypes) ret-type)
:default default}))
meths)]
(distinct meths)))
(let [i clojure.lang.IFn]
(insn/define (insn/visit (interface-data i (class->methods i)))))
(def reified (babashka.impl.clojure.lang.IFn. {'invoke (fn [& _args] :yep)} {} {}))
(defn gen-classes [_]
(doseq [i interfaces]
(insn/write (doto (insn/visit (interface-data i (class->methods i)))
insn/define) "target/classes")))

13
reify/deps.edn Normal file
View file

@ -0,0 +1,13 @@
{:deps {org.babashka/sci.impl.types {:mvn/version "0.0.2"}}
:aliases
{:build ;; added by neil
{:paths ["." "build" "src"]
:deps {io.github.clojure/tools.build {:git/tag "v0.8.1" :git/sha "7d40500"}
slipset/deps-deploy {:mvn/version "0.2.0"}
org.babashka/sci.impl.types {:mvn/version "0.0.2"}
;; insn/insn {:mvn/version "0.5.3"}
insn/insn {
:git/sha "f85da286d429b507480f8527b12ce3e1e0e17296"
:git/url "https://github.com/phronmophobic/insn"
}}
:ns-default build}}}

79
reify/src/babashka/impl/reify2.clj Normal file
View file

@ -0,0 +1,79 @@
(ns babashka.impl.reify2
(:require [babashka.impl.reify2.interfaces :refer [interfaces]]))
(set! *warn-on-reflection* false)
(defn method-or-bust [methods k]
(or (get methods k)
(throw (UnsupportedOperationException. "Method not implemented: " k))))
(defn reify-ifn [m]
(let [methods (:methods m)
invoke-fn (or (get methods 'invoke)
(fn [& _args]
(throw (UnsupportedOperationException. "Method not implemented: invoke"))))
apply-fn (or (get methods 'applyTo)
(fn [& _args]
(throw (UnsupportedOperationException. "Method not implemented: applyTo"))))]
(reify
sci.impl.types.IReified
(getMethods [_] (:methods m))
(getInterfaces [_] (:interfaces m))
(getProtocols [_] (:protocols m))
clojure.lang.IFn
(invoke [this] (invoke-fn this))
(invoke [this a0] (invoke-fn this a0))
(invoke [this a0 a1] (invoke-fn this a0 a1))
(invoke [this a0 a1 a2] (invoke-fn this a0 a1 a2))
(invoke [this a0 a1 a2 a3] (invoke-fn this a0 a1 a2 a3))
(invoke [this a0 a1 a2 a3 a4] (invoke-fn this a0 a1 a2 a3 a4))
(invoke [this a0 a1 a2 a3 a4 a5] (invoke-fn this a0 a1 a2 a3 a4 a5))
(invoke [this a0 a1 a2 a3 a4 a5 a6] (invoke-fn this a0 a1 a2 a3 a4 a5 a6))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19))
(invoke [this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20] (invoke-fn this a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20))
(applyTo [this arglist] (apply-fn this arglist)))))
(defmacro gen-reify-fn []
`(fn [~'m]
(if (empty? (:interfaces ~'m))
(reify
sci.impl.types.IReified
(getMethods [_] (:methods ~'m))
(getInterfaces [_] (:interfaces ~'m))
(getProtocols [_] (:protocols ~'m)))
(case (.getName ~(with-meta `(first (:interfaces ~'m))
{:tag 'Class}))
"java.lang.Object"
(reify
java.lang.Object
(toString [~'this]
((method-or-bust (:methods ~'m) (quote ~'toString)) ~'this))
sci.impl.types.IReified
(getMethods [_] (:methods ~'m))
(getInterfaces [_] (:interfaces ~'m))
(getProtocols [_] (:protocols ~'m)))
~@(mapcat identity
(cons
["clojure.lang.IFn"
`(reify-ifn ~'m)]
(for [i interfaces]
(let [in (.getName ^Class i)]
[in
`(new ~(symbol (str "babashka.impl." in))
(:methods ~'m)
(:interfaces ~'m)
(:protocols ~'m))]))))))))
(def reify-fn (gen-reify-fn))

30
reify/src/babashka/impl/reify2/interfaces.clj Normal file
View file

@ -0,0 +1,30 @@
(ns babashka.impl.reify2.interfaces)
(def interfaces [java.nio.file.FileVisitor
java.io.FileFilter
java.io.FilenameFilter
clojure.lang.Associative
clojure.lang.ILookup
java.util.Map$Entry
;; TODO: fix problems with clojure.lang.IFn, special cased for now
;; The problem is that the 20-arity (highest one) could not be reified
;; clojure.lang.IFn
clojure.lang.IPersistentCollection
clojure.lang.IReduce
clojure.lang.IReduceInit
clojure.lang.IKVReduce
clojure.lang.Indexed
clojure.lang.IPersistentMap
clojure.lang.IPersistentStack
clojure.lang.Reversible
clojure.lang.Seqable
java.lang.Iterable
java.net.http.WebSocket$Listener
java.util.Iterator
java.util.function.Consumer
java.util.function.Function
java.util.function.Predicate
java.util.function.Supplier
java.lang.Comparable
javax.net.ssl.X509TrustManager
clojure.lang.LispReader$Resolver])

11
resources/META-INF/babashka/deps.edn
View file

@ -17,7 +17,9 @@
"deps.clj/src" "deps.clj/resources"
"resources" "sci/resources"],
:deps {org.clojure/clojure {:mvn/version "1.11.0"},
borkdude/sci {:local/root "sci"}
org.babashka/sci {:local/root "sci"}
org.babashka/babashka.impl.reify {:mvn/version "0.0.7"}
org.babashka/sci.impl.types {:mvn/version "0.0.2"}
babashka/babashka.curl {:local/root "babashka.curl"}
babashka/fs {:local/root "fs"}
babashka/babashka.core {:local/root "babashka.core"}
@ -40,10 +42,11 @@
org.clojure/core.match {:mvn/version "1.0.0"}
hiccup/hiccup {:mvn/version "2.0.0-alpha2"}
rewrite-clj/rewrite-clj {:mvn/version "1.0.699-alpha"}
selmer/selmer {:mvn/version "1.12.44"}
selmer/selmer {:mvn/version "1.12.50"}
com.taoensso/timbre {:mvn/version "5.2.1"}
org.clojure/tools.logging {:mvn/version "1.1.0"}
org.clojure/data.priority-map {:mvn/version "1.1.0"}}
org.clojure/data.priority-map {:mvn/version "1.1.0"}
insn/insn {:mvn/version "0.5.2"}}
:aliases {:babashka/dev
{:main-opts ["-m" "babashka.main"]}
:profile
@ -129,7 +132,7 @@
clojure-msgpack/clojure-msgpack {:mvn/version "1.2.1"}
cli-matic/cli-matic {:git/url "https://github.com/l3nz/cli-matic.git", :git/sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}
aysylu/loom {:mvn/version "1.0.2"}
com.layerware/hugsql-core {:mvn/version "0.5.1"}
com.layerware/hugsql-core {:mvn/version "0.5.3"}
com.github.seancorfield/expectations {:mvn/version "2.0.157"}
com.rpl/specter {:mvn/version "1.1.4"}}
:classpath-overrides {org.clojure/clojure nil

2
sci

@ -1 +1 @@
Subproject commit 64545c0f254d25c872086a17afa604ac802b5ee1
Subproject commit c44c2b1c801c09987e0051834070509066785377

2
src/babashka/impl/classes.clj
View file

@ -391,7 +391,9 @@
java.util.concurrent.CompletableFuture
java.util.concurrent.Executors
java.util.concurrent.TimeUnit
java.util.function.Consumer
java.util.function.Function
java.util.function.Predicate
java.util.function.Supplier
java.util.zip.Inflater
java.util.zip.InflaterInputStream

1
src/babashka/impl/print_deps.clj
View file

@ -20,6 +20,7 @@
:git/sha "52a6037bd4b632bffffb04394fb4efd0cdab6b1e"})
deps (dissoc deps
'borkdude/sci
'org.babashka/sci
'borkdude/graal.locking
'org.postgresql/postgresql
'babashka/clojure-lanterna

2
src/babashka/main.clj
View file

@ -35,7 +35,7 @@
[babashka.impl.process :refer [process-namespace]]
[babashka.impl.protocols :refer [protocols-namespace]]
[babashka.impl.proxy :refer [proxy-fn]]
[babashka.impl.reify :refer [reify-fn]]
[babashka.impl.reify2 :refer [reify-fn]]
[babashka.impl.repl :as repl]
[babashka.impl.rewrite-clj :as rewrite]
[babashka.impl.server :refer [clojure-core-server-namespace]]

17
test/babashka/reify_test.clj
View file

@ -57,6 +57,11 @@
(def m (reify Object
(toString [_] (str :foo))))
(str m)
"))))
(testing "toString + protocol"
(is (= ":dude1:dude2"
(bb nil "
(defprotocol Dude (dude [_])) (def obj (reify Object (toString [_] (str :dude1)) Dude (dude [_] :dude2))) (str (str obj) (dude obj))
"))))
(testing "Hashcode still works when only overriding toString"
(is (number?
@ -97,3 +102,15 @@
[x y] (bb nil prog)]
(is (pos? x))
(is (zero? y))))
(deftest reify-default-method-test
(let [prog '(do (def iter (let [coll [:a :b :c] idx (volatile! -1)]
(reify java.util.Iterator (hasNext [_] (< @idx 2))
(next [_] (nth coll (vswap! idx inc))))))
(def res (volatile! []))
(vswap! res conj (.hasNext iter))
(vswap! res conj (.next iter))
(.forEachRemaining
iter (reify java.util.function.Consumer (accept [_ x] (vswap! res conj x))))
(= [true :a :b :c] @res))]
(is (true? (bb nil prog)))))