1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/generic/arithmetic.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,201 @@
     1.4 +;; Generic interfaces for arithmetic operations
     1.5 +
     1.6 +;; by Konrad Hinsen
     1.7 +;; last updated May 5, 2009
     1.8 +
     1.9 +;; Copyright (c) Konrad Hinsen, 2009. 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 +(ns
    1.18 +  ^{:author "Konrad Hinsen"
    1.19 +     :doc "Generic arithmetic interface
    1.20 +           This library defines generic versions of + - * / as multimethods
    1.21 +           that can be defined for any type. The minimal required 
    1.22 +           implementations for a type are binary + and * plus unary - and /.
    1.23 +           Everything else is derived from these automatically. Explicit
    1.24 +           binary definitions for - and / can be provided for
    1.25 +           efficiency reasons."}
    1.26 +  clojure.contrib.generic.arithmetic
    1.27 +  (:use [clojure.contrib.generic
    1.28 +	 :only (root-type nulary-type nary-type nary-dispatch)]
    1.29 +	[clojure.contrib.types :only (defadt)])
    1.30 +  (:refer-clojure :exclude [+ - * /]))
    1.31 +
    1.32 +;
    1.33 +; Universal zero and one values
    1.34 +;
    1.35 +(defadt ::zero zero)
    1.36 +(defadt ::one one)
    1.37 +
    1.38 +(derive ::zero root-type)
    1.39 +(derive ::one root-type)
    1.40 +
    1.41 +;
    1.42 +; Addition
    1.43 +;
    1.44 +; The minimal implementation is for binary my-type. It is possible
    1.45 +; in principle to implement [::unary my-type] as well, though this
    1.46 +; doesn't make any sense.
    1.47 +;
    1.48 +(defmulti + 
    1.49 +  "Return the sum of all arguments. The minimal implementation for type
    1.50 +   ::my-type is the binary form with dispatch value [::my-type ::my-type]."
    1.51 +  {:arglists '([x] [x y] [x y & more])}
    1.52 +  nary-dispatch)
    1.53 +
    1.54 +(defmethod + nulary-type
    1.55 +  []
    1.56 +  zero)
    1.57 +
    1.58 +(defmethod + root-type
    1.59 +  [x] x)
    1.60 +
    1.61 +(defmethod + [root-type ::zero]
    1.62 +  [x y] x)
    1.63 +
    1.64 +(defmethod + [::zero root-type]
    1.65 +  [x y] y)
    1.66 +
    1.67 +(defmethod + nary-type
    1.68 +  [x y & more]
    1.69 +  (if more
    1.70 +    (recur (+ x y) (first more) (next more))
    1.71 +    (+ x y)))
    1.72 +
    1.73 +;
    1.74 +; Subtraction
    1.75 +;
    1.76 +; The minimal implementation is for unary my-type. A default binary
    1.77 +; implementation is provided as (+ x (- y)), but it is possible to
    1.78 +; implement unary my-type explicitly for efficiency reasons.
    1.79 +;
    1.80 +(defmulti -
    1.81 +  "Return the difference of the first argument and the sum of all other
    1.82 +   arguments. The minimal implementation for type ::my-type is the binary
    1.83 +   form with dispatch value [::my-type ::my-type]."
    1.84 +  {:arglists '([x] [x y] [x y & more])}
    1.85 +  nary-dispatch)
    1.86 +
    1.87 +(defmethod - nulary-type
    1.88 +  []
    1.89 +  (throw (java.lang.IllegalArgumentException.
    1.90 +	  "Wrong number of arguments passed")))
    1.91 +
    1.92 +(defmethod - [root-type ::zero]
    1.93 +  [x y] x)
    1.94 +
    1.95 +(defmethod - [::zero root-type]
    1.96 +  [x y] (- y))
    1.97 +
    1.98 +(defmethod - [root-type root-type]
    1.99 +  [x y] (+ x (- y)))
   1.100 +
   1.101 +(defmethod - nary-type
   1.102 +  [x y & more]
   1.103 +  (if more
   1.104 +    (recur (- x y) (first more) (next more))
   1.105 +    (- x y)))
   1.106 +
   1.107 +;
   1.108 +; Multiplication
   1.109 +;
   1.110 +; The minimal implementation is for binary [my-type my-type]. It is possible
   1.111 +; in principle to implement unary my-type as well, though this
   1.112 +; doesn't make any sense.
   1.113 +;
   1.114 +(defmulti *
   1.115 +  "Return the product of all arguments. The minimal implementation for type
   1.116 +   ::my-type is the binary form with dispatch value [::my-type ::my-type]."
   1.117 +  {:arglists '([x] [x y] [x y & more])}
   1.118 +  nary-dispatch)
   1.119 +
   1.120 +(defmethod * nulary-type
   1.121 +  []
   1.122 +  one)
   1.123 +
   1.124 +(defmethod * root-type
   1.125 +  [x] x)
   1.126 +
   1.127 +(defmethod * [root-type ::one]
   1.128 +  [x y] x)
   1.129 +
   1.130 +(defmethod * [::one root-type]
   1.131 +  [x y] y)
   1.132 +
   1.133 +(defmethod * nary-type
   1.134 +  [x y & more]
   1.135 +  (if more
   1.136 +    (recur (* x y) (first more) (next more))
   1.137 +    (* x y)))
   1.138 +
   1.139 +;
   1.140 +; Division
   1.141 +;
   1.142 +; The minimal implementation is for unary my-type. A default binary
   1.143 +; implementation is provided as (* x (/ y)), but it is possible to
   1.144 +; implement binary [my-type my-type] explicitly for efficiency reasons.
   1.145 +;
   1.146 +(defmulti /
   1.147 +  "Return the quotient of the first argument and the product of all other
   1.148 +   arguments. The minimal implementation for type ::my-type is the binary
   1.149 +   form with dispatch value [::my-type ::my-type]."
   1.150 +  {:arglists '([x] [x y] [x y & more])}
   1.151 +  nary-dispatch)
   1.152 +
   1.153 +(defmethod / nulary-type
   1.154 +  []
   1.155 +  (throw (java.lang.IllegalArgumentException.
   1.156 +	  "Wrong number of arguments passed")))
   1.157 +
   1.158 +(defmethod / [root-type ::one]
   1.159 +  [x y] x)
   1.160 +
   1.161 +(defmethod / [::one root-type]
   1.162 +  [x y] (/ y))
   1.163 +
   1.164 +(defmethod / [root-type root-type]
   1.165 +  [x y] (* x (/ y)))
   1.166 +
   1.167 +(defmethod / nary-type
   1.168 +  [x y & more]
   1.169 +  (if more
   1.170 +    (recur (/ x y) (first more) (next more))
   1.171 +    (/ x y)))
   1.172 +
   1.173 +;
   1.174 +; Macros to permit access to the / multimethod via namespace qualification
   1.175 +;
   1.176 +(defmacro defmethod*
   1.177 +  "Define a method implementation for the multimethod name in namespace ns.
   1.178 +   Required for implementing the division function from another namespace."
   1.179 +  [ns name & args]
   1.180 +  (let [qsym (symbol (str ns) (str name))]
   1.181 +    `(defmethod ~qsym ~@args)))
   1.182 +
   1.183 +(defmacro qsym
   1.184 +  "Create the qualified symbol corresponding to sym in namespace ns.
   1.185 +   Required to access the division function from another namespace,
   1.186 +   e.g. as (qsym clojure.contrib.generic.arithmetic /)."
   1.187 +  [ns sym]
   1.188 +  (symbol (str ns) (str sym)))
   1.189 +
   1.190 +;
   1.191 +; Minimal implementations for java.lang.Number
   1.192 +;
   1.193 +(defmethod + [java.lang.Number java.lang.Number]
   1.194 +  [x y] (clojure.core/+ x y))
   1.195 +
   1.196 +(defmethod - java.lang.Number
   1.197 +  [x] (clojure.core/- x))
   1.198 +
   1.199 +(defmethod * [java.lang.Number java.lang.Number]
   1.200 +  [x y] (clojure.core/* x y))
   1.201 +
   1.202 +(defmethod / java.lang.Number
   1.203 +  [x] (clojure.core// x))
   1.204 +