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

Reify improvements

Browse source
This commit is contained in:
Michiel Borkent 2021-03-07 13:56:12 +01:00
parent bc8739a57e
commit 0d59c0f43b
6 changed files with 106 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
deps.edn
View file

@ -32,10 +32,9 @@
datascript/datascript {:mvn/version "1.0.1"}
http-kit/http-kit {:mvn/version "2.5.3"}
babashka/clojure-lanterna {:mvn/version "0.9.8-SNAPSHOT"}
org.clojure/math.combinatorics {:mvn/version "0.1.6"}
org.clojure/core.match {:mvn/version "1.0.0"}
hiccup/hiccup {:mvn/version "2.0.0-alpha2"}}
:aliases {:main
:aliases {:babashka/dev
{:main-opts ["-m" "babashka.main"]}
:profile
{:extra-deps

3
project.clj
View file

@ -21,8 +21,7 @@
[cheshire "5.10.0"]
[nrepl/bencode "1.1.0"]
[borkdude/sci.impl.reflector "0.0.1"]
[org.clojure/test.check "1.1.0"]
[org.clojure/math.combinatorics "0.1.6"]]
[org.clojure/test.check "1.1.0"]]
:profiles {:feature/xml {:source-paths ["feature-xml"]
:dependencies [[org.clojure/data.xml "0.2.0-alpha6"]]}
:feature/yaml {:source-paths ["feature-yaml"]

2
sci

@ -1 +1 @@
Subproject commit 9843e5521f65574d4c5c49a4fccfd920e28c8a62
Subproject commit 5912a2b6d12d3a6c46f903383c61b784cddbc174

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

@ -1,7 +1,6 @@
(ns babashka.impl.reify
{:no-doc true}
(:require [clojure.math.combinatorics :as combo]
[sci.impl.types]))
(:require [sci.impl.types]))
(set! *warn-on-reflection* false)
@ -15,18 +14,27 @@
'(getMethods [this]
methods)
'(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]}]
(concat prelude
(mapcat (fn [[clazz methods]]
(cons clazz
(cons
clazz
(mapcat
(fn [[meth arities]]
(map
(fn [arity]
(list meth arity
(list*
(list 'get 'methods (list 'quote meth))
(list 'or (list 'get 'methods (list 'quote meth))
`(throw (new Exception (str "Not implemented: "
~(str meth)))))
arity)))
arities))
methods)))
@ -35,11 +43,9 @@
#_:clj-kondo/ignore
(def reify-fn
(gen-reify-combos
{java.nio.file.FileVisitor {preVisitDirectory [[this p attrs]]
postVisitDirectory [[this p attrs]]
visitFile [[this p attrs]]}
java.io.FileFilter {accept [[this f]]}
java.io.FilenameFilter {accept [[this f s]]}
{clojure.lang.Associative {containsKey [[this k]]
entryAt [[this k]]
assoc [[this k v]]}
clojure.lang.ILookup {valAt [[this k] [this k default]]}
clojure.lang.IFn {applyTo [[this arglist]]
invoke [[this]
@ -64,6 +70,8 @@
[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 varargs]]}
clojure.lang.Associative {containsKey [[this k]]
entryAt [[this k]]
assoc [[this k v]]}}))
java.nio.file.FileVisitor {preVisitDirectory [[this p attrs]]
postVisitDirectory [[this p attrs]]
visitFile [[this p attrs]]}
java.io.FileFilter {accept [[this f]]}
java.io.FilenameFilter {accept [[this f s]]}}))

41
test/babashka/main_test.clj
View file

@ -363,16 +363,7 @@
(is (.exists f2))
(let [v (bb nil "-f" (.getPath (io/file "test-resources" "babashka" "glob.clj")))]
(is (vector? v))
(is (.exists (io/file (first v))))))
(testing "reify can handle multiple classes at once"
(is (true? (bb nil "
(def filter-obj (reify java.io.FileFilter
(accept [this f] (prn (.getPath f)) true)
java.io.FilenameFilter
(accept [this f name] (prn name) true)))
(def s1 (with-out-str (.listFiles (clojure.java.io/file \".\") filter-obj)))
(def s2 (with-out-str (.list (clojure.java.io/file \".\") filter-obj)))
(and (pos? (count s1)) (pos? (count s2)))")))))
(is (.exists (io/file (first v)))))))
(deftest future-print-test
(testing "the root binding of sci/*out*"
@ -576,36 +567,6 @@
(when test-utils/native?
(is (bb nil "(defmethod print-method sci.lang.IVar [o w] (.write w (str :foo (symbol o)))) (def x 1) (= \":foouser/x\" (pr-str #'x))"))))
(deftest reify-multiple-arities-test
(testing "ILookup"
(is (= ["->:foo" 10]
(bb nil "
(def m (reify clojure.lang.ILookup
(valAt [this x] (str \"->\" x))
(valAt [this x y] y)))
[(:foo m) (:foo m 10)]"))))
(testing "IFn"
(is (= [:yo :three :six :twelve :eighteen :nineteen 19]
(bb nil "
(def m (reify clojure.lang.IFn
(invoke [this] :yo)
(invoke [this _ _ _] :three)
(invoke [this _ _ _ _ _ _] :six)
(invoke [this _ _ _ _ _ _ _ _ _ _ _ _] :twelve)
(invoke [this _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _] :eighteen)
(invoke [this _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _] :nineteen)
(applyTo [this args] (last args))))
[
(m)
(m 1 2 3)
(m 1 2 3 4 5 6)
(m 1 2 3 4 5 6 1 2 3 4 5 6)
(m 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6)
(m 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1)
(apply m (range 20))
]")))))
;;;; Scratch
(comment

73
test/babashka/reify_test.clj Normal file
View file

@ -0,0 +1,73 @@
(ns babashka.reify-test
(:require
[babashka.test-utils :as test-utils]
[clojure.edn :as edn]
[clojure.test :as test :refer [deftest is testing]]
[clojure.string :as str]))
(defn bb [input & args]
(edn/read-string
{:readers *data-readers*
:eof nil}
(apply test-utils/bb (when (some? input) (str input)) (map str args))))
(deftest file-filter-test
(testing "reify can handle multiple classes at once"
(is (true? (bb nil "
(def filter-obj (reify java.io.FileFilter
(accept [this f] (prn (.getPath f)) true)
java.io.FilenameFilter
(accept [this f name] (prn name) true)))
(def s1 (with-out-str (.listFiles (clojure.java.io/file \".\") filter-obj)))
(def s2 (with-out-str (.list (clojure.java.io/file \".\") filter-obj)))
(and (pos? (count s1)) (pos? (count s2)))")))))
(deftest reify-multiple-arities-test
(testing "ILookup"
(is (= ["->:foo" 10]
(bb nil "
(def m (reify clojure.lang.ILookup
(valAt [this x] (str \"->\" x))
(valAt [this x y] y)))
[(:foo m) (:foo m 10)]"))))
(testing "IFn"
(is (= [:yo :three :six :twelve :eighteen :nineteen 19]
(bb nil "
(def m (reify clojure.lang.IFn
(invoke [this] :yo)
(invoke [this _ _ _] :three)
(invoke [this _ _ _ _ _ _] :six)
(invoke [this _ _ _ _ _ _ _ _ _ _ _ _] :twelve)
(invoke [this _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _] :eighteen)
(invoke [this _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _] :nineteen)
(applyTo [this args] (last args))))
[
(m)
(m 1 2 3)
(m 1 2 3 4 5 6)
(m 1 2 3 4 5 6 1 2 3 4 5 6)
(m 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6)
(m 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1)
(apply m (range 20))
]")))))
(deftest reify-object
(testing "toString"
(is (= ":foo"
(bb nil "
(def m (reify Object
(toString [_] (str :foo))))
(str m)
"))))
(testing "Hashcode still works when only overriding toString"
(is (number?
(bb nil "
(def m (reify Object
(toString [_] (str :foo))))
(hash m)
"))))
(testing "toString still works when not overriding it"
(is (bb nil "
(def m (reify Object))
(str m)
"))))