;; 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))