COMPLEMENT wasn't exactly one of mey favorite new constructs in ANSI
Common Lisp, and the deprecation of useful functions at the cost of much
less readable forms made me unhappy about the whole invention. adding
insult to injury, COMPLEMENT is incredibly expensive in all the Lisps I
have used. then I came to conclude that it was missing a vital component
to its definition. here's what I did. maybe others think this is useful.
(defmacro define-complement (function complement)
"Define the complement of FUNCTION to be COMPLEMENT, both symbols."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (get ',function 'complement-function) ',complement)
(setf (get ',complement 'complement-function) ',function)))
(defun complement (function)
"Return a function that returns the boolean complement of FUNCTION."
(let* ((function-symbol
(typecase function
(symbol function)
#+allegro (compiled-function (excl::func_name function))
(t nil)))
(complement-symbol
(and (fboundp function-symbol)
(get function-symbol 'complement-function))))
(if complement-function
(symbol-function complement-function)
(lambda (&rest arguments)
(not (apply function arguments))))))
(define-complement = /=)
(define-complement < >=)
(define-complement > <=)
(define-complement char= char/=)
(define-complement char< char>=)
(define-complement char> char<=)
(define-complement char-equal char-not-equal)
(define-complement char-lessp char-not-lessp)
(define-complement char-greaterp char-not-greaterp)
(define-complement string= string/=)
(define-complement string< string>=)
(define-complement string> string<=)
(define-complement string-equal string-not-equal)
(define-complement string-lessp string-not-lessp)
(define-complement string-greaterp string-not-greaterp)
(defun ¬eq (object1 object2)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(not (eq object1 object2)))
(defun ¬eql (object1 object2)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(not (eql object1 object2)))
(defun ¬equal (object1 object2)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(not (equal object1 object2)))
(defun ¬equalp (object1 object2)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(not (equalp object1 object2)))
(define-complement eq ¬eq)
(define-complement eql ¬eql)
(define-complement equal ¬equal)
(define-complement equalp ¬equalp)
I keep adding complements as I need them, so I have no complete list, but
if others think this is a good idea, maybe all the usefully complemented
predicates can be complemented, if necessary with internal functions,
like those above. (¬ is the NOT operator, as per ISO 8859-1.)
#:Erik
--
@1999-07-22T00:37:33Z -- pi billion seconds since the turn of the century
