;; Copyright (c) Rich Hickey. All rights reserved. ;; The use and distribution terms for this software are covered by the ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) ;; which can be found in the file epl-v10.html 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. (defmacro for [seq-exprs body-expr] (let [to-groups (fn [seq-exprs] (reduce (fn [groups [k v]] (if (keyword? k) (conj (pop groups) (conj (peek groups) [k v])) (conj groups [k v]))) [] (partition 2 seq-exprs))) err (fn [& msg] (throw (IllegalArgumentException. ^String (apply str msg)))) emit-bind (fn emit-bind [[[bind expr & mod-pairs] & [[_ next-expr] :as next-groups]]] (let [giter (gensym "iter__") gxs (gensym "s__") do-mod (fn do-mod [[[k v :as pair] & etc]] (cond (= k :let) `(let ~v ~(do-mod etc)) (= k :while) `(when ~v ~(do-mod etc)) (= k :when) `(if ~v ~(do-mod etc) (recur (rest ~gxs))) (keyword? k) (err "Invalid 'for' keyword " k) next-groups `(let [iterys# ~(emit-bind next-groups) fs# (seq (iterys# ~next-expr))] (if fs# (concat fs# (~giter (rest ~gxs))) (recur (rest ~gxs)))) :else `(cons ~body-expr (~giter (rest ~gxs)))))] (if next-groups `(fn ~giter [~gxs] (lazy-seq (loop [~gxs ~gxs] (when-first [~bind ~gxs] ~(do-mod mod-pairs))))) (let [gi (gensym "i__") gb (gensym "b__") do-cmod (fn do-cmod [[[k v :as pair] & etc]] (cond (= k :let) `(let ~v ~(do-cmod etc)) (= k :while) `(when ~v ~(do-cmod etc)) (= k :when) `(if ~v ~(do-cmod etc) (recur (unchecked-inc ~gi))) (keyword? k) (err "Invalid 'for' keyword " k) :else `(do (chunk-append ~gb ~body-expr) (recur (unchecked-inc ~gi)))))] `(fn ~giter [~gxs] (lazy-seq (loop [~gxs ~gxs] (when-let [~gxs (seq ~gxs)] (let [~bind (first ~gxs)] ~(do-mod mod-pairs))))))))))] `(let [iter# ~(emit-bind (to-groups seq-exprs))] (iter# ~(second seq-exprs)))))