Commit 4fb59edb authored by Marco Antoniotti's avatar Marco Antoniotti

Added doc strings and reworked some of the internals.

parent 52362756
......@@ -45,69 +45,113 @@
;;; ------------------
(defgeneric .<. (x y)
(:documentation "The dyadic 'less than' operation.")
(:method ((x real) (y real))
"The method on two real numbers calls CL:< directly."
(cl:< x y))
)
(defgeneric <. (x)
(:method ((n real)) (cl:< n))
(:documentation "The monadic 'less than' operation.
Necessary to properly implement the n-ary operators.")
(:method ((n real))
"The method on a real number calls CL:< directly."
(cl:< n))
)
(defgeneric .>. (x y)
(:documentation "The dyadic 'greater than' operation.")
(:method ((x real) (y real))
"The method on two real numbers calls CL:> directly."
(cl:> x y))
)
(defgeneric >. (x)
(:documentation "The monadic 'greater than' operation.
Necessary to properly implement the n-ary operators.")
(:method ((n real)) (cl:> n))
)
(defgeneric .=. (x y)
(:documentation "The dyadic 'equal' operation.")
(:method ((x number) (y number))
"The method on two numbers calls CL:= directly."
(cl:= x y))
)
(defgeneric =. (x)
(:method ((n number)) (cl:= n))
(:documentation "The monadic 'equal' operation.
Necessary to properly implement the n-ary operators.")
(:method ((n number))
"The method on a number calls CL:= directly."
(cl:= n))
)
(defgeneric ./=. (x y)
(:documentation "The dyadic 'different' operation.")
(:method ((x number) (y number))
"The method on two numbers calls CL:/= directly."
(cl:/= x y))
)
(defgeneric /=. (x)
(:method ((n number)) (cl:/= n))
(:documentation "The monadic 'different' operation.
Necessary to properly implement the n-ary operators.")
(:method ((n number))
"The method on a number calls CL:/= directly."
(cl:/= n))
)
(defgeneric .<=. (x y)
(:documentation "The dyadic 'less than or equal' operation.")
(:method ((x real) (y real))
"The method on two reals calls CL:<= directly."
(cl:<= x y))
)
(defgeneric <=. (x)
(:method ((n real)) (cl:<= n))
(:documentation "The monadic 'less than or equal' operation.
Necessary to properly implement the n-ary operators.")
(:method ((n real))
"The method on a real calls CL:<= directly."
(cl:<= n))
)
(defgeneric .>=. (x y)
(:documentation "The dyadic 'greater than or equal' operation.")
(:method ((x real) (y real))
"The method on two reals calls CL:>= directly."
(cl:>= x y))
)
(defgeneric >=. (x)
(:method ((n real)) (cl:>= n))
(:documentation "The monadic 'greater than or equal' operation.
Necessary to properly implement the n-ary operators.")
(:method ((n real))
"The method on a real calls CL:>= directly."
(cl:>= n))
)
......@@ -119,6 +163,17 @@
;;; result. This becomes useful for, e.g., matrix operations.
(defgeneric .+. (x y &optional r)
(:documentation "The dyadic 'plus' operation.
Sums the two objects X and Y, possibly modifying R. If R is modified than
it is returned as the result of the operation.
Arguments and Values:
X : a 'summable' object.
Y : a 'summable' object.
R : a 'summable' object.
")
(:method ((x number) (y number) &optional r)
(declare (ignore r))
(let ((r (cl:+ x y)))
......@@ -131,13 +186,48 @@
(defgeneric +. (x &optional r)
(:documentation "The monadic 'plus' operation.
Sums the object X, possibly modifying R. If R is modified than
it is returned as the result of the operation.
Arguments and Values:
X : a 'summable' object.
R : a 'summable' object.
Notes:
This generic function is necessary to properly implement the n-ary
operators.
")
(:method ((x number) &optional r)
(declare (ignore r))
(cl:+ x))
(:method ((x float) &optional r)
(declare (ignore r))
(let ((r (cl:+ x)))
(if (and (is-nan r) *error-on-nan-returning-operations*)
(error 'floating-point-invalid-operation
:operation '+.
:operands (list x))
r)))
)
(defgeneric .*. (x y &optional r)
(:documentation "The dyadic 'times' operation.
Multiplies the two objects X and Y, possibly modifying R. If R is modified than
it is returned as the result of the operation.
Arguments and Values:
X : a 'multipliable' object.
Y : a 'multipliable' object.
R : a 'multipliable' object.
")
(:method ((x number) (y number) &optional r)
(declare (ignore r))
(let ((r (cl:* x y)))
......@@ -150,13 +240,48 @@
(defgeneric *. (x &optional r)
(:documentation "The monadic 'times' operation.
Multiplies the object X, possibly modifying R. If R is modified than
it is returned as the result of the operation.
Arguments and Values:
X : a 'summable' object.
R : a 'summable' object.
Notes:
This generic function is necessary to properly implement the n-ary
operators.
")
(:method ((x number) &optional r)
(declare (ignore r))
(cl:* x))
(:method ((x float) &optional r)
(declare (ignore r))
(let ((r (cl:+ x)))
(if (and (is-nan r) *error-on-nan-returning-operations*)
(error 'floating-point-invalid-operation
:operation '*.
:operands (list x))
r)))
)
(defgeneric .-. (x y &optional r)
(:documentation "The dyadic 'subtraction' operation.
Subtracts the two objects X and Y, possibly modifying R. If R is modified than
it is returned as the result of the operation.
Arguments and Values:
X : a 'subtractable' object.
Y : a 'subtractable' object.
R : a 'subtractable' object.
")
(:method ((x number) (y number) &optional r)
(declare (ignore r))
(let ((r (cl:- x y)))
......@@ -169,13 +294,49 @@
(defgeneric -. (x &optional r)
(:documentation "The monadic 'subtract' operation.
Subtracts the object X, that is, computes its 'opposite', possibly
modifying R. If R is modified than it is returned as the result of
the operation.
Arguments and Values:
X : a 'subtractable' object.
R : a 'subtractable' object.
Notes:
This generic function is necessary to properly implement the n-ary
operators.
")
(:method ((x number) &optional r)
(declare (ignore r))
(cl:- x))
(:method ((x float) &optional r)
(declare (ignore r))
(let ((r (cl:+ x)))
(if (and (is-nan r) *error-on-nan-returning-operations*)
(error 'floating-point-invalid-operation
:operation '-.
:operands (list x))
r)))
)
(defgeneric ./. (x y &optional r)
(:documentation "The dyadic 'divide' operation.
Multiplies the two objects X and Y, possibly modifying R. If R is modified than
it is returned as the result of the operation.
Arguments and Values:
X : a 'divisible' object.
Y : a 'divisible' object.
R : a 'divisible' object.
")
(:method ((x number) (y number) &optional r)
(declare (ignore r))
(let ((r (cl:/ x y)))
......@@ -188,15 +349,44 @@
(defgeneric /. (x &optional r)
(:documentation "The monadic 'divide' operation.
Divides the object X, that is, computes its 'reciprocal', possibly
modifying R. If R is modified than it is returned as the result of
the operation.
Arguments and Values:
X : a 'divisible' object.
R : a 'divisible' object.
Notes:
This generic function is necessary to properly implement the n-ary
operators.
")
(:method ((x number) &optional r)
(declare (ignore r))
(cl:/ x))
(:method ((x float) &optional r)
(declare (ignore r))
(let ((r (cl:+ x)))
(if (and (is-nan r) *error-on-nan-returning-operations*)
(error 'floating-point-invalid-operation
:operation '/.
:operands (list x))
r)))
)
;;; Redefined Common Lisp N-adic operators
;;; --------------------------------------
;;; TODO: add other compiler macros and/or move all of them out to a
;;; separate file.
#+with-list-length
(defun + (&rest args)
(if (null args)
(cl:+)
......@@ -209,6 +399,22 @@
(t (.+. (first args) (apply #'+ (rest args))))
))))
(defun + (&rest args)
(if (null args)
(cl:+) ; Should never happen as a recursive call.
(cond ((null (cdr args)) ; One arg.
(+. (first args)))
((null (cddr args)) ; Two args.
(.+. (first args) (second args)))
(t ; More than two args.
(.+. (first args) (apply #'+ (rest args))))
)))
#+with-list-length
(define-compiler-macro + (&rest args)
(if (null args)
'(cl:+)
......@@ -222,113 +428,163 @@
)))
)
(define-compiler-macro + (&rest args)
(if (null args)
'(cl:+)
(cond ((null (cdr args)) ; One arg.
`(+. ,(first args)))
((null (cddr args)) ; Two args.
`(+ ,(first args) ,(second args)))
(t ; More than two args.
`(.+. ,(first args) (+ ,@(rest args))))
)))
(defun - (arg1 &rest args)
(if (null args)
(-. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(.-. arg1 (first args))
(.-. arg1 (apply #'+ args))))))
(if (null (cdr args))
(.-. arg1 (first args))
(.-. arg1 (apply #'+ args)))))
(define-compiler-macro - (arg1 &rest args)
(if (null args)
`(-. ,arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
`(.-. ,arg1 ,(first args))
`(.-. ,arg1 (+ ,@(rest args)))))
))
(if (null (cdr args))
`(.-. ,arg1 ,(first args))
`(.-. ,arg1 (+ ,@(rest args))))))
(defun * (&rest args)
(if (null args)
(cl:*)
(let ((n-args (list-length args)))
(cond ((cl:= n-args 1)
(*. (first args)))
((cl:= n-args 2)
(.*. (first args) (second args)))
(t (.*. (first args) (apply #'* (rest args))))
))))
(cond ((null (cdr args))
(*. (first args)))
((null (cddr args))
(.*. (first args) (second args)))
(t
(.*. (first args) (apply #'* (rest args))))
)))
(define-compiler-macro * (&rest args)
(if (null args)
`(cl:*)
(let ((n-args (list-length args)))
(cond ((cl:= n-args 1)
`(*. ,(first args)))
((cl:= n-args 2)
`(.*. ,(first args) ,(second args)))
(t
`(.*. ,(first args) (* ,@(rest args))))
))))
(cond ((null (cdr args))
`(*. ,(first args)))
((null (cddr args))
`(.*. ,(first args) ,(second args)))
(t
`(.*. ,(first args) (* ,@(rest args))))
)))
;;; TODO: add other compiler macros or move all of them out to a
;;; separate file.
(defun / (arg1 &rest args)
(if (null args)
(/. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(./. arg1 (first args))
(./. arg1 (apply #'* args))))))
(if (null (cdr args))
(./. arg1 (first args))
(./. arg1 (apply #'* args)))))
(define-compiler-macro / (arg1 &rest args)
(if (null args)
`(/. ,arg1)
(if (null (cdr args))
`(./. ,arg1 ,(first args))
`(./. ,arg1 (* ,@(rest args))))))
(defun = (arg1 &rest args)
(if (null args)
(=. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(.=. arg1 (first args))
(.=. arg1 (apply #'= args))))))
(if (null (cdr args))
(.=. arg1 (first args))
(.=. arg1 (apply #'= args)))))
(define-compiler-macro = (arg1 &rest args)
(if (null args)
`(=. ,arg1)
(if (null (cdr args))
`(.=. ,arg1 ,(first args))
`(.=. ,arg1 (= ,@(rest args))))))
(defun /= (arg1 &rest args)
(if (null args)
(/=. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(./=. arg1 (first args))
(./=. arg1 (apply #'/= args))))))
(if (null (cdr args))
(./=. arg1 (first args))
(./=. arg1 (apply #'/= args)))))
(define-compiler-macro /= (arg1 &rest args)
(if (null args)
`(/=. ,arg1)
(if (null (cdr args))
`(./=. ,arg1 ,(first args))
`(./=. ,arg1 (/= ,@(rest args))))))
(defun < (arg1 &rest args)
(if (null args)
(<. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(.<. arg1 (first args))
(.<. arg1 (apply #'< args))))))
(if (null (cdr args))
(.<. arg1 (first args))
(.<. arg1 (apply #'< args)))))
(define-compiler-macro < (arg1 &rest args)
(if (null args)
`(<. ,arg1)
(if (null (cdr args))
`(.<. ,arg1 ,(first args))
`(.<. ,arg1 (< ,@(rest args))))))
(defun <= (arg1 &rest args)
(if (null args)
(<=. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(.<=. arg1 (first args))
(.<=. arg1 (apply #'<= args))))))
(if (null (cdr args))
(.<=. arg1 (first args))
(.<=. arg1 (apply #'<= args)))))
(define-compiler-macro <= (arg1 &rest args)
(if (null args)
`(<=. ,arg1)
(if (null (cdr args))
`(.<=. ,arg1 ,(first args))
`(.<=. ,arg1 (< ,@(rest args))))))
(defun > (arg1 &rest args)
(if (null args)
(>. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(.>. arg1 (first args))
(.>. arg1 (apply #'> args))))))
(if (null (cdr args))
(.>. arg1 (first args))
(.>. arg1 (apply #'> args)))))
(define-compiler-macro > (arg1 &rest args)
(if (null args)
`(>. ,arg1)
(if (null (cdr args))
`(.>. ,arg1 ,(first args))
`(.>. ,arg1 (> ,@(rest args))))))
(defun >= (arg1 &rest args)
(if (null args)
(>=. arg1)
(let ((n-args (list-length args)))
(if (cl:= n-args 1)
(.>=. arg1 (first args))
(.>=. arg1 (apply #'>= args))))))
(if (null (cdr args))
(.>=. arg1 (first args))
(.>=. arg1 (apply #'>= args)))))
(define-compiler-macro >= (arg1 &rest args)
(if (null args)
`(>=. ,arg1)
(if (null (cdr args))
`(.>=. ,arg1 ,(first args))
`(.>=. ,arg1 (>= ,@(rest args))))))
;;; Other Redefined Common Lisp Operators
......@@ -361,11 +617,10 @@
(defun gcd (&rest args)
(case (list-length args)
(0 (cl:gcd))
(1 (gcd. (first args)))
(2 (.gcd. (first args) (second args)))
(t (apply #'gcd (.gcd. (first args) (second args)) (cddr args)))))
(cond ((null args) (cl:gcd))
((null (cdr args)) (gcd. (first args)))
((null (cddr args)) (.gcd. (first args) (second args)))
(t (apply #'gcd (.gcd. (first args) (second args)) (cddr args)))))
(defgeneric lcm. (n &optional r)
......@@ -383,42 +638,70 @@
(defun lcm (&rest args)
(case (list-length args)
(0 (cl:lcm))
(1 (lcm. (first args)))
(2 (.lcm. (first args) (second args)))
(t (apply #'lcm (.lcm. (first args) (second args)) (cddr args)))))
(defun increasing (x)
(declare (type sequence x))
(loop for i from 0 below (1- (length x))
for a1 = (elt x 0) then a2
for a2 = (elt x (1+ i))
always (.<. a1 a2)))
(defun decreasing (x)
(declare (type sequence x))
(loop for i from 0 below (1- (length x))
for a1 = (elt x 0) then a2
for a2 = (elt x (1+ i))
always (.>. a1 a2)))
(cond ((null args) (cl:lcm))
((null (cdr args)) (lcm. (first args)))
((null (cddr args)) (.lcm. (first args) (second args)))
(t (apply #'lcm (.lcm. (first args) (second args)) (cddr args)))))
(defgeneric increasing (x)
(:method ((x sequence))
(let ((l (length x)))
(declare (type fixnum l)) ; Should be (integer 0)
(if (cl:plusp l)
(loop for i from 0 below (1- l)
for a1 = (elt x 0) then a2
for a2 = (elt x (1+ i))
always (.<. a1 a2))
t))))
(defgeneric decreasing (x)
(:method ((x sequence))
(let ((l (length x)))
(declare (type fixnum l)) ; Should be (integer 0)
(when (cl:plusp l)
(loop for i from 0 below (1- l)
for a1 = (elt x 0) then a2
for a2 = (elt x (1+ i))
always (.>. a1 a2))))))
(defgeneric plusp (x)
(:method ((x number)) (cl:plusp x))
(:method ((x real)) (cl:plusp x))
)
(defgeneric minusp (x)
(:method ((x number)) (cl:minusp x))
(:method ((x real)) (cl:minusp x))
)
(defgeneric minimum (x))
(defgeneric minimum (x)
(:method ((x sequence))
(let ((l (length x)))
(declare (type fixnum l))
(if (cl:plusp l)
(loop with m = (elt x 0)
for i from 0 below (length x)
for ei = (elt x i)
when (< ei m) do (setq m ei)
finally (return m))
(error "Empty sequence.")))))
(defgeneric maximum (x)
(:method ((x sequence))
(let ((l (length x)))
(declare (type fixnum l))
(if (cl:plusp l)
(loop with m = (elt x 0)
for i from 0 below (length x)
for ei = (elt x i)
when (> ei m) do (setq m ei)
finally (return m))
(error "Empty sequence.")))))
(defgeneric maximum (x))
(defgeneric minmax (x))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment