diff options
author | Andreas Rottmann <a.rottmann@gmx.at> | 2010-10-03 21:54:22 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-10-03 21:54:22 +0200 |
commit | f16a20071dcb55e1362a5b21c63e98b3b4101364 (patch) | |
tree | f7585f5ea026908bdcf90ac9bce9dfb571414985 /module/srfi | |
parent | 5ad3881631c078d29e6b5676e8ab55759ee5bb85 (diff) | |
download | guile-f16a20071dcb55e1362a5b21c63e98b3b4101364.tar.gz |
Add implementation of SRFI 45
* module/srfi/srfi-45.scm: New file, containing the reference implementation of
SRFI 45, slightly adapted to use SRFI-9.
* module/Makefile.am (SRFI_SOURCES): Added srfi/srfi-45.scm.
* test-suite/tests/srfi-45.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Add tests/srfi-45.test.
* doc/ref/srfi-modules.texi (SRFI-45): New node and subsection;
essentially a shortended transcript of the SRFI-45 specification.
Diffstat (limited to 'module/srfi')
-rw-r--r-- | module/srfi/srfi-45.scm | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/module/srfi/srfi-45.scm b/module/srfi/srfi-45.scm new file mode 100644 index 000000000..1b912befc --- /dev/null +++ b/module/srfi/srfi-45.scm @@ -0,0 +1,78 @@ +;;; srfi-45.scm -- Primitives for Expressing Iterative Lazy Algorithms + +;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003 André van Tonder. All Rights Reserved. + +;; Permission is hereby granted, free of charge, to any person +;; obtaining a copy of this software and associated documentation +;; files (the "Software"), to deal in the Software without +;; restriction, including without limitation the rights to use, copy, +;; modify, merge, publish, distribute, sublicense, and/or sell copies +;; of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: + +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. + +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +;; SOFTWARE. + +;;; Commentary: + +;; This is the code of the reference implementation of SRFI-45, slightly +;; modified to use SRFI-9. + +;; This module is documented in the Guile Reference Manual. + +;;; Code: + +(define-module (srfi srfi-45) + #:export (delay + lazy + force + eager) + #:replace (delay force) + #:use-module (srfi srfi-9)) + +(define-record-type promise (make-promise val) promise? + (val promise-val promise-val-set!)) + +(define-record-type value (make-value tag proc) value? + (tag value-tag value-tag-set!) + (proc value-proc value-proc-set!)) + +(define-syntax lazy + (syntax-rules () + ((lazy exp) + (make-promise (make-value 'lazy (lambda () exp)))))) + +(define (eager x) + (make-promise (make-value 'eager x))) + +(define-syntax delay + (syntax-rules () + ((delay exp) (lazy (eager exp))))) + +(define (force promise) + (let ((content (promise-val promise))) + (case (value-tag content) + ((eager) (value-proc content)) + ((lazy) (let* ((promise* ((value-proc content))) + (content (promise-val promise))) ; * + (if (not (eqv? (value-tag content) 'eager)) ; * + (begin (value-tag-set! content + (value-tag (promise-val promise*))) + (value-proc-set! content + (value-proc (promise-val promise*))) + (promise-val-set! promise* content))) + (force promise)))))) + +;; (*) These two lines re-fetch and check the original promise in case +;; the first line of the let* caused it to be forced. For an example +;; where this happens, see reentrancy test 3 below. |