Fix some bugs in ap-reduce

This commit is contained in:
Kodi Arfer 2019-12-15 14:54:23 -05:00
parent 592c681261
commit f6b9ba9b8f
3 changed files with 20 additions and 5 deletions

View File

@ -36,6 +36,8 @@ Bug Fixes
* Fixed crashes from inaccessible history files. * Fixed crashes from inaccessible history files.
* The unit tests no longer unintentionally import the internal Python module "test". * The unit tests no longer unintentionally import the internal Python module "test".
This allows them to pass when run inside the "slim" Python Docker images. This allows them to pass when run inside the "slim" Python Docker images.
* `ap-reduce` now accepts any iterable.
* `ap-reduce` now evaluates its arguments only once.
Misc. Improvements Misc. Improvements
------------------------------ ------------------------------

View File

@ -91,12 +91,15 @@
~n))) ~n)))
(defmacro ap-reduce [form lst &optional [initial-value None]] (defmacro! ap-reduce [form o!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)
(ap-each ~(if (none? initial-value) `(cut ~lst 1) lst) `(do
(setv acc ~form)) (setv ~g!lst (iter ~g!lst))
(next ~g!lst))
initial-value))
(ap-each ~g!lst (setv acc ~form))
acc)) acc))

View File

@ -64,7 +64,17 @@
(assert (= (ap-reduce (* acc it) [1 2 3] 6) 36)) (assert (= (ap-reduce (* acc it) [1 2 3] 6) 36))
(assert (= (ap-reduce (+ acc " on " it) ["Hy" "meth"]) (assert (= (ap-reduce (+ acc " on " it) ["Hy" "meth"])
"Hy on meth")) "Hy on meth"))
(assert (= (ap-reduce (+ acc it) [] 1) 1))) (assert (= (ap-reduce (+ acc it) [] 1) 1))
; https://github.com/hylang/hy/issues/1848
(assert (= (ap-reduce (* acc it) (map inc [1 2 3])) 24))
(assert (= (ap-reduce (* acc it) (map inc [1 2 3]) 4) 96))
(setv expr-evaluated 0)
(assert (=
(ap-reduce (* acc it) (do (+= expr-evaluated 1) [4 5 6])))
120)
(assert (= expr-evaluated 1)))
(defn test-tag-fn [] (defn test-tag-fn []
;; test ordering ;; test ordering