rlm@10: ;;; fcase.clj -- simple variants of "case" for Clojure
rlm@10: 
rlm@10: ;; by Stuart Sierra, http://stuartsierra.com/
rlm@10: ;; April 7, 2008
rlm@10: 
rlm@10: ;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
rlm@10: ;; and distribution terms for this software are covered by the Eclipse
rlm@10: ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;; which can be found in the file epl-v10.html at the root of this
rlm@10: ;; distribution.  By using this software in any fashion, you are
rlm@10: ;; agreeing to be bound by the terms of this license.  You must not
rlm@10: ;; remove this notice, or any other, from this software.
rlm@10: 
rlm@10: 
rlm@10: ;; This file defines a generic "case" macro called "fcase" which takes
rlm@10: ;; the equality-testing function as an argument.  It also defines a
rlm@10: ;; traditional "case" macro that tests using "=" and variants that
rlm@10: ;; test for regular expressions and class membership.
rlm@10: 
rlm@10: 
rlm@10: ;; Note (December 23, 2008): This library has been supplanted by the
rlm@10: ;; inclusion of "condp" in clojure.core as of Clojure SVN rev. 1180.
rlm@10: 
rlm@10: 
rlm@10: (ns 
rlm@10:   ^{:author "Stuart Sierra",
rlm@10:      :doc "This file defines a generic \"case\" macro called \"fcase\" which takes
rlm@10: the equality-testing function as an argument.  It also defines a
rlm@10: traditional \"case\" macro that tests using \"=\" and variants that
rlm@10: test for regular expressions and class membership.
rlm@10: 
rlm@10: 
rlm@10: Note (December 23, 2008): This library has been supplanted by the
rlm@10: inclusion of \"condp\" in clojure.core as of Clojure SVN rev. 1180."} 
rlm@10: 
rlm@10:   clojure.contrib.fcase
rlm@10:   (:refer-clojure :exclude (case)))
rlm@10: 
rlm@10: 
rlm@10: (defmacro fcase
rlm@10:   "Generic switch/case macro.  'fcase' is short for 'function case'.
rlm@10: 
rlm@10:   The 'compare-fn' is a fn of two arguments.
rlm@10: 
rlm@10:   The 'test-expr-clauses' are value-expression pairs without
rlm@10:   surrounding parentheses, like in Clojure's 'cond'.
rlm@10: 
rlm@10:   The 'case-value' is evaluated once and cached.  Then, 'compare-fn'
rlm@10:   is called once for each clause, with the clause's test value as its
rlm@10:   first argument and 'case-value' as its second argument.  If
rlm@10:   'compare-fn' returns logical true, the clause's expression is
rlm@10:   evaluated and returned.  If 'compare-fn' returns false/nil, we go to
rlm@10:   the next test value.
rlm@10: 
rlm@10:   If 'test-expr-clauses' contains an odd number of items, the last
rlm@10:   item is the default expression evaluated if no case-value matches.
rlm@10:   If there is no default expression and no case-value matches, fcase
rlm@10:   returns nil.
rlm@10: 
rlm@10:   See specific forms of this macro in 'case' and 're-case'.
rlm@10: 
rlm@10:   The test expressions in 'fcase' are always evaluated linearly, in
rlm@10:   order.  For a large number of case expressions it may be more
rlm@10:   efficient to use a hash lookup."
rlm@10:   [compare-fn case-value &
rlm@10:    test-expr-clauses]
rlm@10:   (let [test-val-sym (gensym "test_val")
rlm@10: 	test-fn-sym (gensym "test_fn")
rlm@10: 	cond-loop (fn this [clauses]
rlm@10: 		      (cond
rlm@10: 		       (>= (count clauses) 2)
rlm@10: 		       (list 'if (list test-fn-sym (first clauses) test-val-sym)
rlm@10: 			     (second clauses)
rlm@10: 			     (this (rest (rest clauses))))
rlm@10: 		       (= (count clauses) 1) (first clauses)))]
rlm@10:     (list 'let [test-val-sym case-value, test-fn-sym compare-fn]
rlm@10: 	  (cond-loop test-expr-clauses))))
rlm@10: 
rlm@10: (defmacro case
rlm@10:   "Like cond, but test-value is compared against the value of each
rlm@10:   test expression with =.  If they are equal, executes the \"body\"
rlm@10:   expression.  Optional last expression is executed if none of the
rlm@10:   test expressions match."
rlm@10:   [test-value & clauses]
rlm@10:   `(fcase = ~test-value ~@clauses))
rlm@10: 
rlm@10: (defmacro re-case
rlm@10:   "Like case, but the test expressions are regular expressions, tested
rlm@10:   with re-find."
rlm@10:   [test-value & clauses]
rlm@10:   `(fcase re-find ~test-value ~@clauses))
rlm@10: 
rlm@10: (defmacro instance-case
rlm@10:   "Like case, but the test expressions are Java class names, tested with
rlm@10:   'instance?'."
rlm@10:   [test-value & clauses]
rlm@10:   `(fcase instance? ~test-value ~@clauses))
rlm@10: 
rlm@10: (defn in-case-test [test-seq case-value]
rlm@10:   (some (fn [item] (= item case-value))
rlm@10:         test-seq))
rlm@10: 
rlm@10: (defmacro in-case
rlm@10:   "Like case, but test expressions are sequences.  The test expression
rlm@10:   is true if any item in the sequence is equal (tested with '=') to
rlm@10:   the test value."
rlm@10:   [test-value & clauses]
rlm@10:   `(fcase in-case-test ~test-value ~@clauses))