src/code/funutils.lisp

   1 ;;;; miscellaneous operations on functions, returning functions, or
   2 ;;;; primarily useful for functional programming
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!IMPL")
  14
  15 (defun identity (thing)
  16   #!+sb-doc
  17   "This function simply returns what was passed to it."
  18   thing)
  19
  20 (defun complement (function)
  21   #!+sb-doc
  22   "Return a new function that returns T whenever FUNCTION returns NIL and
  23    NIL whenever FUNCTION returns non-NIL."
  24   (lambda (&optional (arg0 nil arg0-p) (arg1 nil arg1-p) (arg2 nil arg2-p)
  25                      &rest more-args)
  26     (not (cond (more-args (apply function arg0 arg1 arg2 more-args))
  27                (arg2-p (funcall function arg0 arg1 arg2))
  28                (arg1-p (funcall function arg0 arg1))
  29                (arg0-p (funcall function arg0))
  30                (t (funcall function))))))
  31
  32 (defun constantly (value)
  33   #!+sb-doc
  34   "Return a function that always returns VALUE."
  35   (lambda ()
  36     ;; KLUDGE: This declaration is a hack to make the closure ignore
  37     ;; all its arguments without consing a &REST list or anything.
  38     ;; Perhaps once DYNAMIC-EXTENT is implemented we won't need to
  39     ;; screw around with this kind of thing. -- WHN 2001-04-06
  40     (declare (optimize (speed 3) (safety 0)))
  41     value))