[PATCH] SRFI 41: Improve stream-constant and list->stream implementation

[Chris Jester-Young]

Attached is a patch to implement the changes detailed in
http://srfi-email.schemers.org/srfi-41/msg/3066997, which improves
the performance of `stream-constant` compared to the reference
implementation.

It probably doesn't improve performance against the Guile version
(which is already O(1) per element), but it's a cleaner implementation
that removes the need for the `list?` shadowing hack in `list->stream`.

This also removes support for circular lists for `list->stream` (which
was never supported in the reference implementation, and was added as
an implementation detail of `stream-constant` (which I originally
implemented using circular lists).

Comments welcome.

Cheers,
Chris.
> --- Begin Message ---
>
>
>
> Subject: 
>
> [PATCH] SRFI 41: Improve stream-constant and list->stream implementation
>
>
>
>
> Date: 
>
> Tue, 3 Nov 2015 14:10:36 +1300
>
>
>
>
> See http://srfi-email.schemers.org/srfi-41/msg/3066997 for more details.
>
> * module/srfi/srfi-41.scm (stream-constant): Implement by repeatedly
>   stream-appending the incoming list (converted to a stream), rather
>   than using a circular list.
>   (list->stream): No longer support circular lists, since we no longer
>   use it for stream-constant.
> ---
>  module/srfi/srfi-41.scm | 6 +++---
>  1 file changed, 3 insertions(+), 3 deletions(-)
>
> diff --git a/module/srfi/srfi-41.scm b/module/srfi/srfi-41.scm
> index 3589b35..59c3b50 100644
> --- a/module/srfi/srfi-41.scm
> +++ b/module/srfi/srfi-41.scm
> @@ -212,8 +212,6 @@
>    ((letrec ((tag (stream-lambda (name ...) body1 body2 ...))) tag) val ...))
>  
>  (define (list->stream objs)
> -  (define (list? x)
> -    (or (proper-list? x) (circular-list? x)))
>    (must list? objs 'list->stream "non-list argument")
>    (stream-let recur ((objs objs))
>      (if (null? objs) stream-null
> @@ -274,7 +272,9 @@
>  (define stream-constant
>    (case-lambda
>     (() stream-null)
> -   (objs (list->stream (apply circular-list objs)))))
> +   ((obj) (stream-let loop () (stream-cons obj (loop))))
> +   (objs (define strm (list->stream objs))
> +         (stream-let loop () (stream-append strm (loop))))))
>  
>  (define-syntax* (stream-do x)
>    (define (end x)
> -- 
> 2.3.8 (Apple Git-58)
>
> --- End Message ---