[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-133-gf16a200

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f16a20071dcb55e1362a5b21c63e98b3b4101364

The branch, master has been updated
       via  f16a20071dcb55e1362a5b21c63e98b3b4101364 (commit)
      from  5ad3881631c078d29e6b5676e8ab55759ee5bb85 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f16a20071dcb55e1362a5b21c63e98b3b4101364
Author: Andreas Rottmann <address@hidden>
Date:   Sun Oct 3 21:54:22 2010 +0200

    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.

-----------------------------------------------------------------------

Summary of changes:
 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(-)
 create mode 100644 module/srfi/srfi-45.scm
 create mode 100644 test-suite/tests/srfi-45.test

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


hooks/post-receive
-- 
GNU Guile