/[gcl]/gcl/ansi-tests/numbers-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/numbers-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by pfdietz, Sat Aug 9 18:13:35 2003 UTC revision 1.6 by pfdietz, Sat Aug 23 13:42:35 2003 UTC
# Line 5  Line 5 
5    
6  (in-package :cl-test)  (in-package :cl-test)
7    
8    (defun numbers-are-compatible (x y)
9      (cond
10       ((complexp x)
11        (and (numbers-are-compatible (realpart x) y)
12             (numbers-are-compatible (imagpart x) y)))
13       ((complexp y)
14        (and (numbers-are-compatible x (realpart y))
15             (numbers-are-compatible x (imagpart y))))
16       (t
17        (when (floatp x) (rotatef x y))
18        (or (floatp x)
19            (not (floatp y))
20            (etypecase y
21              (short-float
22               (<= #.(rationalize most-negative-short-float)
23                   x
24                   #.(rationalize most-positive-short-float)))
25              (single-float
26               (<= #.(rationalize most-negative-single-float)
27                   x
28                   #.(rationalize most-positive-single-float)))
29              (double-float
30               (<= #.(rationalize most-negative-double-float)
31                   x
32                   #.(rationalize most-positive-double-float)))
33              (long-float
34               (<= #.(rationalize most-negative-long-float)
35                   x
36                   #.(rationalize most-positive-long-float))))))))    
37    
38  (defun =.4-fn ()  (defun =.4-fn ()
39    (loop for x in *numbers*    (loop for x in *numbers*
40          append          append
41          (loop for y in *numbers*          (loop for y in *numbers*
42                unless (if (= x y) (= y x) (not (= y x)))                unless (or (not (numbers-are-compatible x y))
43                             (if (= x y) (= y x) (not (= y x))))
44                collect (list x y))))                collect (list x y))))
45    
46  (defun /=.4-fn ()  (defun /=.4-fn ()
47    (loop for x in *numbers*    (loop for x in *numbers*
48          append          append
49          (loop for y in *numbers*          (loop for y in *numbers*
50                unless (if (/= x y) (/= y x) (not (/= y x)))                unless (or (not (numbers-are-compatible x y))
51                             (if (/= x y) (/= y x) (not (/= y x))))
52                collect (list x y))))                collect (list x y))))
53    
54  (defun /=.4a-fn ()  (defun /=.4a-fn ()
55    (loop for x in *numbers*    (loop for x in *numbers*
56          append          append
57          (loop for y in *numbers*          (loop for y in *numbers*
58                when (if (= x y)                when (and (numbers-are-compatible x y)
59                         (/= x y)                          (if (= x y)
60                       (not (/= x y)))                              (/= x y)
61                              (not (/= x y))))
62                collect (list x y))))                collect (list x y))))
63    
64  (defun <.8-fn ()  (defun <.8-fn ()
65    (loop for x in *reals*    (loop for x in *reals*
66          nconc          nconc
67          (loop for y in *reals*          (loop for y in *reals*
68                when (and (< x y) (> x y))                when (and (numbers-are-compatible x y)
69                            (and (< x y) (> x y)))
70                collect (list x y))))                collect (list x y))))
71    
72  (defun <.9-fn ()  (defun <.9-fn ()
73    (loop for x in *reals*    (loop for x in *reals*
74          nconc          nconc
75          (loop for y in *reals*          (loop for y in *reals*
76                when (if (< x y) (not (> y x))                when (and (numbers-are-compatible x y)
77                       (> y x))                          (if (< x y) (not (> y x))
78                              (> y x)))
79                collect (list x y))))                collect (list x y))))
80    
81  (defun <.10-fn ()  (defun <.10-fn ()
82    (loop for x in *reals*    (loop for x in *reals*
83          nconc          nconc
84          (loop for y in *reals*          (loop for y in *reals*
85                when (if (< x y) (>= x y)                when (and (numbers-are-compatible x y)
86                       (not (>= x y)))                          (if (< x y) (>= x y)
87                              (not (>= x y))))
88                collect (list x y))))                collect (list x y))))
89    
90  (defun <=.8-fn ()  (defun <=.8-fn ()
91    (loop for x in *reals*    (loop for x in *reals*
92          nconc          nconc
93          (loop for y in *reals*          (loop for y in *reals*
94                when (if (<= x y) (not (>= y x))                when (and (numbers-are-compatible x y)
95                       (>= y x))                          (if (<= x y) (not (>= y x))
96                              (>= y x)))
97                collect (list x y))))                collect (list x y))))
98    
99  (defun <=.9-fn ()  (defun <=.9-fn ()
100    (loop for x in *reals*    (loop for x in *reals*
101          nconc          nconc
102          (loop for y in *reals*          (loop for y in *reals*
103                when (if (<= x y) (not (or (= x y) (< x y)))                when (and (numbers-are-compatible x y)
104                       (or (= x y) (< x y)))                          (if (<= x y) (not (or (= x y) (< x y)))
105                              (or (= x y) (< x y))))
106                collect (list x y))))                collect (list x y))))
107    
108  (defun >.8-fn ()  (defun >.8-fn ()
109    (loop for x in *reals*    (loop for x in *reals*
110          nconc          nconc
111          (loop for y in *reals*          (loop for y in *reals*
112                when (if (> x y) (<= x y)                when (and (numbers-are-compatible x y)
113                       (not (<= x y)))                          (if (> x y) (<= x y)
114                              (not (<= x y))))
115                collect (list x y))))                collect (list x y))))
116    
117  (defun >=.8-fn ()  (defun >=.8-fn ()
118    (loop for x in *reals*    (loop for x in *reals*
119          nconc          nconc
120          (loop for y in *reals*          (loop for y in *reals*
121                when (if (>= x y) (not (or (= x y) (> x y)))                when (and (numbers-are-compatible x y)
122                       (or (= x y) (> x y)))                          (if (>= x y) (not (or (= x y) (> x y)))
123                              (or (= x y) (> x y))))
124                collect (list x y))))                collect (list x y))))
125    
126  ;;; Comparison of rationsls  ;;; Comparison of rationsls

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26