- SRFI-27 "Sources of Random Bits"
- SRFI-42 "Eager Comprehensions"
+- SRFI-45 "Primitives for Expressing Iterative Lazy Algorithms"
** Many R6RS bugfixes
* SRFI-37:: args-fold program argument processor
* SRFI-39:: Parameter objects
* SRFI-42:: Eager comprehensions
+* SRFI-45:: Primitives for expressing iterative lazy algorithms
* SRFI-55:: Requiring Features.
* SRFI-60:: Integers as bits.
* SRFI-61:: A more general `cond' clause
See @uref{http://srfi.schemers.org/srfi-42/srfi-42.html, the
specification of SRFI-42}.
+@node SRFI-45
+@subsection SRFI-45 - Primitives for Expressing Iterative Lazy Algorithms
+@cindex SRFI-45
+
+This subsection is based on @uref{http://srfi.schemers.org/srfi-45/srfi-45.html, the
+specification of SRFI-45} written by Andr@'e van Tonder.
+
+@c Copyright (C) André van Tonder (2003). All Rights Reserved.
+
+@c Permission is hereby granted, free of charge, to any person obtaining a
+@c copy of this software and associated documentation files (the
+@c "Software"), to deal in the Software without restriction, including
+@c without limitation the rights to use, copy, modify, merge, publish,
+@c distribute, sublicense, and/or sell copies of the Software, and to
+@c permit persons to whom the Software is furnished to do so, subject to
+@c the following conditions:
+
+@c The above copyright notice and this permission notice shall be included
+@c in all copies or substantial portions of the Software.
+
+@c THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+@c OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+@c MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+@c NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+@c LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+@c OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+@c WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Lazy evaluation is traditionally simulated in Scheme using @code{delay}
+and @code{force}. However, these primitives are not powerful enough to
+express a large class of lazy algorithms that are iterative. Indeed, it
+is folklore in the Scheme community that typical iterative lazy
+algorithms written using delay and force will often require unbounded
+memory.
+
+This SRFI provides set of three operations: @{@code{lazy}, @code{delay},
+@code{force}@}, which allow the programmer to succinctly express lazy
+algorithms while retaining bounded space behavior in cases that are
+properly tail-recursive. A general recipe for using these primitives is
+provided. An additional procedure @code{eager} is provided for the
+construction of eager promises in cases where efficiency is a concern.
+
+Although this SRFI redefines @code{delay} and @code{force}, the
+extension is conservative in the sense that the semantics of the subset
+@{@code{delay}, @code{force}@} in isolation (i.e., as long as the
+program does not use @code{lazy}) agrees with that in R5RS. In other
+words, no program that uses the R5RS definitions of delay and force will
+break if those definition are replaced by the SRFI-45 definitions of
+delay and force.
+
+@deffn {Scheme Syntax} delay expression
+Takes an expression of arbitrary type @var{a} and returns a promise of
+type @code{(Promise @var{a})} which at some point in the future may be
+asked (by the @code{force} procedure) to evaluate the expression and
+deliver the resulting value.
+@end deffn
+
+@deffn {Scheme Syntax} lazy expression
+Takes an expression of type @code{(Promise @var{a})} and returns a
+promise of type @code{(Promise @var{a})} which at some point in the
+future may be asked (by the @code{force} procedure) to evaluate the
+expression and deliver the resulting promise.
+@end deffn
+
+@deffn {Scheme Procedure} force expression
+Takes an argument of type @code{(Promise @var{a})} and returns a value
+of type @var{a} as follows: If a value of type @var{a} has been computed
+for the promise, this value is returned. Otherwise, the promise is
+first evaluated, then overwritten by the obtained promise or value, and
+then force is again applied (iteratively) to the promise.
+@end deffn
+
+@deffn {Scheme Procedure} eager expression
+Takes an argument of type @var{a} and returns a value of type
+@code{(Promise @var{a})}. As opposed to @code{delay}, the argument is
+evaluated eagerly. Semantically, writing @code{(eager expression)} is
+equivalent to writing
+
+@lisp
+(let ((value expression)) (delay value)).
+@end lisp
+
+However, the former is more efficient since it does not require
+unnecessary creation and evaluation of thunks. We also have the
+equivalence
+
+@lisp
+(delay expression) = (lazy (eager expression))
+@end lisp
+@end deffn
+
+The following reduction rules may be helpful for reasoning about these
+primitives. However, they do not express the memoization and memory
+usage semantics specified above:
+
+@lisp
+(force (delay expression)) -> expression
+(force (lazy expression)) -> (force expression)
+(force (eager value)) -> value
+@end lisp
+
+@subsubheading Correct usage
+
+We now provide a general recipe for using the primitives @{@code{lazy},
+@code{delay}, @code{force}@} to express lazy algorithms in Scheme. The
+transformation is best described by way of an example: Consider the
+stream-filter algorithm, expressed in a hypothetical lazy language as
+
+@lisp
+(define (stream-filter p? s)
+ (if (null? s) '()
+ (let ((h (car s))
+ (t (cdr s)))
+ (if (p? h)
+ (cons h (stream-filter p? t))
+ (stream-filter p? t)))))
+@end lisp
+
+This algorithm can be espressed as follows in Scheme:
+
+@lisp
+(define (stream-filter p? s)
+ (lazy
+ (if (null? (force s)) (delay '())
+ (let ((h (car (force s)))
+ (t (cdr (force s))))
+ (if (p? h)
+ (delay (cons h (stream-filter p? t)))
+ (stream-filter p? t))))))
+@end lisp
+
+In other words, we
+
+@itemize @bullet
+@item
+wrap all constructors (e.g., @code{'()}, @code{cons}) with @code{delay},
+@item
+apply @code{force} to arguments of deconstructors (e.g., @code{car},
+@code{cdr} and @code{null?}),
+@item
+wrap procedure bodies with @code{(lazy ...)}.
+@end itemize
+
@node SRFI-55
@subsection SRFI-55 - Requiring Features
@cindex SRFI-55
srfi/srfi-37.scm \
srfi/srfi-42.scm \
srfi/srfi-39.scm \
+ srfi/srfi-45.scm \
srfi/srfi-60.scm \
srfi/srfi-67.scm \
srfi/srfi-69.scm \
--- /dev/null
+;;; 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.
tests/srfi-37.test \
tests/srfi-39.test \
tests/srfi-42.test \
+ tests/srfi-45.test \
tests/srfi-60.test \
tests/srfi-67.test \
tests/srfi-69.test \
--- /dev/null
+;;; -*- mode: scheme; coding: utf-8; -*-
+
+;; Copyright 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.
+
+;; Modified by Andreas Rottmann for Guile.
+
+(define-module (test-srfi-45)
+ #:use-module (test-suite lib)
+ #:use-module (srfi srfi-45))
+
+(define-syntax test-output
+ (syntax-rules ()
+ ((_ expected proc)
+ (let ((output (call-with-output-string proc)))
+ (pass-if (equal? expected output))))))
+
+(define-syntax test-equal
+ (syntax-rules ()
+ ((_ expected expr)
+ (pass-if (equal? expected expr)))))
+
+(define test-leaks? #f)
+
+(define-syntax test-leak
+ (syntax-rules ()
+ ((_ expr)
+ (cond (test-leaks?
+ (display "Leak test, please watch memory consumption;")
+ (display " press C-c when satisfied.\n")
+ (call/cc
+ (lambda (k)
+ (sigaction SIGINT (lambda (signal) (k #t)))
+ expr)))))))
+
+;=========================================================================
+; TESTS AND BENCHMARKS:
+;=========================================================================
+
+;=========================================================================
+; Memoization test 1:
+
+(test-output "hello"
+ (lambda (port)
+ (define s (delay (begin (display 'hello port) 1)))
+ (test-equal 1 (force s))
+ (test-equal 1 (force s))))
+
+;=========================================================================
+; Memoization test 2:
+
+(test-output "bonjour"
+ (lambda (port)
+ (let ((s (delay (begin (display 'bonjour port) 2))))
+ (test-equal 4 (+ (force s) (force s))))))
+
+;=========================================================================
+; Memoization test 3: (pointed out by Alejandro Forero Cuervo)
+
+(test-output "hi"
+ (lambda (port)
+ (define r (delay (begin (display 'hi port) 1)))
+ (define s (lazy r))
+ (define t (lazy s))
+ (test-equal 1 (force t))
+ (test-equal 1 (force r))))
+
+;=========================================================================
+; Memoization test 4: Stream memoization
+
+(define (stream-drop s index)
+ (lazy
+ (if (zero? index)
+ s
+ (stream-drop (cdr (force s)) (- index 1)))))
+
+(define (ones port)
+ (delay (begin
+ (display 'ho port)
+ (cons 1 (ones port)))))
+
+(test-output "hohohohoho"
+ (lambda (port)
+ (define s (ones port))
+ (test-equal 1
+ (car (force (stream-drop s 4))))
+ (test-equal 1
+ (car (force (stream-drop s 4))))))
+
+;=========================================================================
+; Reentrancy test 1: from R5RS
+
+(letrec ((count 0)
+ (p (delay (begin (set! count (+ count 1))
+ (if (> count x)
+ count
+ (force p)))))
+ (x 5))
+ (test-equal 6 (force p))
+ (set! x 10)
+ (test-equal 6 (force p)))
+
+;=========================================================================
+; Reentrancy test 2: from SRFI 40
+
+(letrec ((f (let ((first? #t))
+ (delay
+ (if first?
+ (begin
+ (set! first? #f)
+ (force f))
+ 'second)))))
+ (test-equal 'second (force f)))
+
+;=========================================================================
+; Reentrancy test 3: due to John Shutt
+
+(let* ((q (let ((count 5))
+ (define (get-count) count)
+ (define p (delay (if (<= count 0)
+ count
+ (begin (set! count (- count 1))
+ (force p)
+ (set! count (+ count 2))
+ count))))
+ (list get-count p)))
+ (get-count (car q))
+ (p (cadr q)))
+
+ (test-equal 5 (get-count))
+ (test-equal 0 (force p))
+ (test-equal 10 (get-count)))
+
+;=========================================================================
+; Test leaks: All the leak tests should run in bounded space.
+
+;=========================================================================
+; Leak test 1: Infinite loop in bounded space.
+
+(define (loop) (lazy (loop)))
+(test-leak (force (loop))) ;==> bounded space
+
+;=========================================================================
+; Leak test 2: Pending memos should not accumulate
+; in shared structures.
+
+(let ()
+ (define s (loop))
+ (test-leak (force s))) ;==> bounded space
+
+;=========================================================================
+; Leak test 3: Safely traversing infinite stream.
+
+(define (from n)
+ (delay (cons n (from (+ n 1)))))
+
+(define (traverse s)
+ (lazy (traverse (cdr (force s)))))
+
+(test-leak (force (traverse (from 0)))) ;==> bounded space
+
+;=========================================================================
+; Leak test 4: Safely traversing infinite stream
+; while pointer to head of result exists.
+
+(let ()
+ (define s (traverse (from 0)))
+ (test-leak (force s))) ;==> bounded space
+
+;=========================================================================
+; Convenient list deconstructor used below.
+
+(define-syntax match
+ (syntax-rules ()
+ ((match exp
+ (() exp1)
+ ((h . t) exp2))
+ (let ((lst exp))
+ (cond ((null? lst) exp1)
+ ((pair? lst) (let ((h (car lst))
+ (t (cdr lst)))
+ exp2))
+ (else 'match-error))))))
+
+;========================================================================
+; Leak test 5: Naive stream-filter should run in bounded space.
+; Simplest case.
+
+(define (stream-filter p? s)
+ (lazy (match (force s)
+ (() (delay '()))
+ ((h . t) (if (p? h)
+ (delay (cons h (stream-filter p? t)))
+ (stream-filter p? t))))))
+
+(test-leak
+ (force (stream-filter (lambda (n) (= n 10000000000))
+ (from 0)))) ;==> bounded space
+
+;========================================================================
+; Leak test 6: Another long traversal should run in bounded space.
+
+; The stream-ref procedure below does not strictly need to be lazy.
+; It is defined lazy for the purpose of testing safe compostion of
+; lazy procedures in the times3 benchmark below (previous
+; candidate solutions had failed this).
+
+(define (stream-ref s index)
+ (lazy
+ (match (force s)
+ (() 'error)
+ ((h . t) (if (zero? index)
+ (delay h)
+ (stream-ref t (- index 1)))))))
+
+; Check that evenness is correctly implemented - should terminate:
+
+(test-equal 0
+ (force (stream-ref (stream-filter zero? (from 0))
+ 0)))
+
+;; Commented out since it takes too long
+#;
+(let ()
+ (define s (stream-ref (from 0) 100000000))
+ (test-equal 100000000 (force s))) ;==> bounded space
+
+;======================================================================
+; Leak test 7: Infamous example from SRFI 40.
+
+(define (times3 n)
+ (stream-ref (stream-filter
+ (lambda (x) (zero? (modulo x n)))
+ (from 0))
+ 3))
+
+(test-equal 21 (force (times3 7)))
+
+;; Commented out since it takes too long
+#;
+(test-equal 300000000 (force (times3 100000000))) ;==> bounded space
HCoop / bpt / guile.git / commitdiff