Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
202 lines (165 sloc) 5.23 KB
;; Generic interfaces for arithmetic operations
;; by Konrad Hinsen
;; last updated May 5, 2009
;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use
;; and distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution. By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license. You must not
;; remove this notice, or any other, from this software.
(ns
#^{:author "Konrad Hinsen"
:doc "Generic arithmetic interface
This library defines generic versions of + - * / as multimethods
that can be defined for any type. The minimal required
implementations for a type are binary + and * plus unary - and /.
Everything else is derived from these automatically. Explicit
binary definitions for - and / can be provided for
efficiency reasons."}
clojure.contrib.generic.arithmetic
(:use [clojure.contrib.generic
:only (root-type nulary-type nary-type nary-dispatch)]
[clojure.contrib.types :only (defadt)])
(:refer-clojure :exclude [+ - * /]))
;
; Universal zero and one values
;
(defadt ::zero zero)
(defadt ::one one)
(derive ::zero root-type)
(derive ::one root-type)
;
; Addition
;
; The minimal implementation is for binary my-type. It is possible
; in principle to implement [::unary my-type] as well, though this
; doesn't make any sense.
;
(defmulti +
"Return the sum of all arguments. The minimal implementation for type
::my-type is the binary form with dispatch value [::my-type ::my-type]."
{:arglists '([x] [x y] [x y & more])}
nary-dispatch)
(defmethod + nulary-type
[]
zero)
(defmethod + root-type
[x] x)
(defmethod + [root-type ::zero]
[x y] x)
(defmethod + [::zero root-type]
[x y] y)
(defmethod + nary-type
[x y & more]
(if more
(recur (+ x y) (first more) (next more))
(+ x y)))
;
; Subtraction
;
; The minimal implementation is for unary my-type. A default binary
; implementation is provided as (+ x (- y)), but it is possible to
; implement unary my-type explicitly for efficiency reasons.
;
(defmulti -
"Return the difference of the first argument and the sum of all other
arguments. The minimal implementation for type ::my-type is the binary
form with dispatch value [::my-type ::my-type]."
{:arglists '([x] [x y] [x y & more])}
nary-dispatch)
(defmethod - nulary-type
[]
(throw (java.lang.IllegalArgumentException.
"Wrong number of arguments passed")))
(defmethod - [root-type ::zero]
[x y] x)
(defmethod - [::zero root-type]
[x y] (- y))
(defmethod - [root-type root-type]
[x y] (+ x (- y)))
(defmethod - nary-type
[x y & more]
(if more
(recur (- x y) (first more) (next more))
(- x y)))
;
; Multiplication
;
; The minimal implementation is for binary [my-type my-type]. It is possible
; in principle to implement unary my-type as well, though this
; doesn't make any sense.
;
(defmulti *
"Return the product of all arguments. The minimal implementation for type
::my-type is the binary form with dispatch value [::my-type ::my-type]."
{:arglists '([x] [x y] [x y & more])}
nary-dispatch)
(defmethod * nulary-type
[]
one)
(defmethod * root-type
[x] x)
(defmethod * [root-type ::one]
[x y] x)
(defmethod * [::one root-type]
[x y] y)
(defmethod * nary-type
[x y & more]
(if more
(recur (* x y) (first more) (next more))
(* x y)))
;
; Division
;
; The minimal implementation is for unary my-type. A default binary
; implementation is provided as (* x (/ y)), but it is possible to
; implement binary [my-type my-type] explicitly for efficiency reasons.
;
(defmulti /
"Return the quotient of the first argument and the product of all other
arguments. The minimal implementation for type ::my-type is the binary
form with dispatch value [::my-type ::my-type]."
{:arglists '([x] [x y] [x y & more])}
nary-dispatch)
(defmethod / nulary-type
[]
(throw (java.lang.IllegalArgumentException.
"Wrong number of arguments passed")))
(defmethod / [root-type ::one]
[x y] x)
(defmethod / [::one root-type]
[x y] (/ y))
(defmethod / [root-type root-type]
[x y] (* x (/ y)))
(defmethod / nary-type
[x y & more]
(if more
(recur (/ x y) (first more) (next more))
(/ x y)))
;
; Macros to permit access to the / multimethod via namespace qualification
;
(defmacro defmethod*
"Define a method implementation for the multimethod name in namespace ns.
Required for implementing the division function from another namespace."
[ns name & args]
(let [qsym (symbol (str ns) (str name))]
`(defmethod ~qsym ~@args)))
(defmacro qsym
"Create the qualified symbol corresponding to sym in namespace ns.
Required to access the division function from another namespace,
e.g. as (qsym clojure.contrib.generic.arithmetic /)."
[ns sym]
(symbol (str ns) (str sym)))
;
; Minimal implementations for java.lang.Number
;
(defmethod + [java.lang.Number java.lang.Number]
[x y] (clojure.core/+ x y))
(defmethod - java.lang.Number
[x] (clojure.core/- x))
(defmethod * [java.lang.Number java.lang.Number]
[x y] (clojure.core/* x y))
(defmethod / java.lang.Number
[x] (clojure.core// x))
Something went wrong with that request. Please try again.