1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/fcase.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,108 @@
     1.4 +;;; fcase.clj -- simple variants of "case" for Clojure
     1.5 +
     1.6 +;; by Stuart Sierra, http://stuartsierra.com/
     1.7 +;; April 7, 2008
     1.8 +
     1.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
    1.10 +;; and distribution terms for this software are covered by the Eclipse
    1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;; which can be found in the file epl-v10.html at the root of this
    1.13 +;; distribution.  By using this software in any fashion, you are
    1.14 +;; agreeing to be bound by the terms of this license.  You must not
    1.15 +;; remove this notice, or any other, from this software.
    1.16 +
    1.17 +
    1.18 +;; This file defines a generic "case" macro called "fcase" which takes
    1.19 +;; the equality-testing function as an argument.  It also defines a
    1.20 +;; traditional "case" macro that tests using "=" and variants that
    1.21 +;; test for regular expressions and class membership.
    1.22 +
    1.23 +
    1.24 +;; Note (December 23, 2008): This library has been supplanted by the
    1.25 +;; inclusion of "condp" in clojure.core as of Clojure SVN rev. 1180.
    1.26 +
    1.27 +
    1.28 +(ns 
    1.29 +  ^{:author "Stuart Sierra",
    1.30 +     :doc "This file defines a generic \"case\" macro called \"fcase\" which takes
    1.31 +the equality-testing function as an argument.  It also defines a
    1.32 +traditional \"case\" macro that tests using \"=\" and variants that
    1.33 +test for regular expressions and class membership.
    1.34 +
    1.35 +
    1.36 +Note (December 23, 2008): This library has been supplanted by the
    1.37 +inclusion of \"condp\" in clojure.core as of Clojure SVN rev. 1180."} 
    1.38 +
    1.39 +  clojure.contrib.fcase
    1.40 +  (:refer-clojure :exclude (case)))
    1.41 +
    1.42 +
    1.43 +(defmacro fcase
    1.44 +  "Generic switch/case macro.  'fcase' is short for 'function case'.
    1.45 +
    1.46 +  The 'compare-fn' is a fn of two arguments.
    1.47 +
    1.48 +  The 'test-expr-clauses' are value-expression pairs without
    1.49 +  surrounding parentheses, like in Clojure's 'cond'.
    1.50 +
    1.51 +  The 'case-value' is evaluated once and cached.  Then, 'compare-fn'
    1.52 +  is called once for each clause, with the clause's test value as its
    1.53 +  first argument and 'case-value' as its second argument.  If
    1.54 +  'compare-fn' returns logical true, the clause's expression is
    1.55 +  evaluated and returned.  If 'compare-fn' returns false/nil, we go to
    1.56 +  the next test value.
    1.57 +
    1.58 +  If 'test-expr-clauses' contains an odd number of items, the last
    1.59 +  item is the default expression evaluated if no case-value matches.
    1.60 +  If there is no default expression and no case-value matches, fcase
    1.61 +  returns nil.
    1.62 +
    1.63 +  See specific forms of this macro in 'case' and 're-case'.
    1.64 +
    1.65 +  The test expressions in 'fcase' are always evaluated linearly, in
    1.66 +  order.  For a large number of case expressions it may be more
    1.67 +  efficient to use a hash lookup."
    1.68 +  [compare-fn case-value &
    1.69 +   test-expr-clauses]
    1.70 +  (let [test-val-sym (gensym "test_val")
    1.71 +	test-fn-sym (gensym "test_fn")
    1.72 +	cond-loop (fn this [clauses]
    1.73 +		      (cond
    1.74 +		       (>= (count clauses) 2)
    1.75 +		       (list 'if (list test-fn-sym (first clauses) test-val-sym)
    1.76 +			     (second clauses)
    1.77 +			     (this (rest (rest clauses))))
    1.78 +		       (= (count clauses) 1) (first clauses)))]
    1.79 +    (list 'let [test-val-sym case-value, test-fn-sym compare-fn]
    1.80 +	  (cond-loop test-expr-clauses))))
    1.81 +
    1.82 +(defmacro case
    1.83 +  "Like cond, but test-value is compared against the value of each
    1.84 +  test expression with =.  If they are equal, executes the \"body\"
    1.85 +  expression.  Optional last expression is executed if none of the
    1.86 +  test expressions match."
    1.87 +  [test-value & clauses]
    1.88 +  `(fcase = ~test-value ~@clauses))
    1.89 +
    1.90 +(defmacro re-case
    1.91 +  "Like case, but the test expressions are regular expressions, tested
    1.92 +  with re-find."
    1.93 +  [test-value & clauses]
    1.94 +  `(fcase re-find ~test-value ~@clauses))
    1.95 +
    1.96 +(defmacro instance-case
    1.97 +  "Like case, but the test expressions are Java class names, tested with
    1.98 +  'instance?'."
    1.99 +  [test-value & clauses]
   1.100 +  `(fcase instance? ~test-value ~@clauses))
   1.101 +
   1.102 +(defn in-case-test [test-seq case-value]
   1.103 +  (some (fn [item] (= item case-value))
   1.104 +        test-seq))
   1.105 +
   1.106 +(defmacro in-case
   1.107 +  "Like case, but test expressions are sequences.  The test expression
   1.108 +  is true if any item in the sequence is equal (tested with '=') to
   1.109 +  the test value."
   1.110 +  [test-value & clauses]
   1.111 +  `(fcase in-case-test ~test-value ~@clauses))