mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Ludovic Courtès
parent
fe613fe25d
commit
0d4e6ca38f
5 changed files with 360 additions and 1 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
177
module/ice-9/futures.scm
Normal file
177
module/ice-9/futures.scm
Normal file
|
|
@ -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)))))
|
||||
|
|
@ -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 \
|
||||
|
|
|
|||
83
test-suite/tests/future.test
Normal file
83
test-suite/tests/future.test
Normal file
|
|
@ -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!")))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue