From: Alfredo Beaumont Date: Wed, 15 May 2013 12:53:23 +0000 (+0200) Subject: Add COMPLEMENT function definition, including tests. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cfd9e0ce078d53d0665aea0b2e445432721f99b7;p=jscl.git Add COMPLEMENT function definition, including tests. --- diff --git a/src/boot.lisp b/src/boot.lisp index 47f4309..3d6cd77 100644 --- 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 --- 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 --- 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)))