Modify multimethods to use dispatching function
This commit is contained in:
Tuukka Turto
parent
a0251a25ed
commit
0ef9e9ef3b
@ -4,20 +4,75 @@ defmulti
|
||||
|
||||
.. versionadded:: 0.10.0
|
||||
|
||||
``defmulti`` lets you arity-overload a function by the given number of
|
||||
args and/or kwargs. Inspired by Clojure's take on ``defn``.
|
||||
``defmulti``, ``defmethod`` and ``default-method`` lets you define
|
||||
multimethods where a dispatching function is used to select between different
|
||||
implementations of the function. Inspired by Clojure's multimethod and based
|
||||
on the code by `Adam Bard`_.
|
||||
|
||||
.. code-block:: clj
|
||||
|
||||
=> (require hy.contrib.multi)
|
||||
=> (defmulti fun
|
||||
... ([a] "a")
|
||||
... ([a b] "a b")
|
||||
... ([a b c] "a b c"))
|
||||
=> (fun 1)
|
||||
"a"
|
||||
=> (fun 1 2)
|
||||
"a b"
|
||||
=> (fun 1 2 3)
|
||||
"a b c"
|
||||
=> (defmulti area [shape]
|
||||
... "calculate area of a shape"
|
||||
... (:type shape))
|
||||
|
||||
=> (defmethod area "square" [square]
|
||||
... (* (:width square)
|
||||
... (:height square)))
|
||||
|
||||
=> (defmethod area "circle" [circle]
|
||||
... (* (** (:radius circle) 2)
|
||||
... 3.14))
|
||||
|
||||
=> (default-method area [shape]
|
||||
... 0)
|
||||
|
||||
=> (area {:type "circle" :radius 0.5})
|
||||
0.785
|
||||
|
||||
=> (area {:type "square" :width 2 :height 2})
|
||||
4
|
||||
|
||||
=> (area {:type "non-euclid rhomboid"})
|
||||
0
|
||||
|
||||
``defmulti`` is used to define the initial multimethod with name, signature
|
||||
and code that selects between different implementations. In the example,
|
||||
multimethod expects a single input that is type of dictionary and contains
|
||||
at least key :type. The value that corresponds to this key is returned and
|
||||
is used to selected between different implementations.
|
||||
|
||||
``defmethod`` defines a possible implementation for multimethod. It works
|
||||
otherwise in the same way as ``defn``, but has an extra parameters
|
||||
for specifying multimethod and which calls are routed to this specific
|
||||
implementation. In the example, shapes with "square" as :type are routed to
|
||||
first function and shapes with "circle" as :type are routed to second
|
||||
function.
|
||||
|
||||
``default-method`` specifies default implementation for multimethod that is
|
||||
called when no other implementation matches.
|
||||
|
||||
Interfaces of multimethod and different implementation don't have to be
|
||||
exactly identical, as long as they're compatible enough. In practice this
|
||||
means that multimethod should accept the broadest range of parameters and
|
||||
different implementations can narrow them down.
|
||||
|
||||
.. code-block:: clj
|
||||
|
||||
=> (require hy.contrib.multi)
|
||||
=> (defmulti fun [&rest args]
|
||||
... (len args))
|
||||
|
||||
=> (defmethod fun 1 [a]
|
||||
... a)
|
||||
|
||||
=> (defmethod fun 2 [a b]
|
||||
... (+ a b))
|
||||
|
||||
=> (fun 1)
|
||||
1
|
||||
|
||||
=> (fun 1 2)
|
||||
3
|
||||
|
||||
.. _Adam Bard: https://adambard.com/blog/implementing-multimethods-in-python/
|
||||
|
||||
@ -1,50 +0,0 @@
|
||||
# -*- encoding: utf-8 -*-
|
||||
#
|
||||
# Decorator for defmulti
|
||||
#
|
||||
# Copyright (c) 2014 Morten Linderud <mcfoxax@gmail.com>
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a
|
||||
# copy of this software and associated documentation files (the "Software"),
|
||||
# to deal in the Software without restriction, including without limitation
|
||||
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
||||
# and/or sell copies of the Software, and to permit persons to whom the
|
||||
# Software is furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||||
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
# DEALINGS IN THE SOFTWARE.
|
||||
|
||||
from collections import defaultdict
|
||||
|
||||
|
||||
class MultiDispatch(object):
|
||||
_fns = defaultdict(dict)
|
||||
|
||||
def __init__(self, fn):
|
||||
self.fn = fn
|
||||
self.__doc__ = fn.__doc__
|
||||
if fn.__name__ not in self._fns[fn.__module__].keys():
|
||||
self._fns[fn.__module__][fn.__name__] = {}
|
||||
values = fn.__code__.co_varnames
|
||||
self._fns[fn.__module__][fn.__name__][values] = fn
|
||||
|
||||
def is_fn(self, v, args, kwargs):
|
||||
"""Compare the given (checked fn) too the called fn"""
|
||||
com = list(args) + list(kwargs.keys())
|
||||
if len(com) == len(v):
|
||||
return all([kw in com for kw in kwargs.keys()])
|
||||
return False
|
||||
|
||||
def __call__(self, *args, **kwargs):
|
||||
for i, fn in self._fns[self.fn.__module__][self.fn.__name__].items():
|
||||
if self.is_fn(i, args, kwargs):
|
||||
return fn(*args, **kwargs)
|
||||
raise TypeError("No matching functions with this signature!")
|
||||
@ -1,5 +1,6 @@
|
||||
;; Hy Arity-overloading
|
||||
;; Copyright (c) 2014 Morten Linderud <mcfoxax@gmail.com>
|
||||
;; Copyright (c) 2016 Tuukka Turto <tuukka.turto@oktaeder.net>
|
||||
|
||||
;; Permission is hereby granted, free of charge, to any person obtaining a
|
||||
;; copy of this software and associated documentation files (the "Software"),
|
||||
@ -19,23 +20,37 @@
|
||||
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;; DEALINGS IN THE SOFTWARE.
|
||||
|
||||
(import [collections [defaultdict]])
|
||||
(import [hy.models.string [HyString]])
|
||||
(defn multi-decorator [dispatch-fn]
|
||||
(setv inner (fn [&rest args &kwargs kwargs]
|
||||
(setv dispatch-key (apply dispatch-fn args kwargs))
|
||||
(if (in dispatch-key inner.--multi--)
|
||||
(apply (get inner.--multi-- dispatch-key) args kwargs)
|
||||
(apply inner.--multi-default-- args kwargs))))
|
||||
(setv inner.--multi-- {})
|
||||
(setv inner.--doc-- dispatch-fn.--doc--)
|
||||
(setv inner.--multi-default-- (fn [&rest args &kwargs kwargs] nil))
|
||||
inner)
|
||||
|
||||
|
||||
(defmacro defmulti [name &rest bodies]
|
||||
(def comment (HyString))
|
||||
(if (= (type (first bodies)) HyString)
|
||||
(do (def comment (car bodies))
|
||||
(def bodies (cdr bodies))))
|
||||
|
||||
(def ret `(do))
|
||||
|
||||
(.append ret '(import [hy.contrib.dispatch [MultiDispatch]]))
|
||||
(defn method-decorator [dispatch-fn &optional [dispatch-key nil]]
|
||||
(setv apply-decorator
|
||||
(fn [func]
|
||||
(if (is dispatch-key nil)
|
||||
(setv dispatch-fn.--multi-default-- func)
|
||||
(assoc dispatch-fn.--multi-- dispatch-key func))
|
||||
dispatch-fn))
|
||||
apply-decorator)
|
||||
|
||||
(for [body bodies]
|
||||
(def let-binds (car body))
|
||||
(def body (cdr body))
|
||||
(.append ret
|
||||
`(with-decorator MultiDispatch (defn ~name ~let-binds ~comment ~@body))))
|
||||
ret)
|
||||
(defmacro defmulti [name params &rest body]
|
||||
`(do (import [hy.contrib.multi [multi-decorator]])
|
||||
(with-decorator multi-decorator
|
||||
(defn ~name ~params ~@body))))
|
||||
|
||||
(defmacro defmethod [name multi-key params &rest body]
|
||||
`(do (import [hy.contrib.multi [method-decorator]])
|
||||
(with-decorator (method-decorator ~name ~multi-key)
|
||||
(defn ~name ~params ~@body))))
|
||||
|
||||
(defmacro default-method [name params &rest body]
|
||||
`(do (import [hy.contrib.multi [method-decorator]])
|
||||
(with-decorator (method-decorator ~name)
|
||||
(defn ~name ~params ~@body))))
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
;; Copyright (c) 2014 Morten Linderud <mcfoxax@gmail.com>
|
||||
;; Copyright (c) 2016 Tuukka Turto <tuukka.turto@oktaeder.net>
|
||||
|
||||
;; Permission is hereby granted, free of charge, to any person obtaining a
|
||||
;; copy of this software and associated documentation files (the "Software"),
|
||||
@ -21,13 +22,22 @@
|
||||
(require hy.contrib.multi)
|
||||
|
||||
|
||||
(defn test-basic-multi []
|
||||
"NATIVE: Test a basic defmulti"
|
||||
(defmulti fun
|
||||
([] "Hello!")
|
||||
([a] a)
|
||||
([a b] "a b")
|
||||
([a b c] "a b c"))
|
||||
(defn test-different-signatures []
|
||||
"NATIVE: Test multimethods with different signatures"
|
||||
(defmulti fun [&rest args]
|
||||
(len args))
|
||||
|
||||
(defmethod fun 0 []
|
||||
"Hello!")
|
||||
|
||||
(defmethod fun 1 [a]
|
||||
a)
|
||||
|
||||
(defmethod fun 2 [a b]
|
||||
"a b")
|
||||
|
||||
(defmethod fun 3 [a b c]
|
||||
"a b c")
|
||||
|
||||
(assert (= (fun) "Hello!"))
|
||||
(assert (= (fun "a") "a"))
|
||||
@ -35,23 +45,49 @@
|
||||
(assert (= (fun "a" "b" "c") "a b c")))
|
||||
|
||||
|
||||
(defn test-kw-args []
|
||||
"NATIVE: Test if kwargs are handled correctly"
|
||||
(defmulti fun
|
||||
([a] a)
|
||||
([&optional [a "nop"] [b "p"]] (+ a b)))
|
||||
|
||||
(assert (= (fun 1) 1))
|
||||
(assert (= (apply fun [] {"a" "t"}) "t"))
|
||||
(assert (= (apply fun ["hello "] {"b" "world"}) "hello world"))
|
||||
(assert (= (apply fun [] {"a" "hello " "b" "world"}) "hello world")))
|
||||
(defn test-basic-dispatch []
|
||||
"NATIVE: Test basic dispatch"
|
||||
(defmulti area [shape]
|
||||
(:type shape))
|
||||
|
||||
(defmethod area "square" [square]
|
||||
(* (:width square)
|
||||
(:height square)))
|
||||
|
||||
(defmethod area "circle" [circle]
|
||||
(* (** (:radius circle) 2)
|
||||
3.14))
|
||||
|
||||
(default-method area [shape]
|
||||
0)
|
||||
|
||||
(assert (< 0.784 (area {:type "circle" :radius 0.5}) 0.786))
|
||||
(assert (= (area {:type "square" :width 2 :height 2})) 4)
|
||||
(assert (= (area {:type "non-euclid rhomboid"}) 0)))
|
||||
|
||||
(defn test-docs []
|
||||
"NATIVE: Test if docs are properly handled"
|
||||
(defmulti fun
|
||||
(defmulti fun [a b]
|
||||
"docs"
|
||||
([a] (print a))
|
||||
([a b] (print b)))
|
||||
a)
|
||||
|
||||
(defmethod fun "foo" [a b]
|
||||
"foo was called")
|
||||
|
||||
(defmethod fun "bar" [a b]
|
||||
"bar was called")
|
||||
|
||||
(assert (= fun.--doc-- "docs")))
|
||||
|
||||
(defn test-kwargs-handling []
|
||||
"NATIVE: Test handling of kwargs with multimethods"
|
||||
(defmulti fun [&kwargs kwargs]
|
||||
(get kwargs "type"))
|
||||
|
||||
(defmethod fun "foo" [&kwargs kwargs]
|
||||
"foo was called")
|
||||
|
||||
(defmethod fun "bar" [&kwargs kwargs]
|
||||
"bar was called")
|
||||
|
||||
(assert (= (fun :type "foo" :extra "extra") "foo was called")))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user