On Mon, Dec 8, 2008 at 10:42 AM, Rich Hickey <[EMAIL PROTECTED]> wrote:
>
> On Dec 8, 10:08 am, Chouser <[EMAIL PROTECTED]> wrote:
>>
>> doseq currently supports both. If both appear on the same binding,
>> the :while is always test first regardless of the order in which they
>> appear in the doseq. The thinking is that if the :while is false,
>> there's no need to check the :when.
>>
>> Is this Good, and should 'for' work the same way?
>>
>
> Yes.
The attached patch adds support for :when and :while on the binding
expression in 'for'. The macro now parses its arguments using code
almost identical to 'doseq'. I've changed some local names in 'for'
and 'doseq' where they are similar to each other, so that both have
what I believe to be more descriptive names.
If these extra renaming changes are undesirable, I can certainly
create a smaller patch.
I've also attached a set of tests that I used. All but
While-and-When-Same-Binding behaved identically before and after my
changes to 'for'.
--Chouser
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Clojure" group.
To post to this group, send email to clojure@googlegroups.com
To unsubscribe from this group, send email to [EMAIL PROTECTED]
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---
commit f21c3a14b2c5167bd643ab010851c602e5073c33
Author: Chouser <[EMAIL PROTECTED]>
Date: Mon Dec 8 15:51:18 2008 -0500
Support :while and :when on same binding expressions in 'for'
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index 24c9d01..e84ec15 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -1473,20 +1473,22 @@
bindings and filtering as provided by \"for\". Does not retain
the head of the sequence. Returns nil."
[seq-exprs & body]
- (let [binds (reduce (fn [binds p]
- (if (instance? clojure.lang.Keyword (first p))
- (conj (pop binds) (apply assoc (peek binds) p))
- (conj binds {:name (first p) :init (second p)})))
+ (let [groups (reduce (fn [groups p]
+ (if (keyword? (first p))
+ (conj (pop groups) (apply assoc (peek groups) p))
+ (conj groups {:bind (first p) :seq (second p)})))
[] (partition 2 seq-exprs))
- emit (fn emit [bind & binds]
- `(loop [sq# (seq ~(:init bind))]
+ emit (fn emit [group & more-groups]
+ `(loop [sq# (seq ~(:seq group))]
(when sq#
- (let [~(:name bind) (first sq#)]
- (when ~(or (:while bind) true)
- (when ~(or (:when bind) true)
- ~(if binds (apply emit binds) `(do [EMAIL PROTECTED])))
+ (let [~(:bind group) (first sq#)]
+ (when ~(or (:while group) true)
+ (when ~(or (:when group) true)
+ ~(if more-groups
+ (apply emit more-groups)
+ `(do [EMAIL PROTECTED])))
(recur (rest sq#)))))))]
- (apply emit binds)))
+ (apply emit groups)))
(defn dorun
"When lazy sequences are produced via functions that have side
@@ -2385,8 +2387,6 @@
(lazy-cat [EMAIL PROTECTED])))]
(iter# ~coll))))
-
-
(defmacro for
"List comprehension. Takes a vector of one or more
binding-form/collection-expr pairs, each followed by an optional filtering
@@ -2397,31 +2397,27 @@
(take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))"
([seq-exprs expr]
- (let [pargs (fn [xs]
- (loop [ret []
- [b e & [w f & wr :as r] :as xs] (seq xs)]
- (if xs
- (cond
- (= w :when) (recur (conj ret {:b b :e e :f f :w :when}) wr)
- (= w :while) (recur (conj ret {:b b :e e :f f :w :while}) wr)
- :else (recur (conj ret {:b b :e e :f true :w :while}) r))
- (seq ret))))
- emit (fn emit [[{b :b f :f w :w} & [{ys :e} :as rses]]]
+ (let [to-groups (fn [seq-exprs]
+ (reduce (fn [groups [k v]]
+ (if (keyword? k)
+ (conj (pop groups) (assoc (peek groups) k v))
+ (conj groups {:bind k :seq v})))
+ [] (partition 2 seq-exprs)))
+ emit (fn emit [[group & [{next-seq :seq} :as more-groups]]]
(let [giter (gensym "iter__") gxs (gensym "s__")]
`(fn ~giter [~gxs]
- (when-first [~b ~gxs]
- (if ~f
- ~(if rses
- `(let [iterys# ~(emit rses)
- fs# (iterys# ~ys)]
- (if fs#
- (lazy-cat fs# (~giter (rest ~gxs)))
- (recur (rest ~gxs))))
- `(lazy-cons ~expr (~giter (rest ~gxs))))
- ~(if (= w :when)
- `(recur (rest ~gxs))
- nil))))))]
- `(let [iter# ~(emit (pargs seq-exprs))]
+ (when-first [~(:bind group) ~gxs]
+ (when ~(or (:while group) true)
+ (if ~(or (:when group) true)
+ ~(if more-groups
+ `(let [iterys# ~(emit more-groups)
+ fs# (iterys# ~next-seq)]
+ (if fs#
+ (lazy-cat fs# (~giter (rest ~gxs)))
+ (recur (rest ~gxs))))
+ `(lazy-cons ~expr (~giter (rest ~gxs))))
+ (recur (rest ~gxs))))))))]
+ `(let [iter# ~(emit (to-groups seq-exprs))]
(iter# ~(second seq-exprs))))))
(defmacro comment
;; Copyright (c) Chris Houser. All rights reserved. The use and
;; distribution terms for this software are covered by the Common Public
;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found
;; in the file CPL.TXT at the root of this distribution. By using this
;; software in any fashion, you are agreeing to be bound by the terms of
;; this license. You must not remove this notice, or any other, from this
;; software.
;;
;; Tests for the Clojure 'for' macro
;;
;; by Chouser, http://chouser.n01se.net
;; Created Dec 2008
(ns clojure.contrib.test-clojure.for
(:use clojure.contrib.test-is))
(deftest Docstring-Example
(is (= (take 100 (for [x (range 100000000)
y (range 1000000) :while (< y x)]
[x y]))
'([1 0] [2 0] [2 1] [3 0] [3 1] [3 2] [4 0] [4 1] [4 2] [4 3]
[5 0] [5 1] [5 2] [5 3] [5 4]
[6 0] [6 1] [6 2] [6 3] [6 4] [6 5]
[7 0] [7 1] [7 2] [7 3] [7 4] [7 5] [7 6]
[8 0] [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7]
[9 0] [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8]
[10 0] [10 1] [10 2] [10 3] [10 4] [10 5] [10 6] [10 7] [10 8] [10 9]
[11 0] [11 1] [11 2] [11 3] [11 4] [11 5] [11 6] [11 7] [11 8] [11 9]
[11 10]
[12 0] [12 1] [12 2] [12 3] [12 4] [12 5] [12 6] [12 7] [12 8] [12 9]
[12 10] [12 11]
[13 0] [13 1] [13 2] [13 3] [13 4] [13 5] [13 6] [13 7] [13 8] [13 9]
[13 10] [13 11] [13 12]
[14 0] [14 1] [14 2] [14 3] [14 4] [14 5] [14 6] [14 7] [14 8]))))
(deftest When
(is (= (for [x (range 10) :when (odd? x)] x) '(1 3 5 7 9)))
(is (= (for [x (range 4) y (range 4) :when (odd? y)] [x y])
'([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3])))
(is (= (for [x (range 4) y (range 4) :when (odd? x)] [x y])
'([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3])))
(is (= (for [x (range 4) :when (odd? x) y (range 4)] [x y])
'([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3])))
(is (= (for [x (range 5) y (range 5) :when (< x y)] [x y])
'([0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4]))))
(defn only
"Returns a lazy seq of increasing ints starting at 0. Trying to get
the nth+1 value of the seq throws an exception. This is meant to
help detecting over-eagerness in lazy seq consumers."
[n]
(lazy-cat (range n)
(throw (Exception. "consumer went too far in lazy seq"))))
(deftest While
(is (= (for [x (only 6) :while (< x 5)] x) '(0 1 2 3 4)))
(is (= (for [x (range 4) y (only 4) :while (< y 3)] [x y])
'([0 0] [0 1] [0 2] [1 0] [1 1] [1 2]
[2 0] [2 1] [2 2] [3 0] [3 1] [3 2])))
(is (= (for [x (range 4) y (range 4) :while (< x 3)] [x y])
'([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3]
[2 0] [2 1] [2 2] [2 3])))
(is (= (for [x (only 4) :while (< x 3) y (range 4)] [x y])
'([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3]
[2 0] [2 1] [2 2] [2 3])))
(is (= (for [x (range 4) y (range 4) :while (even? x)] [x y])
'([0 0] [0 1] [0 2] [0 3] [2 0] [2 1] [2 2] [2 3])))
(is (= (for [x (only 2) :while (even? x) y (range 4)] [x y])
'([0 0] [0 1] [0 2] [0 3])))
(is (= (for [x (range 4) y (only 4) :while (< y x)] [x y])
'([1 0] [2 0] [2 1] [3 0] [3 1] [3 2]))))
(deftest While-and-When
(is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? y)] [x y])
'([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3] [4 1] [4 3])))
(is (= (for [x (range 4) :when (odd? x) y (only 6) :while (< y 5)] [x y])
'([1 0] [1 1] [1 2] [1 3] [1 4] [3 0] [3 1] [3 2] [3 3] [3 4])))
(is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? (+ x y))]
[x y])
'([0 1] [0 3] [1 0] [1 2] [2 1] [2 3] [3 0] [3 2] [4 1] [4 3])))
(is (= (for [x (range 4) :when (odd? x) y (only 2) :while (odd? (+ x y))]
[x y])
'([1 0] [3 0]))))
(deftest While-and-When-Same-Binding
(is (= (for [x (only 6) :while (< x 5) :when (odd? x)] x) '(1 3)))
(is (= (for [x (only 6)
:while (< x 5) ; if :while is false, :when should not be evaled
:when (do (is (< x 5) (odd? x)))] x) '(1 3))))
(deftest Nesting
(is (= (for [x '(a b) y (interpose x '(1 2)) z (list x y)] [x y z])
'([a 1 a] [a 1 1] [a a a] [a a a] [a 2 a] [a 2 2]
[b 1 b] [b 1 1] [b b b] [b b b] [b 2 b] [b 2 2]))))
(deftest Destructuring
(is (= (for [{:syms [a b c]} (map #(zipmap '(a b c) (range % 5)) (range 3))
x [a b c]]
(Integer. (str a b c x))))
'(120 121 122 1231 1232 1233 2342 2343 2344)))
