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

Merge pull request #1849 from Kodiologist/reduction

Browse Source 
Fix some bugs in `ap-reduce`
This commit is contained in:
Kodi Arfer 2019-12-19 11:43:41 -05:00 committed by GitHub
commit b5d18d9654
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 86 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
NEWS.rst
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
------------------------------ ------------------------------

11
hy/extra/anaphoric.hy
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))

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

@ -5,130 +5,115 @@
(import [hy.errors [HyMacroExpansionError]]) (import [hy.errors [HyMacroExpansionError]])
(require [hy.extra.anaphoric [*]]) (require [hy.extra.anaphoric [*]])
;;;; some simple helpers
(defn assert-true [x]
(assert (= True x)))
(defn assert-false [x]
(assert (= False x)))
(defn assert-equal [x y]
(assert (= x y)))
(defn test-ap-if [] (defn test-ap-if []
"NATIVE: testing anaphoric if" (ap-if True (assert (is it True)))
(ap-if True (assert-true it)) (ap-if False True (assert (is it False))))
(ap-if False True (assert-false it)))
(defn test-ap-each [] (defn test-ap-each []
"NATIVE: testing anaphoric each"
(setv res []) (setv res [])
(ap-each [1 2 3 4] (.append res it)) (ap-each [1 2 3 4] (.append res it))
(assert-equal res [1 2 3 4])) (assert (= res [1 2 3 4])))
(defn test-ap-each-while [] (defn test-ap-each-while []
"NATIVE: testing anaphoric each-while"
(setv res []) (setv res [])
(ap-each-while [2 2 4 3 4 5 6] (even? it) (.append res it)) (ap-each-while [2 2 4 3 4 5 6] (even? it) (.append res it))
(assert-equal res [2 2 4])) (assert (= res [2 2 4])))
(defn test-ap-map [] (defn test-ap-map []
"NATIVE: testing anaphoric map" (assert (= (list (ap-map (* it 3) [1 2 3]))
(assert-equal (list (ap-map (* it 3) [1 2 3])) [3 6 9]))
[3 6 9]) (assert (= (list (ap-map (* it 3) []))
(assert-equal (list (ap-map (* it 3) [])) []))
[]) (assert (= (do (setv 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 []
"NATIVE: testing anaphoric map-when" (assert (= (list (ap-map-when even? (* it 2) [1 2 3 4]))
(assert-equal (list (ap-map-when even? (* it 2) [1 2 3 4])) [1 4 3 8])))
[1 4 3 8]))
(defn test-ap-filter [] (defn test-ap-filter []
"NATIVE: testing anaphoric filter" (assert (= (list (ap-filter (> it 2) [1 2 3 4]))
(assert-equal (list (ap-filter (> it 2) [1 2 3 4])) [3 4]))
[3 4]) (assert (= (list (ap-filter (even? it) [1 2 3 4]))
(assert-equal (list (ap-filter (even? it) [1 2 3 4])) [2 4])))
[2 4]))
(defn test-ap-reject [] (defn test-ap-reject []
"NATIVE: testing anaphoric filter" (assert (= (list (ap-reject (> it 2) [1 2 3 4]))
(assert-equal (list (ap-reject (> it 2) [1 2 3 4])) [1 2]))
[1 2]) (assert (= (list (ap-reject (even? it) [1 2 3 4]))
(assert-equal (list (ap-reject (even? it) [1 2 3 4])) [1 3])))
[1 3]))
(defn test-ap-dotimes [] (defn test-ap-dotimes []
"NATIVE: testing anaphoric dotimes" (assert (= (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 (= (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" (assert (= (ap-first (> it 5) (range 10)) 6))
(assert-equal (ap-first (> it 5) (range 10)) 6) (assert (= (ap-first (even? it) [1 2 3 4]) 2))
(assert-equal (ap-first (even? it) [1 2 3 4]) 2) (assert (= (ap-first (> it 10) (range 10)) None)))
(assert-equal (ap-first (> it 10) (range 10)) None))
(defn test-ap-last [] (defn test-ap-last []
"NATIVE: testing anaphoric last" (assert (= (ap-last (> it 5) (range 10)) 9))
(assert-equal (ap-last (> it 5) (range 10)) 9) (assert (= (ap-last (even? it) [1 2 3 4]) 4))
(assert-equal (ap-last (even? it) [1 2 3 4]) 4) (assert (= (ap-last (> it 10) (range 10)) None)))
(assert-equal (ap-last (> it 10) (range 10)) None))
(defn test-ap-reduce [] (defn test-ap-reduce []
"NATIVE: testing anaphoric reduce" (assert (= (ap-reduce (* acc it) [1 2 3]) 6))
(assert-equal (ap-reduce (* acc it) [1 2 3]) 6) (assert (= (ap-reduce (* acc it) [1 2 3] 6) 36))
(assert-equal (ap-reduce (* acc it) [1 2 3] 6) 36) (assert (= (ap-reduce (+ acc " on " it) ["Hy" "meth"])
(assert-equal (ap-reduce (+ acc " on " it) ["Hy" "meth"]) "Hy on meth"))
"Hy on meth") (assert (= (ap-reduce (+ acc it) [] 1) 1))
(assert-equal (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 []
"NATIVE: testing #%() forms"
;; test ordering ;; test ordering
(assert-equal (#%(/ %1 %2) 2 4) 0.5) (assert (= (#%(/ %1 %2) 2 4) 0.5))
(assert-equal (#%(/ %2 %1) 2 4) 2) (assert (= (#%(/ %2 %1) 2 4) 2))
(assert-equal (#%(identity (, %5 %4 %3 %2 %1)) 1 2 3 4 5) (, 5 4 3 2 1)) (assert (= (#%(identity (, %5 %4 %3 %2 %1)) 1 2 3 4 5) (, 5 4 3 2 1)))
(assert-equal (#%(identity (, %1 %2 %3 %4 %5)) 1 2 3 4 5) (, 1 2 3 4 5)) (assert (= (#%(identity (, %1 %2 %3 %4 %5)) 1 2 3 4 5) (, 1 2 3 4 5)))
(assert-equal (#%(identity (, %1 %5 %2 %3 %4)) 1 2 3 4 5) (, 1 5 2 3 4)) (assert (= (#%(identity (, %1 %5 %2 %3 %4)) 1 2 3 4 5) (, 1 5 2 3 4)))
;; test &rest ;; test &rest
(assert-equal (#%(sum %*) 1 2 3) 6) (assert (= (#%(sum %*) 1 2 3) 6))
(assert-equal (#%(identity (, %1 %*)) 10 1 2 3) (, 10 (, 1 2 3))) (assert (= (#%(identity (, %1 %*)) 10 1 2 3) (, 10 (, 1 2 3))))
;; no parameters ;; no parameters
(assert-equal (#%(list)) []) (assert (= (#%(list)) []))
(assert-equal (#%(identity "Hy!")) "Hy!") (assert (= (#%(identity "Hy!")) "Hy!"))
(assert-equal (#%(identity "%*")) "%*") (assert (= (#%(identity "%*")) "%*"))
(assert-equal (#%(+ "Hy " "world!")) "Hy world!") (assert (= (#%(+ "Hy " "world!")) "Hy world!"))
;; test skipped parameters ;; test skipped parameters
(assert-equal (#%(identity [%3 %1]) 1 2 3) [3 1]) (assert (= (#%(identity [%3 %1]) 1 2 3) [3 1]))
;; test nesting ;; test nesting
(assert-equal (#%(identity [%1 (, %2 [%3] "Hy" [%*])]) 1 2 3 4 5) (assert (= (#%(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 (#%(%1 2 4) +) 6) (assert (= (#%(%1 2 4) +) 6))
(assert-equal (#%(%1 2 4) -) -2) (assert (= (#%(%1 2 4) -) -2))
(assert-equal (#%(%1 2 4) /) 0.5) (assert (= (#%(%1 2 4) /) 0.5))
;; test &rest &kwargs ;; test &rest &kwargs
(assert-equal (#%(, %* %**) 1 2 :a 'b) (assert (= (#%(, %* %**) 1 2 :a 'b)
(, (, 1 2) (, (, 1 2)
(dict :a 'b))) (dict :a 'b))))
;; test other expression types ;; test other expression types
(assert-equal (#% %* 1 2 3) (assert (= (#% %* 1 2 3)
(, 1 2 3)) (, 1 2 3)))
(assert-equal (#% %** :foo 2) (assert (= (#% %** :foo 2)
(dict :foo 2)) (dict :foo 2)))
(assert-equal (#%[%3 %2 %1] 1 2 3) (assert (= (#%[%3 %2 %1] 1 2 3)
[3 2 1]) [3 2 1]))
(assert-equal (#%{%1 %2} 10 100) (assert (= (#%{%1 %2} 10 100)
{10 100}) {10 100}))
(assert-equal (#% #{%3 %2 %1} 1 3 2) (assert (= (#% #{%3 %2 %1} 1 3 2)
#{3 1 2}) ; sets are not ordered. #{3 1 2})) ; sets are not ordered.
(assert-equal (#% "%1") (assert (= (#% "%1")
"%1")) "%1")))