diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-12-16 15:14:33 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-12-16 23:45:23 +0100 |
commit | 18f06db925a67cb6b174a9210f7bed8adced4e00 (patch) | |
tree | a4ca1837512a3c5a0f179d4f38f740f4792af601 | |
parent | 0bfba83a038ba03924eb82841407d387310181d5 (diff) | |
download | guile-18f06db925a67cb6b174a9210f7bed8adced4e00.tar.gz |
Add `compose', `negate', and `const'.
* module/ice-9/boot-9.scm (compose, negate, const): New procedures.
* doc/ref/api-procedures.texi (Higher-Order Functions): New node.
* test-suite/Makefile.am (SCM_TESTS): Add `tests/procs.test'.
* test-suite/tests/procs.test: New file.
-rw-r--r-- | doc/ref/api-procedures.texi | 57 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 23 | ||||
-rw-r--r-- | test-suite/Makefile.am | 1 | ||||
-rw-r--r-- | test-suite/tests/procs.test | 48 |
4 files changed, 129 insertions, 0 deletions
diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi index 8fc7f33f5..c087f4c7e 100644 --- a/doc/ref/api-procedures.texi +++ b/doc/ref/api-procedures.texi @@ -13,6 +13,7 @@ * Compiled Procedures:: Scheme procedures can be compiled. * Optional Arguments:: Handling keyword, optional and rest arguments. * Case-lambda:: One function, multiple arities. +* Higher-Order Functions:: Function that take or return functions. * Procedure Properties:: Procedure properties and meta-information. * Procedures with Setters:: Procedures with setters. @end menu @@ -573,6 +574,62 @@ arguments, and on the predicate; keyword arguments may be present but do not contribute to the ``success'' of a match. In fact a bad keyword argument list may cause an error to be raised. +@node Higher-Order Functions +@subsection Higher-Order Functions + +@cindex higher-order functions + +As a functional programming language, Scheme allows the definition of +@dfn{higher-order functions}, i.e., functions that take functions as +arguments and/or return functions. Utilities to derive procedures from +other procedures are provided and described below. + +@deffn {Scheme Procedure} const value +Return a procedure that accepts any number of arguments and returns +@var{value}. + +@lisp +(procedure? (const 3)) @result{} #t +((const 'hello)) @result{} hello +((const 'hello) 'world) @result{} hello +@end lisp +@end deffn + +@deffn {Scheme Procedure} negate proc +Return a procedure with the same arity as @var{proc} that returns the +@code{not} of @var{proc}'s result. + +@lisp +(procedure? (negate number?)) @result{} #t +((negate odd?) 2) @result{} #t +((negate real?) 'dream) @result{} #t +((negate string-prefix?) "GNU" "GNU Guile") + @result{} #f +(filter (negate number?) '(a 2 "b")) + @result{} (a "b") +@end lisp +@end deffn + +@deffn {Scheme Procedure} compose proc rest ... +Compose @var{proc} with the procedures in @var{rest}, such that the last +one in @var{rest} is applied first and @var{proc} last, and return the +resulting procedure. The given procedures must have compatible arity. + +@lisp +(procedure? (compose 1+ 1-)) @result{} #t +((compose sqrt 1+ 1+) 2) @result{} 2.0 +((compose 1+ sqrt) 3) @result{} 2.73205080756888 +(eq? (compose 1+) 1+) @result{} #t + +((compose zip unzip2) '((1 2) (a b))) + @result{} ((1 2) (a b)) +@end lisp +@end deffn + +@deffn {Scheme Procedure} identity x +Return X. +@end deffn + @node Procedure Properties @subsection Procedure Properties and Meta-information diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 1a61ce01e..1b2985d25 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -531,6 +531,29 @@ If there is no handler at all, Guile prints an error and then exits." ;;; (define (identity x) x) + +(define (compose proc . rest) + "Compose PROC with the procedures in REST, such that the last one in +REST is applied first and PROC last, and return the resulting procedure. +The given procedures must have compatible arity." + (if (null? rest) + proc + (let ((g (apply compose rest))) + (lambda args + (call-with-values (lambda () (apply g args)) proc))))) + +(define (negate proc) + "Return a procedure with the same arity as PROC that returns the `not' +of PROC's result." + (lambda args + (not (apply proc args)))) + +(define (const value) + "Return a procedure that accepts any number of arguments and returns +VALUE." + (lambda _ + value)) + (define (and=> value procedure) (and value (procedure value))) (define call/cc call-with-current-continuation) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 2e43e877b..b1f184eb2 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -72,6 +72,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/options.test \ tests/print.test \ tests/procprop.test \ + tests/procs.test \ tests/poe.test \ tests/popen.test \ tests/popen-child.scm \ diff --git a/test-suite/tests/procs.test b/test-suite/tests/procs.test new file mode 100644 index 000000000..c17a02184 --- /dev/null +++ b/test-suite/tests/procs.test @@ -0,0 +1,48 @@ +;;;; procss.test --- Procedures. -*- mode: scheme; coding: utf-8; -*- +;;;; +;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-procs) + #:use-module (srfi srfi-1) + #:use-module (test-suite lib)) + +(with-test-prefix "common procedures" + + (pass-if "identity" + (eq? 'a (identity 'a))) + + (pass-if "const" + (and (procedure? (const 'a)) + (eq? 'a ((const 'a))) + (eq? 'a ((const 'a) 'b 'c 'd)))) + + (pass-if "negate" + (and (procedure? (negate number?)) + ((negate real?) 'dream) + ((negate odd?) 0))) + + (with-test-prefix "compose" + + (pass-if "identity" + (eq? 1+ (compose 1+))) + + (pass-if "simple" + (= 2.0 ((compose sqrt 1+ 1+) 2))) + + (pass-if "multiple values" + (equal? ((compose zip unzip2) '((1 2) (a b))) + '((1 2) (a b)))))) |