;;; -*-  mode: lisp; package: maxima; syntax: common-lisp; base: 10 -*- 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                              
;;;  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.	 
;;;										 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; coefficient ring operations
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; these are all operations that are performed on the coefficients by
;; the package, and thus the coefficient ring can be changed by merely
;; redefining these operations.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defpackage "RING"
  (:use :cl)
  (:export "R-PARSE"
	   "R-UNIT-FOR"
	   "R-ZEROP"
	   "R+"
	   "R-"
	   "R*"
	   "R+"
	   "R/"
	   "R-EXPT"
	   "R-LCM"
	   "R-EZGCD"
	   "R-GCD"
	   "R-TOTAL-DEGREE"
	   "R-DIMENSION"
	   "R-EXPONENTS"
	   "R-COEFF"
	   "R-SUGAR"
	   "R-DIVIDES-P"   
	   "R-DIVIDES-LCM-P"
	   "R-LCM-DIVIDES-LCM-P"
	   "R-LCM-EQUAL-LCM-P"
	   "R-REL-PRIME-P"    
	   "R-EQUALP"	       
	   "R-ELT"
	   "R->LIST"
	   "R-DIVISIBLE-BY-P"	
	   "R-REL-PRIME-P"	
	   "R-DEPENDS-P"	
	   "R-TENSOR-PRODUCT"
	   "R-CONTRACT"      
	   "R-LENGTH"
	   "MULTIPLY-BY"
	   "ADD-TO"
	   "SUBTRACT-FROM"
	   "UNARY-UMINUS"
	   "SCALAR"
))

(in-package :ring)

(defclass scalar () ())

(defgeneric r-unit-for (object)
  (:method ((self number)) 1))

(defgeneric r-zerop (object)
  (:method ((self number)) (zerop self)))

(defgeneric r+ (x y)
  (:method ((x number) (y number)) (+ x y))) 

(defgeneric r- (x y)
  (:method ((x number) (y number)) (- x y))) 

(defgeneric r* (x y)
  (:method ((x number) (y number)) (* x y))) 

(defgeneric r-tensor-product (x y))

(defgeneric r/ (x y)
  (:method ((x number) (y number)) (/ x y))) 

(defgeneric r-lcm (x y)
  (:method ((x integer) (y integer)) (lcm x y))) 

(defgeneric r-expt (x y)
  (:method ((x integer) (y integer)) (expt x y))) 

(defgeneric r-ezgcd (x y)
  (:method ((x integer) (y integer)
	    &aux (c (gcd x y)))
    (values c (/ x c) (/ y c))))

(defgeneric r-gcd (x y)
  (:method ((x integer) (y integer))
    (gcd x y)))

(defgeneric r-dimension (object))
(defgeneric r-exponents (object))
(defgeneric r-coeff (object))

(defgeneric r-total-degree (object &optional start end))

(defgeneric r-divides-p (object1 object2)
  (:method ((object1 integer) (object2 integer))
    (zerop (rem object2 object1)))
  (:documentation "Returns T if OBJECT1 divides OBJECT2"))

(defgeneric r-divides-lcm-p (object1 object2 object3)
  (:documentation "Returns T if OBJECT divides LCM(OBJECT2, OBJECT3), NIL otherwise."))

(defgeneric r-lcm-divides-lcm-p (object1 object2 object3 object4)
  (:documentation "Returns T if LCM(OBJECT1,OBJECT2) divides LCM(OBJECT3,OBJECT4), NIL otherwise."))

(defgeneric r-lcm-equal-lcm-p (object1 object2 object3 object4)
  (:documentation "Returns T if object LCM(OBJECT1,OBJECT2) equals LCM(OBJECT3,OBJECT4), NIL otherwise."))

(defgeneric r-equalp (object1 object2)
  (:method ((object1 t) (object2 t)) (equalp object1 object2))
  (:documentation "Equality using deep comparison of object slots."))

(defgeneric r-elt (object index))

(defgeneric (setf r-elt) (new-value object index))

(defgeneric r-length (object))

(defgeneric r->list (object))
(defgeneric r-sugar (object))
(defgeneric r-rel-prime-p (object1 object2))
(defgeneric r-contract (object k))
(defgeneric r-divisible-by-p (object1 object2))
(defgeneric r-depends-p (object k))

(defgeneric multiply-by (self other)
  (:method (self other) (r* self other)))

(defgeneric add-to (self other)
  (:method (self other) (r+ self other)))

(defgeneric subtract-from (self other)
  (:method (self other) (r- self other)))

(defmethod unary-uminus (self))