8 |
|
|
9 |
(declaim (optimize (safety 3))) |
(declaim (optimize (safety 3))) |
10 |
|
|
11 |
|
;;; A function for coercing truth values to BOOLEAN |
12 |
|
|
13 |
|
(defun notnot (x) (not (not x))) |
14 |
|
|
15 |
;;; Comparison functions that are like various builtins, |
;;; Comparison functions that are like various builtins, |
16 |
;;; but are guaranteed to return T for true. |
;;; but are guaranteed to return T for true. |
17 |
|
|
18 |
(defun eqt (x y) |
(defun eqt (x y) |
19 |
"Like EQ, but guaranteed to return T for true." |
"Like EQ, but guaranteed to return T for true." |
20 |
(if (eq x y) t nil)) |
(apply #'values (mapcar #'notnot (multiple-value-list (eq x y))))) |
21 |
|
|
22 |
(defun eqlt (x y) |
(defun eqlt (x y) |
23 |
"Like EQL, but guaranteed to return T for true." |
"Like EQL, but guaranteed to return T for true." |
24 |
(if (eql x y) t nil)) |
(apply #'values (mapcar #'notnot (multiple-value-list (eql x y))))) |
25 |
|
|
26 |
(defun equalt (x y) |
(defun equalt (x y) |
27 |
"Like EQUAL, but guaranteed to return T for true." |
"Like EQUAL, but guaranteed to return T for true." |
28 |
(if (equal x y) t nil)) |
(apply #'values (mapcar #'notnot (multiple-value-list (equal x y))))) |
29 |
|
|
30 |
(defun equalpt (x y) |
(defun equalpt (x y) |
31 |
"Like EQUALP, but guaranteed to return T for true." |
"Like EQUALP, but guaranteed to return T for true." |
32 |
(if (equalp x y) t nil)) |
(apply #'values (mapcar #'notnot (multiple-value-list (equalp x y))))) |
33 |
|
|
34 |
(defun =t (x &rest args) |
(defun =t (x &rest args) |
35 |
"Like =, but guaranteed to return T for true." |
"Like =, but guaranteed to return T for true." |
36 |
(if (apply #'= x args) t nil)) |
(apply #'values (mapcar #'notnot (multiple-value-list (apply #'= args))))) |
|
|
|
|
|
|
|
;;; A function for coercing truth values to BOOLEAN |
|
|
|
|
|
(defun notnot (x) (not (not x))) |
|
37 |
|
|
38 |
(defun make-int-list (n) |
(defun make-int-list (n) |
39 |
(loop for i from 0 below n collect i)) |
(loop for i from 0 below n collect i)) |
221 |
count (not (eqt e (nth i x))))) |
count (not (eqt e (nth i x))))) |
222 |
|
|
223 |
;;; |
;;; |
224 |
;;; The function SUBTYPEP returns two generalized booleans. |
;;; The function SUBTYPEP should return two generalized booleans. |
225 |
;;; This auxiliary function returns two booleans instead |
;;; This auxiliary function returns booleans instead |
226 |
;;; (which makes it easier to write tests). |
;;; (which makes it easier to write tests). |
227 |
;;; |
;;; |
228 |
(defun subtypep* (obj type) |
(defun subtypep* (obj type) |
229 |
(multiple-value-bind (result good) |
(apply #'values |
230 |
(subtypep obj type) |
(mapcar #'notnot |
231 |
(values (notnot result) |
(multiple-value-list (subtypep obj type))))) |
|
(notnot good)))) |
|
232 |
|
|
233 |
;;; (eval-when (load eval compile) |
;;; (eval-when (load eval compile) |
234 |
;;; (unless (fboundp 'complement) |
;;; (unless (fboundp 'complement) |