Mercurial > lasercutter

annotate src/clojure/contrib/generic/arithmetic.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ;; Generic interfaces for arithmetic operations
rlm@10 2
rlm@10 3 ;; by Konrad Hinsen
rlm@10 4 ;; last updated May 5, 2009
rlm@10 5
rlm@10 6 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use
rlm@10 7 ;; and distribution terms for this software are covered by the Eclipse
rlm@10 8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10 9 ;; which can be found in the file epl-v10.html at the root of this
rlm@10 10 ;; distribution. By using this software in any fashion, you are
rlm@10 11 ;; agreeing to be bound by the terms of this license. You must not
rlm@10 12 ;; remove this notice, or any other, from this software.
rlm@10 13
rlm@10 14 (ns
rlm@10 15 ^{:author "Konrad Hinsen"
rlm@10 16 :doc "Generic arithmetic interface
rlm@10 17 This library defines generic versions of + - * / as multimethods
rlm@10 18 that can be defined for any type. The minimal required
rlm@10 19 implementations for a type are binary + and * plus unary - and /.
rlm@10 20 Everything else is derived from these automatically. Explicit
rlm@10 21 binary definitions for - and / can be provided for
rlm@10 22 efficiency reasons."}
rlm@10 23 clojure.contrib.generic.arithmetic
rlm@10 24 (:use [clojure.contrib.generic
rlm@10 25 :only (root-type nulary-type nary-type nary-dispatch)]
rlm@10 26 [clojure.contrib.types :only (defadt)])
rlm@10 27 (:refer-clojure :exclude [+ - * /]))
rlm@10 28
rlm@10 29 ;
rlm@10 30 ; Universal zero and one values
rlm@10 31 ;
rlm@10 32 (defadt ::zero zero)
rlm@10 33 (defadt ::one one)
rlm@10 34
rlm@10 35 (derive ::zero root-type)
rlm@10 36 (derive ::one root-type)
rlm@10 37
rlm@10 38 ;
rlm@10 39 ; Addition
rlm@10 40 ;
rlm@10 41 ; The minimal implementation is for binary my-type. It is possible
rlm@10 42 ; in principle to implement [::unary my-type] as well, though this
rlm@10 43 ; doesn't make any sense.
rlm@10 44 ;
rlm@10 45 (defmulti +
rlm@10 46 "Return the sum of all arguments. The minimal implementation for type
rlm@10 47 ::my-type is the binary form with dispatch value [::my-type ::my-type]."
rlm@10 48 {:arglists '([x] [x y] [x y & more])}
rlm@10 49 nary-dispatch)
rlm@10 50
rlm@10 51 (defmethod + nulary-type
rlm@10 52 []
rlm@10 53 zero)
rlm@10 54
rlm@10 55 (defmethod + root-type
rlm@10 56 [x] x)
rlm@10 57
rlm@10 58 (defmethod + [root-type ::zero]
rlm@10 59 [x y] x)
rlm@10 60
rlm@10 61 (defmethod + [::zero root-type]
rlm@10 62 [x y] y)
rlm@10 63
rlm@10 64 (defmethod + nary-type
rlm@10 65 [x y & more]
rlm@10 66 (if more
rlm@10 67 (recur (+ x y) (first more) (next more))
rlm@10 68 (+ x y)))
rlm@10 69
rlm@10 70 ;
rlm@10 71 ; Subtraction
rlm@10 72 ;
rlm@10 73 ; The minimal implementation is for unary my-type. A default binary
rlm@10 74 ; implementation is provided as (+ x (- y)), but it is possible to
rlm@10 75 ; implement unary my-type explicitly for efficiency reasons.
rlm@10 76 ;
rlm@10 77 (defmulti -
rlm@10 78 "Return the difference of the first argument and the sum of all other
rlm@10 79 arguments. The minimal implementation for type ::my-type is the binary
rlm@10 80 form with dispatch value [::my-type ::my-type]."
rlm@10 81 {:arglists '([x] [x y] [x y & more])}
rlm@10 82 nary-dispatch)
rlm@10 83
rlm@10 84 (defmethod - nulary-type
rlm@10 85 []
rlm@10 86 (throw (java.lang.IllegalArgumentException.
rlm@10 87 "Wrong number of arguments passed")))
rlm@10 88
rlm@10 89 (defmethod - [root-type ::zero]
rlm@10 90 [x y] x)
rlm@10 91
rlm@10 92 (defmethod - [::zero root-type]
rlm@10 93 [x y] (- y))
rlm@10 94
rlm@10 95 (defmethod - [root-type root-type]
rlm@10 96 [x y] (+ x (- y)))
rlm@10 97
rlm@10 98 (defmethod - nary-type
rlm@10 99 [x y & more]
rlm@10 100 (if more
rlm@10 101 (recur (- x y) (first more) (next more))
rlm@10 102 (- x y)))
rlm@10 103
rlm@10 104 ;
rlm@10 105 ; Multiplication
rlm@10 106 ;
rlm@10 107 ; The minimal implementation is for binary [my-type my-type]. It is possible
rlm@10 108 ; in principle to implement unary my-type as well, though this
rlm@10 109 ; doesn't make any sense.
rlm@10 110 ;
rlm@10 111 (defmulti *
rlm@10 112 "Return the product of all arguments. The minimal implementation for type
rlm@10 113 ::my-type is the binary form with dispatch value [::my-type ::my-type]."
rlm@10 114 {:arglists '([x] [x y] [x y & more])}
rlm@10 115 nary-dispatch)
rlm@10 116
rlm@10 117 (defmethod * nulary-type
rlm@10 118 []
rlm@10 119 one)
rlm@10 120
rlm@10 121 (defmethod * root-type
rlm@10 122 [x] x)
rlm@10 123
rlm@10 124 (defmethod * [root-type ::one]
rlm@10 125 [x y] x)
rlm@10 126
rlm@10 127 (defmethod * [::one root-type]
rlm@10 128 [x y] y)
rlm@10 129
rlm@10 130 (defmethod * nary-type
rlm@10 131 [x y & more]
rlm@10 132 (if more
rlm@10 133 (recur (* x y) (first more) (next more))
rlm@10 134 (* x y)))
rlm@10 135
rlm@10 136 ;
rlm@10 137 ; Division
rlm@10 138 ;
rlm@10 139 ; The minimal implementation is for unary my-type. A default binary
rlm@10 140 ; implementation is provided as (* x (/ y)), but it is possible to
rlm@10 141 ; implement binary [my-type my-type] explicitly for efficiency reasons.
rlm@10 142 ;
rlm@10 143 (defmulti /
rlm@10 144 "Return the quotient of the first argument and the product of all other
rlm@10 145 arguments. The minimal implementation for type ::my-type is the binary
rlm@10 146 form with dispatch value [::my-type ::my-type]."
rlm@10 147 {:arglists '([x] [x y] [x y & more])}
rlm@10 148 nary-dispatch)
rlm@10 149
rlm@10 150 (defmethod / nulary-type
rlm@10 151 []
rlm@10 152 (throw (java.lang.IllegalArgumentException.
rlm@10 153 "Wrong number of arguments passed")))
rlm@10 154
rlm@10 155 (defmethod / [root-type ::one]
rlm@10 156 [x y] x)
rlm@10 157
rlm@10 158 (defmethod / [::one root-type]
rlm@10 159 [x y] (/ y))
rlm@10 160
rlm@10 161 (defmethod / [root-type root-type]
rlm@10 162 [x y] (* x (/ y)))
rlm@10 163
rlm@10 164 (defmethod / nary-type
rlm@10 165 [x y & more]
rlm@10 166 (if more
rlm@10 167 (recur (/ x y) (first more) (next more))
rlm@10 168 (/ x y)))
rlm@10 169
rlm@10 170 ;
rlm@10 171 ; Macros to permit access to the / multimethod via namespace qualification
rlm@10 172 ;
rlm@10 173 (defmacro defmethod*
rlm@10 174 "Define a method implementation for the multimethod name in namespace ns.
rlm@10 175 Required for implementing the division function from another namespace."
rlm@10 176 [ns name & args]
rlm@10 177 (let [qsym (symbol (str ns) (str name))]
rlm@10 178 `(defmethod ~qsym ~@args)))
rlm@10 179
rlm@10 180 (defmacro qsym
rlm@10 181 "Create the qualified symbol corresponding to sym in namespace ns.
rlm@10 182 Required to access the division function from another namespace,
rlm@10 183 e.g. as (qsym clojure.contrib.generic.arithmetic /)."
rlm@10 184 [ns sym]
rlm@10 185 (symbol (str ns) (str sym)))
rlm@10 186
rlm@10 187 ;
rlm@10 188 ; Minimal implementations for java.lang.Number
rlm@10 189 ;
rlm@10 190 (defmethod + [java.lang.Number java.lang.Number]
rlm@10 191 [x y] (clojure.core/+ x y))
rlm@10 192
rlm@10 193 (defmethod - java.lang.Number
rlm@10 194 [x] (clojure.core/- x))
rlm@10 195
rlm@10 196 (defmethod * [java.lang.Number java.lang.Number]
rlm@10 197 [x y] (clojure.core/* x y))
rlm@10 198
rlm@10 199 (defmethod / java.lang.Number
rlm@10 200 [x] (clojure.core// x))
rlm@10 201