Merge branch 'master' into pr/487

This commit is contained in:
Paul Tagliamonte 2014-02-15 11:55:27 -05:00
commit b4b8fb44cf
14 changed files with 345 additions and 6 deletions

View File

@ -39,3 +39,5 @@
* Fatih Kadir Akın <fka@fatihak.in>
* Jack Hooper <contact.jhooper@gmail.com>
* Brian McKenna <brian@brianmckenna.org>
* Richard Parsons <richard.lee.parsons@gmail.com>
* han semaj <sangho.nah@gmail.com>

View File

@ -31,7 +31,7 @@ Why?
Well, I wrote Hy to help people realize one thing about Python:
It's really goddamn awesome.
It's really awesome.
Oh, and lisps are neat.

View File

@ -9,3 +9,4 @@ Contents:
anaphoric
loop
multi

23
docs/contrib/multi.rst Normal file
View File

@ -0,0 +1,23 @@
========
defmulti
========
.. versionadded:: 0.9.13
`defmulti` lets you arity-overload a function by the given number of
args and/or kwargs. Inspired by clojures take on `defn`.
.. code-block:: clj
=> (require hy.contrib.multi)
=> (defmulti fun
... ([a] a)
... ([a b] "a b")
... ([a b c] "a b c"))
=> (fun 1 2 3)
'a b c'
=> (fun a b)
"a b"
=> (fun 1)
1

View File

@ -762,6 +762,9 @@ of import you can use.
[os.path [exists isdir isfile]]
[sys :as systest])
;; Import all module functions into current namespace
(import [sys [*]])
kwapply
-------

View File

@ -138,6 +138,32 @@ Return True if ``coll`` is empty, i.e. ``(= 0 (len coll))``.
False
.. _every?-fn:
every?
------
.. versionadded:: 0.9.13
Usage: ``(every? pred coll)``
Return True if ``(pred x)`` is logical true for every ``x`` in ``coll``, otherwise False. Return True if ``coll`` is empty.
.. code-block:: clojure
=> (every? even? [2 4 6])
True
=> (every? even? [1 3 5])
False
=> (every? even? [2 4 5])
False
=> (every? even? [])
True
.. _float?-fn:
float?
@ -570,6 +596,32 @@ Return the second member of ``coll``. Equivalent to
1
.. _some-fn:
some
----
.. versionadded:: 0.9.13
Usage: ``(some pred coll)``
Return True if ``(pred x)`` is logical true for any ``x`` in ``coll``, otherwise False. Return False if ``coll`` is empty.
.. code-block:: clojure
=> (some even? [2 4 6])
True
=> (some even? [1 3 5])
False
=> (some even? [1 3 6])
True
=> (some even? [])
False
.. _string?-fn:
string?

View File

@ -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!")

41
hy/contrib/multi.hy Normal file
View File

