Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

core proxy fn impl #818

Closed
wants to merge 3 commits into from
Closed

core proxy fn impl #818

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
f441333
core proxy fn impl
ikappaki Jan 9, 2024
5d915b7
attempt to address review comments (populate arity fns)
ikappaki Jan 28, 2024
ee9d903
Reimplement using let function bindings
ikappaki Feb 12, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
* Added support for reading scientific notation literals, octal and hex integer literals, and arbitrary base (2-36) integer literals (#769)
* Added support for passing trailing maps to functions which accept Basilisp keyword arguments (#663)
* Added support for loading namespaces as an alias only (#664)
* 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
129 changes: 129 additions & 0 deletions src/basilisp/core.lpy
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7175,3 +7175,132 @@
(.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, such as :collect, 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 shadowed/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))))
;; The idea here is to create let bindings to the functions
;; required to implement the interfaces or new methods, and
;; associate these bindigns to method names in `python/type`.
;;
;; (let [binding1 (fn method-name1 ['this args...] body)
;; binding2 (fn method-name2 (['this args1...] body1)
;; (['this args2...] body2))
;; ...]
;; (python/type proxy-xyz (class-and-interfaces)
;; {"method-name1" bidning1, "method-name2" binding2, ...}))
bindings-and-mappings
(for [f fs]
(if (list? (second f))
;; multi-arity
(let [fname (first f)
;; Implementation of a multi arity function for a
;; Basilisp interface does not only require a single
;; multiarity function implemented, but also necessitates
;; the inclusion of additional arity method
;; signatures, such as method-name_arityN, to be
;; implemented for proper functionality.
arity-fns-additional
(->> (for [spec (rest f)]
(let [fargs (first spec)
argc (count fargs)
variadic-pos (try
(.index fargs '&)
(catch python/ValueError _
nil))
;; setting varidiac fn to infinity will
;; help with the sorting to position
;; the variadic fn last.
arity (if variadic-pos math/inf argc)
farity (if variadic-pos
"_rest"
(if (= argc 0) 0 (inc argc)))
fnname (str "_" fname "_arity" farity)]
{:fnname fnname
:binding-name (gensym fnname)
:fargs fargs
:arity arity
:variadic-pos variadic-pos
:fun `(fn ~(symbol fnname) ~(into ['this] fargs)
~@(rest spec))}))
(sort-by :arity))
;; e.g. ( [method-name-arityN-binding (fn method-name_arityN [this args1...] body)],
;; [method-name-arityY-binding (fn method-name_arityY [this args2...] body)] ...)
binding-to-fn-pairs (for [{:keys [binding-name fun]} arity-fns-additional]
[binding-name fun])
;; e.g. ( [method-name_arityN method-name-arityN-binding],
;; [method-name_arityY method-name-arityY-binding] ...)
fname-to-binding-pairs (for [{:keys [fnname binding-name]} arity-fns-additional]
[(munge fnname) binding-name])
;; the main multiarity function, it refers to the
;; above function bindings.
;; (fn method-name2 ([this args1...] (method-name-arityN-binding this args1...)
;; ([this args2...] (method-name_arityY-binding this args2...))]
multiarity-fn (->> (for [{:keys [binding-name fargs variadic-pos]} arity-fns-additional]
(let [args (into ['this] fargs)]
(if variadic-pos
(let [singles (take (inc variadic-pos) args)
variadic (last args)]
`(~args
(apply ~binding-name ~@singles ~variadic)))
`(~args
(~binding-name ~@args)))))
(concat `(fn ~fname)))
multiarity-binding-name (gensym fname)
;; add the multiarity binding pair to the end,
;; because the function it defines can refer back to
;; the other bindings.
binding-to-fn-pairs (conj (into [] binding-to-fn-pairs) [multiarity-binding-name multiarity-fn])
;; add multiarity method name to the list
fname-to-binding-pairs (cons [(munge (str fname)) multiarity-binding-name] fname-to-binding-pairs)]
{:binding-to-fn-pairs binding-to-fn-pairs
:fname-to-binding-pairs fname-to-binding-pairs})

;; single arity
(let [fmeta (meta f)
fname (first f)
fargs (second f)
binding-name (gensym fname)
fn-def (with-meta `(fn ~fname ~(into ['this] fargs)
~@(drop 2 f))
fmeta)]
{:binding-to-fn-pairs [ [binding-name fn-def] ]
:fname-to-binding-pairs [[(munge fname) binding-name]]})))

let-bindings (apply concat (map :binding-to-fn-pairs bindings-and-mappings))
fns-dict (into {} (apply concat (map :fname-to-binding-pairs bindings-and-mappings)))]
`(let ~(into [] (apply concat let-bindings))
((python/type ~class-nm (python/tuple ~class-and-interfaces)
(lisp->py ~fns-dict)) ~@args))))
114 changes: 114 additions & 0 deletions tests/basilisp/test_core_macros.lpy
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1537,3 +1537,117 @@
(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-a [one two & more]))
(definterface ITestProxyMultiVariadic
(multi-a [])
(multi-a [one two three & more])
(multi-a [one]))

(deftest proxy-test
(testing "proxy interface of simple fn with args"
(let [p (proxy [ITestProxySingleArg] []
(arg-simple [atm*]
(swap! atm* inc)
@atm*))
atm (atom 5)]
(is (= 6 (.arg-simple p atm)))

(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-a [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-a p 5 3 4 6)))))

(testing "proxy interface with multiarity and variadic fns"
(let [p (proxy [ITestProxyMultiVariadic] []
(multi-a
([] 0)
([atm]
(swap! atm inc)
@atm)
([one two three & more] [one two three more])))
atm (atom 9)]
(is (= 0 (.multi-a p)))
(is (= 10 (.multi-a p atm)))
(is (= [9 8 7 nil] (.multi-a p 9 8 7)))
(is (= [9 8 7 '(3 4)] (.multi-a p 9 8 7 3 4)))

(is (thrown? basilisp.lang.runtime/RuntimeException (.multi-a p 9 8)))))

(testing "proxy interfaces with simple fn and multiarity"
(let [p (proxy [ITestProxySingleArg ITestProxyMultiVariadic] []
(arg-simple [arg] arg)
(multi-a
([] 0)
([one] one)
([one two three & more] [one two three more])))]
(is (= 3 (.arg-simple p 3)))
(is (= 0 (.multi-a p)))
(is (= 5 (.multi-a p 5)))
(is (= [9 8 7 '(3 4)] (.multi-a 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))))))
Loading