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
[ 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
[ Bug Fixes ]

93
docs/language/api.rst
View File

@ -286,17 +286,20 @@ Examples of usage:
.. code-block:: clj
=>(let [collection {}]
=>(do
... (setv collection {})
... (assoc collection "Dog" "Bark")
... (print collection))
{u'Dog': u'Bark'}
=>(let [collection {}]
=>(do
... (setv collection {})
... (assoc collection "Dog" "Bark" "Cat" "Meow")
... (print collection))
{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)
... (print collection))
[1, 2, None, 4]
@ -555,9 +558,9 @@ Parameters may have the following keywords in front of them:
.. code-block:: clj
=> (defn zig-zag-sum [&rest numbers]
(let [odd-numbers (list-comp x [x numbers] (odd? x))
even-numbers (list-comp x [x numbers] (even? x))]
(- (sum odd-numbers) (sum even-numbers))))
(setv odd-numbers (list-comp x [x numbers] (odd? x))
even-numbers (list-comp x [x numbers] (even? x)))
(- (sum odd-numbers) (sum even-numbers)))
=> (zig-zag-sum)
0
@ -578,10 +581,10 @@ Parameters may have the following keywords in front of them:
.. code-block:: clj
=> (defn compare [a b &kwonly keyfn [reverse false]]
... (let [result (keyfn a b)]
... (if (not reverse)
... result
... (- result))))
... (setv result (keyfn a b))
... (if (not reverse)
... result
... (- result)))
=> (apply compare ["lisp" "python"]
... {"keyfn" (fn [x y]
... (reduce - (map (fn [s] (ord (first s))) [x y])))})
@ -932,8 +935,9 @@ list. Example usage:
.. code-block:: clj
=> (let [animals {"dog" "bark" "cat" "meow"}
... numbers ["zero" "one" "two" "three"]]
=> (do
... (setv animals {"dog" "bark" "cat" "meow"}
... numbers ["zero" "one" "two" "three"])
... (print (get animals "dog"))
... (print (get numbers 2)))
bark
@ -1149,36 +1153,6 @@ last
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
---------
@ -1210,30 +1184,20 @@ nonlocal
``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
to modify variables through nested ``let`` or ``fn`` scopes:
to modify variables through nested ``fn`` scopes:
.. 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 []
(let [x 0]
(register-some-callback
(fn [stuff]
(nonlocal x)
(setv x stuff)))))
(setv x 0)
(register-some-callback
(fn [stuff]
(nonlocal x)
(setv x stuff))))
In the first example, without the call to ``(nonlocal x)``, this code would
result in an UnboundLocalError being raised during the call to ``setv``.
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
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
information.
@ -1699,9 +1663,10 @@ expands to:
.. code-block:: hy
(let [a (gensym)
b (gensym)
c (gensym)]
(do
(setv a (gensym)
b (gensym)
c (gensym))
...)
.. 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")]
... (try
... (while True
... (let [exp (read f)]
... (do
... (print "OHY" exp)
... (eval exp))))
... (setv exp (read f))
... (print "OHY" exp)
... (eval exp))
... (except [e EOFError]
... (print "EOF!"))))
OHY ('print' 'hello')

36
docs/language/internals.rst
View File

