Yaltik/hy
2
0
Fork 0
Code Pull Requests Releases Activity

Merge branch 'let-it-be'

Browse Source
This commit is contained in:
Kodi Arfer 2017-02-13 09:19:37 -08:00
commit 1d6de2792e
23 changed files with 453 additions and 562 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
NEWS
View File

@ -1,6 +1,8 @@
Changes from 0.12.1 Changes from 0.12.1
[ Language Changes ] [ Language Changes ]
* `let` has been removed. Python's scoping rules do not make a proper
implementation of it possible. Use `setv` instead.
* xor: If exactly one argument is true, return it * xor: If exactly one argument is true, return it
[ Bug Fixes ] [ Bug Fixes ]

93
docs/language/api.rst
View File

@ -286,17 +286,20 @@ Examples of usage:
.. code-block:: clj .. code-block:: clj
=>(let [collection {}] =>(do
... (setv collection {})
... (assoc collection "Dog" "Bark") ... (assoc collection "Dog" "Bark")
... (print collection)) ... (print collection))
{u'Dog': u'Bark'} {u'Dog': u'Bark'}
=>(let [collection {}] =>(do
... (setv collection {})
... (assoc collection "Dog" "Bark" "Cat" "Meow") ... (assoc collection "Dog" "Bark" "Cat" "Meow")
... (print collection)) ... (print collection))
{u'Cat': u'Meow', u'Dog': u'Bark'} {u'Cat': u'Meow', u'Dog': u'Bark'}
=>(let [collection [1 2 3 4]] =>(do
... (setv collection [1 2 3 4])
... (assoc collection 2 None) ... (assoc collection 2 None)
... (print collection)) ... (print collection))
[1, 2, None, 4] [1, 2, None, 4]
@ -555,9 +558,9 @@ Parameters may have the following keywords in front of them:
.. code-block:: clj .. code-block:: clj
=> (defn zig-zag-sum [&rest numbers] => (defn zig-zag-sum [&rest numbers]
(let [odd-numbers (list-comp x [x numbers] (odd? x)) (setv odd-numbers (list-comp x [x numbers] (odd? x))
even-numbers (list-comp x [x numbers] (even? x))] even-numbers (list-comp x [x numbers] (even? x)))
(- (sum odd-numbers) (sum even-numbers)))) (- (sum odd-numbers) (sum even-numbers)))
=> (zig-zag-sum) => (zig-zag-sum)
0 0
@ -578,10 +581,10 @@ Parameters may have the following keywords in front of them:
.. code-block:: clj .. code-block:: clj
=> (defn compare [a b &kwonly keyfn [reverse false]] => (defn compare [a b &kwonly keyfn [reverse false]]
... (let [result (keyfn a b)] ... (setv result (keyfn a b))
... (if (not reverse) ... (if (not reverse)
... result ... result
... (- result)))) ... (- result)))
=> (apply compare ["lisp" "python"] => (apply compare ["lisp" "python"]
... {"keyfn" (fn [x y] ... {"keyfn" (fn [x y]
... (reduce - (map (fn [s] (ord (first s))) [x y])))}) ... (reduce - (map (fn [s] (ord (first s))) [x y])))})
@ -932,8 +935,9 @@ list. Example usage:
.. code-block:: clj .. code-block:: clj
=> (let [animals {"dog" "bark" "cat" "meow"} => (do
... numbers ["zero" "one" "two" "three"]] ... (setv animals {"dog" "bark" "cat" "meow"}
... numbers ["zero" "one" "two" "three"])
... (print (get animals "dog")) ... (print (get animals "dog"))
... (print (get numbers 2))) ... (print (get numbers 2)))
bark bark
@ -1149,36 +1153,6 @@ last
6 6
let
---
``let`` is used to create lexically scoped variables. They are created at the
beginning of the ``let`` form and cease to exist after the form. The following
example showcases this behaviour:
.. code-block:: clj
=> (let [x 5] (print x)
... (let [x 6] (print x))
... (print x))
5
6
5
The ``let`` macro takes two parameters: a vector defining *variables*
and the *body* which gets executed. *variables* is a vector of
variable and value pairs.
Note that the variable assignments are executed one by one, from left to right.
The following example takes advantage of this:
.. code-block:: clj
=> (let [x 5
y (+ x 1)] (print x y))
5 6
list-comp list-comp
--------- ---------
@ -1210,30 +1184,20 @@ nonlocal
``nonlocal`` can be used to mark a symbol as not local to the current scope. ``nonlocal`` can be used to mark a symbol as not local to the current scope.
The parameters are the names of symbols to mark as nonlocal. This is necessary The parameters are the names of symbols to mark as nonlocal. This is necessary
to modify variables through nested ``let`` or ``fn`` scopes: to modify variables through nested ``fn`` scopes:
.. code-block:: clj .. code-block:: clj
(let [x 0]
(for [y (range 10)]
(let [z (inc y)]
(nonlocal x) ; allow the setv to "jump scope" to resolve x
(setv x (+ x y))))
x)
(defn some-function [] (defn some-function []
(let [x 0] (setv x 0)
(register-some-callback (register-some-callback
(fn [stuff] (fn [stuff]
(nonlocal x) (nonlocal x)
(setv x stuff))))) (setv x stuff))))
In the first example, without the call to ``(nonlocal x)``, this code would Without the call to ``(nonlocal x)``, the inner function would redefine ``x`` to
result in an UnboundLocalError being raised during the call to ``setv``. ``stuff`` inside its local scope instead of overwriting the ``x`` in the outer
function.
In the second example, without the call to ``(nonlocal x)``, the inner function
would redefine ``x`` to ``stuff`` inside its local scope instead of overwriting
the ``x`` in the outer function
See `PEP3104 <https://www.python.org/dev/peps/pep-3104/>`_ for further See `PEP3104 <https://www.python.org/dev/peps/pep-3104/>`_ for further
information. information.
@ -1699,9 +1663,10 @@ expands to:
.. code-block:: hy .. code-block:: hy
(let [a (gensym) (do
b (gensym) (setv a (gensym)
c (gensym)] b (gensym)
c (gensym))
...) ...)
.. seealso:: .. seealso::

7
docs/language/core.rst
View File

@ -1203,10 +1203,9 @@ if *from-file* ends before a complete expression can be parsed.
=> (with [f (open "example.hy")] => (with [f (open "example.hy")]
... (try ... (try
... (while True ... (while True
... (let [exp (read f)] ... (setv exp (read f))
... (do ... (print "OHY" exp)
... (print "OHY" exp) ... (eval exp))
... (eval exp))))
... (except [e EOFError] ... (except [e EOFError]
... (print "EOF!")))) ... (print "EOF!"))))
OHY ('print' 'hello') OHY ('print' 'hello')

36
docs/language/internals.rst
View File

