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

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

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

revision 1.23 by pfdietz, Thu Jan 23 04:11:59 2003 UTC revision 1.24 by pfdietz, Thu Jan 23 13:10:02 2003 UTC
# Line 8  Line 8 
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))
# Line 222  the condition to go uncaught if it canno Line 221  the condition to go uncaught if it canno
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)

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

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