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   "This function simply returns what was passed to it."
  17   thing)
  18
  19 (defun complement (function)
  20   "Return a new function that returns T whenever FUNCTION returns NIL and
  21    NIL whenever FUNCTION returns non-NIL."
  22   ;; KLUDGE: constraint propagation is unable to detect that NTH gets
  23   ;; called only on indices known to be less than the predetermined N.
  24   (macrolet ((arg (n) `(fast-&rest-nth ,n arguments)))
  25     (lambda (&rest arguments)
  26       (not (let ((n (length arguments)))
  27              (if (> n 3)
  28                  (apply function arguments)
  29                  (case n
  30                   (1 (funcall function (arg 0)))
  31                   (2 (funcall function (arg 0) (arg 1)))
  32                   (3 (funcall function (arg 0) (arg 1) (arg 2)))
  33                   (t (funcall function)))))))))
  34
  35 (defun constantly (value)
  36   "Return a function that always returns VALUE."
  37   (lambda (&rest arguments)
  38     (declare (ignore arguments))
  39     (declare (optimize (speed 3) (safety 0) (debug 0)))
  40     value))