Mercurial > lasercutter

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