mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Add implementation of SRFI 45

Browse source 
* 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.
This commit is contained in:
Andreas Rottmann 2010-10-03 21:54:22 +02:00 • committed by Andy Wingo
parent 5ad3881631
commit f16a20071d
6 changed files with 485 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

1
NEWS
View file

@ -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

144
doc/ref/srfi-modules.texi
View file

@ -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

1
module/Makefile.am
View file

@ -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 \

78
module/srfi/srfi-45.scm Normal file
View file

@ -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.

1
test-suite/Makefile.am
View file

@ -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 \

260
test-suite/tests/srfi-45.test Normal file
View file

@ -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