Skip to content

Commit

Permalink
core proxy fn impl
Browse files Browse the repository at this point in the history
  • Loading branch information
@ikappaki
ikappaki committed Jan 22, 2024
1 parent 491a136 commit 6316d9a
Show file tree
Hide file tree
Showing 3 changed files with 228 additions and 0 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
* Added a subcommand for bootstrapping the Python installation with Basilisp (#790)
* Added support for executing Basilisp namespaces directly via `basilisp run` and by `python -m` (#791)
* Added the `memoize` core fn (#812)
* Added support for the `proxy` fn (part of #425)

### Changed
* Optimize calls to Python's `operator` module into their corresponding native operators (#754)
Expand Down
119 changes: 119 additions & 0 deletions src/basilisp/core.lpy
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7085,3 +7085,122 @@
(.put-nowait tap-queue {:topic topic :val val})
true
(catch queue/Full _ false))))

;;;;;;;;;;;
;; Proxy ;;
;;;;;;;;;;;

(defmacro proxy [class-and-interfaces args & fs]
"Expands to code that creates an instance of a class that implements
the Basilisp interfaces in ``class-and-interfaces``. The methods
implementations are provided in ``fs``, while the ``args`` are
passed to superclass constructor of the instance. If no class is
specified in ``class-and-interfaces``, the proxy instance inherits
from `python/object`.
``fs`` consists of class/interface method definitions and/or
multiarity interface method definitions
(method-name1 [args...] body)
(method-name2 ([args1...] body1)
([args2...] body2) ...)
...
A `this` argument is implicitly avaialble in method bodies, refering
to the proxy instance.
The single arity version can also accept python keyword args using
the meta :kwargs option, as follows
^{:kwargs :collect} (method-name [args... {:as kwargs}])
The interfaces in ``class-and-interfaces`` can be regular classes or
abstract classes whose methods can be overriden in ``fs``.
Moreover, if a method in ``fs`` is not found in any of the methods
in ``class-and-interfaces``, it is added as a new method in the
proxy instance."
(let [class-nm (str (gensym (str "proxy--" (first class-and-interfaces))))
fname-fn-pairs
(for [f fs]
(if (list? (second f))
;; multi-arity
;;
;; Create a single variadic fn that will switch to the
;; correct body based on the number of arguments passed
;; in.
(let [fname-fn-pair
(let [vargs (gensym "args")
fname (first f)
;; sort the different arities to ensure that
;; variadic arity comes last, courtesy of the
;; additional `&` symbol.
fargs (sort-by count (rest f))
fargs-last (last fargs)
variadic-pos (try
(.index (first fargs-last) '&)
(catch python/ValueError _
nil))]
[(str fname)
`(fn [& ~vargs]
;; create a case form to switch to the right
;; body according to the number of arguments
;; passed to the fn.
;;
;; (case (count fn-args)
;; n1 (do body1)
;; n2 (do body2)
;; (if-not (variadic? fn-args)
;; (throw exception)
;; (do variadic-body))
~(apply list 'case (list 'count vargs)
(mapcat (fn [args-and-body]
(let [args (first args-and-body)
body (rest args-and-body)]
(if (and (= args-and-body fargs-last)
variadic-pos)
`((if (<= (count ~vargs) ~variadic-pos)
(throw (ex-info "Arguments passed to function does not match the variadic fn specification"
{:args-spec-expected (quote ~(first fargs-last))
:args-provided (drop 1 ~vargs)}))
(let [~(into ['this] args) ~vargs]
(do ~@body))))
[(inc (count args)) (list 'let [(into ['this] args) vargs]
`(do ~@body))])))
fargs)))])


;; Implementation of variadic functions for Basilisp
;; interfaces necessitates the inclusion of
;; additional arity method signatures, such as
;; method-name_arityN, to be registered for proper
;; functionality, even if their implementations are
;; nil.
fname-fndummy-pairs
(for [spec (rest f)]
(let [fargs (first spec)
argc (count fargs)
variadic? (try
(.index fargs '&)
(catch python/ValueError _
nil))
arity (if variadic?
"_rest"
(if (= argc 0) 0 (inc argc)))]
[(str "_" (first f) "_arity" arity) nil]))]
(into [fname-fn-pair] fname-fndummy-pairs))

;; single arity
(let [fmeta (meta f)
fname (first f)
fargs (second f)
body `(do ~@(drop 2 f))]
[[(.replace (str fname) "-" "_") (with-meta `(fn ~(into ['this] fargs)
~body)
fmeta)]])))

;; convert to dictionary of fname-fn pairs
fns-dict
(into {} (apply concat fname-fn-pairs))]
`((python/type ~class-nm (python/tuple ~class-and-interfaces)
(lisp->py ~fns-dict)) ~@args)))
108 changes: 108 additions & 0 deletions tests/basilisp/test_core_macros.lpy
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1464,3 +1464,111 @@
(deftest macro-variadic-fn
(testing "defining variadic fn with ampersand"
(is (= '(2 3 4) ((variadic-fn) 2 3 4)))))

(definterface ITestProxySingleArg
(arg-simple [arg]))
(definterface ITestProxySimpleVariadic
(variadic-simple [arg1 arg2 & more]))
(definterface ITestProxyFullVariadic
(variadic-full [& more]))
(definterface ITestProxyMultiArgs
(none [])
(one-arg [arg])
(multi [one two & more]))
(definterface ITestProxyMultiVariadic
(variadic [])
(variadic [one two three & more])
(variadic [one]))

(deftest proxy-test
(testing "proxy interface of simple fn with args"
(let [p (proxy [ITestProxySingleArg] []
(arg-simple [arg] arg))]
(is (= 5 (.arg-simple p 5)))

(is (thrown? python/TypeError (.arg-simple p)))
(is (thrown? python/TypeError (.arg-simple p 2 3)))))

(testing "proxy interface of simple variadic fn"
(let [p (proxy [ITestProxySimpleVariadic] []
(variadic-simple [arg1 arg2 & more] [arg1 arg2 more]))]
(is (= [5 6 nil] (.variadic-simple p 5 6)))
(is (= [5 6 '(2 3)] (.variadic-simple p 5 6 2 3)))

(is (thrown? python/TypeError (.variadic-simple p)))
(is (thrown? python/TypeError (.variadic-simple p 1)))))

(testing "proxy interface of full variadic fn"
(let [p (proxy [ITestProxyFullVariadic] []
(variadic-full [& more] more))]
(is (= '(5 6 2 3) (.variadic-full p 5 6 2 3)))))

(testing "proxy interface of functions with various length of args"
(let [p (proxy [ITestProxyMultiArgs] []
(none [] "hi")
(one-arg [arg] arg)
(multi [one two & more] {:one one
:two two
:more more}))]
(is (= "hi" (.none p)))
(is (= 5 (.one-arg p 5)))
(is (= {:one 5 :two 3 :more [4 6]}
(.multi p 5 3 4 6)))))

(testing "proxy interface with multiarity and variadic fns"
(let [p (proxy [ITestProxyMultiVariadic] []
(variadic
([] 0)
([one] one)
([one two three & more] [one two three more])))]
(is (= 0 (.variadic p)))
(is (= 5 (.variadic p 5)))
(is (= [9 8 7 nil] (.variadic p 9 8 7)))
(is (= [9 8 7 '(3 4)] (.variadic p 9 8 7 3 4)))

(is (thrown? basilisp.lang.exception/ExceptionInfo (.variadic p 9 8)))))

(testing "proxy interfaces with simple fn and multiarity"
(let [p (proxy [ITestProxySingleArg ITestProxyMultiVariadic] []
(arg-simple [arg] arg)
(variadic
([] 0)
([one] one)
([one two three & more] [one two three more])))]
(is (= 3 (.arg-simple p 3)))
(is (= 0 (.variadic p)))
(is (= 5 (.variadic p 5)))
(is (= [9 8 7 '(3 4)] (.variadic p 9 8 7 3 4)))))

(testing "simple proxy class with interface and `this` anaphora"
(let [p (proxy [io/StringIO ITestProxySingleArg] []
(arg-simple [arg] (.write this arg)))]
(is (= 2 (.arg-simple p "hi")))
(is (= "hi" (.getvalue p))))
)

(testing "simple proxy class with super constructor arg"
(let [p (proxy [io/StringIO ITestProxySingleArg] ["hello"]
(arg-simple [_] (.getvalue this)))]
(is (= "hello" (.arg-simple p nil)))))


(testing "simple proxy class with a new fn taking pythonic keyword args"
(let [p (proxy [io/StringIO] []
^{:kwargs :collect} (xyz [arg1 {:as kwargs}]
[arg1 kwargs]))]
(is (= [1 {:kw1 2 :kw2 3}] (.xyz p 1 ** :kw1 2 :kw2 3)))))

(testing "proxy class overriding taking pythonic keyword args"
(let [encoding-default (.-encoding (io/TextIOWrapper (io/BufferedIOBase)))
p (proxy [io/TextIOWrapper] [(io/BufferedIOBase)])
p-override (proxy [io/TextIOWrapper] [(io/BufferedIOBase)]
^{:kwargs :collect} (reconfigure [{:as kwargs}]
kwargs))]
(is (nil? (.reconfigure p ** :encoding "ascii")))
(let [encoding-new (.-encoding p)]
(is (= "ascii" encoding-new))
(is (not= encoding-default encoding-new)))

(is (= {:encoding :xyz} (.reconfigure p-override ** :encoding :xyz)))
(is (= encoding-default (.-encoding p-override))))))

0 comments on commit 6316d9a

Please sign in to comment.