diff --git a/NEWS b/NEWS index 5e9fd03bf..d05d39cf5 100644 --- a/NEWS +++ b/NEWS @@ -17,6 +17,7 @@ The following SRFIs have been added: - SRFI-27 "Sources of Random Bits" - SRFI-42 "Eager Comprehensions" +- SRFI-45 "Primitives for Expressing Iterative Lazy Algorithms" ** Many R6RS bugfixes diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 2ca971e41..238484cec 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -44,6 +44,7 @@ get the relevant SRFI documents from the SRFI home page * 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 @@ -3875,6 +3876,149 @@ as Guile-specific. 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 diff --git a/module/Makefile.am b/module/Makefile.am index 8062d5a2f..9aa4c7a6a 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -255,6 +255,7 @@ SRFI_SOURCES = \ 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 \ 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. diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 71094e4a3..70e49b201 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -120,6 +120,7 @@ SCM_TESTS = tests/00-initial-env.test \ 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 \ diff --git a/test-suite/tests/srfi-45.test b/test-suite/tests/srfi-45.test new file mode 100644 index 000000000..573eea04a --- /dev/null +++ b/test-suite/tests/srfi-45.test @@ -0,0 +1,260 @@ +;;; -*- 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