;;; -*-  Mode: Lisp -*- 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                              
;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>		 
;;;  		       								 
;;;  This program is free software; you can redistribute it and/or modify	 
;;;  it under the terms of the GNU General Public License as published by	 
;;;  the Free Software Foundation; either version 2 of the License, or		 
;;;  (at your option) any later version.					 
;;; 		       								 
;;;  This program is distributed in the hope that it will be useful,		 
;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of		 
;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the		 
;;;  GNU General Public License for more details.				 
;;; 		       								 
;;;  You should have received a copy of the GNU General Public License		 
;;;  along with this program; if not, write to the Free Software 		 
;;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	 
;;;										 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defpackage "RING"
  (:use :cl :copy)
  (:export "RING"
	   "FIELD"
	   "ADD-TO"
	   "SUBTRACT-FROM"
	   "MULTIPLY-BY"
	   "DIVIDE-BY"
	   "ADD"
	   "SUBTRACT"
	   "MULTIPLY"
	   "DIVIDE"
	   "UNARY-MINUS"
	   "UNARY-INVERSE"
	   "UNIVERSAL-GCD"
	   "UNIVERSAL-EZGCD"
	   "UNIVERSAL-EQUALP"
	   "UNIVERSAL-ZEROP"
	   "MAKE-ZERO-FOR"
	   "MAKE-UNIT-FOR"
	   "->SEXP"
	   "RATIONAL-FIELD"
	   "RATIONAL-FIELD-VALUE"
	   "MAKE-ZERO-FOR"
	   "MAKE-UNIT-FOR"
	   "INTEGER-RING"
	   "INTEGER-RING-VALUE"
	   )
  (:documentation "Defines an abstract ring class and ring operations.")
  )

(in-package "RING")

(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))

(defclass ring () () (:documentation "An abstract ring."))
(defclass field (ring) () (:documentation "An abstract ring."))
	   
(defgeneric multiply-by (self other)
  (:documentation "Multiply SELF by OTHER."))

(defgeneric divide-by (self other)
  (:documentation "Divide SELF by OTHER."))

(defgeneric add-to (self other)
  (:documentation "Add OTHER to SELF."))

(defgeneric subtract-from (self other)
  (:documentation "Subtract OTHER from SELF."))

(defgeneric unary-minus (self)
  (:documentation "Changes SELF to its negative."))

(defgeneric unary-inverse (self)
  (:documentation "Changes SELF to the unary inverse of SELF."))

(defgeneric universal-gcd (object other)
  (:documentation "Returns GCD(OBJECT, OTHER)"))

(defgeneric universal-ezgcd (x y)
  (:documentation "Solves the diophantine system: X=C*X1, Y=C*X2,
C=GCD(X,Y).  It returns three values: C, X1 and Y1. The result may be obtained by
the Euclidean algorithm.")
  (:method ((x t) (y t) &aux (c (universal-gcd x y)))
    (values c (divide x c) (divide y c))))

(defgeneric universal-equalp (self other)
  (:documentation "Return T if objects SELF and OTHER are equal, NIL otherwise.")
  (:method ((object1 null) (object2 null)) t)
  (:method ((object1 cons) (object2 cons)) (every #'universal-equalp object1 object2))
  (:method ((self number) (other number)) (= self other)))

(defgeneric universal-zerop (self)
  (:documentation "Return T if SELF is a zero in the ring it belongs to."))

(defgeneric ->sexp (self &optional vars)
  (:documentation "Convert SELF to an S-expression."))

(defgeneric make-zero-for (self)
  (:documentation "Create a zero in the ring of SELF. A fresh instance
should be returned upon every call."))

(defgeneric make-unit-for (self)
  (:documentation "Create a unit in the ring of SELF. A fresh instance
should be returned upon every call."))

(defgeneric add (summand &rest more-summands)
  (:documentation "Successively adds to SUMMAND the elements of
MORE-SUMMANDS, using ADD-TO. The first SUMMAND must not be
destructively modified.  Instead, a copy of factor should be made and
returned as the value of this function.")
  (:method ((summand t) &rest more-summands)
    "The default implementation of ADD."
    (reduce #'add-to more-summands :initial-value (copy-instance summand))))

(defgeneric subtract (minuend  &rest subtrahends)
  (:documentation "Successively subtracts SUBTRAHENDS from MINUEND,
using SUBTRACT-FROM. MINUEND. must not be destructively modified.
Instead, a copy of factor should be made and returned as the value of
this function.")
  (:method ((minuend t) &rest subtrahends)
    "The default implementation of SUBTRACT."
    (cond ((endp subtrahends) (unary-minus (copy-instance minuend)))
	  (t (reduce #'subtract-from subtrahends :initial-value (copy-instance minuend))))))

(defgeneric multiply (factor &rest more-factors)
  (:documentation "Successively multiplies factor FACTOR by the remaining arguments
MORE-FACTORS, using MULTIPLY-BY to multiply two factors. FACTOR must not be destructively modified.
Instead, a copy of factor should be made and returned as the value of this function.")
  (:method ((factor t) &rest more-factors)
    "The default implementation of MULTIPLY."
    (reduce #'multiply-by more-factors :initial-value (copy-instance factor))))

(defgeneric divide (numerator &rest denominators)
  (:documentation "Successively divides NUMERATOR by elements of DENOMINATORS. The operation
should not modify the NUMERATOR. Instead, a copy of factor should be made and returned as the value of this function.")
  (:method ((numerator t) &rest denominators)
    "The default implementation of DIVIDE."
    (cond ((endp denominators)
	   (unary-inverse (copy-instance numerator)))
	  (t (reduce #'divide-by denominators :initial-value (copy-instance numerator))))))