@ -381,7 +381,8 @@ A first pass might be something like:
.. code-block:: hy .. code-block:: hy
(defmacro nif [expr pos-form zero-form neg-form] (defmacro nif [expr pos-form zero-form neg-form]
`(let [obscure-name ~expr] `(do
(setv obscure-name ~expr)
(cond [(pos? obscure-name) ~pos-form] (cond [(pos? obscure-name) ~pos-form]
[(zero? obscure-name) ~zero-form] [(zero? obscure-name) ~zero-form]
[(neg? obscure-name) ~neg-form]))) [(neg? obscure-name) ~neg-form])))
@ -396,15 +397,16 @@ such an occasion. A much better version of ``nif`` would be:
.. code-block:: hy .. code-block:: hy
(defmacro nif [expr pos-form zero-form neg-form] (defmacro nif [expr pos-form zero-form neg-form]
(let [g (gensym)] (setv g (gensym))
`(let [~g ~expr] `(do
(cond [(pos? ~g) ~pos-form] (setv ~g ~expr)
[(zero? ~g) ~zero-form] (cond [(pos? ~g) ~pos-form]
[(neg? ~g) ~neg-form])))) [(zero? ~g) ~zero-form]
[(neg? ~g) ~neg-form])))
This is an easy case, since there is only one symbol. But if there is This is an easy case, since there is only one symbol. But if there is
a need for several gensym's there is a second macro :ref:`with-gensyms` that a need for several gensym's there is a second macro :ref:`with-gensyms` that
basically expands to a series of ``let`` statements: basically expands to a ``setv`` form:
.. code-block:: hy .. code-block:: hy
@ -415,9 +417,10 @@ expands to:
.. code-block:: hy .. code-block:: hy
(let [a (gensym) (do
b (gensym) (setv a (gensym)
c (gensym)] b (gensym)
c (gensym))
...) ...)
so our re-written ``nif`` would look like: so our re-written ``nif`` would look like:
@ -426,10 +429,10 @@ so our re-written ``nif`` would look like:
(defmacro nif [expr pos-form zero-form neg-form] (defmacro nif [expr pos-form zero-form neg-form]
(with-gensyms [g] (with-gensyms [g]
`(let [~g ~expr] `(setv [~g ~expr])
(cond [(pos? ~g) ~pos-form] `(cond [(pos? ~g) ~pos-form]
[(zero? ~g) ~zero-form] [(zero? ~g) ~zero-form]
[(neg? ~g) ~neg-form])))) [(neg? ~g) ~neg-form])))
Finally, though we can make a new macro that does all this for us. :ref:`defmacro/g!` Finally, though we can make a new macro that does all this for us. :ref:`defmacro/g!`
will take all symbols that begin with ``g!`` and automatically call ``gensym`` with the will take all symbols that begin with ``g!`` and automatically call ``gensym`` with the
@ -440,10 +443,11 @@ Our final version of ``nif``, built with ``defmacro/g!`` becomes:
.. code-block:: hy .. code-block:: hy
(defmacro/g! nif [expr pos-form zero-form neg-form] (defmacro/g! nif [expr pos-form zero-form neg-form]
`(let [~g!res ~expr] `(do
(setv ~g!res ~expr)
(cond [(pos? ~g!res) ~pos-form] (cond [(pos? ~g!res) ~pos-form]
[(zero? ~g!res) ~zero-form] [(zero? ~g!res) ~zero-form]
[(neg? ~g!res) ~neg-form])))) [(neg? ~g!res) ~neg-form])))

9
docs/style-guide.rst
View File

@ -101,15 +101,6 @@ Layout & Indentation
) ; GAH, BURN IT WITH FIRE ) ; GAH, BURN IT WITH FIRE
+ Vertically align ``let`` blocks.
.. code-block:: clj
(let [foo (bar)
qux (baz)]
(foo qux))
+ Inline comments shall be two spaces from the end of the code; they + Inline comments shall be two spaces from the end of the code; they
must always have a space between the comment character and the start must always have a space between the comment character and the start
of the comment. Also, try to not comment the obvious. of the comment. Also, try to not comment the obvious.

8
docs/tutorial.rst
View File

@ -538,8 +538,8 @@ We can also manipulate code with macros:
.. code-block:: clj .. code-block:: clj
=> (defmacro rev [code] => (defmacro rev [code]
... (let [op (last code) params (list (butlast code))] ... (setv op (last code) params (list (butlast code)))
... `(~op ~@params))) ... `(~op ~@params))
=> (rev (1 2 3 +)) => (rev (1 2 3 +))
6 6
@ -558,8 +558,8 @@ characters that soon):
.. code-block:: clj .. code-block:: clj
=> (defreader ↻ [code] => (defreader ↻ [code]
... (let [op (last code) params (list (butlast code))] ... (setv op (last code) params (list (butlast code)))
... `(~op ~@params))) ... `(~op ~@params))
=> #↻(1 2 3 +) => #↻(1 2 3 +)
6 6

6
hy/contrib/botsbuildbots.hy
View File

@ -26,8 +26,8 @@
(do (do
(import [requests]) (import [requests])
(let [r (requests.get (setv r (requests.get
"https://raw.githubusercontent.com/hylang/hy/master/AUTHORS")] "https://raw.githubusercontent.com/hylang/hy/master/AUTHORS"))
(repeat r.text))) (repeat r.text))
(except [e ImportError] (except [e ImportError]
(repeat "Botsbuildbots requires `requests' to function.")))) (repeat "Botsbuildbots requires `requests' to function."))))

24
hy/contrib/loop.hy
View File

@ -58,13 +58,13 @@
(defmacro/g! fnr [signature &rest body] (defmacro/g! fnr [signature &rest body]
(let [new-body (recursive-replace 'recur g!recur-fn body)] (setv new-body (recursive-replace 'recur g!recur-fn body))
`(do `(do
(import [hy.contrib.loop [--trampoline--]]) (import [hy.contrib.loop [--trampoline--]])
(with-decorator (with-decorator
--trampoline-- --trampoline--
(def ~g!recur-fn (fn [~@signature] ~@new-body))) (def ~g!recur-fn (fn [~@signature] ~@new-body)))
~g!recur-fn))) ~g!recur-fn))
(defmacro defnr [name lambda-list &rest body] (defmacro defnr [name lambda-list &rest body]
@ -86,8 +86,8 @@
;; If recur is used in a non-tail-call position, None is returned, which ;; If recur is used in a non-tail-call position, None is returned, which
;; causes chaos. Fixing this to detect if recur is in a tail-call position ;; causes chaos. Fixing this to detect if recur is in a tail-call position
;; and erroring if not is a giant TODO. ;; and erroring if not is a giant TODO.
(let [fnargs (map (fn [x] (first x)) bindings) (setv fnargs (map (fn [x] (first x)) bindings)
initargs (map second bindings)] initargs (map second bindings))
`(do (require hy.contrib.loop) `(do (require hy.contrib.loop)
(hy.contrib.loop.defnr ~g!recur-fn [~@fnargs] ~@body) (hy.contrib.loop.defnr ~g!recur-fn [~@fnargs] ~@body)
(~g!recur-fn ~@initargs)))) (~g!recur-fn ~@initargs)))

16
hy/core/bootstrap.hy
View File

