summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-12-16 15:14:33 +0100
committerLudovic Courtès <ludo@gnu.org>2010-12-16 23:45:23 +0100
commit18f06db925a67cb6b174a9210f7bed8adced4e00 (patch)
treea4ca1837512a3c5a0f179d4f38f740f4792af601
parent0bfba83a038ba03924eb82841407d387310181d5 (diff)
downloadguile-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.texi57
-rw-r--r--module/ice-9/boot-9.scm23
-rw-r--r--test-suite/Makefile.am1
-rw-r--r--test-suite/tests/procs.test48
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))))))