@ -381,7 +381,8 @@ A first pass might be something like:
.. code-block:: hy
(defmacro nif [expr pos-form zero-form neg-form]
`(let [obscure-name ~expr]
`(do
(setv obscure-name ~expr)
(cond [(pos? obscure-name) ~pos-form]
[(zero? obscure-name) ~zero-form]
[(neg? obscure-name) ~neg-form])))
@ -396,15 +397,16 @@ such an occasion. A much better version of ``nif`` would be:
.. code-block:: hy
(defmacro nif [expr pos-form zero-form neg-form]
(let [g (gensym)]
`(let [~g ~expr]
(cond [(pos? ~g) ~pos-form]
[(zero? ~g) ~zero-form]
[(neg? ~g) ~neg-form]))))
(setv g (gensym))
`(do
(setv ~g ~expr)
(cond [(pos? ~g) ~pos-form]
[(zero? ~g) ~zero-form]
[(neg? ~g) ~neg-form])))
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
basically expands to a series of ``let`` statements:
basically expands to a ``setv`` form:
.. code-block:: hy
@ -415,9 +417,10 @@ expands to:
.. code-block:: hy
(let [a (gensym)
b (gensym)
c (gensym)]
(do
(setv a (gensym)
b (gensym)
c (gensym))
...)
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]
(with-gensyms [g]
`(let [~g ~expr]
(cond [(pos? ~g) ~pos-form]
[(zero? ~g) ~zero-form]
[(neg? ~g) ~neg-form]))))
`(setv [~g ~expr])
`(cond [(pos? ~g) ~pos-form]
[(zero? ~g) ~zero-form]
[(neg? ~g) ~neg-form])))
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
@ -440,10 +443,11 @@ Our final version of ``nif``, built with ``defmacro/g!`` becomes:
.. code-block:: hy
(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]
[(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
+ 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
must always have a space between the comment character and the start
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
=> (defmacro rev [code]
... (let [op (last code) params (list (butlast code))]
... `(~op ~@params)))
... (setv op (last code) params (list (butlast code)))
... `(~op ~@params))
=> (rev (1 2 3 +))
6
@ -558,8 +558,8 @@ characters that soon):
.. code-block:: clj
=> (defreader ↻ [code]
... (let [op (last code) params (list (butlast code))]
... `(~op ~@params)))
... (setv op (last code) params (list (butlast code)))
... `(~op ~@params))
=> #↻(1 2 3 +)
6

6
hy/contrib/botsbuildbots.hy
View File

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

24
hy/contrib/loop.hy
View File

@ -58,13 +58,13 @@
(defmacro/g! fnr [signature &rest body]
(let [new-body (recursive-replace 'recur g!recur-fn body)]
`(do
(import [hy.contrib.loop [--trampoline--]])
(with-decorator
--trampoline--
(def ~g!recur-fn (fn [~@signature] ~@new-body)))
~g!recur-fn)))
(setv new-body (recursive-replace 'recur g!recur-fn body))
`(do
(import [hy.contrib.loop [--trampoline--]])
(with-decorator
--trampoline--
(def ~g!recur-fn (fn [~@signature] ~@new-body)))
~g!recur-fn))
(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
;; causes chaos. Fixing this to detect if recur is in a tail-call position
;; and erroring if not is a giant TODO.
(let [fnargs (map (fn [x] (first x)) bindings)
initargs (map second bindings)]
`(do (require hy.contrib.loop)
(hy.contrib.loop.defnr ~g!recur-fn [~@fnargs] ~@body)
(~g!recur-fn ~@initargs))))
(setv fnargs (map (fn [x] (first x)) bindings)
initargs (map second bindings))
`(do (require hy.contrib.loop)
(hy.contrib.loop.defnr ~g!recur-fn [~@fnargs] ~@body)
(~g!recur-fn ~@initargs)))

16
hy/core/bootstrap.hy
View File

@ -41,23 +41,13 @@
(defmacro defn [name lambda-list &rest 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"))
(if (not (isinstance lambda-list HyList))
(if (not (isinstance lambda-list hy.HyList))
(macro-error name "defn takes a parameter list as second argument"))
`(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]
"If running on python2, execute python2-form, else, execute python3-form"
(import sys)

62
hy/core/language.hy
View File

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

48
hy/core/macros.hy
View File

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

36
hy/core/shadow.hy
View File

