在书里《Scheme 编程语言，第四版》 http://www.scheme.com/tspl4/，作者：R. Kent Dybvig，第 86 页，作者写了define-syntax（方案宏）对于case接受其条件范围的语句。我想我会在 Clojure 中尝试这个。
这是结果。
我该如何改进这个？我用:ii, :ie, :ei, and :ee对于范围运算符，表示包含-包含、包含-排除、独占-包含，
和独家独家。还有更好的选择吗？
我选择扩展到cond而不是离散的if声明，因为我觉得我将从未来的任何改进中受益cond macro.
(defmacro range-case [target & cases]
"Compare the target against a set of ranges or constant values and return
the first one that matches. If none match, and there exists a case with the
value :else, return that target. Each range consists of a vector containing
3 terms: a lower bound, an operator, and an upper bound. The operator must
be one of :ii, :ie, :ei, or :ee, which indicate that the range comparison
should be inclusive-inclusive, inclusive-exclusive, exclusive-inclusive,
or exclusive-exclusive, respectively.
Example:
(range-case target
[0.0 :ie 1.0] :greatly-disagree
[1.0 :ie 2.0] :disagree
[2.0 :ie 3.0] :neutral
[3.0 :ie 4.0] :agree
[4.0 :ii 5.0] :strongly-agree
42 :the-answer
:else :do-not-care)
expands to
(cond
(and (<= 0.0 target) (< target 1.0)) :greatly-disagree
(and (<= 1.0 target) (< target 2.0)) :disagree
(and (<= 2.0 target) (< target 3.0)) :neutral
(and (<= 3.0 target) (< target 4.0)) :agree
(<= 4.0 target 5.0) :strongly-agree
(= target 42) :the-answer
:else :do-not-care)
Test cases:
(use '[clojure.test :only (deftest is run-tests)])
(deftest unit-tests
(letfn [(test-range-case [target]
(range-case target
[0.0 :ie 1.0] :greatly-disagree
[1.0 :ie 2.0] :disagree
[2.0 :ie 3.0] :neutral
[3.0 :ie 4.0] :agree
[4.0 :ii 5.0] :strongly-agree
42 :the-answer
:else :do-not-care))]
(is (= (test-range-case 0.0) :greatly-disagree))
(is (test-range-case 0.5) :greatly-disagree)
(is (test-range-case 1.0) :disagree)
(is (test-range-case 1.5) :disagree)
(is (test-range-case 2.0) :neutral)
(is (test-range-case 2.5) :neutral)
(is (test-range-case 3.0) :agree)
(is (test-range-case 3.5) :agree)
(is (test-range-case 4.0) :strongly-agree)
(is (test-range-case 4.5) :strongly-agree)
(is (test-range-case 5.0) :strongly-agree)
(is (test-range-case 42) :the-answer)
(is (test-range-case -1) :do-not-care)))
(run-tests)"
`(cond
~@(loop [cases cases ret []]
(cond
(empty? cases)
ret
(odd? (count cases))
(throw (IllegalArgumentException.
(str "no matching clause: " (first cases))))
(= :else (first cases))
(recur (drop 2 cases) (conj ret :else (second cases)))
(vector? (first cases))
(let [[lower-bound operator upper-bound] (first cases)
clause (second cases)
[condition clause]
(case operator
:ii `((<= ~lower-bound ~target ~upper-bound) ~clause)
:ie `((and (<= ~lower-bound ~target)
(< ~target ~upper-bound)) ~clause)
:ei `((and (< ~lower-bound ~target)
(<= ~target ~upper-bound)) ~clause)
:ee `((< ~lower-bound ~target ~upper-bound) ~clause)
(throw (IllegalArgumentException.
(str "unknown operator: " operator))))]
(recur (drop 2 cases) (conj ret condition clause)))
:else
(let [[condition clause]
`[(= ~target ~(first cases)) ~(second cases)]]
(recur (drop 2 cases) (conj ret condition clause)))))))
UPDATE：这是包含以下建议的更改的修订版本mikera https://stackoverflow.com/users/214010/mikera and kotarak https://stackoverflow.com/users/198935/kotarak:
(defmacro range-case [target & cases]
"Compare the target against a set of ranges or constant values and return
the first one that matches. If none match, and there exists a case with the
value :else, return that target. Each range consists of a vector containing
one of the following patterns:
[upper-bound] if this is the first pattern, match any
target <= upper-bound
otherwise, match any target <= previous
upper-bound and <= upper-bound
[< upper-bound] if this is the first pattern, match any
target < upper-bound
otherwise, match any target <= previous
upper-bound and < upper-bound
[lower-bound upper-bound] match any target where lower-bound <= target
and target <= upper-bound
[< lower-bound upper-bound] match any target where lower-bound < target
and target <= upper-bound
[lower-bound < upper-bound] match any target where lower-bound <= target
and target < upper-bound
[< lower-bound < upper-bound] match any target where lower-bound < target
and target < upper-bound
Example:
(range-case target
[0 < 1] :strongly-disagree
[< 2] :disagree
[< 3] :neutral
[< 4] :agree
[5] :strongly-agree
42 :the-answer
:else :do-not-care)
expands to
(cond
(and (<= 0 target) (< target 1)) :strongly-disagree
(and (<= 1 target) (< target 2)) :disagree
(and (<= 2 target) (< target 3)) :neutral
(and (<= 3 target) (< target 4)) :agree
(<= 4 target 5) :strongly-agree
(= target 42) :the-answer
:else :do-not-care)
Test cases:
(use '[clojure.test :only (deftest is run-tests)])
(deftest unit-tests
(letfn [(test-range-case [target]
(range-case target
[0 < 1] :strongly-disagree
[< 2] :disagree
[< 3] :neutral
[< 4] :agree
[5] :strongly-agree
42 :the-answer
:else :do-not-care))]
(is (= (test-range-case 0) :strongly-disagree))
(is (= (test-range-case 0.5) :strongly-disagree))
(is (= (test-range-case 1) :disagree))
(is (= (test-range-case 1.5) :disagree))
(is (= (test-range-case 2) :neutral))
(is (= (test-range-case 2.5) :neutral))
(is (= (test-range-case 3) :agree))
(is (= (test-range-case 3.5) :agree))
(is (= (test-range-case 4) :strongly-agree))
(is (= (test-range-case 4.5) :strongly-agree))
(is (= (test-range-case 5) :strongly-agree))
(is (= (test-range-case 42) :the-answer))
(is (= (test-range-case -1) :do-not-care))))
(run-tests)"
(if (odd? (count cases))
(throw (IllegalArgumentException. (str "no matching clause: "
(first cases))))
`(cond
~@(loop [cases cases ret [] previous-upper-bound nil]
(cond
(empty? cases)
ret
(= :else (first cases))
(recur (drop 2 cases) (conj ret :else (second cases)) nil)
(vector? (first cases))
(let [condition (first cases)
clause (second cases)
[case-expr prev-upper-bound]
(let [length (count condition)]
(cond
(= length 1)
(let [upper-bound (first condition)]
[(if previous-upper-bound
`(and (<= ~previous-upper-bound ~target)
(<= ~target ~upper-bound))
`(<= ~target ~upper-bound))
upper-bound])
(= length 2)
(if (= '< (first condition))
(let [[_ upper-bound] condition]
[(if previous-upper-bound
`(and (<= ~previous-upper-bound ~target)
(< ~target ~upper-bound))
`(< ~target ~upper-bound))
upper-bound])
(let [[lower-bound upper-bound] condition]
[`(and (<= ~lower-bound ~target)
(<= ~target ~upper-bound))
upper-bound]))
(= length 3)
(cond
(= '< (first condition))
(let [[_ lower-bound upper-bound] condition]
[`(and (< ~lower-bound ~target)
(<= ~target ~upper-bound))
upper-bound])
(= '< (second condition))
(let [[lower-bound _ upper-bound] condition]
[`(and (<= ~lower-bound ~target)
(< ~target ~upper-bound))
upper-bound])
:else
(throw (IllegalArgumentException. (str "unknown pattern: "
condition))))
(and (= length 4)
(= '< (first condition))
(= '< (nth condition 3)))
(let [[_ lower-bound _ upper-bound] condition]
[`(and (< ~lower-bound ~target) (< ~target ~upper-bound))
upper-bound])
:else
(throw (IllegalArgumentException. (str "unknown pattern: "
condition)))))]
(recur (drop 2 cases)
(conj ret case-expr clause)
prev-upper-bound))
:else
(let [[condition clause]
`[(= ~target ~(first cases)) ~(second cases)]]
(recur (drop 2 cases) (conj ret condition clause) nil)))))))
