Commit e56e2726 authored by Marco Antoniotti's avatar Marco Antoniotti

Removed symbolic infinities, thus greatly simplifying the code.

parent a4344be7
......@@ -26,10 +26,16 @@
;;; Constants and Variables
;;; =======================
(defconstant +negative-infinity+ '+negative-infinity+)
(defconstant +positive-infinity+ '+positive-infinity+)
;;; (defparameter *ignore-comparison-errors-p* nil)
(define-symbol-macro +positive-infinity+
(coerce long-float-positive-infinity *read-default-float-format*))
(define-symbol-macro +negative-infinity+
(coerce long-float-negative-infinity *read-default-float-format*))
;;; Generic Operations Interface
;;; ============================
......@@ -41,41 +47,11 @@
(defgeneric .<. (x y)
(:method ((x real) (y real))
(cl:< x y))
(:method ((x real) (y (eql +negative-infinity+)))
;; Fix behavior for (.<. double-float-negative-infinity +negative-infinity+)
nil)
(:method ((y (eql +negative-infinity+)) (x real))
T)
(:method ((y (eql +negative-infinity+)) (x (eql +negative-infinity+)))
;; This is per "standard mathematics" and also per IEEE 754 (more or less).
;; "infinity" is defined to be greater that any number except NaN and itself.
nil)
(:method ((y (eql +negative-infinity+)) (x (eql +positive-infinity+)))
T)
(:method ((y (eql +positive-infinity+)) (x (eql +negative-infinity+)))
nil)
(:method ((x real) (y (eql +positive-infinity+)))
T)
(:method ((y (eql +positive-infinity+)) (x real))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +positive-infinity+)))
;; See above.
nil)
)
(defgeneric <. (x)
(:method ((n real)) (cl:< n))
(:method ((n (eql +negative-infinity+))) t)
(:method ((n (eql +positive-infinity+))) t)
)
......@@ -83,205 +59,55 @@
(defgeneric .>. (x y)
(:method ((x real) (y real))
(cl:> x y))
(:method ((x real) (y (eql +negative-infinity+)))
;; Fix behavior for (.>. double-float-negative-infinity +negative-infinity+)
nil)
(:method ((y (eql +negative-infinity+)) (x real))
T)
(:method ((y (eql +negative-infinity+)) (x (eql +negative-infinity+)))
;; This is per "standard mathematics" and also per IEEE 754 (more or less).
;; "infinity" is defined to be greater that any number except NaN and itself.
nil)
(:method ((y (eql +negative-infinity+)) (x (eql +positive-infinity+)))
T)
(:method ((y (eql +positive-infinity+)) (x (eql +negative-infinity+)))
nil)
(:method ((x real) (y (eql +positive-infinity+)))
T)
(:method ((y (eql +positive-infinity+)) (x real))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +positive-infinity+)))
;; See above.
nil)
)
(defgeneric >. (x)
(:method ((n real)) (cl:> n))
(:method ((n (eql +negative-infinity+))) t)
(:method ((n (eql +positive-infinity+))) t)
)
(defgeneric .=. (x y)
(:method ((x number) (y number))
(cl:= x y))
(:method ((x real) (y (eql +negative-infinity+)))
;; Fix behavior for (.=. double-float-negative-infinity +negative-infinity+)
nil)
(:method ((y (eql +negative-infinity+)) (x real))
nil)
(:method ((y (eql +negative-infinity+)) (x (eql +negative-infinity+)))
;; This is per "standard mathematics" and also per IEEE 754 (more or less).
;; "infinity" is defined to be greater that any number except NaN and itself.
T)
(:method ((y (eql +negative-infinity+)) (x (eql +positive-infinity+)))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +negative-infinity+)))
nil)
(:method ((x real) (y (eql +positive-infinity+)))
nil)
(:method ((y (eql +positive-infinity+)) (x real))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +positive-infinity+)))
;; See above.
t)
)
(defgeneric =. (x)
(:method ((n number)) (cl:= n))
(:method ((n (eql +negative-infinity+))) t)
(:method ((n (eql +positive-infinity+))) t)
)
(defgeneric ./=. (x y)
(:method ((x number) (y number))
(cl:/= x y))
(:method ((x real) (y (eql +negative-infinity+)))
;; Fix behavior for (./=. double-float-negative-infinity +negative-infinity+)
T)
(:method ((y (eql +negative-infinity+)) (x real))
T)
(:method ((y (eql +negative-infinity+)) (x (eql +negative-infinity+)))
;; This is per "standard mathematics" and also per IEEE 754 (more or less).
;; "infinity" is defined to be greater that any number except NaN and itself.
nil)
(:method ((y (eql +negative-infinity+)) (x (eql +positive-infinity+)))
t)
(:method ((y (eql +positive-infinity+)) (x (eql +negative-infinity+)))
t)
(:method ((x real) (y (eql +positive-infinity+)))
t)
(:method ((y (eql +positive-infinity+)) (x real))
t)
(:method ((y (eql +positive-infinity+)) (x (eql +positive-infinity+)))
;; See above.
nil)
)
(defgeneric /=. (x)
(:method ((n number)) (cl:/= n))
(:method ((n (eql +negative-infinity+))) t)
(:method ((n (eql +positive-infinity+))) t)
)
(defgeneric .<=. (x y)
(:method ((x real) (y real))
(cl:<= x y))
(:method ((x real) (y (eql +negative-infinity+)))
;; Fix behavior for (.<=. double-float-negative-infinity +negative-infinity+)
nil)
(:method ((y (eql +negative-infinity+)) (x real))
T)
(:method ((y (eql +negative-infinity+)) (x (eql +negative-infinity+)))
;; This is per "standard mathematics" and also per IEEE 754 (more or less).
;; "infinity" is defined to be greater that any number except NaN and itself.
t)
(:method ((y (eql +negative-infinity+)) (x (eql +positive-infinity+)))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +negative-infinity+)))
nil)
(:method ((x real) (y (eql +positive-infinity+)))
t)
(:method ((y (eql +positive-infinity+)) (x real))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +positive-infinity+)))
;; See above.
t)
)
(defgeneric <=. (x)
(:method ((n real)) (cl:<= n))
(:method ((n (eql +negative-infinity+))) t)
(:method ((n (eql +positive-infinity+))) t)
)
(defgeneric .>=. (x y)
(:method ((x real) (y real))
(cl:>= x y))
(:method ((x real) (y (eql +negative-infinity+)))
;; Fix behavior for (.<=. double-float-negative-infinity +negative-infinity+)
nil)
(:method ((y (eql +negative-infinity+)) (x real))
T)
(:method ((y (eql +negative-infinity+)) (x (eql +negative-infinity+)))
;; This is per "standard mathematics" and also per IEEE 754 (more or less).
;; "infinity" is defined to be greater that any number except NaN and itself.
t)
(:method ((y (eql +negative-infinity+)) (x (eql +positive-infinity+)))
nil)
(:method ((y (eql +positive-infinity+)) (x (eql +negative-infinity+)))
t)
(:method ((x real) (y (eql +positive-infinity+)))
nil)
(:method ((y (eql +positive-infinity+)) (x real))
t)
(:method ((y (eql +positive-infinity+)) (x (eql +positive-infinity+)))
;; See above.
t)
)
(defgeneric >=. (x)
(:method ((n real)) (cl:>= n))
(:method ((n (eql +negative-infinity+))) t)
(:method ((n (eql +positive-infinity+))) t)
)
......@@ -301,53 +127,6 @@
:operation '.+.
:operands (list x y))
r)))
(:method ((x real) (y (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+negative-infinity+)
(:method ((y (eql +negative-infinity+)) (x real) &optional r)
(declare (ignore r))
+negative-infinity+)
(:method ((y (eql +negative-infinity+))
(x (eql +negative-infinity+))
&optional r)
(declare (ignore r))
+negative-infinity+)
(:method ((y (eql +negative-infinity+))
(x (eql +positive-infinity+))
&optional r)
(declare (ignore r))
(if *error-on-nan-returning-operations*
(error 'floating-point-invalid-operation
:operation '.+.
:operands (list y x))
nan))
(:method ((x number) (y (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((y (eql +positive-infinity+)) (x number) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((y (eql +positive-infinity+))
(x (eql +positive-infinity+))
&optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((y (eql +positive-infinity+))
(x (eql +negative-infinity+))
&optional r)
(if *error-on-nan-returning-operations*
(error 'floating-point-invalid-operation
:operation '.+.
:operands (list y x))
nan))
)
......@@ -355,15 +134,6 @@
(:method ((x number) &optional r)
(declare (ignore r))
(cl:+ x))
(:method ((x (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((x (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+negative-infinity+)
)
......@@ -376,61 +146,6 @@
:operation '.+.
:operands (list x y))
r)))
(:method ((x real) (y (eql +negative-infinity+)) &optional r)
(declare (ignore r))
(let ((s (cl:signum x)))
(cond ((cl:plusp s) +negative-infinity+)
((cl:zerop s) (if *error-on-nan-returning-operations*
(error 'floating-point-invalid-operation
:operation '.+.
:operands (list x y))
nan))
(t ; (minusp s)
+positive-infinity+))))
(:method ((y (eql +negative-infinity+)) (x real) &optional r)
(declare (ignore r))
(.*. x y))
(:method ((y (eql +negative-infinity+))
(x (eql +negative-infinity+))
&optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((y (eql +negative-infinity+))
(x (eql +positive-infinity+))
&optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((x number) (y (eql +positive-infinity+)) &optional r)
(declare (ignore r))
(let ((s (cl:signum x)))
(cond ((cl:plusp s) +positive-infinity+)
((cl:zerop s) (if *error-on-nan-returning-operations*
(error 'floating-point-invalid-operation
:operation '.*.
:operands (list x y))
nan))
(t ; (minusp s)
+negative-infinity+))))
(:method ((y (eql +positive-infinity+)) (x number) &optional r)
(declare (ignore r))
(.*. x y))
(:method ((y (eql +positive-infinity+))
(x (eql +positive-infinity+))
&optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((y (eql +positive-infinity+))
(x (eql +negative-infinity+))
&optional r)
+negative-infinity+)
)
......@@ -438,42 +153,25 @@
(:method ((x number) &optional r)
(declare (ignore r))
(cl:* x))
(:method ((x (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((x (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+negative-infinity+)
)
(defgeneric .-. (x y &optional r)
(:method ((x number) (y number) &optional r)
(declare (ignore r))
(let ((r (cl:- x y)))
(if (and (is-nan r) *error-on-nan-returning-operations*)
(error 'floating-point-invalid-operation
:operation '.-.
:operands (list x y))
r)))
(:method ((x t) (y t) &optional r)
(.+. x (-. y) r)))
)
(defgeneric -. (x &optional r)
(:method ((x number) &optional r)
(declare (ignore r))
(cl:- x))
(:method ((x (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+negative-infinity+)
(:method ((x (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
)
......@@ -486,9 +184,6 @@
:operation './.
:operands (list x y))
r)))
(:method ((x t) (y t) &optional r)
(.*. x (/. y) r))
)
......@@ -496,15 +191,6 @@
(:method ((x number) &optional r)
(declare (ignore r))
(cl:/ x))
(:method ((x (eql +positive-infinity+)) &optional (r 'single-float))
;; Let's abuse the R argument.
(coerce 0 r))
(:method ((x (eql +negative-infinity+)) &optional (r 'single-float))
;; Let's abuse the R argument.
(coerce 0 r))
)
......@@ -657,12 +343,6 @@
(defgeneric zerop (n)
(:method ((n number))
(cl:zerop n))
(:method ((x (eql +positive-infinity+)))
nil)
(:method ((x (eql +negative-infinity+)))
nil)
)
......@@ -670,14 +350,6 @@
(:method ((n integer) &optional r)
(declare (ignore r))
(cl:gcd n))
(:method ((n (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((n (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
)
......@@ -685,22 +357,6 @@
(:method ((n integer) (m integer) &optional r)
(declare (ignore r))
(cl:gcd n m))
(:method ((n (eql +positive-infinity+)) (m integer) &optional r)
(declare (ignore r))
(abs m))
(:method ((n (eql +negative-infinity+)) (m integer) &optional r)
(declare (ignore r))
(abs m))
(:method ((m integer) (n (eql +positive-infinity+)) &optional r)
(declare (ignore r))
(.gcd. n m))
(:method ((m integer) (n (eql +negative-infinity+)) &optional r)
(declare (ignore r))
(.gcd. n m))
)
......@@ -716,14 +372,6 @@
(:method ((n integer) &optional r)
(declare (ignore r))
(cl:lcm n))
(:method ((n (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((n (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
)
......@@ -731,22 +379,6 @@
(:method ((n integer) (m integer) &optional r)
(declare (ignore r))
(cl:lcm n m))
(:method ((n (eql +positive-infinity+)) (m integer) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((n (eql +negative-infinity+)) (m integer) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((m integer) (n (eql +positive-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
(:method ((m integer) (n (eql +negative-infinity+)) &optional r)
(declare (ignore r))
+positive-infinity+)
)
......@@ -765,6 +397,7 @@
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))
......@@ -775,14 +408,12 @@
(defgeneric plusp (x)
(:method ((x number)) (cl:plusp x))
(:method ((x (eql +positive-infinity+))) t)
(:method ((x (eql +negative-infinity+))) nil))
)
(defgeneric minusp (x)
(:method ((x number)) (cl:minusp x))
(:method ((x (eql +positive-infinity+))) nil)
(:method ((x (eql +negative-infinity+))) t))
)
(defgeneric minimum (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