Subject: COMPLEMENT, again
From: Erik Naggum <erik@naggum.no>
Date: 1999/06/20
Newsgroups: comp.lang.lisp
Message-ID: <3138883562099900@naggum.no>

  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