@ -26,22 +26,22 @@
(defn + [&rest args]
"Shadow + operator for when we need to import / map it against something"
(let [count (len args)]
(if (zero? count)
(raise (TypeError "Need at least 1 argument to add/concatenate"))
(if (= count 1)
(operator.pos (get args 0))
(reduce operator.add args)))))
(if
(= (len args) 1)
(operator.pos (get args 0))
args
(reduce operator.add args)
(raise (TypeError "Need at least 1 argument to add/concatenate"))))
(defn - [&rest args]
"Shadow - operator for when we need to import / map it against something"
(let [count (len args)]
(if (= count 0)
(raise (TypeError "Need at least 1 argument to subtract"))
(if (= count 1)
(- (get args 0))
(reduce operator.sub args)))))
(if
(= (len args) 1)
(- (get args 0))
args
(reduce operator.sub args)
(raise (TypeError "Need at least 1 argument to subtract"))))
(defn * [&rest args]
@ -53,12 +53,12 @@
(defn / [&rest args]
"Shadow / operator for when we need to import / map it against something"
(let [count (len args)]
(if (= count 0)
(raise (TypeError "Need at least 1 argument to divide"))
(if (= count 1)
(operator.truediv 1 (get args 0))
(reduce operator.truediv args)))))
(if
(= (len args) 1)
(operator.truediv 1 (get args 0))
args
(reduce operator.truediv args)
(raise (TypeError "Need at least 1 argument to divide"))))
(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]
`(let [it ~test-form]
(if it ~then-form ~else-form)))
`(do
(setv it ~test-form)
(if it ~then-form ~else-form)))
(defmacro ap-each [lst &rest body]
@ -38,38 +39,44 @@
(defmacro ap-each-while [lst form &rest body]
"Evaluate the body form for each element in the list while the
predicate form evaluates to True."
`(let [p (lambda [it] ~form)]
(setv p (gensym))
`(do
(defn ~p [it] ~form)
(for [it ~lst]
(if (p it)
(if (~p it)
~@body
(break)))))
(defmacro ap-map [form lst]
"Yield elements evaluated in the form for each element in the list."
(let [v (gensym 'v)
f (gensym 'f)]
`(let [~f (lambda [it] ~form)]
(for [~v ~lst]
(yield (~f ~v))))))
(setv v (gensym 'v) f (gensym 'f))
`((fn []
(defn ~f [it] ~form)
(for [~v ~lst]
(yield (~f ~v))))))
(defmacro ap-map-when [predfn rep lst]
"Yield elements evaluated for each element in the list when the
predicate function returns True."
`(let [f (lambda [it] ~rep)]
(setv f (gensym))
`((fn []
(defn ~f [it] ~rep)
(for [it ~lst]
(if (~predfn it)
(yield (f it))
(yield it)))))
(yield (~f it))
(yield it))))))
(defmacro ap-filter [form lst]
"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]
(if (pred val)
(yield val)))))
(if (~pred val)
(yield val))))))
(defmacro ap-reject [form lst]
@ -80,14 +87,15 @@
(defmacro ap-dotimes [n &rest body]
"Execute body for side effects `n' times, with it bound from 0 to n-1"
(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))
(defmacro ap-first [predfn lst]
"Yield the first element that passes `predfn`"
(with-gensyms [n]
`(let [~n None]
`(do
(setv ~n None)
(ap-each ~lst (when ~predfn (setv ~n it) (break)))
~n)))
@ -95,7 +103,8 @@
(defmacro ap-last [predfn lst]
"Yield the last element that passes `predfn`"
(with-gensyms [n]
`(let [~n None]
`(do
(setv ~n None)
(ap-each ~lst (none? ~n)
(when ~predfn
(setv ~n it)))
@ -104,20 +113,18 @@
(defmacro ap-reduce [form lst &optional [initial-value None]]
"Anaphoric form of reduce, `acc' and `it' can be used for a form"
(if (none? initial-value)
`(let [acc (car ~lst)]
(ap-each (cdr ~lst) (setv acc ~form))
acc)
`(let [acc ~initial-value]
(ap-each ~lst (setv acc ~form))
acc)))
`(do
(setv acc ~(if (none? initial-value) `(car ~lst) initial-value))
(ap-each ~(if (none? initial-value) `(cdr ~lst) lst)
(setv acc ~form))
acc))
(defmacro ap-pipe [var &rest forms]
"Pushes a value through several forms.
(Anaphoric version of -> and ->>)"
(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]

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))")
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():
""" Ensure basic AST expression conversion works. """
code = can_compile("(foo bar)").body[0]

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

@ -15,20 +15,20 @@
walk-form)))
(defn test-walk []
(let [acc '()]
(assert (= (walk (partial collector acc) identity walk-form)
[None None]))
(assert (= acc walk-form)))
(let [acc []]
(assert (= (walk identity (partial collector acc) walk-form)
None))
(assert (= acc [walk-form]))))
(setv acc '())
(assert (= (walk (partial collector acc) identity walk-form)
[None None]))
(assert (= acc walk-form))
(setv acc [])
(assert (= (walk identity (partial collector acc) walk-form)
None))
(assert (= acc [walk-form])))
(defn test-walk-iterators []
(let [acc []]
(assert (= (walk (fn [x] (* 2 x)) (fn [x] x)
(drop 1 [1 [2 [3 [4]]]]))
[[2 [3 [4]] 2 [3 [4]]]]))))
(setv acc [])
(assert (= (walk (fn [x] (* 2 x)) (fn [x] x)
(drop 1 [1 [2 [3 [4]]]]))
[[2 [3 [4]] 2 [3 [4]]]])))
(defn test-macroexpand-all []
(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])))
(assert-equal res [1 None])
;; using 0 should raise ValueError
(let [passed False]
(try
(setv res (list (take-nth 0 [1 2 3 4 5 6 7])))
(except [ValueError] (setv passed True)))
(assert passed)))
(setv passed False)
(try
(setv res (list (take-nth 0 [1 2 3 4 5 6 7])))
(except [ValueError] (setv passed True)))
(assert passed))
(defn test-take-while []
"NATIVE: testing the take-while function"

6
tests/native_tests/defclass.hy
View File

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

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

@ -59,7 +59,7 @@
[3 6 9])
(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]))
(defn test-ap-map-when []
@ -83,9 +83,9 @@
(defn test-ap-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])
(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]))
(defn test-ap-first []

283
tests/native_tests/language.hy
View File

@ -449,51 +449,51 @@
(try (do) (except [IOError]) (except))
;; Test correct (raise)
(let [passed False]
(try
(try
(raise IndexError)
(except [IndexError] (raise)))
(except [IndexError]
(setv passed True)))
(assert passed))
(setv passed False)
(try
(try
(raise IndexError)
(except [IndexError] (raise)))
(except [IndexError]
(setv passed True)))
(assert passed)
;; Test incorrect (raise)
(let [passed False]
(try
(raise)
;; Python 2 raises TypeError
;; Python 3 raises RuntimeError
(except [[TypeError RuntimeError]]
(setv passed True)))
(assert passed))
(setv passed False)
(try
(raise)
;; Python 2 raises IndexError here (due to the previous test)
;; Python 3 raises RuntimeError
(except [[IndexError RuntimeError]]
(setv passed True)))
(assert passed)
;; Test (finally)
(let [passed False]
(try
(do)
(finally (setv passed True)))
(assert passed))
(setv passed False)
(try
(do)
(finally (setv passed True)))
(assert passed)
;; Test (finally) + (raise)
(let [passed False]
(try
(raise Exception)
(except)
(finally (setv passed True)))
(assert passed))
(setv passed False)
(try
(raise Exception)
(except)
(finally (setv passed True)))
(assert passed)
;; Test (finally) + (raise) + (else)
(let [passed False
not-elsed True]
(try
(raise Exception)
(except)
(else (setv not-elsed False))
(finally (setv passed True)))
(assert passed)
(assert not-elsed))
(setv passed False
not-elsed True)
(try
(raise Exception)
(except)
(else (setv not-elsed False))
(finally (setv passed True)))
(assert passed)
(assert not-elsed)
(try
(raise (KeyError))
@ -553,37 +553,37 @@
(setv foobar42ofthebaz 42)
(assert (= foobar42ofthebaz 42))))
(let [passed False]
(try
(try (do) (except) (else (bla)))
(except [NameError] (setv passed True)))
(assert passed))
(setv passed False)
(try
(try (do) (except) (else (bla)))
(except [NameError] (setv passed True)))
(assert passed)
(let [x 0]
(try
(raise IOError)
(except [IOError]
(setv x 45))
(else (setv x 44)))
(assert (= x 45)))
(setv x 0)
(try
(raise IOError)
(except [IOError]
(setv x 45))
(else (setv x 44)))
(assert (= x 45))
(let [x 0]
(try
(raise KeyError)
(except []
(setv x 45))
(else (setv x 44)))
(assert (= x 45)))
(setv x 0)
(try
(raise KeyError)
(except []
(setv x 45))
(else (setv x 44)))
(assert (= x 45))
(let [x 0]
(try
(try
(raise KeyError)
(except [IOError]
(setv x 45))
(else (setv x 44)))
(except))
(assert (= x 0))))
(setv x 0)
(try
(try
(raise KeyError)
(except [IOError]
(setv x 45))
(else (setv x 44)))
(except))
(assert (= x 0)))
(defn test-earmuffs []
"NATIVE: Test earmuffs"
@ -677,9 +677,9 @@
(defn test-yield-in-try []
"NATIVE: test yield in try"
(defn gen []
(let [x 1]
(setv x 1)
(try (yield x)
(finally (print x)))))
(finally (print x))))
(setv output (list (gen)))
(assert (= [1] output)))
@ -747,17 +747,17 @@
(defn test-for-else []
"NATIVE: test for else"
(let [x 0]
(for* [a [1 2]]
(setv x (+ x a))
(else (setv x (+ x 50))))
(assert (= x 53)))
(setv x 0)
(for* [a [1 2]]
(setv x (+ x a))
(else (setv x (+ x 50))))
(assert (= x 53))
(let [x 0]
(for* [a [1 2]]
(setv x (+ x a))
(else))
(assert (= x 3))))
(setv x 0)
(for* [a [1 2]]
(setv x (+ x a))
(else))
(assert (= x 3)))
(defn test-list-comprehensions []
@ -864,37 +864,6 @@
(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 []
"NATIVE: test that we return ifs"
(assert (= True (if True True True))))
@ -905,51 +874,38 @@
(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 []
"NATIVE: test symbol encoded"
(let [♥ "love"
⚘ "flower"]
(assert (= (+ ⚘ ♥) "flowerlove"))))
(setv ♥ "love"
⚘ "flower")
(assert (= (+ ⚘ ♥) "flowerlove")))
(defn test-symbol-dash []
"NATIVE: test symbol encoded"
(let [♥-♥ "doublelove"
-_- "what?"]
(assert (= ♥-♥ "doublelove"))
(assert (= -_- "what?"))))
(setv ♥-♥ "doublelove"
-_- "what?")
(assert (= ♥-♥ "doublelove"))
(assert (= -_- "what?")))
(defn test-symbol-question-mark []
"NATIVE: test foo? -> is_foo behavior"
(let [foo? "nachos"]
(assert (= is_foo "nachos"))))
(setv foo? "nachos")
(assert (= is_foo "nachos")))
(defn test-and []
"NATIVE: test the and function"
(let [and123 (and 1 2 3)
(setv and123 (and 1 2 3)
and-false (and 1 False 3)
and-true (and)
and-single (and 1)]
(assert (= and123 3))
(assert (= and-false False))
(assert (= and-true True))
(assert (= and-single 1)))
and-single (and 1))
(assert (= and123 3))
(assert (= and-false False))
(assert (= and-true True))
(assert (= and-single 1))
; short circuiting
(setv a 1)
(and 0 (setv a 2))
@ -980,16 +936,16 @@
(defn test-or []
"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-none-true (or False False)
or-false (or)
or-single (or 1)]
(assert (= or-all-true 1))
(assert (= or-some-true "hello"))
(assert (= or-none-true False))
(assert (= or-false None))
(assert (= or-single 1)))
or-single (or 1))
(assert (= or-all-true 1))
(assert (= or-some-true "hello"))
(assert (= or-none-true False))
(assert (= or-false None))
(assert (= or-single 1))
; short circuiting
(setv a 1)
(or 1 (setv a 2))
@ -1039,16 +995,12 @@
(defn test-if-return-branching []
"NATIVE: test the if return branching"
; thanks, algernon
(assert (= 1 (let [x 1
y 2]
(if True
2)
1)))
(assert (= 1 (let [x 1 y 2]
(do)
(do)
((fn [] 1))))))
; thanks, kirbyfan64
(defn f []
(if True (setv x 1) 2)
1)
(assert (= 1 (f))))
(defn test-keyword []
@ -1107,17 +1059,16 @@
(defn test-eval-globals []
"NATIVE: test eval with explicit global dict"
(assert (= 'bar (eval (quote foo) {'foo 'bar})))
(assert (= 1 (let [d {}] (eval '(setv x 1) d) (eval (quote x) d))))
(let [d1 {}
d2 {}]
(eval '(setv x 1) d1)
(try
(do
; this should fail with a name error
(eval (quote x) d2)
(assert False "We shouldn't have arrived here"))
(except [e Exception]
(assert (isinstance e NameError))))))
(assert (= 1 (do (setv d {}) (eval '(setv x 1) d) (eval (quote x) d))))
(setv d1 {} d2 {})
(eval '(setv x 1) d1)
(try
(do
; this should fail with a name error
(eval (quote x) d2)
(assert False "We shouldn't have arrived here"))
(except [e Exception]
(assert (isinstance e NameError)))))
(defn test-eval-failure []
"NATIVE: test eval failure modes"
@ -1187,10 +1138,6 @@
(assert False))
(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 []
"NATIVE: test that we can use if in if"
(assert (= 42

111
tests/native_tests/mathematics.hy
View File

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

20
tests/native_tests/native_macros.hy
View File

@ -132,11 +132,12 @@
(import [astor.codegen [to_source]])
(import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro nif [expr pos zero neg]
(let [g (gensym)]
`(let [~g ~expr]
(cond [(pos? ~g) ~pos]
[(zero? ~g) ~zero]
[(neg? ~g) ~neg]))))
(setv g (gensym))
`(do
(setv ~g ~expr)
(cond [(pos? ~g) ~pos]
[(zero? ~g) ~zero]
[(neg? ~g) ~neg])))
(print (nif (inc -1) 1 0 -1))
")
@ -158,7 +159,8 @@
(import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro nif [expr pos zero neg]
(with-gensyms [a]
`(let [~a ~expr]
`(do
(setv ~a ~expr)
(cond [(pos? ~a) ~pos]
[(zero? ~a) ~zero]
[(neg? ~a) ~neg]))))
@ -180,7 +182,8 @@
(import [astor.codegen [to_source]])
(import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro/g! nif [expr pos zero neg]
`(let [~g!res ~expr]
`(do
(setv ~g!res ~expr)
(cond [(pos? ~g!res) ~pos]
[(zero? ~g!res) ~zero]
[(neg? ~g!res) ~neg])))
@ -208,7 +211,8 @@
(import [astor.codegen [to_source]])
(import [hy.importer [import_buffer_to_ast]])
(setv macro1 "(defmacro! nif [expr pos zero neg]
`(let [~g!res ~expr]
`(do
(setv ~g!res ~expr)
(cond [(pos? ~g!res) ~pos]
[(zero? ~g!res) ~zero]
[(neg? ~g!res) ~neg])))

37
tests/native_tests/py3_only_tests.hy
View File

@ -15,24 +15,23 @@
(defn test-kwonly []
"NATIVE: test keyword-only arguments"
;; keyword-only with default works
(let [kwonly-foo-default-false (fn [&kwonly [foo False]] foo)]
(assert (= (apply kwonly-foo-default-false) False))
(assert (= (apply kwonly-foo-default-false [] {"foo" True}) True)))
(defn kwonly-foo-default-false [&kwonly [foo False]] foo)
(assert (= (apply kwonly-foo-default-false) False))
(assert (= (apply kwonly-foo-default-false [] {"foo" True}) True))
;; keyword-only without default ...
(let [kwonly-foo-no-default (fn [&kwonly foo] foo)
attempt-to-omit-default (try
(kwonly-foo-no-default)
(except [e [Exception]] e))]
;; works
(assert (= (apply kwonly-foo-no-default [] {"foo" "quux"}) "quux"))
;; raises TypeError with appropriate message if not supplied
(assert (isinstance attempt-to-omit-default TypeError))
(assert (in "missing 1 required keyword-only argument: 'foo'"
(. attempt-to-omit-default args [0]))))
(defn kwonly-foo-no-default [&kwonly foo] foo)
(setv attempt-to-omit-default (try
(kwonly-foo-no-default)
(except [e [Exception]] e)))
;; works
(assert (= (apply kwonly-foo-no-default [] {"foo" "quux"}) "quux"))
;; raises TypeError with appropriate message if not supplied
(assert (isinstance attempt-to-omit-default TypeError))
(assert (in "missing 1 required keyword-only argument: 'foo'"
(. attempt-to-omit-default args [0])))
;; keyword-only with other arg types works
(let [function-of-various-args
(fn [a b &rest args &kwonly foo &kwargs kwargs]
(, a b args foo kwargs))]
(assert (= (apply function-of-various-args
[1 2 3 4] {"foo" 5 "bar" 6 "quux" 7})
(, 1 2 (, 3 4) 5 {"bar" 6 "quux" 7})))))
(defn function-of-various-args [a b &rest args &kwonly foo &kwargs kwargs]
(, a b args foo kwargs))
(assert (= (apply function-of-various-args
[1 2 3 4] {"foo" 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 []
"NATIVE: test shadow addition"
(let [x +]
(assert (try
(x)
(except [TypeError] True)
(else (raise AssertionError))))
(assert (= (x 1 2 3 4) 10))
(assert (= (x 1 2 3 4 5) 15))
; with strings
(assert (= (x "a" "b" "c")
"abc"))
; with lists
(assert (= (x ["a"] ["b"] ["c"])
["a" "b" "c"]))))
(setv x +)
(assert (try
(x)
(except [TypeError] True)
(else (raise AssertionError))))
(assert (= (x 1 2 3 4) 10))
(assert (= (x 1 2 3 4 5) 15))
; with strings
(assert (= (x "a" "b" "c")
"abc"))
; with lists
(assert (= (x ["a"] ["b"] ["c"])
["a" "b" "c"])))
(defn test-shadow-subtraction []
"NATIVE: test shadow subtraction"
(let [x -]
(assert (try
(x)
(except [TypeError] True)
(else (raise AssertionError))))
(assert (= (x 1) -1))
(assert (= (x 2 1) 1))
(assert (= (x 2 1 1) 0))))
(setv x -)
(assert (try
(x)
(except [TypeError] True)
(else (raise AssertionError))))
(assert (= (x 1) -1))
(assert (= (x 2 1) 1))
(assert (= (x 2 1 1) 0)))
(defn test-shadow-multiplication []
"NATIVE: test shadow multiplication"
(let [x *]
(assert (= (x) 1))
(assert (= (x 3) 3))
(assert (= (x 3 3) 9))))
(setv x *)
(assert (= (x) 1))
(assert (= (x 3) 3))
(assert (= (x 3 3) 9)))
(defn test-shadow-division []
"NATIVE: test shadow division"
(let [x /]
(assert (try
(x)
(except [TypeError] True)
(else (raise AssertionError))))
(assert (= (x 1) 1))
(assert (= (x 8 2) 4))
(assert (= (x 8 2 2) 2))
(assert (= (x 8 2 2 2) 1))))
(setv x /)
(assert (try
(x)
(except [TypeError] True)
(else (raise AssertionError))))
(assert (= (x 1) 1))
(assert (= (x 8 2) 4))
(assert (= (x 8 2 2) 2))
(assert (= (x 8 2 2 2) 1)))
(defn test-shadow-compare []
@ -70,24 +70,24 @@
[2 2]]]
(assert (= (apply x args) (not (apply y args))))))
(let [s-lt <
(setv s-lt <
s-gt >
s-le <=
s-ge >=
s-eq =
s-ne !=]
(assert (apply s-lt [1 2 3]))
(assert (not (apply s-lt [3 2 1])))
(assert (apply s-gt [3 2 1]))
(assert (not (apply s-gt [1 2 3])))
(assert (apply s-le [1 1 2 2 3 3]))
(assert (not (apply s-le [1 1 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 (apply s-eq [1 1 1 1 1]))
(assert (not (apply s-eq [1 1 2 1 1])))
(assert (apply s-ne [1 2 3 4 5]))
(assert (not (apply s-ne [1 1 2 3 4]))))
s-ne !=)
(assert (apply s-lt [1 2 3]))
(assert (not (apply s-lt [3 2 1])))
(assert (apply s-gt [3 2 1]))
(assert (not (apply s-gt [1 2 3])))
(assert (apply s-le [1 1 2 2 3 3]))
(assert (not (apply s-le [1 1 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 (apply s-eq [1 1 1 1 1]))
(assert (not (apply s-eq [1 1 2 1 1])))
(assert (apply s-ne [1 2 3 4 5]))
(assert (not (apply s-ne [1 1 2 3 4])))
; Make sure chained comparisons use `and`, not `&`.
; https://github.com/hylang/hy/issues/1191