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 (&rest arguments)
  36     (declare (ignore arguments))
  37     (declare (optimize (speed 3) (safety 0) (debug 0)))
  38     value))