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

fix whitespace in anaphoric

Browse Source
This commit is contained in:
gilch 2017-10-26 12:53:08 -06:00
parent a5146e6494
commit 2319adcc7f
2 changed files with 40 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
hy/extra/anaphoric.hy
View File

@ -8,8 +8,8 @@
(defmacro ap-if [test-form then-form &optional else-form] (defmacro ap-if [test-form then-form &optional else-form]
`(do `(do
(setv it ~test-form) (setv it ~test-form)
(if it ~then-form ~else-form))) (if it ~then-form ~else-form)))
(defmacro ap-each [lst &rest body] (defmacro ap-each [lst &rest body]
@ -25,17 +25,17 @@
(defn ~p [it] ~form) (defn ~p [it] ~form)
(for [it ~lst] (for [it ~lst]
(if (~p it) (if (~p it)
~@body ~@body
(break))))) (break)))))
(defmacro ap-map [form lst] (defmacro ap-map [form lst]
"Yield elements evaluated in the form for each element in the list." "Yield elements evaluated in the form for each element in the list."
(setv v (gensym 'v) f (gensym 'f)) (setv v (gensym 'v) f (gensym 'f))
`((fn [] `((fn []
(defn ~f [it] ~form) (defn ~f [it] ~form)
(for [~v ~lst] (for [~v ~lst]
(yield (~f ~v)))))) (yield (~f ~v))))))
(defmacro ap-map-when [predfn rep lst] (defmacro ap-map-when [predfn rep lst]
@ -43,21 +43,21 @@
predicate function returns True." predicate function returns True."
(setv f (gensym)) (setv f (gensym))
`((fn [] `((fn []
(defn ~f [it] ~rep) (defn ~f [it] ~rep)
(for [it ~lst] (for [it ~lst]
(if (~predfn it) (if (~predfn it)
(yield (~f it)) (yield (~f it))
(yield it)))))) (yield it))))))
(defmacro ap-filter [form lst] (defmacro ap-filter [form lst]
"Yield elements returned when the predicate form evaluates to True." "Yield elements returned when the predicate form evaluates to True."
(setv pred (gensym)) (setv pred (gensym))
`((fn [] `((fn []
(defn ~pred [it] ~form) (defn ~pred [it] ~form)
(for [val ~lst] (for [val ~lst]
(if (~pred val) (if (~pred val)
(yield val)))))) (yield val))))))
(defmacro ap-reject [form lst] (defmacro ap-reject [form lst]
@ -95,10 +95,10 @@
(defmacro ap-reduce [form lst &optional [initial-value None]] (defmacro ap-reduce [form lst &optional [initial-value None]]
"Anaphoric form of reduce, `acc' and `it' can be used for a form" "Anaphoric form of reduce, `acc' and `it' can be used for a form"
`(do `(do
(setv acc ~(if (none? initial-value) `(get ~lst 0) initial-value)) (setv acc ~(if (none? initial-value) `(get ~lst 0) initial-value))
(ap-each ~(if (none? initial-value) `(cut ~lst 1) lst) (ap-each ~(if (none? initial-value) `(cut ~lst 1) lst)
(setv acc ~form)) (setv acc ~form))
acc)) acc))
(defmacro ap-pipe [var &rest forms] (defmacro ap-pipe [var &rest forms]
@ -119,19 +119,18 @@
This is not a replacement for fn. The xi forms cannot be nested. " This is not a replacement for fn. The xi forms cannot be nested. "
(setv flatbody (flatten body)) (setv flatbody (flatten body))
`(fn [;; generate all xi symbols up to the maximum found in body `(fn [;; generate all xi symbols up to the maximum found in body
~@(genexpr (HySymbol (+ "x" ~@(genexpr (HySymbol (+ "x"
(str i))) (str i)))
[i (range 1 [i (range 1
;; find the maximum xi ;; find the maximum xi
(inc (max (+ (list-comp (int (cut a 1)) (inc (max (+ (list-comp (int (cut a 1))
[a flatbody] [a flatbody]
(and (symbol? a) (and (symbol? a)
(.startswith a 'x) (.startswith a 'x)
(.isdigit (cut a 1)))) (.isdigit (cut a 1))))
[0]))))]) [0]))))])
;; generate the &rest parameter only if 'xi is present in body ;; generate the &rest parameter only if 'xi is present in body
~@(if (in 'xi flatbody) ~@(if (in 'xi flatbody)
'(&rest xi) '(&rest xi)
'())] '())]
(~@body))) (~@body)))

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

@ -65,9 +65,9 @@
(defn test-ap-dotimes [] (defn test-ap-dotimes []
"NATIVE: testing anaphoric dotimes" "NATIVE: testing anaphoric dotimes"
(assert-equal (do (setv n []) (ap-dotimes 3 (.append n 3)) n) (assert-equal (do (setv n []) (ap-dotimes 3 (.append n 3)) n)
[3 3 3]) [3 3 3])
(assert-equal (do (setv n []) (ap-dotimes 3 (.append n it)) n) (assert-equal (do (setv n []) (ap-dotimes 3 (.append n it)) n)
[0 1 2])) [0 1 2]))
(defn test-ap-first [] (defn test-ap-first []
"NATIVE: testing anaphoric first" "NATIVE: testing anaphoric first"
@ -86,16 +86,16 @@
(assert-equal (ap-reduce (* acc it) [1 2 3]) 6) (assert-equal (ap-reduce (* acc it) [1 2 3]) 6)
(assert-equal (ap-reduce (* acc it) [1 2 3] 6) 36) (assert-equal (ap-reduce (* acc it) [1 2 3] 6) 36)
(assert-equal (ap-reduce (+ acc " on " it) ["Hy" "meth"]) (assert-equal (ap-reduce (+ acc " on " it) ["Hy" "meth"])
"Hy on meth") "Hy on meth")
(assert-equal (ap-reduce (+ acc it) [] 1) 1)) (assert-equal (ap-reduce (+ acc it) [] 1) 1))
(defn test-ap-pipe [] (defn test-ap-pipe []
"NATIVE: testing anaphoric pipe" "NATIVE: testing anaphoric pipe"
(assert-equal (ap-pipe 2 (+ it 1) (* it 3)) 9) (assert-equal (ap-pipe 2 (+ it 1) (* it 3)) 9)
(assert-equal (ap-pipe [4 5 6 7] (list (rest it)) (len it)) 3)) (assert-equal (ap-pipe [4 5 6 7] (list (rest it)) (len it)) 3))
(defn test-ap-compose [] (defn test-ap-compose []
"NATIVE: testing anaphoric compose" "NATIVE: testing anaphoric compose"
(assert-equal ((ap-compose (+ it 1) (* it 3)) 2) 9) (assert-equal ((ap-compose (+ it 1) (* it 3)) 2) 9)
(assert-equal ((ap-compose (list (rest it)) (len it)) [4 5 6 7]) 3)) (assert-equal ((ap-compose (list (rest it)) (len it)) [4 5 6 7]) 3))