1.0.6.30: clean up FD-SOUT a little bit
[sbcl.git] / 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))