Add `(ice-9 futures)'.

* doc/ref/api-scheduling.texi (Threads): Add short introduction.
  Mention the `threads' feature.  Add cross-reference to futures.
  (Futures): New node.

* module/Makefile.am (ICE_9_SOURCES): Add `ice-9/futures.scm'.

* module/ice-9/futures.scm: New file.

* test-suite/Makefile.am (SCM_TESTS): Add `tests/future.test'.

* test-suite/tests/future.test: New file.

doc/ref/api-scheduling.texi

@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -15,6 +15,7 @@
 * Blocking::                    How to block properly in guile mode.
 * Critical Sections::           Avoiding concurrency and reentries.
 * Fluids and Dynamic States::   Thread-local variables, etc.
+* Futures::                     Fine-grain parallelism.
 * Parallel Forms::              Parallel execution of forms.
 @end menu
 
@@ -195,6 +196,16 @@ Execute all thunks from the marked asyncs of the list @var{list_of_a}.
 @cindex Guile threads
 @cindex POSIX threads
 
+Guile supports POSIX threads, unless it was configured with
+@code{--without-threads} or the host lacks POSIX thread support.  When
+thread support is available, the @code{threads} feature is provided
+(@pxref{Feature Manipulation, @code{provided?}}).
+
+The procedures below manipulate Guile threads, which are wrappers around
+the system's POSIX threads.  For application-level parallelism, using
+higher-level constructs, such as futures, is recommended
+(@pxref{Futures}).
+
 @deffn {Scheme Procedure} all-threads
 @deffnx {C Function} scm_all_threads ()
 Return a list of all threads.
@@ -791,6 +802,92 @@ Like @code{scm_with_dynamic_state}, but call @var{func} with
 @var{data}.
 @end deftypefn
 
