Add COMPLEMENT function definition, including tests.

diff --git a/src/boot.lisp b/src/boot.lisp
index 47f4309..3d6cd77 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -362,6 +362,10 @@
 
 (defun identity (x) x)
 
+(defun complement (x)
+  (lambda (&rest args)
+    (not (apply x args))))
+
 (defun constantly (x)
   (lambda (&rest args)
     x))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index ed0abfe..003641d 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -54,9 +54,9 @@
           boundp butlast caaaar caaadr caaar caadar caaddr caadr caar cadaar
           cadadr cadar caddar cadddr caddr cadr car car case catch cdaaar
           cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar
-          cddddr cdddr cddr cdr cdr char char-code char= code-char cond cons
-          consp constantly copy-alist copy-list copy-tree decf declaim declare
-          defconstant define-setf-expander define-symbol-macro defmacro
+          cddddr cdddr cddr cdr cdr char char-code char= code-char complement
+          cond cons consp constantly copy-alist copy-list copy-tree decf declaim
+          declare defconstant define-setf-expander define-symbol-macro defmacro
           defparameter defun defvar destructuring-bind digit-char digit-char-p
           disassemble do do* documentation dolist dotimes ecase eighth eq eql
           equal error eval every export expt fdefinition fifth find

diff --git a/tests/control.lisp b/tests/control.lisp
index 5e010e3..fba8956 100644 (file)
--- a/tests/control.lisp
+++ b/tests/control.lisp
@@ -42,3 +42,10 @@
                    (zfoo 5 rf 3)
                    out)))
              '(-5 -4 -3 999 1 2 3 4 5)))
+
+;; COMPLEMENT
+(test (funcall (complement #'zerop) 1))
+;; FIXME: Uncomment whenever characterp is defined
+;(test (not (funcall (complement #'characterp) #\A)))
+(test (not (funcall (complement #'member) 'a '(a b c))))
+(test (funcall (complement #'member) 'd '(a b c)))