Merge branch 'kwapply-macro' of https://github.com/Willyfrog/hy into Willyfrog-kwapply-macro

Conflicts:
	hy/core/language.hy
	hy/core/macros.hy
	tests/native_tests/language.hy
This commit is contained in:
Nicolas Dandrimont 2013-12-22 19:58:34 +01:00
commit ec2b5fb7ad
5 changed files with 89 additions and 11 deletions

View File

@ -1273,19 +1273,33 @@ class HyASTCompiler(object):
return ret
@builds("kwapply")
@checkargs(2)
def compile_kwapply_expression(self, expr):
expr.pop(0) # kwapply
@builds("apply")
@checkargs(min=1, max=3)
def compile_apply_expression(self, expr):
expr.pop(0) # apply
call = self.compile(expr.pop(0))
kwargs = self.compile(expr.pop(0))
call = ast.Call(func=call.expr,
args=[],
keywords=[],
starargs=None,
kwargs=None,
lineno=expr.start_line,
col_offset=expr.start_column)
ret = call
if type(call.expr) != ast.Call:
raise HyTypeError(expr, "kwapplying a non-call")
if expr:
stargs = expr.pop(0)
if stargs is not None:
stargs = self.compile(stargs)
call.starargs = stargs.force_expr
ret = stargs + ret
call.expr.kwargs = kwargs.force_expr
if expr:
kwargs = self.compile(expr.pop(0))
call.kwargs = kwargs.force_expr
ret = kwargs + ret
return kwargs + call
return ret
@builds("not")
@builds("~")

View File

@ -250,7 +250,7 @@
(_numeric_check n)
(= n 0))
(def *exports* '[cycle dec distinct drop drop-while empty? even? filter flatten
(def *exports* '[cycle dec distinct drop drop-while empty? even? filter flatten
float? gensym
inc instance? integer integer? iterable? iterate iterator? neg?
none? nth numeric? odd? pos? remove repeat repeatedly second

View File

@ -126,3 +126,21 @@
`(defmacro ~name [~@args]
(let ~(HyList (map (fn [x] `[~x (gensym (slice '~x 2))]) syms))
~@body))))
(defmacro kwapply [call kwargs]
"Use a dictionary as keyword arguments"
(let [[-fun (car call)]
[-args (cdr call)]
[-okwargs `[(list (.items ~kwargs))]]]
(while (= -fun "kwapply") ;; join any further kw
(if (not (= (len -args) 2))
(macro-error
call
(.format "Trying to call nested kwapply with {0} args instead of 2"
(len -args))))
(.insert -okwargs 0 `(list (.items ~(car (cdr -args)))))
(setv -fun (car (car -args)))
(setv -args (cdr (car -args))))
`(apply ~-fun [~@-args] (dict (sum ~-okwargs [])))))

View File

@ -0,0 +1,27 @@
# Copyright (c) 2013 Nicolas Dandrimont <nicolas.dandrimont@crans.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.
from .test_ast import can_compile, cant_compile
def test_macro_nested_kwapply():
"Make sure nested kwapply compile correctly"
can_compile("(kwapply (kwapply (foo) bar) baz)")
cant_compile("(kwapply (kwapply (foo)) bar)")

View File

@ -152,8 +152,27 @@
(assert (= (kwapply (kwtest) {"one" "two"}) {"one" "two"}))
(setv mydict {"one" "three"})
(assert (= (kwapply (kwtest) mydict) mydict))
(assert (= (kwapply (kwtest) ((fn [] {"one" "two"}))) {"one" "two"})))
(assert (= (kwapply (kwtest) ((fn [] {"one" "two"}))) {"one" "two"}))
(assert (= (kwapply
(kwapply
(kwapply
(kwapply
(kwapply (kwtest) {"x" 4})
mydict)
{"x" 8})
{"x" (- 3 2) "y" 2})
{"y" 5 "z" 3})
{"x" 1 "y" 5 "z" 3 "one" "three"})))
(defn test-apply []
"NATIVE: test working with args and functions"
(defn sumit [a b c] (+ a b c))
(assert (= (apply sumit [1] {"b" 2 "c" 3}) 6))
(assert (= (apply sumit [1 2 2]) 5))
(assert (= (apply sumit [] {"a" 1 "b" 1 "c" 2}) 4))
(assert (= (apply sumit ((fn [] [1 1])) {"c" 1}) 3))
(defn noargs [] [1 2 3])
(assert (= (apply noargs) [1 2 3])))
(defn test-dotted []
"NATIVE: test dotted invocation"