hy/tests/native_tests/model_patterns.hy
2019-02-07 08:57:35 -05:00

71 lines
1.7 KiB
Hy

;; Copyright 2019 the authors.
;; This file is part of Hy, which is free software licensed under the Expat
;; license. See the LICENSE.
(defmacro do-until [&rest args]
(import
[hy.model-patterns [whole FORM notpexpr dolike]]
[funcparserlib.parser [many]])
(setv [body condition] (->> args (.parse (whole
[(many (notpexpr "until")) (dolike "until")]))))
(setv g (gensym))
`(do
(setv ~g True)
(while (or ~g (not (do ~@condition)))
~@body
(setv ~g False))))
(defn test-do-until []
(setv n 0 s "")
(do-until
(+= s "x")
(until (+= n 1) (>= n 3)))
(assert (= s "xxx"))
(do-until
(+= s "x")
(until (+= n 1) (>= n 3)))
(assert (= s "xxxx")))
(defmacro loop [&rest args]
(import
[hy.model-patterns [whole FORM sym SYM]]
[funcparserlib.parser [many]])
(setv [loopers body] (->> args (.parse (whole [
(many (|
(>> (+ (sym "while") FORM) (fn [x] [x]))
(+ (sym "for") SYM (sym "in") FORM)
(+ (sym "for") SYM (sym "from") FORM (sym "to") FORM)))
(sym "do")
(many FORM)]))))
(defn f [loopers]
(setv [head tail] [(first loopers) (cut loopers 1)])
(print head)
(cond
[(none? head)
`(do ~@body)]
[(= (len head) 1)
`(while ~@head ~(f tail))]
[(= (len head) 2)
`(for [~@head] ~(f tail))]
[True ; (= (len head) 3)
(setv [sym from to] head)
`(for [~sym (range ~from (inc ~to))] ~(f tail))]))
(f loopers))
(defn test-loop []
(setv l [])
(loop
for x in "abc"
do (.append l x))
(assert (= l ["a" "b" "c"]))
(setv l [] k 2)
(loop
while (> k 0)
for n from 1 to 3
for p in [k n (* 10 n)]
do (.append l p) (-= k 1))
(print l)
(assert (= l [2 1 10 -1 2 20 -4 3 30])))