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>

docs/language/api.rst

@@ -267,11 +267,10 @@ is only called on every other value in the list.
     ;; collection is a list of numerical values
 
     (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

hy/core/macros.hy

@@ -32,7 +32,7 @@
 
 
 (defmacro with [args &rest body]
-  "shorthand for nested for* loops:
+  "shorthand for nested with* loops:
   (with [[x foo] [y bar]] baz) ->
   (with* [x foo]
     (with* [y bar]
@@ -73,10 +73,11 @@
     "check `cond` branch for validity, return the corresponding `if` expr"
     (if (not (= (type branch) HyList))
       (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 latest-branch root)
@@ -96,16 +97,23 @@
   (for* [x foo]
     (for* [y bar]
       baz))"
-  (cond 
+  (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
    [(odd? (len args))
     (macro-error args "`for' requires an even number of args.")]
    [(empty? body)
     (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)]]
-      `(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] ~@body))]))
+      `(for* [(, ~@alist) (genexpr (, ~@alist) [~@args])] (do ~@body) ~@belse))]))
 
 
 (defmacro -> [head &rest rest]

tests/compilers/test_ast.py

@@ -484,7 +484,7 @@ def test_for_compile_error():
         assert(False)
 
     try:
-        can_compile("(fn [] (for [x]))")
+        can_compile("(fn [] (for [x] x))")
     except HyTypeError as e:
         assert(e.message == "`for' requires an even number of args.")
     else:
@@ -497,6 +497,13 @@ def test_for_compile_error():
     else:
         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():
     """Ensure attribute access compiles correctly"""

tests/native_tests/contrib/walk.hy

@@ -32,4 +32,4 @@
 
 (defn test-macroexpand-all []
   (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)))))))))

tests/native_tests/language.hy

@@ -86,15 +86,19 @@
 
 (defn test-for-loop []
   "NATIVE: test for loops"
-  (setv count 0)
+  (setv count1 0 count2 0)
   (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)
   (for [x [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)))))
              (list-comp y [x [[1] [2 3]] y x])))
   (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."
   (cond
    [(= 1 2) (assert (is true false))]
-   [(is null null) (assert (is true true))]))
+   [(is null null) (setv x true) (assert x)]))
 
 
 (defn test-index []