Merge branch 'glc/for-cond-implicit-do'

Closes #869. Compared to the original pull request, an issue with a
corner case was fixed, and the branch rebased on top of current master.

Signed-off-by: Gergely Nagy <algernon@madhouse-project.org>
This commit is contained in:
Gergely Nagy 2015-08-10 10:16:45 +02:00
commit 8ef8032c75
No known key found for this signature in database
GPG Key ID: 0A083C5F06E0DD42
5 changed files with 41 additions and 23 deletions

View File

@ -267,11 +267,10 @@ is only called on every other value in the list.
;; collection is a list of numerical values ;; collection is a list of numerical values
(for [x collection] (for [x collection]
(do (side-effect1 x)
(side-effect1 x) (if (% x 2)
(if (% x 2) (continue))
(continue)) (side-effect2 x))
(side-effect2 x)))
dict-comp dict-comp

View File

@ -32,7 +32,7 @@
(defmacro with [args &rest body] (defmacro with [args &rest body]
"shorthand for nested for* loops: "shorthand for nested with* loops:
(with [[x foo] [y bar]] baz) -> (with [[x foo] [y bar]] baz) ->
(with* [x foo] (with* [x foo]
(with* [y bar] (with* [y bar]
@ -73,10 +73,11 @@
"check `cond` branch for validity, return the corresponding `if` expr" "check `cond` branch for validity, return the corresponding `if` expr"
(if (not (= (type branch) HyList)) (if (not (= (type branch) HyList))
(macro-error branch "cond branches need to be a list")) (macro-error branch "cond branches need to be a list"))
(if (!= (len branch) 2) (if (< (len branch) 2)
(macro-error branch "cond branches need two items: a test and a code branch")) (macro-error branch "cond branches need at least two items: a test and one or more code branches"))
(setv (, test thebranch) branch) (setv test (car branch))
`(if ~test ~thebranch)) (setv thebranch (cdr branch))
`(if ~test (do ~@thebranch)))
(setv root (check-branch branch)) (setv root (check-branch branch))
(setv latest-branch root) (setv latest-branch root)
@ -96,16 +97,23 @@
(for* [x foo] (for* [x foo]
(for* [y bar] (for* [y bar]
baz))" baz))"
(setv body (list body))
(if (empty? body)
(macro-error None "`for' requires a body to evaluate"))
(setv lst (get body -1))
(setv belse (if (and (isinstance lst HyExpression) (= (get lst 0) "else"))
[(body.pop)]
[]))
(cond (cond
[(odd? (len args)) [(odd? (len args))
(macro-error args "`for' requires an even number of args.")] (macro-error args "`for' requires an even number of args.")]
[(empty? body) [(empty? body)
(macro-error None "`for' requires a body to evaluate")] (macro-error None "`for' requires a body to evaluate")]
[(empty? args) `(do ~@body)] [(empty? args) `(do ~@body ~@belse)]
[(= (len args) 2) `(for* [~@args] ~@body)] [(= (len args) 2) `(for* [~@args] (do ~@body) ~@belse)]
[true [true
(let [[alist (cut args 0 nil 2)]] (let [[alist (cut args 0 nil 2)]]
`(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] ~@body))])) `(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] (do ~@body) ~@belse))]))
(defmacro -> [head &rest rest] (defmacro -> [head &rest rest]

View File

@ -484,7 +484,7 @@ def test_for_compile_error():
assert(False) assert(False)
try: try:
can_compile("(fn [] (for [x]))") can_compile("(fn [] (for [x] x))")
except HyTypeError as e: except HyTypeError as e:
assert(e.message == "`for' requires an even number of args.") assert(e.message == "`for' requires an even number of args.")
else: else:
@ -497,6 +497,13 @@ def test_for_compile_error():
else: else:
assert(False) assert(False)
try:
can_compile("(fn [] (for [x xx] (else 1)))")
except HyTypeError as e:
assert(e.message == "`for' requires a body to evaluate")
else:
assert(False)
def test_attribute_access(): def test_attribute_access():
"""Ensure attribute access compiles correctly""" """Ensure attribute access compiles correctly"""

View File

@ -32,4 +32,4 @@
(defn test-macroexpand-all [] (defn test-macroexpand-all []
(assert (= (macroexpand-all '(with [a b c] (for [d c] foo))) (assert (= (macroexpand-all '(with [a b c] (for [d c] foo)))
'(with* [a] (with* [b] (with* [c] (do (for* [d c] foo)))))))) '(with* [a] (with* [b] (with* [c] (do (for* [d c] (do foo)))))))))

View File

@ -86,15 +86,19 @@
(defn test-for-loop [] (defn test-for-loop []
"NATIVE: test for loops" "NATIVE: test for loops"
(setv count 0) (setv count1 0 count2 0)
(for [x [1 2 3 4 5]] (for [x [1 2 3 4 5]]
(setv count (+ count x))) (setv count1 (+ count1 x))
(assert (= count 15)) (setv count2 (+ count2 x)))
(assert (= count1 15))
(assert (= count2 15))
(setv count 0) (setv count 0)
(for [x [1 2 3 4 5] (for [x [1 2 3 4 5]
y [1 2 3 4 5]] y [1 2 3 4 5]]
(setv count (+ count x y))) (setv count (+ count x y))
(assert (= count 150)) (else
(+= count 1)))
(assert (= count 151))
(assert (= (list ((fn [] (for [x [[1] [2 3]] y x] (yield y))))) (assert (= (list ((fn [] (for [x [[1] [2 3]] y x] (yield y)))))
(list-comp y [x [[1] [2 3]] y x]))) (list-comp y [x [[1] [2 3]] y x])))
(assert (= (list ((fn [] (for [x [[1] [2 3]] y x z (range 5)] (yield z))))) (assert (= (list ((fn [] (for [x [[1] [2 3]] y x z (range 5)] (yield z)))))
@ -224,7 +228,7 @@
"NATIVE: test if cond sorta works." "NATIVE: test if cond sorta works."
(cond (cond
[(= 1 2) (assert (is true false))] [(= 1 2) (assert (is true false))]
[(is null null) (assert (is true true))])) [(is null null) (setv x true) (assert x)]))
(defn test-index [] (defn test-index []