Merge branch 'master' into letmacro

This commit is contained in:
Ryan Gonzalez 2017-11-01 09:39:18 -05:00 committed by GitHub
commit e0e664c030
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
17 changed files with 496 additions and 257 deletions

View File

@ -84,3 +84,4 @@
* Andrew Silva <asilva@law.harvard.edu> * Andrew Silva <asilva@law.harvard.edu>
* Zaheer Soebhan <z.soebhan@gmail.com> * Zaheer Soebhan <z.soebhan@gmail.com>
* Rob Day <rkd@rkd.me.uk> * Rob Day <rkd@rkd.me.uk>
* Eric Kaschalk <ekaschalk@gmail.com>

6
NEWS
View File

@ -22,6 +22,9 @@ Changes from 0.13.0
* support EDN `#_` syntax to discard the next term * support EDN `#_` syntax to discard the next term
* `return` has been implemented as a special form * `return` has been implemented as a special form
* `while` loops may now contain an `else` clause, like `for` loops * `while` loops may now contain an `else` clause, like `for` loops
* `xi` from `hy.extra.anaphoric` is now the `#%` tag macro
* `#%` works on any expression and has a new `&kwargs` parameter `%**`
* new `doc` macro and `#doc` tag macro
[ Bug Fixes ] [ Bug Fixes ]
* Numeric literals are no longer parsed as symbols when followed by a dot * Numeric literals are no longer parsed as symbols when followed by a dot
@ -39,11 +42,14 @@ Changes from 0.13.0
* Fixed a crash when `with` suppresses an exception. `with` now returns * Fixed a crash when `with` suppresses an exception. `with` now returns
`None` in this case. `None` in this case.
* Fixed a crash when --repl-output-fn raises an exception * Fixed a crash when --repl-output-fn raises an exception
* Fixed a crash when HyTypeError was raised with objects that had no
source position
* `assoc` now evaluates its arguments only once each * `assoc` now evaluates its arguments only once each
* `break` and `continue` now raise an error when given arguments * `break` and `continue` now raise an error when given arguments
instead of silently ignoring them instead of silently ignoring them
* Multiple expressions are now allowed in the else clause of * Multiple expressions are now allowed in the else clause of
a for loop a for loop
* `else` clauses in `for` and `while` are recognized more reliably
* Argument destructuring no longer interferes with function docstrings. * Argument destructuring no longer interferes with function docstrings.
[ Misc. Improvements ] [ Misc. Improvements ]

View File

@ -229,21 +229,37 @@ Returns a function which applies several forms in series from left to right. The
=> (op 2) => (op 2)
9 9
.. _xi .. _#%
xi #%
== ==
Usage ``(xi body ...)`` Usage ``#% expr``
Returns a function with parameters implicitly determined by the presence in the body of xi parameters. An xi symbol designates the ith parameter (1-based, e.g. x1, x2, x3, etc.), or all remaining parameters for xi itself. This is not a replacement for fn. The xi forms cannot be nested. Makes an expression into a function with an implicit ``%`` parameter list.
This is similar to Clojure's anonymous function literals (``#()``). A ``%i`` symbol designates the (1-based) *i* th parameter (such as ``%3``).
Only the maximum ``%i`` determines the number of ``%i`` parameters--the
others need not appear in the expression.
``%*`` and ``%**`` name the ``&rest`` and ``&kwargs`` parameters, respectively.
.. code-block:: hy .. code-block:: hy
=> ((xi identity [x1 x5 [x2 x3] xi x4]) 1 2 3 4 5 6 7 8) => (#%[%1 %6 42 [%2 %3] %* %4] 1 2 3 4 555 6 7 8)
[1, 5, [2, 3,] (6, 7, 8), 4] [1, 6, 42, [2, 3], (7, 8), 4]
=> (def add-10 (xi + 10 x1)) => (#% %** :foo 2)
=> (add-10 6) {"foo": 2}
16
When used on an s-expression,
``#%`` is similar to Clojure's anonymous function literals--``#()``.
.. code-block:: hy
=> (setv add-10 #%(+ 10 %1))
=> (add-10 6)
16
``#%`` determines the parameter list by the presence of a ``%*`` or ``%**``
symbol and by the maximum ``%i`` symbol found *anywhere* in the expression,
so nesting of ``#%`` forms is not recommended.

View File

@ -501,6 +501,41 @@ Some example usage:
``do`` can accept any number of arguments, from 1 to n. ``do`` can accept any number of arguments, from 1 to n.
doc / #doc
----------
Documentation macro and tag macro.
Gets help for macros or tag macros, respectively.
.. code-block:: clj
=> (doc doc)
Help on function (doc) in module hy.core.macros:
(doc)(symbol)
macro documentation
Gets help for a macro function available in this module.
Use ``require`` to make other macros available.
Use ``#doc foo`` instead for help with tag macro ``#foo``.
Use ``(help foo)`` instead for help with runtime objects.
=> (doc comment)
Help on function (comment) in module hy.core.macros:
(comment)(*body)
Ignores body and always expands to None
=> #doc doc
Help on function #doc in module hy.core.macros:
#doc(symbol)
tag macro documentation
Gets help for a tag macro function available in this module.
def / setv def / setv
---------- ----------

View File

@ -11,7 +11,7 @@ import sys
import os import os
import importlib import importlib
import astor.codegen import astor.code_gen
import hy import hy
@ -413,17 +413,17 @@ def hy2py_main():
else pretty_error(import_buffer_to_ast, stdin_text, module_name)) else pretty_error(import_buffer_to_ast, stdin_text, module_name))
if options.with_ast: if options.with_ast:
if PY3 and platform.system() == "Windows": if PY3 and platform.system() == "Windows":
_print_for_windows(astor.dump(_ast)) _print_for_windows(astor.dump_tree(_ast))
else: else:
print(astor.dump(_ast)) print(astor.dump_tree(_ast))
print() print()
print() print()
if not options.without_python: if not options.without_python:
if PY3 and platform.system() == "Windows": if PY3 and platform.system() == "Windows":
_print_for_windows(astor.codegen.to_source(_ast)) _print_for_windows(astor.code_gen.to_source(_ast))
else: else:
print(astor.codegen.to_source(_ast)) print(astor.code_gen.to_source(_ast))
parser.exit(0) parser.exit(0)

View File

@ -27,6 +27,7 @@ import copy
import inspect import inspect
from collections import defaultdict from collections import defaultdict
from cmath import isnan
if PY3: if PY3:
import builtins import builtins
@ -376,6 +377,14 @@ def is_unpack(kind, x):
and x[0] == "unpack_" + kind) and x[0] == "unpack_" + kind)
def ends_with_else(expr):
return (expr and
isinstance(expr[-1], HyExpression) and
expr[-1] and
isinstance(expr[-1][0], HySymbol) and
expr[-1][0] == HySymbol("else"))
class HyASTCompiler(object): class HyASTCompiler(object):
def __init__(self, module_name): def __init__(self, module_name):
@ -1827,7 +1836,7 @@ class HyASTCompiler(object):
orel = Result() orel = Result()
# (for* [] body (else …)) # (for* [] body (else …))
if expression and expression[-1][0] == HySymbol("else"): if ends_with_else(expression):
else_expr = expression.pop() else_expr = expression.pop()
for else_body in else_expr[1:]: for else_body in else_expr[1:]:
orel += self.compile(else_body) orel += self.compile(else_body)
@ -1856,7 +1865,7 @@ class HyASTCompiler(object):
orel = Result() orel = Result()
# (while cond body (else …)) # (while cond body (else …))
if expr and expr[-1][0] == HySymbol("else"): if ends_with_else(expr):
else_expr = expr.pop() else_expr = expr.pop()
for else_body in else_expr[1:]: for else_body in else_expr[1:]:
orel += self.compile(else_body) orel += self.compile(else_body)
@ -2094,11 +2103,27 @@ class HyASTCompiler(object):
raise HyTypeError(cons, "Can't compile a top-level cons cell") raise HyTypeError(cons, "Can't compile a top-level cons cell")
@builds(HyInteger, HyFloat, HyComplex) @builds(HyInteger, HyFloat, HyComplex)
def compile_numeric_literal(self, number, building): def compile_numeric_literal(self, x, building):
f = {HyInteger: long_type, f = {HyInteger: long_type,
HyFloat: float, HyFloat: float,
HyComplex: complex}[building] HyComplex: complex}[building]
return asty.Num(number, n=f(number)) # Work around https://github.com/berkerpeksag/astor/issues/85 :
# astor can't generate Num nodes with NaN, so we have
# to build an expression that evaluates to NaN.
def nn(number):
return asty.Num(x, n=number)
if isnan(x):
def nan(): return asty.BinOp(
x, left=nn(1e900), op=ast.Sub(), right=nn(1e900))
if f is complex:
return asty.Call(
x,
func=asty.Name(x, id="complex", ctx=ast.Load()),
keywords=[],
args=[nan() if isnan(x.real) else nn(x.real),
nan() if isnan(x.imag) else nn(x.imag)])
return nan()
return nn(f(x))
@builds(HySymbol) @builds(HySymbol)
def compile_symbol(self, symbol): def compile_symbol(self, symbol):