@ -41,23 +41,13 @@
(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 a function `name` with signature `lambda-list` and body `body`"
(if (not (= (type name) HySymbol)) (import hy)
(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"))
(if (not (isinstance lambda-list HyList)) (if (not (isinstance lambda-list hy.HyList))
(macro-error name "defn takes a parameter list as second argument")) (macro-error name "defn takes a parameter list as second argument"))
`(setv ~name (fn ~lambda-list ~@body))) `(setv ~name (fn ~lambda-list ~@body)))
(defmacro let [variables &rest body]
"Execute `body` in the lexical context of `variables`"
(if (not (isinstance variables HyList))
(macro-error variables "let lexical context must be a list"))
(if (= (len variables) 0)
`((fn []
~@body))
`((fn []
(setv ~@variables)
~@body))))
(defmacro if-python2 [python2-form python3-form] (defmacro if-python2 [python2-form python3-form]
"If running on python2, execute python2-form, else, execute python3-form" "If running on python2, execute python2-form, else, execute python3-form"
(import sys) (import sys)

62
hy/core/language.hy
View File

@ -103,13 +103,12 @@
(defn distinct [coll] (defn distinct [coll]
"Return a generator from the original collection with duplicates "Return a generator from the original collection with duplicates
removed" removed"
(let [seen (set) (setv seen (set) citer (iter coll))
citer (iter coll)]
(for* [val citer] (for* [val citer]
(if (not_in val seen) (if (not_in val seen)
(do (do
(yield val) (yield val)
(.add seen val)))))) (.add seen val)))))
(if-python2 (if-python2
(def (def
@ -178,9 +177,9 @@
(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."
(let [iters (tee coll)] (setv iters (tee coll))
(map first (apply zip [(get iters 0) (map first (apply 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" "Return True if `coll` is empty"
@ -229,14 +228,14 @@
(setv _gensym_lock (Lock)) (setv _gensym_lock (Lock))
(defn gensym [&optional [g "G"]] (defn gensym [&optional [g "G"]]
(let [new_symbol None] (setv new_symbol None)
(global _gensym_counter) (global _gensym_counter)
(global _gensym_lock) (global _gensym_lock)
(.acquire _gensym_lock) (.acquire _gensym_lock)
(try (do (setv _gensym_counter (inc _gensym_counter)) (try (do (setv _gensym_counter (inc _gensym_counter))
(setv new_symbol (HySymbol (.format ":{0}_{1}" g _gensym_counter)))) (setv new_symbol (HySymbol (.format ":{0}_{1}" g _gensym_counter))))
(finally (.release _gensym_lock))) (finally (.release _gensym_lock)))
new_symbol)) new_symbol)
(defn calling-module-name [&optional [n 1]] (defn calling-module-name [&optional [n 1]]
"Get the name of the module calling `n` levels up the stack from the "Get the name of the module calling `n` levels up the stack from the
@ -335,16 +334,16 @@
from the latter (left-to-right) will be combined with the mapping in from the latter (left-to-right) will be combined with the mapping in
the result by calling (f val-in-result val-in-latter)." the result by calling (f val-in-result val-in-latter)."
(if (any maps) (if (any maps)
(let [merge-entry (fn [m e] (do
(let [k (get e 0) (defn merge-entry [m e]
v (get e 1)] (setv k (get e 0) v (get e 1))
(if (in k m) (if (in k m)
(assoc m k (f (get m k) v)) (assoc m k (f (get m k) v))
(assoc m k v))) (assoc m k v))
m) m)
merge2 (fn [m1 m2] (defn merge2 [m1 m2]
(reduce merge-entry (.items m2) (or m1 {})))] (reduce merge-entry (.items m2) (or m1 {})))
(reduce merge2 maps)))) (reduce merge2 maps))))
(defn neg? [n] (defn neg? [n]
"Return true if n is < 0" "Return true if n is < 0"
@ -420,14 +419,13 @@
(defn take-nth [n coll] (defn take-nth [n coll]
"Return every nth member of coll "Return every nth member of coll
raises ValueError for (not (pos? n))" raises ValueError for (not (pos? n))"
(if (pos? n) (if (not (pos? n))
(let [citer (iter coll) (raise (ValueError "n must be positive")))
skip (dec n)] (setv citer (iter coll) skip (dec n))
(for* [val citer] (for* [val citer]
(yield val) (yield val)
(for* [_ (range skip)] (for* [_ (range skip)]
(next citer)))) (next citer))))
(raise (ValueError "n must be positive"))))
(defn zero? [n] (defn zero? [n]
"Return true if n is 0" "Return true if n is 0"

48
hy/core/macros.hy
View File

@ -125,8 +125,8 @@
[(empty? args) `(do ~@body ~@belse)] [(empty? args) `(do ~@body ~@belse)]
[(= (len args) 2) `(for* [~@args] (do ~@body) ~@belse)] [(= (len args) 2) `(for* [~@args] (do ~@body) ~@belse)]
[True [True
(let [alist (cut args 0 None 2)] (setv alist (cut args 0 None 2))
`(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] (do ~@body) ~@belse))])) `(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] (do ~@body) ~@belse)]))
(defmacro -> [head &rest rest] (defmacro -> [head &rest rest]
@ -151,7 +151,8 @@
(if (isinstance expression HyExpression) (if (isinstance expression HyExpression)
`(~(first expression) ~f ~@(rest expression)) `(~(first expression) ~f ~@(rest expression))
`(~expression ~f))) `(~expression ~f)))
`(let [~f ~form] `(do
(setv ~f ~form)
~@(map build-form expressions) ~@(map build-form expressions)
~f)) ~f))
@ -203,23 +204,24 @@
(defmacro with-gensyms [args &rest body] (defmacro with-gensyms [args &rest body]
(setv syms []) (setv syms [])
(for* [arg args] (for* [arg args]
(.extend syms `[~arg (gensym '~arg)])) (.extend syms [arg `(gensym '~arg)]))
`(let ~syms `(do
~@body)) (setv ~@syms)
~@body))
(defmacro defmacro/g! [name args &rest body] (defmacro defmacro/g! [name args &rest body]
(let [syms (list (setv syms (list
(distinct (distinct
(filter (fn [x] (filter (fn [x]
(and (hasattr x "startswith") (and (hasattr x "startswith")
(.startswith x "g!"))) (.startswith x "g!")))
(flatten body)))) (flatten body))))
gensyms []] gensyms [])
(for* [sym syms] (for* [sym syms]
(.extend gensyms `[~sym (gensym (cut '~sym 2))])) (.extend gensyms [sym `(gensym ~(cut sym 2))]))
`(defmacro ~name [~@args] `(defmacro ~name [~@args]
(let ~gensyms (setv ~@gensyms)
~@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! plus automatic once-only evaluation for o!
@ -251,17 +253,15 @@
(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"
(let [retval (gensym) (setv retval (gensym))
mainfn `(fn [~@args] `(when (= --name-- "__main__")
~@body)] (import sys)
`(when (= --name-- "__main__") (setv ~retval (apply (fn [~@args] ~@body) sys.argv))
(import sys) (if (integer? ~retval)
(setv ~retval (apply ~mainfn sys.argv)) (sys.exit ~retval))))
(if (integer? ~retval)
(sys.exit ~retval)))))
(defreader @ [expr] (defreader @ [expr]
(let [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))

36
hy/core/shadow.hy
View File

@ -26,22 +26,22 @@
(defn + [&rest args] (defn + [&rest args]
"Shadow + operator for when we need to import / map it against something" "Shadow + operator for when we need to import / map it against something"
(let [count (len args)] (if
(if (zero? count) (= (len args) 1)
(raise (TypeError "Need at least 1 argument to add/concatenate")) (operator.pos (get args 0))
(if (= count 1) args
(operator.pos (get args 0)) (reduce operator.add args)
(reduce operator.add args))))) (raise (TypeError "Need at least 1 argument to add/concatenate"))))
(defn - [&rest args] (defn - [&rest args]
"Shadow - operator for when we need to import / map it against something" "Shadow - operator for when we need to import / map it against something"
(let [count (len args)] (if
(if (= count 0) (= (len args) 1)
(raise (TypeError "Need at least 1 argument to subtract")) (- (get args 0))
(if (= count 1) args
(- (get args 0)) (reduce operator.sub args)
(reduce operator.sub args))))) (raise (TypeError "Need at least 1 argument to subtract"))))
(defn * [&rest args] (defn * [&rest args]
@ -53,12 +53,12 @@
(defn / [&rest args] (defn / [&rest args]
"Shadow / operator for when we need to import / map it against something" "Shadow / operator for when we need to import / map it against something"
(let [count (len args)] (if
(if (= count 0) (= (len args) 1)
(raise (TypeError "Need at least 1 argument to divide")) (operator.truediv 1 (get args 0))
(if (= count 1) args
(operator.truediv 1 (get args 0)) (reduce operator.truediv args)
(reduce operator.truediv args))))) (raise (TypeError "Need at least 1 argument to divide"))))
(defn comp-op [op args] (defn comp-op [op args]

59
hy/extra/anaphoric.hy
View File

@ -26,8 +26,9 @@
(defmacro ap-if [test-form then-form &optional else-form] (defmacro ap-if [test-form then-form &optional else-form]
`(let [it ~test-form] `(do
(if it ~then-form ~else-form))) (setv it ~test-form)
(if it ~then-form ~else-form)))
(defmacro ap-each [lst &rest body] (defmacro ap-each [lst &rest body]
@ -38,38 +39,44 @@
(defmacro ap-each-while [lst form &rest body] (defmacro ap-each-while [lst form &rest body]
"Evaluate the body form for each element in the list while the "Evaluate the body form for each element in the list while the
predicate form evaluates to True." predicate form evaluates to True."
`(let [p (lambda [it] ~form)] (setv p (gensym))
`(do
(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."
(let [v (gensym 'v) (setv v (gensym 'v) f (gensym 'f))
f (gensym 'f)] `((fn []
`(let [~f (lambda [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]
"Yield elements evaluated for each element in the list when the "Yield elements evaluated for each element in the list when the
predicate function returns True." predicate function returns True."
`(let [f (lambda [it] ~rep)] (setv f (gensym))
`((fn []
(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."
`(let [pred (lambda [it] ~form)] (setv pred (gensym))
`((fn []
(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]
@ -80,14 +87,15 @@
(defmacro ap-dotimes [n &rest body] (defmacro ap-dotimes [n &rest body]
"Execute body for side effects `n' times, with it bound from 0 to n-1" "Execute body for side effects `n' times, with it bound from 0 to n-1"
(unless (numeric? n) (unless (numeric? n)
(raise (TypeError (.format "{0!r} is not a number" n)))) (raise (TypeError (.format "{!r} is not a number" n))))
`(ap-each (range ~n) ~@body)) `(ap-each (range ~n) ~@body))
(defmacro ap-first [predfn lst] (defmacro ap-first [predfn lst]
"Yield the first element that passes `predfn`" "Yield the first element that passes `predfn`"
(with-gensyms [n] (with-gensyms [n]
`(let [~n None] `(do
(setv ~n None)
(ap-each ~lst (when ~predfn (setv ~n it) (break))) (ap-each ~lst (when ~predfn (setv ~n it) (break)))
~n))) ~n)))
@ -95,7 +103,8 @@
(defmacro ap-last [predfn lst] (defmacro ap-last [predfn lst]
"Yield the last element that passes `predfn`" "Yield the last element that passes `predfn`"
(with-gensyms [n] (with-gensyms [n]
`(let [~n None] `(do
(setv ~n None)
(ap-each ~lst (none? ~n) (ap-each ~lst (none? ~n)
(when ~predfn (when ~predfn
(setv ~n it))) (setv ~n it)))
@ -104,20 +113,18 @@
(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"
(if (none? initial-value) `(do
`(let [acc (car ~lst)] (setv acc ~(if (none? initial-value) `(car ~lst) initial-value))
(ap-each (cdr ~lst) (setv acc ~form)) (ap-each ~(if (none? initial-value) `(cdr ~lst) lst)
acc) (setv acc ~form))
`(let [acc ~initial-value] acc))
(ap-each ~lst (setv acc ~form))
acc)))
(defmacro ap-pipe [var &rest forms] (defmacro ap-pipe [var &rest forms]
"Pushes a value through several forms. "Pushes a value through several forms.
(Anaphoric version of -> and ->>)" (Anaphoric version of -> and ->>)"
(if (empty? forms) var (if (empty? forms) var
`(ap-pipe (let [it ~var] ~(first forms)) ~@(rest forms)))) `(ap-pipe (do (setv it ~var) ~(first forms)) ~@(rest forms))))
(defmacro ap-compose [&rest forms] (defmacro ap-compose [&rest forms]

16
tests/compilers/test_ast.py
View File

@ -333,22 +333,6 @@ def test_ast_invalid_for():
cant_compile("(for* [a 1] (else 1 2))") cant_compile("(for* [a 1] (else 1 2))")
def test_ast_valid_let():
"Make sure AST can compile valid let"
can_compile("(let [a b])")
can_compile("(let [a 1])")
can_compile("(let [a 1 b None])")
def test_ast_invalid_let():
"Make sure AST can't compile invalid let"
cant_compile("(let 1)")
cant_compile("(let [1])")
cant_compile("(let [a 1 2])")
cant_compile("(let [a])")
cant_compile("(let [1])")
def test_ast_expression_basics(): def test_ast_expression_basics():
""" Ensure basic AST expression conversion works. """ """ Ensure basic AST expression conversion works. """
code = can_compile("(foo bar)").body[0] code = can_compile("(foo bar)").body[0]

24
tests/native_tests/contrib/walk.hy
View File

@ -15,20 +15,20 @@
walk-form))) walk-form)))
(defn test-walk [] (defn test-walk []
(let [acc '()] (setv acc '())
(assert (= (walk (partial collector acc) identity walk-form) (assert (= (walk (partial collector acc) identity walk-form)
[None None])) [None None]))
(assert (= acc walk-form))) (assert (= acc walk-form))
(let [acc []] (setv acc [])
(assert (= (walk identity (partial collector acc) walk-form) (assert (= (walk identity (partial collector acc) walk-form)
None)) None))
(assert (= acc [walk-form])))) (assert (= acc [walk-form])))
(defn test-walk-iterators [] (defn test-walk-iterators []
(let [acc []] (setv acc [])
(assert (= (walk (fn [x] (* 2 x)) (fn [x] x) (assert (= (walk (fn [x] (* 2 x)) (fn [x] x)
(drop 1 [1 [2 [3 [4]]]])) (drop 1 [1 [2 [3 [4]]]]))
[[2 [3 [4]] 2 [3 [4]]]])))) [[2 [3 [4]] 2 [3 [4]]]])))
(defn test-macroexpand-all [] (defn test-macroexpand-all []
(assert (= (macroexpand-all '(with [a 1 b 2 c 3] (for [d c] foo))) (assert (= (macroexpand-all '(with [a 1 b 2 c 3] (for [d c] foo)))

10
tests/native_tests/core.hy
View File

@ -561,11 +561,11 @@
(setv res (list (take-nth 3 [1 2 3 None 5 6]))) (setv res (list (take-nth 3 [1 2 3 None 5 6])))
(assert-equal res [1 None]) (assert-equal res [1 None])
;; using 0 should raise ValueError ;; using 0 should raise ValueError
(let [passed False] (setv passed False)
(try (try
(setv res (list (take-nth 0 [1 2 3 4 5 6 7]))) (setv res (list (take-nth 0 [1 2 3 4 5 6 7])))
(except [ValueError] (setv passed True))) (except [ValueError] (setv passed True)))
(assert passed))) (assert passed))
(defn test-take-while [] (defn test-take-while []
"NATIVE: testing the take-while function" "NATIVE: testing the take-while function"

6
tests/native_tests/defclass.hy
View File

@ -36,9 +36,9 @@
(+ self.x value))]) (+ self.x value))])
(assert (= B.x 42)) (assert (= B.x 42))
(assert (= (.y (B) 5) 47)) (assert (= (.y (B) 5) 47))
(let [b (B)] (setv b (B))
(setv B.x 0) (setv B.x 0)
(assert (= (.y b 1) 1)))) (assert (= (.y b 1) 1)))
(defn test-defclass-dynamic-inheritance [] (defn test-defclass-dynamic-inheritance []

6
tests/native_tests/extra/anaphoric.hy
View File

@ -59,7 +59,7 @@
[3 6 9]) [3 6 9])
(assert-equal (list (ap-map (* it 3) [])) (assert-equal (list (ap-map (* it 3) []))
[]) [])
(assert-equal (let [v 1 f 1] (list (ap-map (it v f) [(fn [a b] (+ a b))]))) (assert-equal (do (setv v 1 f 1) (list (ap-map (it v f) [(fn [a b] (+ a b))])))
[2])) [2]))
(defn test-ap-map-when [] (defn test-ap-map-when []
@ -83,9 +83,9 @@
(defn test-ap-dotimes [] (defn test-ap-dotimes []
"NATIVE: testing anaphoric dotimes" "NATIVE: testing anaphoric dotimes"
(assert-equal (let [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 (let [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 []

283
tests/native_tests/language.hy
View File

@ -449,51 +449,51 @@
(try (do) (except [IOError]) (except)) (try (do) (except [IOError]) (except))
;; Test correct (raise) ;; Test correct (raise)
(let [passed False] (setv passed False)
(try (try
(try (try
(raise IndexError) (raise IndexError)
(except [IndexError] (raise))) (except [IndexError] (raise)))
(except [IndexError] (except [IndexError]
(setv passed True))) (setv passed True)))
(assert passed)) (assert passed)
;; Test incorrect (raise) ;; Test incorrect (raise)
(let [passed False] (setv passed False)
(try (try
(raise) (raise)
;; Python 2 raises TypeError ;; Python 2 raises IndexError here (due to the previous test)
;; Python 3 raises RuntimeError ;; Python 3 raises RuntimeError
(except [[TypeError RuntimeError]] (except [[IndexError RuntimeError]]
(setv passed True))) (setv passed True)))
(assert passed)) (assert passed)
;; Test (finally) ;; Test (finally)
(let [passed False] (setv passed False)
(try (try
(do) (do)
(finally (setv passed True))) (finally (setv passed True)))
(assert passed)) (assert passed)
;; Test (finally) + (raise) ;; Test (finally) + (raise)
(let [passed False] (setv passed False)
(try (try
(raise Exception) (raise Exception)
(except) (except)
(finally (setv passed True))) (finally (setv passed True)))
(assert passed)) (assert passed)
;; Test (finally) + (raise) + (else) ;; Test (finally) + (raise) + (else)
(let [passed False (setv passed False
not-elsed True] not-elsed True)
(try (try
(raise Exception) (raise Exception)
(except) (except)
(else (setv not-elsed False)) (else (setv not-elsed False))
(finally (setv passed True))) (finally (setv passed True)))
(assert passed) (assert passed)
(assert not-elsed)) (assert not-elsed)
(try (try
(raise (KeyError)) (raise (KeyError))
@ -553,37 +553,37 @@
(setv foobar42ofthebaz 42) (setv foobar42ofthebaz 42)
(assert (= foobar42ofthebaz 42)))) (assert (= foobar42ofthebaz 42))))
(let [passed False] (setv passed False)
(try (try
(try (do) (except) (else (bla))) (try (do) (except) (else (bla)))
(except [NameError] (setv passed True))) (except [NameError] (setv passed True)))
(assert passed)) (assert passed)
(let [x 0] (setv x 0)
(try (try
(raise IOError) (raise IOError)
(except [IOError] (except [IOError]
(setv x 45)) (setv x 45))
(else (setv x 44))) (else (setv x 44)))
(assert (= x 45))) (assert (= x 45))
(let [x 0] (setv x 0)
(try (try
(raise KeyError) (raise KeyError)
(except [] (except []
(setv x 45)) (setv x 45))
(else (setv x 44))) (else (setv x 44)))
(assert (= x 45))) (assert (= x 45))
(let [x 0] (setv x 0)
(try (try
(try (try
(raise KeyError) (raise KeyError)
(except [IOError] (except [IOError]
(setv x 45)) (setv x 45))
(else (setv x 44))) (else (setv x 44)))
(except)) (except))
(assert (= x 0)))) (assert (= x 0)))
(defn test-earmuffs [] (defn test-earmuffs []
"NATIVE: Test earmuffs" "NATIVE: Test earmuffs"
@ -677,9 +677,9 @@
(defn test-yield-in-try [] (defn test-yield-in-try []
"NATIVE: test yield in try" "NATIVE: test yield in try"
(defn gen [] (defn gen []
(let [x 1] (setv x 1)
(try (yield x) (try (yield x)
(finally (print x))))) (finally (print x))))
(setv output (list (gen))) (setv output (list (gen)))
(assert (= [1] output))) (assert (= [1] output)))
@ -747,17 +747,17 @@
(defn test-for-else [] (defn test-for-else []
"NATIVE: test for else" "NATIVE: test for else"
(let [x 0] (setv x 0)
(for* [a [1 2]] (for* [a [1 2]]
(setv x (+ x a)) (setv x (+ x a))
(else (setv x (+ x 50)))) (else (setv x (+ x 50))))
(assert (= x 53))) (assert (= x 53))
(let [x 0] (setv x 0)
(for* [a [1 2]] (for* [a [1 2]]
(setv x (+ x a)) (setv x (+ x a))
(else)) (else))
(assert (= x 3)))) (assert (= x 3)))
(defn test-list-comprehensions [] (defn test-list-comprehensions []
@ -864,37 +864,6 @@
(assert (= (fn-test) None))) (assert (= (fn-test) None)))
(defn test-let []
"NATIVE: test let works rightish"
;; TODO: test sad paths for let
(assert (= (let [x 1 y 2 z 3] (+ x y z)) 6))
(assert (= (let [x 1 a None y 2 b None] (if a 1 2)) 2))
(assert (= (let [x None] x) None))
(assert (= (let [x "x not bound"] (setv x "x bound by setv") x)
"x bound by setv"))
(assert (= (let [x "let nests scope correctly"]
(let [y None] x))
"let nests scope correctly"))
(assert (= (let [x 999999]
(let [x "x being rebound"] x))
"x being rebound"))
(assert (= (let [x "x not being rebound"]
(let [x 2] None)
x)
"x not being rebound"))
(assert (= (let [x (set [3 2 1 3 2]) y x z y] z) (set [1 2 3])))
(import math)
(let [cos math.cos
foo-cos (fn [x] (cos x))]
(assert (= (cos math.pi) -1.0))
(assert (= (foo-cos (- math.pi)) -1.0))
(let [cos (fn [_] "cos has been locally rebound")]
(assert (= (cos cos) "cos has been locally rebound"))
(assert (= (-> math.pi (/ 3) foo-cos (round 2)) 0.5)))
(setv cos (fn [_] "cos has been rebound by setv"))
(assert (= (foo-cos foo-cos) "cos has been rebound by setv"))))
(defn test-if-mangler [] (defn test-if-mangler []
"NATIVE: test that we return ifs" "NATIVE: test that we return ifs"
(assert (= True (if True True True)))) (assert (= True (if True True True))))
@ -905,51 +874,38 @@
(assert (= ((fn [] (-> 2 (+ 1 1) (* 1 2)))) 8))) (assert (= ((fn [] (-> 2 (+ 1 1) (* 1 2)))) 8)))
(defn test-let-scope []
"NATIVE: test let works rightish"
(setv y 123)
(assert (= (let [x 1
y 2
z 3]
(+ x y z))
6))
(try
(assert (= x 42)) ; This ain't true
(except [e [NameError]] (assert e)))
(assert (= y 123)))
(defn test-symbol-utf-8 [] (defn test-symbol-utf-8 []
"NATIVE: test symbol encoded" "NATIVE: test symbol encoded"
(let [♥ "love" (setv ♥ "love"
⚘ "flower"] ⚘ "flower")
(assert (= (+ ⚘ ♥) "flowerlove")))) (assert (= (+ ⚘ ♥) "flowerlove")))
(defn test-symbol-dash [] (defn test-symbol-dash []
"NATIVE: test symbol encoded" "NATIVE: test symbol encoded"
(let [♥-♥ "doublelove" (setv ♥-♥ "doublelove"
-_- "what?"] -_- "what?")
(assert (= ♥-♥ "doublelove")) (assert (= ♥-♥ "doublelove"))
(assert (= -_- "what?")))) (assert (= -_- "what?")))
(defn test-symbol-question-mark [] (defn test-symbol-question-mark []
"NATIVE: test foo? -> is_foo behavior" "NATIVE: test foo? -> is_foo behavior"
(let [foo? "nachos"] (setv foo? "nachos")
(assert (= is_foo "nachos")))) (assert (= is_foo "nachos")))
(defn test-and [] (defn test-and []
"NATIVE: test the and function" "NATIVE: test the and function"
(let [and123 (and 1 2 3)
(setv and123 (and 1 2 3)
and-false (and 1 False 3) and-false (and 1 False 3)
and-true (and) and-true (and)
and-single (and 1)] and-single (and 1))
(assert (= and123 3)) (assert (= and123 3))
(assert (= and-false False)) (assert (= and-false False))
(assert (= and-true True)) (assert (= and-true True))
(assert (= and-single 1))) (assert (= and-single 1))
; short circuiting ; short circuiting
(setv a 1) (setv a 1)
(and 0 (setv a 2)) (and 0 (setv a 2))
@ -980,16 +936,16 @@
(defn test-or [] (defn test-or []
"NATIVE: test the or function" "NATIVE: test the or function"
(let [or-all-true (or 1 2 3 True "string") (setv or-all-true (or 1 2 3 True "string")
or-some-true (or False "hello") or-some-true (or False "hello")
or-none-true (or False False) or-none-true (or False False)
or-false (or) or-false (or)
or-single (or 1)] or-single (or 1))
(assert (= or-all-true 1)) (assert (= or-all-true 1))
(assert (= or-some-true "hello")) (assert (= or-some-true "hello"))
(assert (= or-none-true False)) (assert (= or-none-true False))
(assert (= or-false None)) (assert (= or-false None))
(assert (= or-single 1))) (assert (= or-single 1))
; short circuiting ; short circuiting
(setv a 1) (setv a 1)
(or 1 (setv a 2)) (or 1 (setv a 2))
@ -1039,16 +995,12 @@
(defn test-if-return-branching [] (defn test-if-return-branching []
"NATIVE: test the if return branching" "NATIVE: test the if return branching"
; thanks, algernon ; thanks, kirbyfan64
(assert (= 1 (let [x 1 (defn f []
y 2] (if True (setv x 1) 2)
(if True 1)
2)
1))) (assert (= 1 (f))))
(assert (= 1 (let [x 1 y 2]
(do)
(do)
((fn [] 1))))))
(defn test-keyword [] (defn test-keyword []
@ -1107,17 +1059,16 @@
(defn test-eval-globals [] (defn test-eval-globals []
"NATIVE: test eval with explicit global dict" "NATIVE: test eval with explicit global dict"
(assert (= 'bar (eval (quote foo) {'foo 'bar}))) (assert (= 'bar (eval (quote foo) {'foo 'bar})))
(assert (= 1 (let [d {}] (eval '(setv x 1) d) (eval (quote x) d)))) (assert (= 1 (do (setv d {}) (eval '(setv x 1) d) (eval (quote x) d))))
(let [d1 {} (setv d1 {} d2 {})
d2 {}] (eval '(setv x 1) d1)
(eval '(setv x 1) d1) (try
(try (do
(do ; this should fail with a name error
; this should fail with a name error (eval (quote x) d2)
(eval (quote x) d2) (assert False "We shouldn't have arrived here"))
(assert False "We shouldn't have arrived here")) (except [e Exception]
(except [e Exception] (assert (isinstance e NameError)))))
(assert (isinstance e NameError))))))
(defn test-eval-failure [] (defn test-eval-failure []
"NATIVE: test eval failure modes" "NATIVE: test eval failure modes"
@ -1187,10 +1138,6 @@
(assert False)) (assert False))
(except [NameError]))) (except [NameError])))
(defn test-if-let-mixing []
"NATIVE: test that we can now mix if and let"
(assert (= 0 (if True (let [x 0] x) 42))))
(defn test-if-in-if [] (defn test-if-in-if []
"NATIVE: test that we can use if in if" "NATIVE: test that we can use if in if"
(assert (= 42 (assert (= 42

111
tests/native_tests/mathematics.hy
View File

@ -81,75 +81,75 @@
(defn test-augassign-add [] (defn test-augassign-add []
"NATIVE: test augassign add" "NATIVE: test augassign add"
(let [x 1] (setv x 1)
(+= x 41) (+= x 41)
(assert (= x 42)))) (assert (= x 42)))
(defn test-augassign-sub [] (defn test-augassign-sub []
"NATIVE: test augassign sub" "NATIVE: test augassign sub"
(let [x 1] (setv x 1)
(-= x 41) (-= x 41)
(assert (= x -40)))) (assert (= x -40)))
(defn test-augassign-mult [] (defn test-augassign-mult []
"NATIVE: test augassign mult" "NATIVE: test augassign mult"
(let [x 1] (setv x 1)
(*= x 41) (*= x 41)
(assert (= x 41)))) (assert (= x 41)))
(defn test-augassign-div [] (defn test-augassign-div []
"NATIVE: test augassign div" "NATIVE: test augassign div"
(let [x 42] (setv x 42)
(/= x 2) (/= x 2)
(assert (= x 21)))) (assert (= x 21)))
(defn test-augassign-floordiv [] (defn test-augassign-floordiv []
"NATIVE: test augassign floordiv" "NATIVE: test augassign floordiv"
(let [x 42] (setv x 42)
(//= x 2) (//= x 2)
(assert (= x 21)))) (assert (= x 21)))
(defn test-augassign-mod [] (defn test-augassign-mod []
"NATIVE: test augassign mod" "NATIVE: test augassign mod"
(let [x 42] (setv x 42)
(%= x 2) (%= x 2)
(assert (= x 0)))) (assert (= x 0)))
(defn test-augassign-pow [] (defn test-augassign-pow []
"NATIVE: test augassign pow" "NATIVE: test augassign pow"
(let [x 2] (setv x 2)
(**= x 3) (**= x 3)
(assert (= x 8)))) (assert (= x 8)))
(defn test-augassign-lshift [] (defn test-augassign-lshift []
"NATIVE: test augassign lshift" "NATIVE: test augassign lshift"
(let [x 2] (setv x 2)
(<<= x 2) (<<= x 2)
(assert (= x 8)))) (assert (= x 8)))
(defn test-augassign-rshift [] (defn test-augassign-rshift []
"NATIVE: test augassign rshift" "NATIVE: test augassign rshift"
(let [x 8] (setv x 8)
(>>= x 1) (>>= x 1)
(assert (= x 4)))) (assert (= x 4)))
(defn test-augassign-bitand [] (defn test-augassign-bitand []
"NATIVE: test augassign bitand" "NATIVE: test augassign bitand"
(let [x 8] (setv x 8)
(&= x 1) (&= x 1)
(assert (= x 0)))) (assert (= x 0)))
(defn test-augassign-bitor [] (defn test-augassign-bitor []
"NATIVE: test augassign bitand" "NATIVE: test augassign bitand"
(let [x 0] (setv x 0)
(|= x 2) (|= x 2)
(assert (= x 2)))) (assert (= x 2)))
(defn test-augassign-bitxor [] (defn test-augassign-bitxor []
"NATIVE: test augassign bitand" "NATIVE: test augassign bitand"
(let [x 1] (setv x 1)
(^= x 1) (^= x 1)
(assert (= x 0)))) (assert (= x 0)))
(defn overflow-int-to-long [] (defn overflow-int-to-long []
"NATIVE: test if int does not raise an overflow exception" "NATIVE: test if int does not raise an overflow exception"
@ -159,19 +159,19 @@
(defclass HyTestMatrix [list] (defclass HyTestMatrix [list]
[--matmul-- [--matmul--
(fn [self other] (fn [self other]
(let [n (len self) (setv n (len self)
m (len (. other [0])) m (len (. other [0]))
result []] result [])
(for [i (range m)] (for [i (range m)]
(let [result-row []] (setv result-row [])
(for [j (range n)] (for [j (range n)]
(let [dot-product 0] (setv dot-product 0)
(for [k (range (len (. self [0])))] (for [k (range (len (. self [0])))]
(+= dot-product (* (. self [i] [k]) (+= dot-product (* (. self [i] [k])
(. other [k] [j])))) (. other [k] [j]))))
(.append result-row dot-product))) (.append result-row dot-product))
(.append result result-row))) (.append result result-row))
result))]) result)])
(def first-test-matrix (HyTestMatrix [[1 2 3] (def first-test-matrix (HyTestMatrix [[1 2 3]
[4 5 6] [4 5 6]
@ -191,15 +191,16 @@
(assert (= (@ first-test-matrix second-test-matrix) (assert (= (@ first-test-matrix second-test-matrix)
product-of-test-matrices)) product-of-test-matrices))
;; Python <= 3.4 ;; Python <= 3.4
(let [matmul-attempt (try (@ first-test-matrix second-test-matrix) (do
(except [e [Exception]] e))] (setv matmul-attempt (try (@ first-test-matrix second-test-matrix)
(except [e [Exception]] e)))
(assert (isinstance matmul-attempt NameError))))) (assert (isinstance matmul-attempt NameError)))))
(defn test-augassign-matmul [] (defn test-augassign-matmul []
"NATIVE: test augmented-assignment matrix multiplication" "NATIVE: test augmented-assignment matrix multiplication"
(let [matrix first-test-matrix (setv matrix first-test-matrix
matmul-attempt (try (@= matrix second-test-matrix) matmul-attempt (try (@= matrix second-test-matrix)
(except [e [Exception]] e))] (except [e [Exception]] e)))
(if PY35 (if PY35
(assert (= product-of-test-matrices matrix)) (assert (= product-of-test-matrices matrix))
(assert (isinstance matmul-attempt NameError))))) (assert (isinstance matmul-attempt NameError))))

20
tests/native_tests/native_macros.hy
View File

@ -132,11 +132,12 @@
(import [astor.codegen [to_source]]) (import [astor.codegen [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]
(let [g (gensym)] (setv g (gensym))
`(let [~g ~expr] `(do
(cond [(pos? ~g) ~pos] (setv ~g ~expr)
[(zero? ~g) ~zero] (cond [(pos? ~g) ~pos]
[(neg? ~g) ~neg])))) [(zero? ~g) ~zero]
[(neg? ~g) ~neg])))
(print (nif (inc -1) 1 0 -1)) (print (nif (inc -1) 1 0 -1))
") ")
@ -158,7 +159,8 @@
(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]
`(let [~a ~expr] `(do
(setv ~a ~expr)
(cond [(pos? ~a) ~pos] (cond [(pos? ~a) ~pos]
[(zero? ~a) ~zero] [(zero? ~a) ~zero]
[(neg? ~a) ~neg])))) [(neg? ~a) ~neg]))))
@ -180,7 +182,8 @@
(import [astor.codegen [to_source]]) (import [astor.codegen [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]
`(let [~g!res ~expr] `(do
(setv ~g!res ~expr)
(cond [(pos? ~g!res) ~pos] (cond [(pos? ~g!res) ~pos]
[(zero? ~g!res) ~zero] [(zero? ~g!res) ~zero]
[(neg? ~g!res) ~neg]))) [(neg? ~g!res) ~neg])))
@ -208,7 +211,8 @@
(import [astor.codegen [to_source]]) (import [astor.codegen [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]
`(let [~g!res ~expr] `(do
(setv ~g!res ~expr)
(cond [(pos? ~g!res) ~pos] (cond [(pos? ~g!res) ~pos]
[(zero? ~g!res) ~zero] [(zero? ~g!res) ~zero]
[(neg? ~g!res) ~neg]))) [(neg? ~g!res) ~neg])))

37
tests/native_tests/py3_only_tests.hy
View File

@ -15,24 +15,23 @@
(defn test-kwonly [] (defn test-kwonly []
"NATIVE: test keyword-only arguments" "NATIVE: test keyword-only arguments"
;; keyword-only with default works ;; keyword-only with default works
(let [kwonly-foo-default-false (fn [&kwonly [foo False]] foo)] (defn kwonly-foo-default-false [&kwonly [foo False]] foo)
(assert (= (apply kwonly-foo-default-false) False)) (assert (= (apply kwonly-foo-default-false) False))
(assert (= (apply kwonly-foo-default-false [] {"foo" True}) True))) (assert (= (apply kwonly-foo-default-false [] {"foo" True}) True))
;; keyword-only without default ... ;; keyword-only without default ...
(let [kwonly-foo-no-default (fn [&kwonly foo] foo) (defn kwonly-foo-no-default [&kwonly foo] foo)
attempt-to-omit-default (try (setv attempt-to-omit-default (try
(kwonly-foo-no-default) (kwonly-foo-no-default)
(except [e [Exception]] e))] (except [e [Exception]] e)))
;; works ;; works
(assert (= (apply kwonly-foo-no-default [] {"foo" "quux"}) "quux")) (assert (= (apply kwonly-foo-no-default [] {"foo" "quux"}) "quux"))
;; raises TypeError with appropriate message if not supplied ;; raises TypeError with appropriate message if not supplied
(assert (isinstance attempt-to-omit-default TypeError)) (assert (isinstance attempt-to-omit-default TypeError))
(assert (in "missing 1 required keyword-only argument: 'foo'" (assert (in "missing 1 required keyword-only argument: 'foo'"
(. attempt-to-omit-default args [0])))) (. attempt-to-omit-default args [0])))
;; keyword-only with other arg types works ;; keyword-only with other arg types works
(let [function-of-various-args (defn function-of-various-args [a b &rest args &kwonly foo &kwargs kwargs]
(fn [a b &rest args &kwonly foo &kwargs kwargs] (, a b args foo kwargs))
(, a b args foo kwargs))] (assert (= (apply function-of-various-args
(assert (= (apply function-of-various-args [1 2 3 4] {"foo" 5 "bar" 6 "quux" 7})
[1 2 3 4] {"foo" 5 "bar" 6 "quux" 7}) (, 1 2 (, 3 4) 5 {"bar" 6 "quux" 7}))))
(, 1 2 (, 3 4) 5 {"bar" 6 "quux" 7})))))

96
tests/native_tests/shadow.hy
View File

@ -1,51 +1,51 @@
(defn test-shadow-addition [] (defn test-shadow-addition []
"NATIVE: test shadow addition" "NATIVE: test shadow addition"
(let [x +] (setv x +)
(assert (try (assert (try
(x) (x)
(except [TypeError] True) (except [TypeError] True)
(else (raise AssertionError)))) (else (raise AssertionError))))
(assert (= (x 1 2 3 4) 10)) (assert (= (x 1 2 3 4) 10))
(assert (= (x 1 2 3 4 5) 15)) (assert (= (x 1 2 3 4 5) 15))
; with strings ; with strings
(assert (= (x "a" "b" "c") (assert (= (x "a" "b" "c")
"abc")) "abc"))
; with lists ; with lists
(assert (= (x ["a"] ["b"] ["c"]) (assert (= (x ["a"] ["b"] ["c"])
["a" "b" "c"])))) ["a" "b" "c"])))
(defn test-shadow-subtraction [] (defn test-shadow-subtraction []
"NATIVE: test shadow subtraction" "NATIVE: test shadow subtraction"
(let [x -] (setv x -)
(assert (try (assert (try
(x) (x)
(except [TypeError] True) (except [TypeError] True)
(else (raise AssertionError)))) (else (raise AssertionError))))
(assert (= (x 1) -1)) (assert (= (x 1) -1))
(assert (= (x 2 1) 1)) (assert (= (x 2 1) 1))
(assert (= (x 2 1 1) 0)))) (assert (= (x 2 1 1) 0)))
(defn test-shadow-multiplication [] (defn test-shadow-multiplication []
"NATIVE: test shadow multiplication" "NATIVE: test shadow multiplication"
(let [x *] (setv x *)
(assert (= (x) 1)) (assert (= (x) 1))
(assert (= (x 3) 3)) (assert (= (x 3) 3))
(assert (= (x 3 3) 9)))) (assert (= (x 3 3) 9)))
(defn test-shadow-division [] (defn test-shadow-division []
"NATIVE: test shadow division" "NATIVE: test shadow division"
(let [x /] (setv x /)
(assert (try (assert (try
(x) (x)
(except [TypeError] True) (except [TypeError] True)
(else (raise AssertionError)))) (else (raise AssertionError))))
(assert (= (x 1) 1)) (assert (= (x 1) 1))
(assert (= (x 8 2) 4)) (assert (= (x 8 2) 4))
(assert (= (x 8 2 2) 2)) (assert (= (x 8 2 2) 2))
(assert (= (x 8 2 2 2) 1)))) (assert (= (x 8 2 2 2) 1)))
(defn test-shadow-compare [] (defn test-shadow-compare []
@ -70,24 +70,24 @@
[2 2]]] [2 2]]]
(assert (= (apply x args) (not (apply y args)))))) (assert (= (apply x args) (not (apply y args))))))
(let [s-lt < (setv s-lt <
s-gt > s-gt >
s-le <= s-le <=
s-ge >= s-ge >=
s-eq = s-eq =
s-ne !=] s-ne !=)
(assert (apply s-lt [1 2 3])) (assert (apply s-lt [1 2 3]))
(assert (not (apply s-lt [3 2 1]))) (assert (not (apply s-lt [3 2 1])))
(assert (apply s-gt [3 2 1])) (assert (apply s-gt [3 2 1]))
(assert (not (apply s-gt [1 2 3]))) (assert (not (apply s-gt [1 2 3])))
(assert (apply s-le [1 1 2 2 3 3])) (assert (apply s-le [1 1 2 2 3 3]))
(assert (not (apply s-le [1 1 2 2 1 1]))) (assert (not (apply s-le [1 1 2 2 1 1])))
(assert (apply s-ge [3 3 2 2 1 1])) (assert (apply s-ge [3 3 2 2 1 1]))
(assert (not (apply s-ge [3 3 2 2 3 3]))) (assert (not (apply s-ge [3 3 2 2 3 3])))
(assert (apply s-eq [1 1 1 1 1])) (assert (apply s-eq [1 1 1 1 1]))
(assert (not (apply s-eq [1 1 2 1 1]))) (assert (not (apply s-eq [1 1 2 1 1])))
(assert (apply s-ne [1 2 3 4 5])) (assert (apply s-ne [1 2 3 4 5]))
(assert (not (apply s-ne [1 1 2 3 4])))) (assert (not (apply s-ne [1 1 2 3 4])))
; Make sure chained comparisons use `and`, not `&`. ; Make sure chained comparisons use `and`, not `&`.
; https://github.com/hylang/hy/issues/1191 ; https://github.com/hylang/hy/issues/1191