summaryrefslogtreecommitdiff
path: root/module/srfi
diff options
context:
space:
mode:
authorAndreas Rottmann <a.rottmann@gmx.at>2010-10-03 21:54:22 +0200
committerAndy Wingo <wingo@pobox.com>2010-10-03 21:54:22 +0200
commitf16a20071dcb55e1362a5b21c63e98b3b4101364 (patch)
treef7585f5ea026908bdcf90ac9bce9dfb571414985 /module/srfi
parent5ad3881631c078d29e6b5676e8ab55759ee5bb85 (diff)
downloadguile-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.scm78
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.