|
417 | 417 | ([x] (lazy-seq x)) |
418 | 418 | ([x y] |
419 | 419 | (lazy-seq |
420 | | - (if (seq x) |
421 | | - (cons (first x) (concat (more x) y)) |
422 | | - y))) |
| 420 | + (let [s (seq x)] |
| 421 | + (if s |
| 422 | + (cons (first s) (concat (more s) y)) |
| 423 | + y)))) |
423 | 424 | ([x y & zs] |
424 | 425 | (let [cat (fn cat [xys zs] |
425 | 426 | (lazy-seq |
426 | | - (if (seq xys) |
427 | | - (cons (first xys) (cat (more xys) zs)) |
428 | | - (when zs |
429 | | - (cat (first zs) (rest zs))))))] |
430 | | - (cat (concat x y) zs)))) |
| 427 | + (let [xys (seq xys)] |
| 428 | + (if xys |
| 429 | + (cons (first xys) (cat (more xys) zs)) |
| 430 | + (when zs |
| 431 | + (cat (first zs) (rest zs)))))))] |
| 432 | + (cat (concat x y) zs)))) |
431 | 433 |
|
432 | 434 | ;;;;;;;;;;;;;;;;at this point all the support for syntax-quote exists;;;;;;;;;;;;;;;;;;;;;; |
433 | 435 |
|
|
1076 | 1078 | (when more |
1077 | 1079 | (list* `assert-args fnname more))))) |
1078 | 1080 |
|
| 1081 | +(defmacro if-let |
| 1082 | + "bindings => binding-form test |
| 1083 | +
|
| 1084 | + If test is true, evaluates then with binding-form bound to the value of test, if not, yields else" |
| 1085 | + ([bindings then] |
| 1086 | + `(if-let ~bindings ~then nil)) |
| 1087 | + ([bindings then else & oldform] |
| 1088 | + (assert-args if-let |
| 1089 | + (and (vector? bindings) (nil? oldform)) "a vector for its binding" |
| 1090 | + (= 2 (count bindings)) "exactly 2 forms in binding vector") |
| 1091 | + (let [form (bindings 0) tst (bindings 1)] |
| 1092 | + `(let [temp# ~tst] |
| 1093 | + (if temp# |
| 1094 | + (let [~form temp#] |
| 1095 | + ~then) |
| 1096 | + ~else))))) |
| 1097 | + |
| 1098 | +(defmacro when-let |
| 1099 | + "bindings => binding-form test |
| 1100 | +
|
| 1101 | + When test is true, evaluates body with binding-form bound to the value of test" |
| 1102 | + [bindings & body] |
| 1103 | + (assert-args when-let |
| 1104 | + (vector? bindings) "a vector for its binding" |
| 1105 | + (= 2 (count bindings)) "exactly 2 forms in binding vector") |
| 1106 | + (let [form (bindings 0) tst (bindings 1)] |
| 1107 | + `(let [temp# ~tst] |
| 1108 | + (when temp# |
| 1109 | + (let [~form temp#] |
| 1110 | + ~@body))))) |
| 1111 | + |
1079 | 1112 | (defmacro binding |
1080 | 1113 | "binding => var-symbol init-expr |
1081 | 1114 |
|
|
1418 | 1451 | f should accept number-of-colls arguments." |
1419 | 1452 | ([f coll] |
1420 | 1453 | (lazy-seq |
1421 | | - (when (seq coll) |
1422 | | - (cons (f (first coll)) (map f (more coll)))))) |
| 1454 | + (when-let [s (seq coll)] |
| 1455 | + (cons (f (first s)) (map f (more s)))))) |
1423 | 1456 | ([f c1 c2] |
1424 | 1457 | (lazy-seq |
1425 | | - (when (and (seq c1) (seq c2)) |
1426 | | - (cons (f (first c1) (first c2)) |
1427 | | - (map f (more c1) (more c2)))))) |
| 1458 | + (let [s1 (seq c1) s2 (seq c2)] |
| 1459 | + (when (and s1 s2) |
| 1460 | + (cons (f (first s1) (first s2)) |
| 1461 | + (map f (more s1) (more s2))))))) |
1428 | 1462 | ([f c1 c2 c3] |
1429 | 1463 | (lazy-seq |
1430 | | - (when (and (seq c1) (seq c2) (seq c3)) |
1431 | | - (cons (f (first c1) (first c2) (first c3)) |
1432 | | - (map f (more c1) (more c2) (more c3)))))) |
| 1464 | + (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] |
| 1465 | + (when (and s1 s2 s3) |
| 1466 | + (cons (f (first s1) (first s2) (first s3)) |
| 1467 | + (map f (more s1) (more s2) (more s3))))))) |
1433 | 1468 | ([f c1 c2 c3 & colls] |
1434 | 1469 | (let [step (fn step [cs] |
1435 | 1470 | (lazy-seq |
1436 | | - (when (every? seq cs) |
1437 | | - (cons (map first cs) (step (map more cs))))))] |
| 1471 | + (let [ss (map seq cs)] |
| 1472 | + (when (every? identity ss) |
| 1473 | + (cons (map first ss) (step (map more ss)))))))] |
1438 | 1474 | (map #(apply f %) (step (conj colls c3 c2 c1)))))) |
1439 | 1475 |
|
1440 | 1476 | (defn mapcat |
|
1447 | 1483 | "Returns a lazy sequence of the items in coll for which |
1448 | 1484 | (pred item) returns true. pred must be free of side-effects." |
1449 | 1485 | [pred coll] |
1450 | | - (let [step (fn [pred coll] |
1451 | | - (when (seq coll) |
1452 | | - (if (pred (first coll)) |
1453 | | - (clojure.lang.Cons. (first coll) (filter pred (more coll))) |
1454 | | - (recur pred (more coll)))))] |
| 1486 | + (let [step (fn [p c] |
| 1487 | + (when-let [s (seq c)] |
| 1488 | + (if (p (first s)) |
| 1489 | + (clojure.lang.Cons. (first s) (filter p (more s))) |
| 1490 | + (recur p (more s)))))] |
1455 | 1491 | (lazy-seq (step pred coll)))) |
1456 | 1492 |
|
1457 | 1493 |
|
|
1466 | 1502 | there are fewer than n." |
1467 | 1503 | [n coll] |
1468 | 1504 | (lazy-seq |
1469 | | - (when (and (pos? n) (seq coll)) |
1470 | | - (cons (first coll) (take (dec n) (more coll)))))) |
| 1505 | + (when (pos? n) |
| 1506 | + (when-let [s (seq coll)] |
| 1507 | + (cons (first s) (take (dec n) (more s))))))) |
1471 | 1508 |
|
1472 | 1509 | (defn take-while |
1473 | 1510 | "Returns a lazy sequence of successive items from coll while |
1474 | 1511 | (pred item) returns true. pred must be free of side-effects." |
1475 | 1512 | [pred coll] |
1476 | 1513 | (lazy-seq |
1477 | | - (when (and (seq coll) (pred (first coll))) |
1478 | | - (cons (first coll) (take-while pred (more coll)))))) |
| 1514 | + (when-let [s (seq coll)] |
| 1515 | + (when (pred (first s))) |
| 1516 | + (cons (first s) (take-while pred (more s)))))) |
1479 | 1517 |
|
1480 | 1518 | (defn drop |
1481 | 1519 | "Returns a lazy sequence of all but the first n items in coll." |
1482 | 1520 | [n coll] |
1483 | 1521 | (let [step (fn [n coll] |
1484 | | - (if (and (pos? n) (seq coll)) |
1485 | | - (recur (dec n) (more coll)) |
1486 | | - (seq coll)))] |
| 1522 | + (let [s (seq coll)] |
| 1523 | + (if (and (pos? n) s) |
| 1524 | + (recur (dec n) (more s)) |
| 1525 | + s)))] |
1487 | 1526 | (lazy-seq (step n coll)))) |
1488 | 1527 |
|
1489 | 1528 | (defn drop-last |
|
1496 | 1535 | item for which (pred item) returns nil." |
1497 | 1536 | [pred coll] |
1498 | 1537 | (let [step (fn [pred coll] |
1499 | | - (if (and (seq coll) (pred (first coll))) |
1500 | | - (recur pred (more coll)) |
1501 | | - (seq coll)))] |
| 1538 | + (let [s (seq coll)] |
| 1539 | + (if (and s (pred (first s))) |
| 1540 | + (recur pred (more s)) |
| 1541 | + s)))] |
1502 | 1542 | (lazy-seq (step pred coll)))) |
1503 | 1543 |
|
1504 | 1544 | (defn cycle |
|
1625 | 1665 | (partition n n coll)) |
1626 | 1666 | ([n step coll] |
1627 | 1667 | (lazy-seq |
1628 | | - (when (seq coll) |
1629 | | - (let [p (take n coll)] |
| 1668 | + (when-let [s (seq coll)] |
| 1669 | + (let [p (take n s)] |
1630 | 1670 | (when (= n (count p)) |
1631 | | - (cons p (partition n step (drop step coll))))))))) |
| 1671 | + (cons p (partition n step (drop step s))))))))) |
1632 | 1672 |
|
1633 | 1673 | ;; evaluation |
1634 | 1674 |
|
|
2374 | 2414 | "Returns a lazy seq of every nth item in coll." |
2375 | 2415 | [n coll] |
2376 | 2416 | (lazy-seq |
2377 | | - (when (seq coll) |
2378 | | - (cons (first coll) (take-nth n (drop n coll)))))) |
| 2417 | + (when-let [s (seq coll)] |
| 2418 | + (cons (first s) (take-nth n (drop n s)))))) |
2379 | 2419 |
|
2380 | 2420 | (defn interleave |
2381 | 2421 | "Returns a lazy seq of the first item in each coll, then the second |
|
2611 | 2651 | `(fn ~giter [~gxs] |
2612 | 2652 | (lazy-seq |
2613 | 2653 | (loop [~gxs ~gxs] |
2614 | | - (when-first [~(:bind group) ~gxs] |
2615 | | - (when ~(or (:while group) true) |
2616 | | - (if ~(or (:when group) true) |
2617 | | - ~(if more-groups |
2618 | | - `(let [iterys# ~(emit more-groups) |
2619 | | - fs# (seq (iterys# ~next-seq))] |
2620 | | - (if fs# |
2621 | | - (concat fs# (~giter (more ~gxs))) |
2622 | | - (recur (more ~gxs)))) |
2623 | | - `(cons ~expr (~giter (more ~gxs)))) |
2624 | | - (recur (more ~gxs))))))))))] |
| 2654 | + (let [~gxs (seq ~gxs)] |
| 2655 | + (when-first [~(:bind group) ~gxs] |
| 2656 | + (when ~(or (:while group) true) |
| 2657 | + (if ~(or (:when group) true) |
| 2658 | + ~(if more-groups |
| 2659 | + `(let [iterys# ~(emit more-groups) |
| 2660 | + fs# (seq (iterys# ~next-seq))] |
| 2661 | + (if fs# |
| 2662 | + (concat fs# (~giter (more ~gxs))) |
| 2663 | + (recur (more ~gxs)))) |
| 2664 | + `(cons ~expr (~giter (more ~gxs)))) |
| 2665 | + (recur (more ~gxs)))))))))))] |
2625 | 2666 | `(let [iter# ~(emit (to-groups seq-exprs))] |
2626 | 2667 | (iter# ~(second seq-exprs)))))) |
2627 | 2668 |
|
|
2906 | 2947 | (let [step (fn step [xs seen] |
2907 | 2948 | (lazy-seq |
2908 | 2949 | ((fn [[f :as xs] seen] |
2909 | | - (when (seq xs) |
| 2950 | + (when-let [s (seq xs)] |
2910 | 2951 | (if (seen f) |
2911 | | - (recur (more xs) seen) |
2912 | | - (cons f (step (more xs) (conj seen f)))))) |
| 2952 | + (recur (more s) seen) |
| 2953 | + (cons f (step (more s) (conj seen f)))))) |
2913 | 2954 | xs seen)))] |
2914 | 2955 | (step coll #{}))) |
2915 | 2956 |
|
2916 | | -(defmacro if-let |
2917 | | - "bindings => binding-form test |
2918 | 2957 |
|
2919 | | - If test is true, evaluates then with binding-form bound to the value of test, if not, yields else" |
2920 | | - ([bindings then] |
2921 | | - `(if-let ~bindings ~then nil)) |
2922 | | - ([bindings then else & oldform] |
2923 | | - (assert-args if-let |
2924 | | - (and (vector? bindings) (nil? oldform)) "a vector for its binding" |
2925 | | - (= 2 (count bindings)) "exactly 2 forms in binding vector") |
2926 | | - (let [[form tst] bindings] |
2927 | | - `(let [temp# ~tst] |
2928 | | - (if temp# |
2929 | | - (let [~form temp#] |
2930 | | - ~then) |
2931 | | - ~else))))) |
2932 | | - |
2933 | | -(defmacro when-let |
2934 | | - "bindings => binding-form test |
2935 | | -
|
2936 | | - When test is true, evaluates body with binding-form bound to the value of test" |
2937 | | - [bindings & body] |
2938 | | - (assert-args when-let |
2939 | | - (vector? bindings) "a vector for its binding" |
2940 | | - (= 2 (count bindings)) "exactly 2 forms in binding vector") |
2941 | | - (let [[form tst] bindings] |
2942 | | - `(let [temp# ~tst] |
2943 | | - (when temp# |
2944 | | - (let [~form temp#] |
2945 | | - ~@body))))) |
2946 | 2958 |
|
2947 | 2959 | (defn replace |
2948 | 2960 | "Given a map of replacement pairs and a vector/collection, returns a |
|
3740 | 3752 | step (fn step [[x & xs :as s] |
3741 | 3753 | [a & as :as acycle]] |
3742 | 3754 | (lazy-seq |
3743 | | - (if s |
3744 | | - (let [v (wget a)] |
3745 | | - (send a (fn [_] (f x))) |
3746 | | - (cons v (step xs as))) |
3747 | | - (map wget (take (count agents) acycle)))))] |
| 3755 | + (let [s (seq s)] |
| 3756 | + (if s |
| 3757 | + (let [v (wget a)] |
| 3758 | + (send a (fn [_] (f x))) |
| 3759 | + (cons v (step xs as))) |
| 3760 | + (map wget (take (count agents) acycle))))))] |
3748 | 3761 | (step (drop n coll) (cycle agents)))) |
3749 | 3762 | ([f coll & colls] |
3750 | 3763 | (let [step (fn step [cs] |
3751 | 3764 | (lazy-seq |
3752 | | - (when (every? seq cs) |
3753 | | - (cons (map first cs) (step (map rest cs))))))] |
| 3765 | + (let [ss (map seq cs)] |
| 3766 | + (when (every? identity ss) |
| 3767 | + (cons (map first ss) (step (map rest ss)))))))] |
3754 | 3768 | (pmap #(apply f %) (step (cons coll colls)))))) |
3755 | 3769 |
|
3756 | 3770 | (def |
|
0 commit comments