+@node Futures
+@subsection Futures
+@cindex futures
+@cindex fine-grain parallelism
+@cindex parallelism
+
+The @code{(ice-9 futures)} module provides @dfn{futures}, a construct
+for fine-grain parallelism.  A future is a wrapper around an expression
+whose computation may occur in parallel with the code of the calling
+thread, and possibly in parallel with other futures.  Like promises,
+futures are essentially proxies that can be queried to obtain the value
+of the enclosed expression:
+
+@lisp
+(touch (future (+ 2 3)))
+@result{} 5
+@end lisp
+
+However, unlike promises, the expression associated with a future may be
+evaluated on another CPU core, should one be available.  This supports
+@dfn{fine-grain parallelism}, because even relatively small computations
+can be embedded in futures.  Consider this sequential code:
+
+@lisp
+(define (find-prime lst1 lst2)
+  (or (find prime? lst1)
+      (find prime? lst2)))
+@end lisp
+
+The two arms of @code{or} are potentially computation-intensive.  They
+are independent of one another, yet, they are evaluated sequentially
+when the first one returns @code{#f}.  Using futures, one could rewrite
+it like this:
+
+@lisp
+(define (find-prime lst1 lst2)
+  (let ((f (future (find prime? lst2))))
+    (or (find prime? lst1)
+        (touch f))))
+@end lisp
+
+This preserves the semantics of @code{find-prime}.  On a multi-core
+machine, though, the computation of @code{(find prime? lst2)} may be
+done in parallel with that of the other @code{find} call, which can
+reduce the execution time of @code{find-prime}.
+
+Guile's futures are implemented on top of POSIX threads
+(@pxref{Threads}).  Internally, a fixed-size pool of threads is used to
+evaluate futures, such that offloading the evaluation of an expression
+to another thread doesn't incur thread creation costs.  By default, the
+pool contains one thread per CPU core, minus one, to account for the
+main thread.
+
+@deffn {Scheme Syntax} future exp
+Return a future for expression @var{exp}.  This is equivalent to:
+
+@lisp
+(make-future (lambda () exp))
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} make-future thunk
+Return a future for @var{thunk}, a zero-argument procedure.
+
+This procedure returns immediately.  Execution of @var{thunk} may begin
+in parallel with the calling thread's computations, if idle CPU cores
+are available, or it may start when @code{touch} is invoked on the
+returned future.
+
+If the execution of @var{thunk} throws an exception, that exception will
+be re-thrown when @code{touch} is invoked on the returned future.
+@end deffn
+
+@deffn {Scheme Procedure} future? obj
+Return @code{#t} if @var{obj} is a future.
+@end deffn
+
+@deffn {Scheme Procedure} touch f
+Return the result of the expression embedded in future @var{f}.
+
+If the result was already computed in parallel, @code{touch} returns
+instantaneously.  Otherwise, it waits for the computation to complete,
+if it already started, or initiates it.
+@end deffn
+
+
 @node Parallel Forms
 @subsection Parallel forms
 @cindex parallel forms

module/Makefile.am

@@ -187,6 +187,7 @@ ICE_9_SOURCES = \
   ice-9/documentation.scm \
   ice-9/expect.scm \
   ice-9/format.scm \
+  ice-9/futures.scm \
   ice-9/getopt-long.scm \
   ice-9/hcons.scm \
   ice-9/i18n.scm \

module/ice-9/futures.scm

@@ -0,0 +1,177 @@
+;;; -*- 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 (ice-9 futures)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
+  #:export (future make-future future? touch))
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; Commentary:
+;;;
+;;; This module provides an implementation of futures, a mechanism for
+;;; fine-grain parallelism.  Futures were first described by Henry Baker
+;;; in ``The Incremental Garbage Collection of Processes'', 1977, and
+;;; then implemented in MultiLisp (an implicit variant thereof, i.e.,
+;;; without `touch'.)
+;;;
+;;; This modules uses a fixed thread pool, normally one per CPU core.
+;;; Futures are off-loaded to these threads, when they are idle.
+;;;
+;;; Code:
+
+
+;;;
+;;; Futures.
+;;;
+
+(define-record-type <future>
+  (%make-future thunk done? mutex)
+  future?
+  (thunk     future-thunk)
+  (done?     future-done?  set-future-done?!)
+  (result    future-result set-future-result!)
+  (mutex     future-mutex))
+
+(define (make-future thunk)
+  "Return a new future for THUNK.  Execution may start at any point
+concurrently, or it can start at the time when the returned future is
+touched."
+  (let ((future (%make-future thunk #f (make-mutex))))
+    (register-future! future)
+    future))
+
+
+;;;
+;;; Future queues.
+;;;
+
+(define %futures '())
+(define %futures-mutex (make-mutex))
+(define %futures-available (make-condition-variable))
+
+(define (register-future! future)
+  ;; Register FUTURE as being processable.
+  (lock-mutex %futures-mutex)
+  (set! %futures (cons future %futures)) ;; FIXME: use a FIFO
+  (signal-condition-variable %futures-available)
+  (unlock-mutex %futures-mutex))
+
+(define (unregister-future! future)
+  ;; Assume %FUTURES-MUTEX is taken.
+  (set! %futures (delq future %futures)))
+
+(define (process-future! future)
+  ;; Process FUTURE, assuming its mutex is already taken.
+  (set-future-result! future
+                      (catch #t
+                        (lambda ()
+                          (let ((result ((future-thunk future))))
+                            (lambda ()
+                              result)))
+                        (lambda args
+                          (lambda ()
+                            (apply throw args)))))
+  (set-future-done?! future #t))
+
+(define (process-futures)
+  ;; Wait for futures to be available and process them.
+  (lock-mutex %futures-mutex)
+  (let loop ()
+    (wait-condition-variable %futures-available
+                             %futures-mutex)
+    (match %futures
+      (() (loop))
+      ((future _ ...)
+       (lock-mutex (future-mutex future))
+       (or (future-done? future)
+           (begin
+             ;; Do the actual work.
+             (unregister-future! future)
+
+             ;; We want to release %FUTURES-MUTEX so that other workers
+             ;; can progress.  However, to avoid deadlocks, we have to
+             ;; unlock FUTURE as well, to preserve lock ordering.
+             (unlock-mutex (future-mutex future))
+             (unlock-mutex %futures-mutex)
+
+             (lock-mutex (future-mutex future))
+             (or (future-done? future)            ; lost the race?
+                 (process-future! future))
+
+             (lock-mutex %futures-mutex)))
+       (unlock-mutex (future-mutex future))
+       (loop)))))
+
+(define (touch future)
+  "Return the result of FUTURE, computing it if not already done."
+  (lock-mutex (future-mutex future))
+  (or (future-done? future)
+      (begin
+        ;; Do the actual work.  Unlock FUTURE first to preserve lock
+        ;; ordering.
+        (unlock-mutex (future-mutex future))
+
+        (lock-mutex %futures-mutex)
+        (unregister-future! future)
+        (unlock-mutex %futures-mutex)
+
+        (lock-mutex (future-mutex future))
+        (or (future-done? future)            ; lost the race?
+            (process-future! future))))
+  (unlock-mutex (future-mutex future))
+  ((future-result future)))
+
+
+;;;
+;;; Workers.
+;;;
+
+(define %worker-count
+  (if (provided? 'threads)
+      (if (defined? 'getaffinity)
+          (- (bit-count #t (getaffinity (getpid))) 1)
+          3) ;; FIXME: use Gnulib's `nproc' here.
+      0))
+
+(define %workers
+  ;; A dock of workers that stay here forever.
+
+  ;; TODO
+  ;; 1. Allocate lazily.
+  ;; 2. Allow the pool to be shrunk, as in libgomp (though that we'd
+  ;;    need semaphores, which aren't yet in libguile!).
+  ;; 3. Provide a `worker-count' fluid.
+  (unfold (lambda (i) (>= i %worker-count))
+          (lambda (i)
+            (call-with-new-thread process-futures))
+          1+
+          0))
+
+
+;;;
+;;; Syntax.
+;;;
+
+(define-syntax future
+  (syntax-rules ()
+    "Return a new future for BODY."
+    ((_ body)
+     (make-future (lambda () body)))))

test-suite/Makefile.am

@@ -50,6 +50,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/format.test			\
 	    tests/fractions.test		\
 	    tests/ftw.test			\
+	    tests/future.test			\
 	    tests/gc.test			\
 	    tests/getopt-long.test		\
 	    tests/goops.test			\

test-suite/tests/future.test

@@ -0,0 +1,83 @@
+;;;; future.test --- Futures.       -*- mode: scheme; coding: utf-8; -*-
+;;;;
+;;;; Ludovic Courtès <ludo@gnu.org>
+;;;;
+;;;; 	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-future)
+  #:use-module (test-suite lib)
+  #:use-module (ice-9 futures)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26))
+
+(define specific-exception-key (gensym))
+
+(define specific-exception
+  (cons specific-exception-key ".*"))
+
+
+(with-test-prefix "futures"
+
+  (pass-if "make-future"
+    (future? (make-future (lambda () #f))))
+
+  (pass-if "future"
+    (future? (future #t)))
+
+  (pass-if "true"
+    (touch (future #t)))
+
+  (pass-if "(+ 2 3)"
+    (= 5 (touch (future (+ 2 3)))))
+
+  (pass-if "many"
+    (equal? (iota 1234)
+            (map touch
+                 (map (lambda (i)
+                        (make-future (lambda () i)))
+                      (iota 1234)))))
+
+  (pass-if "touch several times"
+    (let* ((f+    (unfold (cut >= <> 123)
+                          (lambda (i)
+                            (make-future
+                             (let ((x (1- i)))
+                               (lambda ()
+                                 (set! x (1+ x))
+                                 i))))
+                          1+
+                          0))
+           (r1    (map touch f+))
+           (r2    (map touch f+))
+           (r3    (map touch f+)))
+      (equal? (iota 123) r1 r2 r3)))
+
+  (pass-if "nested"
+    (= (touch (future (+ 2 (touch (future -2))
+                         (reduce + 0
+                                 (map touch
+                                      (map (lambda (i)
+                                             (future i))
+                                           (iota 123)))))))
+       (reduce + 0 (iota 123))))
+
+  (pass-if "no exception"
+    (future? (future (throw 'foo 'bar))))
+
+  (pass-if-exception "exception"
+    specific-exception
+    (touch (future (throw specific-exception-key 'test "thrown!")))))