View File

@ -31,7 +31,7 @@
~@body)))))) ~@body))))))
(defmacro if [&rest args] (defmacro if [&rest args]
"if with elif" "Conditionally evaluate alternating test and then expressions."
(setv n (len args)) (setv n (len args))
(if* n (if* n
(if* (= n 1) (if* (= n 1)
@ -58,11 +58,11 @@
(fn ~lambda-list ~@body)))) (fn ~lambda-list ~@body))))
(defmacro macro-error [location reason] (defmacro macro-error [location reason]
"error out properly within a macro" "Error out properly within a macro at `location` giving `reason`."
`(raise (hy.errors.HyMacroExpansionError ~location ~reason))) `(raise (hy.errors.HyMacroExpansionError ~location ~reason)))
(defmacro defn [name lambda-list &rest body] (defmacro defn [name lambda-list &rest body]
"define a function `name` with signature `lambda-list` and body `body`" "Define `name` as a function with `lambda-list` signature and body `body`."
(import hy) (import hy)
(if (not (= (type name) hy.HySymbol)) (if (not (= (type name) hy.HySymbol))
(macro-error name "defn takes a name as first argument")) (macro-error name "defn takes a name as first argument"))

View File

@ -22,15 +22,15 @@
(import [hy.importer [hy-eval :as eval]]) (import [hy.importer [hy-eval :as eval]])
(defn butlast [coll] (defn butlast [coll]
"Returns coll except of last element." "Return an iterator of all but the last item in `coll`."
(drop-last 1 coll)) (drop-last 1 coll))
(defn coll? [coll] (defn coll? [coll]
"Checks whether item is a collection" "Check if `coll` is iterable and not a string."
(and (iterable? coll) (not (string? coll)))) (and (iterable? coll) (not (string? coll))))
(defn comp [&rest fs] (defn comp [&rest fs]
"Function composition" "Return the function from composing the given functions `fs`."
(if (not fs) identity (if (not fs) identity
(= 1 (len fs)) (first fs) (= 1 (len fs)) (first fs)
(do (setv rfs (reversed fs) (do (setv rfs (reversed fs)
@ -43,48 +43,48 @@
res)))) res))))
(defn complement [f] (defn complement [f]
"Create a function that reverses truth value of another function" "Returns a new function that returns the logically inverted result of `f`."
(fn [&rest args &kwargs kwargs] (fn [&rest args &kwargs kwargs]
(not (f #* args #** kwargs)))) (not (f #* args #** kwargs))))
(defn cons [a b] (defn cons [a b]
"Return a fresh cons cell with car = a and cdr = b" "Return a fresh cons cell with car = `a` and cdr = `b`."
(HyCons a b)) (HyCons a b))
(defn cons? [c] (defn cons? [c]
"Check whether c can be used as a cons object" "Check whether `c` is a cons cell."
(instance? HyCons c)) (instance? HyCons c))
(defn constantly [value] (defn constantly [value]
"Create a function that always returns the same value" "Create a new function that always returns `value` regardless of its input."
(fn [&rest args &kwargs kwargs] (fn [&rest args &kwargs kwargs]
value)) value))
(defn keyword? [k] (defn keyword? [k]
"Check whether k is a keyword" "Check whether `k` is a keyword."
(and (instance? (type :foo) k) (and (instance? (type :foo) k)
(.startswith k (get :foo 0)))) (.startswith k (get :foo 0))))
(defn dec [n] (defn dec [n]
"Decrement n by 1" "Decrement `n` by 1."
(- n 1)) (- n 1))
(defn disassemble [tree &optional [codegen False]] (defn disassemble [tree &optional [codegen False]]
"Return the python AST for a quoted Hy tree as a string. "Return the python AST for a quoted Hy `tree` as a string.
If the second argument is true, generate python code instead."
If the second argument `codegen` is true, generate python code instead."
(import astor) (import astor)
(import hy.compiler) (import hy.compiler)
(spoof-positions tree) (spoof-positions tree)
(setv compiled (hy.compiler.hy-compile tree (calling-module-name))) (setv compiled (hy.compiler.hy-compile tree (calling-module-name)))
((if codegen ((if codegen
astor.codegen.to_source astor.code-gen.to-source
astor.dump) astor.dump-tree)
compiled)) compiled))
(defn distinct [coll] (defn distinct [coll]
"Return a generator from the original collection with duplicates "Return a generator from the original collection `coll` with no duplicates."
removed"
(setv seen (set) citer (iter coll)) (setv seen (set) citer (iter coll))
(for* [val citer] (for* [val citer]
(if (not_in val seen) (if (not_in val seen)
@ -121,9 +121,8 @@
(defn exec [$code &optional $globals $locals] (defn exec [$code &optional $globals $locals]
"Execute Python code. "Execute Python code.
The parameter names contain weird characters to discourage calling this The parameter names contain weird characters to discourage calling this
function with keyword arguments, which isn't supported by Python 3's function with keyword arguments, which isn't supported by Python 3's `exec`."
`exec`."
(if (if
(none? $globals) (do (none? $globals) (do
(setv frame (._getframe sys (int 1))) (setv frame (._getframe sys (int 1)))
@ -161,9 +160,9 @@
;; also from itertools, but not in Python2, and without func option until 3.3 ;; also from itertools, but not in Python2, and without func option until 3.3
(defn accumulate [iterable &optional [func operator.add]] (defn accumulate [iterable &optional [func operator.add]]
"accumulate(iterable[, func]) --> accumulate object "Accumulate `func` on `iterable`.
Return series of accumulated sums (or other binary function results)." Return series of accumulated sums (or other binary function results)."
(setv it (iter iterable) (setv it (iter iterable)
total (next it)) total (next it))
(yield total) (yield total)
@ -172,29 +171,29 @@
(yield total))) (yield total)))
(defn drop [count coll] (defn drop [count coll]
"Drop `count` elements from `coll` and yield back the rest" "Drop `count` elements from `coll` and yield back the rest."
(islice coll count None)) (islice coll count None))
(defn drop-last [n coll] (defn drop-last [n coll]
"Return a sequence of all but the last n elements in coll." "Return a sequence of all but the last `n` elements in `coll`."
(setv iters (tee coll)) (setv iters (tee coll))
(map first (zip #* [(get iters 0) (map first (zip #* [(get iters 0)
(drop n (get iters 1))]))) (drop n (get iters 1))])))
(defn empty? [coll] (defn empty? [coll]
"Return True if `coll` is empty" "Check if `coll` is empty."
(= 0 (len coll))) (= 0 (len coll)))
(defn even? [n] (defn even? [n]
"Return true if n is an even number" "Check if `n` is an even number."
(= (% n 2) 0)) (= (% n 2) 0))
(defn every? [pred coll] (defn every? [pred coll]
"Return true if (pred x) is logical true for every x in coll, else false" "Check if `pred` is true applied to every x in `coll`."
(all (map pred coll))) (all (map pred coll)))
(defn flatten [coll] (defn flatten [coll]
"Return a single flat list expanding all members of coll" "Return a single flat list expanding all members of `coll`."
(if (coll? coll) (if (coll? coll)
(_flatten coll []) (_flatten coll [])
(raise (TypeError (.format "{0!r} is not a collection" coll))))) (raise (TypeError (.format "{0!r} is not a collection" coll)))))
@ -207,11 +206,11 @@
result) result)
(defn float? [x] (defn float? [x]
"Return True if x is float" "Check if x is float."
(isinstance x float)) (isinstance x float))
(defn symbol? [s] (defn symbol? [s]
"Check whether s is a symbol" "Check if `s` is a symbol."
(instance? HySymbol s)) (instance? HySymbol s))
(import [threading [Lock]]) (import [threading [Lock]])
@ -219,6 +218,7 @@
(setv _gensym_lock (Lock)) (setv _gensym_lock (Lock))
(defn gensym [&optional [g "G"]] (defn gensym [&optional [g "G"]]
"Generate a unique symbol for use in macros without accidental name clashes."
(setv new_symbol None) (setv new_symbol None)
(global _gensym_counter) (global _gensym_counter)
(global _gensym_lock) (global _gensym_lock)
@ -237,93 +237,95 @@
(get f.f_globals "__name__")) (get f.f_globals "__name__"))
(defn first [coll] (defn first [coll]
"Return first item from `coll`" "Return first item from `coll`."
(next (iter coll) None)) (next (iter coll) None))
(defn identity [x] (defn identity [x]
"Returns the argument unchanged" "Return `x`."
x) x)
(defn inc [n] (defn inc [n]
"Increment n by 1" "Increment `n` by 1."
(+ n 1)) (+ n 1))
(defn instance? [klass x] (defn instance? [klass x]
"Perform `isinstance` with reversed arguments."
(isinstance x klass)) (isinstance x klass))
(defn integer [x] (defn integer [x]
"Return Hy kind of integer" "Return Hy kind of integer for `x`."
(long-type x)) (long-type x))
(defn integer? [x] (defn integer? [x]
"Return True if x is an integer" "Check if `x` is an integer."
(isinstance x (, int long-type))) (isinstance x (, int long-type)))
(defn integer-char? [x] (defn integer-char? [x]
"Return True if char `x` parses as an integer" "Check if char `x` parses as an integer."
(try (try
(integer? (int x)) (integer? (int x))
(except [ValueError] False) (except [ValueError] False)
(except [TypeError] False))) (except [TypeError] False)))
(defn interleave [&rest seqs] (defn interleave [&rest seqs]
"Return an iterable of the first item in each of seqs, then the second etc." "Return an iterable of the first item in each of `seqs`, then the second etc."
(chain.from-iterable (zip #* seqs))) (chain.from-iterable (zip #* seqs)))
(defn interpose [item seq] (defn interpose [item seq]
"Return an iterable of the elements of seq separated by item" "Return an iterable of the elements of `seq` separated by `item`."
(drop 1 (interleave (repeat item) seq))) (drop 1 (interleave (repeat item) seq)))
(defn iterable? [x] (defn iterable? [x]
"Return true if x is iterable" "Check if `x` is an iterable."
(isinstance x collections.Iterable)) (isinstance x collections.Iterable))
(defn iterate [f x] (defn iterate [f x]
"Returns an iterator repeatedly applying `f` to seed `x`.. x, f(x), f(f(x))..."
(setv val x) (setv val x)
(while True (while True
(yield val) (yield val)
(setv val (f val)))) (setv val (f val))))
(defn iterator? [x] (defn iterator? [x]
"Return true if x is an iterator" "Check if `x` is an iterator."
(isinstance x collections.Iterator)) (isinstance x collections.Iterator))
(defn juxt [f &rest fs] (defn juxt [f &rest fs]
"Return a function that applies each of the supplied functions to a single "Return a function applying each `fs` to args, collecting results in a list."
set of arguments and collects the results into a list."
(setv fs (cons f fs)) (setv fs (cons f fs))
(fn [&rest args &kwargs kwargs] (fn [&rest args &kwargs kwargs]
(list-comp (f #* args #** kwargs) [f fs]))) (list-comp (f #* args #** kwargs) [f fs])))
(defn last [coll] (defn last [coll]
"Return last item from `coll`" "Return last item from `coll`."
(get (tuple coll) -1)) (get (tuple coll) -1))
(defn list* [hd &rest tl] (defn list* [hd &rest tl]
"Return a dotted list construed from the elements of the argument" "Return a chain of nested cons cells (dotted list) containing `hd` and `tl`."
(if (not tl) (if (not tl)
hd hd
(cons hd (list* #* tl)))) (cons hd (list* #* tl))))
(defn macroexpand [form] (defn macroexpand [form]
"Return the full macro expansion of form" "Return the full macro expansion of `form`."
(import hy.macros) (import hy.macros)
(setv name (calling-module-name)) (setv name (calling-module-name))
(hy.macros.macroexpand form (HyASTCompiler name))) (hy.macros.macroexpand form (HyASTCompiler name)))
(defn macroexpand-1 [form] (defn macroexpand-1 [form]
"Return the single step macro expansion of form" "Return the single step macro expansion of `form`."
(import hy.macros) (import hy.macros)
(setv name (calling-module-name)) (setv name (calling-module-name))
(hy.macros.macroexpand-1 form (HyASTCompiler name))) (hy.macros.macroexpand-1 form (HyASTCompiler name)))
(defn merge-with [f &rest maps] (defn merge-with [f &rest maps]
"Returns a map that consists of the rest of the maps joined onto "Return the map of `maps` joined onto the first via the function `f`.
the first. If a key occurs in more than one map, the mapping(s)
from the latter (left-to-right) will be combined with the mapping in If a key occurs in more than one map, the mapping(s) from the latter
the result by calling (f val-in-result val-in-latter)." (left-to-right) will be combined with the mapping in the result by calling
(f val-in-result val-in-latter)."
(if (any maps) (if (any maps)
(do (do
(defn merge-entry [m e] (defn merge-entry [m e]
@ -337,31 +339,33 @@
(reduce merge2 maps)))) (reduce merge2 maps))))
(defn neg? [n] (defn neg? [n]
"Return true if n is < 0" "Check if `n` is < 0."
(< n 0)) (< n 0))
(defn none? [x] (defn none? [x]
"Return true if x is None" "Check if `x` is None"
(is x None)) (is x None))
(defn numeric? [x] (defn numeric? [x]
"Check if `x` is an instance of numbers.Number."
(import numbers) (import numbers)
(instance? numbers.Number x)) (instance? numbers.Number x))
(defn nth [coll n &optional [default None]] (defn nth [coll n &optional [default None]]
"Return nth item in collection or sequence, counting from 0. "Return `n`th item in `coll` or None (specify `default`) if out of bounds."
Return None if out of bounds unless specified otherwise."
(next (drop n coll) default)) (next (drop n coll) default))
(defn odd? [n] (defn odd? [n]
"Return true if n is an odd number" "Check if `n` is an odd number."
(= (% n 2) 1)) (= (% n 2) 1))
(def -sentinel (object)) (def -sentinel (object))
(defn partition [coll &optional [n 2] step [fillvalue -sentinel]] (defn partition [coll &optional [n 2] step [fillvalue -sentinel]]
"Chunks coll into n-tuples (pairs by default). The remainder, if any, is not "Chunk `coll` into `n`-tuples (pairs by default).
included unless a fillvalue is specified. The step defaults to n, but can be
more to skip elements, or less for a sliding window with overlap." The remainder, if any, is not included unless `fillvalue` is specified. The step
defaults to `n`, but can be more to skip elements, or less for a sliding window
with overlap."
(setv (setv
step (or step n) step (or step n)
coll-clones (tee coll n) coll-clones (tee coll n)
@ -372,46 +376,46 @@
(zip-longest #* slices :fillvalue fillvalue))) (zip-longest #* slices :fillvalue fillvalue)))
(defn pos? [n] (defn pos? [n]
"Return true if n is > 0" "Check if `n` is > 0."
(> n 0)) (> n 0))
(defn rest [coll] (defn rest [coll]
"Get all the elements of a coll, except the first." "Get all the elements of `coll`, except the first."
(drop 1 coll)) (drop 1 coll))
(defn repeatedly [func] (defn repeatedly [func]
"Yield result of running func repeatedly" "Yield result of running `func` repeatedly."
(while True (while True
(yield (func)))) (yield (func))))
(defn second [coll] (defn second [coll]
"Return second item from `coll`" "Return second item from `coll`."
(nth coll 1)) (nth coll 1))
(defn some [pred coll] (defn some [pred coll]
"Return the first logical true value of (pred x) for any x in coll, else None" "Return the first logical true value of applying `pred` in `coll`, else None."
(first (filter None (map pred coll)))) (first (filter None (map pred coll))))
(defn string [x] (defn string [x]
"Cast x as current string implementation" "Cast `x` as the current python verion's string implementation."
(if-python2 (if-python2
(unicode x) (unicode x)
(str x))) (str x)))
(defn string? [x] (defn string? [x]
"Return True if x is a string" "Check if `x` is a string."
(if-python2 (if-python2
(isinstance x (, str unicode)) (isinstance x (, str unicode))
(isinstance x str))) (isinstance x str)))
(defn take [count coll] (defn take [count coll]
"Take `count` elements from `coll`, or the whole set if the total "Take `count` elements from `coll`."
number of entries in `coll` is less than `count`."
(islice coll None count)) (islice coll None count))
(defn take-nth [n coll] (defn take-nth [n coll]
"Return every nth member of coll "Return every `n`th member of `coll`.
raises ValueError for (not (pos? n))"
Raises ValueError for (not (pos? n))."
(if (not (pos? n)) (if (not (pos? n))
(raise (ValueError "n must be positive"))) (raise (ValueError "n must be positive")))
(setv citer (iter coll) skip (dec n)) (setv citer (iter coll) skip (dec n))
@ -421,13 +425,15 @@
(next citer)))) (next citer))))
(defn zero? [n] (defn zero? [n]
"Return true if n is 0" "Check if `n` equals 0."
(= n 0)) (= n 0))
(defn read [&optional [from-file sys.stdin] (defn read [&optional [from-file sys.stdin]
[eof ""]] [eof ""]]
"Read from input and returns a tokenized string. Can take a given input buffer "Read from input and returns a tokenized string.
to read from, and a single byte as EOF (defaults to an empty string)"
Can take a given input buffer to read from, and a single byte
as EOF (defaults to an empty string)."
(setv buff "") (setv buff "")
(while True (while True
(setv inn (string (.readline from-file))) (setv inn (string (.readline from-file)))
@ -441,16 +447,17 @@
parsed) parsed)
(defn read-str [input] (defn read-str [input]
"Reads and tokenizes first line of input" "Reads and tokenizes first line of `input`."
(read :from-file (StringIO input))) (read :from-file (StringIO input)))
(defn hyify [text] (defn hyify [text]
"Convert text to match hy identifier" "Convert `text` to match hy identifier."
(.replace (string text) "_" "-")) (.replace (string text) "_" "-"))
(defn keyword [value] (defn keyword [value]
"Create a keyword from the given value. Strings numbers and even objects "Create a keyword from `value`.
with the __name__ magic will work"
Strings numbers and even objects with the __name__ magic will work."
(if (and (string? value) (value.startswith HyKeyword.PREFIX)) (if (and (string? value) (value.startswith HyKeyword.PREFIX))
(hyify value) (hyify value)
(if (string? value) (if (string? value)
@ -460,8 +467,10 @@
(except [] (HyKeyword (+ ":" (string value)))))))) (except [] (HyKeyword (+ ":" (string value))))))))
(defn name [value] (defn name [value]
"Convert the given value to a string. Keyword special character will be stripped. "Convert `value` to a string.
String will be used as is. Even objects with the __name__ magic will work"
Keyword special character will be stripped. String will be used as is.
Even objects with the __name__ magic will work."
(if (and (string? value) (value.startswith HyKeyword.PREFIX)) (if (and (string? value) (value.startswith HyKeyword.PREFIX))
(hyify (cut value 2)) (hyify (cut value 2))
(if (string? value) (if (string? value)
@ -471,7 +480,7 @@
(except [] (string value)))))) (except [] (string value))))))
(defn xor [a b] (defn xor [a b]
"Perform exclusive or between two parameters" "Perform exclusive or between `a` and `b`."
(if (and a b) (if (and a b)
False False
(or a b))) (or a b)))

View File

@ -10,11 +10,14 @@
(import [hy.models [HyList HySymbol]]) (import [hy.models [HyList HySymbol]])
(defmacro as-> [head name &rest rest] (defmacro as-> [head name &rest rest]
"Expands to sequence of assignments to the provided name, starting with head. "Beginning with `head`, expand a sequence of assignments `rest` to `name`.
The previous result is thus available in the subsequent form. Returns the
final result, and leaves the name bound to it in the local scope. This behaves Each assignment is passed to the subsequent form. Returns the final assignment,
much like the other threading macros, but requires you to specify the threading leaving the name bound to it in the local scope.
point per form via the name instead of always the first or last argument."
This behaves similarly to other threading macros, but requires specifying
the threading point per-form via the name, rather than fixing to the first
or last argument."
`(do (setv `(do (setv
~name ~head ~name ~head
~@(interleave (repeat name) rest)) ~@(interleave (repeat name) rest))
@ -22,6 +25,10 @@
(defmacro assoc [coll k1 v1 &rest other-kvs] (defmacro assoc [coll k1 v1 &rest other-kvs]
"Associate key/index value pair(s) to a collection `coll` like a dict or list.
If more than three parameters are given, the remaining args are k/v pairs to
be associated in pairs."
(if (odd? (len other-kvs)) (if (odd? (len other-kvs))
(macro-error (last other-kvs) (macro-error (last other-kvs)
"`assoc` takes an odd number of arguments")) "`assoc` takes an odd number of arguments"))
@ -37,12 +44,13 @@
(defmacro with [args &rest body] (defmacro with [args &rest body]
"shorthand for nested with* loops: "Wrap execution of `body` within a context manager given as bracket `args`.
Shorthand for nested with* loops:
(with [x foo y bar] baz) -> (with [x foo y bar] baz) ->
(with* [x foo] (with* [x foo]
(with* [y bar] (with* [y bar]
baz))" baz))."
(if (not (empty? args)) (if (not (empty? args))
(do (do
(if (>= (len args) 2) (if (>= (len args) 2)
@ -56,12 +64,10 @@
(defmacro cond [&rest branches] (defmacro cond [&rest branches]
"shorthand for nested ifs: "Build a nested if clause with each `branch` a [cond result] bracket pair.
(cond [foo bar] [baz quux]) ->
(if foo The result in the bracket may be omitted, in which case the condition is also
bar used as the result."
(if baz
quux))"
(if (empty? branches) (if (empty? branches)
None None
(do (do
@ -88,13 +94,10 @@
(defmacro for [args &rest body] (defmacro for [args &rest body]
"shorthand for nested for loops: "Build a for-loop with `args` as a [element coll] bracket pair and run `body`.
(for [x foo
y bar] Args may contain multiple pairs, in which case it executes a nested for-loop
baz) -> in order of the given pairs."
(for* [x foo]
(for* [y bar]
baz))"
(setv body (list body)) (setv body (list body))
(if (empty? body) (if (empty? body)
(macro-error None "`for' requires a body to evaluate")) (macro-error None "`for' requires a body to evaluate"))
@ -113,10 +116,10 @@
(defmacro -> [head &rest rest] (defmacro -> [head &rest rest]
"Threads the head through the rest of the forms. Inserts "Thread `head` first through the `rest` of the forms.
head as the second item in the first form of rest. If
there are more forms, inserts the first form as the The result of the first threaded form is inserted into the first position of
second item in the second form of rest, etc." the second form, the second result is inserted into the third form, and so on."
(setv ret head) (setv ret head)
(for* [node rest] (for* [node rest]
(if (not (isinstance node HyExpression)) (if (not (isinstance node HyExpression))
@ -127,8 +130,7 @@
(defmacro doto [form &rest expressions] (defmacro doto [form &rest expressions]
"Performs a sequence of potentially mutating actions "Perform possibly mutating `expressions` on `form`, returning resulting obj."
on an initial object, returning the resulting object"
(setv f (gensym)) (setv f (gensym))
(defn build-form [expression] (defn build-form [expression]
(if (isinstance expression HyExpression) (if (isinstance expression HyExpression)
@ -140,10 +142,10 @@
~f)) ~f))
(defmacro ->> [head &rest rest] (defmacro ->> [head &rest rest]
"Threads the head through the rest of the forms. Inserts "Thread `head` last through the `rest` of the forms.
head as the last item in the first form of rest. If there
are more forms, inserts the first form as the last item The result of the first threaded form is inserted into the last position of
in the second form of rest, etc." the second form, the second result is inserted into the third form, and so on."
(setv ret head) (setv ret head)
(for* [node rest] (for* [node rest]
(if (not (isinstance node HyExpression)) (if (not (isinstance node HyExpression))
@ -185,6 +187,7 @@
(defmacro with-gensyms [args &rest body] (defmacro with-gensyms [args &rest body]
"Execute `body` with `args` as bracket of names to gensym for use in macros."
(setv syms []) (setv syms [])
(for* [arg args] (for* [arg args]
(.extend syms [arg `(gensym '~arg)])) (.extend syms [arg `(gensym '~arg)]))
@ -193,6 +196,7 @@
~@body)) ~@body))
(defmacro defmacro/g! [name args &rest body] (defmacro defmacro/g! [name args &rest body]
"Like `defmacro`, but symbols prefixed with 'g!' are gensymed."
(setv syms (list (setv syms (list
(distinct (distinct
(filter (fn [x] (filter (fn [x]
@ -207,8 +211,9 @@
~@body)) ~@body))
(defmacro defmacro! [name args &rest body] (defmacro defmacro! [name args &rest body]
"Like defmacro/g! plus automatic once-only evaluation for o! "Like `defmacro/g!`, with automatic once-only evaluation for 'o!' params.
parameters, which are available as the equivalent g! symbol."
Such 'o!' params are availible within `body` as the equivalent 'g!' symbol."
(setv os (list-comp s [s args] (.startswith s "o!")) (setv os (list-comp s [s args] (.startswith s "o!"))
gs (list-comp (HySymbol (+ "g!" (cut s 2))) [s os])) gs (list-comp (HySymbol (+ "g!" (cut s 2))) [s os]))
`(defmacro/g! ~name ~args `(defmacro/g! ~name ~args
@ -217,7 +222,7 @@
(defmacro defmain [args &rest body] (defmacro defmain [args &rest body]
"Write a function named \"main\" and do the if __main__ dance" "Write a function named \"main\" and do the 'if __main__' dance"
(setv retval (gensym)) (setv retval (gensym))
`(when (= --name-- "__main__") `(when (= --name-- "__main__")
(import sys) (import sys)
@ -227,6 +232,7 @@
(deftag @ [expr] (deftag @ [expr]
"with-decorator tag macro"
(setv decorators (cut expr None -1) (setv decorators (cut expr None -1)
fndef (get expr -1)) fndef (get expr -1))
`(with-decorator ~@decorators ~fndef)) `(with-decorator ~@decorators ~fndef))
@ -234,3 +240,41 @@
(defmacro comment [&rest body] (defmacro comment [&rest body]
"Ignores body and always expands to None" "Ignores body and always expands to None"
None) None)
(defmacro doc [symbol]
"macro documentation
Gets help for a macro function available in this module.
Use ``require`` to make other macros available.
Use ``#doc foo`` instead for help with tag macro ``#foo``.
Use ``(help foo)`` instead for help with runtime objects."
`(try
(help (. (__import__ "hy")
macros
_hy_macros
[__name__]
['~symbol]))
(except [KeyError]
(help (. (__import__ "hy")
macros
_hy_macros
[None]
['~symbol])))))
(deftag doc [symbol]
"tag macro documentation
Gets help for a tag macro function available in this module."
`(try
(help (. (__import__ "hy")
macros
_hy_tag
[__name__]
['~symbol]))
(except [KeyError]
(help (. (__import__ "hy")
macros
_hy_tag
[None]
['~symbol])))))

View File

@ -9,7 +9,7 @@
(defn + [&rest args] (defn + [&rest args]
"Shadow + operator for when we need to import / map it against something" "Shadowed `+` operator adds `args`."
(if (if
(= (len args) 0) (= (len args) 0)
0 0
@ -19,13 +19,13 @@
(reduce operator.add args))) (reduce operator.add args)))
(defn - [a1 &rest a-rest] (defn - [a1 &rest a-rest]
"Shadow - operator for when we need to import / map it against something" "Shadowed `-` operator subtracts each `a-rest` from `a1`."
(if a-rest (if a-rest
(reduce operator.sub a-rest a1) (reduce operator.sub a-rest a1)
(- a1))) (- a1)))
(defn * [&rest args] (defn * [&rest args]
"Shadow * operator for when we need to import / map it against something" "Shadowed `*` operator multiplies `args`."
(if (if
(= (len args) 0) (= (len args) 0)
1 1
@ -35,6 +35,7 @@
(reduce operator.mul args))) (reduce operator.mul args)))
(defn ** [a1 a2 &rest a-rest] (defn ** [a1 a2 &rest a-rest]
"Shadowed `**` operator takes `a1` to the power of `a2`, ..., `a-rest`."
; We use `-foldr` instead of `reduce` because exponentiation ; We use `-foldr` instead of `reduce` because exponentiation
; is right-associative. ; is right-associative.
(-foldr operator.pow (+ (, a1 a2) a-rest))) (-foldr operator.pow (+ (, a1 a2) a-rest)))
@ -42,32 +43,40 @@
(reduce (fn [x y] (f y x)) (cut xs None None -1))) (reduce (fn [x y] (f y x)) (cut xs None None -1)))
(defn / [a1 &rest a-rest] (defn / [a1 &rest a-rest]
"Shadow / operator for when we need to import / map it against something" "Shadowed `/` operator divides `a1` by each `a-rest`."
(if a-rest (if a-rest
(reduce operator.truediv a-rest a1) (reduce operator.truediv a-rest a1)
(/ 1 a1))) (/ 1 a1)))
(defn // [a1 a2 &rest a-rest] (defn // [a1 a2 &rest a-rest]
"Shadowed `//` operator floor divides `a1` by `a2`, ..., `a-rest`."
(reduce operator.floordiv (+ (, a2) a-rest) a1)) (reduce operator.floordiv (+ (, a2) a-rest) a1))
(defn % [x y] (defn % [x y]
"Shadowed `%` operator takes `x` modulo `y`."
(% x y)) (% x y))
(if PY35 (defn @ [a1 &rest a-rest] (if PY35
(reduce operator.matmul a-rest a1))) (defn @ [a1 &rest a-rest]
"Shadowed `@` operator matrix multiples `a1` by each `a-rest`."
(reduce operator.matmul a-rest a1)))
(defn << [a1 a2 &rest a-rest] (defn << [a1 a2 &rest a-rest]
"Shadowed `<<` operator performs left-shift on `a1` by `a2`, ..., `a-rest`."
(reduce operator.lshift (+ (, a2) a-rest) a1)) (reduce operator.lshift (+ (, a2) a-rest) a1))
(defn >> [a1 a2 &rest a-rest] (defn >> [a1 a2 &rest a-rest]
"Shadowed `>>` operator performs right-shift on `a1` by `a2`, ..., `a-rest`."
(reduce operator.rshift (+ (, a2) a-rest) a1)) (reduce operator.rshift (+ (, a2) a-rest) a1))
(defn & [a1 &rest a-rest] (defn & [a1 &rest a-rest]
"Shadowed `&` operator performs bitwise-and on `a1` by each `a-rest`."
(if a-rest (if a-rest
(reduce operator.and_ a-rest a1) (reduce operator.and_ a-rest a1)
a1)) a1))
(defn | [&rest args] (defn | [&rest args]
"Shadowed `|` operator performs bitwise-or on `a1` by each `a-rest`."
(if (if
(= (len args) 0) (= (len args) 0)
0 0
@ -77,9 +86,11 @@
(reduce operator.or_ args))) (reduce operator.or_ args)))
(defn ^ [x y] (defn ^ [x y]
"Shadowed `^` operator performs bitwise-xor on `x` and `y`."
(^ x y)) (^ x y))
(defn ~ [x] (defn ~ [x]
"Shadowed `~` operator performs bitwise-negation on `x`."
(~ x)) (~ x))
(defn comp-op [op a1 a-rest] (defn comp-op [op a1 a-rest]
@ -89,29 +100,32 @@
(list-comp (op x y) [(, x y) (zip (+ (, a1) a-rest) a-rest)])) (list-comp (op x y) [(, x y) (zip (+ (, a1) a-rest) a-rest)]))
True)) True))
(defn < [a1 &rest a-rest] (defn < [a1 &rest a-rest]
"Shadow < operator for when we need to import / map it against something" "Shadowed `<` operator perform lt comparison on `a1` by each `a-rest`."
(comp-op operator.lt a1 a-rest)) (comp-op operator.lt a1 a-rest))
(defn <= [a1 &rest a-rest] (defn <= [a1 &rest a-rest]
"Shadow <= operator for when we need to import / map it against something" "Shadowed `<=` operator perform le comparison on `a1` by each `a-rest`."
(comp-op operator.le a1 a-rest)) (comp-op operator.le a1 a-rest))
(defn = [a1 &rest a-rest] (defn = [a1 &rest a-rest]
"Shadow = operator for when we need to import / map it against something" "Shadowed `=` operator perform eq comparison on `a1` by each `a-rest`."
(comp-op operator.eq a1 a-rest)) (comp-op operator.eq a1 a-rest))
(defn is [a1 &rest a-rest] (defn is [a1 &rest a-rest]
"Shadowed `is` keyword perform is on `a1` by each `a-rest`."
(comp-op operator.is_ a1 a-rest)) (comp-op operator.is_ a1 a-rest))
(defn != [a1 a2 &rest a-rest] (defn != [a1 a2 &rest a-rest]
"Shadow != operator for when we need to import / map it against something" "Shadowed `!=` operator perform neq comparison on `a1` by `a2`, ..., `a-rest`."
(comp-op operator.ne a1 (+ (, a2) a-rest))) (comp-op operator.ne a1 (+ (, a2) a-rest)))
(defn is-not [a1 a2 &rest a-rest] (defn is-not [a1 a2 &rest a-rest]
"Shadowed `is-not` keyword perform is-not on `a1` by `a2`, ..., `a-rest`."
(comp-op operator.is-not a1 (+ (, a2) a-rest))) (comp-op operator.is-not a1 (+ (, a2) a-rest)))
(defn >= [a1 &rest a-rest] (defn >= [a1 &rest a-rest]
"Shadow >= operator for when we need to import / map it against something" "Shadowed `>=` operator perform ge comparison on `a1` by each `a-rest`."
(comp-op operator.ge a1 a-rest)) (comp-op operator.ge a1 a-rest))
(defn > [a1 &rest a-rest] (defn > [a1 &rest a-rest]
"Shadow > operator for when we need to import / map it against something" "Shadowed `>` operator perform gt comparison on `a1` by each `a-rest`."
(comp-op operator.gt a1 a-rest)) (comp-op operator.gt a1 a-rest))
(defn and [&rest args] (defn and [&rest args]
"Shadowed `and` keyword perform and on `args`."
(if (if
(= (len args) 0) (= (len args) 0)
True True
@ -121,6 +135,7 @@
(reduce (fn [x y] (and x y)) args))) (reduce (fn [x y] (and x y)) args)))
(defn or [&rest args] (defn or [&rest args]
"Shadowed `or` keyword perform or on `args`."
(if (if
(= (len args) 0) (= (len args) 0)
None None
@ -130,15 +145,19 @@
(reduce (fn [x y] (or x y)) args))) (reduce (fn [x y] (or x y)) args)))
(defn not [x] (defn not [x]
"Shadowed `not` keyword perform not on `x`."
(not x)) (not x))
(defn in [x y] (defn in [x y]
"Shadowed `in` keyword perform `x` in `y`."
(in x y)) (in x y))
(defn not-in [x y] (defn not-in [x y]
"Shadowed `not in` keyword perform `x` not in `y`."
(not-in x y)) (not-in x y))
(defn get [coll key1 &rest keys] (defn get [coll key1 &rest keys]
"Access item in `coll` indexed by `key1`, with optional `keys` nested-access."
(setv coll (get coll key1)) (setv coll (get coll key1))
(for* [k keys] (for* [k keys]
(setv coll (get coll k))) (setv coll (get coll k)))

View File

@ -43,41 +43,47 @@ class HyTypeError(TypeError):
def __str__(self): def __str__(self):
line = self.expression.start_line
start = self.expression.start_column
end = self.expression.end_column
source = []
if self.source is not None:
source = self.source.split("\n")[line-1:self.expression.end_line]
if line == self.expression.end_line:
length = end - start
else:
length = len(source[0]) - start
result = "" result = ""
result += ' File "%s", line %d, column %d\n\n' % (self.filename, if all(getattr(self.expression, x, None) is not None
line, for x in ("start_line", "start_column", "end_column")):
start)
if len(source) == 1: line = self.expression.start_line
result += ' %s\n' % colored.red(source[0]) start = self.expression.start_column
result += ' %s%s\n' % (' '*(start-1), end = self.expression.end_column
colored.green('^' + '-'*(length-1) + '^'))
if len(source) > 1:
result += ' %s\n' % colored.red(source[0])
result += ' %s%s\n' % (' '*(start-1),
colored.green('^' + '-'*length))
if len(source) > 2: # write the middle lines
for line in source[1:-1]:
result += ' %s\n' % colored.red("".join(line))
result += ' %s\n' % colored.green("-"*len(line))
# write the last line source = []
result += ' %s\n' % colored.red("".join(source[-1])) if self.source is not None:
result += ' %s\n' % colored.green('-'*(end-1) + '^') source = self.source.split("\n")[line-1:self.expression.end_line]
if line == self.expression.end_line:
length = end - start
else:
length = len(source[0]) - start
result += ' File "%s", line %d, column %d\n\n' % (self.filename,
line,
start)
if len(source) == 1:
result += ' %s\n' % colored.red(source[0])
result += ' %s%s\n' % (' '*(start-1),
colored.green('^' + '-'*(length-1) + '^'))
if len(source) > 1:
result += ' %s\n' % colored.red(source[0])
result += ' %s%s\n' % (' '*(start-1),
colored.green('^' + '-'*length))
if len(source) > 2: # write the middle lines
for line in source[1:-1]:
result += ' %s\n' % colored.red("".join(line))
result += ' %s\n' % colored.green("-"*len(line))
# write the last line
result += ' %s\n' % colored.red("".join(source[-1]))
result += ' %s\n' % colored.green('-'*(end-1) + '^')
else:
result += ' File "%s", unknown location\n' % self.filename
result += colored.yellow("%s: %s\n\n" % result += colored.yellow("%s: %s\n\n" %
(self.__class__.__name__, (self.__class__.__name__,

View File

@ -5,11 +5,10 @@
;;; These macros make writing functional programs more concise ;;; These macros make writing functional programs more concise
(defmacro ap-if [test-form then-form &optional else-form] (defmacro ap-if [test-form then-form &optional else-form]
`(do `(do
(setv it ~test-form) (setv it ~test-form)
(if it ~then-form ~else-form))) (if it ~then-form ~else-form)))
(defmacro ap-each [lst &rest body] (defmacro ap-each [lst &rest body]
@ -25,17 +24,17 @@
(defn ~p [it] ~form) (defn ~p [it] ~form)
(for [it ~lst] (for [it ~lst]
(if (~p it) (if (~p it)
~@body ~@body
(break))))) (break)))))
(defmacro ap-map [form lst] (defmacro ap-map [form lst]
"Yield elements evaluated in the form for each element in the list." "Yield elements evaluated in the form for each element in the list."
(setv v (gensym 'v) f (gensym 'f)) (setv v (gensym 'v) f (gensym 'f))
`((fn [] `((fn []
(defn ~f [it] ~form) (defn ~f [it] ~form)
(for [~v ~lst] (for [~v ~lst]
(yield (~f ~v)))))) (yield (~f ~v))))))
(defmacro ap-map-when [predfn rep lst] (defmacro ap-map-when [predfn rep lst]
@ -43,21 +42,21 @@
predicate function returns True." predicate function returns True."
(setv f (gensym)) (setv f (gensym))
`((fn [] `((fn []
(defn ~f [it] ~rep) (defn ~f [it] ~rep)
(for [it ~lst] (for [it ~lst]
(if (~predfn it) (if (~predfn it)
(yield (~f it)) (yield (~f it))
(yield it)))))) (yield it))))))
(defmacro ap-filter [form lst] (defmacro ap-filter [form lst]
"Yield elements returned when the predicate form evaluates to True." "Yield elements returned when the predicate form evaluates to True."
(setv pred (gensym)) (setv pred (gensym))
`((fn [] `((fn []
(defn ~pred [it] ~form) (defn ~pred [it] ~form)
(for [val ~lst] (for [val ~lst]
(if (~pred val) (if (~pred val)
(yield val)))))) (yield val))))))
(defmacro ap-reject [form lst] (defmacro ap-reject [form lst]
@ -95,10 +94,10 @@
(defmacro ap-reduce [form lst &optional [initial-value None]] (defmacro ap-reduce [form lst &optional [initial-value None]]
"Anaphoric form of reduce, `acc' and `it' can be used for a form" "Anaphoric form of reduce, `acc' and `it' can be used for a form"
`(do `(do
(setv acc ~(if (none? initial-value) `(get ~lst 0) initial-value)) (setv acc ~(if (none? initial-value) `(get ~lst 0) initial-value))
(ap-each ~(if (none? initial-value) `(cut ~lst 1) lst) (ap-each ~(if (none? initial-value) `(cut ~lst 1) lst)
(setv acc ~form)) (setv acc ~form))
acc)) acc))
(defmacro ap-pipe [var &rest forms] (defmacro ap-pipe [var &rest forms]
@ -112,26 +111,32 @@
"Returns a function which is the composition of several forms." "Returns a function which is the composition of several forms."
`(fn [var] (ap-pipe var ~@forms))) `(fn [var] (ap-pipe var ~@forms)))
(defmacro xi [&rest body] (deftag % [expr]
"Returns a function with parameters implicitly determined by the presence in "Makes an expression into a function with an implicit `%` parameter list.
the body of xi parameters. An xi symbol designates the ith parameter
(1-based, e.g. x1, x2, x3, etc.), or all remaining parameters for xi itself. A `%i` symbol designates the (1-based) ith parameter (such as `%3`).
This is not a replacement for fn. The xi forms cannot be nested. " Only the maximum `%i` determines the number of `%i` parameters--the
(setv flatbody (flatten body)) others need not appear in the expression.
`(fn [;; generate all xi symbols up to the maximum found in body `%*` and `%**` name the `&rest` and `&kwargs` parameters, respectively.
~@(genexpr (HySymbol (+ "x"
(str i))) Nesting of `#%` forms is not recommended."
[i (range 1 (setv %symbols (set-comp a
;; find the maximum xi [a (flatten [expr])]
(inc (max (+ (list-comp (int (cut a 1)) (and (symbol? a)
[a flatbody] (.startswith a '%))))
(and (symbol? a) `(fn [;; generate all %i symbols up to the maximum found in expr
(.startswith a 'x) ~@(genexpr (HySymbol (+ "%" (str i)))
(.isdigit (cut a 1)))) [i (range 1 (-> (list-comp (int (cut a 1))
[0]))))]) [a %symbols]
;; generate the &rest parameter only if 'xi is present in body (.isdigit (cut a 1)))
~@(if (in 'xi flatbody) (or (, 0))
'(&rest xi) max
'())] inc))])
(~@body))) ;; generate the &rest parameter only if '%* is present in expr
~@(if (in '%* %symbols)
'(&rest %*))
;; similarly for &kwargs and %**
~@(if (in '%** %symbols)
'(&kwargs %**))]
~expr))

View File

@ -30,7 +30,7 @@ class Install(install):
"." + filename[:-len(".hy")]) "." + filename[:-len(".hy")])
install.run(self) install.run(self)
install_requires = ['rply>=0.7.5', 'astor>=0.5', 'clint>=0.4'] install_requires = ['rply>=0.7.5', 'astor>=0.6', 'clint>=0.4']
if os.name == 'nt': if os.name == 'nt':
install_requires.append('pyreadline>=2.1') install_requires.append('pyreadline>=2.1')

View File

@ -65,9 +65,9 @@
(defn test-ap-dotimes [] (defn test-ap-dotimes []
"NATIVE: testing anaphoric dotimes" "NATIVE: testing anaphoric dotimes"
(assert-equal (do (setv n []) (ap-dotimes 3 (.append n 3)) n) (assert-equal (do (setv n []) (ap-dotimes 3 (.append n 3)) n)
[3 3 3]) [3 3 3])
(assert-equal (do (setv n []) (ap-dotimes 3 (.append n it)) n) (assert-equal (do (setv n []) (ap-dotimes 3 (.append n it)) n)
[0 1 2])) [0 1 2]))
(defn test-ap-first [] (defn test-ap-first []
"NATIVE: testing anaphoric first" "NATIVE: testing anaphoric first"
@ -86,41 +86,59 @@
(assert-equal (ap-reduce (* acc it) [1 2 3]) 6) (assert-equal (ap-reduce (* acc it) [1 2 3]) 6)
(assert-equal (ap-reduce (* acc it) [1 2 3] 6) 36) (assert-equal (ap-reduce (* acc it) [1 2 3] 6) 36)
(assert-equal (ap-reduce (+ acc " on " it) ["Hy" "meth"]) (assert-equal (ap-reduce (+ acc " on " it) ["Hy" "meth"])
"Hy on meth") "Hy on meth")
(assert-equal (ap-reduce (+ acc it) [] 1) 1)) (assert-equal (ap-reduce (+ acc it) [] 1) 1))
(defn test-ap-pipe [] (defn test-ap-pipe []
"NATIVE: testing anaphoric pipe" "NATIVE: testing anaphoric pipe"
(assert-equal (ap-pipe 2 (+ it 1) (* it 3)) 9) (assert-equal (ap-pipe 2 (+ it 1) (* it 3)) 9)
(assert-equal (ap-pipe [4 5 6 7] (list (rest it)) (len it)) 3)) (assert-equal (ap-pipe [4 5 6 7] (list (rest it)) (len it)) 3))
(defn test-ap-compose [] (defn test-ap-compose []
"NATIVE: testing anaphoric compose" "NATIVE: testing anaphoric compose"
(assert-equal ((ap-compose (+ it 1) (* it 3)) 2) 9) (assert-equal ((ap-compose (+ it 1) (* it 3)) 2) 9)
(assert-equal ((ap-compose (list (rest it)) (len it)) [4 5 6 7]) 3)) (assert-equal ((ap-compose (list (rest it)) (len it)) [4 5 6 7]) 3))
(defn test-xi [] (defn test-tag-fn []
"NATIVE: testing xi forms" "NATIVE: testing #%() forms"
;; test ordering ;; test ordering
(assert-equal ((xi / x1 x2) 2 4) 0.5) (assert-equal (#%(/ %1 %2) 2 4) 0.5)
(assert-equal ((xi / x2 x1) 2 4) 2) (assert-equal (#%(/ %2 %1) 2 4) 2)
(assert-equal ((xi identity (, x5 x4 x3 x2 x1)) 1 2 3 4 5) (, 5 4 3 2 1)) (assert-equal (#%(identity (, %5 %4 %3 %2 %1)) 1 2 3 4 5) (, 5 4 3 2 1))
(assert-equal ((xi identity (, x1 x2 x3 x4 x5)) 1 2 3 4 5) (, 1 2 3 4 5)) (assert-equal (#%(identity (, %1 %2 %3 %4 %5)) 1 2 3 4 5) (, 1 2 3 4 5))
(assert-equal ((xi identity (, x1 x5 x2 x3 x4)) 1 2 3 4 5) (, 1 5 2 3 4)) (assert-equal (#%(identity (, %1 %5 %2 %3 %4)) 1 2 3 4 5) (, 1 5 2 3 4))
;; test &rest ;; test &rest
(assert-equal ((xi sum xi) 1 2 3) 6) (assert-equal (#%(sum %*) 1 2 3) 6)
(assert-equal ((xi identity (, x1 xi)) 10 1 2 3) (, 10 (, 1 2 3))) (assert-equal (#%(identity (, %1 %*)) 10 1 2 3) (, 10 (, 1 2 3)))
;; no parameters ;; no parameters
(assert-equal ((xi list)) []) (assert-equal (#%(list)) [])
(assert-equal ((xi identity "Hy!")) "Hy!") (assert-equal (#%(identity "Hy!")) "Hy!")
(assert-equal ((xi identity "xi")) "xi") (assert-equal (#%(identity "%*")) "%*")
(assert-equal ((xi + "Hy " "world!")) "Hy world!") (assert-equal (#%(+ "Hy " "world!")) "Hy world!")
;; test skipped parameters ;; test skipped parameters
(assert-equal ((xi identity [x3 x1]) 1 2 3) [3 1]) (assert-equal (#%(identity [%3 %1]) 1 2 3) [3 1])
;; test nesting ;; test nesting
(assert-equal ((xi identity [x1 (, x2 [x3] "Hy" [xi])]) 1 2 3 4 5) (assert-equal (#%(identity [%1 (, %2 [%3] "Hy" [%*])]) 1 2 3 4 5)
[1 (, 2 [3] "Hy" [(, 4 5)])]) [1 (, 2 [3] "Hy" [(, 4 5)])])
;; test arg as function ;; test arg as function
(assert-equal ((xi x1 2 4) +) 6) (assert-equal (#%(%1 2 4) +) 6)
(assert-equal ((xi x1 2 4) -) -2) (assert-equal (#%(%1 2 4) -) -2)
(assert-equal ((xi x1 2 4) /) 0.5)) (assert-equal (#%(%1 2 4) /) 0.5)
;; test &rest &kwargs
(assert-equal (#%(, %* %**) 1 2 :a 'b)
(, (, 1 2)
(dict :a 'b)))
;; test other expression types
(assert-equal (#% %* 1 2 3)
(, 1 2 3))
(assert-equal (#% %** :foo 2)
(dict :foo 2))
(assert-equal (#%[%3 %2 %1] 1 2 3)
[3 2 1])
(assert-equal (#%{%1 %2} 10 100)
{10 100})
(assert-equal (#% #{%3 %2 %1} 1 3 2)
#{3 1 2}) ; sets are not ordered.
(assert-equal (#% "%1")
"%1"))

View File

@ -219,8 +219,24 @@
(else (else
(+= count 1) (+= count 1)
(+= count 10))) (+= count 10)))
(assert (= count 161)) (assert (= count 161))
; don't be fooled by constructs that look like else
(setv s "")
(setv (get (globals) "else") True)
(for [x "abcde"]
(+= s x)
[else (+= s "_")])
(assert (= s "a_b_c_d_e_"))
(setv s "")
(setv (get (globals) "else") True)
(with [(pytest.raises TypeError)]
(for [x "abcde"]
(+= s x)
("else" (+= s "z"))))
(assert (= s "az"))
(assert (= (list ((fn [] (for [x [[1] [2 3]] y x] (yield y))))) (assert (= (list ((fn [] (for [x [[1] [2 3]] y x] (yield y)))))
(list-comp y [x [[1] [2 3]] y x]))) (list-comp y [x [[1] [2 3]] y x])))
(assert (= (list ((fn [] (for [x [[1] [2 3]] y x z (range 5)] (yield z))))) (assert (= (list ((fn [] (for [x [[1] [2 3]] y x z (range 5)] (yield z)))))
@ -308,7 +324,26 @@
(while True (while True
(break) (break)
(else (setv myvariable 53))) (else (setv myvariable 53)))
(assert (= myvariable 26))) (assert (= myvariable 26))
; don't be fooled by constructs that look like else clauses
(setv x 2)
(setv a [])
(setv (get (globals) "else") True)
(while x
(.append a x)
(-= x 1)
[else (.append a "e")])
(assert (= a [2 "e" 1 "e"]))
(setv x 2)
(setv a [])
(with [(pytest.raises TypeError)]
(while x
(.append a x)
(-= x 1)
("else" (.append a "e"))))
(assert (= a [2 "e"])))
(defn test-branching [] (defn test-branching []
@ -1515,13 +1550,23 @@
"NATIVE: Test the disassemble function" "NATIVE: Test the disassemble function"
(if PY35 (if PY35
(assert (= (disassemble '(do (leaky) (leaky) (macros))) (assert (= (disassemble '(do (leaky) (leaky) (macros)))
"Module(\n body=[Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[])),\n Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[])),\n Expr(value=Call(func=Name(id='macros'), args=[], keywords=[]))])")) "Module(
body=[Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[])),
Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[])),
Expr(value=Call(func=Name(id='macros'), args=[], keywords=[]))])"))
(assert (= (disassemble '(do (leaky) (leaky) (macros))) (assert (= (disassemble '(do (leaky) (leaky) (macros)))
"Module(\n body=[\n Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),\n Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),\n Expr(value=Call(func=Name(id='macros'), args=[], keywords=[], starargs=None, kwargs=None))])"))) "Module(
body=[
Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),
Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),
Expr(value=Call(func=Name(id='macros'), args=[], keywords=[], starargs=None, kwargs=None))])")))
(assert (= (disassemble '(do (leaky) (leaky) (macros)) True) (assert (= (disassemble '(do (leaky) (leaky) (macros)) True)
"leaky()\nleaky()\nmacros()")) "leaky()
leaky()
macros()
"))
(assert (= (re.sub r"[L() ]" "" (disassemble `(+ ~(+ 1 1) 40) True)) (assert (= (re.sub r"[L() ]" "" (disassemble `(+ ~(+ 1 1) 40) True))
"2+40"))) "2+40\n")))
(defn test-attribute-access [] (defn test-attribute-access []

View File

@ -144,7 +144,7 @@
(defn test-gensym-in-macros [] (defn test-gensym-in-macros []
(import ast) (import ast)
(import [astor.codegen [to_source]]) (import [astor.code-gen [to-source]])
(import [hy.importer [import_buffer_to_ast]]) (import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro nif [expr pos zero neg] (setv macro1 "(defmacro nif [expr pos zero neg]
(setv g (gensym)) (setv g (gensym))
@ -170,7 +170,7 @@
(defn test-with-gensym [] (defn test-with-gensym []
(import ast) (import ast)
(import [astor.codegen [to_source]]) (import [astor.code-gen [to-source]])
(import [hy.importer [import_buffer_to_ast]]) (import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro nif [expr pos zero neg] (setv macro1 "(defmacro nif [expr pos zero neg]
(with-gensyms [a] (with-gensyms [a]
@ -194,7 +194,7 @@
(defn test-defmacro-g! [] (defn test-defmacro-g! []
(import ast) (import ast)
(import [astor.codegen [to_source]]) (import [astor.code-gen [to-source]])
(import [hy.importer [import_buffer_to_ast]]) (import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro/g! nif [expr pos zero neg] (setv macro1 "(defmacro/g! nif [expr pos zero neg]
`(do `(do
@ -223,7 +223,7 @@
(defn test-defmacro! [] (defn test-defmacro! []
;; defmacro! must do everything defmacro/g! can ;; defmacro! must do everything defmacro/g! can
(import ast) (import ast)
(import [astor.codegen [to_source]]) (import [astor.code-gen [to-source]])
(import [hy.importer [import_buffer_to_ast]]) (import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro! nif [expr pos zero neg] (setv macro1 "(defmacro! nif [expr pos zero neg]
`(do `(do

View File

@ -72,7 +72,7 @@ def test_bin_hy_stdin():
output, _ = run_cmd("hy --spy", '(koan)') output, _ = run_cmd("hy --spy", '(koan)')
assert "monk" in output assert "monk" in output
assert "\\n Ummon" in output assert "\n Ummon" in output
# --spy should work even when an exception is thrown # --spy should work even when an exception is thrown
output, _ = run_cmd("hy --spy", '(foof)') output, _ = run_cmd("hy --spy", '(foof)')
@ -138,6 +138,16 @@ def test_bin_hy_stdin_except_do():
assert "zzz" in output assert "zzz" in output
def test_bin_hy_stdin_unlocatable_hytypeerror():
# https://github.com/hylang/hy/issues/1412
# The chief test of interest here is the returncode assertion
# inside run_cmd.
_, err = run_cmd("hy", """
(import hy.errors)
(raise (hy.errors.HyTypeError '[] (+ "A" "Z")))""")
assert "AZ" in err
def test_bin_hy_stdin_bad_repr(): def test_bin_hy_stdin_bad_repr():
# https://github.com/hylang/hy/issues/1389 # https://github.com/hylang/hy/issues/1389
output, err = run_cmd("hy", """ output, err = run_cmd("hy", """
@ -185,7 +195,7 @@ def test_bin_hy_icmd_file():
def test_bin_hy_icmd_and_spy(): def test_bin_hy_icmd_and_spy():
output, _ = run_cmd("hy -i \"(+ [] [])\" --spy", "(+ 1 1)") output, _ = run_cmd("hy -i \"(+ [] [])\" --spy", "(+ 1 1)")
assert "([] + [])" in output assert "[] + []" in output
def test_bin_hy_missing_file(): def test_bin_hy_missing_file():