From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andreas Rottmann Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Add implementation of SRFI 45 Date: Sun, 03 Oct 2010 19:32:26 +0200 Message-ID: <87pqvri3md.fsf@delenn.lan> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1286127340 16816 80.91.229.12 (3 Oct 2010 17:35:40 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 3 Oct 2010 17:35:40 +0000 (UTC) To: Guile Development Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Oct 03 19:35:37 2010 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1P2STI-0007RO-80 for guile-devel@m.gmane.org; Sun, 03 Oct 2010 19:35:37 +0200 Original-Received: from localhost ([127.0.0.1]:41886 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1P2STH-00032R-6x for guile-devel@m.gmane.org; Sun, 03 Oct 2010 13:35:35 -0400 Original-Received: from [140.186.70.92] (port=46804 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1P2STB-0002zU-4M for guile-devel@gnu.org; Sun, 03 Oct 2010 13:35:31 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1P2SQV-0002QK-EG for guile-devel@gnu.org; Sun, 03 Oct 2010 13:32:46 -0400 Original-Received: from mailout-de.gmx.net ([213.165.64.23]:36295 helo=mail.gmx.net) by eggs.gnu.org with smtp (Exim 4.71) (envelope-from ) id 1P2SQU-0002Pq-HX for guile-devel@gnu.org; Sun, 03 Oct 2010 13:32:43 -0400 Original-Received: (qmail invoked by alias); 03 Oct 2010 17:32:38 -0000 Original-Received: from 83-215-154-5.hage.dyn.salzburg-online.at (EHLO nathot.lan) [83.215.154.5] by mail.gmx.net (mp003) with SMTP; 03 Oct 2010 19:32:38 +0200 X-Authenticated: #3102804 X-Provags-ID: V01U2FsdGVkX19gqhYZDUxgppEmMDabXedlrUXUr3kxkhldnys+xc prd8wSfkxDvjDi Original-Received: from localhost (localhost.localdomain [127.0.0.1]) by nathot.lan (Postfix) with ESMTP id 4A7693A6A5 for ; Sun, 3 Oct 2010 19:32:38 +0200 (CEST) Original-Received: from nathot.lan ([127.0.0.1]) by localhost (nathot.lan [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id yYhuw17y5V0k for ; Sun, 3 Oct 2010 19:32:28 +0200 (CEST) Original-Received: from delenn.lan (delenn.lan [192.168.3.11]) by nathot.lan (Postfix) with ESMTP id A2D2E3A695 for ; Sun, 3 Oct 2010 19:32:27 +0200 (CEST) Original-Received: by delenn.lan (Postfix, from userid 1000) id 0CBAC74E40; Sun, 3 Oct 2010 19:32:26 +0200 (CEST) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) X-Y-GMX-Trusted: 0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:10991 Archived-At: --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=srfi-45.patch Content-Transfer-Encoding: quoted-printable From: Andreas Rottmann Subject: Add implementation of SRFI 45 =20=20=20=20 * module/srfi/srfi-45.scm: New file, containing the reference implementatio= n 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: =20 - SRFI-27 "Sources of Random Bits" - SRFI-42 "Eager Comprehensions" +- SRFI-45 "Primitives for Expressing Iterative Lazy Algorithms" =20 ** Many R6RS bugfixes =20 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 a= lgorithms * 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}. =20 +@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=C3=A9 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) =3D (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=20 +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 8062d5a..9aa4c7a 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -255,6 +255,7 @@ SRFI_SOURCES =3D \ 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=C3=A9 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 promis= e*))) + (value-proc-set! content + (value-proc (promise-val prom= ise*))) + (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 =3D 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=C3=A9 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))))))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; TESTS AND BENCHMARKS: +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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)))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Memoization test 2: + +(test-output "bonjour" + (lambda (port) + (let ((s (delay (begin (display 'bonjour port) 2)))) + (test-equal 4 (+ (force s) (force s)))))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Memoization test 3: (pointed out by Alejandro Forero Cuervo)=20 + +(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)))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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)))))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Reentrancy test 3: due to John Shutt + +(let* ((q (let ((count 5)) + (define (get-count) count) + (define p (delay (if (<=3D 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))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Test leaks: All the leak tests should run in bounded space. + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Leak test 1: Infinite loop in bounded space. + +(define (loop) (lazy (loop))) +(test-leak (force (loop))) ;=3D=3D> bounded space + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Leak test 2: Pending memos should not accumulate +; in shared structures. + +(let () + (define s (loop)) + (test-leak (force s))) ;=3D=3D> bounded space + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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)))) ;=3D=3D> bounded space + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; Leak test 4: Safely traversing infinite stream +; while pointer to head of result exists. + +(let () + (define s (traverse (from 0))) + (test-leak (force s))) ;=3D=3D> bounded space + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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)))))) + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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) (=3D n 10000000000)) + (from 0)))) ;=3D=3D> bounded sp= ace + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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))) ;=3D=3D> bounded space + +;=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D +; 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))) ;=3D=3D> bounded space --=20 tg: (5ad3881..) t/srfi-45 (depends on: master) --=-=-= Regards, Rotty -- Andreas Rottmann -- --=-=-=--