From: Andreas Rottmann Subject: 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. --- NEWS | 1 + doc/ref/srfi-modules.texi | 144 +++++++++++++++++++++++ module/Makefile.am | 1 + module/srfi/srfi-45.scm | 78 ++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-45.test | 260 +++++++++++++++++++++++++++++++++++++++++ 6 files changed, 485 insertions(+), 0 deletions(-) diff --git a/NEWS b/NEWS index 5e9fd03..d05d39c 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 2ca971e..238484c 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}. address@hidden SRFI-45 address@hidden SRFI-45 - Primitives for Expressing Iterative Lazy Algorithms address@hidden 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. + address@hidden Copyright (C) André van Tonder (2003). All Rights Reserved. + address@hidden Permission is hereby granted, free of charge, to any person obtaining a address@hidden copy of this software and associated documentation files (the address@hidden "Software"), to deal in the Software without restriction, including address@hidden without limitation the rights to use, copy, modify, merge, publish, address@hidden distribute, sublicense, and/or sell copies of the Software, and to address@hidden permit persons to whom the Software is furnished to do so, subject to address@hidden the following conditions: + address@hidden The above copyright notice and this permission notice shall be included address@hidden in all copies or substantial portions of the Software. + address@hidden THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS address@hidden OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF address@hidden MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND address@hidden NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE address@hidden LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION address@hidden OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION address@hidden 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: @address@hidden, @code{delay}, address@hidden@}, 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 address@hidden@code{delay}, @address@hidden 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. + address@hidden {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. address@hidden deffn + address@hidden {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. address@hidden deffn + address@hidden {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. address@hidden deffn + address@hidden {Scheme Procedure} eager expression +Takes an argument of type @var{a} and returns a value of type address@hidden(Promise @var{a})}. As opposed to @code{delay}, the argument is +evaluated eagerly. Semantically, writing @code{(eager expression)} is +equivalent to writing + address@hidden +(let ((value expression)) (delay value)). address@hidden lisp + +However, the former is more efficient since it does not require +unnecessary creation and evaluation of thunks. We also have the +equivalence + address@hidden +(delay expression) = (lazy (eager expression)) address@hidden lisp address@hidden 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: + address@hidden +(force (delay expression)) -> expression +(force (lazy expression)) -> (force expression) +(force (eager value)) -> value address@hidden lisp + address@hidden Correct usage + +We now provide a general recipe for using the primitives @address@hidden, address@hidden, @address@hidden 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 + address@hidden +(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))))) address@hidden lisp + +This algorithm can be espressed as follows in Scheme: + address@hidden +(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)))))) address@hidden lisp + +In other words, we + address@hidden @bullet address@hidden +wrap all constructors (e.g., @code{'()}, @code{cons}) with @code{delay}, address@hidden +apply @code{force} to arguments of deconstructors (e.g., @code{car}, address@hidden and @code{null?}), address@hidden +wrap procedure bodies with @code{(lazy ...)}. address@hidden itemize + @node SRFI-55 @subsection SRFI-55 - Requiring Features @cindex SRFI-55 diff --git a/module/Makefile.am b/module/Makefile.am index 8062d5a..9aa4c7a 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 0000000..1b912be --- /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 71094e4..70e49b2 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 0000000..573eea0 --- /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 -- tg: (5ad3881..) t/srfi-45 (depends on: master)