diff options
Diffstat (limited to 'src')
43 files changed, 2620 insertions, 2428 deletions
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index b4ccd791..b494b836 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -37,6 +37,10 @@ fn (fn* fn [& decl] (cons 'fn* decl))) (def + #^{:macro true} + if (fn* if [& decl] (cons 'if* decl))) + +(def #^{:arglists '([coll]) :doc "Returns the first item in the collection. Calls seq on its argument. If coll is nil, returns nil."} @@ -44,9 +48,17 @@ (def #^{:arglists '([coll]) + :tag clojure.lang.ISeq :doc "Returns a seq of the items after the first. Calls seq on its argument. If there are no more items, returns nil."} - rest (fn rest [x] (. clojure.lang.RT (rest x)))) + next (fn next [x] (. clojure.lang.RT (next x)))) + +(def + #^{:arglists '([coll]) + :tag clojure.lang.ISeq + :doc "Returns a possibly empty seq of the items after the first. Calls seq on its + argument."} + rest (fn rest [x] (. clojure.lang.RT (more x)))) (def #^{:arglists '([coll x] [coll x & xs]) @@ -57,13 +69,13 @@ ([coll x] (. clojure.lang.RT (conj coll x))) ([coll x & xs] (if xs - (recur (conj coll x) (first xs) (rest xs)) + (recur (conj coll x) (first xs) (next xs)) (conj coll x))))) (def - #^{:doc "Same as (first (rest x))" + #^{:doc "Same as (first (next x))" :arglists '([x])} - second (fn second [x] (first (rest x)))) + second (fn second [x] (first (next x)))) (def #^{:doc "Same as (first (first x))" @@ -71,26 +83,26 @@ ffirst (fn ffirst [x] (first (first x)))) (def - #^{:doc "Same as (rest (first x))" + #^{:doc "Same as (next (first x))" :arglists '([x])} - rfirst (fn rfirst [x] (rest (first x)))) + nfirst (fn nfirst [x] (next (first x)))) (def - #^{:doc "Same as (first (rest x))" + #^{:doc "Same as (first (next x))" :arglists '([x])} - frest (fn frest [x] (first (rest x)))) + fnext (fn fnext [x] (first (next x)))) (def - #^{:doc "Same as (rest (rest x))" + #^{:doc "Same as (next (next x))" :arglists '([x])} - rrest (fn rrest [x] (rest (rest x)))) + nnext (fn nnext [x] (next (next x)))) (def #^{:arglists '([coll]) - :doc "Sequence. Returns a new ISeq on the collection. If the - collection is empty, returns nil. (seq nil) returns nil. seq also - works on Strings, native Java arrays (of reference types) and any - objects that implement Iterable." + :doc "Returns a seq on the collection. If the collection is + empty, returns nil. (seq nil) returns nil. seq also works on + Strings, native Java arrays (of reference types) and any objects + that implement Iterable." :tag clojure.lang.ISeq} seq (fn seq [coll] (. clojure.lang.RT (seq coll)))) @@ -127,7 +139,7 @@ (if (seq? (first fdecl)) (loop [ret [] fdecl fdecl] (if fdecl - (recur (conj ret (first (first fdecl))) (rest fdecl)) + (recur (conj ret (first (first fdecl))) (next fdecl)) (seq ret))) (list (first fdecl))))) @@ -143,7 +155,7 @@ ([map key val & kvs] (let [ret (assoc map key val)] (if kvs - (recur ret (first kvs) (second kvs) (rrest kvs)) + (recur ret (first kvs) (second kvs) (nnext kvs)) ret))))) ;;;;;;;;;;;;;;;;; metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -165,17 +177,17 @@ #^{:arglists '([coll]) :doc "Return the last item in coll, in linear time"} last (fn last [s] - (if (rest s) - (recur (rest s)) + (if (next s) + (recur (next s)) (first s)))) (def #^{:arglists '([coll]) - :doc "Return a sequence of all but the last item in coll, in linear time"} + :doc "Return a seq of all but the last item in coll, in linear time"} butlast (fn butlast [s] (loop [ret [] s s] - (if (rest s) - (recur (conj ret (first s)) (rest s)) + (if (next s) + (recur (conj ret (first s)) (next s)) (seq ret))))) (def @@ -190,13 +202,13 @@ {:doc (first fdecl)} {}) fdecl (if (string? (first fdecl)) - (rest fdecl) + (next fdecl) fdecl) m (if (map? (first fdecl)) (conj m (first fdecl)) m) fdecl (if (map? (first fdecl)) - (rest fdecl) + (next fdecl) fdecl) fdecl (if (vector? (first fdecl)) (list fdecl) @@ -281,6 +293,20 @@ (. (var defmacro) (setMacro)) +(defmacro assert-if-lazy-seq? {:private true} [] + (let [prop (System/getProperty "clojure.assert-if-lazy-seq")] + (if prop + (if (clojure.lang.Util/equals prop "") nil true)))) + +(defmacro if [tst & etc] + (if* (assert-if-lazy-seq?) + (let [tstsym 'G__0_0] + (list 'clojure.core/let [tstsym tst] + (list 'if* (list 'clojure.core/instance? clojure.lang.LazySeq tstsym) + (list 'throw (list 'new Exception "LazySeq used in 'if'")) + (cons 'if* (cons tstsym etc))))) + (cons 'if* (cons tst etc)))) + (defmacro when "Evaluates test. If logical true, evaluates body in an implicit do." [test & body] @@ -322,7 +348,7 @@ ([x & ys] ((fn [#^StringBuilder sb more] (if more - (recur (. sb (append (str (first more)))) (rest more)) + (recur (. sb (append (str (first more)))) (next more)) (str sb))) (new StringBuilder #^String (str x)) ys))) @@ -361,19 +387,19 @@ [& clauses] (when clauses (list 'if (first clauses) - (if (rest clauses) + (if (next clauses) (second clauses) (throw (IllegalArgumentException. "cond requires an even number of forms"))) - (cons 'clojure.core/cond (rest (rest clauses)))))) + (cons 'clojure.core/cond (next (next clauses)))))) (defn spread {:private true} [arglist] (cond (nil? arglist) nil - (nil? (rest arglist)) (seq (first arglist)) - :else (cons (first arglist) (spread (rest arglist))))) + (nil? (next arglist)) (seq (first arglist)) + :else (cons (first arglist) (spread (next arglist))))) (defn apply "Applies fn f to the argument list formed by prepending args to argseq." @@ -392,12 +418,46 @@ [item & more] (spread (cons item more))) +(defmacro lazy-seq + "Takes a body of expressions that returns an ISeq or nil, and yields + a Seqable object that will invoke the body only the first time seq + is called, and will cache the result and return it on all subsequent + seq calls. Any closed over locals will be cleared prior to the tail + call of body." + [& body] + (list* '#^{:once true :super-name "clojure/lang/LazySeq"} fn* [] body)) + +(defn concat + "Returns a lazy seq representing the concatenation of the elements in the supplied colls." + ([] (lazy-seq nil)) + ([x] (lazy-seq x)) + ([x y] + (lazy-seq + (let [s (seq x)] + (if s + (cons (first s) (concat (rest s) y)) + y)))) + ([x y & zs] + (let [cat (fn cat [xys zs] + (lazy-seq + (let [xys (seq xys)] + (if xys + (cons (first xys) (cat (rest xys) zs)) + (when zs + (cat (first zs) (next zs)))))))] + (cat (concat x y) zs)))) + +;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;; + + (defmacro delay "Takes a body of expressions and yields a Delay object that will invoke the body only the first time it is forced (with force), and - will cache the result and return it on all subsequent force calls" + will cache the result and return it on all subsequent force + calls. Any closed over locals will be cleared prior to the tail call + of body, (i.e. they will not be retained)." [& body] - (list 'new 'clojure.lang.Delay (list* `fn [] body))) + (list 'new 'clojure.lang.Delay (list* `#^{:once true} fn* [] body))) (defn delay? "returns true if x is a Delay created with delay" @@ -407,57 +467,6 @@ "If x is a Delay, returns the (possibly cached) value of its expression, else returns x" [x] (. clojure.lang.Delay (force x))) -(defn fnseq - "Returns a seq object whose first is first and whose rest is the - value produced by calling restfn with no arguments. restfn will be - called at most once per step in the sequence, e.g. calling rest - repeatedly on the head of the seq calls restfn once - the value it - yields is cached." - [first restfn] - (new clojure.lang.FnSeq first restfn)) - -(defmacro lazy-cons - "Expands to code which produces a seq object whose first is - first-expr and whose rest is rest-expr, neither of which is - evaluated until first/rest is called. Each expr will be evaluated at most - once per step in the sequence, e.g. calling first/rest repeatedly on the - same node of the seq evaluates first/rest-expr once - the values they yield are - cached." - [first-expr & rest-expr] - (list 'new 'clojure.lang.LazyCons (list `fn (list [] first-expr) (list* [(gensym)] rest-expr)))) - -;(defmacro lazy-seq -; "Expands to code which produces a seq object whose first is the -; value of first-expr and whose rest is the value of rest-expr, -; neither of which is evaluated until first/rest is called. Each expr -; will be evaluated every step in the sequence, e.g. calling -; first/rest repeatedly on the same node of the seq evaluates -; first/rest-expr repeatedly - the values they yield are not cached." -; [first-expr rest-expr] -; (list 'new 'clojure.lang.LazySeq (list `fn (list [] first-expr) (list [(gensym)] rest-expr)))) - -(defn cache-seq - "Given a seq s, returns a lazy seq that will touch each element of s - at most once, caching the results." - [s] (when s (clojure.lang.CachedSeq. s))) - -(defn concat - "Returns a lazy seq representing the concatenation of the elements in the supplied colls." - ([] nil) - ([x] (seq x)) - ([x y] - (if (seq x) - (lazy-cons (first x) (concat (rest x) y)) - (seq y))) - ([x y & zs] - (let [cat (fn cat [xys zs] - (if (seq xys) - (lazy-cons (first xys) (cat (rest xys) zs)) - (when zs - (recur (first zs) (rest zs)))))] - (cat (concat x y) zs)))) - -;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;; (defmacro if-not "Evaluates test. If logical false, evaluates and returns then expr, otherwise else expr, if supplied, else nil." ([test then] `(if-not ~test ~then nil)) @@ -477,8 +486,8 @@ ([x y] (clojure.lang.Util/equiv x y)) ([x y & more] (if (= x y) - (if (rest more) - (recur y (first more) (rest more)) + (if (next more) + (recur y (first more) (next more)) (= y (first more))) false))) @@ -508,9 +517,9 @@ the value of the last expr. (and) returns true." ([] true) ([x] x) - ([x & rest] + ([x & next] `(let [and# ~x] - (if and# (and ~@rest) and#)))) + (if and# (and ~@next) and#)))) (defmacro or "Evaluates exprs one at a time, from left to right. If a form @@ -519,9 +528,9 @@ value of the last expression. (or) returns nil." ([] nil) ([x] x) - ([x & rest] + ([x & next] `(let [or# ~x] - (if or# or# (or ~@rest))))) + (if or# or# (or ~@next))))) ;;;;;;;;;;;;;;;;;;; sequence fns ;;;;;;;;;;;;;;;;;;;;;;; (defn reduce @@ -539,7 +548,7 @@ (if s (if (instance? clojure.lang.IReduce s) (. #^clojure.lang.IReduce s (reduce f)) - (reduce f (first s) (rest s))) + (reduce f (first s) (next s))) (f)))) ([f val coll] (let [s (seq coll)] @@ -547,7 +556,7 @@ (. #^clojure.lang.IReduce s (reduce f val)) ((fn [f val s] (if s - (recur f (f val (first s)) (rest s)) + (recur f (f val (first s)) (next s)) val)) f val s))))) @@ -606,8 +615,8 @@ ([x y] (. clojure.lang.Numbers (lt x y))) ([x y & more] (if (< x y) - (if (rest more) - (recur y (first more) (rest more)) + (if (next more) + (recur y (first more) (next more)) (< y (first more))) false))) @@ -620,8 +629,8 @@ ([x y] (. clojure.lang.Numbers (lte x y))) ([x y & more] (if (<= x y) - (if (rest more) - (recur y (first more) (rest more)) + (if (next more) + (recur y (first more) (next more)) (<= y (first more))) false))) @@ -634,8 +643,8 @@ ([x y] (. clojure.lang.Numbers (gt x y))) ([x y & more] (if (> x y) - (if (rest more) - (recur y (first more) (rest more)) + (if (next more) + (recur y (first more) (next more)) (> y (first more))) false))) @@ -648,8 +657,8 @@ ([x y] (. clojure.lang.Numbers (gte x y))) ([x y & more] (if (>= x y) - (if (rest more) - (recur y (first more) (rest more)) + (if (next more) + (recur y (first more) (next more)) (>= y (first more))) false))) @@ -661,8 +670,8 @@ ([x y] (. clojure.lang.Numbers (equiv x y))) ([x y & more] (if (== x y) - (if (rest more) - (recur y (first more) (rest more)) + (if (next more) + (recur y (first more) (next more)) (== y (first more))) false))) @@ -838,8 +847,12 @@ (defn complement "Takes a fn f and returns a fn that takes the same arguments as f, has the same effects, if any, and returns the opposite truth value." - [f] (fn [& args] - (not (apply f args)))) + [f] + (fn + ([] (not (f))) + ([x] (not (f x))) + ([x y] (not (f x y))) + ([x y & zs] (not (apply f x y zs))))) (defn constantly "Returns a function that takes any number of arguments and returns x." @@ -868,7 +881,7 @@ "For a list or queue, returns a new list/queue without the first item, for a vector, returns a new vector without the last item. If the collection is empty, throws an exception. Note - not the same - as rest/butlast." + as next/butlast." [coll] (. clojure.lang.RT (pop coll))) (defn nth @@ -905,7 +918,7 @@ ([map key & ks] (let [ret (dissoc map key)] (if ks - (recur ret (first ks) (rest ks)) + (recur ret (first ks) (next ks)) ret)))) (defn disj @@ -917,7 +930,7 @@ ([set key & ks] (let [ret (disj set key)] (if ks - (recur ret (first ks) (rest ks)) + (recur ret (first ks) (next ks)) ret)))) (defn find @@ -934,7 +947,7 @@ (if entry (conj ret entry) ret) - (rest keys))) + (next keys))) ret))) (defn keys @@ -956,8 +969,8 @@ (. e (getValue))) (defn rseq - "Returns, in constant time, a sequence of the items in rev (which - can be a vector or sorted-map), in reverse order." + "Returns, in constant time, a seq of the items in rev (which + can be a vector or sorted-map), in reverse order. If rev is empty returns nil" [#^clojure.lang.Reversible rev] (. rev (rseq))) @@ -1007,7 +1020,7 @@ list already. If there are more forms, inserts the first form as the second item in second form, etc." ([x form] (if (seq? form) - `(~(first form) ~x ~@(rest form)) + `(~(first form) ~x ~@(next form)) (list form x))) ([x form & more] `(-> (-> ~x ~form) ~@more))) @@ -1028,16 +1041,16 @@ (first options) nil) options (if (string? (first options)) - (rest options) + (next options) options) m (if (map? (first options)) (first options) {}) options (if (map? (first options)) - (rest options) + (next options) options) dispatch-fn (first options) - options (rest options) + options (next options) m (assoc m :tag 'clojure.lang.MultiFn) m (if docstring (assoc m :doc docstring) @@ -1082,10 +1095,41 @@ `(do (when-not ~(first pairs) (throw (IllegalArgumentException. ~(str fnname " requires " (second pairs))))) - ~(let [more (rrest pairs)] + ~(let [more (nnext pairs)] (when more (list* `assert-args fnname more))))) +(defmacro if-let + "bindings => binding-form test + + If test is true, evaluates then with binding-form bound to the value of test, if not, yields else" + ([bindings then] + `(if-let ~bindings ~then nil)) + ([bindings then else & oldform] + (assert-args if-let + (and (vector? bindings) (nil? oldform)) "a vector for its binding" + (= 2 (count bindings)) "exactly 2 forms in binding vector") + (let [form (bindings 0) tst (bindings 1)] + `(let [temp# ~tst] + (if temp# + (let [~form temp#] + ~then) + ~else))))) + +(defmacro when-let + "bindings => binding-form test + + When test is true, evaluates body with binding-form bound to the value of test" + [bindings & body] + (assert-args when-let + (vector? bindings) "a vector for its binding" + (= 2 (count bindings)) "exactly 2 forms in binding vector") + (let [form (bindings 0) tst (bindings 1)] + `(let [temp# ~tst] + (when temp# + (let [~form temp#] + ~@body))))) + (defmacro binding "binding => var-symbol init-expr @@ -1100,7 +1144,7 @@ (loop [ret [] vvs (seq var-vals)] (if vvs (recur (conj (conj ret `(var ~(first vvs))) (second vvs)) - (rest (rest vvs))) + (next (next vvs))) (seq ret))))] `(do (. clojure.lang.Var (pushThreadBindings (hash-map ~@(var-ize bindings)))) @@ -1353,7 +1397,7 @@ exception message." [& body] (let [message (when (string? (first body)) (first body)) - body (if message (rest body) body)] + body (if message (next body) body)] `(if (clojure.lang.LockingTransaction/isRunning) (throw (new IllegalStateException ~(or message "I/O in transaction"))) (do ~@body)))) @@ -1369,9 +1413,9 @@ [& fs] (let [fs (reverse fs)] (fn [& args] - (loop [ret (apply (first fs) args) fs (rest fs)] + (loop [ret (apply (first fs) args) fs (next fs)] (if fs - (recur ((first fs) ret) (rest fs)) + (recur ((first fs) ret) (next fs)) ret))))) (defn partial @@ -1396,7 +1440,7 @@ [pred coll] (if (seq coll) (and (pred (first coll)) - (recur pred (rest coll))) + (recur pred (next coll))) true)) (def @@ -1413,7 +1457,7 @@ (some #{:fred} coll)" [pred coll] (when (seq coll) - (or (pred (first coll)) (recur pred (rest coll))))) + (or (pred (first coll)) (recur pred (next coll))))) (def #^{:tag Boolean @@ -1423,26 +1467,33 @@ not-any? (comp not some)) (defn map - "Returns a lazy seq consisting of the result of applying f to the + "Returns a lazy sequence consisting of the result of applying f to the set of first items of each coll, followed by applying f to the set of second items in each coll, until any one of the colls is exhausted. Any remaining items in other colls are ignored. Function f should accept number-of-colls arguments." ([f coll] - (when (seq coll) - (lazy-cons (f (first coll)) (map f (rest coll))))) + (lazy-seq + (when-let [s (seq coll)] + (cons (f (first s)) (map f (rest s)))))) ([f c1 c2] - (when (and (seq c1) (seq c2)) - (lazy-cons (f (first c1) (first c2)) - (map f (rest c1) (rest c2))))) + (lazy-seq + (let [s1 (seq c1) s2 (seq c2)] + (when (and s1 s2) + (cons (f (first s1) (first s2)) + (map f (rest s1) (rest s2))))))) ([f c1 c2 c3] - (when (and (seq c1) (seq c2) (seq c3)) - (lazy-cons (f (first c1) (first c2) (first c3)) - (map f (rest c1) (rest c2) (rest c3))))) + (lazy-seq + (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] + (when (and s1 s2 s3) + (cons (f (first s1) (first s2) (first s3)) + (map f (rest s1) (rest s2) (rest s3))))))) ([f c1 c2 c3 & colls] (let [step (fn step [cs] - (when (every? seq cs) - (lazy-cons (map first cs) (step (map rest cs)))))] + (lazy-seq + (let [ss (map seq cs)] + (when (every? identity ss) + (cons (map first ss) (step (map rest ss)))))))] (map #(apply f %) (step (conj colls c3 c2 c1)))))) (defn mapcat @@ -1452,67 +1503,70 @@ (apply concat (apply map f colls))) (defn filter - "Returns a lazy seq of the items in coll for which + "Returns a lazy sequence of the items in coll for which (pred item) returns true. pred must be free of side-effects." [pred coll] - (when (seq coll) - (if (pred (first coll)) - (lazy-cons (first coll) (filter pred (rest coll))) - (recur pred (rest coll))))) + (let [step (fn [p c] + (when-let [s (seq c)] + (if (p (first s)) + (cons (first s) (filter p (rest s))) + (recur p (rest s)))))] + (lazy-seq (step pred coll)))) + (defn remove - "Returns a lazy seq of the items in coll for which + "Returns a lazy sequence of the items in coll for which (pred item) returns false. pred must be free of side-effects." [pred coll] - (when (seq coll) - (if (pred (first coll)) - (recur pred (rest coll)) - (lazy-cons (first coll) (remove pred (rest coll)))))) + (filter (complement pred) coll)) (defn take - "Returns a lazy seq of the first n items in coll, or all items if + "Returns a lazy sequence of the first n items in coll, or all items if there are fewer than n." [n coll] - (when (and (pos? n) (seq coll)) - (lazy-cons (first coll) (when (> n 1) (take (dec n) (rest coll)))))) + (lazy-seq + (when (pos? n) + (when-let [s (seq coll)] + (cons (first s) (take (dec n) (rest s))))))) (defn take-while - "Returns a lazy seq of successive items from coll while + "Returns a lazy sequence of successive items from coll while (pred item) returns true. pred must be free of side-effects." [pred coll] - (when (and (seq coll) (pred (first coll))) - (lazy-cons (first coll) (take-while pred (rest coll))))) + (lazy-seq + (when-let [s (seq coll)] + (when (pred (first s)) + (cons (first s) (take-while pred (rest s))))))) (defn drop - "Returns a lazy seq of all but the first n items in coll." + "Returns a lazy sequence of all but the first n items in coll." [n coll] - (if (and (pos? n) (seq coll)) - (recur (dec n) (rest coll)) - (seq coll))) + (let [step (fn [n coll] + (let [s (seq coll)] + (if (and (pos? n) s) + (recur (dec n) (rest s)) + s)))] + (lazy-seq (step n coll)))) (defn drop-last - "Return a lazy seq of all but the last n (default 1) items in coll" |