@ -0,0 +1,41 @@
;; Hy Arity-overloading
;; 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.
(import [collections [defaultdict]])
(import [hy.models.string [HyString]])
(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]]))
(for [body bodies]
(def let-binds (car body))
(def body (cdr body))
(.append ret
`(with-decorator MultiDispatch (defn ~name ~let-binds ~comment ~@body))))
ret)

58
hy/contrib/walk.hy Normal file
View File

@ -0,0 +1,58 @@
;;; Hy AST walker
;;
;; Copyright (c) 2014 Gergely Nagy <algernon@madhouse-project.org>
;;
;; 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.
(import [hy [HyExpression HyDict]]
[functools [partial]])
(defn walk [inner outer form]
"Traverses form, an arbitrary data structure. Applies inner to each
element of form, building up a data structure of the same type.
Applies outer to the result."
(cond
[(instance? HyExpression form)
(outer (HyExpression (map inner form)))]
[(instance? HyDict form)
(HyDict (outer (HyExpression (map inner form))))]
[(cons? form)
(outer (cons (inner (first form))
(inner (rest form))))]
[(instance? list form)
((type form) (outer (HyExpression (map inner form))))]
[true (outer form)]))
(defn postwalk [f form]
"Performs depth-first, post-order traversal of form. Calls f on each
sub-form, uses f's return value in place of the original."
(walk (partial postwalk f) f form))
(defn prewalk [f form]
"Performs depth-first, pre-order traversal of form. Calls f on each
sub-form, uses f's return value in place of the original."
(walk (partial prewalk f) identity (f form)))
(defn macroexpand-all [form]
"Recursively performs all possible macroexpansions in form."
(prewalk (fn [x]
(if (instance? HyExpression x)
(macroexpand x)
x))
form))

View File

@ -75,12 +75,12 @@
(defn distinct [coll]
"Return a generator from the original collection with duplicates
removed"
(let [[seen []] [citer (iter coll)]]
(let [[seen (set)] [citer (iter coll)]]
(for* [val citer]
(if (not_in val seen)
(do
(yield val)
(.append seen val))))))
(.add seen val))))))
(defn drop [count coll]
"Drop `count` elements from `coll` and yield back the rest"
@ -108,6 +108,10 @@
(_numeric-check n)
(= (% n 2) 0))
(defn every? [pred coll]
"Return true if (pred x) is logical true for every x in coll, else false"
(all (map pred coll)))
(defn fake-source-positions [tree]
"Fake the source positions for a given tree"
(if (and (iterable? tree) (not (string? tree)))
@ -294,6 +298,10 @@
"Return second item from `coll`"
(get coll 1))
(defn some [pred coll]
"Return true if (pred x) is logical true for any x in coll, else false"
(any (map pred coll)))
(defn string [x]
"Cast x as current string implementation"
(if-python2
@ -338,9 +346,9 @@
(= n 0))
(def *exports* '[calling-module-name coll? cons cons? cycle dec distinct
disassemble drop drop-while empty? even? first filter
disassemble drop drop-while empty? even? every? first filter
flatten float? gensym identity inc instance? integer
integer? integer-char? iterable? iterate iterator?
list* macroexpand macroexpand-1 neg? nil? none? nth
numeric? odd? pos? remove repeat repeatedly rest second
string string? take take-nth take-while zero?])
some string string? take take-nth take-while zero?])

View File

@ -17,3 +17,5 @@ from .native_tests.with_test import * # noqa
from .native_tests.contrib.anaphoric import * # noqa
from .native_tests.contrib.loop import * # noqa
from .native_tests.contrib.meth import * # noqa
from .native_tests.contrib.walk import * # noqa
from .native_tests.contrib.multi import * # noqa

View File

@ -0,0 +1,57 @@
;; 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.
(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"))
(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"
(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-docs []
"NATIVE: Test if docs are properly handled"
(defmulti fun
"docs"
([a] (print a))
([a b] (print b)))
(assert (= fun.--doc-- "docs")))

View File

@ -0,0 +1,29 @@
(import [hy.contrib.walk [*]])
(def walk-form '(print {"foo" "bar"
"array" [1 2 3 [4]]
"something" (+ 1 2 3 4)
"cons!" (cons 1 2)
"quoted?" '(foo)}))
(defn collector [acc x]
(.append acc x)
nil)
(defn test-walk-identity []
(assert (= (walk identity identity walk-form)
walk-form)))
(defn test-walk []
(let [[acc '()]]
(assert (= (walk (partial collector acc) identity walk-form)
[nil nil]))
(assert (= acc walk-form)))
(let [[acc []]]
(assert (= (walk identity (partial collector acc) walk-form)
nil))
(assert (= acc [walk-form]))))
(defn test-macroexpand-all []
(assert (= (macroexpand-all '(with [a b c] (for [d c] foo)))
'(with* [a] (with* [b] (with* [c] (do (for* [d c] foo))))))))

View File

@ -123,6 +123,13 @@
(try (even? None)
(catch [e [TypeError]] (assert (in "not a number" (str e))))))
(defn test-every? []
"NATIVE: testing the every? function"
(assert-true (every? even? [2 4 6]))
(assert-false (every? even? [1 3 5]))
(assert-false (every? even? [2 4 5]))
(assert-true (every? even? [])))
(defn test-filter []
"NATIVE: testing the filter function"
(setv res (list (filter pos? [ 1 2 3 -4 5])))
@ -399,6 +406,13 @@
(assert-equal 2 (second [1 2]))
(assert-equal 3 (second [2 3 4])))
(defn test-some []
"NATIVE: testing the some function"
(assert-true (some even? [2 4 6]))
(assert-false (some even? [1 3 5]))
(assert-true (some even? [1 3 6]))
(assert-false (some even? [])))
(defn test-string? []
"NATIVE: testing string?"
(assert-true (string? "foo"))
@ -456,4 +470,3 @@
(assert-equal res [None None])
(setv res (list (take-while (fn [x] (not (none? x))) [1 2 3 4 None 5 6 None 7])))
(assert-equal res [1 2 3 4]))