Add arity-overloaded defn

Old defmulti has been renamed to defn and extended to detect when it is
used to define regular function and when a arity-overloaded one.

docs/contrib/multi.rst

@@ -2,6 +2,38 @@
 defmulti
 ========
 
+defn
+----
+.. versionadded:: 0.10.0
+
+``defn`` lets you arity-overload a function by the given number of
+args and/or kwargs. This version of ``defn`` works with regular syntax and
+with the arity overloaded one. Inspired by Clojures take on ``defn``.
+
+.. code-block:: clj
+
+    => (require [hy.contrib.multi [defn]])
+    => (defn 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"
+
+    => (defn add [a b] 
+    ...  (+ a b))
+    => (add 1 2)
+    3
+
+
+defmulti
+--------
+
 .. versionadded:: 0.12.0
 
 ``defmulti``, ``defmethod`` and ``default-method`` lets you define

hy/contrib/dispatch/__init__.py

@@ -0,0 +1,50 @@
+# -*- 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!")

hy/contrib/multi.hy

@@ -20,6 +20,11 @@
 ;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 ;; DEALINGS IN THE SOFTWARE.
 
+(import [collections [defaultdict]]
+        [hy.models.expression [HyExpression]]
+        [hy.models.list [HyList]]
+        [hy.models.string [HyString]])
+
 (defn multi-decorator [dispatch-fn]
   (setv inner (fn [&rest args &kwargs kwargs]
                 (setv dispatch-key (apply dispatch-fn args kwargs))
@@ -54,3 +59,28 @@
   `(do (import [hy.contrib.multi [method-decorator]])
        (with-decorator (method-decorator ~name)
          (defn ~name ~params ~@body))))
+
+(defmacro defn [name &rest bodies]
+  (def arity-overloaded? (fn [bodies]
+                           (if (isinstance (first bodies) HyString)
+                             (arity-overloaded? (rest bodies))
+                             (isinstance (first bodies) HyExpression))))
+
+  (if (arity-overloaded? bodies)
+    (do
+     (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]]))
+     (for [body bodies]
+       (def let-binds (car body))
+       (def body (cdr body))
+       (.append ret 
+                `(with-decorator MultiDispatch (defn ~name ~let-binds ~comment ~@body))))
+     ret)
+    (do
+     (setv lambda-list (first bodies))
+     (setv body (rest bodies))
+     `(setv ~name (fn ~lambda-list ~@body)))))

tests/native_tests/contrib/multi.hy

@@ -19,7 +19,7 @@
 ;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 ;; DEALINGS IN THE SOFTWARE.
 
-(require [hy.contrib.multi [defmulti defmethod default-method]])
+(require [hy.contrib.multi [defmulti defmethod default-method defn]])
 
 (defn test-different-signatures []
   "NATIVE: Test multimethods with different signatures"
@@ -90,3 +90,38 @@
     "bar was called")
 
   (assert (= (fun :type "foo" :extra "extra") "foo was called")))
+
+(defn test-basic-multi []
+  "NATIVE: Test a basic arity overloaded defn"
+  (defn fun
+    ([] "Hello!")
+    ([a] a)
+    ([a b] "a b")
+    ([a b c] "a b c"))
+
+  (assert (= (fun) "Hello!"))
+  (assert (= (fun "a") "a"))
+  (assert (= (fun "a" "b") "a b"))
+  (assert (= (fun "a" "b" "c") "a b c")))
+
+
+(defn test-kw-args []
+  "NATIVE: Test if kwargs are handled correctly for arity overloading"
+  (defn 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-docs []
+  "NATIVE: Test if docs are properly handled for arity overloading"
+  (defn fun
+    "docs"
+    ([a] (print a))
+    ([a b] (print b)))
+  
+  (assert (= fun.--doc-- "docs")))